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