Trailing-Edge
-
PDP-10 Archives
-
decuslib10-04
-
43,50346/filsnd.mac
There are 4 other files named filsnd.mac in the archive. Click here to see a list.
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