TITLE FILSND
	ENTRY DFHACK


;	TEST PROGRAM FOR INTERPROCESSOR COMMUNICATIONS ROUTINES.
;THE DEC-10 STORES INFORMATION IN 36-BIT WORDS ON THE DISK.  FOR
;TRANSMISSION, A WORD IS PICKED UP IN 4-BIT BYTES, COMBINED 2 PER
;8-BIT BYTE AND THEN FORMATTED IN A MESSAGE OF LENGTH 1-70 BYTES.
;THE REVERSE PROCESS IS PERFORMED ON MESSAGES RECEIVED.
;EACH MESSAGE (THE RESIDUAL TEXT AFTER STRIPPING AWAY ALL THE
;MAJOR PROTOCOL BYTES) IS COMPOSED OF TWO PARTS:
;BYTE 1: LOWER 7 BITS IS THE NUMBER OF BYTES IN THE ACTUAL TEXT AND
; IS ALWAYS ONE LESS THAN THE MAJOR PROTOCOL MESSAGE COUNT.  THE
; EIGHTH BIT (200 BASE 8 MASK) PRESENT IS USED TO INDICATE AN 
; END OF FILE.
;BYTES 2-72: TEXT


	DEFINE ERRMES(A)
<	JRST [TTCALL 3,[ASCIZ/A/]
		JSA 16,HNGUPF##
		EXIT]>


	P=17
	L=16			;THE LINK REGISTER
	C=16
	M=15
	P2=14
	P1=13

	AC=0
	T1=1
	T2=2
	T3=3

	DSK=1

DFHACK:	RESET
	MOVE P,[IOWD PDLEN,PDLST]
	PUSHJ P,GETIOX		;GET TTY NUMBER
	PUSHJ P,GETNAM		;GET FILENAME AND EXTENSION
	SETZM INTFLG#
IT:	TTCALL 3,[ASCIZ/
 MANUAL INITIALIZATION OF OTHER SYSTEM? /]
	TTCALL 4,0		;INCHWL
	TTCALL 11,		;CLRBFI
	CAIE "N"
	CAIN "Y"
	SKIPA
	JRST [TTCALL 3,[ASCIZ/
TYPE Y OR N 
/]
		JRST IT]
	CAIN "Y"
	SETOM INTFLG		;YES. INITIATING OTHER SYSTEM
SORR:	TTCALL 3,[ASCIZ/SEND OR RECEIVE?  /]
	TTCALL 4,0
	TTCALL 11,
	CAIN "R"
	JRST RECV
	CAIN "S"
	JRST SEND
	TTCALL 3,[ASCIZ/TYPE  S OR R
/]
	JRST SORR
	SUBTTL	ROUTINE TO SEND A FILE

SEND:	PUSHJ P,OPNFIL
	ERRMES(<FILE DOES NOT EXIST>)
	SETZM COUNT		;TO FORCE FIRST INPUT
	MOVEI	L,INTLST	;ARGUMENT LIST ADDRESS
	PUSHJ P,INITC
	SKIPN IERR#
	ERRMES(<COMMUNICATIONS LINE INITIALIZATION ERROR>)
	SKIPE INTFLG
	PUSHJ P,GETNUM		;DIAL A NUMBER
	TTCALL 3,[ASCIZ/STARTING TO SEND
/]
GLOOP0:	MOVSI 1,-MESSIZ
	HRRI 1,ARRAY
GLOOP1:	PUSHJ P,GETBYT		;GET ONE 8-BIT BYTE FROM THE FILE
	JRST LSTMES		;END-OF-FILE RETURN
	MOVEM C,(1)
	AOBJN 1,GLOOP1
	MOVEI 1,MESSIZ		;GET INTERNAL MESSAGE BYTE COUNT
	MOVEM 1,MESAGE		;PUT IT IN FIRST BYTE OF MESSAGE
	MOVEI	L,SNDLST	;GET ARGUMENT LIST ADDR IN LINK REGISTER
	PUSHJ P,SENDC##
	SKIPGE IERR
	JRST GLOOP0
	SKIPG	IERR		;GOT A DATA MESSAGE INSTEAD ?
	ERRMES (<TRANSMISSION ERROR>)
	ERRMES	(<DATA MESSAGE RECEIVED IN SEND, ERROR>) ;YES. TELL USER

LSTMES:	HLRES 1			;COMPUTE INTERNAL MESSAGE COUNT
	ADDI 1,MESSIZ		; ...
	TRO 1,200		;SET END-OF-FILE FLAG
	MOVEM 1,MESAGE
	MOVEI	L,SNDLST	;ARG LIST ADDRESS TO LINK REGISTER
	PUSHJ P,SENDC
	SKIPL IERR
	ERRMES(<TRANSMISSION ERROR>)
	SKIPE INTFLG		;IF OTHER SYSTEM MANUALLY INITIALIZED,
	JSA L,DIALC##		; PUT IN MONITOR MODE WITH OTHER COMPUTER
	JUMP [0]		; SO USER MAY LOGOUT.
	JUMP [0]		;BUT DON'T DO ANY DIALING
	JUMP IERR
	JUMP ITYPE
	TTCALL 3,[ASCIZ/
/]
	PUSHJ P,HNGUPC##
	TTCALL 3,[ASCIZ/  TRANSFER COMPLETED!/]
	EXIT
	SUBTTL	ROUTINE TO CREATE A FILE FROM RECEIVED MESSAGES


RECV:	PUSHJ P,ENTFIL		;OPEN THE FILE FOR OUTPUT
	MOVE [POINT 4,BUFFER]
	MOVEM BYTPNT
	MOVEI ^D9*^D128		;SETUP THE BUFFER 4-BIT BYTE COUNT
	MOVEM COUNT
	MOVEI	L,INTLST	;ARG LIST ADDRESS TO LINK REGISTER
	PUSHJ P,INITC##
	SKIPL IERR
	ERRMES(<COMMUNICATIONS LINE INITIALIZATION ERROR>)
	SKIPE INTFLG
	PUSHJ P,GETNUM		;INIT OTHER SYSTEM IF REQUIRED
RLOOP0:	MOVEI	L,INTLST	;ARG LIST ADDRESS TO LINK REGISTER
	PUSHJ P,RECVC##
	SKIPL IERR
	ERRMES(<TRANSMISSION ERROR>)
	MOVE MESAGE		;GET INTERNAL MESSAGE BYTE COUNT
	TRZ 200			;LAST MESSAGE FOR FILE ?
	JUMPE RDONE1		; AND BYTE COUNT IS ZERO ?
	MOVNS
	HRL 1,0
	HRRI 1,ARRAY
RLOOP1:	MOVE C,(1)		;GET AN 8-BIT BYTE
	PUSHJ P,PUTBYT		;AND WRITE IT AS 2 4-BIT BYTES
	AOBJN 1,RLOOP1
	MOVE MESAGE
	TRNN 200		;PROCESSED LAST MESSAGE OF FILE ?
	JRST RLOOP0		;NO. GET THE NEXT MESSAGE
RDONE1:	PUSHJ P,PUTLST		;YES. OUTPUT THE LAST BUFFER TO DISK
	SKIPE INTFLG
	JSA	L,DIALC##
	JUMP [0]
	JUMP [0]
	JUMP IERR
	JUMP ITYPE
	PUSHJ P,HNGUPC
	CLOSE DSK,
	EXIT
	SUBTTL	MISCELLANEOUS DISK AND INITIALIZATION ROUTINES


;	ROUTINE TO ASSEMBLE 2 4-BIT BYTES FROM THE FILE INTO ONE
;	8-BIT BYTE
;CALLING SEQUENCE:
;	PUSHJ	P,GETFOR
;	  END-OF-FILE RETURN
;	NORMAL RETURN  8-BIT BYTE IS IN REGISTER C

GETBYT:	PUSHJ P,GETFOR
	POPJ P,
	MOVE M,C
	PUSHJ P,GETFOR
	POPJ P,
	LSH M,4
	IOR C,M
CPOPJ1:	AOS (P)
	POPJ P,

GETFOR:	SOSGE COUNT
	JRST GETBUF
	ILDB C,BYTPNT		;GET A 4-BIT BYTE
	JRST CPOPJ1		;NORMAL RETURN IS SKIP RETURN

GETBUF:	MOVE C,[POINT 4,BUFFER] ;RETRIEVE CONSECUTIVE 4-BIT BYTES FROM FILE
	MOVEM C,BYTPNT#
	MOVEI C,^D9*^D128	;INITIALIZE BUFFER 4-BIT BYTE COUNT
	MOVEM C,COUNT#
	IN DSK,CL		;READ THE BUFFER (ONE DISK BLOCK)
	JRST GETFOR		;OK RETURN
	STATZ DSK,1B22		;END-OF-FILE ?
	POPJ P,			;YES. TAKE EOF RETURN (NONSKIP)
	ERRMES(<ERROR READING DSK FILE>)


;	ROUTINE TO SPLIT A 8-BIT BYTE INTO 2 FOUR BIT UNITS TO BE
;	PLACED IN THE OUTPUT FILE.  ROUTINE SHOULD BE CALLED WITH
;	8-BIT BYTE IN REGISTER C.

PUTBYT:	MOVE M,C
	LSH C,-4
	PUSHJ P,PUTFOR		;HIGH ORDER 4 BITS GO FIRST
	MOVE C,M
	ANDI C,17
	PUSHJ P,PUTFOR		;THEN LOW ORDER 4 BITS FOLLOW
	POPJ P,

PUTFR0:	SETZM BUFFER		;CLEAR THE BUFFER TO ZEROS
	MOVE P2,[XWD BUFFER,BUFFER+1] ;IT MAY ONLY BE PARTIALLY USED
	BLT P2,BUFFER+177
PUTFOR:	SOSGE COUNT
	JRST PUTBUF
	IDPB C,BYTPNT
	POPJ P,
PUTBUF:	MOVE  P2,[POINT 4,BUFFER] ;HAVE FILLED THE DISK BUFFER
	MOVEM P2,BYTPNT		;REINITIALIZE BYTE POINTER AND COUNT
	MOVEI P2,^D9*^D128
	MOVEM P2,COUNT
	OUT DSK,CL		;WRITE THE BUFFER
	JRST PUTFR0		;OK RETURN
	ERRMES(<ERROR DURING OUTPUT TO DSK>)

PUTLST:	MOVE COUNT		;OUTPUT THE LAST BUFFER WHICH IS ONLY
	IDIVI ^D9		; PARTIALLY FULL
	SUBI ^D128
	HRLZS
	HRRI BUFFER-1
	MOVEM CL1
	OUT DSK,CL1
	POPJ P,
	ERRMES(<ERROR DOING OUTPUT TO DSK>)
CL1:	0
	0


;	ROUTINE TO READ AND SETUP UNIVERSAL I/O INDEX

GETIOE:	TTCALL 11,
	TTCALL 3,[ASCIZ/
OCTAL DIGITS ONLY!
/]
GETIOX:	SETZ 1,
	TTCALL 3,[ASCIZ/TTY NUMBER?   /]
GETIOL:	TTCALL 4,
	CAIN 15
	JRST GETIOD
	CAIL 60
	CAILE 67
	JRST GETIOE
	SUBI 60
	LSH 1,3
	ADD 1,
	JRST GETIOL
GETIOD:	TRO 1,200000
	HRRZM 1,IOINDX#
	TTCALL 11,
	POPJ P,


;	ROUTINE TO READ AND SETUP FILENAME

GETERR:	TTCALL 11,
	TTCALL 3,[ASCIZ/
USE THE FORMAT:  NAME.EXT<CR>
/]
GETNAM:	TTCALL 3,[ASCIZ/FILE NAME?   /]
	MOVEI AC,6
	MOVE T1,[POINT 6,NAME]
	SETZM NAME
	SETZM NAME+1
	INCHWL C
	JRST GETLP2
GETLOP:	INCHSL C
	JRST GETERR
GETLP2:	CAIN C,15
	JRST GETDON
	CAIN C,"."
	JRST GETEXT
	SUBI C,40
	IDPB C,T1
	SOJG AC,GETLOP
GETLP1:	INCHSL C
	JRST GETERR
	CAIN C,15
	JRST GETDON
	CAIE C,"."
	JRST GETLP1

GETEXT:	CAIL	AC,6		;GOT ANY CHARACTERS ?
	JRST	GETERR		;NO. MUST HAVE AT LEAST ONE
	MOVEI AC,3
	MOVE T1,[POINT 6,NAME+1]
GETELP:	INCHSL C
	JRST GETERR
	CAIN C,15
	JRST GETDON
	SUBI C,40
	IDPB C,T1
	SOJG AC,GETELP
GETDON:	TTCALL 11,
	POPJ P,


;	ROUTINE TO OPEN A FILE FOR INPUT

OPNFIL:	INIT 1,17
	SIXBIT/DSK/
	XWD OBUF,IBUF
	ERRMES(<DSK NOT AVAILABLE>)
	SETZ P1,
	LOOKUP DSK,NAME
	POPJ P,
	JRST CPOPJ1


;	ROUTINE TO OPEN A FILE FOR OUTPUT

ENTFIL:	PUSHJ P,OPNFIL
	JRST OPNFL1
	TTCALL 3,[ASCIZ/FILE ALREADY EXISTS, RENAMING OLD FILE
/]
OVERWRITE:	MOVEI AC,1000
	MOVEI P1,0
OVLOOP:	MOVEI T1,3
	MOVE T2,[POINT 3,P1,26]
	MOVE T3,[POINT 6,NAME1+1]
OVLP1:	ILDB C,T2
	ADDI C,20
	IDPB C,T3
	SOJG T1,OVLP1
	MOVE T1,NAME
	MOVEM T1,NAME1
	HLLZS NAME1+1
	SETZM NAME1+2
	SETZM NAME1+3
	LOOKUP DSK,NAME
	ERRMES(<LOOKUP FAILURE ON FILE>)
	RENAME DSK,NAME1
	JRST RFAIL
	TTCALL 3,[ASCIZ/OLD FILE RENAMED TO /]
	MOVE T1,[POINT 6,NAME1]
RLOOP:	ILDB C,T1
	JUMPE C,REXT
	ADDI C,40
	TTCALL 1,C
	TLNE T1,770000
	JRST RLOOP
REXT:	MOVEI C,"."
	TTCALL 1,C
	MOVE T1,[POINT 6,NAME1+1]
	HLLZS NAME1+1
RELP:	ILDB C,T1
	JUMPE C,RDONE
	ADDI C,40
	TTCALL 1,C
	JRST RELP
RDONE:	TTCALL 3,[ASCIZ/
/]
	HLLZS NAME+1
	SETZM NAME+2
	SETZM NAME+3
	SETZ P1,
OPNFL1:	SETZM NAME+3		;CLEAR THE PPN
	ENTER DSK,NAME
	ERRMES(<ENTER FAILURE ON OUTPUT FILE>)
	POPJ P,


RFAIL:	AOS P1			;RENAME HAS FAILED.  TRY AGAIN
	SOJG AC,OVLOOP
	ERRMES(<CANNOT RENAME OLD FILE>)
	SUBTTL	ROUTINE TO DIAL A PHONE NUMBER


GETNUM:	MOVE 1,[POINT 36,NUMBER]
	TTCALL 3,[ASCIZ/
PHONE # TO DIAL (<CR> IF NONE) ?  /]
	MOVSI 2,-20
DLOOP:	TTCALL 4,0
	CAIN 15
	JRST DIAL
	CAIG "9"
	CAIGE "0"
	JRST ERROR
	SUBI "0"
	IDPB 1
	AOBJN 2,DLOOP
ERROR:	TTCALL 11,
	TTCALL 3,[ASCIZ/USE DIGITS ONLY, NUMBER MUST BE LESS THAN 16 DIGITS.
/]
	JRST GETNUM

NUMBER:	BLOCK	^D16		;ONE DIGIT PER WORD
DNUM:	0

DIAL:	HRRZM 2,DNUM		;NUMBER OF DIGITS TO DIAL
	JSA	L,DIALF##	;DIAL THE NUMBER
	JUMP NUMBER
	JUMP DNUM
	JUMP IERR
	JUMP ITYPE#
	SKIPN IERR
	ERRMES(<DIALER ERROR>) 
	TTCALL 3,[ASCIZ/
/]
	POPJ P,
	SUBTTL	STORAGE AREAS


NAME1:	BLOCK 4

NAME:	SIXBIT/FILE/
	0
	0
	0
	0

PDLEN=10
PDLST:	BLOCK PDLEN



IBUF:	BLOCK 3
OBUF:	BLOCK 3

CL:	IOWD ^D128,BUFFER
	0
MESSIZ=^D70
MESAGE:	0
ARRAY:	BLOCK MESSIZ
BUFFER:	BLOCK ^D128


;	AGUMENT LIST ENTRY
; AA IS ARGUMENT TYPE
; BB IS INDIRECT BIT
; CC IS ARGUMENT NAME
	DEFINE	ARGENT(AA,BB,CC)
<	BYTE 	(9)0 (4)AA (1)BB (4)0 (18)CC
>

	TP%INT=	2		;INTEGER, COMP ARGUMENT TYPE
	TP%BYT=	15		;COBOL BYTE STRING DESCRIPTOR


;	COBOL, FORTRAN-10 ARGUMENT LIST FOR INITIALIZATION

	XWD	-3,0
INTLST:	ARGENT	(TP%INT,0,IOINDX)
	ARGENT	(TP%INT,0,IERR)
	ARGENT	(TP%INT,0,ITYPE)

;	COBOL, FORTRAN-10 ARGUMENT LIST FOR SENDING OR RECEIVING

	XWD	-4,0
SNDLST:	ARGENT	(TP%BYT,0,MSGBYT)
	ARGENT	(TP%INT,0,[MESSIZ+1])
	ARGENT	(TP%INT,0,IERR)
	ARGENT	(TP%INT,0,ITYPE)

MSGBYT:	POINT	36,MESAGE		;BYTE POINTER TO MESSAGE
	EXP	MESSIZ+1		;BYTE COUNT


	END DFHACK