Trailing-Edge
-
PDP-10 Archives
-
bb-d857a-sm_dx_tops20_v1_src
-
dx/sources/wp8pip.for
There is 1 other file named wp8pip.for in the archive. Click here to see a list.
C PACKAGE : DX/TOPS20
C VERSION : V1.0
C OP. SYSTEM : TOPS20 V3.0
C
C PROGRAM : WPIP
C MODULE : WP8PIP.FOR
C MODULE # : 1 OF 13
C EDIT : 043
C EDIT DATE : 10-AUG-78
C
C
C
C**********************************************************************
C
C C O P Y R I G H T
C
C
C COPYRIGHT (C) 1978
C DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASSACHUSETTS
C
C
C THIS SOFTWARE IS FURNISHED UNDER A LICENSE FOR USE ONLY ON A
C SINGLE COMPUTER SYSTEM AND MAY BE COPIED ONLY WITH THE
C INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE, OR
C ANY OTHER COPIES THEREOF, MAY NOT BE PROVIDED OR OTHERWISE
C MADE AVAILABLE TO ANY OTHER PERSON EXCEPT FOR USE ON SUCH
C SYSTEM AND TO ONE WHO AGREES TO THESE LICENSE TERMS. TITLE TO
C AND OWNERSHIP OF THE SOFTWARE SHALL AT ALL TIMES REMAIN IN
C DIGITAL.
C
C THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT
C NOTICE AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL
C EQUIPMENT CORPORATION.
C
C DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY
C OF ITS SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED BY DIGITAL.
C
C**********************************************************************
C
C
C E D I T H I S T O R Y
C
C
C EDIT #000 1/3/78 KENT BLACKETT
C
C EDIT #001 2/1/78 J.COHEN
C ALLOW MESSAGE DURING TRANSMISSION
C
C EDIT #002 2/1/78 J.COHEN
C ELIMINATE EXTRA SPACES IN FILE-NAME
C
C EDIT #003 2/1/78 J.COHEN
C IMPLEMENT BYE PACKET
C
C EDIT #004 2/2/78 J.COHEN
C ALLOW FOR DEFAULT EXTENSION = "WP8"
C
C EDIT #005 2/4/78 J. COHEN
C INITIAL IMPLEMENTATION OF PROMPT PACKETS.
C
C EDIT #006 2/4/78 G. A. REID
C CHANGE SO THAT ALL USER DIALOGUE IS TO THE WPS
C STATION AND NOT TO A SECOND TERMINAL.
C INCLUDED THE ABILITY TO USE A SECOND TERMINAL, LATER
C THIS CODE WILL BE ALTERED SO THAT IT IS ONLY COMPILED
C WHEN USING THE 'DEBUG' COMPILER SWITCH.
C
C EDIT #007 2/14/78 J. COHEN
C IMPLEMENTATION OF ERROR MESSAGES 103 AND 104.
C
C EDIT #008 2/14/78 J. COHEN
C ALLOW FOR OPTIONS TO OVERWRITE, ADD TO TOP AND
C ADD TO BOTTOM OF A FILE.
C
C EDIT #009 2/14/78 G. A. REID
C ADD FILENAME VERIFICATION AND DEFAULT EXTENSION 'WP8'.
C
C EDIT #010 2/15/78 J. COHEN
C CHANGED CONTENTS OF ERROR MESSAGES TO NOT INCLUDE
C 'Message - ' AND RELATED CODE CHANGES.
C FIXED A PROBLEM WHICH CAUSED US TO ALWAYS GO TO THE
C RECEIVE CODE (FSN 100).
C WE NOW CLEAR THE MESSAGE BUFFER TO ELIMINATE PREVIOUS
C CONTENTS, IF ANY.
C
C EDIT #011 2/15/78 G. A. REID
C CORRECTIONS TO ENABLE HOST TO ADD TO 'B'OTTOM OR TO
C 79VERWRITE AN EXISTING FILE. ANOTHER PLACE WAS
C FOUND WHERE 'BUF' HAD TO BE PADDED WITH SPACES TO
C CLEAR OUT ANY POSSIBLE PREVIOUS CONTENTS.
C
C EDIT #012 2/15/78 J. COHEN
C ALLOW ANSWER TO 'ARE YOU A WPS STATION?' TO BY A 89 OR
C OR A 121.
C CHANGE CODE TO PROMPT AGAIN FOR THE FILENAME IF AN
C 83 OR AN 82 RESPONSE IS RECEIVED WHICH IS FOLLOWED
C BY JUST A SPACE WITH NO FILENAME.
C CORRECTION TO CODE WHICH HANDLES THE ADD TO TOP OPTION.
C
C EDIT #013 2/16/78 J. COHEN
C ADD CODE TO TELL WPS TO SET UP FOR RECEIVING A
C TOPS20 FILE.
C ALTER FILENAME CHECK FOR LEGAL CHARACTERS.
C ANOTHER CORRECTION TO EDIT #010.
C
C EDIT #014 2/16/78 G. A. REID
C CHANGES MADE NECESSARY BECAUSE WE MOVED THE CONVERSION
C FROM LOWERCASE TO UPPERCASE AND CHECKING FOR RESPONSE
C TO PROMPT PACKETS TO THE 'PROMPT' SUBROUTINE.
C
C EDIT #015 2/16/78 J. COHEN
C CHANGES MADE NECESSARY BY EDIT #014.
C CODING CHANGES TO MAKE THE NECESSARY ORDER OF CALLS
C FOR SENDING A TOPS20 FILE TO WPS.
C
C EDIT #016 2/16/78 G. A. REID
C CHANGE SO THAT NULL RESPONSES TO PROMPTS CAUSE THE FLOW
C OF CONTROL TO BUBBLE UP TO THE NEXT HIGHER COMMAND LEVEL.
C ALSO, MODIFY TO PROPERLY ACT ON RESPONSES OTHER THAN 89
C (I.E. ALTERED FLOW OF CONTROL).
C IMPLEMENT MESSAGE 105 INDICATING AN ILLEGAL FILENAME:
C Message - 105. [Filename] is an illegal name.
C
C EDIT #017 2/17/78 J. COHEN
C ALTER FLOW OF LOGICAL IN THE CASE OF AN 'R'ECEIVE TRANSFER
C TO: 1) PROMPT FOR A 89ES REPLY ON CORRECT ACTION,
C 2) SEND MESSAGE TO WPS TO SET UP FOR RECEIVE STATE
C 3) WAIT FOR REPLY = 'M OK' AND CONTINUE OR
C A NULLSTRING TO START OVER
C
C EDIT #018 2/28/78 J. COHEN
C ADD CODE TO CONVERT 'START-OF-DOCUMENT' PACKETS TO
C HEADER BLOCKS FOR THE TOPS20 FILES AS WELL AS CONVERTING
C HEADER BLOCKS TO 'START-OF-DOCUMENT' PACKETS WHEN
C SENDING A TOPS20 FILE TO THE WPS SYSTEM.
C ALTER CODE TO ELIMINATE EXTRANEOUS 'END-OF-DOCUMENT'
C PACKETS IN CASE ADDING TO THE TOP OR BOTTOM
C OF AN EXISTING FILE.
C
C EDIT #019 3/2/78 J. COHEN
C CLOSE ALL FILES AFTER DXINIT TO AVOID POSSIBLE
C ERROR CONDITION ON AN 'OPEN' STATEMENT. ALSO
C CHECK FOR AN 'OK-TO-SEND' PACKET FROM WPS AFTER
C TOPS20 HAS SENT THE 'START-OF-DOCUMENT' AND BEFORE
C TOPS20 SENDS THE FIRST 'TEXT-OF-DOCUMENT'.
C
C EDIT #020 3/2/78 G. A. REID
C INITIALIZE 'FNAME' BEFORE USING IT. THIS IS NECESSARY
C TO CLEAR OUT A FILENAME THAT MAY HAVE PREVIOUSLY BEEN
C PROCESSED AND WHO'S LENGTH IS GREATER THAN THE NEXT ONE
C TO BE HANDLED. AVOIDS FILENAME SPECIFICATION ERRORS.
C ALSO, FIX SO THAT THE ADD-TO-BOTTOM CASE (WHERE THE
C HOST IS RECEIVING) WRITES THE END-OF-DOCUMENT RECORD.
C
C EDIT #021 3/2/78 J. COHEN
C CALL 'RECV' AFTER END-OF-FILE ENCOUNTERED ON TOPS20
C FILE. THIS IS DONE TO ENSURE THAT THE LAST PACKET
C WE SENT WAS RECEIVED AND ACK'ED.
C
C EDIT #022 3/3/78 G. A. REID
C PUT IN COPYRIGHT STATEMENT AND RENAMED FROM DX.FTN
C TO WP8PIP.FTN.
C
C EDIT #023 3/3/78 J. COHEN
C INCLUDE A CALL TO 'ERRSET' WHICH WILL INHIBIT AN
C ERROR LISTING OF CERTAIN POTENTIAL BUT NON-CRITICAL
C ERRORS (ERROR #'S ARE THE ONES LISTED IN THE 'DATA'
C STATEMENT FOR 'IERRST').
C IMPLEMENT USE OF 'MESSAGE 106' WHICH INDICATES THAT
C A FILE IS CORRUPTED.
C ALSO IMPLEMENT USE OF 'BYE 202' WHICH INDICATES THAT
C AN EXPECTED RESPONSE FROM THE LOGICAL FLOW OF
C 'WP8PIP' WAS NOT ENCOUNTERED.
C REMOVED 'CLOSE' FILE STATEMENTS AFTER 'DXINIT' BECAUSE
C THEY WERE UNNECESSARY. (REFERENCE EDIT #019).
C SET CURRENT 'DEBUG' CODE ON.
C
C EDIT #024 3/3/78 J. COHEN
C ALTER CHECK FOR 'START-OF-DOCUMENT' CHECK WHEN RECEIVING
C FROM WPS.
C
C EDIT #025 3/6/78 J. COHEN
C FOR WPS RECEIVING ALLOW FOR CHECKING OF CORRECT FILE
C FORMAT BEFORE SENDING THE FILE AND BEFORE PROMPTING
C WPS TO SET UP FOR THE TRANSFER.
C INSERT A TWO SECOND DELAY BEFORE SENDING MESSAGES
C TO WPS.
C TYPE OUT THE 'WP8PIP' PROGRAM IDENTIFICATION:
C 'WP8PIP V1.0'.
C
C EDIT #026 3/6/78 J. COHEN
C ALLOW 'WP8PIP' TO RESTART AFTER USER TYPES
C '<GOLD><HALT>' AND LATER TYPES 'DX <RETURN>'.
C
C EDIT #027 3/6/78 J. COHEN
C CHECK FOR RESTART POSSIBILITY AFTER ALL CALLS TO
C 'PROMPT' AND 'SEND'.
C
C EDIT #028 3/7/78 J. COHEN
C PERFORM HOUSEKEEPING ON ANY OPEN FILES IF FOR ANY
C REASON TRANSMISSION MUST BE STOPPED PREMATURELY.
C ALSO ALLOW WPS TO FINISH ITS PROCESSING IN AN
C ORDERLY MANNER IF THIS CONDITION IS ENCOUNTERED.
C
C EDIT #029 3/7/78 J. COHEN
C IF WPS TRANSMITS AN INCORRECT PACKET, END PROCESSING
C IN AN ORDERLY MANNER AND END FURTHER TRANSMISSION
C BY SENDING A 'BYE' PACKET.
C
C EDIT #030 3/7/78 J. COHEN
C CHANGE THE 2 SECOND DELAY BEFORE A MESSAGE IS
C SENT TO BE 1 SECOND.
C
C EDIT #031 3/8/78 J. COHEN
C ADD 'DEBUG' CODE WHICH CAN BE USED TO CALCULATE
C STATISTICS FOR DETERMINING BAUD RATES.
C
C EDIT #032 3/8/78 J. COHEN
C INFORM USER OF AN EMPTY FILE CONDITION.
C INFORM USER OF A CORRUPTED FILE CONDITION WHICH
C OCCURED IN THE MIDDLE OF THE FILE TRANSFER AND
C FORCED AN EARLY 'END-OF-DOCUMENT' TO BE SENT.
C ALSO ALLOW FOR A POSSIBLE TIMEOUT OF 1 MINUTE
C IN THE CASE WHERE THE WPS USER FIRST TYPED
C 83 FILE THEN TYPED 82 DOCUMENT. SHOULD THIS
C SITUATION ARISE RESTART.
C ALLOW TOPS20 TO RECOGNIZE A "164 CODE WHICH SAYS THAT
C WPS DOES NOT HAVE ENOUGH ROOM ON ITS DISKETTE TO
C RECEIVE THE FILE WE ARE ABOUT TO SEND DOWN
C
C EDIT #033 3/9/78 J. COHEN
C CHANGE THE WAIT TIME FOR ERROR MESSAGES SO THAT
C THE TOTAL ELAPSED TIME IS 10 SECONDS.
C ADD COMMENTS WHICH WILL LABEL EACH SECTION OF
C THE PROGRAM.
C
C EDIT #034 3/13/78 J. COHEN
C INFORM USER THAT THEIR FILE IS EMPTY OR CORRUPTED
C IN THE CASE OF ADDING TO TOP/BOTTOM. ALSO ALLOW FOR
C A 1 MINUTE TIME OUT IF WE ARE EXPECTING AN 'M OK'
C MESSAGE AND DON'T RECEIVE IT.
C CHANGE ALL CARRIAGE CONTROL OPTIONS ON THE 'OPEN'
C STATEMENTS TO BE 'LIST' NOT 'NONE'.
C
C EDIT #035 3/13/78 J. COHEN
C IF USER TYPES OTHER THAN 'M OK' WHEN WPS IS IN
C THE RECEIVE STATE SEND AN ERROR MESSAGE INFORMING
C THE USER OF THIS. INSERT A WAIT AFTER A 'BYE'
C PACKET HAS BEEN SENT.
C
C**********************************************************************
C**********************************************************************
C
C EDIT #036 3/15/78 J. COHEN
C EDITS FROM THIS POINT ON ARE FOR TOPS20 COMPATIBILITY.
C MAKE CHANGES TO 'LOGICAL*1' DECLARATIVES AND ALL 'OPEN'
C STATEMENTS.
C
C EDIT #037 3/17/78 J. COHEN
C ADD CALLS TO 'DTECVT' AND 'TIMER' WHICH WILL CONVERT
C THE SYSTEM DATE AND TIME RESPECTIVELY, FORM ASCII TO
C INTEGER FORMAT FOR USE IN THE HEADER BLOCK IN THE
C FORMER AND THE STATISTICS ROUTINE IN THE LATER.
C ALSO ADD CODE WHICH WILL FORM A 'DOUBLE PRECISION'
C VARIABLE FOR THE FILE NAME TO BE USED IN ALL THE
C 'OPEN' STATEMENTS.
C
C EDIT #038 3/20/78 J. COHEN
C CHANGE THE CALL TO 'WAIT' TO A CALL OF A MACRO ROUTINE
C WHICH DOES THE ACTUAL WAIT.
C
C EDIT #039 3/28/78 J. COHEN
C CHANGE ALL CALLS TO WAIT TO NOW SET A VALUE IN 'MCOM'
C = TO THE # OF 1/2 SECONDS REQUIRED FOR THE WAIT CONDI-
C TION. WHEN THE WAIT IS PERFORMED WE WILL CONTINUE TO
C LOOP ON THE CONDITION WHERE 'ITIME' IS NOT = 0, WHEN
C IT DOES = 0 THIS IMPLIES THAT THE TOTAL WAIT TIME HAS
C BEEN MET.
C
C EDIT #040 3/29/78 J. COHEN
C CHANGE ALL READS, WRITES AND THE APPROPRIATE FORMAT
C TO INCLUDE A 2 DIGIT NUMBER AS THE FIRST ELEMENT
C TO BE READ OR WRITTEN WHICH WILL BE THE SIZE OF
C THE DATA RECORD. ALSO DECREASE THE SIZE OF THE HEADER
C BLOCK FROM 512 CHARACTERS TO 80 (ONLY 78 OF WHICH WILL
C REALLY BE USED) IN ORDER TO MAKE ALL THE RECORDS CON-
C SISTENT.
C
C EDIT #041 5/19/78 J. COHEN
C ALLOW FOR 4 DIGIT DOCUMENT # TO BE PASSED TO LOOKUP.
C IF USER ATTEMPTS TO REFERENCE DOCUMENT #1, SEND AN ERROR
C MESSAGE AND REINITIALIZE.
C
C EDIT #042 6/19/78 J. COHEN
C ALLOW FOR REINITIALIZATION IF PREVIOUS PACKET RECEIVED
C WAS A <GOLD><MENU> ("171).
C
C EDIT #043 8/10/78 J. COHEN
C CHANGE ALL SEQUENTIAL I/O TO RANDOM I/O AND CALL TYPE 2
C RECV BEFORE FINISHING I/O FOR ADD TO TOP CASE.
C
C**********************************************************************
C
C
C
C A R R A Y & C O M M O N D E C L A R A T I O N S
C
IMPLICIT INTEGER (A-Z)
D REAL DELTA,BAUD,ABAUD
DOUBLE PRECISION FILNAM,FNAME,FBLANK
DIMENSION BUF(80),FTEMP(64),DXOPT(2),DC1MSG(44)
1 ,M104(6),M104A(15),M103(6),M103A(9),CLRSCN(65)
2 ,EODBYE(17),RECOPT(2),M108(64),M106(6),M106A(13)
3 ,HEADER(130),HDRTMP(130),CORRUP(64),M107(64)
4 ,BUFBCK(80)
DIMENSION DOCNAM(64),CREDAT(2),MODDAT(2)
COMMON ITMP(6),IERRC,IERRCT,MSGFLG,IBYE
1 ,IFLAG
COMMON /WCOM/ MEF,ITIME,IDU
EQUIVALENCE (FILNAM,FNAME)
C
C I N I T I A L I Z A T I O N A N D C O N S T A N T S
C
DATA LUN/27/
DATA LENHDR/65/
DATA MSGFLG,IBYE,IFLAG/3*0/
DATA EOD/"146/
DATA FBLANK/' '/
C
C EODBYE WILL BE SENT WHEN THE WPS USER HAS TYPED A 'BYE'
C MESSAGE DURING A FILE TRANSFER, IT WILL READ:
C Message - Transfer aborted
C
DATA EODBYE/"142,84,114,97,110,115,102,101,114,32,
1 97,98,111,114,116,101,100/
DATA CLRSCN/"142,64*32/
DATA DXOPT/"153,"044/
DATA RECOPT/"141,"047/
DATA OKSND/"151/
C
C MESSAGE 103 TO INDICATE AN EMPTY FILE:
C Message - 103. [Document] is empty
C
C MESSAGE 104 TO INDICATE A NONEXISTENT FILE:
C Message - 104. [Document] does not exist
C
C MESSAGE 106 TO INDICATE A CORRUPTED FILE:
C Message - 106. [Document] is corrupted
C
C MESSAGE 107 TO INDICATE DOCUMENT NAME IS NOT UNIQUE:
C Message - 107. Non-unique document name - [Document]
C
C MESSAGE 108 TO INDICATE NO T20 FILE EXISTS FOR THIS DOC. NAME
C Message - 108. T20 file does not exist for this
C document name
C
C
DATA M103,M103A,M104,M104A/
1 49,48,51,46,3*32,105,115,32,101,109,112,116,
2 121,49,48,52,46,3*32,100,111,101,115,32,
3 110,111,116,32,101,120,105,115,116/
DATA M106,M106A/
1 49,48,54,46,3*32,105,115,32,99,111,114,
2 114,117,112,116,101,100/
DATA M107/"142,49,48,55,46,32,32,78,111,110,45,117,110,
1 105,113,117,101,32,100,111,99,117,109,101,110,116,
1 32,110,97,109,101,32,45,31*32/
C
DATA M108/"142,49,48,56,46,32,32,84,79,80,83,50,48,32,102,
1 105,108,101,32,100,111,101,115,32,110,111,116,32,101,
2 120,105,115,116,32,102,111,114,32,100,111,99,117,
3 109,101,110,116,18*32/
C
C
C
C MESSAGE TO BE SENT IN THE EVENT A CORRUPTED FILE IS
C DETECTED IN THE MIDDLE OF TRANSMISSION.
C
DATA CORRUP/"142,
1 78,111,110,45,115,116,97,110,100,97,114,100,32,
2 87,80,83,32,102,111,114,109,97,116,32,105,110,32,
3 100,111,99,117,109,101,110,116,28*32/
C
C DC1MSG: *** USER MAY NOT REFERENCE DOCUMENT #1 ***
C
DATA DC1MSG/"142,32,3*42,32,85,83,69,82,32,77,65,89,32,
1 78,79,84,32,82,69,70,69,82,69,78,67,69,32,
1 68,79,67,85,77,69,78,84,32,35,49,32,3*42/
C
C INITIALIZE FIRST TEN WORD OF HEADER BLOCK INFORMATION
C HEADER(1-2) = -255
C HEADER(3-4) = 8
C HEADER(5-6) = 0
C HEADER(7-8) = 0
C HEADER(9-10) = 40
C
C
DATA HEADER(1),HEADER(2)/"133,"40/
DATA HEADER(3),HEADER(4)/"137,"47/
DATA HEADER(5),HEADER(6)/"137,"137/
DATA HEADER(7),HEADER(8)/"137,"137/
DATA HEADER(9),HEADER(10)/"137,"107/
C
C
C P R O G R A M S T A R T
C
C
C OBTAIN TODAY'S DATE TO BE USED IN THE HEADER BLOCK AND
C INITIALIZE THE REMAINDER OF THE HEADER BLOCK TO "137
C WHICH IS THE COS-310 EQUIVALENT OF ZERO. ALSO INITIALIZE
C THE TEMPORARY HEADER BLOCK AREA.
C THE DATE FIELDS APPEAR IN THE HEADER BLOCK AS:
C HEADER(13) = DAY
C HEADER(14) = MONTH
C HEADER(15-16) = YEAR (MINUS 1900)
C
C
CALL DTECVT(IDAY,IMON,IYR)
IDYMN = ((IDAY .AND. "77) * "100) + (IMON .AND. "77)
DAY = IDYMN
YEAR = IYR
DO 910 I=11,130
HEADER(I) = "137
HDRTMP(I) = "137
910 CONTINUE
DO 911 I=1,10
HDRTMP(I) = "137
911 CONTINUE
C
C CALL 'ERRSET' TO INHIBIT AN ERROR LOG OF THE ERRORS
C LISTED FOR NUMBERS IN 'DATA STATEMENT' FOR 'IERRST'.
C
CALL ERRSET(0)
D2 TYPE 8700
D8700 FORMAT(' ARE YOU ON A WPS STATION? (Y/N) ',$)
D READ(5,8750,END=99999)IANS
8750 FORMAT(A1)
D IF(IANS .NE. 'Y' .AND. IANS .NE. 'N' .AND.
D 1 IANS .NE. 'y' .AND. IANS .NE. 'n') GO TO 2
D IF(IANS .NE. 'N' .AND. IANS .NE. 'n') GO TO 3
D TYPE 8905
D8905 FORMAT(' PLEASE ENTER LINE NUMBER OF WPS STATION : ',$)
D READ(5,8906,END=99999)IUNIT
D8906 FORMAT(O3)
D TYPE 8901
D GO TO 1
3 IUNIT = -1
TYPE 8901
8901 FORMAT(//,' WPIP V1.0')
TYPE 8900
8900 FORMAT(/,' PLEASE TYPE "\R <GOLD><MENU>DX<RETURN>"')
GO TO 1
99999 CALL EXIT
C
C
C E S T A B L I S H C O M M U N I C A T I O N S
C
C
1 IBYE = 0
CALL DXINIT(IUNIT)
7 CALL SEND(DXOPT,2)
4 IF(IBYE .EQ. 0) GO TO 14
ITIME = 10000
CALL WAIT
ITIME = 0
MEF = 0
IBYE = 0
CALL SEND(CLRSCN,65)
14 IF(IFLAG .EQ. 0) GO TO 15
IFLAG = 0
GO TO 1
15 I1112 = 0
IRECS = 0
ICNTR = 0
BCK = 0
LTOT = 0
ISIZE = 0
D IACKC = 0
D IERRC = 0
D IERRCT = 0
D DELTA = 0.
D BAUD = 0.
D ABAUD = 0.
DO 375 I=1,80
BUF(I) = 32
375 CONTINUE
IF(IBYE .EQ. 1) GO TO 1
C
C IF USER RE-ENTERS 'WP8PIP' ALLOW HIM TO RESTART
C
CALL RECV(1,BUF,LEN)
C
C
C B E G I N P R O M P T I N G W P S - 8
C
C
IF(IBYE .EQ. 1) GO TO 1
C
C EDIT #009
C A RESPONSE HAS THE FORMAT "X FILENAME"
C WHERE "X" IS A ONE LETTER CODE FOR THE DESIRED FUNCTION:
C "S" FOR WPS WANTS TO SEND US A DOCUMENT,
C "R" FOR WPS WANTS TO RECEIVE A DOCUMENT FROM US,
C "FILENAME" IS THE FILENAME.
C NOTE: THE FILENAME IS OPTIONAL HERE. IF NOT SPECIFIED, IT
C WILL BE PROMPTED FOR.
C
C
C
C EDIT #009
C IS THE SPECIFIED FUNCTION EITHER 'S' OR 'R'?
C IF NOT, PROMPT AGAIN FOR THE DESIRED FUNCTION.
C
IF (BUF(1) .NE. "151 .AND. BUF(1) .NE. "152) GO TO 4
C
C OK, WE HAVE HAVE LEGAL FUNCTION. REMEMBER IT IN 'IFCN'.
C
5998 IFCN = BUF(1)
C
C
C FIRST DETERMINE IF WE HAVE A DOCUMENT NAME OR A DOCUMENT NUMBER.
C IF IT'S A DOCUMENT NAME SET 'IDOCNO' = 0 AND PASS THE DOCUMENT
C NAME AND LENGTH RO 'LOOKUP', ELSE SET 'IDOCNO' = DOC. # PASSED IN
C 'BUF(2)' AND 'BUF(3)' AND PASS IT TO 'LOOKUP' WITHOUT THE DOCUMENT
C NAME.
C
DO 5999 M=1,64
DOCNAM(M) = 32
FTEMP(M) = 32
5999 CONTINUE
IDOCNO = 0
IDNLEN = 0
IFL = 0
FNAME = FBLANK
IEXIST = 0
ISIZE = 0
IVERSN = 0
C
C IF LENGTH-1 = 1 OR 2 AND 'BUF(2)' AND 'BUF(3)' EQUALS A
C NUMBER THEN WE HAVE A DOCUMENT NUMBER ELSE WE HAVE A
C DOCUMENT NAME.
C
IDNLEN = LEN - 1
IF(IDNLEN .GT. 4) GO TO 6
IDOCNO = 0
DO 2131 M=LEN,2,-1
IF(BUF(M) .GE. 48 .AND. BUF(M) .LE. 57) GO TO 2130
GO TO 6
2130 IDOCNO = IDOCNO + (BUF(M) -48) * (10 ** (LEN - M))
2131 CONTINUE
IF(IDOCNO .NE. 1) GO TO 8
CALL SEND(DC1MSG,44)
GO TO 19
C
C WE ARE SENDING A DOCUMENT NAME
C
6 DO 12 M=2,LEN
DOCNAM(M-1) = BUF(M)
12 CONTINUE
IDOCNO = 0
C
C SAVE ORIGINAL NAME SENT FROM WPS STATION
C
8 DO 112 M=2,LEN
FTEMP(M-1) = BUF(M)
112 CONTINUE
C
D WRITE(23,1000)BUF(1),DOCNAM,IDNLEN,IDOCNO
D1000 FORMAT(' FUNCTION = ',O3,/,' DOC = ',64R1,/,
D 1 ' LENGTH = ',I5,/,'DOC # ',I5)
C
C CALL 'LOOKUP' WITH EITHER 'IDOCNO' OR 'DOCNAM' AND 'IDNLEN',
C THE CORRESPONDING FILE NAME WILL BE RETURNED IN 'FNAME' WITH
C THE LENGTH IN 'IFL'.
C
CALL LOOKUP(LUN,IDOCNO,DOCNAM,IDNLEN,IEXIST,CREDAT,MODDAT,
1 MODTIM,ISIZE,IVERSN,FNAME,IFL)
C
C VERSION NUMBER FOR THE HEADER WILL BE 'IVERSN' + 1
C
IVERNO = IVERSN + 1
C
D WRITE(23,1005)IEXIST,FNAME,IFL
D1005 FORMAT(' ON RETURN FROM LOOKUP ==> ',I5,/,' FNAME = ',
D 1 A10,' LENGTH = ',I5)
C
C ON RETURN FROM 'LOOKUP' IEXIST WILL INDICATE THE RESULTS:
C 1 = FILE EXISTS
C 2 = FILE DOES NOT EXIST
C 3 = FILE EXISTS ON INDEX BUT NOT ON DISK (ERROR CONDITION)
C 4 = FILE NAME WAS NOT UNIQUE (POSSIBLE ERROR CONDITION)
C 5 = FILE EXISTS AND WAS CONVERTED BY WFLX
C
IF(IEXIST .LE. 0 .OR. IEXIST .GT. 5) GO TO 4
GO TO (11,11,9,10,11),IEXIST
C
C ALL'S WELL FROM 'LOOKUP' (I.E. 'IEXIST' = 1, 2 OR 5).
C NOW DISPATCH ON IFCN, "151 = 'S' AND "152 = 'R'.
C
11 IF (IFCN .EQ. "151) GO TO 200
GO TO 100
C
C COME HERE TO HANDLE WPS RECEIVING, US SENDING.
C (THE USER AT THE WPS STATION TYPED 'R'.)
C
C
C
C H E R E F O R W P S - 8 T O R E C E I V E
C
C
C
C IF 'IEXIST' = 1 OR 5 WE ARE WORKING WITH AN 'OLD' FILE, ELSE
C CONTINUE AT FSN #151 TO INFORM THE USER THAT THE DOCUMENT
C IS EMPTY.
C
100 IF(IEXIST .NE. 1.AND. IEXIST .NE. 5) GO TO 190
OPEN(UNIT=22,DEVICE='DSK:',FILE=FILNAM,ACCESS='SEQIN',
1 MODE='ASCII',DISPOSE='SAVE',ERR=190)
C
CLOSE (UNIT=22)
OPEN(UNIT=22,DEVICE='DSK:',FILE=FILNAM,ACCESS='RANDOM',
1 MODE='ASCII',RECORD SIZE=67, ASSOCIATE VARIABLE=RECORD,
2 ERR=194)
READ(22'1,9002,END=151,ERR=194)LENIN,(HDRTMP(II),II=1,65)
READ(22'2,9002,END=151,ERR=194)LENIN2,(HDRTMP(II),II=66,130)
C
C IF THE HEADER BLOCK IS THE FIRST RECORD OF OUR FILE,
C CONTINUE BY SENDING MESSAGE REQUESTING WPS TO SET UP
C THE TRANSFER.
C
C IF THE FIRST RECORD OF THE FILE IS NOT A 'HEADER BLOCK', THEN
C THE FILE IS NOT IN THE CORRECT FORMAT. INFORM WPS OF THE
C PROBLEM AND THEN PROMPT FOR THE FILENAME AGAIN.
C
IF(HDRTMP(1) .NE. "133 .OR. HDRTMP(2) .NE. "40) GO TO 194
C
C
C MUST NOW SET UP A 'START-OF-DOCUMENT' PACKET TO SEND WPS BY
C EXTRACTING THE BLOCK SIZE INFORMATION FROM WORDS 11 AND 12
C AND THE PRINTER INFORMATION FROM WORDS 39 THRU 78.
C
931 BUF(1) = "144
BUF(2) = HDRTMP(11)
BUF(3) = HDRTMP(12)
DO 930 I=4,45
BUF(I) = HDRTMP(I+35)
930 CONTINUE
LEN = 45
C
C EDIT #001
C MSGFLG = 1 IMPLIES FILE TRANSMISSION IN PROGRESS
C
MSGFLG = 1
CALL SEND(BUF,LEN)
IF(IBYE .EQ. 1) GO TO 150
CALL RECV(1,BUF,LEN)
IF(IBYE .EQ. 1) GO TO 150
IF(BUF(1) .EQ. "140) GO TO 140
C
C IF WPS INFORMS US THAT THERE IS NOT ENOUGH ROOM ON ITS
C DISKETTE TO RECEIVE THE TOPS20 FILE (CODE = "164) THEN
C CLOSE OPEN FILES AND REINITIALIZE.
C
IF(BUF(1) .EQ. "164) GO TO 150
C
C IF THE RESPONSE WE GOT WAS NOT AN 'OK-TO-SEND' PACKET
C THEN SEND A 'BYE' PACKET WITH THE MESSAGE:
C Bye - 202. DX message type error
C THEN CLOSE FILES AND REINITIALIZE.
C
1202 CALL BYE(2)
1150 CONTINUE
CLOSE(UNIT=22)
D CLOSE(UNIT=23)
IBYE = 1
GO TO 7
C
C
C W P S - 8 R E C E I V I N G T E X T
C
C
C
C OPEN WAS SUCESSFUL, BEGIN SENDING FILE DOWN
C
140 CONTINUE
D CALL TIMER(ISEC1)
RECORD = 3
110 READ(22'RECORD,9002,END=150)LEN,(BUF(II),II=1,65)
9002 FORMAT(I2,65R1)
C
C IF RECORD IS NOT 'TEXT-OF-DOCUMENT' AND NOT
C 'END-OF-DOCUMENT' THEN WILL SEND 'END-OF-DOCUMENT'
C PACKET, CLOSE APPROPRIATE FILES AND CONTINUE.
C
IF(BUF(1) .NE. "145 .AND. BUF(1) .NE. "146) GO TO 154
CALL SEND(BUF,LEN)
C
C IF 'BYE' PACKET RECEIVED STOP THIS TRANSMISSION, CLOSE
C FILES AND REINITIALIZE.
C
ICNTR = ICNTR + 1
LTOT = LTOT + LEN + 4
IF(IBYE .EQ. 0) GO TO 110
IF(IFLAG .EQ. 1) GO TO 150
IBYE = 0
CALL SEND(EODBYE,17)
IBYE = 1
GO TO 150
154 CONTINUE
C
C INFORM USER THAT FILE 'FNAME' IS CORRPUPTED. THE RESULTING
C FILE IS, HOWEVER, IN THE CORRECT FORMAT.
C
IFLLEN = 27
IF(IDNLEN .LT. 27) IFLLEN = IDNLEN
DO 155 M=1,IFLLEN
CORRUP(M+38) = FTEMP(M)
155 CONTINUE
CALL SEND(CORRUP,IFLLEN+38)
1155 CALL SEND(EOD,1)
IBYE = 1
C
C ADD TO STATISTICS COUNTERS FOR THE CASE OF A
C PREMATURE END TO TRANSMISSION.
C
ICNTR = ICNTR + 1
C
C TOTAL CHARACTERS = TOTAL CHARACTERS + EOD(1) + 4
C
LTOT = LTOT + 5
C
C END OF FILE ENCOUNTERED, END OF DOCUMENT LAST MESSAGE SENT.
C
150 CLOSE( UNIT=22 )
C
C
C S T A T I S T I C S F O R W P S - 8 R E C E I V I N G
C
C
C
C CALCULATE STATISTICS AND PREPARE TO OUTPUT THEM
C
D CALL TIMER(ISEC2)
D DELTA = ISEC2 - ISEC1
D IACKC = ICNTR * 5
D BAUD = ((LTOT + IACKC) / DELTA) * 10.
D ABAUD = ((LTOT + IERRC + IACKC) / DELTA) * 10.
D WRITE(23,901) ICNTR,LTOT,IACKC,IERRC,IERRCT,DELTA,BAUD,ABAUD
D901 FORMAT(' TOTAL PACKETS SENT: ',I5,';',/
D 1 ' TOTAL CHARACTERS SENT: ',I6,';',/
D 1 ' TOTAL ACK CHARACTERS RECEIVED: ',I6,';',/
D 1 ' TOTAL ERROR CHAR (MESS. + NAKS): ',I6,';',/
D 1 ' NUMBER OF ERROR RETRIES: ',I4,';',/
D 2 ' ELAPSED TIME (SECONDS): ',F8.0,';',/
D 3 ' EFFECTIVE BAUD RATE (TOTAL CHARS. + ACK CHAR.): ',
D 3 F8.0,';',/
D 4 ' ACTUAL BAUD (COUNTING ERROR CHARS): ',F8.0)
D CLOSE (UNIT=23)
C
MSGFLG = 0
GO TO 4
C
C
C E R R O R S E C T I O N
C
C
C
C ERROR -- FILE DOES NOT EXIST ON OUR SYSTEM.
C
C
C PLACE ERROR MESSAGE 104 INTO BUFFER AREA INCLUDING THE
C INCORRECT FILENAME.
C
190 IFLLEN = 42
IF(IDNLEN .LT. 42)IFLLEN = IDNLEN
DO 191 M=1,15
BUF(M+IFLLEN+7) = M104A(M)
IF(M .LE. 6) BUF(M+1) = M104(M)
191 CONTINUE
C
C SET LEN = PACKET # + MSG LEN + FILENAME LEN
C LEN = 1 + 21 + IFL = 22 + IFL
C SET PACKET #
C
LEN = 22 + IFLLEN
152 BUF(1) = "142
DO 192 M=1,IFLLEN
BUF(M+7) = FTEMP(M)
192 CONTINUE
C
C CLEAR THE REST OF THE BUFFER AREA THEN
C SEND ERROR MESSAGE, SUSPEND FOR 10 SECONDS, THEN SEND
C PROMPT FOR HOST FILENAME AGAIN. (PROMPT #2)
C
DO 193 M=LEN+1,80
BUF(M) = 32
193 CONTINUE
CALL SEND(BUF,LEN)
IF(IBYE .EQ. 1) GO TO 4
C
19 CALL SEND(DXOPT,2)
IBYE = 1
GO TO 4
C
C HERE IF TOPS20 FILE IS EMPTY. CLOSE AND TRY AGAIN.
C
151 IF(RECORD .NE. 1) GO TO 194
IFLLEN = 48
IF(IDNLEN .LT. 48)IFLLEN = IDNLEN
DO 1616 M=1,9
BUF(M+IFLLEN+7) = M103A(M)
IF(M .LE. 6) BUF(M+1) = M103(M)
1616 CONTINUE
LEN = 16 + IFLLEN
CLOSE(UNIT=22)
GO TO 152
C
C SET UP MESSAGE 106, PAUSE FOR 10 SECONDS AND PROMPT FOR
C THE FILENAME AGAIN.
C
194 IFLLEN = 51
IF(IDNLEN .LT. 51)IFLLEN = IDNLEN
DO 1617 M=1,13
BUF(M+IFLLEN+7) = M106A(M)
IF(M .LE. 6) BUF(M+1) = M106(M)
1617 CONTINUE
LEN = 20 + IFLLEN
CLOSE(UNIT=22)
GO TO 152
C
C TOPS20 FILE DOES NOT EXIST FOR WPS DOCUMENT NAME/NUMBER SENT
C
9 IFLLEN = 17
IF(IDNLEN .LT. 17)IFLLEN = IDNLEN
DO 1620 M=1,IFLLEN
M108(M+47) = FTEMP(M)
1620 CONTINUE
LEN = 47 + IFLLEN
DO 1618 M=LEN+1,64
M108(M) = 32
1618 CONTINUE
CALL SEND(M108,LEN)
GO TO 19
C
C DOCUMENT NAME IS NOT UNIQUE
C
10 IFLLEN = 30
IF(IDNLEN .LT. 30) IFLLEN = IDNLEN
DO 1621 M=1,IFLLEN
M107(M+34) = FTEMP(M)
1621 CONTINUE
LEN = 34 + IFLLEN
DO 1619 M=LEN+1,64
M107(M) = 32
1619 CONTINUE
CALL SEND(M107,LEN)
GO TO 19
C
C
C H E R E F O R W P S - 8 T O S E N D
C
C
C
200 GO TO (201,290,9,10,201),IEXIST
201 OPEN(UNIT=22,DEVICE='DSK:',FILE=FILNAM,ACCESS='SEQIN',
1 MODE='ASCII',DISPOSE='SAVE',ERR=290)
C
C IF OPEN IS SUCCESSFUL CLOSE AND OPEN AGAIN AS A RANDOM
C ACCESS FILE.
C
CLOSE(UNIT=22)
OPEN(UNIT=22,DEVICE='DSK:',FILE=FILNAM,ACCESS='RANDOM',
1 MODE='ASCII',RECORD SIZE=67,ASSOCIATE VARIABLE=RECORD,
2 ERR=194)
C
C SEND THE USER A FILE OPTIONS PACKET TO DETERMINE HOW THE DOCUMENT
C SHOULD BE MODIFIED.
C
350 CALL SEND(RECOPT,2)
IF(IBYE .EQ. 1) GO TO 9910
CALL RECV(1,BUF,LEN)
IF(IBYE .EQ. 1) GO TO 7
C
C RESPONSE MUST BE AN ANSWER TO PROMPT ("172) PACKET, IF IT
C ISN'T SEND THE OPTIONS AGAIN. THE POSSIBLE RESPONSES WITHIN
C THIS PACKET ARE:
C "040 - GOLD MENU
C "041 - 'O'VERWRITE (USER TYPED 'O')
C "042 - ADD TO 'T'OP (USER TYPED 'T')
C "043 - ADD TO 'B'OTTOM (USER TYPED 'A')
C IF IT IS NONE OF THE ABOVE THEN PROMPT AGAIN.
C
IF(BUF(1) .NE. "172) GO TO 350
IF(BUF(2) .NE. "040) GO TO 279
CLOSE(UNIT=22)
GO TO 7
C
C CHECK FOR AN O, A T OR AN A. IF IT IS NONE OF THESE, SEND
C THE FILE OPTIONS PACKET AGAIN.
C
279 IF(LEN .EQ. 0) GO TO 350
C
C OVERWRITE?
C
IF(BUF(2) .NE. "041) GO TO 280
IT = 1
GO TO 291
C
C ADD TO TOP?
C
280 IF(BUF(2) .NE. "042) GO TO 281
IT = 2
GO TO 291
C
C ADD TO BOTTOM?
C
281 IF(BUF(2) .NE. "043) GO TO 350
IT = 3
GO TO 291
C
C
C W P S - 8 S E N D I N G N E W F I L E
C
C
290 OPEN(UNIT=22,DEVICE='DSK:',FILE=FILNAM,ACCESS='RANDOM',
1 MODE='ASCII',RECORD SIZE=67,ERR=290,ASSOCIATE VARIABLE=RECORD)
IT = 4
C
C IF NEW FILE CONTINUE.
C IF OVERWRITING, OPEN A NEW VERSION AND CONTINUE.
C IF ADDING TO TOP OPEN A TEMPORARY FILE.
C IF ADDING TO BOTTOM, OPEN FILE AS NEW.
C IN THE CASE OF ADDING TO TOP/BOTTOM CHECK THE HEADER
C BLOCK FOR CORRECT WPS FORMAT.
C
291 GO TO (3091,3092,3093,2090),IT
C
C CLOSE FILE AND REOPEN AS 'NEW' TO PRODUCE A NEW VERSION
C FOR THE OVERWRITE OPTION.
C
C
C
C W P S - 8 S E N D I N G O L D F I L E
C
C
C
C --- OVERWRITE ---
C
3091 CLOSE(UNIT=22)
OPEN(UNIT=22,DEVICE='DSK:',ASSOCIATE VARIABLE=RECORD,
1 ACCESS='RANDOM',MODE='ASCII',RECORD SIZE=67)
GO TO 2090
C
C --- ADDING TO TOP ---
C
3092 READ(22'1,9002,END=1151,ERR=1194)LENIN,(HDRTMP(II),II=1,65)
READ(22'2,9002,END=1151,ERR=1194)LENIN2,(HDRTMP(II),II=66,130)
CALL DEC(HDRTMP,NUMREC)
D WRITE(23,9005)NUMREC
D9005 FORMAT(' NUMBER OF INPUT RECORDS FOR TOP = ',I8)
C
C CHECK FOR VALIDITY OF 'HEADER', IF NOT OK TELL USER
C THAT FILE IS CORRUPTED.
C
IF(HDRTMP(1) .NE. "133 .OR. HDRTMP(2) .NE. "40)GO TO 1194
OPEN(UNIT=24,DEVICE='DSK:',ASSOCIATE VARIABLE=OUTPUT,
1 ACCESS='RANDOM',RECORD SIZE=67,MODE='ASCII')
GO TO 2090
C
C MAKE SURE TOPS20 FILE IS NOT EMPTY OR CORRUPTED, IF IT IS
C INFORM THE WPS USER OF THE SITUATION.
C
C
C --- ADDING TO BOTTOM ---
C
3093 READ(22'1,9002,END=151,ERR=194)LENIN,(HDRTMP(II),II=1,65)
READ(22'2,9002,END=151,ERR=194)LENIN2,(HDRTMP(II),II=66,130)
IF(HDRTMP(1) .NE. "133 .OR. HDRTMP(2) .NE. "40) GO TO 194
CALL DEC(HDRTMP,NUMREC)
D WRITE(23,9007)NUMREC
D9007 FORMAT(' NUMBER OF INPUT RECORDS FOR BOTTOM = ',I8)
CLOSE(UNIT=22)
OPEN(UNIT=22,DEVICE='DSK:',FILE=FILNAM,ACCESS='RANDOM',
9 MODE='ASCII',ASSOCIATE VARIABLE=RECORD,RECORD SIZE=67)
C
C SEND MESSAGE TO WPS TO START SENDING ITS DOCUMENT, THEN
C CHECK TO SEE IF WE RECEIVED A 'START-OF-DOCUMENT', IF SO
C SEND THE "OK-TO-SEND" PACKET TO WPS.
C
2090 CALL SEND(OKSND,1)
IF(IBYE .EQ. 1) GO TO 9912
CALL RECV(1,BUF,LEN)
MSGFLG = 0
IF( IBYE .EQ. 1 ) GO TO 9912
IF( BUF(1) .EQ. "144) GO TO 949
C
C DID NOT GET EXPECTED PACKET FROM WPS, SEND
C 'BYE - 202' AND REINITIALIZE.
C
CALL BYE(2)
CLOSE(UNIT=22)
IF(IT .EQ. 2) CLOSE(UNIT=24,DISPOSE='DELETE')
D CLOSE(UNIT=23)
GO TO 7
C
C
C B U I L D 5 1 2 B Y T E H E A D E R B L O C K
C
C
C
C SET UP HEADER BLOCK INFORMATION FOR THE TOPS20 FILE
C EXTRACT FILE SIZE FROM THE 'START-OF-DOCUMENT'
C PACKET. ALSO CONVERT TODAY'S DATE AND PLACE IT IN
C THE HEADER BLOCK. EXTRACT PRINTER SETTINGS FROM
C PACKET WORDS 4 THRU LEN AND PLACE THEM IN THE HEADER
C BLOCK WORDS 39 THRU 39+LEN.
C
949 HEADER(11) = BUF(2)
HEADER(12) = BUF(3)
NUL1 = "137
NUL2 = "137
IRECS = INTSIX(NUL1,BUF(2)) * 64 + INTSIX(NUL2,BUF(3))
C
C INSERT TODAY'S DATE AS THE LAST DATE EDITED INTO
C HEADER(17-20)
C
CALL HDRCVT(IDYMN,HEADER(17),HEADER(18))
CALL HDRCVT(IYR,HEADER(19),HEADER(20))
C
C INSERT THE VERSION NUMBER - HEADER(21-22)
C
CALL HDRCVT(IVERNO,HEADER(21),HEADER(22))
C
C INSERT CURRENT TIME AS THE TIME LAST EDITED - HEADER(25-26)
C
CALL TIME(ITIME)
DECODE(5,13,ITIME)IHR,IMIN
13 FORMAT(I2,1X,I2)
IHRMN = ((IHR .AND. "77) * "100) + (IMIN .AND. "77)
CALL HDRCVT(IHRMN,HEADER(25),HEADER(26))
C
C IF THIS IS A NEW FILE THEN FILL IN TODAY'S DATE WITH THE
C CURRENT DATE - HEADER(13-16)
C
IF(IT .NE. 1) GO TO 948
CALL HDRCVT(DAY,HEADER(13),HEADER(14))
CALL HDRCVT(YEAR,HEADER(15),HEADER(16))
C
C WE ARE ONLY CONCERNED WITH THE FIRST 78 CHARACTERS OF THE
C HEADER BLOCK
C
948 DO 950 I=4,43
HEADER(I+35) = BUF(I)
950 CONTINUE
C
C HEADER(79-80)WILL BE USED TO INDICATE WHETHER OR NOT THIS FILE
C WAS AT ANY POINT CONVERTED BY 'WP8FLX'.
C
HEADER(79) = HDRTMP(79)
HEADER(80) = HDRTMP(80)
C
C IF ADDING TO TOP OF FILE (IT = 2), CONTINUE AT 960
C
IF(IT .EQ. 2) GO TO 960
C
C IF ADDING TO BOTTOM OF FILE, NEEDED INFORMATION REMAINS
C IN 'HEADER' AND PROCESSING CONTINUES.
C
IF(IT .EQ. 3) GO TO 940
C
C IF OVERWRITING AN EXISTING FILE OR CREATING A NEW FILE
C SIMPLY WRITE THE HEADER BLOCK WHICH WAS JUST CREATED AND
C CONTINUE.
C
WRITE(22'1,9002)LENHDR,(HEADER(II),II=1,65)
WRITE(22'2,9002)LENHDR,(HEADER(II),II=66,130)
GO TO 940
C
C IF ADDING TO THE TOP OF AN EXISTING FILE, READ THE HEADER
C BLOCK, ADD THE BLOCK SIZES INTO THE NEW HEADER AREA ('HEADER')
C AND WRITE 'HEADER' TO THE OUTPUT FILE. IF THE FILE IS
C EMPTY OR CORRUPTED INFORM THE WPS USER.
C
960 I1112 = INTSIX(HDRTMP(11),HDRTMP(12))
IJ = I1112 + INTSIX(HEADER(11),HEADER(12))
CALL HDRCVT(IJ,HEADER(11),HEADER(12))
WRITE(24'1,9002)LENHDR,(HEADER(II),II=1,65)
WRITE(24'2,9002)LENHDR,(HEADER(II),II=66,130)
GO TO 940
C
C FILE IS EMPTY
C
1151 CLOSE(UNIT=24,DISPOSE='DELETE')
GO TO 151
C
C FILE IS CORRUPTED
C
1194 CLOSE(UNIT=24,DISPOSE='DELETE')
GO TO 194
C
C EDIT #001
C
940 MSGFLG = 1
C
C WE ARE NOW READY TO RECEIVE THE 'TEXT-OF-DOCUMENT' PACKETS,
C THEREFORE WE MUST SEND AN 'OK-TO-SEND' PACKET.
C
BUF(1) = "140
CALL SEND(BUF, 1)
IF(IBYE .EQ. 1) GO TO 7001
C
C OK, NOW RECEIVE THE FILE.
C
C
C
C W P S - 8 S T A R T S S E N D I N G
C
C
D CALL TIMER(ISEC1)
RECORD = 3
OUTPUT = 3
IF(IT .EQ. 3)RECORD = NUMREC + 1
210 CALL RECV(1,BUF,LEN)
C
C IF BYE PACKET RECEIVED, CLOSE ALL OPEN FILES,
C AFTER WRITING AN 'END-OF-DOCUMENT' AND GO
C BACK TO REINITIALIZE.
C
IF(IBYE .EQ. 0) GO TO 9988
7001 LEN = 1
IBYE = 0
CALL SEND(EODBYE,17)
IBYE = 1
BUF(1) = "146
C
C CONTINUE NORMALLY SO AS TO CLEAN UP ANY END OF DOCUMENT
C CONDITIONS.
C
9988 CONTINUE
C
C IF PACKET RECEIVED FROM WPS IS NOT ONE THAT WE EXPECT
C AT THIS POINT, THEN WRITE OUT AN 'END-OF-DOCUMENT'
C RECORD, SEND A 'BYE' PACKET AND CLOSE OUT FILES, THEN
C REINITIALIZE.
C
991 IF(BUF(1) .EQ. "145 .OR. BUF(1) .EQ. "146) GO TO 993
LEN = 1
BUF(1) = "146
IF(IT .NE. 2) WRITE(22'RECORD,9002)LEN,(BUF(II),II=1,65)
IF(IT .EQ. 2) WRITE(24'OUTPUT,9002)LEN,(BUF(II),II=1,65)
DO 992 M=2,17
BUF(M) = E