home *** CD-ROM | disk | FTP | other *** search
/ Columbia Kermit / kermit.zip / extra / perkin.ftn < prev    next >
Text File  |  2020-01-01  |  138KB  |  4,076 lines
  1. $NLIST
  2. C-------------------------------------------------------------------
  3.       PROGRAM Kermit                 ; (Celtic for 'free')
  4. C
  5. C...................................................................
  6. C           Kermit-CO   Version 2.1         4/16/86
  7. C
  8. C  -- Configured for the CONCURRENT Computer Corp. 3200 series
  9. C         under OS/32, Rev. 7.2 and up, by:
  10. C
  11. C               Paul Mamelka
  12. C               Genetics Department
  13. C               Southwest Foundation for Biomedical Research
  14. C               Box 28147
  15. C               San Antonio, TX      (512) 674-1410
  16. C
  17. C  -- Current versions are available through INTERCHANGE library,
  18. C       and Columbia University
  19. C
  20. C  -- Other contributors to the Kermit kause include David MacPhee,
  21. C     Tom Funke, John Cooley, Rick MacDonald, and Walter Shevchuk.
  22. C...................................................................
  23. C
  24. C  -- Kermit-CO is a revised, and much expanded, version of a Kermit
  25. C     written for the Hewlett-Packard 1000:
  26. c
  27. C        RTE-6/VM KERMIT, implemented by John Lee of RCA Laboratories
  28. C
  29. C     Permission is granted to any individual or institution to copy
  30. C     or use this program, except for explicitly commerical purpose.
  31. C
  32. C                     John Lee         6/29/84
  33. C                     RCA Laboratories
  34. C                     (609) 734-3157
  35. C.............................................................
  36. C                   ** Kermit-CO Release Files**
  37. C
  38. C      CONKER.DOC     - Documentation
  39. C
  40. C      CONKER.FTN     - Fortran source  (rename to KERMIT.FTN for use)
  41. C
  42. C      CONKER.ETC     - a collection of following files:
  43. C
  44. C         KERMLINK.CSS    - Link file with XSVC1 option
  45. C         KERMIT.CSS     - Run time Command file
  46. C         KERMIT.HLP     - Help file of KERMIT-CO commands
  47. C         KERDEF, KERCOM - INCLUDE files of COMMON, PARAMETERs
  48. C..............................................................
  49. C                ** Logical Unit Assignments**
  50. C
  51. C   1       : Comm. Input  (LOCAL/RMTINFD) (CSS assigned)
  52. C   2       : Comm. Output (LOCAL/RMTOUTFD)  (CSS assigned)
  53. C   3 - 12  : Transfer, Directory, Scratch files  (BUFFCHAN)
  54. C   15      : Help file         KERMIT.HLP  (CSS assigned)
  55. C   16      : Initial Settings: KERMIT.INI or User-specified in CSS
  56. C   20      : Session log file  KERMIT.LOG
  57. C...................................................................
  58. $INCLUDE KERCOM  (NLIST)
  59. $NLIST
  60. $INCLUDE KERDEF  (NLIST)
  61. $NLIST
  62.       COMMON /IOUNIT/ PT,BUFFCHAN(20), RECLCHAN(20),MAXCHAN
  63.       COMMON /MUX/ VRAWCOOK,VPARITY,VPORT,VBAUD,VENQACK,VXONXOFF,VREST
  64.       INTEGER*2 STATUS,GETLIN,FCHAN,ITEMP
  65.       INTEGER ISZ, LUN, TskCode
  66.       CHARACTER Day6*6,Time6*6,Day8*8,Time8*8
  67. C-----------------------------------------------------------------
  68. C             Kermit-CO Parameter Initialization
  69. C----------------------------------------------------------------
  70.       DELAY=10         ; 10 Secs wait before Init packet sent
  71.       EOL=13           ; CR
  72.       ESCHAR=29        ; CNTR-]
  73.       HOSTON=YES       ; we are running in Remote Host mode
  74.       LOCALINFD=1      ;  LU 1 for Communiation port Input
  75.       LOCALOUTFD=2     ;  LU 2 for Communication port Output
  76.       LOCALSLU=1       ; System
  77.       MAXTRY=5
  78.       MYEOL=13
  79.       MYPAD=0           ; 0 pads in front of Incoming Packet
  80.       MYPCHAR=0         ; Null(00), Del(127) , or 255 (OS/32 Pad)
  81.       MYTIMOUT=10       ;Timeout after 10 secs   (Not Implemented)
  82.       MYQUOTE=35        ; '#' used for Control Char Prefix
  83.       MYQUOT8B=YES ; Default to 8-bit prefixing with EVEN parity
  84.       PAD=0
  85.       PADCHAR=0
  86.       PAKSIZ=94       ;Busy systems like smaller packet size
  87.       PARITY=5        ;(1=EVEN,2=ODD,3=SPACE,4=MARK,5=NONE)
  88.       QUOTE=35
  89.       QUOT8B=NO  ; Set 'No 8-Bit prefixing' as starting REMOTE default
  90.       SOH=1
  91.       STATE=BIGC
  92.       DEBUGON=NO
  93.       FMode = TXTFILE    ; Default to FORMATTED/TEXT file mode
  94.       TMode = TXTFILE    ; Default to FORMATTED/TEXT  for 7 bit path
  95.       IF (PARITY.EQ.5) TMode = BINFILE  ; IMAGE I/O if 8bit path
  96.       FNamChek=YES    ; Set for Make Unique Filename
  97.       FNamChng=NO     ; Set to 'No Names Changed' to start
  98.       SendEOR=3    ; Delimit Outgoing records with CRLF  (13,10)
  99. C...........................Following 'To-Be-Installed' ......
  100.       SPEED=9600       ;9600 BAUD (Currently Unused: 3/85)
  101.       IBMON=NO
  102.       PROMPT=17             ;DC1, IBM MODE ONLY
  103. C..............................................................
  104. C    Parameters used by Kermit.CO in Local Mode
  105. C       (as of 1/31/85, only Remote Mode is available)
  106. C.............................................................
  107. C     SET DEFAULT NON-LOGIN TTY ( IN LOCAL MODE ONLY)
  108.       RMTTTY(1)=BIGA
  109.       RMTTTY(2)=BIGB
  110.       RMTTTY(3)=BIGC
  111.       RMTTTY(4)=BIGD
  112.       RMTTTY(5)=BIGE
  113.       RMTTTY(6)=BIGF
  114.       RMTTTY(7)=LF
  115.       RMTTTY(8)=EOS
  116.       SPARITY=YES
  117.       SBAUD=YES
  118.       SPORT=NO
  119. C     VREST=52004B   ;7 bits/char; baud rate generaor 1;1 stop bits
  120. C     VRAWCOOK=400B  ;set tty to cook mode
  121.       VXONXOFF=1  ;set XON/XOFF enabled
  122.       VENQACK=0   ;set ENQ/ACK disabled
  123. C-------------------------------------------------------------------
  124. C                 **Kermit Mainline**
  125. C
  126. C ..........................Initialize channel stack
  127.       MAXCHAN=20
  128.       PT=1
  129.       FCHAN=LOCALOUTFD      ; First Channel - 1  = Next LU
  130.       DO 10 I=PT,MAXCHAN
  131.          BUFFCHAN(I)=FCHAN+I
  132.          RECLCHAN(I) = 80  ;Default Rec Size(used by LU 15,16)
  133.    10 CONTINUE
  134. C ...........................Assume LU 1, LU 2 opened in CSS
  135.       LUN = LOCALOUTFD
  136.       CALL DATETIME(Day6,Time6,Day8,Time8)
  137.       WRITE(LUN,99)
  138.       IF (HOSTON.EQ.YES) THEN
  139.          WRITE(LUN,100) Day8,Time8
  140.       ELSE
  141.          WRITE(LUN,110) Day8,Time8
  142.       ENDIF
  143.       RMTINFD=LOCALINFD
  144.       RMTOUTFD=LOCALOUTFD
  145.       OPEN(20,FILE='KERMIT.LOG',STATUS='RENEW',RECL=132)
  146.  
  147. C .................................Ready to do business
  148.  
  149.       CALL PARSER   ;Interpret, route Kermit commands
  150.  
  151. C..................................EXIT/QUIT entered
  152.       CALL DATETIME(Day6,Time6,Day8,Time8)
  153.       WRITE(LUN,200) Day8,Time8
  154.       INQUIRE(20,SIZE=ISZ)
  155.       IF (ISZ.LE.0) THEN
  156.          CLOSE(20,STATUS='DELETE')  ; Remove LOG if empty
  157.       ELSE
  158.          CLOSE(20)        ; Keep if not
  159.       ENDIF
  160.       TskCode = 0               ; Good End-0f-Task
  161.       CALL EXIT(TskCode)        ; Au revoir to Kermie....
  162. C..........................................................
  163.    99 FORMAT(/'   <><><> CCC OS/32 <><><> Kermit 2.1 <><><>')
  164.   100 FORMAT(/3X,'REMOTE Host in effect -> ',A8,2X,A8)
  165.   110 FORMAT(/3X,'LOCAL mode in effect --> ',A8,2X,A8)
  166.   200 FORMAT(/3X,'Kermit signing off ----> ',A8,2X,A8)
  167.       END
  168. $NLIST
  169. C-----------------------------------------------------------------
  170.       INTEGER*2 FUNCTION AOPEN(FileMode,FNAME,MODE)
  171. C
  172. C  Assigns 'Channel' numbers (logical units) to all files used
  173. C             for I/O by Kermit.
  174. C        -- Files are Formatted (TXTFILE) or Unformatted (BINFILE)
  175. C            depending on 'FileMode'.
  176. C        -- If a filename to be RECEIVEd already exists, a unique name
  177. C           is derived (if the user has requested), by adding a
  178. C           sequential numeric suffix (.001, .002, ... etc.) to the
  179. C           existing name.
  180. C
  181. C     PM 4/9/86
  182. C-----------------------------------------------------------------
  183. $INCLUDE KERCOM  (NLIST)
  184. $NLIST
  185. $INCLUDE KERDEF  (NLIST)
  186. $NLIST
  187.       INTEGER*2 FNAME(1),MODE,TFILE(132),MAXLEN,COUNT
  188.       INTEGER*2 X,Y,XREAD,XWRITE,IOS,GETCHAN,FileMode
  189.       INTEGER RECLEN,UserRecL,NSects,ISIZE,LUN,IBLKSZ,MAXBLKSZ
  190.       PARAMETER (MAXBLKSZ=256)  ; Maximum Physical block OS files
  191.       CHARACTER*12 MyFile
  192.       LOGICAL TOBE,MAKEUNIQ
  193.       INTEGER*2 PT,BUFFCHAN(20),RECLCHAN(20),MAXCHAN
  194.       COMMON /IOUNIT/ PT,BUFFCHAN, RECLCHAN,MAXCHAN
  195.       COMMON /XBYTE/ XNEW,XCOUNT,XLIN(264),XEOF
  196.       COMMON /NEWREC/ UserRecL,NSects
  197.       DATA MAXLEN/12/, XREAD/0/, XWRITE/1/
  198. C................................................
  199.       LUN=LOCALOUTFD
  200.       COUNT=1
  201.       AOPEN=BAD   ; Assume disaster, just for a change
  202. C
  203. C Get Filename length, prepare for use
  204.    20 IF ((FNAME(COUNT).NE.LF).AND.
  205.      +    (FNAME(COUNT).NE.EOS).AND.
  206.      +    (FNAME(COUNT).NE.0))        THEN
  207.          TFILE(COUNT)=FNAME(COUNT)
  208.          COUNT=COUNT+1
  209.          GOTO 20
  210.       ENDIF
  211. C
  212.       IF(COUNT.LE.MAXLEN)THEN     ;fill filename with trailing
  213.    40    IF (COUNT.LE.MAXLEN) THEN  ;blanks
  214.             TFILE(COUNT)=BLANK
  215.             COUNT=COUNT+1
  216.             GOTO 40
  217.          ENDIF
  218.       ENDIF
  219.       TFILE(MAXLEN+1)=EOS
  220.       CALL PACK(TFILE,MyFile)
  221.  
  222. C......................................Open file for READ
  223.       IF (MODE.EQ.XREAD) THEN
  224.          X=GETCHAN(Y)    ;get a channel
  225.          IF(X.EQ.BAD)THEN
  226.             WRITE (LUN,1000)
  227.             WRITE(20,1000)  ; LOG entry
  228.             RETURN
  229.          ENDIF
  230.  
  231.          TOBE=.FALSE.    ; File Attributes?
  232.          INQUIRE(FILE=MyFile,EXIST=TOBE,SIZE=ISIZE,IOSTAT=IOS)
  233.          IF (IOS.NE.0) THEN
  234.             WRITE (LUN,1010) IOS,MyFile
  235.             WRITE(20,1010) IOS,MyFile    ; LOG entry
  236.             RETURN
  237.          ENDIF
  238.          IF (.NOT.TOBE) THEN
  239.             WRITE(20,*) ' File ',MyFile,' does not exist'
  240.             CALL PUTCHAN(X)   ; Return Channel, exit
  241.             RETURN
  242.          ENDIF
  243.          IF (ISIZE.LE.0) THEN
  244.             CALL PUTCHAN(X)
  245.             WRITE (LUN,1020) MyFile
  246.             WRITE(20,1020) MyFile   ; LOG entry
  247.             RETURN
  248.          ENDIF
  249.  
  250.          IF (FileMode.EQ.TXTFILE) THEN  ; TEXT/ASCII/Formatted
  251.             OPEN(X,FILE=MyFile,STATUS='OLD',FORM='FORMATTED',
  252.      1            IOSTAT=IOS,ACCESS='SEQUENTIAL')
  253.             IF (IOS.EQ.0) THEN
  254.                INQUIRE(X,RECL=RECLEN,BLOCKSIZE=IBLKSZ)
  255.                RECLCHAN(X-1)=RECLEN ; Keep Rec Leng for I/O
  256.                AOPEN=X  ; Set to Non-Disastrous return
  257.                RETURN
  258.             ELSE
  259.                WRITE (LUN,1040) IOS,MyFile
  260.                WRITE(20,1040) IOS,MyFile   ;LOG entry
  261.                CALL PUTCHAN(X)   ;Return channel
  262.                RETURN
  263.             ENDIF
  264.          ELSE
  265.  
  266. C Open Binary/Contiguous as Unformatted file
  267.             OPEN(X,IOSTAT=IOS,FILE=MyFile,STATUS='OLD',
  268.      1             FORM='BINARY',ACCESS='SEQUENTIAL')
  269.             IF (IOS.EQ.0) THEN
  270.                INQUIRE(X,RECL=RECLEN,BLOCKSIZE=IBLKSZ)
  271.                RECLCHAN(X-1)=IBLKSZ
  272.                AOPEN=X   ; Set Non-disastrous return
  273.             ELSE
  274.                WRITE (LUN,1040) IOS,MyFile    ; ERROR
  275.                CALL PUTCHAN(X)   ;Return channel
  276.             ENDIF
  277.             RETURN
  278.          ENDIF
  279.       ENDIF
  280.  
  281. C.........................................Open file for WRITE
  282.       IF (MODE.EQ.XWRITE) THEN
  283.          CALL REMOVE(FNAME)         ;remove that file and ignore
  284.          X=GETCHAN(Y)               ;error, get a channel
  285.          IF(X.EQ.BAD)THEN
  286.             WRITE (LUN,1000)
  287.             RETURN
  288.          ENDIF
  289.          TOBE=.FALSE.
  290.          INQUIRE(FILE=MyFile,EXIST=TOBE)   ;Filename unique??
  291.          IF (TOBE.AND.FNamChek.EQ.YES) THEN
  292.             IF (MAKEUNIQ(MyFile)) THEN
  293.                FNamChng=YES        ;Flag for later User message
  294.             ELSE
  295.                WRITE(LUN,2010)
  296.                WRITE(20,2010)   ;LOG entry
  297.                RETURN
  298.             ENDIF
  299.          ENDIF
  300.  
  301.          IF (FileMode.EQ.TXTFILE) THEN
  302.             OPEN(X,FILE=MyFile,STATUS='RENEW',FORM='FORMATTED',
  303.      1        IOSTAT=IOS,RECL=UserRecL,ACCESS='SEQUENTIAL')
  304.          ELSE
  305.             IF (FileMode.EQ.BINFILE) THEN
  306.                IBLKSZ=MAXBLKSZ
  307.                IF (UserRecL.LT.MAXBLKSZ) IBLKSZ=UserRecL
  308.                OPEN(X,FILE=MyFile,STATUS='RENEW',FORM='BINARY',
  309.      1         RECL=UserRecL,BLOCKSIZE=IBLKSZ,ACCESS='SEQUENTIAL',
  310.      2         IOSTAT=IOS)
  311.             ELSE           ; CONTIGUOUS file (.TSK - Special case)
  312.                IBLKSZ=MAXBLKSZ
  313.                OPEN(X,FILE=MyFile,STATUS='RENEW',FORM='BINARY',
  314.      1         RECL=UserRecL,BLOCKSIZE=IBLKSZ,ACCESS='SEQUENTIAL',
  315.      2         IOSTAT=IOS,TYPE='CONTIG',SIZE=NSects)
  316.             ENDIF
  317.          ENDIF
  318.          IF (IOS.EQ.0) THEN
  319.             RECLCHAN(X-1)=UserRecL ; Store record len
  320.             AOPEN=X   ; Set Non-Disastrous return
  321.             RETURN
  322.          ELSE
  323.             WRITE (LUN,1050) IOS,MyFile
  324.             WRITE(20,1050) IOS,MyFile  ;LOG entry
  325.             CALL PUTCHAN(X)
  326.             RETURN
  327.          ENDIF
  328.       ENDIF
  329.  
  330. C..............................MODE code check
  331.       IF (MODE.NE.XREAD.AND.MODE.NE.XWRITE) THEN
  332.          WRITE (LUN,1060) MODE
  333.       ENDIF
  334.       RETURN
  335. C.........................................................
  336.  1000 FORMAT(/' All channels have been allocated')
  337.  1010 FORMAT(/' Open Error ',I3,' on file--> ',A)
  338.  1020 FORMAT(/' Requested SEND file is empty-->',A)
  339.  1040 FORMAT(/' OPEN/READ error ',I3,' on file-->',A)
  340.  1050 FORMAT(/' OPEN/WRITE Error ',I3,' on file-->',A)
  341.  1060 FORMAT(/' Invalid read/write mode detected-->',I3)
  342.  2010 FORMAT(/' Problem with File ',A,' - MAKEUNIQ')
  343.       END
  344. $NLIST
  345. C---------------------------------------------------------------
  346.       LOGICAL FUNCTION MAKEUNIQ(FileIN)
  347. C
  348. C -- Update FileIN with suffix sequence until unique name is derived.
  349. C       ( .001 -> .999 is the range of possible suffixes)
  350. C
  351. C      4/2/86     PM
  352. C---------------------------------------------------------------
  353.       IMPLICIT NONE
  354.       CHARACTER*12 FileIN,FileOT
  355.       CHARACTER*3 FSuf
  356.       CHARACTER*1 Period,Spce
  357.       INTEGER K,F1,F2,I,MAXTRIAL,PerPos,NTrial
  358.       LOGICAL TOBE
  359.       PARAMETER (MAXTRIAL=999)
  360.       DATA Period/'.'/, Spce/' '/
  361.  
  362.       MAKEUNIQ=.TRUE.    ; Assume success
  363.       DO 50 I=1,8
  364.       IF (FileIN(I:I).EQ.Period.OR.FileIN(I:I).EQ.Spce) GOTO 60
  365.    50 CONTINUE
  366.    60 PerPos = I
  367.       IF (PerPos.LE.0) THEN
  368.          MAKEUNIQ=.FALSE.
  369.          GOTO 999
  370.       ENDIF
  371.  
  372.       DO 100 NTrial=1,MAXTRIAL    ; Try '.001' ->
  373.       I=NTrial
  374.       FSuf=ITOC(I,K)
  375.       FileOT=FileIN(1:(PerPos-1))  // '.000'
  376.       F2=PerPos+3
  377.       F1=F2-K+1
  378.       FileOT(F1:F2)=FSuf(1:K)
  379.       INQUIRE(FILE=FileOT,EXIST=TOBE)
  380.       IF (.NOT.TOBE) THEN
  381.          FileIN=FileOT         ; Got Unique name
  382.          GOTO 999
  383.       ENDIF
  384.   100 CONTINUE                ; Else try again
  385.       MAKEUNIQ=.FALSE.
  386.   999 RETURN
  387.       END
  388. $NLIST
  389. C-----------------------------------------------------------------
  390.       SUBROUTINE BUFEMP(BUFFER,LEN)
  391. C
  392. C  Write out the content of the buffer out to the receiving disk file
  393. C     BUFFER - integer array which holds the data
  394. C     LEN - Number of bytes in BUFFER
  395. C
  396. C (Updated 4/9/86 - Skip LF only for TEXT files)
  397. C     PM 1/85
  398. C     JL 4/18/84 14:30
  399. C-----------------------------------------------------------------
  400. $INCLUDE KERCOM  (NLIST)
  401. $NLIST
  402. $INCLUDE KERDEF  (NLIST)
  403. $NLIST
  404.       INTEGER TT
  405.       INTEGER*2 BUFFER(132),LEN,CH,CTL,I,T,T2,FLIP8BIT
  406.       CH=FD                        ;file descriptor of receiving disk
  407.       I=1                          ;start with the very first charact
  408.   100 IF (I.LE.LEN) THEN      ;put LEN characters into disk file
  409.          T=BUFFER(I)               ;get the next character from buffer
  410. C
  411. C Perform 8-bit "un"prefixing if requested
  412.          IF (MYQUOT8B.EQ.YES) THEN
  413.             IF (T.EQ.Q8BCHR) THEN
  414.                I=I+1
  415.                T=BUFFER(I)
  416.                IF (T.EQ.MYQUOTE) THEN
  417.                   I=I+1
  418.                   T=BUFFER(I)
  419.                   IF ((T.NE.MYQUOTE).AND.(T.NE.Q8BCHR)) T=CTL(T)
  420.                ENDIF
  421.                T=FLIP8BIT(T)
  422.             ELSE
  423.                IF (T.EQ.MYQUOTE) THEN
  424.                   I=I+1
  425.                   T=BUFFER(I)
  426.                   IF ((T.NE.MYQUOTE).AND.(T.NE.Q8BCHR)) T=CTL(T)
  427.                ENDIF
  428.             ENDIF
  429.          ELSE
  430.             IF (T.EQ.MYQUOTE) THEN
  431.                I=I+1
  432.                T=BUFFER(I)
  433.                 T2=IAND(T,127)
  434.                IF (T2.NE.MYQUOTE) T=CTL(T)
  435.             ENDIF
  436.          ENDIF
  437.  
  438.          IF (FMode.EQ.TXTFILE) THEN      ;For text, exclude LF's
  439.             IF(T.NE.LF)CALL DPUTCH(T,CH) ;when writing to Receive file
  440.          ELSE
  441.             CALL DPUTCH(T,CH)  ;For Binary files, write out all chars
  442.          ENDIF
  443.          I=I+1
  444.          GOTO 100
  445.       ENDIF
  446.       RETURN
  447.       END
  448. $NLIST
  449. C-----------------------------------------------------------------
  450.       INTEGER*2 FUNCTION BUFILL(BUFFER)
  451. C
  452. C     Fill up the buffer with bytes from the sending file.
  453. C     BUFFER is used to stored the data from the sending disk file
  454. C
  455. C     PM 4/86
  456. C     JL 4/18/84 14:30
  457. C-----------------------------------------------------------------
  458. $INCLUDE KERCOM  (NLIST)
  459. $NLIST
  460. $INCLUDE KERDEF  (NLIST)
  461. $NLIST
  462.       INTEGER*2 I,CTL,DGETCH,BUFFER(132),CH,T,T2,FLIP8BIT
  463.       INTEGER*2 DGETemp
  464.       INTEGER TT
  465.       I=1
  466.       CH=FD   ;Sending Disk file
  467.  
  468. C Read from file until EOF reached, or Buffer filled
  469.   100 DGETemp = DGETCH(T,CH)
  470.       IF (DGETemp.NE.EOF) THEN
  471.          IF(T.EQ.LF.AND.DGETemp.EQ.LDELIM) THEN  ; End-of-Rec??
  472.             IF (SendEOR.EQ.NO) THEN
  473.                GOTO 100  ;No Delimiter (WORDSTAR,.TSK,.OBJ,.COM,.EXE)
  474.             ELSE IF (SendEOR.EQ.1) THEN  ; CR ??  (Macintosh usage)
  475.                     T=CR
  476.             ELSE IF (SendEOR.EQ.2) THEN  ; LF ??  (Unix)
  477.                     CONTINUE
  478.             ELSE IF (SendEOR.EQ.3) THEN  ; CRLF?   (TEXT files)
  479.                     BUFFER(I)=QUOTE
  480.                     I=I+1
  481.                     BUFFER(I)=CTL(CR)
  482.                     I=I+1
  483.             ENDIF
  484.          ENDIF
  485.  
  486. C Perform 8-Bit prefixing if requested
  487.          IF (QUOT8B.EQ.YES) THEN  ; Do 8-Bit quoting
  488.             IF (T.GT.DEL) THEN
  489.                BUFFER(I)=Q8BCHR
  490.                I=I+1
  491.                T=FLIP8BIT(T)
  492.             ENDIF
  493.             IF ((T.LT.BLANK).OR.(T.EQ.DEL).OR.(T.EQ.QUOTE).OR.
  494.      &            (T.EQ.Q8BCHR)) THEN
  495.                BUFFER(I)=QUOTE
  496.                I=I+1
  497.                IF ((T.NE.QUOTE).AND.(T.NE.Q8BCHR)) T=CTL(T)
  498.             ENDIF
  499.          ELSE
  500.             TT=T
  501.             T2=IAND(TT,127)      ;(as done by CP/M Kermit-80)
  502.             IF (PARITY.NE.5) T=T2   ; Strip bit 8 if Parity Even/Odd
  503.             IF (T2.LT.BLANK.OR.T2.EQ.QUOTE.OR.T2.EQ.DEL)THEN
  504.                BUFFER(I)=QUOTE
  505.                I=I+1
  506.                IF (T2.NE.QUOTE) T=CTL(T)
  507.             ENDIF
  508.          ENDIF
  509.          BUFFER(I)=T
  510.          I=I+1
  511.          IF(I.GT.SPSIZADJ)THEN   ;read up to spsiz-6 byte from disk
  512.             BUFILL=I-1            ;Ith byte was read
  513.             RETURN
  514.          ENDIF
  515.          GOTO 100
  516.       ENDIF
  517.       IF(I.LE.1)THEN
  518.          BUFILL=EOF                ;zero byte was read
  519.       ELSE
  520.          BUFILL=I-1                ;partial EOF was detected
  521.       ENDIF
  522.       RETURN
  523.       END
  524. $NLIST
  525. C-----------------------------------------------------------------
  526.       INTEGER*2 FUNCTION DGETCH(XCHAR,CH)
  527. C
  528. C  Get a CHAR from the disk file
  529. C
  530. C  (Updated 4/9/85 - Return EOF only if LF/EOS encountered
  531. C    PM  4/86
  532. C     JL 4/25/84 14:20
  533. C-----------------------------------------------------------------
  534. $INCLUDE KERCOM (NLIST)
  535. $NLIST
  536. $INCLUDE KERDEF  (NLIST)
  537. $NLIST
  538.       INTEGER*2 XCHAR,CH
  539.       COMMON /XBYTE/ XNEW,XCOUNT,XLIN(264),XEOF
  540.       INTEGER*2 X,DGETLIN
  541.       IF(XEOF.EQ.YES)THEN
  542.          DGETCH=EOF
  543.          RETURN
  544.       ENDIF
  545.       IF(XNEW.EQ.YES)THEN
  546.          X=DGETLIN(FMode,XLIN,CH)  ; Next line from file to SEND
  547.          IF(X.EQ.EOF)THEN
  548.             DGETCH=EOF
  549.             XEOF=YES
  550.             RETURN
  551.          ELSE
  552.             IF(XLIN(1).EQ.LF.AND.XLIN(2).EQ.EOS) THEN  ; PM 4/9/86
  553.                XNEW=YES
  554.                DGETCH=LDELIM      ; 4/86: End of line LF
  555.                XCHAR=LF
  556.                RETURN
  557.             ELSE
  558.                XNEW=NO
  559.                DGETCH=OK
  560.                XCHAR=XLIN(1)
  561.                XCOUNT=2
  562.                RETURN
  563.             ENDIF
  564.         ENDIF
  565.       ELSE
  566.           IF(XLIN(XCOUNT).EQ.LF.AND.XLIN(XCOUNT+1).EQ.EOS) THEN  ; PM
  567.              XNEW=YES
  568.              DGETCH=LDELIM        ; 4/86 End of Line LF
  569.              XCHAR=LF
  570.              RETURN
  571.            ELSE
  572.               DGETCH=OK
  573.               XCHAR=XLIN(XCOUNT)
  574.               XCOUNT=XCOUNT+1
  575.               RETURN
  576.            ENDIF
  577.       ENDIF
  578.       RETURN
  579.       END
  580. $NLIST
  581. C-----------------------------------------------------------------
  582.       INTEGER*2 FUNCTION DGETLIN(FileMode,ALIN,CH)
  583. C
  584. C    Read a record from the SENDing file and upack it into
  585. C      the array ALIN.
  586. C
  587. C     PM 3/85
  588. C     JL 5/10/84 11:25
  589. C-----------------------------------------------------------------
  590. $INCLUDE KERCOM  (NLIST)
  591. $NLIST
  592. $INCLUDE KERDEF  (NLIST)
  593. $NLIST
  594.       INTEGER*2 PT,BUFFCHAN(20),RECLCHAN(20),MAXCHAN
  595.       COMMON /IOUNIT/ PT,BUFFCHAN, RECLCHAN,MAXCHAN
  596.       INTEGER*2 CH,ALIN(1)
  597.       INTEGER*2 ACOUNT,BCOUNT,STATUS
  598.       INTEGER*2 IOS,TV2
  599.       INTEGER TV1,ITEMP1,ITEMP2,RECLEN,RECLEN2
  600.       CHARACTER BLIN*264, CHARINP*2, SPACE*1/' '/,SPACES*264/' '/
  601.       INTEGER*2 INPCHAR,FileMode,BLIN2(132)
  602.       INTEGER MLeft/Z0000FF00/, MRight/Z000000FF/
  603.       EQUIVALENCE (INPCHAR,CHARINP)
  604. C..............................................................
  605.       RECLEN=RECLCHAN(CH-1) ; RecLen of File to be Read
  606.       DO 100 I=1,264
  607.   100 ALIN(I)=0
  608.  
  609. C Read a formatted record   (TEXT mode)
  610.       IF (FileMode.EQ.TXTFILE) THEN         ; TEXT read
  611.          BLIN=SPACES
  612.          READ(UNIT=CH,IOSTAT=IOS,FMT='(A)')BLIN(1:RECLEN)
  613.          IF(IOS.GT.0)THEN
  614.             WRITE(20,*) ' DGETLIN Ascii Read Error - ',IOS
  615.             GOTO 999    ; Handle error as EOF
  616.          ELSE
  617.             IF (IOS.LT.0) THEN
  618.                IF (IOS.EQ.-2) THEN  ; Trap EOF on '/*' read and
  619.                   BLIN(1:2) = '/*'  ; process '/*' as data only
  620.                ELSE
  621.                   GOTO 999  ; Any other EOF condition
  622.                ENDIF
  623.             ENDIF
  624.          ENDIF
  625.  
  626.          DO 200 I=RECLEN,1,-1    ; Scan record backwards for blanks
  627.          IF (BLIN(I:I).NE.SPACE) GOTO 210
  628.   200    CONTINUE
  629.   210    ACOUNT=I
  630.  
  631.          DO 220 I=1,ACOUNT
  632.          INPCHAR=0
  633.          CHARINP(2:2)=BLIN(I:I)
  634.          ALIN(I)=INPCHAR
  635.   220    CONTINUE
  636.          ALIN(ACOUNT+1)=LF
  637.          ALIN(ACOUNT+2)=EOS
  638.          DGETLIN=OK
  639.          RETURN
  640.       ELSE
  641.  
  642. C Read an Unformatted record (BINARY mode)
  643.          RECLEN2=RECLEN/2
  644.          READ(CH,IOSTAT=IOS)(BLIN2(I),I=1,RECLEN2)
  645.          IF(IOS.NE.0)THEN
  646.             WRITE(20,*) ' DGETLIN Image Read Error - ',IOS
  647.             GOTO 999    ; Handle error as EOF
  648.          ENDIF
  649.          ACOUNT = 0
  650.          DO 300 I=1,RECLEN2
  651.          ACOUNT = ACOUNT + 1
  652.          ITEMP1 = BLIN2(I)
  653.          ALIN(ACOUNT) = IAND(ITEMP1,MLEFT) / 256
  654.          ACOUNT = ACOUNT + 1
  655.          ALIN(ACOUNT) = IAND(ITEMP1,MRIGHT)
  656.   300    CONTINUE
  657.          ALIN(ACOUNT+1) = LF
  658.          ALIN(ACOUNT+2) = EOS
  659.          DGETLIN = OK
  660.          RETURN
  661.       ENDIF
  662.  
  663. C    Here for EOF on input file
  664. 999   CONTINUE
  665.       DGETLIN=EOF
  666.       RETURN
  667.       END
  668. $NLIST
  669. C-----------------------------------------------------------------
  670.       SUBROUTINE DPUTCH(XCHAR,CH)
  671. C
  672. C  Output a char to the disk file channel
  673. C
  674. C      PM 4/86       (SkipCR update: 5/8/86)
  675. C     JL 4/25/84 14:25
  676. C-----------------------------------------------------------------
  677. $INCLUDE KERCOM (NLIST)
  678. $NLIST
  679. $INCLUDE KERDEF  (NLIST)
  680. $NLIST
  681.       INTEGER XCHAR*2,CH*2,TV1*2,TV2*4, RecLen*4
  682.       INTEGER*2 PT,BUFFCHAN(20),RECLCHAN(20),MAXCHAN
  683.       LOGICAL SkipCR               ; 5/8/86 PM
  684.       SAVE SkipCR                  ; Full rec CR skip flag
  685.       COMMON /IOUNIT/ PT,BUFFCHAN, RECLCHAN,MAXCHAN
  686.       COMMON /XBYTE/ XNEW,XCOUNT,XLIN(264),XEOF
  687.       DATA SkipCR/.FALSE./
  688.       RecLen=RECLCHAN(CH-1)     ; Get Record length of RECEIVE file
  689.       IF (XCHAR.EQ.CR.AND.FMode.EQ.TXTFILE) THEN
  690.          IF (SkipCR) THEN
  691.             SkipCR = .FALSE.
  692.             IF (XCOUNT.EQ.1) THEN   ; Skip only if end of last rec
  693.                CONTINUE
  694.             ELSE
  695.                XLIN(XCOUNT)=LF    ; Handle end of Record
  696.                XLIN(XCOUNT+1)=EOS
  697.                CALL DPUTLIN(FMode,XLIN,CH,RecLen) ;Write rec to file
  698.                XCOUNT=1
  699.             ENDIF
  700.          ELSE
  701.             XLIN(XCOUNT)=LF             ;  Write out Record
  702.             XLIN(XCOUNT+1)=EOS
  703.             CALL DPUTLIN(FMode,XLIN,CH,RecLen) ;Write rec to file
  704.             XCOUNT=1
  705.          ENDIF
  706.       ELSE
  707.          XLIN(XCOUNT)=XCHAR  ; CR may be part of BINARY record
  708.          XCOUNT=XCOUNT+1
  709.          IF (XCOUNT.GT.RecLen) THEN   ; check for "O/P Line
  710.             IF (FMode.EQ.TXTFILE) SkipCR = .TRUE.
  711.             XLIN(XCOUNT)=LF             ; Write out Record
  712.             XLIN(XCOUNT+1)=EOS
  713.             CALL DPUTLIN(FMode,XLIN,CH,RecLen) ;Write rec to file
  714.             XCOUNT=1
  715.          ENDIF
  716.       ENDIF
  717.       RETURN
  718.       END
  719. $NLIST
  720. C-----------------------------------------------------------------
  721.       SUBROUTINE DPUTLIN(FileMode,ALIN,CH,RecLen)
  722. C
  723. C     Write ALIN to a disk file
  724. C
  725. C  (Updated 6/9/86 - Look for LF/EOS as BIN file rec end
  726. C     JL 5/11/84 10:00           **   PM 1/85
  727. C-----------------------------------------------------------------
  728. $INCLUDE KERCOM  (NLIST)
  729. $NLIST
  730. $INCLUDE KERDEF  (NLIST)
  731. $NLIST
  732.       INTEGER*2 CH,IOS,ACOUNT,BLEN,INPCHAR,XCR,ALIN(1)
  733.       CHARACTER BLIN*264,CHARINP*2,RLENCH*4,FORMT*10
  734.       INTEGER RecLen
  735.       INTEGER*2 FileMode, BLIN2(132)
  736.       EQUIVALENCE (INPCHAR,CHARINP)
  737. C ...........................................TEXT/Ascii output
  738.       IF (FileMode.EQ.TXTFILE) THEN      ; TEXT
  739.          ACOUNT=1
  740.   100    IF (ALIN(ACOUNT).NE.LF) THEN
  741.             INPCHAR=ALIN(ACOUNT)
  742.             BLIN(ACOUNT:ACOUNT)=CHARINP(2:2)
  743.             ACOUNT=ACOUNT+1
  744.             GOTO 100
  745.          ENDIF
  746.          BLEN=ACOUNT-1
  747.          IF (BLEN.GT.RecLen) BLEN=RecLen
  748.  
  749. C Write the Record to Receiving file
  750.          RLENCH=ITOC(RecLen,K)
  751.          FORMT= '(' // RLENCH(1:K) // 'A1)'
  752.          IF (BLEN.LE.0) THEN       ; Empty line, print <CR> only
  753.             WRITE(CH,FMT=FORMT,IOSTAT=IOS) " "  ; Empty Rec
  754.          ELSE
  755.             WRITE(CH,FMT=FORMT,IOSTAT=IOS)(BLIN(I:I),I=1,BLEN)
  756.          ENDIF
  757.          IF (IOS.NE.0) THEN
  758.             WRITE(20,*) 'DPUTLIN - Ascii Write Error: ',IOS
  759.          ENDIF
  760.          GOTO 900
  761.       ELSE
  762.  
  763. C ................................Binary/IMAGE file output
  764.          ACOUNT=1
  765.          BLEN = 0
  766.   200    IF (ALIN(ACOUNT).NE.LF.OR.ALIN(ACOUNT+1).NE.EOS) THEN  ;PM
  767.             BLEN = BLEN + 1
  768.             BLIN2(BLEN) = ALIN(ACOUNT) * 256
  769.             ACOUNT = ACOUNT + 1
  770.             IF((ALIN(ACOUNT).NE.LF).OR.(ALIN(ACOUNT+1).NE.EOS)) THEN
  771.                BLIN2(BLEN) = BLIN2(BLEN) + ALIN(ACOUNT)
  772.                ACOUNT=ACOUNT+1
  773.             ENDIF
  774.             GOTO 200                   ; Assume Even number chars
  775.          ENDIF
  776.          IF ((BLEN*2).GT.RecLen) BLEN=RecLen/2
  777.          IF (BLEN.GT.0) THEN
  778.             WRITE(CH,IOSTAT=IOS)(BLIN2(I),I=1,BLEN)
  779.             IF (IOS.NE.0) THEN
  780.                WRITE(20,*) 'DPUTLIN - Image Write Error: ',IOS
  781.                IF (DEBUGON.EQ.YES) THEN    ; Note file error
  782.                   WRITE(20,*) 'BLEN-',BLEN,' REC-',(BLIN2(I),I=1,BLEN)
  783.                ENDIF
  784.             ENDIF
  785.          ENDIF
  786.       ENDIF
  787.   900 RETURN
  788.       END
  789. $NLIST
  790. C-----------------------------------------------------------------
  791.       INTEGER*2 FUNCTION CHARTOI(IN, I)
  792. C Convert CHARACTER string to INTEGER eqiuivalent
  793. C-----------------------------------------------------------------
  794. $INCLUDE KERDEF  (NLIST)
  795. $NLIST
  796.       INTEGER*2 IN(1),I,S
  797. 23000 IF(.NOT.(IN(I).EQ.32.OR.IN(I).EQ.9))GOTO 23001
  798.       I = I + 1
  799.       GOTO 23000
  800. 23001 CONTINUE
  801.       IF(.NOT.(IN(I).EQ.45.OR.IN(I).EQ.43))GOTO 23002
  802.       S = IN(I)
  803.       I = I + 1
  804.       GOTO 23003
  805. 23002 CONTINUE
  806.       S = 0
  807. 23003 CONTINUE
  808.       CHARTOI = 0
  809. 23004 IF(.NOT.(IN(I).NE.10002))GOTO 23006
  810.       IF(.NOT.(IN(I).LT.48.OR.IN(I).GT.57))GOTO 23007
  811.       GOTO 23006
  812. 23007 CONTINUE
  813.       CHARTOI = 10 * CHARTOI + IN(I) - 48
  814.       I = I + 1
  815.       GOTO 23004
  816. 23006 CONTINUE
  817.       IF(.NOT.(S .EQ. 45))GOTO 23009
  818.       CHARTOI = -CHARTOI
  819. 23009 CONTINUE
  820.       RETURN
  821.       END
  822. $NLIST
  823. C-----------------------------------------------------------------
  824.       INTEGER*2 FUNCTION CTL(T)
  825. C
  826. C  Toggle the control bit of a character so that, for example,
  827. C     Control-A becomes A, and vice-versa.
  828. C
  829. C     JL 4/18/83 14:50
  830. C-----------------------------------------------------------------
  831.       INTEGER T*2, TT*4
  832.       TT=T
  833.       CTL=IEOR(TT,64)  ;Flip the 7th Bit
  834.       RETURN
  835.       END
  836. $NLIST
  837. C-----------------------------------------------------------------
  838.       INTEGER*2 FUNCTION FINDLN(LIN,APAT,A1,Z1)
  839. C
  840. C     This function will try to find the pattern within a line
  841. C     It also returns pointers to the pattern's Begin/End characters.
  842. C     'A1' points to the character location where search is to
  843. C     begin.  The values returned in 'A1' and 'Z1' point to Begin/End
  844. C     characters of 'Found' pattern.  FINDLN=YES if pattern found,
  845. C     while FINDLIN=NO if pattern not found. (EOS is not included
  846. C    in A1 -> Z1 pattern pointers.)
  847. C
  848. C     LIN holds the line to search; APAT holds pattern to search for.
  849. C
  850. C     JL 4/18/84  14:50
  851. C-----------------------------------------------------------------
  852.       INTEGER*2 LIN(1),APAT(1),A1,Z1,STATUS,T1,T2,T3,FLAG
  853.       INTEGER NChars,NSigC
  854.       PARAMETER (NSigC=3)  ; Number Significant chars requ'd
  855. $INCLUDE KERDEF  (NLIST)
  856. $NLIST
  857.       NChars=0
  858.       STATUS=OK
  859.       T1=A1
  860. C Search until First char. of pattern matches a char. in line; exit
  861. C   when EOS is found.
  862.   100 IF (STATUS.EQ.OK)THEN  ;do forever, Break within loop
  863.   110    IF ((LIN(T1).NE.APAT(1)).AND.(LIN(T1).NE.EOS)) THEN
  864.             T1=T1+1
  865.             GOTO 110
  866.          ENDIF
  867.          IF(LIN(T1).EQ.EOS)THEN   ;we hit EOS on the line, no match
  868.             STATUS=NO
  869.          ELSE
  870.              A1=T1
  871.              T2=1
  872.              T3=T1
  873.              FLAG=NO
  874.   120        IF ((FLAG.EQ.NO).AND.(APAT(T2).NE.EOS)) THEN
  875.                 IF(APAT(T2).EQ.LIN(T1))THEN
  876.                    T1=T1+1
  877.                    T2=T2+1
  878.                    NChars = NChars + 1
  879.                 ELSE
  880.                     FLAG=YES ;we got partial matching , no exact
  881.                 ENDIF
  882.                 GOTO 120
  883.              ENDIF
  884.              IF(APAT(T2).EQ.EOS.OR.NChars.GE.NSigC)THEN
  885.                 Z1=T1-1
  886.                 STATUS=YES
  887.              ELSE
  888.                 T1=T3+1
  889.              ENDIF
  890.           ENDIF
  891.           NChars=0      ; Restart Sig Chars count
  892.           GOTO 100        ; Loop until EXIT
  893.       ENDIF
  894.       FINDLN=STATUS
  895.       RETURN
  896.       END
  897. $NLIST
  898. C-----------------------------------------------------------------
  899.       INTEGER*2 FUNCTION FLIP8BIT(T)
  900. C
  901. C     Toggle 8th bit of byte in low end of 'XCHAR'
  902. C
  903. C     PM 1/15/85 12:00
  904. C-----------------------------------------------------------------
  905.       INTEGER T*2, TT*4
  906.       TT=T
  907.       FLIP8BIT=IEOR(TT,128) ; Flip the 8th bit
  908.       RETURN
  909.       END
  910. $NLIST
  911. C---------------------------------------------------------------------
  912.       SUBROUTINE FLUSHBUF(CH)
  913. C
  914. C  -- Write remaining bytes in XLIN out to receiving file after EOF
  915. C     packet received in RDATA
  916. C          PM  4/22/86
  917. C---------------------------------------------------------------------
  918. $INCLUDE KERCOM (NLIST)
  919. $NLIST
  920. $INCLUDE KERDEF (NLIST)
  921. $NLIST
  922.       INTEGER*2 CH, BUFFCHAN(20), RECLCHAN(20), MAXCHAN, XFILL
  923.       INTEGER*4 RecLen,I
  924.       COMMON /IOUNIT/ PT,BUFFCHAN,RECLCHAN,MAXCHAN
  925.       COMMON /XBYTE/ XNEW, XCOUNT, XLIN(264), XEOF
  926.       IF (XCOUNT.GT.1) THEN    ;Fill only if Buffer not empty
  927.          RecLen=RECLCHAN(CH-1)
  928.          IF (FMode.EQ.TXTFILE) THEN
  929.             XFILL=BLANK   ; Spaces for ASCII file
  930.          ELSE
  931.             XFILL=0       ; Zeros for BINARY/CONTIG Fill
  932.          ENDIF
  933.          DO 100 I=XCOUNT,RecLen
  934.   100    XLIN(I) = XFILL
  935.          XCOUNT=I
  936.          XLIN(XCOUNT)=LF
  937.          XLIN(XCOUNT+1)=EOS
  938.          CALL DPUTLIN(FMode,XLIN,CH,RecLen)
  939.          XCOUNT=1
  940.       ENDIF
  941.       RETURN
  942.       END
  943. $NLIST
  944. C-----------------------------------------------------------------
  945.       INTEGER*2 FUNCTION GETCHAN(CHAN)
  946. C
  947. C     JL 4/25/84 13:35
  948. C-----------------------------------------------------------------
  949.       IMPLICIT INTEGER*2 (A-Z)
  950.       COMMON /IOUNIT/ PT,BUFFCHAN(20), RECLCHAN(20),MAXCHAN
  951. $INCLUDE KERDEF  (NLIST)
  952. $NLIST
  953.       IF(PT.GT.MAXCHAN)THEN
  954.          GETCHAN=BAD         ;already used-up all available channels
  955.       ELSE
  956.          GETCHAN=BUFFCHAN(PT)  ;there are more available channels
  957.          PT=PT+1
  958.       ENDIF
  959.       RETURN
  960.       END
  961. $NLIST
  962. C-----------------------------------------------------------------
  963.       INTEGER*2 FUNCTION IBMGETLIN(BUFFER,CH)
  964. C
  965. C     Read a packet with a SOH in it and wait for the prompt
  966. C     before returning it
  967. C
  968. C     BUFFER is an integer array that will hold the incoming packet
  969. C     CH tells this routine which channel to read the packet from
  970. C         (Used for interaction with IBM half-duplex lines)
  971. C
  972. C     JL 4/18/84 15:00
  973. C-----------------------------------------------------------------
  974. $INCLUDE KERCOM  (NLIST)
  975. $NLIST
  976. $INCLUDE KERDEF  (NLIST)
  977. $NLIST
  978.       INTEGER*2 BUFFER(132),CH,STATUS,GASOH,COUNT,T,IBYTE
  979.       INTEGER*2 TGETCH,X
  980.       STATUS=YES
  981.       GASOH=NO                       ;we have not gotten a packet yet
  982.       COUNT=1
  983.   100 IF (STATUS.EQ.YES) THEN
  984.   110     IF (GASOH.EQ.NO) THEN  ;keep reading one byte at a tim
  985.             IBYTE=0                  ;the I/O port until you see the
  986.             X=TGETCH(IBYTE,CH)       ;character , EOF is not expected
  987.             IF(IBYTE.EQ.SOH)THEN
  988.                GASOH=YES             ;I got the SOH
  989.                BUFFER(COUNT)=IBYTE   ;store the SOH into buffer
  990.                COUNT=COUNT+1         ;increment the buffer pointer
  991.             ENDIF
  992.             GOTO 110
  993.           ENDIF
  994.           IBYTE=0
  995.           X=TGETCH(IBYTE,CH)         ;read a byte from the I/O port
  996.           IF(IBYTE.EQ.PROMPT)THEN    ; we got the prompt
  997.              STATUS=NO
  998.           ELSE
  999.               BUFFER(COUNT)=IBYTE    ;it is not a prompt, but another
  1000.               COUNT=COUNT+1          ;data of the incoming packet
  1001.           ENDIF                      ;store it and increment pointer
  1002.           GOTO 100
  1003.       ENDIF
  1004.       BUFFER(COUNT)=EOS              ;add an EOS into end of buffer
  1005.       IBMGETLIN=OK
  1006.       RETURN
  1007.       END
  1008. $NLIST
  1009. C-----------------------------------------------------------------
  1010.       INTEGER*2 FUNCTION KGETLIN(BUFFER,CH)
  1011. C
  1012. C     read a packet with a SOH in it and DON'T wait for the prompt
  1013. C     before returning it
  1014. C
  1015. C     BUFFER is an integer array that will hold the incoming packet
  1016. C     CH tells this routine which channel to read the packet from
  1017. C
  1018. C     JL 4/18/84 15:00
  1019. C-----------------------------------------------------------------
  1020. $INCLUDE KERCOM  (NLIST)
  1021. $NLIST
  1022. $INCLUDE KERDEF  (NLIST)
  1023. $NLIST
  1024.       INTEGER*2 BUFFER(132),CH,STATUS,GASOH,COUNT,T,IBYTE
  1025.       INTEGER*2 TGETCH,X
  1026. C
  1027.       STATUS=YES
  1028.       GASOH=NO                       ;we have not gotten a packet yet
  1029.       COUNT=1
  1030.   100 IF (STATUS.EQ.YES) THEN
  1031.   110     IF (GASOH.EQ.NO) THEN  ;keep reading one byte at a tim
  1032.             IBYTE=0                  ;the I/O port until you see the
  1033.             X=TGETCH(IBYTE,CH)       ;character , EOF is not expected
  1034.             IF(IBYTE.EQ.SOH)THEN
  1035.                GASOH=YES             ;I got the SOH
  1036.                BUFFER(COUNT)=IBYTE   ;store the SOH into buffer
  1037.                COUNT=COUNT+1         ;increment the buffer pointer
  1038.             ENDIF
  1039.             GOTO 110
  1040.           ENDIF
  1041.           IBYTE=0
  1042.           X=TGETCH(IBYTE,CH)         ;read a byte from the I/O port
  1043.           IF(IBYTE.EQ.MYEOL)THEN     ;we got the required MYEOL
  1044.              STATUS=NO
  1045.           ELSE
  1046.               BUFFER(COUNT)=IBYTE    ;it is not MYEOL, but another
  1047.               COUNT=COUNT+1          ;data of the incoming packet
  1048.           ENDIF                      ;store it and increment pointer
  1049.          GOTO 100
  1050.       ENDIF
  1051.       BUFFER(COUNT)=EOS              ;add an EOS into end of buffer
  1052.       KGETLIN=OK
  1053.       RETURN
  1054.       END
  1055. $NLIST
  1056. C-----------------------------------------------------------------
  1057.       SUBROUTINE PACK(XFROM,XTO)
  1058. C
  1059. C     Pack the Filename from XFROM into character array XTO
  1060. C
  1061. C     JL 5/2/84 10:38
  1062. C-----------------------------------------------------------------
  1063.       INTEGER*2 XFROM(1),MAXLEN
  1064.       CHARACTER XTO*12, SPACES*12/' '/,TVCHAR*2
  1065.       INTEGER*2 FCOUNT,TCOUNT,TV
  1066.       EQUIVALENCE(TV,TVCHAR)
  1067. $INCLUDE KERDEF  (NLIST)
  1068. $NLIST
  1069.       FCOUNT=1       ;start with the first word of the XFROM array
  1070.       MAXLEN=12       ; Maximum file name length
  1071.       TCOUNT=1       ;start with the first word of the XTO array
  1072.       XTO=SPACES
  1073. C
  1074.   100 IF (XFROM(FCOUNT).NE.EOS)THEN   ;Do until EOS is detected
  1075.          TV=XFROM(FCOUNT)
  1076.          XTO(TCOUNT:TCOUNT)=TVCHAR(2:2)
  1077.          TCOUNT=TCOUNT+1
  1078.          FCOUNT=FCOUNT+1
  1079.          IF(TCOUNT.GT.MAXLEN) GOTO 900
  1080.          GOTO 100
  1081.       ENDIF
  1082.   900 RETURN
  1083.       END
  1084. $NLIST
  1085. C-----------------------------------------------------------------
  1086.       SUBROUTINE PARSER
  1087. C
  1088. C     The main parser at the command level: Search for
  1089. C         for Kermit commands & route to appropriate routine.
  1090. C      -- If LU 16 has been opened in .CSS, read initial settings
  1091. C         from it, else check for 'KERMIT.INI'.
  1092. C
  1093. C     PM 4/86
  1094. C     JL 4/18/84 17:00
  1095. C-----------------------------------------------------------------
  1096. $INCLUDE KERCOM  (NLIST)
  1097. $NLIST
  1098. $INCLUDE KERDEF  (NLIST)
  1099. $NLIST
  1100.       INTEGER*2   ICONNECT(8),IEXIT(5),IHELP(5),IQUIT(5)
  1101.       INTEGER*2   IRECEIVE(8),ISET(4),ISEND(5),ISTATUS(7),ISERVER(7)
  1102.       INTEGER*2   ALIN(132),BLIN(132),TV,STATUS,A1,Z1,INITIAL
  1103.       INTEGER*2 GETKEYBD,FINDLN,LFCR,XREAD,XWRITE,IniCH,X,CHARTOI
  1104.       INTEGER*2 IniFile(132), FLAG1
  1105.       INTEGER LUN, NRECS, IniLU
  1106.       LOGICAL TOBE, IniOPEN
  1107.       CHARACTER*12 CPROMPT
  1108. C
  1109.       DATA XREAD/0/, XWRITE/1/, IniLU/16/
  1110.       DATA LFCR/Z0A0D/, CPROMPT/'Kermit-CO>  '/
  1111.       DATA ICONNECT /67,79,78,78,69,67,84,10002/
  1112.       DATA IEXIT    /69,88,73,84,10002/
  1113.       DATA IHELP    /72,69,76,80,10002/
  1114.       DATA IQUIT    /81,85,73,84,10002/
  1115.       DATA IRECEIVE /82,69,67,69,73,86,69,10002/
  1116.       DATA ISET     /83,69,84,10002/
  1117.       DATA ISEND    /83,69,78,68,10002/
  1118.       DATA ISTATUS  /83,84,65,84,85,83,10002/
  1119.       DATA ISERVER  /83,69,82,86,69,82,10002/
  1120. C.......................PARSER until EXIT/QUIT.................
  1121.       IniFile(1)=BIGK
  1122.       IniFile(2)=BIGE
  1123.       IniFile(3)=BIGR
  1124.       IniFile(4)=BIGM
  1125.       IniFile(5)=BIGI
  1126.       IniFile(6)=BIGT
  1127.       IniFile(7)=PERIOD
  1128.       IniFile(8)=BIGI
  1129.       IniFile(9)=BIGN
  1130.       IniFile(10)=BIGI
  1131.       IniFile(11)=LF
  1132.       IniFile(12)=EOS
  1133.       STATUS=YES
  1134.       INITIAL=NO
  1135.  
  1136. C If LU 16 is opened in CSS, process commands from it
  1137.       LUN=IniLU
  1138.       INQUIRE(UNIT=LUN,OPENED=IniOPEN,SIZE=NRECS) ;Ini file in CSS?
  1139.       LUN=LOCALOUTFD
  1140.       IF (IniOPEN) THEN
  1141.          IniCH = IniLU
  1142.          INITIAL=YES     ; Enable Startup initialization
  1143.          WRITE(LUN,1210)  ; Flash User msg
  1144.       ELSE
  1145.          INQUIRE(FILE='KERMIT.INI',EXIST=TOBE) ;Check default .INI
  1146.          IF (TOBE) THEN
  1147.             IniCH=AOPEN(TXTFILE,IniFile,XREAD)
  1148.             IF (IniCH.EQ.BAD) THEN
  1149.                WRITE(20,*) 'PARSER - Cant open KERMIT.INI'
  1150.                INITIAL=NO
  1151.             ELSE
  1152.                INITIAL=YES     ; Enable Startup initialization
  1153.                WRITE(LUN,1200)  ; Flash User msg
  1154.             ENDIF
  1155.          ENDIF
  1156.       ENDIF
  1157.  
  1158. C ...............................Process KERMIT commands
  1159.   100 IF (STATUS.EQ.YES) THEN
  1160.          IF (INITIAL.EQ.YES) THEN    ; Commands from .INI file
  1161.             TV=DGETLIN(TXTFILE,ALIN,IniCH)
  1162.             IF (TV.EQ.EOF) THEN
  1163.                IF (IniCH.EQ.IniLU) THEN
  1164.                   CLOSE(IniLU)      ; CSS open file
  1165.                ELSE
  1166.                   CALL RATCLOSE(IniCH)  ;Close Internal file channel
  1167.                ENDIF
  1168.                INITIAL=NO      ; End Initialization
  1169.                CALL PUTSTRNG(LOCALOUTFD,2,LFCR)
  1170.                GOTO 100    ; Start in on console now
  1171.             ENDIF
  1172.             CALL PUTSTRNG(LOCALOUTFD,2,LFCR)  ;Send LF,CR to Display
  1173.             CALL PUTLIN(ALIN,LOCALOUTFD)  ; Show command line
  1174.          ELSE
  1175.             CALL PUTSTRNG(LOCALOUTFD,2,LFCR)  ;Send LF,CR to Display
  1176.             CALL PUTSTRNG(LOCALOUTFD,10,CPROMPT)  ;Prompt
  1177.             TV=GETKEYBD(ALIN,LOCALINFD) ;read line from local keyboard
  1178.          ENDIF
  1179.  
  1180.          IF (ALIN(1).EQ.LF) GOTO 100  ; Nothing input, repeat prompt
  1181.          CALL UPPER(ALIN,BLIN)        ;converts it to uppercase
  1182.  
  1183.          A1=1
  1184.          FLAG1=FINDLN(BLIN,ISEND,A1,Z1)   ; SEND
  1185.          IF (FLAG1.EQ.YES) THEN
  1186.             CALL SSEND(BLIN)
  1187.             GOTO 100
  1188.          ENDIF
  1189.  
  1190.          A1=1
  1191.          FLAG1=FINDLN(BLIN,ISET,A1,Z1)    ; SET
  1192.          IF (FLAG1.EQ.YES) THEN
  1193.             CALL SSET(BLIN)
  1194.             GOTO 100
  1195.          ENDIF
  1196.  
  1197.          A1=1
  1198.          FLAG1=FINDLN(BLIN,IEXIT,A1,Z1)   ; EXIT
  1199.          IF (FLAG1.EQ.YES) THEN
  1200.             RETURN   ; Back to Mainline
  1201.          ENDIF
  1202.  
  1203.          A1=1
  1204.          FLAG1=FINDLN(BLIN,IHELP,A1,Z1)   ; HELP
  1205.          IF (FLAG1.EQ.YES) THEN
  1206.             CALL SHELP
  1207.             GOTO 100
  1208.          ENDIF
  1209.  
  1210.          A1=1
  1211.          FLAG1=FINDLN(BLIN,IQUIT,A1,Z1)   ; QUIT
  1212.          IF (FLAG1.EQ.YES) THEN
  1213.             RETURN   ;Back to Mainline
  1214.          ENDIF
  1215.  
  1216.          A1=1
  1217.          FLAG1=FINDLN(BLIN,ISTATUS,A1,Z1) ; STATUS
  1218.          IF (FLAG1.EQ.YES) THEN
  1219.             CALL SSTATUS
  1220.             GOTO 100
  1221.          ENDIF
  1222.  
  1223.          A1=1
  1224.          FLAG1=FINDLN(BLIN,ISERVER,A1,Z1) ; SERVER
  1225.          IF (FLAG1.EQ.YES) THEN
  1226.             CALL SSERVER
  1227.             GOTO 100
  1228.          ENDIF
  1229.  
  1230.          A1=1
  1231.          FLAG1=FINDLN(BLIN,IRECEIVE,A1,Z1) ; RECEIVE
  1232.          IF (FLAG1.EQ.YES) THEN
  1233.             X=0
  1234.             A1=Z1+1
  1235.             CALL SKIPBL(BLIN,A1)
  1236.             X=CHARTOI(BLIN,A1)  ; Get Rec len if on command line
  1237.             CALL SRECEIVE(X)
  1238.             GOTO 100
  1239.          ENDIF
  1240.  
  1241.          A1=1
  1242.          FLAG1=FINDLN(BLIN,ICONNECT,A1,Z1)   ; CONNECT
  1243.          IF (FLAG1.EQ.YES) THEN
  1244.             CALL SCONNECT
  1245.             GOTO 100
  1246.          ENDIF
  1247.  
  1248.          WRITE(LUN,1000)   ; Command not recognized
  1249.          GOTO 100
  1250.          ENDIF
  1251.       RETURN
  1252.  1000 FORMAT(/' Unrecognized command (Type HELP for ideas)')
  1253.  1200 FORMAT(/' Initializing from KERMIT.INI...')
  1254.  1210 FORMAT(/' Initializing from User file...')
  1255.       END
  1256. $NLIST
  1257. C-----------------------------------------------------------------
  1258.       SUBROUTINE PUTCHAN(CHAN)
  1259. C
  1260. C     JL 4/25/84 13:35
  1261. C-----------------------------------------------------------------
  1262.       IMPLICIT INTEGER*2 (A-Z)
  1263.       COMMON /IOUNIT/ PT,BUFFCHAN(20), RECLCHAN(20),MAXCHAN
  1264. $INCLUDE KERDEF  (NLIST)
  1265. $NLIST
  1266.       IF(PT.LE.1)RETURN    ;no channel was allocated at all
  1267.       PT=PT-1
  1268.       BUFFCHAN(PT)=CHAN
  1269.       RETURN
  1270.       END
  1271. $NLIST
  1272. C-----------------------------------------------------------------
  1273.       SUBROUTINE RATCLOSE(CH)
  1274. C
  1275. C  Close that channel and return it to the channel pool
  1276. C
  1277. C     JL 4/25/84 13:50
  1278. C-----------------------------------------------------------------
  1279.       INTEGER*2 CH,IOS
  1280.       IF (CH.GT.0) THEN
  1281.          CALL PUTCHAN(CH)
  1282.          CLOSE(CH)
  1283.       ENDIF
  1284.       RETURN
  1285.       END
  1286. $NLIST
  1287. C-----------------------------------------------------------------
  1288.       INTEGER*2 FUNCTION RDATA(X)
  1289. C
  1290. C     Read a data packet from the other KERMIT
  1291. C
  1292. C     JL 4/18/84 15:05
  1293. C-----------------------------------------------------------------
  1294. $INCLUDE KERCOM  (NLIST)
  1295. $NLIST
  1296. $INCLUDE KERDEF  (NLIST)
  1297. $NLIST
  1298.       INTEGER*2 NUM,LEN,STATUS,X,RPACK,TNUM
  1299.       INTEGER*2 TV1,TV2,TV3,TV4,NMinus
  1300.       INTEGER ITEMP,LUN
  1301. C
  1302.       IF(NUMTRY.GT.MAXTRY)THEN
  1303.          WRITE(20,*) 'RDATA - MAXTRY exceeded '
  1304.          RDATA=BIGA                ;exceeded maxtry , gives up
  1305.          CALL RATCLOSE(FD)
  1306.          RETURN
  1307.       ELSE
  1308.           NUMTRY=NUMTRY+1          ;try it again
  1309.       ENDIF
  1310.       STATUS=RPACK(LEN,NUM,PACKET) ;read a packet
  1311.  
  1312. C Get (N-1) modulo'd properly for comparison with NUM (D.MacPhee)
  1313.       IF (N.EQ.0) THEN
  1314.          NMinus = 63
  1315.       ELSE
  1316.          NMinus = N - 1
  1317.       ENDIF
  1318.  
  1319.       IF(HOSTON.EQ.NO)THEN         ;if we are running in remote
  1320.          LUN=LOCALOUTFD
  1321.          WRITE(LUN,100)NUM           ;mode the diepay packet #
  1322.       ENDIF
  1323.       IF(STATUS.EQ.BIGD)THEN       ;we got the data packet
  1324.          IF(NUM.NE.N)THEN
  1325.             IF(OLDTRY.GT.MAXTRY)THEN
  1326.                RDATA=BIGA
  1327.                CALL RATCLOSE(FD)
  1328.                WRITE(20,*) ' RDATA - MAXTRY exceeded - 2nd test'
  1329.                RETURN
  1330.             ELSE
  1331.                OLDTRY=OLDTRY+1
  1332.             ENDIF
  1333.             IF(NUM.EQ.NMinus)THEN   ; We got a duplicated packet
  1334.                TV1=BIGY            ;just ACK it
  1335.                TV2=0
  1336.                TV3=0
  1337.                CALL SPACK(TV1,NUM,TV2,TV3)
  1338.                NUMTRY=0
  1339.                RDATA=STATE
  1340.                RETURN
  1341.             ELSE
  1342.                 RDATA=BIGA
  1343.                 WRITE(20,*) ' RDATA - NUM ne (N-1) - State = ',STATE
  1344.                 CALL RATCLOSE(FD)
  1345.                 RETURN
  1346.             ENDIF
  1347.          ENDIF
  1348.          CALL BUFEMP(PACKET,LEN)  ;write the data packet just receive
  1349.          TNUM=N                   ;into the receiving disk file
  1350.          TV1=BIGY
  1351.          TV2=TNUM
  1352.          TV3=0
  1353.          TV4=0
  1354.          CALL SPACK(TV1,TV2,TV3,TV4) ;ACK the just received packet
  1355.          OLDTRY=NUMTRY
  1356.          NUMTRY=0
  1357.          ITEMP=N+1
  1358.          N=MOD(ITEMP,64)
  1359.          RDATA=BIGD
  1360.          RETURN
  1361.       ELSE IF(STATUS.EQ.BIGF)THEN     ;the packet is the file header
  1362.               IF(OLDTRY.GT.MAXTRY)THEN   ;we should have already got
  1363.                  RDATA=BIGA     ;exceeded number of retry, give up
  1364.                  CALL RATCLOSE(FD)
  1365.                  WRITE(20,*) ' RDATA - MAXTRY exceeded - Status = F'
  1366.                  RETURN
  1367.               ELSE
  1368.                  OLDTRY=OLDTRY+1
  1369.               ENDIF
  1370.               IF(NUM.EQ.NMinus)THEN    ;we got duplicate file header
  1371.                  TV1=BIGY
  1372.                  TV2=0
  1373.                  TV3=0
  1374.                  CALL SPACK(TV1,NUM,TV2,TV3)  ;just ACK it
  1375.                  NUMTRY=0
  1376.                  RDATA=STATE
  1377.                  RETURN
  1378.               ELSE
  1379.                  RDATA=BIGA
  1380.                  WRITE(20,*) ' RDATA - NUM .NE. (N-1) - Status = F'
  1381.                  CALL RATCLOSE(FD)
  1382.                  RETURN
  1383.               ENDIF
  1384.       ELSE IF(STATUS.EQ.BIGZ)THEN          ;we got the EOF packet
  1385.               IF(NUM.NE.N)THEN
  1386.                  WRITE(20,*) ' RDATA - NUM .NE. N - Status = Z'
  1387.                  RDATA=BIGA
  1388.                  CALL RATCLOSE(FD)
  1389.                  RETURN
  1390.               ENDIF
  1391.               TNUM=N
  1392.               TV1=BIGY
  1393.               TV2=0
  1394.               TV3=0
  1395.               CALL SPACK(TV1,TNUM,TV2,TV3)  ;ACK it
  1396.               CALL FLUSHBUF(FD)     ;Flush XLIN buffer
  1397.               CALL RATCLOSE(FD)          ;close the receiving disk fi
  1398.               ITEMP=N+1
  1399.               N=MOD(ITEMP,64)
  1400.               RDATA=BIGF                 ;change the state to look fo
  1401.               RETURN                     ;another file header
  1402.       ELSE IF(STATUS.EQ.BAD)THEN
  1403.               WRITE(20,*) ' RDATA - Status BAD - CHKSUM error?'
  1404.               RDATA=STATE                ;there was an error in the
  1405.               TNUM=N                     ;checksum
  1406.               TV1=BIGN
  1407.               TV2=0
  1408.               TV3=0
  1409.               CALL SPACK(TV1,TNUM,TV2,TV3)  ;NAK it
  1410.               RETURN
  1411.       ELSE
  1412.           RDATA=BIGA                  ;we got a unknown packet type
  1413.           WRITE(20,*) ' RDATA - UNKNOWN PACKET - Status = A'
  1414.           CALL RATCLOSE(FD)
  1415.       ENDIF                           ;gives up
  1416.       RETURN
  1417. 100   FORMAT(' ','Packet # ',I4)
  1418.       END
  1419. $NLIST
  1420. C-----------------------------------------------------------------
  1421.       INTEGER*2 FUNCTION RECSW(X)
  1422. C
  1423. C     Receive a file or a group of files from the other KERMIT
  1424. C
  1425. C     JL 4/18/84 17:06
  1426. C-----------------------------------------------------------------
  1427. $INCLUDE KERCOM  (NLIST)
  1428. $NLIST
  1429. $INCLUDE KERDEF  (NLIST)
  1430. $NLIST
  1431.       COMMON /XBYTE/ XNEW,XCOUNT,XLIN(264),XEOF
  1432.       INTEGER*2 X,RDATA,RFILE,RINIT,STATUS
  1433.       INTEGER*2 TV1,TV2,TV3,TV4
  1434.       STATUS=YES
  1435.       STATE=BIGR
  1436.       XNEW=YES
  1437.       XCOUNT=1
  1438.       N=0
  1439.       NUMTRY=0
  1440.   100 IF (STATUS.EQ.YES) THEN
  1441.            IF(STATE.EQ.BIGD)THEN          ;read a DATA packet
  1442.               STATE=RDATA(X)
  1443.            ELSE IF(STATE.EQ.BIGR)THEN     ;read a SINIT packet
  1444.                    STATE=RINIT(X)
  1445.            ELSE IF(STATE.EQ.BIGF)THEN     ;read a file header
  1446.                    STATE=RFILE(X)
  1447.            ELSE IF(STATE.EQ.BIGC)THEN     ;file transfer compl
  1448.                    RECSW=YES
  1449.                    RETURN
  1450.            ELSE IF(STATE.EQ.BIGA)THEN     ;we got an error
  1451.                    RECSW=NO
  1452.                    TV1=BIGE
  1453.                    TV2=N
  1454.                    TV3=0
  1455.                    TV4=0
  1456.                    CALL SPACK(TV1,TV2,TV3,TV4)  ;send ERROR packet
  1457.                    RETURN                    ;file channel
  1458.            ENDIF
  1459.            GOTO 100
  1460.       ENDIF
  1461.       RETURN
  1462.       END
  1463. $NLIST
  1464. C-----------------------------------------------------------------
  1465.       SUBROUTINE REMOVE(FNAME)
  1466. C
  1467. C     JL 4/25/84 13:43
  1468. C-----------------------------------------------------------------
  1469.       INTEGER*2 FNAME(1),TFILE(13),IERR
  1470.       INTEGER*2 COUNT,MAXLEN,XLENGTH
  1471.       CHARACTER INAME*12
  1472. $INCLUDE KERDEF  (NLIST)
  1473. $NLIST
  1474.       MAXLEN=12     ;CCC OS/32 uses a max. filename length of 12
  1475.       COUNT=1
  1476. C
  1477.   100 IF ((FNAME(COUNT).NE.LF).AND. ;determine length of filenam
  1478.      +         (FNAME(COUNT).NE.EOS)) THEN
  1479.          TFILE(COUNT)=FNAME(COUNT)
  1480.          COUNT=COUNT+1
  1481.          GOTO 100
  1482.       ENDIF
  1483. C
  1484.       IF(COUNT.LE.MAXLEN)THEN            ;fill up rest with trailing
  1485.   200    IF (COUNT.LE.MAXLEN) THEN
  1486.             TFILE(COUNT)=BLANK
  1487.             COUNT=COUNT+1
  1488.             GOTO 200
  1489.          ENDIF
  1490.       ENDIF
  1491. C                                        ;pack the filename string
  1492.       TFILE(MAXLEN+1)=EOS
  1493.       CALL PACK(TFILE,INAME)
  1494.       OPEN(40,FILE=INAME,STATUS='OLD',ERR=111)
  1495.       CLOSE(40,STATUS='DELETE')
  1496.       RETURN
  1497. 111   CONTINUE
  1498.       RETURN
  1499.       END
  1500. $NLIST
  1501. C-----------------------------------------------------------------
  1502.       INTEGER*2 FUNCTION RFILE(X)
  1503. C
  1504. C     Read a file header packet from the other KERMIT
  1505. C
  1506. C     JL 4/18/84 17:08
  1507. C-----------------------------------------------------------------
  1508. $INCLUDE KERCOM  (NLIST)
  1509. $NLIST
  1510. $INCLUDE KERDEF  (NLIST)
  1511. $NLIST
  1512.       INTEGER*2 NUM,LEN,STATUS,RPACK,X,TNUM,AOPEN
  1513.       INTEGER*2 TV1,TV2,TV3,TV4,XWRITE,NMinus
  1514.       INTEGER ITEMP,LUN
  1515.       CHARACTER*12 FileName
  1516.       XWRITE=1
  1517.       IF(NUMTRY.GT.MAXTRY)THEN
  1518.          WRITE(20,*) ' RFILE - MAXTRY exceeded - BIGA '
  1519.          RFILE=BIGA                       ;exceeded max. # of re-try
  1520.          RETURN                           ;gives up
  1521.       ELSE
  1522.          NUMTRY=NUMTRY+1
  1523.       ENDIF
  1524.       STATUS=RPACK(LEN,NUM,PACKET)
  1525.  
  1526. C Calc N-1, properly Modulo'd, for compare with NUM  (D.MacPhee)
  1527.       IF (N.EQ.0) THEN
  1528.          NMinus = 63
  1529.       ELSE
  1530.          NMinus = N - 1
  1531.       ENDIF
  1532.  
  1533.       IF(STATUS.EQ.BIGS)THEN              ;we got a SINIT packet
  1534.          IF(OLDTRY.GT.MAXTRY)THEN
  1535.             WRITE(20,*) 'RFILE - MAXTRY exceeded (1) - Status = A'
  1536.             RFILE=BIGA                    ;re-try it again
  1537.             RETURN
  1538.          ELSE
  1539.             OLDTRY=OLDTRY+1
  1540.          ENDIF
  1541.          IF(NUM.EQ.NMinus)THEN             ;we already got the SINIT
  1542.             CALL SPAR(PACKET)            ;packet, get my file-transfer
  1543.             TV1=BIGY                      ;requirement/parameters
  1544.             TV2=9
  1545.             CALL SPACK(TV1,NUM,TV2,PACKET)   ;ACK it
  1546.             NUMTRY=0
  1547.             RFILE=STATE
  1548.             RETURN
  1549.          ELSE
  1550.              WRITE(20,*) ' RFILE - Unexpected Seq No 1 - Status=A'
  1551.              RFILE=BIGA                   ;unexpected sequence #
  1552.              RETURN                       ;gives up
  1553.          ENDIF
  1554.       ELSE IF(STATUS.EQ.BIGZ)THEN         ;we got a EOF packet
  1555.               IF(OLDTRY.GT.MAXTRY)THEN
  1556.                  RFILE=BIGA               ;exceeded max # of re-try
  1557.                  WRITE(20,*) ' RFILE - MAXTRY exceeded (2) - Status=A'
  1558.                  RETURN                   ;gives up
  1559.               ELSE
  1560.                  OLDTRY=OLDTRY+1         ;re-try one more time
  1561.               ENDIF
  1562.               IF(NUM.EQ.NMinus)THEN
  1563.                  TV1=BIGY                 ;we already got the EOF pac
  1564.                  TV2=0
  1565.                  TV3=0
  1566.                  CALL SPACK(TV1,NUM,TV2,TV3) ;just ACK it
  1567.                  NUMTRY=0
  1568.                  RFILE=STATE
  1569.                  RETURN
  1570.               ELSE
  1571.                   RFILE=BIGA              ;unexpected sequence #
  1572.                   WRITE(20,*) ' RFILE - Unexpected Seq No (2) - A'
  1573.                   RETURN
  1574.               ENDIF
  1575.       ELSE IF(STATUS.EQ.BIGF)THEN ;got file header packet
  1576.               IF(NUM.NE.N)THEN
  1577.                  RFILE=BIGA               ;unexpected sequence #,give
  1578.                  WRITE(20,*) ' RFILE - Unexpected Seq No (3) - A'
  1579.                  RETURN
  1580.               ENDIF
  1581.               PACKET(LEN+1)=LF            ;packet(len) has the incomi
  1582.               PACKET(LEN+2)=EOS           ;filename packet
  1583.               CALL VERIFY(PACKET) ;verify incoming filename
  1584.               IF(HOSTON.EQ.NO)THEN
  1585.                  LUN=LOCALOUTFD
  1586.                  CALL PACK(PACKET,FileName)
  1587.                  WRITE(LUN,*) 'Receiving file--> ',FileName
  1588.               ENDIF
  1589.               FD=AOPEN(FMode,PACKET,XWRITE)     ;open file for writing
  1590.               IF(FD.EQ.BAD)THEN
  1591.                  RFILE=BIGA               ;we got a ERR in opening th
  1592.                  WRITE(20,*) ' RFILE - BAD File OPEN - Status = A'
  1593.                  RETURN
  1594.               ENDIF
  1595.               TNUM=N
  1596.               TV1=BIGY
  1597.               TV2=0
  1598.               TV3=0
  1599.               CALL SPACK(TV1,TNUM,TV2,TV3) ;ACK the file header packet
  1600.               OLDTRY=NUMTRY
  1601.               NUMTRY=0
  1602.               ITEMP=N+1
  1603.               N=MOD(ITEMP,64)
  1604.               RFILE=BIGD                 ;change state to look for DA
  1605.               RETURN                     ;packet
  1606.       ELSE IF(STATUS.EQ.BIGB)THEN        ;we got a BREAK transmission
  1607.               IF(NUM.NE.N)THEN
  1608.                  RFILE=BIGA
  1609.                  WRITE(20,*) ' RFILE - NUM.NE.N - Status = A/B'
  1610.                  RETURN
  1611.               ENDIF
  1612.               TNUM=N
  1613.               TV1=BIGY
  1614.               TV2=0
  1615.               TV3=0
  1616.               CALL SPACK(TV1,TNUM,TV2,TV3) ;ACK the BREAK packet
  1617.               RFILE=BIGC                ;change state to complete sta
  1618.               RETURN
  1619.       ELSE IF(STATUS.EQ.BAD)THEN        ;we got an error on the check
  1620.               RFILE=STATE
  1621.               TNUM=N
  1622.               TV1=BIGN
  1623.               TV2=0
  1624.               TV3=0
  1625.               CALL SPACK(TV1,TNUM,TV2,TV3) ;NAK it
  1626.               RETURN
  1627.       ELSE
  1628.           RFILE=BIGA     ;unexpected packet type, give up
  1629.           WRITE(20,*) 'RFILE - UNKNOWN PACKET - Status = A'
  1630.       ENDIF
  1631.       RETURN
  1632.       END
  1633. $NLIST
  1634. C-----------------------------------------------------------------
  1635.       INTEGER*2 FUNCTION RINIT(X)
  1636. C
  1637. C     Receive the initial packet from the remote KERIT
  1638. C
  1639. C     JL 4/18/84 17:10
  1640. C-----------------------------------------------------------------
  1641. $INCLUDE KERCOM  (NLIST)
  1642. $NLIST
  1643. $INCLUDE KERDEF  (NLIST)
  1644. $NLIST
  1645.       INTEGER*2 LEN,NUM,STATUS,RPACK,X,TNUM
  1646.       INTEGER*2 TV1,TV2,TV3,TV4
  1647.       INTEGER ITEMP
  1648.       IF(NUMTRY.GT.MAXTRY)THEN
  1649.          RINIT=BIGA                        ;exceeded max. # of re-try
  1650.          WRITE(20,*) ' RINIT - MAXTRY exceeded - Status = A'
  1651.          RETURN               ;gives up
  1652.       ELSE
  1653.           NUMTRY=NUMTRY+1     ;try-it again
  1654.       ENDIF
  1655.       DO 100 I=1,40
  1656.          PACKET(I)=0
  1657.   100 CONTINUE
  1658.       STATUS=RPACK(LEN,NUM,PACKET)         ;read a packet
  1659.       IF(STATUS.EQ.BIGS)THEN               ;we got a SINIT packet
  1660.          CALL RPAR(PACKET)     ;store other KERMIT's requirements
  1661.          CALL SPAR(PACKET)                 ;get our parameters/requir
  1662.          TNUM=N
  1663.          TV1=BIGY
  1664.          TV2=9
  1665.          CALL SPACK(TV1,TNUM,TV2,PACKET)   ;send out requirement and
  1666.          OLDTRY=NUMTRY                     ;ACK it on one shot
  1667.          NUMTRY=0
  1668.          ITEMP=N+1
  1669.          N=MOD(ITEMP,64)
  1670.          RINIT=BIGF                        ;change state to look for
  1671.          RETURN                            ;the file header packet
  1672.       ELSE IF(STATUS.EQ.BAD)THEN           ;we got a checksum error
  1673.            RINIT=STATE
  1674.            TNUM=N
  1675.            TV1=BIGN
  1676.            TV2=0
  1677.            TV3=0
  1678.            CALL SPACK(TV1,TNUM,TV2,TV3)    ;NAK it
  1679.            RETURN
  1680.       ELSE
  1681.            RINIT=BIGA                       ;we got an unexpected pack
  1682.            WRITE(20,*) ' RINIT - Unexpected Packet type - Status = A'
  1683.       ENDIF                                ;type, gives up
  1684.       RETURN
  1685.       END
  1686. $NLIST
  1687. C-----------------------------------------------------------------
  1688.       INTEGER*2 FUNCTION RPACK(LEN,NUM,XDATA)
  1689. C
  1690. C     Read a packet from other KERMIT
  1691. C
  1692. C     JL 4/18/84 17:10
  1693. C-----------------------------------------------------------------
  1694. $INCLUDE KERCOM  (NLIST)
  1695. $NLIST
  1696. $INCLUDE KERDEF  (NLIST)
  1697. $NLIST
  1698. *$TEST
  1699.       INTEGER*2 LEN,NUM,CH
  1700.       INTEGER*2 GETLIN,IBMGETLIN,T
  1701.       INTEGER*2 XDATA(132)
  1702.       INTEGER*2 I,COUNT,STATUS,UNCHAR,J,K,XCOUNT
  1703.       INTEGER*2 TV2,TV3,CHKSUM2
  1704.       INTEGER TV1, ITEMP, CHKSUM
  1705.       INTEGER*2 BUFFER(132),XTYPE,GAPTRY,MGAPTRY
  1706.       CH=RMTINFD                        ;this is the input channel to
  1707.       GAPTRY=1
  1708.       MGAPTRY=1     ; (Number of <CR>s need for to get re-transmit
  1709.       CHKSUM=0
  1710. C
  1711. C Read a packet that begins with a SOH and ends with MYEOL
  1712.   100 IF (GAPTRY.LE.MGAPTRY) THEN
  1713.          IF(IBMON.EQ.YES)THEN
  1714.             STATUS=IBMGETLIN(BUFFER,CH) ;get a packet and waits for t
  1715.          ELSE                           ;prompt
  1716.             STATUS=GETLIN(BUFFER,CH)    ;get a packet without waitin
  1717.          ENDIF                          ;for a prompt
  1718. C........................................UPDATE 9/15/85
  1719. C   ********(TEST WITH THIS CODE HUNG THE PROGRAM
  1720. C***********(CHECK USED OF   EOF   IN OTHER PARTS)  10/25/85
  1721. C     Check for bad packet and reject if so
  1722.          IF (STATUS.EQ.EOF) THEN
  1723.             RPACK=BAD               ; Reject on bad GETLIN
  1724.             RETURN
  1725.          ENDIF
  1726. C........................................END UPDATE 9/15/85
  1727.          COUNT=1
  1728. C        skips all other characters until we see one with a SOH in it
  1729. C
  1730.   200    IF ((BUFFER(COUNT).NE.SOH).AND.(BUFFER(COUNT).NE.EOS)) THEN
  1731.             COUNT=COUNT+1               ;wait for a SOH or EOS
  1732.             GOTO 200
  1733.          ENDIF
  1734.          IF(BUFFER(COUNT).EQ.SOH)THEN   ;Got the SOH
  1735.             K=COUNT+1
  1736.             CHKSUM=BUFFER(K)
  1737.             LEN=UNCHAR(BUFFER(K))-3     ;get the length of the packet
  1738.             K=K+1
  1739.             CHKSUM=CHKSUM+BUFFER(K)
  1740.             NUM=UNCHAR(BUFFER(K))   ;Get Frame Packet Seq Number
  1741.             K=K+1
  1742.             XTYPE=BUFFER(K)             ;get the data type
  1743.             CHKSUM=CHKSUM+BUFFER(K)
  1744.             K=K+1
  1745. C
  1746. C    Zero out XDATA array; Get the data
  1747.             DO 300 I=1,132
  1748.   300       XDATA(I)=0
  1749.             DO 400 J=1,LEN
  1750.             XDATA(J)=BUFFER(K)
  1751.             CHKSUM=CHKSUM+BUFFER(K)
  1752.             K=K+1
  1753.             COUNT=J
  1754.   400       CONTINUE
  1755.             XDATA(COUNT+1)=EOS
  1756.             T=BUFFER(K)
  1757. C
  1758. C   Calculate the checksum of Incoming Packet.
  1759.             TV1=IAND(CHKSUM,192)
  1760.             ITEMP=CHKSUM+(TV1/64)
  1761.             CHKSUM2=IAND(ITEMP,63)
  1762. C
  1763. C   Does the checksum match?
  1764.             IF(CHKSUM2.NE.UNCHAR(T))THEN
  1765.                IF (DEBUGON.EQ.YES) THEN
  1766.                    WRITE(20,*) ' RPACK- CALC CHKSM - ',CHKSUM2
  1767.                    WRITE(20,*) '  RCVD CHKSUM- ',T,' REC NO - ',NUM
  1768.                ENDIF
  1769.                RPACK=BAD                ;bad checksum
  1770.                RETURN
  1771.             ELSE
  1772.                RPACK=XTYPE
  1773.                RETURN
  1774.             ENDIF
  1775.          ENDIF
  1776.  
  1777. C  We got the EOS, the packet has no SOH, read another one
  1778.          GAPTRY=GAPTRY+1
  1779.          IF(DEBUGON.EQ.YES)WRITE(20,*) 'RPACK - No SOH GAP ',GAPTRY
  1780.          GOTO 100          ; Loop Till EOS
  1781.       ENDIF
  1782.       RPACK=BAD
  1783.       RETURN
  1784.       END
  1785. $NLIST
  1786. C-----------------------------------------------------------------
  1787.       SUBROUTINE RPAR(XDATA)
  1788. C
  1789. C     Store the other KERMIT's file transfer requirement away
  1790. C
  1791. C     JL 4/18/84 17:13
  1792. C-----------------------------------------------------------------
  1793. $INCLUDE KERCOM  (NLIST)
  1794. $NLIST
  1795. $INCLUDE KERDEF  (NLIST)
  1796. $NLIST
  1797.       INTEGER*2 XDATA(1),UNCHAR,CTL,ITEMP
  1798.       I=1                        ; Use Relative index
  1799.       IF(XDATA(I).EQ.0)THEN      ; IF no packet size sent by other
  1800.          SPSIZ=PAKSIZ            ; KERMIT, use local KERMIT default
  1801.       ELSE
  1802.          SPSIZ=UNCHAR(XDATA(I))
  1803.       ENDIF
  1804.       SPSIZADJ = SPSIZ-6   ;Size adjusted for Seq,Siz,Type (BUFFILL)
  1805.       IF(XDATA(I+1).NE.0)TIMEOUT=UNCHAR(XDATA(I+1))
  1806.       IF(XDATA(I+2).NE.0)PAD=UNCHAR(XDATA(I+2))
  1807.       IF(XDATA(I+3).NE.0)PADCHAR=CTL(XDATA(I+3))
  1808.       IF(XDATA(I+4).NE.0)EOL=UNCHAR(XDATA(I+4))
  1809.       IF(XDATA(I+5).NE.0)QUOTE=XDATA(I+5)
  1810. C
  1811. C Establish whether remote Kermit will do 8-Bit prefixing
  1812.       ITEMP=XDATA(I+6)
  1813.       QUOT8B=NO      ; Assume it won't
  1814.       IF (MYQUOT8B.EQ.NO) GOTO 999 ;If not set, No 8-Bit quoting
  1815.       IF (ITEMP.EQ.BIGN) GOTO 999 ; Remote refuses to 8-Bit prefix
  1816.       IF (ITEMP.EQ.BIGY) THEN
  1817.          QUOT8B=YES     ; Remote will do 8-bit quoting
  1818.          GOTO 999
  1819.       ENDIF
  1820.       IF (((BANG.LE.ITEMP).AND.(ITEMP.LT.QMARK)) .OR.  ; 33-62?
  1821.      &   ((ITEMP.GT.LETA).AND.(TILDE.GE.ITEMP))) THEN  ; 96-126?
  1822.           Q8BCHR=ITEMP      ; Use this as 8 Bit Quote
  1823.           QUOT8B=YES
  1824.       ENDIF
  1825.   999 RETURN
  1826.       END
  1827. $NLIST
  1828. C-----------------------------------------------------------------
  1829.       INTEGER*2 FUNCTION SBREAK(X)
  1830. C
  1831. C  Send the break packet to signify the end of transmissions
  1832. C
  1833. C     JL 4/18/84 17:15
  1834. C-----------------------------------------------------------------
  1835. $INCLUDE KERCOM  (NLIST)
  1836. $NLIST
  1837. $INCLUDE KERDEF  (NLIST)
  1838. $NLIST
  1839.       INTEGER*2 NUM,LEN,RPACK,STATUS,X,TNUM
  1840.       INTEGER*2 TV1,TV2,TV3
  1841.       INTEGER ITEMP
  1842.       IF(NUMTRY.GT.MAXTRY)THEN
  1843.          SBREAK=BIGA       ; exceeded max. no. Retries
  1844.          WRITE(20,*) ' SBREAK - MAXTRY exceeded - Status = A'
  1845.          RETURN                               ;gives up
  1846.       ELSE
  1847.           NUMTRY=NUMTRY+1                     ;try it again
  1848.       ENDIF
  1849. C
  1850.       TNUM=N
  1851.       TV1=BIGB
  1852.       TV2=0
  1853.       TV3=0
  1854.       CALL SPACK(TV1,TNUM,TV2,TV3)
  1855.       STATUS=RPACK(LEN,NUM,RECPKT)
  1856.       SBREAK=STATE     ; Default to STATE
  1857. C
  1858.       IF(STATUS.EQ.BIGN)THEN                  ;we got a NAK packet
  1859.          IF(N.NE.(NUM-1))THEN
  1860.             SBREAK=STATE
  1861.             RETURN
  1862.           ENDIF
  1863.       ELSE IF(STATUS.EQ.BIGY)THEN             ;we got a ACK packet
  1864.               IF(N.NE.NUM)THEN
  1865.                  SBREAK=STATE                 ;but it is out of seque
  1866.                  RETURN
  1867.               ENDIF
  1868.               NUMTRY=0
  1869.               ITEMP=N+1
  1870.               N=MOD(ITEMP,64)
  1871.               SBREAK=BIGC                     ;change state to comple
  1872.               RETURN                          ;status
  1873.       ELSE IF(STATUS.EQ.BAD)THEN
  1874.               SBREAK=STATE
  1875.               RETURN
  1876.       ELSE
  1877.          WRITE(20,*) ' SBREAK - Unknown Packet - Status = A'
  1878.          SBREAK=BIGA                        ;receive unknown packet
  1879.       ENDIF                                   ;type or error packet
  1880.       RETURN
  1881.       END
  1882. $NLIST
  1883. C-----------------------------------------------------------------
  1884.       SUBROUTINE SCONNECT
  1885. C
  1886. C   Put this terminal into CHAT mode
  1887. C
  1888. C       (This routine would be used by the P-E in LOCAL mode,
  1889. C         which is currently unimplemented.)
  1890. C         (look for it in Version 3.0)
  1891. C
  1892. C     JL 4/27/84 11:30
  1893. C-----------------------------------------------------------------
  1894. $INCLUDE KERCOM  (NLIST)
  1895. $NLIST
  1896. $INCLUDE KERDEF  (NLIST)
  1897. $NLIST
  1898.       INTEGER*2 IBUF,ILEN,TV,IWRITE,IESCHAR,STATUS,IA,IB
  1899.       INTEGER*2 IFUNC,ICLAS,LUTERM,TLEN,RMTRAW,LOCALRAW
  1900.       INTEGER*2 TCODE
  1901.       INTEGER LUN
  1902. C
  1903.       LUN=LOCALOUTFD
  1904.       WRITE(LUN,1000)
  1905. C     STATUS=YES
  1906. C     IESCHAR=ISHFT(ESCHAR,8)
  1907. C     TCODE=17
  1908. C     CALL SETRAW(RMTINFD,RMTTTY)
  1909. C     CALL SETPAR(RMTINFD,RMTTTY)
  1910. C     CALL SETBAUD(RMTINFD,RMTTTY)
  1911. C     CALL SETPORT(RMTINFD,RMTTTY)
  1912. C
  1913. C     WRITE(LUN,101)
  1914. C     WRITE(LUN,102)ESCHAR
  1915. C
  1916. C     ILEN=-1
  1917. C     TLEN=-1
  1918. C     IWRITE=2
  1919. C     RMTRAW=RMTOUTFD+2000B
  1920. C     LOCALRAW=LOCALOUTFD+2000B
  1921. C     CALL EXEC(TCODE,LOCALINFD,IBUF,ILEN,LOCALINFD,0,ICLAS)
  1922. C     CALL EXEC(TCODE,RMTINFD,IBUF,ILEN,RMTINFD,0,ICLAS)
  1923. C     ICLAS=IOR(ICLAS,20000B)
  1924. C
  1925. C     IF (STATUS.EQ.YES)
  1926. C        CALL EXEC(21,ICLAS,IBUF,TLEN,LUTERM)
  1927. C        WRITE(LUN,333)LUTERM
  1928. C 333    FORMAT(' ','VALUE OF LUTERM IS ',I5)
  1929. C        WRITE(LUN,334)IBUF
  1930. C 334    FORMAT(' ','VALUE OF IBUF READ IS ',I5)
  1931. C        IF(LUTERM.EQ.LOCALINFD)THEN
  1932. C           TV=IAND(IBUF,77400B)
  1933. C           IF(TV.EQ.IESCHAR)THEN
  1934. C              WRITE(LUN,103)
  1935. C              CALL SETCOOK(RMTINFD,RMTTTY)
  1936. C              RETURN
  1937. C           ENDIF
  1938. C           IF(IBMON.EQ.YES)THEN
  1939. C              CALL EXEC(IWRITE,LOCALRAW,IBUF,-1,*100)
  1940. C           ENDIF
  1941. C           CALL EXEC(IWRITE,RMTRAW,IBUF,-1,*100)
  1942. C           CALL EXEC(TCODE,LOCALINFD,IBUF,ILEN,LOCALINFD,0,ICLAS)
  1943. C        ELSE
  1944. C            CALL EXEC(IWRITE,LOCALRAW,IBUF,-1,*100)
  1945. C            CALL EXEC(TCODE,RMTINFD,IBUF,ILEN,RMTINFD,0,ICLAS)
  1946. C        ENDIF
  1947. C     ENDIF
  1948. C
  1949. C 100 CONTINUE
  1950. C     CALL ABREG(IA,IB)
  1951. C     WRITE(LUN,104)
  1952. C     WRITE(LUN,105)IA,IB
  1953.       RETURN
  1954.  1000 FORMAT(/' CONNECT is unavailable under Kermit-CO 2.1')
  1955. C 101   FORMAT(' ','To exit from CHAT mode; type the')
  1956. C 102   FORMAT(' ','equalivent control character of ',I4)
  1957. C 103   FORMAT(' ','Returning to Kermit-CO')
  1958. C 104   FORMAT(' ','Error in performing EXEC write in SCONNECT')
  1959. C 105   FORMAT(' ','Value of IA & IB are ',A2,' = ',A2)
  1960.       END
  1961. $NLIST
  1962. C-----------------------------------------------------------------
  1963.       SUBROUTINE SCOPY(XFROM,I,XTO,J)
  1964. C-----------------------------------------------------------------
  1965.       INTEGER*2 XFROM(1),XTO(1),I,J,K1,K2
  1966. $INCLUDE KERDEF  (NLIST)
  1967. $NLIST
  1968.       K2=J
  1969.       K1=I
  1970.   100 IF (XFROM(K1).NE.EOS) THEN
  1971.          XTO(K2)=XFROM(K1)
  1972.          K2=K2+1
  1973.          K1=K1+1
  1974.          GOTO 100
  1975.       ENDIF
  1976.       XTO(K2)=EOS
  1977.       RETURN
  1978.       END
  1979. $NLIST
  1980. C-----------------------------------------------------------------
  1981.       INTEGER*2 FUNCTION SDATA(X)
  1982. C
  1983. C     Sends a data packet to other KERMIT
  1984. C
  1985. C     JL 4/18/84 17:15
  1986. C-----------------------------------------------------------------
  1987. $INCLUDE KERCOM  (NLIST)
  1988. $NLIST
  1989. $INCLUDE KERDEF  (NLIST)
  1990. $NLIST
  1991.       INTEGER*2 X,NUM,LEN,BUFILL,STATUS,RPACK,TNUM,TV1
  1992.       INTEGER ITEMP,LUN
  1993.       IF(NUMTRY.GT.MAXTRY)THEN
  1994.          WRITE(20,*) ' SDATA- MAXTRY exceeded - Status = A'
  1995.          SDATA=BIGA
  1996.          CALL RATCLOSE(FD)
  1997.          CALL RATCLOSE(MOREFD)
  1998.          RETURN
  1999.       ELSE
  2000.           NUMTRY=NUMTRY+1
  2001.       ENDIF
  2002. C
  2003.       TNUM=N
  2004.       TV1=BIGD
  2005.       CALL SPACK(TV1,TNUM,SIZE,PACKET)  ;send that data packet
  2006.       IF(HOSTON.EQ.NO)THEN              ;if we are running in local
  2007.          LUN=LOCALOUTFD
  2008.          WRITE(LUN,100)TNUM   ;mode , display the current sequence #
  2009.       ENDIF
  2010. C
  2011.       STATUS=RPACK(LEN,NUM,RECPKT)      ;get the reply
  2012. C
  2013. C The next statements is to make sure we are not one packet
  2014. C     ahead of other KERMIT, it will happen if other KERMIT send a NAK
  2015. C     (due to time-out detection feature) before we send the first
  2016. C     SINIT packet
  2017. C
  2018.       IF((STATUS.EQ.BIGY).AND.(N.EQ.(NUM+1)))THEN
  2019.           STATUS=RPACK(LEN,NUM,RECPKT)
  2020.       ENDIF
  2021.       SDATA=STATE  ; Default to STATE
  2022. C
  2023.       IF(STATUS.EQ.BIGN)THEN            ;we got a NAK
  2024.          IF(N.NE.(NUM-1))THEN
  2025.             SDATA=STATE                 ;to the right sequence #
  2026.             RETURN
  2027.          ENDIF
  2028.       ELSE IF(STATUS.EQ.BIGY)THEN       ;we got a ACK
  2029.               IF(N.NE.NUM)THEN
  2030.                  SDATA=STATE            ;but, it was for the last pac
  2031.                  RETURN
  2032.               ENDIF
  2033.               NUMTRY=0
  2034.               ITEMP=N+1
  2035.               N=MOD(ITEMP,64)           ;increment frame sequence num
  2036.               SIZE=BUFILL(PACKET)       ;fill up more data onto buffe
  2037.               IF(SIZE.EQ.EOF)THEN       ;we got EOF on the sending
  2038.                  SDATA=BIGZ             ;disk file, change state so
  2039.                  RETURN                 ;we can sent an EOF packet
  2040.               ENDIF
  2041.               SDATA=BIGD                ;we send the DATA packet, sen
  2042.               RETURN
  2043.       ELSE IF(STATUS.EQ.BAD)THEN        ;we got a checksum error
  2044.               SDATA=STATE               ;try it again
  2045.               RETURN
  2046.       ELSE
  2047.            SDATA=BIGA                   ;we got unknown packet type o
  2048.            WRITE(20,*) ' SDATA- BAD Packet - Chksum?? - Status = A'
  2049.            CALL RATCLOSE(MOREFD)
  2050.            CALL RATCLOSE(FD)
  2051.            RETURN
  2052.       ENDIF                             ;an error type packet
  2053.       RETURN
  2054. 100   FORMAT(' ','Packet # ',I4)
  2055.       END
  2056. $NLIST
  2057. C-----------------------------------------------------------------
  2058.       INTEGER*2 FUNCTION SENDSW(X)
  2059. C
  2060. C  Send this group of files.
  2061. C
  2062. C     JL 4/18/84 17:15
  2063. C-----------------------------------------------------------------
  2064. $INCLUDE KERCOM  (NLIST)
  2065. $NLIST
  2066. $INCLUDE KERDEF  (NLIST)
  2067. $NLIST
  2068.       COMMON /XBYTE/ XNEW,XCOUNT,XLIN(264),XEOF
  2069.       INTEGER*2 XSTATUS,SDATA,SFILE,SEOF,SINIT,SBREAK,X
  2070.       INTEGER*2 TV1,TV2,TV3,TV4
  2071.       STATE=BIGS
  2072.       XNEW=YES
  2073.       XCOUNT=1
  2074.       XEOF=NO
  2075.       N=0
  2076.       NUMTRY=0
  2077.       STATUS=YES
  2078.       SENDSW=NO  ; Default to failed SEND
  2079. C
  2080.   100 IF (STATUS.EQ.YES) THEN
  2081.           IF(STATE.EQ.BIGD)THEN          ;send a data packet
  2082.              STATE=SDATA(X)
  2083.           ELSE IF(STATE.EQ.BIGF)THEN     ;send a file header
  2084.                   STATE=SFILE(X)
  2085.           ELSE IF(STATE.EQ.BIGZ)THEN     ;send a EOF header
  2086.                   STATE=SEOF(X)
  2087.           ELSE IF(STATE.EQ.BIGS)THEN     ;send a SINIT packet
  2088.                   STATE=SINIT(X)
  2089.           ELSE IF(STATE.EQ.BIGB)THEN     ;send a BREAK packet
  2090.                   STATE=SBREAK(X)
  2091.           ELSE IF(STATE.EQ.BIGC)THEN
  2092.                   SENDSW=YES             ;file transfer complete
  2093.                   RETURN
  2094.           ELSE IF(STATE.EQ.BIGA)THEN     ;file transfer failed
  2095.                   SENDSW=NO
  2096.                   TV1=BIGE
  2097.                   TV2=N
  2098.                   TV3=0
  2099.                   TV4=0
  2100.                   CALL SPACK(TV1,TV2,TV3,TV4)  ;send a ERROR pkt
  2101.                   RETURN
  2102.            ELSE
  2103.                 STATUS=NO
  2104.                 SENDSW=NO             ;file transfer failed
  2105.            ENDIF
  2106.            GOTO 100
  2107.       ENDIF
  2108.       RETURN
  2109.       END
  2110. $NLIST
  2111. C-----------------------------------------------------------------
  2112.       INTEGER*2 FUNCTION SEOF(X)
  2113. C
  2114. C     Send an EOF packet to the other KERMIT
  2115. C
  2116. C     JL 4/18/84 17:16
  2117. C-----------------------------------------------------------------
  2118. $INCLUDE KERCOM  (NLIST)
  2119. $NLIST
  2120. $INCLUDE KERDEF  (NLIST)
  2121. $NLIST
  2122.       INTEGER*2 NUM,LEN,STATUS,RPACK,X,TNUM,TEMP,XY
  2123.       INTEGER*2 ALIN(132),AONE,BONE,TV1,TV2,TV3,TV4
  2124.       INTEGER*2 XREAD
  2125.       INTEGER ITEMP,MAXLEN,LUN
  2126.       CHARACTER*12 FileName
  2127.       DATA MAXLEN/12/
  2128.       XREAD=0
  2129. C
  2130.       IF(NUMTRY.GT.MAXTRY)THEN
  2131.          SEOF=BIGA                    ;exceeded max. # of re-try, giv
  2132.          CALL RATCLOSE(FD)
  2133.          CALL RATCLOSE(MOREFD)
  2134.          WRITE(20,*) ' SEOF - MAXTRY exceeded - Status = A'
  2135.          RETURN
  2136.       ELSE
  2137.           NUMTRY=NUMTRY+1
  2138.       ENDIF
  2139.       AONE=1
  2140.       BONE=1
  2141.       TNUM=N
  2142.       TV1=BIGZ
  2143.       TV2=0
  2144.       TV3=0
  2145.       CALL SPACK(TV1,TNUM,TV2,TV3)    ;send an EOF packet to other KE
  2146.       STATUS=RPACK(LEN,NUM,RECPKT)    ;what is its reply ??
  2147.       SEOF=STATE    ; Default to State
  2148.       IF(STATUS.EQ.BIGN)THEN          ;we got an NAK
  2149.          IF(N.NE.(NUM-1))THEN         ;if NAK for last packet
  2150.             SEOF=STATE
  2151.             RETURN
  2152.          ENDIF
  2153.       ELSE IF(STATUS.EQ.BIGY)THEN     ;we got a NAK
  2154.               IF(N.NE.NUM)THEN
  2155.                  SEOF=STATE           ;but it was for the last packet
  2156.                  RETURN
  2157.               ENDIF
  2158.               NUMTRY=0
  2159.               CALL RATCLOSE(FD)       ;close the sending disk file ch
  2160.               ITEMP=N+1
  2161.               N=MOD(ITEMP,64)
  2162.               TEMP=DGETLIN(TXTFILE,FILNAME,MOREFD) ;Another SEND?
  2163.               IF(TEMP.EQ.EOF)THEN     ;no, all directory files sent
  2164.                  CALL RATCLOSE(MOREFD)   ; close up shop
  2165.                  SEOF=BIGB       ;change state to break transmission
  2166.                  RETURN
  2167.               ELSE
  2168.                   FD=AOPEN(FMode,FILNAME,XREAD) ;At least one more
  2169.                   IF (FD.EQ.BAD) then  ;Can' open for send
  2170.                      IF(HOSTON.EQ.NO)THEN
  2171.                         LUN=LOCALOUTFD
  2172.                         CALL PACK(FILNAME,FileName)
  2173.                         WRITE(LUN,*) ' File not found--> ',FileName
  2174.                      ENDIF
  2175.                      TEMP=YES
  2176.   100                IF (TEMP.EQ.YES) THEN   ; Try next filename
  2177.                         XY=DGETLIN(TXTFILE,ALIN,MOREFD)
  2178.                         IF(X.EQ.EOF)THEN ;no more files
  2179.                            SEOF=BIGB     ;change state to send BREAK
  2180.                            CALL RATCLOSE(MOREFD) ;close directory ch
  2181.                            RETURN
  2182.                         ELSE       ; At least one more file to send
  2183.                             CALL SCOPY(ALIN,AONE,FILNAME,BONE)
  2184.                             FD=AOPEN(TXTFILE,FILNAME,XREAD) ;Exists??
  2185.                             IF(FD.NE.BAD)TEMP=NO   ;file exists
  2186.                         ENDIF
  2187.                         GOTO 100       ; Loop till Good File or End
  2188.                      ENDIF
  2189.                      SEOF=BIGF
  2190.                      RETURN
  2191.                   ELSE
  2192.                      SEOF=BIGF      ;Yes, change state to send
  2193.                      RETURN         ;the file header packet
  2194.                   ENDIF
  2195.              ENDIF
  2196.       ELSE IF(STATUS.EQ.BAD)THEN              ;there was a checksum e
  2197.               SEOF=STATE                      ;try it again
  2198.               RETURN
  2199.       ELSE
  2200.          WRITE(20,*) ' SEOF - Unexpected packet got - Status = A'
  2201.          SEOF=BIGA                ; Unexpected Packet got
  2202.          CALL RATCLOSE(FD)
  2203.          CALL RATCLOSE(MOREFD)
  2204.          RETURN
  2205.       ENDIF
  2206.       RETURN
  2207.       END
  2208. $NLIST
  2209. C-----------------------------------------------------------------
  2210.       SUBROUTINE SETBAUD(CH,FNAME)
  2211. C
  2212. C   Set a global variable to selected baud rate, it will not
  2213. C     goes into affect until executed by SETPORT routine, then it
  2214. C     will remain in effect for the rest of the session
  2215. C
  2216. C       (This routine would be used by the P-E in LOCAL mode,
  2217. C         which is currently unimplemented.)
  2218. C         (look for it in Version 3.0)
  2219. C
  2220. C     JL 4/27/84 11:16
  2221. C-----------------------------------------------------------------
  2222. C$INCLUDE KERCOM  (NLIST)
  2223. $NLIST
  2224. C     COMMON /MUX/ VRAWCOOK,VPARITY,VPORT,VBAUD,VENQACK,VXONXOFF,VREST
  2225. C$INCLUDE KERDEF  (NLIST)
  2226. $NLIST
  2227. C     IF(SPEED.EQ.300)THEN
  2228. C        VBAUD=60B
  2229. C     ELSE IF(SPEED.EQ.1200)THEN
  2230. C             VBAUD=70B
  2231. C     ELSE IF(SPEED.EQ.2400)THEN
  2232. C             VBAUD=110B
  2233. C     ELSE IF(SPEED.EQ.4800)THEN
  2234. C             VBAUD=120B
  2235. C     ELSE IF(SPEED.EQ.9600)THEN
  2236. C             VBAUD=130B
  2237. C     ELSE
  2238. C         WRITE(LUN,100)
  2239. C     ENDIF
  2240.       RETURN
  2241. C 100 FORMAT(' ','Invalid baud rate; not supported in CCC OS/32')
  2242.       END
  2243. $NLIST
  2244. C-----------------------------------------------------------------
  2245.       SUBROUTINE SETCOOK(CH,FNAME)
  2246. C
  2247. C  Set a global variable to cook mode to be used later by
  2248. C     sequential read in TGETCH function routine, have no effect
  2249. C     on the tty setting itself
  2250. C
  2251. C       (This routine would be used by the P-E in LOCAL mode,
  2252. C         which is currently unimplemented.)
  2253. C         (look for it in Version 3.0)
  2254. C
  2255. C     JL 4/27/84 11:05
  2256. C------------------------------------------------------------------
  2257. C     IMPLICIT INTEGER*2 (A-Z)
  2258. C     COMMON /MUX/ VRAWCOOK,VPARITY,VPORT,VBAUD,VENQACK,
  2259. C    +             VXONXOFF,VREST
  2260. C$INCLUDE KERDEF  (NLIST)
  2261. $NLIST
  2262. C     VRAWCOOK=400B
  2263.       RETURN
  2264.       END
  2265. $NLIST
  2266. C-----------------------------------------------------------------
  2267.       SUBROUTINE SETPAR(CH,FNAME)
  2268. C
  2269. C   Set a global variable to selected parity bit, it will not
  2270. C     go into affect until it is executed by the SETPORT subroutine
  2271. C     it will remain in effect for the rest of the session
  2272. C       (This routine would be used by the P-E in LOCAL mode,
  2273. C         which is currently unimplemented.)
  2274. C         (look for it in Version 3.0)
  2275. C
  2276. C     JL 4/27/84 11:12
  2277. C-----------------------------------------------------------------
  2278. C$INCLUDE KERCOM  (NLIST)
  2279. $NLIST
  2280. C     COMMON /MUX/ VRAWCOOK,VPARITY,VPORT,VBAUD,VENQACK,
  2281. C    +             VXONXOFF,VREST
  2282. C$INCLUDE KERDEF  (NLIST)
  2283. $NLIST
  2284. C     IF(PARITY.EQ.1)THEN
  2285. C        VPARITY=600B
  2286. C     ELSE IF(PARITY.EQ.2)THEN
  2287. C             VPARITY=100B
  2288. C     ELSE IF(PARITY.EQ.5)THEN
  2289. C             VPARITY=200B
  2290. C     ELSE
  2291. C         WRITE(LUN,100)
  2292. C     ENDIF
  2293.       RETURN
  2294. C 100 FORMAT(' ','Invalid parity; not supported in CCC OS/32')
  2295.       END
  2296. $NLIST
  2297. C-----------------------------------------------------------------
  2298.       SUBROUTINE SETPORT(CH,FNAME)
  2299. C
  2300. C   This routine would normally enable a user to selected which
  2301. C     port to used for remote file transfer, but it will not
  2302. C     be implemented in the CCC OS/32 system.  This routine is instead
  2303. C     being used for setting the proper port configuration such as
  2304. C     baud rate, parity, xon/xoff,enq/ack, stop bits, bpc etc
  2305. C
  2306. C       (This routine would be used by the P-E in LOCAL mode,
  2307. C         which is currently unimplemented.)
  2308. C         (look for it in Version 3.0)
  2309. C
  2310. C     JL 4/27/84 11:20
  2311. C-----------------------------------------------------------------
  2312. C$INCLUDE KERCOM  (NLIST)
  2313. $NLIST
  2314. C     COMMON /MUX/ VRAWCOOK,VPARITY,VPORT,VBAUD,VENQACK,
  2315. C    +             VXONXOFF,VREST
  2316. C$INCLUDE KERDEF  (NLIST)
  2317. $NLIST
  2318. C     INTEGER*2 CH,FNAME(1)
  2319. C     INTEGER*2 ICODE,ICNWD,IPARM1,IA,IB
  2320. C
  2321. C     ICODE=3
  2322. C     ICNWD=CH+3000B
  2323. C     IPARM1=VPARITY+VBAUD+VENQACK+VREST
  2324. C
  2325. C     CALL EXEC(ICODE,ICNWD,IPARM1) ;set portID based on selected bits
  2326. C     CALL ABREG(IA,IB)           ;see page 2-23 of multiplex manual
  2327. C     WRITE(LUN,100)IA,IB
  2328. C     IPARM1=VXONXOFF
  2329. C     ICNWD=CH+3400B
  2330. C     CALL EXEC(ICODE,ICNWD,IPARM1)  ;set port configuration to enable
  2331. C     CALL ABREG(IA,IB)           ;XON/XOFF see pages 2-23 of mult. m
  2332. C     WRITE(LUN,100)IA,IB
  2333. C100   FORMAT(' ','Values of IA & IB in SETPORT are ',A2,' = ',A2)
  2334.       RETURN
  2335.       END
  2336. $NLIST
  2337. C-----------------------------------------------------------------
  2338.       SUBROUTINE SETRAW(CH,FNAME)
  2339. C
  2340. C  Set a global variable to raw mode to be used later by
  2341. C     sequential read in TGETCH function routine, have no effect
  2342. C     on the tty setting itself
  2343. C
  2344. C       (This routine would be used by the P-E in LOCAL mode,
  2345. C         which is currently unimplemented.)
  2346. C         (look for it in Version 3.0)
  2347. C
  2348. C     JL 4/27/84 11:05
  2349. C-----------------------------------------------------------------
  2350. C     IMPLICIT INTEGER*2 (A-Z)
  2351. C     COMMON /MUX/ VRAWCOOK,VPARITY,VPORT,VBAUD,VENQACK,
  2352. C    +             VXONXOFF,VREST
  2353. C$INCLUDE KERDEF  (NLIST)
  2354. C     VRAWCOOK=100B
  2355.       RETURN
  2356.       END
  2357. $NLIST
  2358. C-----------------------------------------------------------------
  2359.       INTEGER*2 FUNCTION SFILE(X)
  2360. C
  2361. C     Send the filename to other KERMIT
  2362. C
  2363. C     JL 4/18/84 17:19
  2364. C-----------------------------------------------------------------
  2365. $INCLUDE KERCOM  (NLIST)
  2366. $NLIST
  2367. $INCLUDE KERDEF  (NLIST)
  2368. $NLIST
  2369.       COMMON /XBYTE/ XNEW,XCOUNT,XLIN(264),XEOF
  2370.       INTEGER*2 NUM,LEN,COUNT,RPACK,BUFILL,X,TNUM
  2371.       INTEGER*2 TV1,TV2,ALIN(132),AONE,BONE
  2372.       INTEGER ITEMP,LUN
  2373.       CHARACTER*12 FileName
  2374.       AONE=1
  2375.       BONE=1
  2376.       CALL SCOPY(FILNAME,AONE,ALIN,BONE)
  2377. C
  2378.       IF(HOSTON.EQ.NO)THEN
  2379.          LUN=LOCALOUTFD
  2380.          CALL PACK(ALIN,FileName)
  2381.          WRITE(LUN,*) ' Sending file--> ',FileName  ;Local mode
  2382.       ENDIF
  2383. C
  2384.       IF(NUMTRY.GT.MAXTRY)THEN
  2385.          WRITE(20,*)  ' SFILE - Exceeded MAXTRY - Status = A'
  2386.          SFILE=BIGA                        ;exceeded max. # of re-try
  2387.          CALL RATCLOSE(FD)
  2388.          CALL RATCLOSE(MOREFD)
  2389.          RETURN                            ;gives up
  2390.       ELSE
  2391.          NUMTRY=NUMTRY+1                  ;try it one more time
  2392.       ENDIF
  2393.       LEN=1
  2394.   100 IF (FILNAME(LEN).NE.EOS) THEN    ;determine the length of f
  2395.          LEN=LEN+1
  2396.          GOTO 100
  2397.       ENDIF
  2398. C
  2399.       LEN=LEN-2                            ;len is the length of file
  2400.       TNUM=N
  2401.       TV1=BIGF
  2402.       CALL SPACK(TV1,TNUM,LEN,FILNAME) ;Send filename to Remote Kermit
  2403.       STATUS=RPACK(LEN,NUM,RECPKT)
  2404.       SFILE=STATE       ; Default SFILE return to current state
  2405. C
  2406.       IF(STATUS.EQ.BIGN)THEN               ;we got a NAK
  2407.          IF(N.NE.(NUM-1))THEN
  2408.             SFILE=STATE
  2409.             RETURN
  2410.          ENDIF
  2411.       ELSE IF(STATUS.EQ.BIGY)THEN          ;we got a ACK
  2412.            IF(N.NE.NUM)THEN
  2413.               SFILE=STATE
  2414.               RETURN
  2415.            ENDIF
  2416.            NUMTRY=0
  2417.            ITEMP=N+1
  2418.            N=MOD(ITEMP,64)
  2419.            XNEW=YES
  2420.            XCOUNT=1
  2421.            XEOF=NO
  2422.            SIZE=BUFILL(PACKET)     ;fill up a buffer full of bytes
  2423.            SFILE=BIGD             ;change state to sent data
  2424.            RETURN
  2425.       ELSE IF(STATUS.EQ.BAD)THEN          ;we got a checksum error
  2426.               SFILE=STATE
  2427.               RETURN
  2428.       ELSE
  2429.          SFILE=BIGA                     ;we got an error or unexpec
  2430.          WRITE(20,*) ' SFILE - Unexpected Packet type - Status = A'
  2431.          CALL RATCLOSE(MOREFD)          ;CLOSE DIRECTORY CH
  2432.          CALL RATCLOSE(FD)              ;CLOSE SENDING FD
  2433.          RETURN                         ;packet type
  2434.       ENDIF
  2435.       RETURN
  2436.       END
  2437. $NLIST
  2438. C-----------------------------------------------------------------
  2439.       SUBROUTINE SHELP
  2440. C
  2441. C     Types out the content of the HelpFile
  2442. C
  2443. C     JL 4/18/84 17:20
  2444. C     DM/PM 3/85
  2445. C-----------------------------------------------------------------
  2446. $INCLUDE KERCOM  (NLIST)
  2447. $NLIST
  2448. $INCLUDE KERDEF  (NLIST)
  2449. $NLIST
  2450.       INTEGER*2 STATUS,GETLIN,ALIN(264),TEMPCH,XREAD
  2451.       INTEGER*2 AOPEN,GETKEYBD,NLINES,TV        ;DM 1/85
  2452.       INTEGER LUN
  2453.       LOGICAL HELPON
  2454.       CHARACTER*2 CRLF                  ;DM 1/85
  2455.       CHARACTER*25  CPROMPT
  2456.       DATA CRLF/Z0D0A/             ; Carriage Return/Line Feed
  2457.       DATA CPROMPT/'RETURN to continue...'/
  2458.       XREAD=0
  2459.       LUN=LOCALOUTFD
  2460.       TEMPCH=15 ; Kermit.HLP opened as LU 15 in Kermit.CSS
  2461.       INQUIRE(TEMPCH,OPENED=HELPON)   ; Check availability
  2462.       IF (.NOT.HELPON) THEN
  2463.          WRITE(LUN,1000)
  2464.          RETURN
  2465.       ELSE
  2466.          REWIND(TEMPCH)
  2467.          CALL TPUTCH(LF,LOCALOUTFD)   ; LineFeed at top of Display
  2468.          NLINES=0
  2469.  100     IF (DGETLIN(TXTFILE,ALIN,TEMPCH).NE.EOF) THEN ;Next HELPline
  2470.             CALL PUTLIN(ALIN,LOCALOUTFD)   ; (PUTSCRN)
  2471.             CALL PUTSTRNG (LOCALOUTFD,2,CRLF)
  2472.             NLINES=NLINES+1
  2473.             IF (NLINES.GT.21) THEN
  2474.                CALL PUTSTRNG (LOCALOUTFD,2,CRLF)
  2475.                CALL PUTSTRNG(LOCALOUTFD,25,CPROMPT)
  2476.                TV=GETKEYBD(ALIN,LOCALINFD) ; Wait for RETURN
  2477.                CALL PUTSTRNG (LOCALOUTFD,2,CRLF)
  2478.                NLINES=0
  2479.             ENDIF
  2480.             GOTO 100
  2481.          ENDIF
  2482.       ENDIF
  2483.       RETURN
  2484.  1000 FORMAT(/' Kermit.HLP not available....wing it, ok??')
  2485.       END
  2486. $NLIST
  2487. C-----------------------------------------------------------------
  2488.       INTEGER*2 FUNCTION SINIT(X)
  2489. C
  2490. C     Send an initial packet for the first connection
  2491. C     state what my parameters are
  2492. C
  2493. C     JL 4/18/84 17:20
  2494. C-----------------------------------------------------------------
  2495. $INCLUDE KERCOM  (NLIST)
  2496. $NLIST
  2497. $INCLUDE KERDEF  (NLIST)
  2498. $NLIST
  2499.       INTEGER*2 NUM,LEN,STATUS,RPACK,X,TNUM,TEMP,XY
  2500.       INTEGER*2 ALIN(264),AONE,BONE,TV1,TV2,XREAD
  2501.       INTEGER*2 MOREFILE(132),DGETLIN
  2502.       INTEGER ITEMP,MAXLEN
  2503.       DATA MAXLEN/12/
  2504.       MOREFILE(1)=BIGM
  2505.       MOREFILE(2)=BIGO
  2506.       MOREFILE(3)=BIGR
  2507.       MOREFILE(4)=BIGE
  2508.       MOREFILE(5)=BIGF
  2509.       MOREFILE(6)=BIGI
  2510.       MOREFILE(7)=BIGL
  2511.       MOREFILE(8)=BIGE
  2512.       MOREFILE(9)=LF
  2513.       MOREFILE(10)=EOS
  2514.       XREAD=0
  2515.       IF(NUMTRY.GT.MAXTRY)THEN
  2516.          SINIT=BIGA                    ;exceeded max # of re-try , gi
  2517.          WRITE(20,*) ' SINIT - MAXTRY exceeded - Status = A'
  2518.          RETURN
  2519.       ELSE
  2520.           NUMTRY=NUMTRY+1              ;try it again
  2521.       ENDIF
  2522. C
  2523.       AONE=1
  2524.       BONE=1
  2525.       CALL SPAR(PACKET)                ;get my requirement parameters
  2526.       TNUM=N
  2527.       TV1=BIGS
  2528.       TV2=9       ; Basic Kermit + 8-Bit Quoting,CheckSumType,Repeat
  2529.       CALL SPACK(TV1,TNUM,TV2,PACKET)  ;send my parameters requiremen
  2530.       STATUS=RPACK(LEN,NUM,RECPKT)     ;what was the reply ??
  2531.       SINIT=STATE       ; Default RETURN value to State
  2532.       IF (DEBUGON.EQ.YES)
  2533.      &   WRITE(20,*) ' SINIT - STATUS = ',STATUS,'  STATE= ',STATE
  2534. C
  2535.       IF(STATUS.EQ.BIGN)THEN           ;NAK it
  2536.          IF(N.NE.(NUM-1))THEN
  2537.          IF (DEBUGON.EQ.YES)WRITE(20,*) 'SINIT - N.NE.(NUM-1)'
  2538.             SINIT=STATE                ;try it again
  2539.             RETURN
  2540.          ENDIF
  2541.       ELSE IF(STATUS.EQ.BIGY)THEN      ;ACK it
  2542.               IF(N.NE.NUM)THEN         ;but it was for previous packet
  2543.                  SINIT=STATE           ;re-try it again
  2544.                  RETURN
  2545.               ENDIF
  2546.               CALL RPAR(RECPKT)  ;get requirements of other Kermit
  2547.               NUMTRY=0
  2548.               ITEMP=N+1
  2549.               N=MOD(ITEMP,64)
  2550.               MOREFD=AOPEN(TXTFILE,MOREFILE,XREAD) ;open Dir File
  2551.               IF(MOREFD.EQ.BAD)THEN     ;directory file does not exis
  2552.                  WRITE(20,*) ' SINIT - Directory file Unopenable'
  2553.                  SINIT=BIGA
  2554.                  RETURN
  2555.               ENDIF
  2556.               TEMP=YES
  2557.   100         IF (TEMP.EQ.YES) THEN   ;Do until File got or End
  2558.                   XY=DGETLIN(TXTFILE,ALIN,MOREFD) ;Get DIR Fname
  2559.                   IF(XY.EQ.EOF)THEN    ;we have reach an EOF
  2560.                      SINIT=BIGA        ;nothing to send at all
  2561.                      CALL RATCLOSE(MOREFD) ;close directory file
  2562.                      RETURN
  2563.                   ELSE
  2564.                      CALL SCOPY(ALIN,AONE,FILNAME,BONE)
  2565.                      FD=AOPEN(FMode,FILNAME,XREAD) ;Open R File
  2566.                      IF(FD.NE.BAD)TEMP=NO  ;yes it does
  2567.                   ENDIF
  2568.                   GOTO 100   ; Loop till File got or EOF
  2569.               ENDIF
  2570.               SINIT=BIGF        ;change state to sent file header pac
  2571.               RETURN
  2572.       ELSE IF(STATUS.EQ.BAD)THEN   ;checksum error detected
  2573.               WRITE(20,*) ' SINIT - Checksum error - State=',STATE
  2574.               SINIT=STATE       ;try it again
  2575.               RETURN
  2576.       ELSE
  2577.          SINIT=BIGA
  2578.          WRITE(20,*) ' SINIT - BAD OPEN - STATE = ',STATE
  2579.       ENDIF
  2580.       RETURN
  2581.       END
  2582. $NLIST
  2583. C-----------------------------------------------------------------
  2584.       SUBROUTINE SKIPBL(LIN, I)
  2585. C-----------------------------------------------------------------
  2586.       INTEGER*2 LIN(1)
  2587.       INTEGER*2 I
  2588. 23000 IF(.NOT.(LIN(I) .EQ. 32 .OR. LIN(I) .EQ. 9))GOTO 23001
  2589.       I = I + 1
  2590.       GOTO 23000
  2591. 23001 CONTINUE
  2592.       RETURN
  2593.       END
  2594. $NLIST
  2595. C-----------------------------------------------------------------
  2596.       SUBROUTINE SPACK(XTYPE,NUM,LEN,XDATA)
  2597. C
  2598. C     Send this packet to the remote KERMIT
  2599. C
  2600. C     JL 4/18/84 17:22
  2601. C-----------------------------------------------------------------
  2602. $INCLUDE KERCOM  (NLIST)
  2603. $NLIST
  2604. $INCLUDE KERDEF  (NLIST)
  2605. $NLIST
  2606.       INTEGER*2 XDATA(132),XTYPE,NUM,LEN,CH
  2607.       INTEGER*2 TV2,TV3, LENTMP
  2608.       INTEGER*2 BUFFER(132),I,IER,COUNT,TOCHAR,CHKSUM2
  2609.       INTEGER ITEMP,TV1,CHKSUM
  2610.       CH=RMTOUTFD                  ;this is the channel to send packe
  2611.       I=1                          ;out on, start with the first byte
  2612. C
  2613.   100 IF (I.LE.PAD) THEN      ;send out padchar if need
  2614.          CALL TPUTCH(PADCHAR,CH)
  2615.          I=I+1
  2616.          GOTO 100
  2617.       ENDIF
  2618.       COUNT=1
  2619.       BUFFER(COUNT)=SOH
  2620.       COUNT=COUNT+1
  2621.       LENTMP=LEN+3
  2622.       CHKSUM=TOCHAR(LENTMP)
  2623.       BUFFER(COUNT)=TOCHAR(LENTMP)
  2624.       COUNT=COUNT+1
  2625.       CHKSUM=CHKSUM+TOCHAR(NUM)
  2626.       BUFFER(COUNT)=TOCHAR(NUM)
  2627.       COUNT=COUNT+1
  2628.       CHKSUM=CHKSUM+XTYPE
  2629.       BUFFER(COUNT)=XTYPE
  2630.       COUNT=COUNT+1
  2631. C
  2632.       DO 200 I=1,LEN           ;copy the content of packet info
  2633.       BUFFER(COUNT)=XDATA(I)   ;calculate the checksum
  2634.       COUNT=COUNT+1
  2635.       CHKSUM=CHKSUM+XDATA(I)
  2636.   200 CONTINUE
  2637. C
  2638.       TV1=IAND(CHKSUM,192)
  2639. **    TV2=TV1/64
  2640.       ITEMP=(TV1/64) + CHKSUM
  2641.       CHKSUM2=IAND(ITEMP,63)
  2642.       BUFFER(COUNT)=TOCHAR(CHKSUM2)
  2643.       COUNT=COUNT+1
  2644.       BUFFER(COUNT)=LF        ;PUTLIN expects LF as terminator
  2645.       BUFFER(COUNT+1)=EOS
  2646.  
  2647. C Send packet out in one shot
  2648.       CALL PUTLIN(BUFFER,CH)    ; Send Packet to Remote Kermit
  2649.  
  2650.       RETURN
  2651.       END
  2652. $NLIST
  2653. C-----------------------------------------------------------------
  2654.       SUBROUTINE SPAR(XDATA)
  2655. C
  2656. C     JL 5/4/84 15:00
  2657. C-----------------------------------------------------------------
  2658. $INCLUDE KERCOM  (NLIST)
  2659. $NLIST
  2660. $INCLUDE KERDEF  (NLIST)
  2661. $NLIST
  2662.       INTEGER*2 CTL,TOCHAR,XZERO,MYTIME
  2663.       INTEGER*2 XDATA(1)
  2664.       I=1           ;Relative Index
  2665.       XZERO=0
  2666.       XDATA(I)=TOCHAR(PAKSIZ)
  2667.       XDATA(I+1)=TOCHAR(MYTIMOUT)
  2668.       XDATA(I+2)=TOCHAR(MYPAD)   ; No. Pad Chars needed
  2669.       XDATA(I+3)=CTL(MYPCHAR)   ; Pad Character
  2670.       XDATA(I+4)=TOCHAR(MYEOL)
  2671.       XDATA(I+5)=MYQUOTE
  2672.       IF (MYQUOT8B.EQ.YES) THEN
  2673.          XDATA(I+6)=Q8BCHR
  2674.       ELSE
  2675.          XDATA(I+6)=BIGN
  2676.       ENDIF
  2677.       XDATA(I+7)=DIG1       ; Basic Block Checksum used
  2678.       XDATA(I+8)=BLANK      ; No Repeat char. encoding done
  2679.       RETURN
  2680.       END
  2681. $NLIST
  2682. C-----------------------------------------------------------------
  2683.       SUBROUTINE SQUIT
  2684. C
  2685. C  Exit from Kermit-CO, with aplomb.
  2686. C
  2687. C     JL 4/18/84 17:25
  2688. C-----------------------------------------------------------------
  2689. $INCLUDE KERCOM  (NLIST)
  2690. $NLIST
  2691.       INTEGER LUN
  2692.       LUN=LOCALOUTFD
  2693.       WRITE(LUN,100)
  2694.       RETURN
  2695. 100   FORMAT(/' Kermit-CO signing off...')
  2696.       END
  2697. $NLIST
  2698. C-----------------------------------------------------------------
  2699.       SUBROUTINE SRECEIVE(IRecL)
  2700. C
  2701. C Set up TTY line before calling for RECSW routine
  2702. C
  2703. C     JL 4/30/84   15:30      (PM 3/16/86)
  2704. C-----------------------------------------------------------------
  2705. $INCLUDE KERCOM  (NLIST)
  2706. $NLIST
  2707. $INCLUDE KERDEF  (NLIST)
  2708. $NLIST
  2709.       INTEGER*2 STATUS,AOPEN,X,BELL,IRecL
  2710.       INTEGER LUIN, LUOT,UserRecL,NSects, DefRecL(3), MaxRecL(3)
  2711.       CHARACTER RecLenCH*4
  2712.       COMMON /NEWREC/ UserRecL,NSects
  2713.       DATA DefRecL/80,256,256/ ; ASCII, BINARY, CONTIGUOUS default
  2714.       DATA MaxRecL/256,256,256/ ; ASCII, BINARY ,CONTIGUOUS default
  2715. C
  2716. C For CONTIG files,get number sectors to allocate; otherwise get
  2717. C      get Record Length to use for TEXT,BINARY
  2718.       LUIN = LOCALINFD
  2719.       LUOT = LOCALOUTFD
  2720.       IF (FMode.EQ.CONFILE) THEN  ; Get no. sectors for CONTIG
  2721.          IF (IRecL.GT.0) THEN
  2722.             NSects = IRecL
  2723.          ELSE
  2724.    50       WRITE(LUOT,4000)    ; Insist on a Sector count
  2725.             READ(LUIN,1030) RecLenCH
  2726.             NSects=CTOI(RecLenCH,K)
  2727.             IF (NSects.LE.0) GOTO 50
  2728.          ENDIF
  2729.          UserRecL=DefRecL(FMode)  ;Rec size fixed for CONTIG
  2730.          WRITE(LUOT,4010) NSects
  2731.       ELSE                      ; TEXT, BINARY
  2732.          IF (IRecL.LE.0.OR.IRecL.GT.MaxRecL(FMode)) THEN
  2733.   100       WRITE(LUOT,2000)  MaxRecL(FMode)
  2734.             READ (LUIN,1030) RecLenCH
  2735.             UserRecL=CTOI(RecLenCH,K)
  2736.             IF (UserRecL.LE.0) THEN
  2737.                UserRecL=DefRecL(FMode) ; Default if non-numeric
  2738.             ELSE
  2739.                IF (UserRecL.LT.10.OR.
  2740.      &             UserRecL.GT.MaxRecL(FMode)) GOTO 100
  2741.             ENDIF
  2742.          ELSE
  2743.             UserRecl=IRecL
  2744.          ENDIF
  2745.          WRITE(LUOT,2010) UserRecL
  2746.       ENDIF
  2747.       BELL=7
  2748.       Q8BCHR=AMPER     ; Initialize 8-Bit quote before each INIT
  2749.  
  2750. C Enter 'Receive State Switching' routine.....only 'HOSTON' is
  2751. C    currently implemented
  2752.       IF(HOSTON.EQ.YES)THEN     ; 'REMOTE HOST' mode
  2753.          WRITE(LUOT,2020)
  2754.          STATUS=RECSW(X)
  2755.       ELSE
  2756.           WRITE(LUOT,1020)UserRecL   ; 'LOCAL' mode
  2757. CCCC      CALL SETRAW(RMTINFD,RMTTTY)   ;put this TTY into RAW mode
  2758. CCCC      CALL SETPAR(RMTOUTFD,RMTTTY)  ;set user selected parity
  2759. CCCC      CALL SETBAUD(RMTOUTFD,RMTTTY) ;set user selected baud rate
  2760. CCCC      CALL SETPORT(RMTINFD,RMTTTY)
  2761.           STATUS=RECSW(X)
  2762. CCCC      CALL SETCOOK(RMTINFD,RMTTTY)  ;put TTY back into COOK mode
  2763. CCCC      CALL TPUTCH(BELL,LOCALSLU)
  2764. CCCC      CALL TPUTCH(BELL,LOCALSLU)
  2765.          IF(STATUS.EQ.YES)THEN
  2766.             WRITE(LUOT,1000)
  2767.          ELSE
  2768.             WRITE(LUOT,1010)
  2769.          ENDIF
  2770.       ENDIF
  2771.       IF (FNamChng.EQ.YES) THEN
  2772.          WRITE(LUOT,3000)
  2773.          FNamChng=NO
  2774.       ENDIF
  2775.       RETURN
  2776.  1000 FORMAT(' ','File transfer COMPLETED')
  2777.  1010 FORMAT(' ','File transfer FAILED')
  2778.  1020 FORMAT(/' Using Record length = ',I4)
  2779.  1030 FORMAT(A4)
  2780.  2000 FORMAT(/' Enter RECEIVE file Record size: (10 ->',I4,')')
  2781.  2010 FORMAT(/' Record size used = ',I4,' bytes')
  2782.  2020 FORMAT(/' Return to Local Kermit & SEND...'/)
  2783.  3000 FORMAT(' Received file name(s) made unique.')
  2784.  4000 FORMAT(/' Enter Sectors to allocate for CONTIGUOUS file:')
  2785.  4010 FORMAT(/' Number of Contiguous sectors allocated = ',I4)
  2786.       END
  2787. $NLIST
  2788. C-----------------------------------------------------------------
  2789.       SUBROUTINE SSEND(ALIN)
  2790. C
  2791. C     Set up remote line and directory file before calling SENDSW
  2792. C
  2793. C     JL 4/18/84 17:30
  2794. C-----------------------------------------------------------------
  2795. $INCLUDE KERCOM  (NLIST)
  2796. $NLIST
  2797. $INCLUDE KERDEF  (NLIST)
  2798. $NLIST
  2799.       INTEGER*2 ALIN(1),ISEND(5),HoldFlag
  2800.       INTEGER*2 MOREFILE(132),A1,Z1,STATUS,TEMP,I
  2801.       INTEGER*2 FLAG,B1,TPNAME(264),CH1,CH2,XREAD,XWRITE
  2802.       INTEGER*2 TLINE(264),X,BELL,FINDLN
  2803.       INTEGER MAXLEN,RecLen,LUN
  2804.       INTEGER UserRecL, NSects, DefRecL
  2805.       CHARACTER*12 FileName
  2806.       COMMON /NEWREC/ UserRecL,NSects
  2807.       DATA ISEND /83,69,78,68,10002/,  MAXLEN/12/, DefRecL/80/
  2808.  
  2809.       LUN=LOCALOUTFD
  2810.       MOREFILE(1)=BIGM
  2811.       MOREFILE(2)=BIGO
  2812.       MOREFILE(3)=BIGR
  2813.       MOREFILE(4)=BIGE
  2814.       MOREFILE(5)=BIGF
  2815.       MOREFILE(6)=BIGI
  2816.       MOREFILE(7)=BIGL
  2817.       MOREFILE(8)=BIGE
  2818.       MOREFILE(9)=LF
  2819.       MOREFILE(10)=EOS
  2820.       UserRecL=DefRecL    ; Initialize for Temporary files
  2821.       RecLen=UserRecL
  2822.       BELL=7
  2823.       Q8BCHR=AMPER   ; Initialize 8-bit quote before INIT
  2824.       XREAD=0
  2825.       XWRITE=1
  2826. C
  2827.       A1=1
  2828.       FLAG=FINDLN(ALIN,ISEND,A1,Z1)
  2829.       A1=Z1+1
  2830.       CALL SKIPBL(ALIN,A1)
  2831.       IF(ALIN(A1).EQ.LF)THEN
  2832.          WRITE(LUN,1020)
  2833.          RETURN
  2834.       ENDIF
  2835. C
  2836.       IF(ALIN(A1).EQ.ATSIGN)THEN         ;is it a directory file
  2837.          A1=A1+1
  2838.          B1=1
  2839.          TPNAME(1)=LF
  2840.          TPNAME(2)=EOS
  2841.          CALL SCOPY(ALIN,A1,TPNAME,B1)
  2842.          CH1=AOPEN(TXTFILE,TPNAME,XREAD)         ;open that directory
  2843.          IF(CH1.EQ.BAD)THEN              ;does it exist ?
  2844.              CALL PACK(TPNAME,FileName)
  2845.              WRITE(LUN,1030) FileName
  2846.              WRITE(20,1030) FileName
  2847.              RETURN
  2848.          ENDIF
  2849.          CALL REMOVE(MOREFILE)           ;yes, remove temp file
  2850.          HoldFlag=FNamChek
  2851.          FNamChek=NO
  2852.          CH2=AOPEN(TXTFILE,MOREFILE,XWRITE)      ;open it for writing
  2853.          FNamChek=HoldFlag  ; Restore Collision flag
  2854.          IF(CH2.EQ.BAD)THEN
  2855.             CALL PACK(MOREFILE,FileName)
  2856.             WRITE(LUN,1040) FileName
  2857.             WRITE(20,1040) FileName
  2858.             CALL RATCLOSE(CH1)
  2859.             RETURN
  2860.          ENDIF
  2861.   100    IF (DGETLIN(TXTFILE,TLINE,CH1).NE.EOF)THEN  ;copy Dir
  2862.             CALL DPUTLIN(TXTFILE,TLINE,CH2,RecLen) ;into temp file
  2863.             GOTO 100       ; Loop till out of Filenames
  2864.          ENDIF
  2865.          CALL RATCLOSE(CH1)              ;close directory channel
  2866.          CALL RATCLOSE(CH2)              ;close temporary file
  2867.       ELSE
  2868.           B1=1                           ;it is not a directory
  2869.           CALL SCOPY(ALIN,A1,TPNAME,B1)
  2870.           CALL REMOVE(MOREFILE)          ;remove temporary file
  2871.           HoldFlag=FNamChek    ; Save File RENEW
  2872.           FNamChek=NO
  2873.           CH1=AOPEN(TXTFILE,MOREFILE,XWRITE)     ;open it for writing
  2874.           FNamChek=HoldFlag
  2875.           IF(CH1.EQ.BAD)THEN
  2876.              CALL PACK(MOREFILE,FileName)
  2877.              WRITE(LUN,1040) FileName
  2878.              WRITE(20,1040) FileName
  2879.           ENDIF
  2880.           CH2=AOPEN(FMode,TPNAME,XREAD)     ;does that single source
  2881.           IF(CH2.EQ.BAD)THEN          ;file exist ??
  2882.              CALL PACK(TPNAME,FileName)
  2883.              WRITE(LUN,1060) FileName
  2884.              WRITE(20,1060) FileName
  2885.              CALL RATCLOSE(CH1)
  2886.              RETURN
  2887.           ELSE
  2888.               CALL RATCLOSE(CH2)      ;yes it does
  2889.           ENDIF
  2890.           CALL DPUTLIN(TXTFILE,TPNAME,CH1,RecLen) ;write name of
  2891.           CALL RATCLOSE(CH1)  ;single source file and the temp file
  2892.       ENDIF
  2893. C
  2894.       IF(HOSTON.EQ.YES)THEN    ; 'REMOTE HOST' mode
  2895.          WRITE(LUN,1010)
  2896.          CALL XDELAY(DELAY)
  2897.          STATUS=SENDSW(X)             ;send the requested file
  2898.       ELSE
  2899. CC       CALL SETRAW(RMTINFD,RMTTTY)      ; LOCAL mode
  2900. CC       CALL SETPAR(RMTOUTFD,RMTTTY)     ; (These routines left
  2901. CC       CALL SETBAUD(RMTOUTFD,RMTTTY)    ; for reference in
  2902. CC       CALL SETPORT(RMTINFD,RMTTTY)     ; using LOCAL mode)
  2903.          STATUS=SENDSW(X)
  2904. CC       CALL SETCOOK(RMTINFD,RMTTTY)
  2905. CC       CALL TPUTCH(BELL,LOCALSLU)
  2906. CC       CALL TPUTCH(BELL,LOCALSLU)
  2907.          IF(STATUS.EQ.YES)THEN
  2908.             WRITE(LUN,1000) 'COMPLETED'
  2909.          ELSE
  2910.             WRITE(LUN,1000) 'FAILED'
  2911.          ENDIF
  2912.       ENDIF
  2913.       RETURN
  2914.  1000 FORMAT(/' File transfer ',A)
  2915.  1010 FORMAT(/' Return to Local Kermit & RECEIVE...'/)
  2916.  1020 FORMAT(/' Proper format is  SEND FILENAME  or SEND @FILENAME')
  2917.  1030 FORMAT(/' Source of directory file not found --> ',A,'  ')
  2918.  1040 FORMAT(/' Unable to open temporary file --> ',A,'  ')
  2919.  1060 FORMAT(/' Source file does not exist --> ',A,'  ')
  2920.       END
  2921. $NLIST
  2922. C------------------------------------------------------------------
  2923.       SUBROUTINE SSERVER
  2924. C
  2925. C -- Put Kermit-CO into SERVER mode.  In this state, it simply waits
  2926. C    for a remote Kermit to intiate some activity.  Every 30 seconds,
  2927. C    a  NAK packet is sent down the line in case a remote Kermit has
  2928. C    stalled.  SERVER mode is active until shut down by remote user.
  2929. C
  2930. C     Implementation projected for Version 3.0:
  2931. C             GET fname     - Kermit-CO send requested file
  2932. C             RECEIVE       - Kermit-CO responds to File Header packet
  2933. C                             by preparing to receive files
  2934. C             BYE,FINISH    - Deactivate SERVER, return to LOCAL mode
  2935. C-----------------------------------------------------------------
  2936. $INCLUDE KERCOM (NLIST)
  2937. $NLIST
  2938. $INCLUDE KERDEF (NLIST)
  2939. $NLIST
  2940.       INTEGER LUN
  2941.       LUN=LOCALOUTFD
  2942.       WRITE(LUN,1000)
  2943.       RETURN
  2944.  1000 FORMAT(/' The SERVER is currently not at yr service...')
  2945.       END
  2946. $NLIST
  2947. C-----------------------------------------------------------------
  2948.       SUBROUTINE SSET(ALIN)
  2949. C
  2950. C     Parse and set various selectable parameters
  2951. C
  2952. C     JL 5/1/84 10:00
  2953. C-----------------------------------------------------------------
  2954. $INCLUDE KERCOM  (NLIST)
  2955. $NLIST
  2956. $INCLUDE KERDEF  (NLIST)
  2957. $NLIST
  2958.       INTEGER*2 ALIN(1)
  2959.       INTEGER*2 A1,T1,T2,T3,T4,T5,T6,TV,CHARTOI
  2960.       INTEGER*2 FLAG1,FLAG2,FLAG3,FLAG4,FLAG5,FLAG6,FLAG7
  2961.       INTEGER*2 FLAG8,FLAG9,FLAG10,FLAG11,FLAG12,FLAG13,FLAG14,FLAG15
  2962.       INTEGER*2 FLAG16, FLAG17, FLAG18
  2963.       INTEGER*2 F1,F2,F3,F4,F5,F6,F7,F8,F9,F10,F11,F12,F13,F14,F15,
  2964.      1          F16,F17,F18
  2965.       INTEGER*2 Z1,Z2,Z3,Z4,Z5,Z6,Z7,Z8,Z9,Z10,Z11,Z12,Z13,Z14,Z15,
  2966.      1          Z16,Z17,Z18
  2967. C
  2968.       INTEGER*2 IBAUD(5),IDELAY(6),IPARITY(7),IODD(4)
  2969.       INTEGER*2 IEVEN(5),IMARK(5),ISPACE(6),INONE(5)
  2970.       INTEGER*2 IIBM(4),ION(3),IOFF(4),IESCAPE(7),ILINE(5)
  2971.       INTEGER*2 IPROMPT(7),IPACKET(7),ISOH(4),IEOL(4)
  2972.       INTEGER*2 IQUOTE(8),ISET(4),IPAD(4),INPAD(6),I8BIT(5)
  2973.       INTEGER*2 IDEBUG(6),IFILE(5),ITEXT(5),IBIN(7),IFCHEK(6)
  2974.       INTEGER*2 ISEOR(5),ICR(3),ILF(3),ICRLF(5),ICONTIG(7)
  2975.       INTEGER LUN
  2976. C
  2977. C Various keyword character strings initialized here
  2978.       DATA IBAUD   /66,65,85,68,10002/
  2979.       DATA IDELAY  /68,69,76,65,89,10002/
  2980.       DATA IPARITY /80,65,82,73,84,89,10002/
  2981.       DATA IODD    /79,68,68,10002/
  2982.       DATA IEVEN   /69,86,69,78,10002/
  2983.       DATA IMARK   /77,65,82,75,10002/
  2984.       DATA ISPACE  /83,80,65,67,69,10002/
  2985.       DATA INONE   /78,79,78,69,10002/
  2986.       DATA IIBM    /73,66,77,10002/
  2987.       DATA ION     /79,78,10002/
  2988.       DATA IOFF    /79,70,70,10002/
  2989.       DATA IESCAPE /69,83,67,65,80,69,10002/
  2990.       DATA ILINE   /76,73,78,69,10002/
  2991.       DATA IPROMPT /80,82,79,77,80,84,10002/
  2992.       DATA IPACKET /80,65,67,75,69,84,10002/
  2993.       DATA ISOH    /83,79,72,10002/
  2994.       DATA IEOL    /69,79,76,10002/
  2995.       DATA IQUOTE  /77,89,81,85,79,84,69,10002/
  2996.       DATA INPAD   /78,80,65,68,83,10002/     ; 'NPADS'
  2997.       DATA IPAD    /80,65,68,10002/           ; 'PAD' character
  2998.       DATA I8BIT   /56,66,73,84,10002/        ; '8BIT'
  2999.       DATA IDEBUG  /68,69,66,85,71,10002/     ; 'DEBUG'
  3000.       DATA IFILE   /70,73,76,69,10002/        ; 'FILE'
  3001.       DATA ITEXT   /84,69,88,84,10002/        ; 'TEXT'
  3002.       DATA IBIN    /66,73,78,65,82,89,10002/  ; 'BINARY'
  3003.       DATA IFCHEK  /70,67,72,69,75,10002/     ; 'FCHEK'
  3004.       DATA ISEOR   /83,69,79,82,10002/        ; 'SEOR'
  3005.       DATA ICR     /67,82,10002/              ; 'CR'
  3006.       DATA ILF     /76,70,10002/              ; 'LF'
  3007.       DATA ICRLF   /67,82,76,70,10002/        ; 'CRLF'
  3008.       DATA ICONTIG /67,79,78,84,73,71,10002/  ; 'CONTIG'
  3009. C................................................................
  3010.       LUN=LOCALOUTFD     ; Get Output LU of CON:
  3011. C Convert various keyword character string into integer array
  3012. C  and add an extra EOS to the end of the integer array
  3013.       A1=1
  3014.       FLAG1=FINDLN(ALIN,ISET,A1,Z1)   ;look for the keyword SET
  3015.       A1=A1+1
  3016.       CALL SKIPBL(ALIN,A1)            ;skip any blanks any tabs
  3017.       TV=A1
  3018.       F1=TV
  3019. C
  3020.       FLAG1=FINDLN(ALIN,IBAUD,F1,Z1)     ;look for BAUD
  3021.       F2=TV
  3022.       FLAG2=FINDLN(ALIN,IDELAY,F2,Z2)    ;look for DELAY
  3023.       F3=TV
  3024.       FLAG3=FINDLN(ALIN,IPARITY,F3,Z3)   ;look for PARITY
  3025.       F4=TV
  3026.       FLAG4=FINDLN(ALIN,IIBM,F4,Z4)      ;look for IBM
  3027.       F5=TV
  3028.       FLAG5=FINDLN(ALIN,IESCAPE,F5,Z5)   ;look for ESCAPE
  3029.       F6=TV
  3030.       FLAG6=FINDLN(ALIN,ILINE,F6,Z6)     ;look for LINE
  3031.       F7=TV
  3032.       FLAG7=FINDLN(ALIN,IPROMPT,F7,Z7)   ;look for PROMPT
  3033.       F8=TV
  3034.       FLAG8=FINDLN(ALIN,IPACKET,F8,Z8)   ;look for PACKET
  3035.       F9=TV
  3036.       FLAG9=FINDLN(ALIN,ISOH,F9,Z9)      ;look for SOH
  3037.       FLAG10=NO
  3038.       Z10=0
  3039.       F11=TV
  3040.       FLAG11=FINDLN(ALIN,IQUOTE,F11,Z11) ;look for QUOTE
  3041.       F12=TV
  3042.       FLAG12=FINDLN(ALIN,INPAD,F12,Z12)  ;look for NPAD
  3043.       F13=TV
  3044.       FLAG13=NO
  3045.       Z13=0
  3046. CCC   FLAG13=FINDLN(ALIN,IPAD,F13,Z13)   ;look for PAD (3/19/86 OFF)
  3047.       F14=TV
  3048.       FLAG14=FINDLN(ALIN,I8BIT,F14,Z14)  ;look for 8BIT
  3049.       F15=TV
  3050.       FLAG15=FINDLN(ALIN,IDEBUG,F15,Z15) ;look for DEBUG
  3051.       F16=TV
  3052.       FLAG16=FINDLN(ALIN,IFILE,F16,Z16) ;look for FILE  3/19/86
  3053.       F17=TV
  3054.       FLAG17=FINDLN(ALIN,IFCHEK,F17,Z17) ;look for FCHEK  4/4/86
  3055.       F18=TV
  3056.       FLAG18=FINDLN(ALIN,ISEOR,F18,Z18) ;look for SEOR  4/16/86
  3057. C
  3058.       IF(FLAG1.EQ.YES)THEN            ;set baud
  3059.          IF(SBAUD.EQ.YES)THEN
  3060.             IF(HOSTON.EQ.YES)THEN
  3061.                WRITE(LUN,100)
  3062.                RETURN
  3063.             ENDIF
  3064.             F1=Z1+1
  3065.             CALL SKIPBL(ALIN,F1)      ;skip any blanks or tabs
  3066.             X=CHARTOI(ALIN,F1)
  3067.             IF(X.EQ.300)THEN          ; BAUD = 300
  3068.                     SPEED=300
  3069.             ELSE IF(X.EQ.1200)THEN    ; BAUD = 1200
  3070.                     SPEED=1200
  3071.             ELSE IF(X.EQ.2400)THEN    ; BAUD = 2400
  3072.                     SPEED=2400
  3073.             ELSE IF(X.EQ.4800)THEN    ; BAUD = 4800
  3074.                     SPEED=4800
  3075.             ELSE IF(X.EQ.9600)THEN    ; BAUD = 9600
  3076.                     SPEED=9600
  3077.             ELSE
  3078.                 WRITE(LUN,102)
  3079.                 RETURN
  3080.             ENDIF
  3081.          ELSE
  3082.             WRITE(LUN,103)
  3083.          ENDIF
  3084.       ELSE IF(FLAG2.EQ.YES)THEN       ;set delay
  3085.               IF(HOSTON.EQ.NO)THEN
  3086.                  WRITE(LUN,104)
  3087.                  RETURN
  3088.               ENDIF
  3089.               F2=Z2+1
  3090.               CALL SKIPBL(ALIN,F2)
  3091.               X=CHARTOI(ALIN,F2)
  3092.               IF(X.LT.0)THEN
  3093.                  WRITE(LUN,105)
  3094.                  RETURN
  3095.               ELSE IF(X.GT.30)THEN
  3096.                    WRITE(LUN,106)
  3097.                       DELAY=30
  3098.                       RETURN
  3099.               ELSE
  3100.                   DELAY=X
  3101.                   RETURN
  3102.               ENDIF
  3103.       ELSE IF(FLAG3.EQ.YES)THEN       ;set parity
  3104.               IF(SPARITY.EQ.YES)THEN
  3105. ****             IF(HOSTON.EQ.YES)THEN
  3106. ****                WRITE(LUN,108)
  3107. ****                RETURN         ; in LOCAL mode
  3108. ****             ENDIF
  3109.                  F3=Z3+1
  3110.                  CALL SKIPBL(ALIN,F3) ;skip any blanks or tabs
  3111.                  TV=F3
  3112.                  T1=FINDLN(ALIN,IEVEN,TV,T6) ;look for EVEN
  3113.                  TV=F3
  3114.                  T2=FINDLN(ALIN,IODD,TV,T6)  ;look for ODD
  3115.                  TV=F3
  3116.                  T3=FINDLN(ALIN,ISPACE,TV,T6);look for SPACE
  3117.                  TV=F3
  3118.                  T4=FINDLN(ALIN,IMARK,TV,T6) ;look for MARK
  3119.                  TV=F3
  3120.                  T5=FINDLN(ALIN,INONE,TV,T6) ;look for NONE
  3121.                  IF(T1.EQ.YES)THEN
  3122.                     PARITY=1              ;set parity EVEN
  3123.                     TMode=TXTFILE    ; 7 bit ASCII transfer
  3124.                     MYQUOT8B=YES  ;Set 8 bit prefixing for EVEN
  3125.                  ELSE IF(T2.EQ.YES)THEN
  3126.                          PARITY=2         ;set parity ODD
  3127.                          TMode = TXTFILE  ; 7 bit ASCII
  3128.                          MYQUOT8B=YES ;Set 8bit prefix
  3129.                  ELSE IF(T3.EQ.YES)THEN
  3130.                       WRITE(LUN,110)
  3131.                          RETURN
  3132.                  ELSE IF(T4.EQ.YES)THEN
  3133.                          WRITE(LUN,111)
  3134.                          RETURN
  3135.                  ELSE IF(T5.EQ.YES)THEN
  3136.                          PARITY=5         ;set parity NONE
  3137.                          TMode = BINFILE  ; 8 bit IMAGE transfer
  3138.                          MYQUOT8B=NO     ;Turn off 8bit prefixing
  3139.                  ELSE
  3140.                      WRITE(LUN,112)
  3141.                      RETURN
  3142.                  ENDIF
  3143.              ELSE
  3144.                  WRITE(LUN,113)
  3145.                  RETURN
  3146.              ENDIF
  3147.       ELSE IF(FLAG4.EQ.YES)THEN           ;set IBM
  3148.               IF(HOSTON.EQ.YES)THEN
  3149.                  WRITE(LUN,114)
  3150.                  RETURN
  3151.               ENDIF
  3152.               F4=Z4+1
  3153.               CALL SKIPBL(ALIN,F4)        ;skip any blanks or tabs
  3154.               TV=F4
  3155.               TV1=FINDLN(ALIN,ION,TV,T6)  ;look for keyword ON
  3156.               TV=F4
  3157.               TV2=FINDLN(ALIN,IOFF,TV,T6) ;look for keyword OFF
  3158.               IF(TV1.EQ.YES)THEN
  3159.                  IBMON=YES                ;set IBM flag ON
  3160.               ELSE IF(TV2.EQ.YES)THEN
  3161.                       IBMON=NO            ;set IBM flag OFF
  3162.               ELSE
  3163.                   WRITE(LUN,116)
  3164.                   RETURN
  3165.               ENDIF
  3166.       ELSE IF(FLAG5.EQ.YES)THEN           ;set escape
  3167.               IF(HOSTON.EQ.YES)THEN
  3168.                  WRITE(LUN,117)
  3169.                  RETURN
  3170.               ENDIF
  3171.               F5=Z5+1
  3172.               CALL SKIPBL(ALIN,F5)       ;skip any blanks or tabs
  3173.               X=CHARTOI(ALIN,F5)
  3174.               IF((X.GT.0).AND.(X.LT.32))THEN
  3175.                   ESCHAR=X
  3176.               ELSE
  3177.                   WRITE(LUN,119)
  3178.                   RETURN
  3179.               ENDIF
  3180.       ELSE IF(FLAG6.EQ.YES)THEN          ;set remote line
  3181.               IF(HOSTON.EQ.YES)THEN
  3182.                  WRITE(LUN,120)
  3183.                  RETURN
  3184.               ENDIF
  3185.               IF(SPORT.EQ.YES)THEN       ;is set line supported ??
  3186.                  F6=Z6+1
  3187.                  CALL SKIPBL(ALIN,F6)    ;skip any blanks or tab
  3188.                  A1=1
  3189.                  CALL SCOPY(ALIN,F6,RMTTTY,A1) ;store remote filename
  3190.                  RETURN
  3191.               ELSE
  3192.                   WRITE(LUN,121)
  3193.                   RETURN
  3194.               ENDIF
  3195.       ELSE IF(FLAG7.EQ.YES)THEN          ;set IBM prompt
  3196.               IF(HOSTON.EQ.YES)THEN
  3197.                  WRITE(LUN,123)
  3198.                  RETURN
  3199.               ENDIF
  3200.               F7=Z7+1
  3201.               CALL SKIPBL(ALIN,F7)      ;skip any blanks or tabs
  3202.               X=CHARTOI(ALIN,F7)
  3203.               IF((X.EQ.EOL).OR.(X.EQ.SOH))THEN
  3204.                   WRITE(LUN,125)
  3205.                   RETURN
  3206.               ELSE
  3207.                   IF((X.GT.0).AND.(X.LT.32))PROMPT=X
  3208.               ENDIF
  3209.       ELSE IF(FLAG8.EQ.YES)THEN         ;set packet size
  3210.               F8=Z8+1
  3211.               CALL SKIPBL(ALIN,F8)
  3212.               X=CHARTOI(ALIN,F8)
  3213.               IF((X.GT.30).AND.(X.LT.95))THEN
  3214.                   PAKSIZ=X
  3215.                   RETURN
  3216.               ELSE
  3217.                   WRITE(LUN,126)
  3218.                   RETURN
  3219.               ENDIF
  3220.       ELSE IF(FLAG9.EQ.YES)THEN         ;set SOH
  3221.               F9=Z9+1
  3222.               CALL SKIPBL(ALIN,F9)      ;skip any blanks or tabs
  3223.               X=CHARTOI(ALIN,F9)
  3224.               IF(HOSTON.EQ.YES)THEN
  3225.                  IF(X.EQ.EOL)THEN
  3226.                     WRITE(LUN,127)
  3227.                     RETURN
  3228.                  ELSE
  3229.                      IF((X.GT.0).AND.(X.LT.32))THEN
  3230.                          SOH=X
  3231.                          RETURN
  3232.                      ELSE
  3233.                          WRITE(LUN,128)
  3234.                          RETURN
  3235.                      ENDIF
  3236.                  ENDIF
  3237.               ELSE
  3238.                   IF((X.EQ.EOL).OR.(X.EQ.PROMPT))THEN
  3239.                       WRITE(LUN,129)
  3240.                       RETURN
  3241.                   ELSE
  3242.                       IF((X.GT.0).AND.(X.LT.32))THEN
  3243.                           SOH=X
  3244.                           RETURN
  3245.                       ELSE
  3246.                           WRITE(LUN,128)
  3247.                           RETURN
  3248.                       ENDIF
  3249.                   ENDIF
  3250.               ENDIF
  3251.       ELSE IF(FLAG10.EQ.YES)THEN      ;set EOL
  3252.               F10=Z10+1
  3253.               CALL SKIPBL(ALIN,F10)
  3254.               X=CHARTOI(ALIN,F10)
  3255.               IF(HOSTON.EQ.YES)THEN
  3256.                  IF(X.EQ.SOH)THEN
  3257.                     WRITE(LUN,133)
  3258.                     RETURN
  3259.                  ELSE
  3260.                      IF((X.GT.0).AND.(X.LT.32))THEN
  3261.                          MYEOL=X
  3262.                          RETURN
  3263.                      ELSE
  3264.                          WRITE(LUN,134)
  3265.                          RETURN
  3266.                      ENDIF
  3267.                  ENDIF
  3268.               ELSE
  3269.                   IF((X.EQ.SOH).OR.(X.EQ.PROMPT))THEN
  3270.                       WRITE(LUN,136)
  3271.                       RETURN
  3272.                   ELSE
  3273.                       IF((X.GT.0).AND.(X.LT.32))THEN
  3274.                           MYEOL=X
  3275.                           RETURN
  3276.                       ELSE
  3277.                           WRITE(LUN,134)
  3278.                           RETURN
  3279.                       ENDIF
  3280.                   ENDIF
  3281.                ENDIF
  3282.       ELSE IF(FLAG11.EQ.YES)THEN      ;set myquote
  3283.               F11=Z11+1
  3284.               CALL SKIPBL(ALIN,F11)
  3285.               X=CHARTOI(ALIN,F11)
  3286.               IF((X.GT.32).AND.(X.LT.127))THEN
  3287.                   MYQUOTE=X
  3288.                   RETURN
  3289.               ELSE
  3290.                   WRITE(LUN,140)
  3291.                   RETURN
  3292.               ENDIF
  3293. C...................................added 12/20/84 - PM
  3294.       ELSE IF(FLAG12.EQ.YES)THEN      ;set MYPAD (Number of Pad chars)
  3295.               F12=Z12+1
  3296.               CALL SKIPBL(ALIN,F12)
  3297.               X=CHARTOI(ALIN,F12)
  3298.               IF((X.GE.0).AND.(X.LT.101))THEN    ; 100 Pad chr Max
  3299.                   MYPAD=X
  3300.                   RETURN
  3301.               ELSE
  3302.                   WRITE(LUN,143)
  3303.                   RETURN
  3304.               ENDIF
  3305.       ELSE IF(FLAG13.EQ.YES)THEN      ;set MYPCHAR
  3306.               F13=Z13+1
  3307.               CALL SKIPBL(ALIN,F13)
  3308.               X=CHARTOI(ALIN,F13)
  3309.                MYPCHAR=X
  3310.                RETURN
  3311.       ELSE IF(FLAG14.EQ.YES)THEN   ; Set 8-Bit Quoting On/Off
  3312.               F14=Z14+1
  3313.               CALL SKIPBL(ALIN,F14)
  3314.               TV=F14
  3315.               T1=FINDLN(ALIN,ION,TV,T6)  ; look for ON
  3316.               TV=F14
  3317.               T2=FINDLN(ALIN,IOFF,TV,T6)  ; look for OFF
  3318.               IF (T1.EQ.YES) THEN     ; Turn 8-Bit Quoting ON
  3319.                  MYQUOT8B=YES        ; Set 8-Bit quoting ON
  3320.                  Q8BCHR=AMPER
  3321.               ELSE
  3322.                  IF (T2.EQ.YES) THEN  ; Turn 8-Bit Quoting OFF
  3323.                     MYQUOT8B=NO         ; by setting to 'N'
  3324.                     Q8BCHR=0
  3325.                  ELSE
  3326.                     WRITE(LUN,145)       ; ERROR
  3327.                  ENDIF
  3328.               ENDIF
  3329.               RETURN
  3330.       ELSE IF(FLAG15.EQ.YES)THEN   ; Set DEBUGON On/Off
  3331.               F15=Z15+1
  3332.               CALL SKIPBL(ALIN,F15)
  3333.               TV=F15
  3334.               T1=FINDLN(ALIN,ION,TV,T6)  ; look for ON
  3335.               TV=F15
  3336.               T2=FINDLN(ALIN,IOFF,TV,T6)  ; look for OFF
  3337.               IF (T1.EQ.YES) THEN     ; Turn DEBUG ON
  3338.                  DEBUGON=YES
  3339.               ELSE
  3340.                  IF (T2.EQ.YES) THEN  ; Turn DEBUG OFF
  3341.                     DEBUGON=NO         ; by setting to 'N'
  3342.                  ELSE
  3343.                     WRITE(LUN,146)       ; ERROR
  3344.                  ENDIF
  3345.               ENDIF
  3346.               RETURN
  3347.       ELSE IF(FLAG16.EQ.YES)THEN   ; Set FILE Mode Text/Binary/Contig
  3348.               F16=Z16+1
  3349.               CALL SKIPBL(ALIN,F16)
  3350.               TV=F16
  3351.               T1=FINDLN(ALIN,ITEXT,TV,T6)  ; TEXT?
  3352.               TV=F16
  3353.               T2=FINDLN(ALIN,IBIN,TV,T6)  ; BINARY?
  3354.               TV=F16
  3355.               T3=FINDLN(ALIN,ICONTIG,TV,T6)  ; CONTIGUOUS?
  3356.               IF (T1.EQ.YES) THEN
  3357.                  FMode = TXTFILE     ; TEXT/ASCII  (SSEND) mode
  3358.                  SendEOR = 3         ; EOR = CR/LF
  3359.               ELSE
  3360.                  IF (T2.EQ.YES) THEN
  3361.                     FMode = BINFILE ; BINARY/IMAGE mode
  3362.                     SendEOR = NO    ; EOR = None
  3363.                  ELSE
  3364.                     IF (T3.EQ.YES) THEN
  3365.                        FMode = CONFILE  ;CONTIG/IMAGE mode
  3366.                        SendEOR = NO     ;EOR=None
  3367.                     ELSE
  3368.                        WRITE(LUN,147)
  3369.                     ENDIF
  3370.                  ENDIF
  3371.               ENDIF
  3372.       ELSE IF(FLAG17.EQ.YES)THEN   ; Set FCHEK On/Off
  3373.               F17=Z17+1
  3374.               CALL SKIPBL(ALIN,F17)
  3375.               TV=F17
  3376.               T1=FINDLN(ALIN,ION,TV,T6)  ; look for ON
  3377.               TV=F17
  3378.               T2=FINDLN(ALIN,IOFF,TV,T6)  ; look for OFF
  3379.               IF (T1.EQ.YES) THEN     ; Turn File Name Check ON
  3380.                  FNamChek=YES
  3381.               ELSE
  3382.                  IF (T2.EQ.YES) THEN  ; Turn FNamChek OFF
  3383.                     FNamChek=NO         ; by setting to 'N'
  3384.                  ELSE
  3385.                     WRITE(LUN,149)       ; ERROR
  3386.                  ENDIF
  3387.               ENDIF
  3388.               RETURN
  3389.       ELSE IF(FLAG18.EQ.YES)THEN   ; Set SEOR = NONE,CR,LF,CRLF
  3390.               F18=Z18+1
  3391.               CALL SKIPBL(ALIN,F18)
  3392.               TV=F18
  3393.               T1=FINDLN(ALIN,INONE,TV,T6)  ; look for NONE
  3394.               IF (T1.EQ.YES) THEN
  3395.                  SendEOR=NO    ; No End-of-Rec delimiter used
  3396.               ELSE
  3397.                  TV=F18
  3398.                  T1=FINDLN(ALIN,ICRLF,TV,T6)  ; look for CRLF
  3399.                  IF (T1.EQ.YES) THEN
  3400.                     SendEOR=3      ; CRLF  for End-of-Record
  3401.                  ELSE
  3402.                     TV=F18
  3403.                     T1=FINDLN(ALIN,ILF,TV,T6)  ; look for LF
  3404.                     IF (T1.EQ.YES) THEN
  3405.                        SendEOR=2      ; LF used for End-of-Record
  3406.                     ELSE
  3407.                        TV=F18
  3408.                        T1=FINDLN(ALIN,ICR,TV,T6)  ; look for CR
  3409.                        IF (T1.EQ.YES) THEN
  3410.                           SendEOR=1      ; CR used for End-of-Record
  3411.                        ELSE
  3412.                           WRITE(LUN,150)  ; Error in SEOR parm
  3413.                        ENDIF
  3414.                     ENDIF
  3415.                  ENDIF
  3416.               ENDIF
  3417.               RETURN
  3418.       ELSE
  3419.           WRITE(LUN,142)
  3420.           RETURN
  3421.       ENDIF
  3422.       RETURN
  3423. C.............................................................
  3424. 100   FORMAT(/' Baud rate setting not supported in Remote Host')
  3425. 102   FORMAT(/' Invalid or Unsupported baud rate selected')
  3426. 103   FORMAT(/' Kermit-CO 2.1 does not support Baud selection')
  3427. 104   FORMAT(/' Delay setting not valid in Local Host mode')
  3428. 105   FORMAT(/' Invalid delay setting')
  3429. 106   FORMAT(/' Maximium Delay is 30 seconds')
  3430. C 108 FORMAT(/' Parity setting not supported in Remote Host mode')
  3431. 110   FORMAT(/' SPACE parity not supported')
  3432. 111   FORMAT(/' MARK parity not supported')
  3433. 112   FORMAT(/' Parity selected not valid')
  3434. 113   FORMAT(/' Parity setting not supported in this system')
  3435. 114   FORMAT(/' SET IBM ON/OFF not supported in Remote Host mode')
  3436. 116   FORMAT(/' Invalid SET IBM mode selected')
  3437. 117   FORMAT(/' Escape setting not valid in Remote Host mode')
  3438. 119   FORMAT(/' Escape character must be between 0 & 32')
  3439. 120   FORMAT(/' SET LINE not valid in Remote Host mode')
  3440. 121   FORMAT(/' SET remote line not supported in Remote Host mode')
  3441. 123   FORMAT(/' SET IBM PROMPT not valid in Remote Host mode')
  3442. 125   FORMAT(/' Invalid: in conflict with EOL or SOH')
  3443. 126   FORMAT(/' Packet size must be between 31 & 94')
  3444. 127   FORMAT(/' In conflict with EOL')
  3445. 128   FORMAT(/' SOH must be between 0 & 32')
  3446. 129   FORMAT(/' In conflict with EOL or IBM prompt')
  3447. 133   FORMAT(/' In conflict with SOH')
  3448. 134   FORMAT(/' EOL must be between 0 & 32')
  3449. 136   FORMAT(/' EOL in conflict with SOH or IBM prompt')
  3450. 140   FORMAT(/' QUOTE char must be between 32 & 127')
  3451. 142   FORMAT(/' A SET parameter is incorrect')
  3452. 143   FORMAT(/' Number of Pads must be between 0 & 100')
  3453. 145   FORMAT(/' 8 Bit quoting can be only ON or OFF')
  3454. 146   FORMAT(/' DEBUG can be only ON or OFF')
  3455. 147   FORMAT(/' File mode must be TEXT, BINARY, or CONTIG')
  3456. *148  FORMAT(/' BINARY mode requires a NO PARITY line')
  3457. 149   FORMAT(/' File Name Check (FCHEK) can be only ON or OFF')
  3458. 150   FORMAT(/' Send EOR (SEOR) must be NONE, CR, LF, or CRLF')
  3459.       END
  3460. $NLIST
  3461. C-----------------------------------------------------------------
  3462.       SUBROUTINE SSTATUS
  3463. C
  3464. C     Output the status and values of variables
  3465. C
  3466. C     JL 4/19/84 9:03
  3467. C-----------------------------------------------------------------
  3468. $INCLUDE KERCOM  (NLIST)
  3469. $NLIST
  3470. $INCLUDE KERDEF  (NLIST)
  3471. $NLIST
  3472.       CHARACTER*3 DBG,QUOTE8,FCK,ITSON,ITSOFF
  3473.       CHARACTER*5 PARTYPE(5),SEORTYPE(4)
  3474.       CHARACTER*6 FileType(3)
  3475.       INTEGER LUN, ITemp
  3476.       DATA ITSON/' ON'/, ITSOFF/'OFF'/
  3477.       DATA PARTYPE/' EVEN','  ODD','SPACE',' MARK',' NONE'/
  3478.       DATA SEORTYPE/' NONE','   CR','   LF',' CRLF'/
  3479.       DATA FileType/'  TEXT','BINARY','CONTIG'/
  3480.       LUN=LOCALOUTFD   ; for CON: output
  3481.       QUOTE8=ITSOFF
  3482.       IF (MYQUOT8B.EQ.YES) QUOTE8=ITSON
  3483.       DBG=ITSOFF
  3484.       IF (DEBUGON.EQ.YES) DBG=ITSON
  3485.       FCK=ITSOFF
  3486.       IF (FNamChek.EQ.YES) FCK=ITSON
  3487.       IF(HOSTON.EQ.YES)THEN       ;we are running in remote host mode
  3488.          WRITE(LUN,107)
  3489.          WRITE(LUN,111) PARTYPE(PARITY)
  3490.          WRITE(LUN,124) FileType(FMode)
  3491.          WRITE(LUN,125) FCK
  3492.          WRITE(LUN,122) QUOTE8     ; PM 1/84/84
  3493.          WRITE(LUN,104) DELAY
  3494.          WRITE(LUN,100) PAKSIZ
  3495.          WRITE(LUN,121) MYPAD      ; No. Pad Chars requested  PM 11/84
  3496.          ITemp=SendEOR+1
  3497.          WRITE(LUN,126) SEORTYPE(ITemp)
  3498.          WRITE(LUN,123) DBG     ; DM 1/84
  3499.          IF (DEBUGON.EQ.YES) THEN  ;Display only if DEBUG on
  3500.             WRITE(LUN,102)MYQUOTE
  3501.             WRITE(LUN,101)SOH
  3502.             WRITE(LUN,103)MYEOL
  3503.             IF(STATE.EQ.BIGC)THEN
  3504.                WRITE(LUN,108) 'Complete'
  3505.             ELSE
  3506.                WRITE(LUN,108) ' Aborted'
  3507.             ENDIF
  3508.          ENDIF
  3509.       ELSE
  3510.          WRITE(LUN,110)
  3511.          WRITE(LUN,106)SPEED
  3512.          WRITE(LUN,105)ESCHAR
  3513.          IF(IBMON.EQ.YES)THEN
  3514.             WRITE(LUN,117) ITSON
  3515.             WRITE(LUN,119)PROMPT
  3516.          ELSE
  3517.             WRITE(LUN,117) ITSOFF
  3518.          ENDIF
  3519.          WRITE(LUN,100)PAKSIZ
  3520.          WRITE(LUN,111) PARTYPE(PARITY)
  3521.          WRITE(LUN,116)
  3522.          WRITE(LUN,121) MYPAD              ; PM 12/20/84
  3523.          WRITE(LUN,122) QUOTE8
  3524.          WRITE(LUN,111) PARTYPE(PARITY)
  3525.          WRITE(LUN,123) DBG
  3526.          WRITE(LUN,124) FileType(FMode)
  3527.          WRITE(LUN,125) FCK
  3528.          WRITE(LUN,122) QUOTE8     ; PM 1/84/84
  3529.          ITemp=SendEOR+1
  3530.          WRITE(LUN,126) SEORTYPE(ITemp)
  3531.          IF (DEBUGON.EQ.YES) THEN
  3532.          WRITE(LUN,103)MYEOL
  3533.             WRITE(LUN,102)MYQUOTE
  3534.             WRITE(LUN,101)SOH
  3535.             IF(STATE.EQ.BIGC)THEN
  3536.                WRITE(LUN,108) 'Complete'
  3537.             ELSE
  3538.                WRITE(LUN,108) ' Aborted'
  3539.             ENDIF
  3540.          ENDIF
  3541. CCCCC    WRITE(LUN,120) MYPCHAR            ; PM 12/20/84
  3542.       ENDIF
  3543.       RETURN
  3544. C.................................................................
  3545.   110 FORMAT(/' ','LOCAL Kermit mode in effect:'/)
  3546.   107 FORMAT(/' ','REMOTE Kermit Host in effect:'/)
  3547.   116 FORMAT(' ','   Remote TTY line used is ??')
  3548.   100 FORMAT(' ','   Packet Size            - ',4X,I4)
  3549.   101 FORMAT(' ','   Start-of-packet char   - ',4X,I4)
  3550.   102 FORMAT(' ','   Control char prefix    - ',4X,I4)
  3551.   103 FORMAT(' ','   End-of-packet char     - ',4X,I4)
  3552.   104 FORMAT(' ','   Send Delay (seconds)   - ',4X,I4)
  3553.   105 FORMAT(' ','   Escape Character       - ',4X,I4)
  3554.   106 FORMAT(' ','   Baud Rate              - ',4X,I4)
  3555.   108 FORMAT(' ','   Transfer State         - ',A8)
  3556.   111 FORMAT(' ','   Parity                 - ',3X,A5)
  3557.   117 FORMAT(' ','   IBM Flag               - ',5X,A3)
  3558.   119 FORMAT(' ','   IBM Prompt             - ',4X,I4)
  3559. C 120 FORMAT(' ','   Pad Character          - ',4X,I4)
  3560.   121 FORMAT(' ','   Number of Pad chars    - ',4X,I4)
  3561.   122 FORMAT(' ','   8th Bit Prefixing      - ',5X,A3)
  3562.   123 FORMAT(' ','   Debug Packet Recording - ',5X,A3)
  3563.   124 FORMAT(' ','   File Mode              - ',2X,A6)
  3564.   125 FORMAT(' ','   File Name Check        - ',5X,A3)
  3565.   126 FORMAT(' ','   Send End-of-Rec char   - ',3X,A5)
  3566.       END
  3567. $NLIST
  3568. C     -----------------------------------------------------------------
  3569.       INTEGER*2 FUNCTION TOCHAR(CH)
  3570. C
  3571. C     JL 4/19/84 9:05
  3572. C     -----------------------------------------------------------------
  3573.       INTEGER*2 CH
  3574. $INCLUDE KERDEF  (NLIST)
  3575. $NLIST
  3576.       TOCHAR=CH+BLANK
  3577.       RETURN
  3578.       END
  3579. $NLIST
  3580. C-----------------------------------------------------------------
  3581.       INTEGER*2 FUNCTION UNCHAR(CH)
  3582. C
  3583. C     JL 4/19/84 9:05
  3584. C-----------------------------------------------------------------
  3585.       INTEGER*2 CH
  3586. $INCLUDE KERDEF  (NLIST)
  3587. $NLIST
  3588.       UNCHAR=CH-BLANK
  3589.       RETURN
  3590.       END
  3591. $NLIST
  3592. C-----------------------------------------------------------------
  3593.       SUBROUTINE UPPER(ALIN,BLIN)
  3594. C
  3595. C  Convert lower (ALIN) to upper case (BLIN)
  3596. C
  3597. C      JL 4/19/84
  3598. C-----------------------------------------------------------------
  3599.       INTEGER*2 ALIN(1),BLIN(1),A1
  3600. $INCLUDE KERDEF  (NLIST)
  3601. $NLIST
  3602.       A1=1
  3603.   100 IF (ALIN(A1).NE.EOS) THEN
  3604.          IF((ALIN(A1).GT.96).AND.(ALIN(A1).LT.123))THEN
  3605.              BLIN(A1)=ALIN(A1)-32
  3606.          ELSE
  3607.              BLIN(A1)=ALIN(A1)
  3608.          ENDIF
  3609.          A1=A1+1
  3610.          GOTO 100
  3611.       ENDIF
  3612.       BLIN(A1)=EOS
  3613.       RETURN
  3614.       END
  3615. $NLIST
  3616. C-----------------------------------------------------------------
  3617.       SUBROUTINE VERIFY(TFILE)
  3618. C
  3619. C  Verify that the filename is usable under OS/32
  3620. C    -Checks for XXXXXXXX.XXX filename format, turns
  3621. C      illegal characters (and periods in excess of 1) to 'X',
  3622. C      and limits name to 12 characters......
  3623. C      However, VERIFY does not deal with cases where the FileName
  3624. C      has more than 8 Characters before the period (e.g. 'XXXXXXXXX')
  3625. C      or more than 3 chars after. (e.g. XX.XXXX)
  3626. C      These illegal names will be flagged in AOPEN, and the
  3627. C      attempted SEND/RECEIVE will be terminated.  Individual
  3628. C      sites may want to customize this routine to preference.
  3629. C
  3630. C     JL 4/19/84 9:05
  3631. C     PM 2/85
  3632. C-----------------------------------------------------------------
  3633.       INTEGER*2 INFILE(132),OUTFILE(132),TFILE(1)
  3634.       INTEGER*2 AONE,BONE,TEMP,PERFREQ,ICHAR,MAXLEN/12/
  3635. $INCLUDE KERDEF  (NLIST)
  3636. $NLIST
  3637.       AONE=1
  3638.       BONE=1
  3639.       TEMP=1
  3640.       PERFREQ=0
  3641.       CALL UPPER(TFILE,INFILE)
  3642.       DO 100 I=1,132
  3643.          TFILE(I)=BLANK
  3644.          OUTFILE(I)=BLANK
  3645.   100 CONTINUE
  3646. C
  3647. C Loop thru characters in File Name... Replace illegal chars with 'A'
  3648. C   (OS/32 Format = XXXXXXXX.XXX) (More Exacting checks can be added)
  3649.   200 ICHAR=INFILE(TEMP)           ;Current Character
  3650.       IF ((ICHAR.NE.LF).AND.(ICHAR.NE.EOS)) THEN
  3651.          IF((ICHAR.GT.64).AND.(ICHAR.LT.91))GOTO 290  ; Letter??
  3652.          IF((ICHAR.GT.47).AND.(ICHAR.LT.58))GOTO 290  ; Number??
  3653.          IF (ICHAR.EQ.PERIOD) THEN
  3654.             IF (PERFREQ.LT.1) THEN         ; First Period??
  3655.                PERFREQ=PERFREQ+1   ; Only one Period per filename
  3656.                GOTO 290
  3657.             ENDIF
  3658.          ENDIF
  3659.          ICHAR=BIGX         ; 'X' for illegal chars
  3660.   290    OUTFILE(TEMP)=ICHAR     ; Further checking here
  3661.          TEMP=TEMP+1
  3662.          GOTO 200     ; Next character
  3663.       ENDIF
  3664. C
  3665. C     OS/32  allows maximium of 12 characters per filename
  3666. C         (First character may not be numeric)
  3667.       IF((OUTFILE(1).GT.47).AND.(OUTFILE(1).LT.58)) THEN
  3668.          OUTFILE(1)=BIGX
  3669.       ENDIF
  3670.       OUTFILE(MAXLEN+1)=EOS    ; Limit Name to legal max
  3671.       CALL SCOPY(OUTFILE,AONE,TFILE,BONE)
  3672.       RETURN
  3673.       END
  3674. $NLIST
  3675. C-----------------------------------------------------------------
  3676.       SUBROUTINE XDELAY(X)
  3677. C
  3678. C     Delay the calling program for x seconds
  3679. C
  3680. C     JL 4/25/84 13:40
  3681. C-----------------------------------------------------------------
  3682.       INTEGER ISTAT,IX
  3683.       INTEGER*2 X
  3684.       IX=X
  3685.       CALL WAIT(IX,2,ISTAT)       ; Wait X seconds
  3686.       RETURN
  3687.       END
  3688. $NLIST
  3689. C-----------------------------------------------------------------
  3690.       INTEGER*2 FUNCTION GETLIN(ALIN,CH)
  3691. C
  3692. C   Read a line from the channel and unpack it
  3693. C      - A Formatted (ASCII) or Unformatted (IMAGE) read may be
  3694. C        done, depending on value of 'TMode'
  3695. C
  3696. C     PM 4/86
  3697. C     JL 5/8/84 10:40 AM
  3698. C-----------------------------------------------------------------
  3699. $INCLUDE KERCOM  (NLIST)
  3700. $NLIST
  3701. $INCLUDE KERDEF  (NLIST)
  3702. $NLIST
  3703.       INTEGER ITEMP*4,ICHRS*2(66) ; Full-Word align ICHRS
  3704.       INTEGER IPCBLK(6),IOS,LUN,LEN,MAXREC,LENX, TV4
  3705.       INTEGER IWAIT,IREAD(2),RXOPT(2),IWRIT(2),WXOPT(2),XXON
  3706.       INTEGER*2 ALIN(1),CH,INPCHAR,ACOUNT,TV2,INPCNT
  3707.       CHARACTER CHARINP*2,TV1*2
  3708.       EQUIVALENCE (INPCHAR,CHARINP)
  3709.       EQUIVALENCE (TV1,TV2)
  3710.       PARAMETER (MAXREC=130)    ; Maximum Rec size written
  3711.       DATA XXON/Z11000000/, IWAIT/Z08/
  3712. C 7 bit, Even parity, ASCII
  3713.       DATA IREAD(1)/Z49/,RXOPT(1)/Z38000000/  ;ASCII,Echo off
  3714.       DATA IWRIT(1)/Z29/,WXOPT(1)/Z00000000/   ;ASCII
  3715. C 8 bit, No parity, IMAGE
  3716.       DATA IREAD(2)/Z59/,RXOPT(2)/Z10000000/ ;IMAGE,Echo off
  3717.       DATA IWRIT(2)/Z39/,WXOPT(2)/Z00000000/  ;IMAGE
  3718. C..............................................................
  3719. C  Initialize the ALIN array
  3720.       DO  10 I=1,132
  3721.    10 ALIN(I)=0
  3722.       ACOUNT=0
  3723.       LEN=MAXREC        ; Max line that can be read
  3724.       LUN=CH           ; *2 to *4 variable for SYSIO
  3725. C
  3726. C Send out XON to trigger send (Just testing...this would be used to
  3727. C emulate IBM protocol, make micro await "Prompt"(DC10 before sending)
  3728. C     CALL SYSIO(IPCBLK2,IWRIT(TMode),LUN,XXON,1,0,WXOPT(TMode)) ;XON
  3729. C
  3730. C.....WAIT for last PUTLIN to finish
  3731.       CALL SYSIO(IPCBLK,IWAIT,LUN,0,0,0,Y'00000000') ;WAIT I/O done
  3732.  
  3733. C Read in Line/Packet from CON: until MYEOL encountered (CR)
  3734.       IF (TMode.EQ.TXTFILE) THEN     ; ASCII
  3735.          CALL SYSIO(IPCBLK,Y'49',LUN,ICHRS(1),LEN,0,Y'38000000') ;GL
  3736.       ELSE                           ; IMAGE
  3737.          CALL SYSIO(IPCBLK,Y'59',LUN,ICHRS(1),LEN,0,Y'10000000') ;GL
  3738.       ENDIF
  3739.       CALL IOERR(IPCBLK,IOS)          ; Check status
  3740.       IF (IOS.NE.0) THEN
  3741.          WRITE(20,100) IOS
  3742.          GOTO 900
  3743.       ENDIF
  3744. C
  3745.       LEN = IPCBLK(5)         ; Get length of last receive
  3746.       IF (DEBUGON.EQ.YES) THEN   ; Write out packet if DEBUG on
  3747.          WRITE(20,120) LEN,(ICHRS(I),I=1,LEN/2)
  3748.       ENDIF
  3749. C
  3750. C  Unpack line into ALIN..................UPDATE 9/15/85 (D.MacPhee)
  3751.       LENX = LEN/2 + 1
  3752.       DO 205 I=1,LENX
  3753.          INPCHAR = ICHRS(I)
  3754.          DO 200 K=1,2
  3755.          TV2 =0
  3756.          TV1(2:2) = CHARINP(K:K)
  3757.          IF (PARITY.NE.5) THEN    ; IF EVEN/ODD, strip 8th bit
  3758.             TV4=TV2
  3759.             TV2=IAND(TV4,127)
  3760.          ENDIF
  3761.          IF (TV2.EQ.MYEOL) GOTO 210
  3762.          ACOUNT = ACOUNT + 1
  3763.          ALIN(ACOUNT) = TV2
  3764.   200    CONTINUE
  3765.   205 CONTINUE
  3766.       GOTO 890     ; MYEOL not found
  3767.  
  3768. C Here if MYEOL found
  3769.   210 ALIN(ACOUNT+1)=LF
  3770.       ALIN(ACOUNT+2)=EOS       ; Mark end of input line
  3771.       GETLIN=OK
  3772.       RETURN                   ; Successful end-of-operation
  3773.  
  3774. C.....................................UPDATE 9/15/85  (David MacPhee)
  3775. C Here if No MYEOL on current packet
  3776.   890 WRITE (20,*) ' GETLIN Error: Never found MYEOL'
  3777.  
  3778.   900 GETLIN=EOF        ; Error on read
  3779.       RETURN
  3780.   100 FORMAT(' GETLIN - BAD I/O: ',I4)
  3781.   120 FORMAT(' ',I3,' RPACK=',63A2)
  3782.       END
  3783. $NLIST
  3784. C-----------------------------------------------------------------
  3785.       INTEGER*2 FUNCTION GETKEYBD(ALIN,CH)
  3786. C
  3787. C   Read a line from the Keyboard and unpack it
  3788. C
  3789. C     PM 8/84
  3790. C-----------------------------------------------------------------
  3791. $INCLUDE KERCOM  (NLIST)
  3792. $NLIST
  3793. $INCLUDE KERDEF  (NLIST)
  3794. $NLIST
  3795.       INTEGER*2 ALIN(1),CH,ACOUNT,TV2,INPCHAR,SPBS,PRMPT
  3796.       INTEGER IPCBLK(6),IREAD(2),RXOPT(2),IOS,LUN,MAXREC,ITEMP,TV4
  3797.       CHARACTER CHARINP*2,TV1*2
  3798.       EQUIVALENCE (INPCHAR,CHARINP)
  3799.       EQUIVALENCE (TV1,TV2)
  3800.       PARAMETER (MAXREC=130)    ; Maximum Rec size read
  3801.       DATA SPBS/Z2008/, PRMPT/Z3E00/    ; SP/BS     '>'
  3802. C 7 Bit, Even parity, Formatted
  3803.       DATA IREAD(1)/Z49/,RXOPT(1)/Z00000000/  ;ASCII Rd,Echo on (CON:)
  3804. C 8 Bit, No parity, IMAGE
  3805.       DATA IREAD(2)/Z59/,RXOPT(2)/Z00000000/  ;IMAGE Rd,Echo ON (CON:)
  3806. C...............................................................
  3807. C  Initialize the ALIN array
  3808.       DO 100 I=1,132
  3809.   100 ALIN(I)=0
  3810.       ACOUNT=0
  3811.       LUN=CH           ; *2 to *4 variable for SYSIO
  3812. C
  3813. C Read in Characters one at a time until MYEOL encountered
  3814.       DO 200 I=1,MAXREC
  3815.       IF (TMode.EQ.TXTFILE) THEN     ; ASCII
  3816.          CALL SYSIO(IPCBLK,Y'49',LUN,INPCHAR,1,0,Y'00000000') ;GK
  3817.       ELSE                           ; IMAGE
  3818.          CALL SYSIO(IPCBLK,Y'59',LUN,INPCHAR,1,0,Y'00000000') ;GK
  3819.       ENDIF
  3820.       CALL IOERR(IPCBLK,IOS)          ; Check status
  3821.       IF (IOS.GT.0) GOTO 900
  3822.       TV2=0
  3823.       TV1(2:2)=CHARINP(1:1)       ; Shift Byte to right
  3824.       IF (PARITY.NE.5) THEN    ; IF EVEN/ODD, strip 8th bit
  3825.          TV4=TV2
  3826.          TV2=IAND(TV4,127)
  3827.       ENDIF
  3828.       IF (TV2.EQ.MYEOL) GOTO 210    ; End input when <CR> found
  3829.       IF (TV2.EQ.BACKSPACE) THEN    ; Allow destructive BS
  3830.          IF (ACOUNT.GT.0) THEN
  3831.             ALIN(ACOUNT)=0
  3832.             ACOUNT=ACOUNT-1      ; BS encountered only on CON:
  3833.             CALL PUTSTRNG(LOCALOUTFD,2,SPBS) ;erase BS'd char
  3834.          ELSE
  3835.             CALL PUTSTRNG(LOCALOUTFD,1,PRMPT) ;Stop at Prompt
  3836.          ENDIF
  3837.          GOTO 200                ; Skip BS under any condition
  3838.       ENDIF
  3839.       ACOUNT=ACOUNT+1
  3840.       ALIN(ACOUNT)=TV2
  3841.   200 CONTINUE
  3842.   210 ALIN(ACOUNT+1)=LF
  3843.       ALIN(ACOUNT+2)=EOS       ; Mark end of input line
  3844.       GETKEYBD=OK
  3845.       RETURN                   ; Successful end-of-operation
  3846.  
  3847.   900 GETKEYBD=EOF        ; Error on read
  3848.       RETURN
  3849.       RETURN
  3850.       END
  3851. $NLIST
  3852. C-----------------------------------------------------------------
  3853.       SUBROUTINE PUTLIN(ALIN,CH)
  3854. C
  3855. C  Pack a line and send it down the channel to remote KERMIT.
  3856. C      - A Formatted (ASCII) or Unformatted (IMAGE) write may be
  3857. C        done, depending on value of 'TMode'
  3858. C
  3859. C     JL 4/25/84 14:15      ** PM 11/84
  3860. C-----------------------------------------------------------------
  3861. $INCLUDE KERCOM (NLIST)
  3862. $NLIST
  3863. $INCLUDE KERDEF (NLIST)
  3864. $NLIST
  3865.       INTEGER LEN*4,BLIN*2(132)           ; FullWord align BLIN
  3866.       INTEGER IPCBLK(6), LUN, IOS
  3867.       INTEGER IWRIT(2), WXOPT(2), IWAIT
  3868.       INTEGER*2 ALIN(1),CH,TV2
  3869.       INTEGER*2 LEFT,RIGHT,WHICHS,STATUS,ACOUNT,BCOUNT
  3870.       INTEGER*2 TCOUNT,INPCHAR,OUTCHAR
  3871.       CHARACTER CHARINP*2,CHAROUT*2
  3872.       INTEGER TV1,ITEMP,ITEMP2,RITECR,LEFTCR
  3873.       EQUIVALENCE(INPCHAR,CHARINP)
  3874.       EQUIVALENCE(OUTCHAR,CHAROUT)
  3875.       DATA IWAIT/Z08/
  3876. C 7 bit, Even parity, Formatted
  3877.       DATA IWRIT(1)/Z21/,WXOPT(1)/Z00000000/   ;ASCII Write(No Wait)
  3878. C 8 bit, No parity, IMAGE
  3879.       DATA IWRIT(2)/Z31/,WXOPT(2)/Z00000000/   ;IMAGE Write(No Wait)
  3880. C.........................................................
  3881.       LEFT=1
  3882.       RIGHT=2
  3883.       WHICHS=LEFT
  3884.       ACOUNT=1
  3885.       BCOUNT=1
  3886.       TCOUNT=1
  3887.       LUN=CH
  3888.   901 IF (ALIN(ACOUNT).NE.LF) THEN
  3889.          IF(WHICHS.EQ.LEFT)THEN
  3890.             INPCHAR=ALIN(ACOUNT)
  3891.             OUTCHAR=0
  3892.             CHAROUT(1:1)=CHARINP(2:2)  ; Byte to Left side of BLIN
  3893.             BLIN(BCOUNT)=OUTCHAR
  3894.             WHICHS=RIGHT
  3895.          ELSE
  3896.             OUTCHAR=BLIN(BCOUNT)
  3897.             INPCHAR=ALIN(ACOUNT)
  3898.             CHAROUT(2:2)=CHARINP(2:2)  ; Byte to Right side of BLIN
  3899.             BLIN(BCOUNT)=OUTCHAR
  3900.             WHICHS=LEFT
  3901.             BCOUNT=BCOUNT+1
  3902.          ENDIF
  3903.          ACOUNT=ACOUNT+1
  3904.          TCOUNT=ACOUNT
  3905.          GOTO 901
  3906.       ENDIF
  3907. C
  3908.       IF(WHICHS.EQ.LEFT)THEN
  3909.          INPCHAR=CR
  3910.          OUTCHAR=0
  3911.          CHAROUT(1:1)=CHARINP(2:2)
  3912.          BLIN(BCOUNT)=OUTCHAR
  3913.       ELSE
  3914.          OUTCHAR=BLIN(BCOUNT)
  3915.          INPCHAR=CR
  3916.          CHAROUT(2:2)=CHARINP(2:2)
  3917.          BLIN(BCOUNT)=OUTCHAR
  3918.       ENDIF
  3919.       LEN=TCOUNT
  3920.  
  3921.        IF (DEBUGON.EQ.YES) THEN   ; Save packet if DEBUG mode
  3922.           WRITE(20,120) LEN,(BLIN(I),I=1,LEN/2)
  3923.        ENDIF
  3924.  
  3925.       IF (TMode.EQ.TXTFILE) THEN     ; ASCII
  3926.         CALL SYSIO(IPCBLK,Y'21',LUN,BLIN(1),LEN,0,Y'00000000') ;PL
  3927.       ELSE                           ; IMAGE
  3928.         CALL SYSIO(IPCBLK,Y'31',LUN,BLIN(1),LEN,0,Y'00000000') ;PL
  3929.       ENDIF
  3930.       CALL IOERR(IPCBLK,IOS)
  3931.       IF (IOS.NE.0) THEN
  3932.          WRITE(20,*) ' PUTLIN - SYSIO Error - ',IOS
  3933.       ENDIF
  3934.       RETURN
  3935.   120 FORMAT(' ',I3,' SPACK=',63A2)
  3936.       END
  3937. $NLIST
  3938. C-----------------------------------------------------------------
  3939.       SUBROUTINE PUTSTRNG(LUNX,LenStr,Str)
  3940.  
  3941. C Write out a character string to CON: (LU 1) using SYSIO
  3942. C         (For special cases: Prompt line I/O mostly)
  3943. C-----------------------------------------------------------------
  3944. $INCLUDE KERCOM (NLIST)
  3945. $NLIST
  3946. $INCLUDE KERDEF  (NLIST)
  3947. $NLIST
  3948.       INTEGER LUN,IPCBLK(6),LenStr,IWRIT(2),WXOPT(2),Str*2(50)
  3949.       INTEGER*2 LUNX
  3950. C 7 Bit, Even parity, Formatted Write
  3951.       DATA IWRIT(1)/Z29/,WXOPT(1)/Z00000000/   ;ASCII Write
  3952. C 8 Bit, No Parity, IMAGE Write
  3953.       DATA IWRIT(2)/Z39/,WXOPT(2)/Z00000000/   ;IMAGE Write
  3954.       LUN=LUNX
  3955.       CALL SYSIO(IPCBLK,IWRIT(TMode),LUN,Str(1),LenStr,0,WXOPT(TMode))
  3956.       RETURN
  3957.       END
  3958. $NLIST
  3959. C-----------------------------------------------------------------
  3960.       INTEGER*2 FUNCTION TGETCH(XCHAR,CH)
  3961. C
  3962. C     Get a CHAR from the TTY without echoing it
  3963. C        For use with IBM mode  - Not implemented as of 3/11/85
  3964. C
  3965. C     JL 4/25/84 14:20
  3966. C-----------------------------------------------------------------
  3967. $INCLUDE KERCOM (NLIST)
  3968. $NLIST
  3969. $INCLUDE KERDEF  (NLIST)
  3970. $NLIST
  3971.       INTEGER LUN*4,IBUF*2,XCHAR*2,XCHAR2*2,CH*2
  3972.       INTEGER IPCBLK(6),IREAD(2),IOS,LEN,RXOPT(2)
  3973.       CHARACTER IBUF2*2,XCHAR3*2
  3974.       EQUIVALENCE(XCHAR2,XCHAR3)
  3975.       EQUIVALENCE(IBUF,IBUF2)
  3976. C 7 Bit, Even parity, ASCII
  3977.       DATA IREAD(1)/Z49/, RXOPT(1)/Z38000000/   ;ASCII Rd, Echo off
  3978. C 8 Bit, No parity, IMAGE
  3979.       DATA IREAD(2)/Z59/, RXOPT(2)/Z10000000/   ;IMAGE Rd, Echo off
  3980.       LUN=CH
  3981.       IBUF=0
  3982.       IF (TMode.EQ.TXTFILE) THEN     ; ASCII
  3983.          CALL SYSIO(IPCBLK,Y'49',LUN,IBUF,1,0,Y'38000000') ;TGETCH
  3984.       ELSE                           ; IMAGE
  3985.          CALL SYSIO(IPCBLK,Y'59',LUN,IBUF,1,0,Y'10000000') ;TGETCH
  3986.       ENDIF
  3987.       CALL IOERR(IPCBLK,IOS) ; Check O/P status
  3988.       IF (IOS.LE.0) THEN
  3989.          XCHAR2=0
  3990.          XCHAR3(2:2)=IBUF2(1:1)    ; Shift byte rightmost
  3991.          XCHAR=XCHAR2
  3992.          TGETCH=OK
  3993.          RETURN
  3994.       ELSE        ; Error on Input
  3995.          TGETCH=OK
  3996.          RETURN
  3997.       ENDIF
  3998.       END
  3999. $NLIST
  4000. C-----------------------------------------------------------------
  4001.       SUBROUTINE TPUTCH(XCHAR,CH)
  4002. C
  4003. C     Output a character to the TTY line
  4004. C       (For use with IBM I/O. Not used as of 3/1/85)
  4005. C
  4006. C     JL 4/25/84 14:25
  4007. C-----------------------------------------------------------------
  4008. $INCLUDE KERCOM (NLIST)
  4009. $NLIST
  4010. $INCLUDE KERDEF  (NLIST)
  4011. $NLIST
  4012.       INTEGER LUN*4,IBUF*4,CH*2,XCHAR*2,XCHAR2*2 ;  PW
  4013.       INTEGER IPCBLK(6),IOS,IWRIT(2),WXOPT(2),IWAIT
  4014.       CHARACTER XCHAR3*2,IBUF2*4
  4015.       EQUIVALENCE(XCHAR2,XCHAR3)
  4016.       EQUIVALENCE(IBUF,IBUF2)
  4017.       DATA IWAIT/Z08/
  4018. C 7 bit, Even parity, Formatted
  4019.       DATA IWRIT(1)/Z29/,WXOPT(1)/Z00000000/   ;ASCII Write
  4020. C 8 bit, No parity, IMAGE
  4021.       DATA IWRIT(2)/Z39/,WXOPT(2)/Z00000000/   ;IMAGE Write
  4022. C..............................................................
  4023.       LUN=CH
  4024.       IBUF=0
  4025.       XCHAR2=XCHAR
  4026.       IBUF2(1:1)=XCHAR3(2:2)  ; Shift Byte leftmost
  4027. C.....WAIT for I/O to finish on CON:
  4028. CCC   CALL SYSIO(IPCBLK,IWAIT,LUN,0,0,0,Y'00000000') ;WAIT I/O done
  4029.  
  4030. C  WRite out the character
  4031.       IF (TMode.EQ.TXTFILE) THEN     ; ASCII
  4032.          CALL SYSIO(IPCBLK,Y'29',LUN,IBUF,1,0,Y'00000000') ;TPUTCH
  4033.       ELSE                           ; IMAGE
  4034.          CALL SYSIO(IPCBLK,Y'39',LUN,IBUF,1,0,Y'00000000') ;TPUTCH
  4035.       ENDIF
  4036.       CALL IOERR(IPCBLK,IOS)
  4037.       IF (IOS.NE.0) THEN
  4038.          WRITE (20,*) 'TPUTCH - SYSIO error - ',IOS
  4039.       ENDIF
  4040.       RETURN
  4041.       END
  4042. $NLIST
  4043. C---------------------------------------------------------------
  4044.       SUBROUTINE DATETIME(Day,Sec,FDay,FSec)
  4045. C
  4046. C  Return formatted Date and Time of Right Now.
  4047. C---------------------------------------------------------------
  4048.       INTEGER Today(3), Now(3)
  4049.       CHARACTER Day*6, Sec*6, FDay*8, FSec*8, Char*2
  4050.       CALL DATE(Today)
  4051.       Day = '000000'
  4052.       L = 2
  4053.       DO 10 I=1,3
  4054.       Char = ITOC(Today(I),K)
  4055.       IF (K.EQ.1) THEN
  4056.          Day(L:L)  = Char
  4057.       ELSE
  4058.          Day(L-1:L) = Char
  4059.       ENDIF
  4060.    10 L = L + 2
  4061.       FDay = Day(3:4)//'/'//Day(5:6)//'/'//Day(1:2)  ; MM/DD/YY
  4062.       CALL TIME(Now)
  4063.       Sec = '000000'
  4064.       L=2
  4065.       DO 20 I=1,3
  4066.       Char = ITOC(Now(I),K)
  4067.       IF (K.EQ.1) THEN
  4068.          Sec(L:L) = Char
  4069.       ELSE
  4070.          Sec(L-1:L) = Char
  4071.       ENDIF
  4072.    20 L = L + 2
  4073.       FSec = Sec(1:2)//':'//Sec(3:4)//':'//Sec(5:6)
  4074.       RETURN
  4075.       END
  4076.