C       PROGRAM SEND.FT
C       -----------------
C
C
C
C
	SUBROUTINE SEND(A,B)
C
C       PETER LEMKIN
C       NATIONAL INSTITUTES OF HEALTH 
C       BETHESDA ,MARYLAND  20014
C
C	JULY 9, 1972
C	REVISED NOV. 29, 1972
C
C
C       INTRODUCTION
C       ------------
C	SUBROUTINE "SEND.FT" IS USED ON PDP8#1 TO SEND THE SPECIFIED
C	FILE  OF A OS/8 DEVICE DSK: FILE TO THE PDP8#2 DEVICE DSK:.
C	PDP8#2 WILL PUT THIS INFORMATION (RECEIVED VIA A DC02G OR
C	PT08 TYPE DATA LINK.) ON A DSK: FILE OPENED BY PDP8#2.
C	THIS IS ACCOMPLISHED ON PDP8#2 BY A PROGRAM CALLED
C	"RECVER.SV". "RECVER" IS USED TO SYNCHRONIZE AND BUFFER
C	THE TRANSMISSION. THE SERIAL "SEND" DATA TRANSMISSION DEVICE
C	MAY BE DEFINED AS A PT08 OR DC02G (GROUP 0 STATION 2) DEVICE.
C	(WHERE GROUP 0 STATION 1 IS THE CTY:).
C	THE TYPE OF DEVICE USED IS SPECIFIED BY REMOVING THE "/"
C	FROM THE FRONT OF ONE OF THE FOLLOWING SYMBOL DEFINITIONS.
S	ABSYM PT08 1 /DEFINE AS A PT08 LINK:
S	/ABSYM DC02G 1 /DEFINE AS A DC02 LINK:
C	THE DEVICE DSK: MAY BE ASSIGNED AT SYSTEM LEVEL.
C	NOTE: IF A=0.0, THEN SEND RETURNS IMMEDIATELY AFTER
C	DOING A FETCH OF THE DEVICE DSK:, AND ARGUMENT B IS THE 
C	DEVICE NUMBER (FLOATING POINT).
C	NOTE**** THE SEND.RL SUBROUTINE MUST !!! BE LOADED INTO 
C	FIELD 0 SINCE IT DOES A FETCH ON THE DSK: DEVICE HANDLER.
C
C
C	ARGUMENTS
C	---------
C	1. A - THE FILE NAME (RETURNS AFTER FETCH IF A=0.0)
C	2. B - THE EXTENSION NAME. (OR DEVICE # (FLOAT) AFTER FETCH).
C
C
C       
C       THE FOLLOWING PROTOCOL IS USED:
C       ------------------------------
C       1. LOADS DSK: HANDLER INTO PDP8#1 CORE.
C       2. GETS THE FILENAME FROM THE ARGUMENTS.
C       3. WAITS FOR "#" FROM PDP8#2 BEFORE SENDING FILE NAME AND
C		LENGTH OF THE FILE.
C       4. LOOKS UP THE FILE ON THE DSK:
C		AND CODES 3 BYTES/2 WORDS TO SEND THEM TO THE LINK:.
C       5. WAITS FOR "#" TO CONFIRM RECEIPT AND THEN SENDS THE FILE
C		DATA TO THE PDP8#2 IN THE FOLLOWING FORMAT:
C		SENDS ONE BLOCK AT A TIME, AND WAITS FOR A "#" BEFORE
C		PROCEEDING.
C       6. THE TWO MACHINES TYPE "DONE" WHEN DONE.
C	7. AFTER IT COMPLETES THE TRANSMISSION, IT RETURNS...
C	   IT ALSO RETURNS IF THERE IS A LOOKUP ERROR.
C
C
C	***LINK: DEVICE CODES FOR A DC02G****
S	IF DC02G, 7
S	OPDEF PTLS 6126
S	SKPDF PTSF 6121
S	OPDEF PKRB 6116
S	SKPDF PKSF 6111
S	OPDEF PKCC 6112
S	OPDEF PKRS 6114
S	OPDEF MTON 6117 /SELECT STATION GROUP...
C
C
C
C
C	**** LINK: DEVICE CODES FOR A PT08***
S	IF PT08, 7
S       OPDEF PTLS 6416
S       SKPDF PTSF 6411
S	OPDEF PKRB 6406
S       SKPDF PKSF 6401
S	OPDEF PKCC 6402
S	OPDEF PKRS 6404
S	OPDEF MTON 7200  /NOP...
C
C
C	ALWAYS DEFINE THE MQL TO DISPLAY THE CURRENT LOGICAL BLOCK.
S	OPDEF MQL 7421
C
C **PAGE
        COMMON IBUF
        DIMENSION IDEV(128),FFF(2),III(6),IBUF(256)
	EQUIVALENCE (FFF(1),III(1))
C
C
C
C
C	1. COPY THE FILENAME INTO LOCAL STORAGE.
1	FFF(1)=A
	FFF(2)=B
C
C
C
C
C
C
C       2. LOAD THE  "DSK" HANDLER INTO CORE.
	IBLOCK=1
S       CLA CLL
S       TAD DSKK
S       DCA ARG1
S       TAD DSKK#
S       DCA ARG2
S       TAD PIDEV
S       AND (7600
S       DCA ARG3
S       CPAGE 12
S       6212  /CIF 10
S       JMS 7700   /USR
S       1   /FETCH
SARG1,  0
SARG2,  0
SARG3,  0
        GOTO 11
        GOTO 121
SPIBUF, \IBUF
SDSKK,  0423  /DS
S       1300  /K@
SPIDEV, \IDEV  /POINTER
C
C
C
C
C	2.1 TEST IF ONLY WANTED TO DO A FETCH.
121	IF(A)133,134,133
S\134,	TAD ARG2 /DEVICE NUMBER
S	DCA \IBLOCK
	B=IBLOCK
	RETURN
C
C
C
C
C
C       2.2 FETCH ERROR - FATAL ERROR
11      WRITE(1,12)FFF(1),FFF(2)
12      FORMAT('FETCH ERROR FILE:',A6,'.',A2)
	READ(1,13)IBLOCK
13	FORMAT('TYPE RETURN TO EXIT',A1)
14	CONTINUE
S	TAD (2010 /RESTORE THE CTY
S	MTON
S	CLA
        CALL EXIT
C
C
C
C
C
C
C       3.0 PRINT THE FILENAME ON THE TTY:
133	WRITE(1,3)FFF(1),FFF(2)
3	FORMAT('DOING FILE: ',A6,'.',A2)
C
C
C
C       4.0 LOOKUP THE FILE ON DEVICE DSK:.
S	TAD PFFF /SET UP FILENAME POINTER
S	DCA BARG2
S	TAD ARG2 /GET DEVICE #
S	CPAGE 12
S	6212 /CIF 10
S	JMS 7700 /USR
S	2 /LOOKUP
SBARG2,	0 /POINTER TO FILE NAME, WILL BE ST. BLK #.
SBARG3,	0 /WILL BE -FILE LENGTH
        GOTO 141
        GOTO 42
C
C
C       4.1.1 LOOKUP ERROR - SKIP THIS FILE AND RETURN.
141     WRITE(1,142)FFF(1),FFF(2)
142     FORMAT('LOOKUP FAILED FILE: ',A6,'.',A2)
	GOTO 602
C
C
C
C	4.1.2 WAIT FOR PDP8#2.
S\42,	JMS WAIT
C	**** SEND THE # BACK IN THIS CASE SINCE IT TELLS PDP8#2
C	TO GET OUT OF ITS SYNCH LOOP.*****
S	TAD ("#
S	PTLS
SWAITE,	PTSF
S	JMP WAITE
SWAITL,	PKSF
S	JMP WAITL /CHECK TO MAKE SURE IT IS NOT A #
S	PKRS /READ STATIC
S	TAD (-"#
S	SNA CLA
S	PKCC /YES ERASE IT....
C
C
C
C
C	4.1.3 PUT THE FILE NAME AND SIZE IN THE DATA BUFFER AND 
C	PUT THE FILE SIZE INTO "JJJ".
	DO 1444 JJJ=1,6
	IBUF(JJJ)=III(JJJ)
1444	CONTINUE
S	TAD BARG3 /# BLOCKS
S	CIA
S	DCA \JJJ
	IBUF(7)=JJJ
C
C
C
C
C	4.1.4 NOW SEND THE BUFFER TO THE PDP8#2
S       JMS XMIT
C
C
C
C       5.0 WAIT FOR # THEN SEND "JJJ" NUMBER OF BLOCKS.
50      DO 599 II=1,JJJ
S	TAD BARG2
S	DCA \KKK /SAVE STARTING BLOCK #
	IBLOCK=KKK+II-1
S	TAD \IBLOCK
S	MQL
S	CLA
S       JMS WAIT
C
C
C       5.1 READ ONE BLOCK FROM THE FILE INTO IBUF.
S\51,   TAD PIBUF
S       DCA CARG2
S       TAD \IBLOCK  /START BLOCK NO.
S       DCA CARG3
S       TAD ARG3 / DSK ENTRY POINT
S       DCA FENTRY
S       CLA
S       CPAGE 14
S       6202 /CIF 00 /HANDLER IN FIELD 0
S       JMS I FENTRY
SCARG1,	0210 /FUNCTION WORD. ONE BLOCK READ.
SCARG2, 0
SCARG3, 0
        GOTO 511
        GOTO 52
SFENTRY,        0
C
C
C
C       5.1.1 DATA READ ERROR. TRY AGAIN.
511     WRITE(1,512)FFF(1),FFF(2),IBLOCK
512     FORMAT('READ DSK: ERROR FILE: ',A6,'.',A2,', BLOCK#=',I5)
        GOTO 51
C
C
C
C       5.2 GO TRANSMIT THE DATA.
S\52,       JMS XMIT
C
599     CONTINUE
C
C
C       6.0 DONE -  PRINT THE MESSAGE AND RETURN.
60      WRITE(1,601)FFF(1),FFF(2)
601     FORMAT('DONE FILE:',A6,'.',A2)
602	CONTINUE
S	TAD (2010 /RESTORE THE CTY
S	MTON
S	CLA
	RETURN
C **PAGE
C
C       SUBROUTINE XMIT
C       ---------------
C       MOVE THE  BUFFER IN IBUF (256 WORDS 1 BUFFER) TO
C       PDP8#2, PACKING 3 BYTES / 2 WORDS. ECHO CHECKING IS USED.
SXMIT,	0
        IW3=0
        DO 88 J=1,256,2
        IW1=IBUF(J)
        IW2=IBUF(J+1)
S       TAD \IW1
S       RTR;RTR
S       AND (0360   /TOP 1/2 BYTE.
S       DCA \IW3
S       TAD \IW2
S	RTL;RTL;RAL /MOVE TO BITS 8-11.
S       AND (0017  /BOTTOM HALF OF BYTE.
S       TAD \IW3
S       DCA \IW3
C
C       SEND THE 3 BYTES
C
S       TAD \IW1
S       JMS OUT
S       TAD \IW2
S       JMS OUT
S       TAD \IW3
S       JMS OUT
88      CONTINUE
C
C       SET UP RETURN
S       TAD XMIT
S       DCA XMIT2
S       CPAGE 2
S       JMP I XMIT2
SXMIT2, 0
C
C       SUBROUTINE WAIT
C       ---------------
C       WAIT FOR A # FROM THE PTO8/8E
S       CPAGE 13
SWAIT,	0
S	TAD (1010 /DEVICE LINK:
S	MTON
S	CLA
S       PKSF
S       JMP WAIT#  /WAIT FOR INPUT.
S       PKRB  /GET BYTE.
S       CIA
S       TAD ("#   /#-INPUT BYTE
S       SZA CLA /TEST IT.
S       JMP WAIT# /NO
S       JMP I WAIT  /YES, RETURN.
C
C
C       SUBROUTINE OUT
C       ---------------
C       SENDS THE ACC TO THE PTO8, AND CHECKS THE ECHO.
S       CPAGE  23
SOUT,   0
S	AND (0377 /ONLY BITS 4-11 BECAUSE OF ECHO CHECKING
S	DCA OTSAVE
S	TAD (1010 /DEVICE LINK: STATION 2 GROUP 0.
S	MTON /A NOP IF A PT08.
S	CLA
S	TAD OTSAVE
S       PTLS
SOUT2,  PTSF
S       JMP OUT2
SOUT3,	PKSF
S	JMP OUT3
S	PKRB /GET THE ECHO
S	DCA \IECHO
S	TAD \IECHO /SAVE IT FOR ERROR MESSAGE.
S	CIA
S	TAD OTSAVE /ZERO EXPECTED.
S	SZA CLA
S	JMP \1999 /ERROR
S       JMP I OUT
SOTSAVE,	0 /SAVE CHARACTER FOR ECHO CHECK
S\1999,	TAD \IECHO
S	RTL;RTL;RTL
S	DCA \IECHO /LEFT BYTE.
S	TAD OTSAVE
S	RTL;RTL;RTL
S	DCA \JECHO /MOVE THE DATA TO LEFT BYTE.
	WRITE(1,1998)IECHO,JECHO,FFF(1),FFF(2),IBLOCK
1998	FORMAT('ECHO-CHK-ERR.-- ECHO=',A1,', CHAR SEND=',A1,', FILE: '
     1,A6,'.',A2,', BLK#=',I5)
	GOTO 14
SPFFF,	\FFF
        END