Google
 

Trailing-Edge - PDP-10 Archives - decuslib20-03 - decus/20-0084/filsnd.mac
There are 4 other files named filsnd.mac in the archive. Click here to see a list.
00100		TITLE FILSND
00200		ENTRY DFHACK
00300	
00400	
00500	;	TEST PROGRAM FOR INTERPROCESSOR COMMUNICATIONS ROUTINES.
00600	;THE DEC-10 STORES INFORMATION IN 36-BIT WORDS ON THE DISK.  FOR
00700	;TRANSMISSION, A WORD IS PICKED UP IN 4-BIT BYTES, COMBINED 2 PER
00800	;8-BIT BYTE AND THEN FORMATTED IN A MESSAGE OF LENGTH 1-70 BYTES.
00900	;THE REVERSE PROCESS IS PERFORMED ON MESSAGES RECEIVED.
01000	;EACH MESSAGE (THE RESIDUAL TEXT AFTER STRIPPING AWAY ALL THE
01100	;MAJOR PROTOCOL BYTES) IS COMPOSED OF TWO PARTS:
01200	;BYTE 1: LOWER 7 BITS IS THE NUMBER OF BYTES IN THE ACTUAL TEXT AND
01300	; IS ALWAYS ONE LESS THAN THE MAJOR PROTOCOL MESSAGE COUNT.  THE
01400	; EIGHTH BIT (200 BASE 8 MASK) PRESENT IS USED TO INDICATE AN 
01500	; END OF FILE.
01600	;BYTES 2-72: TEXT
01700	
01800	
01900		DEFINE ERRMES(A)
02000	<	JRST [TTCALL 3,[ASCIZ/A/]
02100			JSA 16,HNGUPF##
02200			EXIT]>
02300	
02400	
02500		P=17
02600		L=16			;THE LINK REGISTER
02700		C=16
02800		M=15
02900		P2=14
03000		P1=13
03100	
03200		AC=0
03300		T1=1
03400		T2=2
03500		T3=3
03600	
03700		DSK=1
03800	
03900	DFHACK:	RESET
04000		MOVE P,[IOWD PDLEN,PDLST]
04100		PUSHJ P,GETIOX		;GET TTY NUMBER
04200		PUSHJ P,GETNAM		;GET FILENAME AND EXTENSION
04300		SETZM INTFLG#
04400	IT:	TTCALL 3,[ASCIZ/
04500	 MANUAL INITIALIZATION OF OTHER SYSTEM? /]
04600		TTCALL 4,0		;INCHWL
04700		TTCALL 11,		;CLRBFI
04800		CAIE "N"
04900		CAIN "Y"
05000		SKIPA
05100		JRST [TTCALL 3,[ASCIZ/
05200	TYPE Y OR N 
05300	/]
05400			JRST IT]
05500		CAIN "Y"
05600		SETOM INTFLG		;YES. INITIATING OTHER SYSTEM
05700	SORR:	TTCALL 3,[ASCIZ/SEND OR RECEIVE?  /]
05800		TTCALL 4,0
05900		TTCALL 11,
06000		CAIN "R"
06100		JRST RECV
06200		CAIN "S"
06300		JRST SEND
06400		TTCALL 3,[ASCIZ/TYPE  S OR R
06500	/]
06600		JRST SORR
     
00100		SUBTTL	ROUTINE TO SEND A FILE
00200	
00300	SEND:	PUSHJ P,OPNFIL
00400		ERRMES(<FILE DOES NOT EXIST>)
00500		SETZM COUNT		;TO FORCE FIRST INPUT
00600		MOVEI	L,INTLST	;ARGUMENT LIST ADDRESS
00700		PUSHJ P,INITC
00800		SKIPN IERR#
00900		ERRMES(<COMMUNICATIONS LINE INITIALIZATION ERROR>)
01000		SKIPE INTFLG
01100		PUSHJ P,GETNUM		;DIAL A NUMBER
01200		TTCALL 3,[ASCIZ/STARTING TO SEND
01300	/]
01400	GLOOP0:	MOVSI 1,-MESSIZ
01500		HRRI 1,ARRAY
01600	GLOOP1:	PUSHJ P,GETBYT		;GET ONE 8-BIT BYTE FROM THE FILE
01700		JRST LSTMES		;END-OF-FILE RETURN
01800		MOVEM C,(1)
01900		AOBJN 1,GLOOP1
02000		MOVEI 1,MESSIZ		;GET INTERNAL MESSAGE BYTE COUNT
02100		MOVEM 1,MESAGE		;PUT IT IN FIRST BYTE OF MESSAGE
02200		MOVEI	L,SNDLST	;GET ARGUMENT LIST ADDR IN LINK REGISTER
02300		PUSHJ P,SENDC##
02400		SKIPGE IERR
02500		JRST GLOOP0
02600		SKIPG	IERR		;GOT A DATA MESSAGE INSTEAD ?
02700		ERRMES (<TRANSMISSION ERROR>)
02800		ERRMES	(<DATA MESSAGE RECEIVED IN SEND, ERROR>) ;YES. TELL USER
02900	
03000	LSTMES:	HLRES 1			;COMPUTE INTERNAL MESSAGE COUNT
03100		ADDI 1,MESSIZ		; ...
03200		TRO 1,200		;SET END-OF-FILE FLAG
03300		MOVEM 1,MESAGE
03400		MOVEI	L,SNDLST	;ARG LIST ADDRESS TO LINK REGISTER
03500		PUSHJ P,SENDC
03600		SKIPL IERR
03700		ERRMES(<TRANSMISSION ERROR>)
03800		SKIPE INTFLG		;IF OTHER SYSTEM MANUALLY INITIALIZED,
03900		JSA L,DIALC##		; PUT IN MONITOR MODE WITH OTHER COMPUTER
04000		JUMP [0]		; SO USER MAY LOGOUT.
04100		JUMP [0]		;BUT DON'T DO ANY DIALING
04200		JUMP IERR
04300		JUMP ITYPE
04400		TTCALL 3,[ASCIZ/
04500	/]
04600		PUSHJ P,HNGUPC##
04700		TTCALL 3,[ASCIZ/  TRANSFER COMPLETED!/]
04800		EXIT
     
00100		SUBTTL	ROUTINE TO CREATE A FILE FROM RECEIVED MESSAGES
00200	
00300	
00400	RECV:	PUSHJ P,ENTFIL		;OPEN THE FILE FOR OUTPUT
00500		MOVE [POINT 4,BUFFER]
00600		MOVEM BYTPNT
00700		MOVEI ^D9*^D128		;SETUP THE BUFFER 4-BIT BYTE COUNT
00800		MOVEM COUNT
00900		MOVEI	L,INTLST	;ARG LIST ADDRESS TO LINK REGISTER
01000		PUSHJ P,INITC##
01100		SKIPL IERR
01200		ERRMES(<COMMUNICATIONS LINE INITIALIZATION ERROR>)
01300		SKIPE INTFLG
01400		PUSHJ P,GETNUM		;INIT OTHER SYSTEM IF REQUIRED
01500	RLOOP0:	MOVEI	L,INTLST	;ARG LIST ADDRESS TO LINK REGISTER
01600		PUSHJ P,RECVC##
01700		SKIPL IERR
01800		ERRMES(<TRANSMISSION ERROR>)
01900		MOVE MESAGE		;GET INTERNAL MESSAGE BYTE COUNT
02000		TRZ 200			;LAST MESSAGE FOR FILE ?
02100		JUMPE RDONE1		; AND BYTE COUNT IS ZERO ?
02200		MOVNS
02300		HRL 1,0
02400		HRRI 1,ARRAY
02500	RLOOP1:	MOVE C,(1)		;GET AN 8-BIT BYTE
02600		PUSHJ P,PUTBYT		;AND WRITE IT AS 2 4-BIT BYTES
02700		AOBJN 1,RLOOP1
02800		MOVE MESAGE
02900		TRNN 200		;PROCESSED LAST MESSAGE OF FILE ?
03000		JRST RLOOP0		;NO. GET THE NEXT MESSAGE
03100	RDONE1:	PUSHJ P,PUTLST		;YES. OUTPUT THE LAST BUFFER TO DISK
03200		SKIPE INTFLG
03300		JSA	L,DIALC##
03400		JUMP [0]
03500		JUMP [0]
03600		JUMP IERR
03700		JUMP ITYPE
03800		PUSHJ P,HNGUPC
03900		CLOSE DSK,
04000		EXIT
     
00100		SUBTTL	MISCELLANEOUS DISK AND INITIALIZATION ROUTINES
00200	
00300	
00400	;	ROUTINE TO ASSEMBLE 2 4-BIT BYTES FROM THE FILE INTO ONE
00500	;	8-BIT BYTE
00600	;CALLING SEQUENCE:
00700	;	PUSHJ	P,GETFOR
00800	;	  END-OF-FILE RETURN
00900	;	NORMAL RETURN  8-BIT BYTE IS IN REGISTER C
01000	
01100	GETBYT:	PUSHJ P,GETFOR
01200		POPJ P,
01300		MOVE M,C
01400		PUSHJ P,GETFOR
01500		POPJ P,
01600		LSH M,4
01700		IOR C,M
01800	CPOPJ1:	AOS (P)
01900		POPJ P,
02000	
02100	GETFOR:	SOSGE COUNT
02200		JRST GETBUF
02300		ILDB C,BYTPNT		;GET A 4-BIT BYTE
02400		JRST CPOPJ1		;NORMAL RETURN IS SKIP RETURN
02500	
02600	GETBUF:	MOVE C,[POINT 4,BUFFER] ;RETRIEVE CONSECUTIVE 4-BIT BYTES FROM FILE
02700		MOVEM C,BYTPNT#
02800		MOVEI C,^D9*^D128	;INITIALIZE BUFFER 4-BIT BYTE COUNT
02900		MOVEM C,COUNT#
03000		IN DSK,CL		;READ THE BUFFER (ONE DISK BLOCK)
03100		JRST GETFOR		;OK RETURN
03200		STATZ DSK,1B22		;END-OF-FILE ?
03300		POPJ P,			;YES. TAKE EOF RETURN (NONSKIP)
03400		ERRMES(<ERROR READING DSK FILE>)
03500	
03600	
03700	;	ROUTINE TO SPLIT A 8-BIT BYTE INTO 2 FOUR BIT UNITS TO BE
03800	;	PLACED IN THE OUTPUT FILE.  ROUTINE SHOULD BE CALLED WITH
03900	;	8-BIT BYTE IN REGISTER C.
04000	
04100	PUTBYT:	MOVE M,C
04200		LSH C,-4
04300		PUSHJ P,PUTFOR		;HIGH ORDER 4 BITS GO FIRST
04400		MOVE C,M
04500		ANDI C,17
04600		PUSHJ P,PUTFOR		;THEN LOW ORDER 4 BITS FOLLOW
04700		POPJ P,
04800	
04900	PUTFR0:	SETZM BUFFER		;CLEAR THE BUFFER TO ZEROS
05000		MOVE P2,[XWD BUFFER,BUFFER+1] ;IT MAY ONLY BE PARTIALLY USED
05100		BLT P2,BUFFER+177
05200	PUTFOR:	SOSGE COUNT
05300		JRST PUTBUF
05400		IDPB C,BYTPNT
05500		POPJ P,
05600	PUTBUF:	MOVE  P2,[POINT 4,BUFFER] ;HAVE FILLED THE DISK BUFFER
05700		MOVEM P2,BYTPNT		;REINITIALIZE BYTE POINTER AND COUNT
05800		MOVEI P2,^D9*^D128
05900		MOVEM P2,COUNT
06000		OUT DSK,CL		;WRITE THE BUFFER
06100		JRST PUTFR0		;OK RETURN
06200		ERRMES(<ERROR DURING OUTPUT TO DSK>)
06300	
06400	PUTLST:	MOVE COUNT		;OUTPUT THE LAST BUFFER WHICH IS ONLY
06500		IDIVI ^D9		; PARTIALLY FULL
06600		SUBI ^D128
06700		HRLZS
06800		HRRI BUFFER-1
06900		MOVEM CL1
07000		OUT DSK,CL1
07100		POPJ P,
07200		ERRMES(<ERROR DOING OUTPUT TO DSK>)
07300	CL1:	0
07400		0
07500	
07600	
07700	;	ROUTINE TO READ AND SETUP UNIVERSAL I/O INDEX
07800	
07900	GETIOE:	TTCALL 11,
08000		TTCALL 3,[ASCIZ/
08100	OCTAL DIGITS ONLY!
08200	/]
08300	GETIOX:	SETZ 1,
08400		TTCALL 3,[ASCIZ/TTY NUMBER?   /]
08500	GETIOL:	TTCALL 4,
08600		CAIN 15
08700		JRST GETIOD
08800		CAIL 60
08900		CAILE 67
09000		JRST GETIOE
09100		SUBI 60
09200		LSH 1,3
09300		ADD 1,
09400		JRST GETIOL
09500	GETIOD:	TRO 1,200000
09600		HRRZM 1,IOINDX#
09700		TTCALL 11,
09800		POPJ P,
09900	
10000	
10100	;	ROUTINE TO READ AND SETUP FILENAME
10200	
10300	GETERR:	TTCALL 11,
10400		TTCALL 3,[ASCIZ/
10500	USE THE FORMAT:  NAME.EXT<CR>
10600	/]
10700	GETNAM:	TTCALL 3,[ASCIZ/FILE NAME?   /]
10800		MOVEI AC,6
10900		MOVE T1,[POINT 6,NAME]
11000		SETZM NAME
11100		SETZM NAME+1
11200		INCHWL C
11300		JRST GETLP2
11400	GETLOP:	INCHSL C
11500		JRST GETERR
11600	GETLP2:	CAIN C,15
11700		JRST GETDON
11800		CAIN C,"."
11900		JRST GETEXT
12000		SUBI C,40
12100		IDPB C,T1
12200		SOJG AC,GETLOP
12300	GETLP1:	INCHSL C
12400		JRST GETERR
12500		CAIN C,15
12600		JRST GETDON
12700		CAIE C,"."
12800		JRST GETLP1
12900	
13000	GETEXT:	CAIL	AC,6		;GOT ANY CHARACTERS ?
13100		JRST	GETERR		;NO. MUST HAVE AT LEAST ONE
13200		MOVEI AC,3
13300		MOVE T1,[POINT 6,NAME+1]
13400	GETELP:	INCHSL C
13500		JRST GETERR
13600		CAIN C,15
13700		JRST GETDON
13800		SUBI C,40
13900		IDPB C,T1
14000		SOJG AC,GETELP
14100	GETDON:	TTCALL 11,
14200		POPJ P,
14300	
14400	
14500	;	ROUTINE TO OPEN A FILE FOR INPUT
14600	
14700	OPNFIL:	INIT 1,17
14800		SIXBIT/DSK/
14900		XWD OBUF,IBUF
15000		ERRMES(<DSK NOT AVAILABLE>)
15100		SETZ P1,
15200		LOOKUP DSK,NAME
15300		POPJ P,
15400		JRST CPOPJ1
15500	
15600	
15700	;	ROUTINE TO OPEN A FILE FOR OUTPUT
15800	
15900	ENTFIL:	PUSHJ P,OPNFIL
16000		JRST OPNFL1
16100		TTCALL 3,[ASCIZ/FILE ALREADY EXISTS, RENAMING OLD FILE
16200	/]
16300	OVERWRITE:	MOVEI AC,1000
16400		MOVEI P1,0
16500	OVLOOP:	MOVEI T1,3
16600		MOVE T2,[POINT 3,P1,26]
16700		MOVE T3,[POINT 6,NAME1+1]
16800	OVLP1:	ILDB C,T2
16900		ADDI C,20
17000		IDPB C,T3
17100		SOJG T1,OVLP1
17200		MOVE T1,NAME
17300		MOVEM T1,NAME1
17400		HLLZS NAME1+1
17500		SETZM NAME1+2
17600		SETZM NAME1+3
17700		LOOKUP DSK,NAME
17800		ERRMES(<LOOKUP FAILURE ON FILE>)
17900		RENAME DSK,NAME1
18000		JRST RFAIL
18100		TTCALL 3,[ASCIZ/OLD FILE RENAMED TO /]
18200		MOVE T1,[POINT 6,NAME1]
18300	RLOOP:	ILDB C,T1
18400		JUMPE C,REXT
18500		ADDI C,40
18600		TTCALL 1,C
18700		TLNE T1,770000
18800		JRST RLOOP
18900	REXT:	MOVEI C,"."
19000		TTCALL 1,C
19100		MOVE T1,[POINT 6,NAME1+1]
19200		HLLZS NAME1+1
19300	RELP:	ILDB C,T1
19400		JUMPE C,RDONE
19500		ADDI C,40
19600		TTCALL 1,C
19700		JRST RELP
19800	RDONE:	TTCALL 3,[ASCIZ/
19900	/]
20000		HLLZS NAME+1
20100		SETZM NAME+2
20200		SETZM NAME+3
20300		SETZ P1,
20400	OPNFL1:	SETZM NAME+3		;CLEAR THE PPN
20500		ENTER DSK,NAME
20600		ERRMES(<ENTER FAILURE ON OUTPUT FILE>)
20700		POPJ P,
20800	
20900	
21000	RFAIL:	AOS P1			;RENAME HAS FAILED.  TRY AGAIN
21100		SOJG AC,OVLOOP
21200		ERRMES(<CANNOT RENAME OLD FILE>)
     
00100		SUBTTL	ROUTINE TO DIAL A PHONE NUMBER
00200	
00300	
00400	GETNUM:	MOVE 1,[POINT 36,NUMBER]
00500		TTCALL 3,[ASCIZ/
00600	PHONE # TO DIAL (<CR> IF NONE) ?  /]
00700		MOVSI 2,-20
00800	DLOOP:	TTCALL 4,0
00900		CAIN 15
01000		JRST DIAL
01100		CAIG "9"
01200		CAIGE "0"
01300		JRST ERROR
01400		SUBI "0"
01500		IDPB 1
01600		AOBJN 2,DLOOP
01700	ERROR:	TTCALL 11,
01800		TTCALL 3,[ASCIZ/USE DIGITS ONLY, NUMBER MUST BE LESS THAN 16 DIGITS.
01900	/]
02000		JRST GETNUM
02100	
02200	NUMBER:	BLOCK	^D16		;ONE DIGIT PER WORD
02300	DNUM:	0
02400	
02500	DIAL:	HRRZM 2,DNUM		;NUMBER OF DIGITS TO DIAL
02600		JSA	L,DIALF##	;DIAL THE NUMBER
02700		JUMP NUMBER
02800		JUMP DNUM
02900		JUMP IERR
03000		JUMP ITYPE#
03100		SKIPN IERR
03200		ERRMES(<DIALER ERROR>) 
03300		TTCALL 3,[ASCIZ/
03400	/]
03500		POPJ P,
     
00100		SUBTTL	STORAGE AREAS
00200	
00300	
00400	NAME1:	BLOCK 4
00500	
00600	NAME:	SIXBIT/FILE/
00700		0
00800		0
00900		0
01000		0
01100	
01200	PDLEN=10
01300	PDLST:	BLOCK PDLEN
01400	
01500	
01600	
01700	IBUF:	BLOCK 3
01800	OBUF:	BLOCK 3
01900	
02000	CL:	IOWD ^D128,BUFFER
02100		0
02200	MESSIZ=^D70
02300	MESAGE:	0
02400	ARRAY:	BLOCK MESSIZ
02500	BUFFER:	BLOCK ^D128
02600	
02700	
02800	;	AGUMENT LIST ENTRY
02900	; AA IS ARGUMENT TYPE
03000	; BB IS INDIRECT BIT
03100	; CC IS ARGUMENT NAME
03200		DEFINE	ARGENT(AA,BB,CC)
03300	<	BYTE 	(9)0 (4)AA (1)BB (4)0 (18)CC
03400	>
03500	
03600		TP%INT=	2		;INTEGER, COMP ARGUMENT TYPE
03700		TP%BYT=	15		;COBOL BYTE STRING DESCRIPTOR
03800	
03900	
04000	;	COBOL, FORTRAN-10 ARGUMENT LIST FOR INITIALIZATION
04100	
04200		XWD	-3,0
04300	INTLST:	ARGENT	(TP%INT,0,IOINDX)
04400		ARGENT	(TP%INT,0,IERR)
04500		ARGENT	(TP%INT,0,ITYPE)
04600	
04700	;	COBOL, FORTRAN-10 ARGUMENT LIST FOR SENDING OR RECEIVING
04800	
04900		XWD	-4,0
05000	SNDLST:	ARGENT	(TP%BYT,0,MSGBYT)
05100		ARGENT	(TP%INT,0,[MESSIZ+1])
05200		ARGENT	(TP%INT,0,IERR)
05300		ARGENT	(TP%INT,0,ITYPE)
05400	
05500	MSGBYT:	POINT	36,MESAGE		;BYTE POINTER TO MESSAGE
05600		EXP	MESSIZ+1		;BYTE COUNT
05700	
05800	
05900		END DFHACK