Trailing-Edge
-
PDP-10 Archives
-
k20v7b
-
decnet-tools/host.mac
There are 5 other files named host.mac in the archive. Click here to see a list.
TITLE HOST Network Command Terminal Active Task
SUBTTL P. MIERSWA/DBFite/EHLeache
;COPYRIGHT (C) 1980,1981 BY
;DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.
;
;
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
;ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE AND WITH THE
;INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE OR ANY OTHER
;COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
;OTHER PERSON. NO TITLE TO AND OWNERSHIP OF THE SOFTWARE IS HEREBY
;TRANSFERRED.
;
;
;THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT NOTICE
;AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
;CORPORATION.
;
;DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS
;SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.
PAGE
COMMENT #
This program runs on a TOPS-20 node to allow a TOPS-20
terminal to appear to be locally attached to a remote VMS, RSTS, RSX11,
or TOPS-10 or TOPS-20 node.
General Program Structure
VMS SUPPORT
Following initialization, the main line code sits in
a DISMS JSYS. Interrupt routines then control processing.
The most important routine, NETAST, receives network
messages from the VMS system. Some requests can be
processed immediately, but others must be queued. The
queued requests are performed by the main line code, which
is awakened by NETAST whenever the first entry is added to
the queue. Queue manipulation interference is prevented
by having the main line code disable interrupts whenever
it performs queue manipulation.
STILL TO DO (VMS):
1. KNOWN BUGS
A. EDT sometimes loses track of cursor position (^W cures).
B. DEF (MCR DEF) appears to be using 8-byte IO packets -
thus a response longer than 8 chars cannot be entered.
(Other NVT hacks do not exhibit this behaviour.)
C. SOS alter mode adds a gratuitous CRLF every 8 characters when
redisplaying the line. Is this related to the previous problem?
D. HELP foo sometimes runs wild and displays only infinite CRLF's.
For RSTS:
1. ADD SUPPORT OF DELIMITER AND WIDTH FIELDS IN CONTROL MESSAGE
2. IF LOWER FORK DIES, HAVE UPPER FORK RECEIVE AN INTERRUPT
AND ALSO DIE. THROW AWAY RABORT.
For 11M:
1. get rid of extra carriage return line feed
2. IMPLEMENT ALL OF THE OTER MESSAGE TYPES
3. Make multi forking work
For rel 4 brand 10/20
1. If lower fork dies make upper fork halt also.
For everyboby:
1. Invent an escape character which causes all incoming network
messages to be discarded. needs a lot of thought. (suggested
by Arnie Miller)
2. Replace the buffer pool code with buffer management for
variable size buffers. This should make the working set smaller
(if done right) and lower overhead.
If anyone solves these problems please let me know.
Send mail to BENCE@KL2102. Thanks.
#
page
comment #
HOST allows you to logon to a remote VMS, RSTS, RSX11, TOPS-10, OR TOPS-20
system from a TOPS-20 system using DECnet. To run HOST just type:
@HOST NODENAME::[NODENAME::...]
To exit from HOST either logout of the remote system or type ^P.
Note that you can specify an alternate escape character
by running HOST. It will prompt for the new escape character.
Note also that the use of ^C, for VMS and RSX11 remotes is different due to its
defered interrupt status on TOPS-20. To cause one ^C to
be seen by the remote you must type one ^C when a read is in progress
or two ^C's when no read is in progress.
#
SUBTTL Edit History
PAGE
COMMENT #
VERSION 3
0 Begin edit history with version 3.
1 Convert lower case to upper case when reading node
names. Some nodes can't accept lower case node names.
VERSION 4
0 Added rel 4 support of 10/20 ttys. This is the beginning
of version 4.
VERSION 5
0 Add support of RSX11s. This is version 5
1 Add support of SYSTEM:DECNET-HOSTS.TXT
2 Increase MAXBUF to ^D263
VERSION 6
0 Add improved QIO-packet support
1 add full duplex vms algorithm
add correct initial tty configuration for vms
2 Add code to bypass poor man's routing if host is adjacent
3 FIX POOL SPACE PROBLEM in rsx11m
4 Fix both rsts and vms texti code. Rel 4 reads the free line feed
given certain break masks and rel 5 with the same break
mask does not read the free line feed. Add code to work
under both releases.
Add code to trace rsts and rsx connections
5 Make PROMPT big enough for DTR32
6 Fix some cosmetics (messages) /TPB
#
SUBTTL Macros and Symbol Definitions
PAGE
SEARCH MONSYM,MACSYM
.REQUIRE DSK:HSDNCN
SALL
;ACS
F=0 ;FLAGS
T1=1 ;TEMPORARY ACS
T2=2
T3=3
T4=4
Q1=5
Q2=6
Q3=7
Q4=10
MD=11 ;Modifier AC for QIO packets
P1=12
P2=13
P3=14
DEBUG=15
M=16 ;CURRENT BUFFER POINTER
P=17 ;STACK POINTER
; FLAG BIT DEFINITIONS
F.PRMT=1 ;READ WITH PROMPT
F.CTC=2 ;^C INTERRUPT ENABLED
F.CTY=4 ;^Y INTERRUPT ENABLED
F.CTCS=10 ;CONTROL C RECEIVED
F.CTYS=20 ;CONTROL Y RECEIVED
F.LF=40 ;A CR JUST ECHOED A LF
F.CR=100 ;CR WAS THE LAST CHAR ON A LINE
F.TTY=200 ;WHEN SET ORIGINAL TTY CHARACTERISTICS EXIST
F.FLSH=400 ;SET AFTER FIRST VMS READ WICH CLEARS
;TYPEAHEAD
F.LOST=1000 ;LOST INTERRUPT
F.TIMZ=2000 ;ZERO TIMEOUT VALUE RECEIVED
F.ESC=4000 ;AN ESCAPE WAS TYPED
F.ADJ=10000 ;ADJACENT NODE
F.WRIT=20000 ;WERE DOING A WRITE AN INT LEVEL
; DEBUGGING FACILITIES
VMSDBG=0 ;VMS DEBUGGING CODE
;LOW LEVEL PRIMITIVES FOR DEBUGGING CODE
DEFINE %NOUT ;;OUTPUT VALUE IN T2
< MOVEI T1,.PRIOU
HRRZI T3,^D8 ;;RADIX 8
TLO T3,(1B0) ;;MAGNITUDE
NOUT%
JFCL
>
DEFINE %SOUT ;;OUTPUT STRING OF POINTER IN T2
< MOVEI T1,.PRIOU
SETZM T3
SOUT%
>
DEFINE %CRLF ;;OUTPUT CRLF
< MOVEI T1,.PRIOU
MOVE T2,[POINT 7,[ASCIZ/
/]]
SETZM T3
SOUT%
>
;VMS PACKET DEBUGGING
;DEFINING VMSDBG WILL SAVE THE LAST 20 READ/WRITE PACKETS RECEIVED AND
;THE REPLY PACKETS SENT FOR THOSE READ/WRITES - SEE LRREC:
;DYNAMIC DEBUGGING
;STORE ANY COMBINATION OF THE FOLLOWING IN AC DEBUG
D.ITYP=1 ;TRACE INCOMING NETWORK MESSAGES
D.UNPR=4 ;TRACE MODIFIERS AND OPTIONS
D.OTYP=2 ;TRACE OUTGOING NETWORK MESSAGES
SUBTTL DEFINITIONS
PDLEN=^D100 ;SIZE OF STACK
MAXBUF=^D263 ;263 WORDS EACH
NUMBUF=^D100 ;100 BUFFERS
INTRD=1 ;INTERNAL QUEUED FUNCTION CODES
INTRDP=2
INTWRT=3
CR=15 ;COMMON ASCII CHARACTERS
LF=12
FF=14
S.TOP1=11 ;SYSTEM TYPES IN CONFIG MESS
S.TOP2=10
S.RSTS=2
S.11M=4
S.VMS=7
S.ULTRIX=22
PAGE
DEFINE SAVTQ , <
DMOVEM T1,SAV1 ;SAVE T1-T4 AND Q1-Q4 FAST
DMOVEM T3,SAV2
DMOVEM Q1,SAV3
DMOVEM Q3,SAV4
MOVEM M,SAVM
>
DEFINE RESTQ , <
DMOVE T1,SAV1 ;RESTORE THEM
DMOVE T3,SAV2
DMOVE Q1,SAV3
DMOVE Q3,SAV4
MOVE M,SAVM
>
DEFINE LDW (AC,PNTR) , < ;LOAD A PDP-11 STYLE WORD
;AS 2 SWAPED 8 BIT BYTES
MOVE Q1,PNTR ;GET POINTER
LDB AC,Q1 ;1ST BYTE
ILDB Q2,Q1 ;2ND BYTE
DPB Q2,[POINT 8,AC,27] ;SWAP BYTES
TXNE AC,100000 ;WAS IT NEGATIVE?
OR AC,[777777,,600000] ;YES, EXTEND IT
>
DEFINE DPW (AC,PNTR) , < ;DEPOSIT A PDP-11 STYLE WORD
MOVE Q1,AC ;GET THE WORD
DPB Q1,PNTR ;DEPOSIT FIRST WORD
LSH Q1,-^D8 ;GET NEXT BYTE
MOVE Q2,PNTR ;GET BYTE POINTER
IDPB Q1,Q2 ;STORE IT
>
subttl Protocol Packet Definitions
PAGE
;
; RSX11M PROTOCOL PACKET DEFINITIONS
;
;
RSXFNC: POINT 8,0(M),7 ;MESSAGE TYPE
RSXMOD: POINT 8,0(M),15 ;MODIFIER
RSXFLG: POINT 8,0(M),23 ;FLAGS
RSXSTA: POINT 8,0(M),31 ;STATUS
RSXRID: POINT 8,1(M),7 ;IDENTIFIER
;ZERO BYTE
RSXRCT: POINT 8,1(M),23 ;READ BYTE COUNT
;
RSXWCT: POINT 8,2(M),7 ;WRITE BYTE COUNT
;
RSXDAT: POINT 8,2(M),15 ;DATA (ALWAYS USE AN ILDB
;WITH THIS FIELD!)
;
; FUNCTIONS
;
;0 NO-OP
;1 SET SYSTEM DATA (CONFIGURATION)
;2 DISCONNECT
;3 WRITE DATA (REPLY TO WRITE DATA)
;4 READ DATA (REPLT TO READ DATA OR WRITE THEN READ DATA)
;5 WRITE TEN READ DATA
;6 ENABLE/DISABLE UNSOLICITED INPUT
;7 READ SINGLE CHARACTERS
;10 KILL I/O
;11 ATTACH TERMINAL
;12 GET TERMINAL CHARACTERISTICS
;13 SET TERMINAL CHARACTERISTICS
;14 EXCEPTION CONDITION REQUEST
;
; MODIFIERS
;
RM.WBN=1 ;WRITE BINARY
RM.WBT=2 ;WRITE BREAKS THROUGH READ
RM.RBN=4 ;READ BINARY
RM.RTC=10 ;READ TERMINATES ON CONTROL CHARACTERS
RM.RNE=20 ;READ WITH NO ECHO
RM.RTO=40 ;RESET TIMEOUT FOR SINGLE CHARACTERS
RM.NRY=200 ;DONT REPLY
;
;FLAGS
;
RM.PRI=2 ;PROCESS REQUEST IMMEDIATELY
RM.CAO=4 ;CANCEL ABORT OUTPUT
subttl VMS Protocol Packet Definitions
PAGE
;
; PROTOCOL PACKET DEFINITIONS
;
; This is the basic protocol packet. It is used for all
; operations not specifically described in the next few pages.
;
; !-------------------------------------------------------!
; ! OP CODE ! MODIFIER ! !
; !-------------------------------------------------------!
; ! REFERENCE ID ! !
; !-------------------------------------------------------!
; ! UNIT NUMBER ! ! !
; !-------------------------------------------------------!
;
R.OPC: POINT 8,0(M),7 ;OPERATION CODE WORD
R.MOD: POINT 8,0(M),23 ;OP CODE MODIFIER WORD
R.RID0: POINT 8,1(M),7 ;REFERENCE ID (1ST WORD)
R.RID1: POINT 8,1(M),23 ;REFERENCE ID (2ST WORD)
R.UNIT: POINT 8,2(M),7 ;DEVICE UNIT NUMBER WORD
; OP CODE MODIFIERS
;READ
CVTLOW=400 ;IO$M_CVTLOW
DISMBX=2000 ;IO$M_DSABLMBX
NOECHO=100 ;IO$M_NOECHO
NFILTR=1000 ;IO$M_NOFILTR
PURGE=4000 ;IO$M_PURGE
RFRESH=2000 ;IO$M_REFRESH
TIMED=200 ;IO$M_TIMED
TNOEKO=10000 ;IO$M_TRMNOECHO
;WRITE
CANCTRLO=100 ;IO$M_CANCTRLO
ENAMBX=200 ;IO$M_ENABLMBX
NFORMT=400 ;IO$M_NOFORMAT
;RFRESH=2000 ;IO$M_REFRESH (defined above)
;SETMODE
CC=400 ;IO$M_CTRLCAST
CY=200 ;IO$M_CTRLYAST
HANGUP=1000 ;IO$M_HANGUP
OBAND=2000
PAGE
; RETURN PACKET WITH NO DATA
;
; !-------------------------------------------------------!
; ! OP CODE ! MODIFIER ! !
; !-------------------------------------------------------!
; ! REFERENCE ID ! !
; !-------------------------------------------------------!
; ! UNIT NUMBER ! IOST... ! !
; !-------------------------------------------------------!
; ! ...IOST ! ...IOST ! !
; !-------------------------------------------------------!
; ! ...IOST ! !
; !-------------------------------------------------------!
;
R.STA: POINT 8,2(M),23 ;STATUS LONG WORD BYTES 0,1
R.STA1: POINT 8,3(M),7 ;STATUS BYTES 2,3
R.STA2: POINT 8,3(M),23 ;STATUS BYTES 4,5
R.STA3: POINT 8,4(M),7 ;STATUS BYTES 6,7
; STATUS CODES
NORMAL=1 ;SS$_NORMAL
TIMEOUT=1054 ;SS$_TIMEOUT
ABORTS=54 ;SS$_ABORT
PARTES=774 ;SS$_PARTESCAPE
BADESC=74 ;SS$_BADESCAPE
CONTRC=3121 ;SS$_CTC
CONTRY=3021 ;SS$_CTY
CANCEL=4060 ;SS$_CANCEL
HNGUPS=1314 ;SS$_HANGUP
; RETURN PACKET OPCODES
RP.ATN=-1 ;ATTENTION
RP.END=-2 ;IO REQUEST COMPLETE
RP.LOG=-3 ;ERROR LOG
; MODIFIERS FOR ATTENTION OP CODE
RA.UNS=0 ;UNSOLICITED DATA
RA.HUP=1 ;MODEM HANGUP
RA.CTC=2 ;CONTROL C
RA.CTY=3 ;CONTROL Y
PAGE
; This packet is received for READ QIOs
;
; !-------------------------------------------------------!
; ! OP CODE ! MODIFIER ! !
; !-------------------------------------------------------!
; ! REFERENCE ID ! !
; !-------------------------------------------------------!
; ! UNIT NUMBER ! BYTE... ! !
; !-------------------------------------------------------!
; ! ...COUNT ! READ... ! !
; !-------------------------------------------------------!
; ! ...TIMEOUT ! MASK SIZE ! MASK... ! !
; !-------------------------------------------------------!
; ADDITIONAL BYTES OF MASK (32 MAX)
; !-------------------------------------------------------!
; ! PROMPT SIZE ! PROMPT... ! !
; !-------------------------------------------------------!
;
; NOTE: IF THE MASK SIZE IS ZERO, THERE IS NO MASK AND
; THE NEXT FIELD BEGINS THE PROMPT COUNT.
; PROMPTS ARE ONLY GIVEN WITH IO$_READPROMPT PACKETS.
R.CNT: POINT 8,2(M),23 ;BYTE COUNT
R.TMO: POINT 8,3(M),23 ;READ TIMEOUT IN SECONDS
R.TRMS: POINT 8,4(M),23 ;SIZE OF TERMINATOR MASK (BYTE POINTER)
R.TRM: POINT 8,4(M),23 ;ILDB POINTER TO TERMINATOR MASK
PAGE
; WRITE QIO PACKET
;
; !-------------------------------------------------------!
; ! OP CODE ! MODIFIER ! !
; !-------------------------------------------------------!
; ! REFERENCE ID ! !
; !-------------------------------------------------------!
; ! UNIT NUMBER ! BYTE... ! !
; !-------------------------------------------------------!
; ! ...COUNT ! CARRIAGE... ! !
; !-------------------------------------------------------!
; ! ...CONTROL ! WRITE DATA !
; !-------------------------------------------------------!
R.WCC: POINT 8,3(M),23 ;CARRIAGE CONT FORTRAN WORD
R.CPRE: POINT 8,4(M),7 ;CARRIAGE CONT PREFIX BYTE
R.CPST: POINT 8,4(M),15 ;CARR CONT POSTFIX BYTE
R.WDAT: POINT 8,4(M),15 ;WRITE DATA
;NOTE THAT THIS IS POINTER FOR
;ILDB NOT LDB!
PAGE
; SET MODE QIO PACKET (CTRL-C/CTRL-Y AST)
;
; !-------------------------------------------------------!
; ! OP CODE ! MODIFIER ! !
; !-------------------------------------------------------!
; ! REFERENCE ID ! !
; !-------------------------------------------------------!
; ! UNUSED ! AST... ! !
; !-------------------------------------------------------!
; ! ...PARAMETERS ! ! !
; !-------------------------------------------------------!
; ! ! ! !
; !-------------------------------------------------------!
R.ASTP: POINT 8,2(M),23 ;AST PARAMETER
PAGE
COMMENT \
SET MODE QIO PACKET
!0 7!8 15! 23! 31!32 35!
!-------------------------------------------------------!
0 ! OP CODE ! MODIFIER ! !
!-------------------------------------------------------!
1 ! REFERENCE ID ! !
!-------------------------------------------------------!
2 ! UNUSED * 102 ! TRM TYP ! !
!-------------------------------------------------------!
3 ! WIDTH0 ! WIDTH1 ! CHARAC0 ! CHARAC1 ! !
!-------------------------------------------------------!
4 ! CHARAC2 ! LENGTH * SPEED0 ! SPEED1 ! !
!-------------------------------------------------------!
5 ! speed ! speed ! CRFILL ! LFFILL ! !
!-------------------------------------------------------!
6 ! fill ! fill ! parity ! parity ! !
!-------------------------------------------------------!
7 ! parity ! parity ! unused ! unused ! !
!-------------------------------------------------------!
8 ! XCHAR0 ! XCHAR1 !
!-----------------------!
Notes: 102 = device type DC$_TERM
"*" marks beggining and end of terminal characteristics buffer
CHARACn is byte n of terminal characteristics field
\;END COMMENT
R.TYPE: POINT 8,2(M),31 ;TERMINAL TYPE (BYTE POINTER!)
R.WID: POINT 8,3(M),7 ;TERMINAL WIDTH
R.LEN: POINT 8,4(M),15 ;TERMINAL LENGTH (BYTE POINTER!)
R.CHAW: POINT 16,3(M),31 ;FIRST 2 BYTES (0,1) OF CHARACTERISTICS FIELD
R.CHAB: POINT 8,4(M),7 ;LAST BYTE OF CHARACTERISTICS FIELD
R.CHA2: POINT 16,10(M),15
; (BYTE POINTER!)
;R.SPD: ;SPEED FILL AND PARITY ARE NOT SUPPORTED
;R.FILL:
;R.PAR:
; VARIOUS TERMINAL SYMBOLS
DC$TERM=102
DT$L120=41
DT$L180=3
DT$L36=40
DT$TTY=0
DT$V05=1
DT$V52=100
DT$V55=101
DT$V100=140
DT$V5X=100
DT$L38=43
DT$V125=144
; TERMINAL CHARACTERISTICS
;TERMINAL DEFINITIONS
;FLAGS IN TERMINAL CHARACTERISTICS FIELD
TLOWR=100000 ;TT$M_LOWER
TWRAP=2 ;TT$M_WRAP
TSCOP=20 ;TT$M_SCOPE
THSYNC=10000 ;TT$M_HOSTSYNC
;MISCELLANEOUS TERMINAL FLAGS
TAPAR=40 ;TT$M_ALTRPAR
TPAR=100 ;TT$M_PARITY
TODD=200 ;TT$M_ODD
TSCRP=100 ;TT$M_SCRIPT
TSPAG=10 ;TT$S_PAGE
TMPAG=37700,,0 ;TT$M_PAGE
PAGE
; READ RETURN PACKET
; !-------------------------------------------------------!
; ! OP CODE ! MODIFIER ! !
; !-------------------------------------------------------!
; ! REFERENCE ID ! !
; !-------------------------------------------------------!
; ! UNIT NUMBER ! Return status ! !
; !-------------------------------------------------------!
; ! Terminator offset ! Terminator ! !
; !-------------------------------------------------------!
; ! Terminator Length ! BYTE COUNT ! !
; !-------------------------------------------------------!
; ! RETURNED DATA !
; !-------------------------------------------------------!
R.STS: POINT 8,2(M),23 ;RETURN STATUS
R.TOFF: POINT 8,3(M),7 ;TERMINATOR OFFSET
R.TERM: POINT 8,3(M),23 ;TERMINATOR
R.TRML: POINT 8,4(M),7 ;TERMINATOR LENGTH
R.RCNT: POINT 8,4(M),23 ;RETURNED DATA BYTE COUNT
R.RDAT: POINT 8,5(M) ;RETURNED DATA
PAGE
; SENSE MODE RETURN PACKET
;
; !-------------------------------------------------------!
; ! OP CODE ! MODIFIER ! !
; !-------------------------------------------------------!
; ! REFERENCE ID ! !
; !-------------------------------------------------------!
; ! UNIT NUMBER ! IOST... ! !
; !-------------------------------------------------------!
; ! ...IOST ! ...IOST ! !
; !-------------------------------------------------------!
; ! ...IOST ! SENSED CHARS ! !
; !-------------------------------------------------------!
R.DTYP: POINT 8,4(M),23 ;DEVICE TYPE (BYTE)
R.STYP: POINT 8,4(M),31 ;TERMINAL TYPE (BYTE)
R.SWID: POINT 8,5(M),7 ;WIDTH
R.SLEN: POINT 8,6(M),15 ;LENGTH (BYTE)
R.SCHW: POINT 16,5(M),31 ;CHAR
R.SCHB: POINT 8,6(M),7
R.SCH2: POINT 16,7(M),15 ;EXTRA CHAR BYTES
SUBTTL Impure Data Storage Area
PAGE
;DATA AREA
;STORAGE FOR BREAK-MASK SUPPORT FOR VMS SYSTEMS
CMSKLN=^D8 ;MAX BREAK MASK SIZE WE CAN HANDLE
; ROOM FOR 32-BYTE MASK
CLENTH: 0 ;LENGTH OF THE RECEIVED BREAK MASK
CMASK: BLOCK CMSKLN ;CURRENT, NON-DEFAULT, BREAK MASK
DMASK: 002360001400 ;DEFAULT (TOPS10) MASK
0 ;BREAK ON CTRL(G,J,K,L,M,Z),ESC
0
0
RABORT: BLOCK 1
PFORK: BLOCK 1
RSTSBF: BLOCK 1
READQ: BLOCK 1
SYSTYP: BLOCK 1 ;SYSTEM TYPE, REMOTE SYSTEM
TTYORG: BLOCK 10
TTYWOR: BLOCK 10
JFNMOD=0 ;TTY JFN MODE WORD
TYPE=1 ;TTY TYPE
WIDTH=2 ;TTY WIDTH
LENGTH=3 ;TTY LENGTH
PAUSE=4 ;PAUSE ON END-OF-PAGE BIT
CAP=5
CCOC=6 ;CCOC WORDS
VMCHAR: BLOCK 2 ;SAVED VMS TTY CHARACTERISTICS
SAV1: BLOCK 2 ;AC SAVE AREA FOR INTERRUPTS
SAV2: BLOCK 2
SAV3: BLOCK 2
SAV4: BLOCK 2
SAVM: BLOCK 1
DEBAC1: BLOCK 2
DEBAC2: BLOCK 2
CCSAVE: BLOCK 2 ;FOR SAVING CURRENT CCOC WORDS
MODSAV: BLOCK 1 ;FOR SAVING CURRENT JFN MODE WORD
RSXTXB: 6
RD%TOP+RD%JFN
.PRIIN,,.PRIOU
0
0
0
0
RSTTXB: 7 ;TEXTI BLOCK FOR RSTS
RD%TOP+RD%JFN
.PRIIN,,.PRIOU
0
0
0
0
CURBRK
CURBRK: BLOCK 4
STDBRK: 040224,,103000 ;CR,LF,ESC,^Y,^C,^T,^Z,^O
0
0
0
;TEXTI BLOCK
TEXTIB: ^D7 ;BLOCK SIZE
0 ;FLAGS
.PRIIN,,.PRIOU ;IO JFNS
0 ;DESTINATION POINTER
0 ;LENGTH OF DESTINATION BUFFER
0 ;BYT POINTER TO BEGINNING OF DESTINATION BUFFER
0 ;BYT POINTER TO ^R BUFFER
0 ;POINTER TO 4-WORD BREAK MASK
TTYJFN: 0 ;BINARY JFN FOR TTY
SAVTRM: 0 ;FOR SAVING READ TERMINATOR
PLENTH: 0 ;PROMPT LENGTH
PROMPT: BLOCK ^D<2048/5+1>
INIMSG: BYTE(8) RP.ATN,377,RA.UNS,0,0,0,0,0
RSXCMG: BYTE(8) 14,0,0,0,0,0,0,0,0,0
TTYNUM: 0
INILEN=^D10
C20MSG: BYTE(8) 1,1,0,0,10,0,10,0
C20LEN=^D8
CNFMSG: BYTE(8) 1,1,1,0,S.TOP2,0,4,0
BYTE(8) DC$TERM,DT$TTY,0,0
BYTE(8) 0,0,0,0,0,0,0,0
CNFLEN=^D20
SCF11M: BYTE (8) 1,1,0,0,10,0,2,0,^D132,0,0,0
CFL11M=^D12
RSTCNT: BYTE(8) 2,7,0,1,4,^D80,0
RSTCNL=7
RSTSCF: BYTE(8) 1,3,0
RSTCFL=3
RSTSUP: BYTE(8) 5,5,0,1,32
SPEC: BLOCK ^D10 ;NETWORK FILE SPEC
NETJFN: BLOCK 1 ;NETWORK JFN
PDL: BLOCK PDLEN ;PUSH DOWN LIST
LOCAL: BLOCK 2 ;LOCAL NODE NAME
REMOTE: BLOCK ^D48 ;REMOTE NODE NAME
SETARG: 3
.PRIIN
ESCCAR: SH%LPM ;SET LOCAL PAGE MODE
;SOFTWARE INTERRUPT SYSTEM DATA
LEVTAB: PC1
PC2
PC3
PC1: BLOCK 1
PC2: BLOCK 2
PC3: BLOCK 3
CHNTAB: 0
1,,ESCAST ; USE CHANNEL 1 FOR ESCAPE CHARACTER
2,,CTYAST ; USE 2 FOR CONTROL C AND CONTROL Y
2,,UNSAST ; USE 3 FOR UNSOLICITED INPUT
NETINT: 2,,0 ; USE 4 FOR NETWORK DATA
CTCINT: 2,,CTCAST ; CONTROL C TRAP
REPEAT ^D30, < 0 >
; COMMAND JSYS DATA STRUCTURES
COMSTA: CM%RAI
.PRIIN,,.PRIOU
-1,,COMBUF
-1,,COMBUF
-1,,COMBUF
^D240
0
-1,,ATMBUF
^D240
0
ATMBUF: BLOCK ^D48
COMBUF: BLOCK ^D48
IFDEF VMSDBG,<
;DEBUGGING STORAGE FOR PACKETS
SBSIZ=^D20 ;Records in ring buffer
SRSIZ=^D8 ;Size of record
LRREC: 0 ; Pointer to last read-packets received
LWREC: 0 ; Pointer to last write-packets received
LRSNT: 0 ;Pointer to last read packets send
LWSNT: 0 ;Pointer to last write send
; The ring buffers
LRRECB: BLOCK SBSIZ*SRSIZ
LWRECB: BLOCK SBSIZ*SRSIZ
LRSNTB: BLOCK SBSIZ*SRSIZ
LWSNTB: BLOCK SBSIZ*SRSIZ
PACKTS: 0 ;Seqential count of read/write packets
>
; POOL AND QUEUE
POOLHD: 0
QUEHD: 0
; TOPS20 V4 BUFFERS SIT AT THE SAME ADDRESS AS THE VAX/RSTS BUFFERS
V4BSZ=10 ;BUFFER SIZE
V4BUF:
POOL: BLOCK NUMBUF*MAXBUF ;POOL
V4BUFI=V4BUF+10*5
SUBTTL Main Program
PAGE
;
; Main Program
;
V: RESET% ;RESET THE WORLD
MOVE P,[IOWD PDLEN,PDL] ;SET UP THE STACK
SETZ F, ;CLEAR FLAGS
CALL QUEINI ;INITIALIZE ALL VARIABLES
CALL COMAND ;GET THE COMMAND LINE
CALL NETINI ;INITIALIZE THE NETWORK
CALL TTYINI ;SET UP TTY CHARACTERISTICS
CALL PSIINI ;INITIALIZE PSI SYSTEM
MOVE T1,SYSTYP ;GET THE SYSTEM TYPE
CAIN T1,S.TOP2 ;20?
JRST DO20 ;YES
CAIN T1,S.TOP1 ;TOPS 10?
JRST DO10 ;YES
CAIN T1,S.11M ;11M?
JRST DO11M ;YES
CAIN T1,S.RSTS ;RSTS?
JRST DORSTS ;YES
CAIN T1,S.VMS ;VMS?
JRST DOVMS0 ;YES
CAIN T1,S.ULTRIX ;ULTRIX?
JRST DOUNIX
JUMPE T1,DO10A ;BE A TEN WITH NO SYSTEM MESSAGE
TMSG <?Target system is not TOPS-10, TOPS-20, VMS, RSTS, or RSX11M
>
HALTF%
JRST .-1
DOVMS0:
IFDEF VMSDBG,<
MOVEI T1,LRSNTB ;Set up debugging ring buffers
MOVEM T1,LRSNT
MOVEI T1,LWSNTB
MOVEM T1,LWSNT
MOVEI T1,LRRECB
MOVEM T1,LRREC
MOVEI T1,LWRECB
MOVEM T1,LWREC
SETZM PACKTS
>
TMSG <]
[Remote host is a VMS system]
>
CALL CONMES
DOVMS: MOVEI T1,^D5000 ;WAIT 5 SECONDS..
DISMS% ;OR UNTIL INTERRUPT OCCURS
WAITH: ;ALL PROCESSING
;WILL BE DRIVEN BY PACKETS
;RECEIVED FROM THE VAX SYSTEM
;OR OUR SOFTWARE INTERRUPT SYSTEM
NEXT: MOVEI T1,.FHSLF ;FOR THIS PROCESS
DIR% ;DISABEL INTERRUPTS
CALL GETQ ;GET A QUEUE REQUEST
MOVE M,T1 ;THE BUFFER ADDRESS
MOVEI T1,.FHSLF ;FOR THIS PROCESS
EIR% ;ENABLE INTERRUPTS AGAIN
CAIN M,0 ;DID WE GET ONE?
JRST [MOVE T1,NETJFN ;network jfn
MOVEI T2,.MORLS ;GET LINK STATUS
MTOPR%
TXNN T3,MO%EOM ;DO WE HAVE A COMPLETE MESSAGE?
JRST DOVMS ;NO, GO ON
TXO F,F.LOST ;YES, WE LOST AN INTERRUPT SOMEHOW
CALL NETAST ;PROCESS THE MESSAGE
JRST DOVMS]
LDW T1,R.OPC ;GET THE OP CODE
CAIN T1,INTRD ;READ?
JRST DORD ;YES
CAIN T1,INTRDP ;READ WITH PROMPT?
JRST DORDP ;YES
TMSG <?Bad internal queued message type
>
JRST ENR
SUBTTL Main Program - Abort current queue request
PAGE
;
; Abort current queue request after ^C or ^Y
;
ABORT: MOVEI T1,.FHSLF
DIR%
PUSH P,M
CALL CORY
POP P,M
MOVEI T1,RP.END ;OP CODE
DPW T1,R.OPC ;SAVE IT
SETZ T1, ;ZERO
DPW T1,R.MOD
MOVEI T1,CONTRY ;CONTROL Y WAS TYPED
TXNE F,F.CTCS ;WAS IT REALLY ^C?
MOVEI T1,CONTRC ;YES
TXZ F,F.CTCS+F.CTYS ;ZERO THE FLAGS
DPW T1,R.STA ;zero the status
SETZ T1,
DPW T1,R.STA1
DPW T1,R.STA2
DPW T1,R.STA3
MOVNI T3,^D18 ;BUFFER LENGT
MOVE T1,NETJFN ;NETWORK JFN
MOVE T2,[POINT 8,0(M)] ;BUFFER POINTER
SOUTR%
ERCAL NETERR
TXNN DEBUG,D.OTYP ;TRACING OUTPUT MESSAGES?
JRST NOUT.1
TMSG <
[Debug: Last qio aborted by ^C or ^Y reply packet sent]
>
NOUT.1: MOVE T1,M
CALL PUTPL ;RETURN BUFFER TO POOL
MOVEI T1,.FHSLF
EIR%
TXNE F,F.WRIT ;ARE WE AT INTERRUPT LEVEL?
RET ;YES, RETURN NOW
JRST NEXT
SUBTTL Main Program - Process Read and Read with prompt queue requests
PAGE
;
; Read and Read with prompt
;
DORDP: TXO F,F.PRMT ;SET THE PROMPT FLAG
JRST DORD1
DORD: TXZ F,F.PRMT ;CLEAR THE PROMPT FLAG
DORD1: TXZ F,F.TIMZ ;DISABLE NON-BLOCKING IO
TXZ F,F.ESC
MOVEI T1,.PRIIN ;FOR THIS TTY
RFMOD% ;
TXZE T2,TT%OSP ;TURN OFF CONTROL O
SFMOD%
MOVEM T2,MODSAV ;SAVE CURRENT MODE WORD (SANS ^O)
MOVEI T1,RP.END ;RETURN OP CODE
DPW T1,R.OPC ;PUT IT IN BUFFER
LDW MD,R.MOD ;LOAD MODIFIERS
TXNN DEBUG,D.UNPR ;TRACE UNPROCESSED OPTIONS?
JRST NOUN.1
MOVE T2,MD ;GET MODIFIERS
ANDCM T2,[CVTLOW+PURGE+NOECHO]
JUMPE T2,NOUN.1
TMSG <
[Debug: Read or Read with prompt, modifiers: >
MOVEI T1,.PRIOU
MOVEI T3,^D8
NOUT%
JFCL
TMSG <]
>
NOUN.1: TXNE MD,PURGE ;CLEAR OUT TYPE AHEAD BUFFER?
JRST [MOVEI T1,.PRIIN
TXOE F,F.FLSH ;DONT FLUSH USER NAME FROM INPUT BUFFER
CFIBF%
JRST .+1]
;UNSUPPORTED ARE:
;TIMED (WITH NON-ZERO VALUE), DSABLMBX
TXNN DEBUG,D.UNPR ;TRACE UNSUPPORTED OPTIONS?
JRST NOUN.2
LDW T2,R.TMO
JUMPE T2,NOUN.2
TMSG <
[Debug: Read timeout value: >
MOVEI T1,.PRIOU
MOVEI T3,^D10
NOUT%
JFCL
TMSG <]
>
NOUN.2: CALL CHKTRM ;GO SEE IF WE GOT A BREAK MASK
SETZM TEXTIB+.RDRTY ;DEFAULT NO PROMPT
TXNN F,F.PRMT ;READ WITH PROMPT
JRST [TXZN F,F.CR
JRST GBCNT
MOVEI T1,LF
PBOUT%
JRST GBCNT]
LDB T2,R.TRM ;GET LENGTH OF TERMINATOR MASK
ADJBP T2,R.TRM ;ADVANCE THE BYTE POINTER BY THE MASK LENGTH
; TO JUST PREVIOUS TO PROMPT FIELD
ILDB T1,T2 ;GET LENGTH OF PROMPT...
ILDB T3,T2 ;...
LSH T3,^D8 ;...
ADD T1,T3 ;...
MOVEM T1,PLENTH ;SAVE PROMPT LENGTH
MOVX T3,RD%JFN ;DEFAULT FLAGS
MOVEM T3,TEXTIB+.RDFLG ;SAVE IT
TXNE MD,CVTLOW ;RAISE LOWER TO UPPER CASE?
JRST [MOVX T3,RD%RAI
ORM T3,TEXTIB+.RDFLG
JRST .+1]
SKIPN PLENTH
TXZ F,F.PRMT
SKIPE PLENTH
JRST GETLF0
TXZN F,F.CR
JRST GBCNT
MOVEI T1,LF
PBOUT%
JRST GBCNT
;HERE TO STORE THE PROMPT FROM THE RECEIVED PACKET SO WE
;CAN USE IT WITH TEXTI
GETLF0: MOVE T4,[POINT 7,PROMPT] ;WHERE TO PUT THE PROMPT
GETLF: ILDB T3,T2 ;GET 1ST BYTE
CAIE T3,CR ;IS IT A CR?
JRST NOTCR ;NO
IDPB T3,T4 ;SAVE IT
SOSLE T1
JRST GETLF
JRST ENDP
NOTCR: TXNN F,F.LF ;LF ALREADY SENT?
JRST [ CAIN T3,LF ;IS IT A LF?
JRST OKLF ;YES
TXZN F,F.CR ;DID LAST LINE END WITH CR?
JRST OKLF ;NO
PUSH P,T1
MOVEI T1,LF
PBOUT%
POP P,T1
JRST OKLF]
CAIN T3,LF ;IS IT A LF?
SETZ T3,
JRST OKLF
MOVPMT: ILDB T3,T2 ;GET A BYTE OF THE PROMPT STRING
OKLF: SKIPE T3
IDPB T3,T4 ;SAVE IT
SOSLE T1 ;ALL DONE?
JRST MOVPMT ;NO, DO MORE
ENDP: TXZ F,F.CR
SETZ T3,
IDPB T3,T4 ;ASCIZ STRING
GBCNT: LDW T1,R.CNT ;MAX BYTE COUNT
JUMPE T1,NOREAD ;BYTE COUNT=0?
CAILE T1,<<MAXBUF-1>*4-^D20> ;COUNT LARGER THAN BUFFER?
MOVEI T1,<<MAXBUF-1>*4-^D20> ;YES, LOWER IT
MOVEM T1,TEXTIB+.RDDBC ;SET IT
MOVE T1,R.RDAT ;POINTER TO DATA
MOVEM T1,TEXTIB+.RDDBP ;SAVE FOR TEXTI
MOVEM T1,TEXTIB+.RDBFP ;SAVE FOR TEXTI
TXNE F,F.CTCS+F.CTYS ;TIME TO ABORT?
JRST RDABT ;YES
TXNE MD,TNOEKO ;TERMINATOR NOECHO IN EFFECT?
CALL SETCC ;YES, GO SET CCOC WORDS
TXNE MD,NOECHO ;NO ECHO?
CALL EK.OFF ;YES
TXNN MD,TIMED ;TIMEOUT SPECIFIED?
JRST NOTIM ;YES
LDW T4,R.TMO ;GET THE TIMEOUT VALUE
SKIPN T4 ;IGNORE TIMEOUT VALUE IF NON-ZERO
; ZERO MEANS NON-BLOCKING IO
TXO F,F.TIMZ ;INDICATE WE RECIEVED A ZERO TIMEOUT VALUE
NOTIM: TXNN F,F.PRMT ;IS THERE A PROMPT?
JRST NOPRMT ;NO
MOVE T2,[POINT 7,PROMPT] ;GET BYTE POINTER TO PROMPT
MOVEM T2,TEXTIB+.RDRTY ;SAVE IT
MOVE T1,TTYJFN ;GET BINARY JFN
SETZM T3 ;END ON NULL
SOUT% ;OUTPUT PROMPT
NOPRMT: TXNN MD,NFILTR ;HOST DOING EDITING?
JRST DTXT ;NO
CALL RTTY2 ;YES - HOST EDIT
SKIPA
DTXT: CALL RTTY1 ;NO - LOCAL EDIT
;RETURN HERE FROM READ WITH BYTE COUNT IN T1
; AND TERMINATOR LENGTH IN T2
; AND STATUS RETURN IN T3
RETPKT: DPW T1,R.RCNT ;DEPOSIT COUNT IN RETURN PACKET
MOVE Q4,T1 ;SAVE IT
ADDI Q4,^D20 ;ADD PACKET LENGTH
RDTRM: SUBI T1,(T2) ;CALCULATE BYTE COUNT MINUS TERMINATOR LENGTH
DPW T1,R.TOFF ;SAVE OFFSET TO TERMINATOR IN BUFFER
JUMPLE T2,NTRM ;DID WE GET A TERMINATOR?
MOVE T4,SAVTRM ;YES, GET LAST CHAR READ
SKIPA
NTRM: SETZM T4 ;NO, GET A NULL BYTE
DPW T4,R.TERM ;SAVE IN BUFFER
SVLEN: DPW T2,R.TRML ;SAVE TERMINATOR LENGTH
DPW T3,R.STS ;SAVE RETURN STATUS IN BUFFER
CALL TTRSET ;GO RESTORE TTY ENVIRONMENT
NORD1: SETZ T1,
DPW T1,R.MOD ;ZERO THE MODIFIERS
MOVE T1,NETJFN ;GET THE NETWORK JFN
MOVE T2,[POINT 8,0(M)] ;BUFFER POINTER
MOVN T3,Q4 ;BUFFER LENGTH
SOUTR%
ERCAL NETERR
IFDEF VMSDBG,<
AOS PACKTS ;INCR THE PACKET COUNT
MOVE T1,LRSNT ;Get ring-buffer pointer
CAIL T1,LRSNTB+<SBSIZ*SRSIZ>-SRSIZ-1
MOVEI T1,LRSNTB ;RESET THE POINTER
HRRO T2,PACKTS ;GET -1,,PACKET COUNT
MOVEM T2,(T1) ;STORE COUNT AT HEAD OF SAVED PACKET
AOS T1 ;INCR POINTER
MOVE T2,T1 ;GET POINTER IN T2
HRL T1,M ;GET PACKET ADDR
BLT T1,SRSIZ-1(T2) ;MOVE THE DATA
MOVE T1,LRSNT ;GET THE POINTER
ADDI T1,SRSIZ ;INCREMENT IT
MOVEM T1,LRSNT ;REPLACE IT
>
TXNN DEBUG,D.OTYP
JRST NOUT.2
TMSG <
[Debug: Reply packet sent for READ or READ with prompt]
>
NOUT.2: MOVEI T1,.FHSLF
DIR% ;DISABLE INTERRUPTS
MOVE T1,M ;BUFFER ADDRESS
CALL PUTPL ;RETURN THE BUFFER
MOVEI T1,.FHSLF
EIR% ;ENABLE INTERRUPTS
SOS READQ
JRST NEXT ;PROCESS NEXT ENTRY ON THE QUEUE
NOREAD: MOVEI T1,NORMAL
DPW T1,R.STA
SETZ T1,
; DPW T1,R.TOFF ;ZERO TERMINATOR OFFSET
; DPW T1,RTERM ;ZERO TERMINATOR BYTE
; DPW T1,R.TRML ;ZERO TERMINATOR LENGTH
; DPW T1,R.RCNT ;ZERO BYTE COUNT
SETZM 3(M) ;DO THE ABOVE IN 2 INSTRUCTIONS (VS 20)
SETZM 4(M) ; ...
MOVEI Q4,^D20 ;GET PACKET SIZE
JRST NORD1 ;GO SEND PACKET
;HERE TO PREPARE FOR ABORTING THE READ
RDABT: CALL TTRSET ;RESET THE STATE OF OUR TTY
SOS READQ
JRST ABORT
PAGE
SUBTTL READ subroutines
;SUBROUTINE TO DO TTY IO USING TEXTI
;RETURNS BYTE COUNT IN T1
;TERMINATOR LENGTH IN T2, AND RETURN STATUS IN T3
RTTY1: TXNN F,F.TIMZ ;NON BLOCKING IO?
JRST DOTXTI ;NO
MOVEI T1,.PRIIN
SIBE% ;ANY TEXT YET?
JRST DOTXTI ;YES, ASSUME THERE IS ENOUGH
SETZB T1,T2
MOVEI T3,TIMEOUT
RET
DOTXTI: MOVEI T1,TEXTIB
TEXTI%
ERJMP [TMSG <?TEXTI failed
>
JRST ENDIT]
AFTTXT: TXO F,F.LF ;SET THE LF ECHOED FLAG
TXNE MD,NOECHO ;NOECHO SET?
CALL EK.ON ;YES, RESTORE ECHOING
TXNE F,F.CTCS+F.CTYS ;TIME TO ABORT?
JRST RDABT ;YES
;HERE TO DIG THROUGH THE TEXT THAT TEXTI% READ
MOVE T3,R.RDAT ;BUFFER POINTER
SETZ T1, ;BYTE COUNT
ANOTH: ILDB T2,T3 ;GET A BYTE
ADDI T1,1 ;INCREMENT COUNT
CAIN T2,33 ;AN ESCAPE?
TXO F,F.ESC ;YES
CAIN T2,"Z"-100 ;WAS IT CONTROL Z?
CALL OUTCRL ;YES, OUTPUT CRLF
CAIE T2,CR ;WAS IT CR?
JRST NTCR ;NO
TXNE MD,NOECHO ;YES, IT'S A CR - WAS ECHOING TURNED OFF?
CALL OUTCRL ;YES - OUTPUT CRLF
PUSH P,T1
CAMN T3,TEXTIB+.RDDBP
PBIN%
POP P,T1
MOVEM T3,TEXTIB+.RDDBP ;DISCARD LF (SAVE INCREMENTED BYTE POINTER)
JRST GOTBC
NTCR: CAME T3,TEXTIB+.RDDBP ;END OF BUFFER?
JRST ANOTH ;NO
GOTBC: LDB T3,TEXTIB+.RDDBP ;GET THE LAST CHARACTER
MOVEM T3,T2 ;SAVE IT
IDIVI T3,^D32 ;DETERMINE WHICH BREAK MASK WORD
ADD T3,TEXTIB+.RDBRK ;INDEX TO CORRECT SLOT
MOVE T3,(T3) ;GET BREAK MASK WORD
TDNN T3,BTAB(T4) ;IS THIS CHARACTER A TERMINATIOR?
JRST RETTY1 ;NO
MOVEM T2,SAVTRM ;SAVE IT
NOTCR1: MOVEI T2,1 ;FOR NOW, SET IT TO 1
SKIPA
RETTY1: SETZM T2 ;INDICATE ZERO TERMINATOR LENGTH
MOVEI T3,NORMAL ;NORMAL RETURN STATUS
RET
PAGE
;SUBROUTINE TO DO "MANUAL" TEXTI
;EDITING CHARS PERFORMED BY
;------------- ------------
;^R,^U,<DEL> VMS
;^V THIS PROGRAM (DISABLED)
;^W NOT IMPLEMENTED - BEEPS
; (DISABLED - ^W IS REFRESH FOR EDT)
;ARGUMENTS ARE FETCHED FROM TEXTI BLOCK
RTTY2: PUSH P,Q1 ;SAVE AC'S
PUSH P,Q2
PUSH P,Q3
MOVE Q1,TEXTIB+.RDDBC ;GET MAX BYTES TO READ
MOVE Q2,TEXTIB+.RDDBP ;GET BYTE POINTER TO BUFFER
SETZB Q3,SAVTRM ;ZERO THE TERMINATOR COUNT AND TERMINATOR BYTE
BLKTST: TXNE F,F.TIMZ ;NON-BLOCKING IO?
JRST TXRET0 ;YES
RDCHR: TXNE F,F.CTCS+F.CTYS ;TIME TO ABORT?
JRST RDABT ;YES
PBIN% ;GET THE CHARACTER
; TXZE F,F.LIT ;LITERAL READ?
; JRST WRTCHR ;YES
; CAIN T1,026 ;^V?
; JRST [TXO F,F.LIT ;YES
; JRST RDCHR] ;GO READ THE CHARACTER LITERALLY
; CAIN T1,027 ;^W?
; JRST [MOVE T1,TTYJFN ;GET BINARY JFN
; MOVEI T2,7 ;BEEP AT HIM
; BOUT%
; JRST GNXCHR]
TXNN MD,CVTLOW ;CONVERT LOWER TO UPPER?
JRST WRTCHR ;NO
CAIL T1,141 ;YES, IN RANGE?
CAIL T1,173 ; ...
JRST WRTCHR ;NO
SUBI T1,40 ;RAISE CASE
WRTCHR: IDPB T1,Q2 ;WRITE THE CHARACTER TO THE BUFFFER
SOS Q1 ;DECREMENT BYTE COUNT
CAIE T1,CR ;WAS IT CR?
JRST TRMCHK ;NO
PBIN% ;YES, - READ AND DISCARD THE LINEFEED
MOVEI T1,015 ;GET A CR BACK IN T1
TXNN MD,NOECHO ;WAS ECHOING TURNED OFF?
JRST EKON ;NO
CALL OUTCRL ;YES - OUTPUT CRLF
EKON: TXO F,F.LF ;SET THE LF ECHOED FLAG
TRMCHK: MOVE T3,CLENTH ;GET LENGTH OF CURRENT BREAK MASK
JUMPE T3,GNXCHR ;IT'S ZERO, FORGET IT
MOVE T3,T1 ;GET THE CHARACTER
IDIVI T3,^D32 ;DETERMINE WHICH BREAK MASK WORD
ADD T3,TEXTIB+.RDBRK ;INDEX TO CORRECT SLOT
MOVE T3,(T3) ;GET BREAK MASK WORD
TDNE T3,BTAB(T4) ;IS THIS CHARACTER A TERMINATIOR?
JRST REDTRM ;YES
GNXCHR: JUMPG Q1,RDCHR ;BACK FOR MORE
JRST TXRET
;HERE IF WE HAVE A TERMINATOR
REDTRM: MOVEM T1,SAVTRM ;SAVE THE TERMINATOR
TXNE MD,TNOEKO ;TERMINATOR NO-ECHO IN EFFECT?
CAIE T1,15 ; WAS THIS A CR?
SKIPA ; NO TO EITHER OR BOTH
TXZ F,F.LF ; YES, DON'T SUPPRESS LINEFEEDS
MOVEI Q3,1 ;FOR NOW, COUNT IS 1
JRST TXRET1 ;SKIP TIMZ LOGIC
TXRET: TXNN F,F.TIMZ ;ARE WE DOING NON-BLOCKING IO?
JRST TXRET1 ;NO
TXRET0: JUMPLE Q1,TXRET1 ;YES - CHAR COUNT EXHAUSTED?
MOVEI T1,.PRIIN ;NO, SEE IF ANY TYPE-AHEAD DATA IN BUFFER
SIBE%
JRST RDCHR ;YES, THERE ARE CHARS, GO READ THEM
;HERE WHEN READ CYCLE COMPLETE
TXRET1: MOVE T4,TEXTIB+.RDDBC ;GET MAX BYTE COUNT
SUB T4,Q1 ;DETERMINE HOW MANY WE READ
MOVE Q1,T4 ;Q1 NOW CONTAINS COUNT OF BYTES WE READ
TXNN F,F.TIMZ ;WERE WE DOING NON-BLOCKING IO?
JRST TXRET3 ;NO
SKIPE SAVTRM ;YES, WAS THERE A TERMINATOR?
JRST TXRET3 ;YES, RETURN NORMAL STATUS
MOVE T1,TEXTIB+.RDDBC ;NO TERMINATOR - GET REQUESTED BYTE COUNT
CAML Q1,T1 ;WAS ACTUAL COUNT LESS THAN REQUESTED COUNT?
JRST TXRET3 ;NO, RETURN NORMAL STATUS
MOVEI T3,TIMEOUT ;EITHER ACTUAL COUNT LESS THAN REQUESTED COUNT
SKIPA ; OR WE GOT NOT CHARS AT ALL
TXRET3: MOVEI T3,NORMAL ;GET NORMAL STATUS VALUE
MOVE T1,Q1 ;GET BYTE COUNT IN T1 FOR RETURN
ADJBP Q1,TEXTIB+.RDDBP ;INCREMENT THE BYTE POINTER IN TEXTI BLOCK
MOVEM Q1,TEXTIB+.RDDBP ; ...
MOVE T2,Q3 ;GET TERMINATOR LENGTH
TTRET: POP P,Q3 ;RESTORE AC'S
POP P,Q2
POP P,Q1
ABCHK: TXNE F,F.CTCS+F.CTYS ;TIME TO ABORT?
JRST RDABT ;YES
RET ;RETURN WITH BYTE COUNT IN T1 AND TERMINATOR
; LENGTH IN T2
PAGE
;SUBROUTINE TO PROCESS TERMINATOR MASK
; SETS UP POINTER IN TEXTI BLOCK
CHKTRM: MOVEI T1,DMASK ;ASSUME DEFAULT MASK IS OK
MOVEM T1,TEXTIB+.RDBRK ;SAVE IT IN TEXTI BLOCK
LDB T1,R.TRMS ;GET TERMINATOR MASK SIZE
MOVEM T1,CLENTH ;SAVE THE LENGTH
JUMPE T1,CHKRET ;NO MASK, RETURN AND LEAVE DEFAULT IN EFFECT
MOVNS T1 ;NEGATE
HRLZS T1 ;BUILD AOBJN POINTER
SETZM CMASK ;ZERO THE EXISTING MASK
MOVE T2,[CMASK,,CMASK+1] ; ...
BLT T2,CMASK+CMSKLN-1 ; ...
MOVE T2,R.TRM ;GET SOURCE BYTE POINTER
MOVE T3,[POINT 8,CMASK] ;GET DESTINATION BYTE POINTER
GTMSK: ILDB T4,T2 ;GET A BYTE OF THE MASK
MOVE T4,SWAPTB(T4) ;SWAP THE BITS
IDPB T4,T3 ;WRITE THE BYTE
AOBJN T1,GTMSK ;BACK FOR MORE
;CROCK - PREVIOUS TO V5, TOPS20 CAN'T BREAK ON CR ONLY
MOVE T1,CMASK ;GET FIRST WORD OF MASK
TLNE T1,20 ;IS CAR-RET A BREAK CHAR?
TLO T1,200 ;TURN ON LF ALSO (IT'S NOT ALWAYS ON!)
MOVEM T1,CMASK ;SAVE IT
MOVEI T1,CMASK ;SAVE BREAK MASK ADDRESS IN TEXTI BLOCK
MOVEM T1,TEXTIB+.RDBRK ; ...
CHKRET: RET
;SUBROUTINE TO SET CCOC WORDS PER BREAK MASK FROM VAX
;FOR IO$_READPROMPT WITH IO$M_TRMNOECHO
; GETS CURRENT BREAK MASK FROM CMASK
; SAVES CURRENT CCOC WORDS IN CCSAVE
SETCC: MOVEI T1,.PRIIN ;PRIMARY INPUT JFN
RFCOC ;GET CCOC WORDS
DMOVEM T2,CCSAVE ;SAVE THE CURRENT CCOC WORDS
MOVE T1,CMASK ;GET FIRST WORD OF BREAK MASK
; EG, THE BITS FOR ASCII 0-31
MOVE T3,CCSAVE ;GET FIRST CCOC WORD
MOVE T2,[-^D18,,0] ;AOBJN POINTER
CCLP: TDNE T1,BTAB(T2) ;IS THIS BREAK MASK BIT ON?
TDZ T3,CTAB(T2) ;YES, TURN OFF ECHOING FOR THAT CHARACTER
AOBJN T2,CCLP
PUSH P,T3 ;SAVE NEW CCOC WORD ON STACK
MOVE T3,CCSAVE+1 ;GET SECOND CCOC WORD
MOVE T2,[-^D14,,0] ;AOBJN POINTER
CCLP1: TDNE T1,BTAB+^D18(T2) ;IS THIS BREAK MASK BIT ON?
TDZ T3,CTAB+^D18(T2) ;YES, TURN OFF ECHOING FOR THAT CHARACTER
AOBJN T2,CCLP1 ;FALL OUT WITH 2'ND CCOC WORD IN T3
POP P,T2 ;FETCH 1'ST CCOC WORD FROM STACK
MOVEI T1,.PRIIN ;PRIMARY INPUT JFN
SFCOC% ;SET CCOC WORD
RET
PAGE
;SUBROUTINE TO OUTPUT CRLF
OUTCRL: PUSH P,T1 ;SAVE T1
MOVEI T1,CR ;OUTPUT CR
PBOUT% ; ...
MOVEI T1,LF ;OUTPUT LF
PBOUT% ; ...
POP P,T1 ;RESTORE T1
RET ;RETURN
;SUBROUTINE TO TURN ECHOING ON/OFF
;DESTROYS T1-T2
EK.OFF: MOVEI T1,.PRIIN
RFMOD%
TXZN T2,TT%ECO ;ALREADY OFF?
JRST EK.RET ;YES
JRST STMOD ;NO, GO TURN IT OFF
EK.ON: MOVEI T1,.PRIIN
RFMOD%
TXOE T2,TT%ECO ;ALREADY ON?
JRST EK.RET ;YES
STMOD: SFMOD%
EK.RET: RET
;SUBROUTINE TO RESET TTY ATTRIBUTES
;ONLY USED WHILE THE LINK IS ACTIVE
;DURING LINK TERMINATION, TTYRES IS USED
TTRSET: TXNN MD,TNOEKO ;TERMINATOR NOECHO IN EFFECT?
JRST NOCC ;NO
DMOVE T2,CCSAVE ;YES, GET OLD CCOC WORDS
MOVEI T1,.PRIOU
SFCOC% ;RESTORE THEM
NOCC: TXNN MD,NOECHO ;NO ECHO?
JRST MDCHK ;NOT IN EFFECT
CALL EK.ON ;YES, ENABLE IT AGAIN
MDCHK: MOVEI T1,.PRIIN ;GET THE CURRENT MODE WORD
RFMOD% ;...
TXO T2,TT%ECO ;TURN ON THE ECHO BIT
MOVE T3,MODSAV ;GET ORIGINAL MODE WORD
CAMN T2,T3 ;SAME AS ORIGINAL?
JRST TTYRET ;YES
MOVE T2,MODSAV ;GET ORIGINAL MODE WORD
SFMOD% ;RESTORE IT
TTYRET: RET
SUBTTL Main Program - Process write queue requests
PAGE
;
; Write - called only from interrupt level (full duplex TTY)
;
DOWRIT: TXZE F,F.ESC ;LAST THING TYPED AN ESCAPE?
CALL OUTCRL
MOVEI T1,RP.END ;RETURN OP CODE
DPW T1,R.OPC ;SAVE IT IN BUFFER
LDW MD,R.MOD ;GET MODIFIERS
TXNE MD,CANCTRLO
JRST [MOVEI T1,.PRIIN
RFMOD%
TXZE T2,TT%OSP
SFMOD%
JRST .+1]
TXNE F,F.CTCS+F.CTYS
JRST ABORT
TXNE MD,NFORMT ;NO FORMATTING?
JRST [MOVEI T1,.PRIIN
RFCOC%
TXZ T3,3B19
TXO T3,2B19
SFCOC%
MOVEI T2,.MORLW ;GET CURRENT WIDTH
MTOPR%
PUSH P,T3 ;SAVE IT
MOVEI T2,.MOSLW ;SET WIDTH
SETZ T3, ;TO ZERO
MTOPR%
JRST .+1]
;UNSUPPORTED ARE:
;ENABLMBX
LDW Q4,R.WCC ;FORTRAN PART OF CARRIAGE CONTROL
CALL PREFIX ;DO PREFIX PROCESSING
LDW T3,R.CNT ;BYTE COUNT
MOVE T2,R.WDAT
MOVN T3,T3 ;BUFFER LENGTH
TXZN F,F.LF ;SUPPRESS LF NOW?
JRST WRLF ;NO
ILDB T1,T2 ;GET A BYTE
CAIN T1,CR ;A CR?
JRST .-2 ;YES, GET ANOTHER
CAIE T1,LF ;A LF?
JRST WRLF ;NO
SETZ T1,
DPB T1,T2 ;DON'T OUTPUT IT
WRLF: MOVE T1,TTYJFN ;BINARY OUTPUT TO TTY
MOVE T2,R.WDAT ;POINT TO THE DATA
CAIE T3,0 ;NULL BYTE COUNT?
SOUT%
LDW T1,R.CNT ;BYTE COUNT
MOVE T2,R.WDAT ;BYTE POINTER TO DATA
SUBI T1,1
ADJBP T1,T2
ILDB T2,T1 ;GET LAST BYTE
CAIN T2,CR
TXO F,F.CR
CALL PSTFIX ;NO, DO POSTFIX PROCESSING
TXNE MD,NFORMT ;NO FORMATTING?
JRST [MOVEI T1,.PRIOU
RFCOC%
TXO T3,3B19
SFCOC%
MOVEI T2,.MOSLW
POP P,T3
MTOPR%
JRST .+1]
TXNE F,F.CTCS+F.CTYS ;^C OR ^Y?
JRST ABORT ;YES
LDW T1,R.CNT ;BYTE COUNT
DPW T1,R.STA1 ;RETURN IT
MOVEI T1,NORMAL ;OK STATUS
DPW T1,R.STA ;SAVE IT
SETZ T1, ;ZEROS
DPW T1,R.STA2
DPW T1,R.STA3
DPW T1,R.MOD
MOVE T1,NETJFN ;NETWORK JFN
MOVE T2,[POINT 8,0(M)] ;POINTER TO BUFFER
MOVNI T3,^D18 ;PACKET SIZE
SOUTR%
ERCAL NETERR
IFDEF VMSDBG,<
AOS PACKTS ;INCR THE PACKET COUNT
MOVE T1,LWSNT ;Get ring-buffer pointer
CAIL T1,LWSNTB+<SBSIZ*SRSIZ>-SRSIZ-1
MOVEI T1,LWSNTB ;RESET THE POINTER
HRRO T2,PACKTS ;GET -1,,PACKET COUNT
MOVEM T2,(T1) ;STORE COUNT AT HEAD OF SAVED PACKET
AOS T1 ;INCR POINTER
MOVE T2,T1 ;GET POINTER IN T2
HRL T1,M ;GET PACKET ADDR
BLT T1,SRSIZ-1(T2) ;MOVE THE DATA
MOVE T1,LWSNT ;GET THE POINTER
ADDI T1,SRSIZ ;INCREMENT IT
MOVEM T1,LWSNT ;REPLACE IT
>
TXNN DEBUG,D.OTYP
JRST NOUT.3
TMSG <
[Debug: reply packet sent for write]
>
NOUT.3: MOVE T1,M
CALL PUTPL
RET
PREFIX: CAIN Q4,0 ;FORTRAN CARRIAGE CONTROL?
JRST PRENF4 ;NO
CAIN Q4,"0" ;DOUBLE SPACE?
JRST [MOVEI T2,LF ;YES
MOVE T1,TTYJFN
TXZN F,F.LF
BOUT%
BOUT%
RET]
CAIN Q4,"1" ;TOP OF PAGE
JRST [MOVEI T2,FF ;YES
MOVE T1,TTYJFN
BOUT%
TXZ F,F.LF
RET]
CAIN Q4,"+" ;OVERPRINT
RET ;YES
MOVEI T2,LF ;SINGLE SPACE
MOVE T1,TTYJFN
TXZN F,F.LF
BOUT%
RET
PRENF4: LDB Q4,R.CPRE ;GET PREFIX BYTE
FIXCOM: CAIN Q4,0 ;NULL?
RET ;YES
TXNE Q4,1B28 ;LINE FEEDS?
JRST PRE1 ;NO
MOVEI T2,LF ;YES
MOVE T1,TTYJFN
TXZN F,F.LF
BOUT%
SOSLE Q4
JRST .-2
RET
PRE1: MOVE T2,Q4 ;GET THE CHARACTER
TXZE T2,1B30 ;SHIFT IT?
ADDI T2,^D128 ;YES
TRZ T2,777600 ;MAKE IT A 7-BIT CHAR
MOVE T1,TTYJFN
BOUT% ;OUTPUT IT
RET
PSTFIX: CAIN Q4,0 ;FORTRAN?
JRST PSTNF4 ;NO
CAIN Q4,"$" ;PROMPT MODE?
RET ;YES
MOVEI T2,CR
MOVE T1,TTYJFN
BOUT%
TXO F,F.CR
TXZ F,F.CR
RET
PSTNF4: LDB Q4,R.CPST ;GET POSTFIX BYTE
CAIN Q4,<1B28+CR>
TXO F,F.CR
JRST FIXCOM ;GO DO IT
SUBTTL Subroutine - Initialize PSI system
PAGE
;
; Initialize the priority interrupt system
;
PSIINI: MOVEI T1,.FHSLF ;FOR THIS PROCESS
MOVE T2,[LEVTAB,,CHNTAB] ;CHANNEL AND LEVEL TABLES
SIR% ;ESTABLISH THEM
EIR% ;ENABLE THE INTERRUPT SYSTEM
HRL T1,ESCCAR ;TERMINAL CODE FOR ESCAPE INTERRUPT
HRRI T1,1 ;CHANNEL FOR ESCAPE INTERRUPT
ATI% ;ASSIGN THE INTERRUPT
MOVEI T1,.FHSLF
MOVSI T2,200000
AIC%
MOVE T1,SYSTYP ;GET SYSTEM TYPE
CAIE T1,S.VMS ;IF VMS GO ON
RET
MOVEI T1,NETAST
HRRM T1,NETINT
MOVEI T1,CTCAST
HRRM T1,CTCINT
HRLI T1,"C"-100 ;FOR CONTROL C
HRRI T1,5 ;CHANNEL 5
ATI% ;ASSIGN THE INTERRUPT
HRLI T1,"Y"-100 ;CHANNEL FOR CONTROL Y
HRRI T1,2 ;CHANNEL 2
ATI% ;ASSIGN THE INTERRUPT
HRLI T1,.TICTI ;BUFFER BECOMES NON EMPTY
HRRI T1,3 ;CHANNEL 3
ATI% ;ASSIGN THE INTERRUPT
MOVEI T1,.FHSLF ;FOR THIS PROCESS
MOVSI T2,150000 ;TURN ON CHANNELS 2,3 AND 5
AIC%
MOVEI T1,.FHSLF
MOVX T2,1B4
AIC%
MOVE T1,NETJFN
MOVE T2,[POINT 8,CNFMSG]
MOVNI T3,CNFLEN
SOUTR%
ERCAL NETERR
TXNN DEBUG,D.OTYP
JRST NOUT.4
TMSG <
[Debug: Configuration message just sent]
>
NOUT.4: MOVE T1,NETJFN
MOVEI T2,.MOACN
MOVX T3,<FLD(.MONCI,MO%CDN)+FLD(4,MO%DAV)+FLD(.MONCI,MO%INA)>
MTOPR%
MOVE T1,NETJFN
MOVE T2,[POINT 8,INIMSG]
MOVNI T3,INILEN
SOUTR%
ERCAL NETERR
TXNN DEBUG,D.OTYP
JRST NOUT.5
TMSG <
[Debug: Initializaton message just sent]
>
NOUT.5: RET ;RETURN
SUBTTL Subroutine - Make initial network connection
PAGE
;
; Make the network connection
;
NETINI: TMSG <
[Attempting a connection, >
MOVE T1,[POINT 7,REMOTE] ;CHECK FOR POOR MANS ROUTING
LPMR: ILDB T2,T1 ;GET A BYTE
CAIN T2,0 ;END OF STRING?
JRST NOTPMR ;MUST BE AJACENT NODE
CAIE T2,":" ;A COLON?
JRST LPMR ;NO, KEEP LOOKING
MOVE Q1,T1 ;SAVE BYTE POINTER
ILDB T2,T1 ;GET THE SECOND COLON
ILDB T2,T1 ;GET THE NEXT CHAR
CAIE T2,0 ;END OF STRING?
JRST DOPMR ;NO, MUST BE ANOTHER NODE NAME
SETZ T1, ;END NODE NAME BEFORE COLON
DPB T1,Q1
NOTPMR: TXO F,F.ADJ
JRST DOPMR
TRYPMR: TXZ F,F.ADJ
MOVEI T1,CONBLK ;ADDRESS OF ARG BLOCK
CALL .DNINI## ;INITIALIZE THE PMR TABLES
JRST ENR
MOVEI T1,CONBLK
CALL .DNCON## ;MAKE THE CONNECTION
JRST ENR ;ERROR?
MOVEM T1,NETJFN ;SAVE THE JFN
GOTLNK: CALL GETPL ;GET A BUFFER
MOVE M,T1 ;ITS ADDRESS
MOVE T2,[POINT 8,0(M)] ;POINT TO IT
MOVE T1,NETJFN ;GET THE NETWORK JFN
MOVNI T3,MAXBUF*4 ;MESSAGE OF 40 BYTES
SINR% ;RECEIVE THE REPLY
ERCAL NETERR
TXNE DEBUG,D.ITYP
JRST [TMSG <
[Debug: Receiving configuration message]
>
JRST .+1]
LDB T1,[POINT 8,0(M),7] ;GET 1ST BYTE
CAIE T1,1 ;WAS IT A 1?
JRST [TMSG <]
[Remote host is a system of unknown type]
>
MOVE T1,[POINT 8,0(M)]
PSOUT%
MOVEI T1,0 ;
JRST .+2] ;TOPS-10 WILL DO THIS
LDB T1,[POINT 8,1(M),7] ;GET 5TH BYTE
CAIN T1,0 ;WAS IT 0?
JRST [LDB T1,[POINT 8,0(M),31]
CAIE T1,2 ;OLD RSTS FORMAT?
SETZ T1, ;NO
JRST .+1] ;YES
; CAIN T1,S.VMS
;PATCH: MOVEI T1,S.TOP2
MOVEM T1,SYSTYP ;SAVE THE SYSTEM TYPE
MOVE T1,M ;BUFFER POINTER
CALL PUTPL ;RETURN THE BUFFER
RET ;RETURN
PAGE
DOPMR: HRROI T1,SPEC ;POINT TO FILE SPEC BUFFER
HRROI T2,[ASCIZ/DCN:/]
SETZ T3,
SOUT%
HRROI T2,REMOTE ;POINT TO HOST STRING
MOVEI T3,^D10
MOVEI T4,":" ;STOP ON A COLON
TXNE F,F.ADJ
MOVEI T4,0
SOUT%
MOVEI T3,"-" ;ADD THE DASH
DPB T3,T1 ;THE DASH
HRROI T2,[ASCIZ/123./] ;AND THE OBJECT TYPE FOR PMR
TXNE F,F.ADJ ;ADJACENT NODE?
HRROI T2,[ASCIZ /23./]
SETZ T3,
SOUT%
IDPB T3,T1 ;ASCIZ STRING
CALL JFNOPN ;DO THE GTJFN AND OPENF
TXNE F,F.ADJ
JRST ADJNOD
CALL GETPL ;GET A BUFFER
MOVE M,T1 ;ITS ADDRESS
MOVE T1,[POINT 8,0(M)] ;BUFFER POINTER
MOVEI T2,1 ;
BOUT% ;
MOVE T2,[POINT 7,REMOTE]
ILDB T3,T2
CAIE T3,":"
JRST .-2
ILDB T3,T2
SETZ T3,
SOUT% ;THE PMR STRING
LDB T3,T1 ;GET THE LAST BYTE
CAIN T3,":" ;WAS IT A COLON?
JRST ENDOK ;YES
MOVEI T3,":"
IDPB T3,T1
IDPB T3,T1
ENDOK: MOVE T2,[POINT 7,[ASCIZ/"23="/]]
SETZ T3,
SOUT%
IDPB T3,T1 ;ASCIZ STRING
MOVE T1,NETJFN ;
MOVE T2,[POINT 8,0(M)]
SETZ T3,
SOUTR%
ERCAL NETERR
TXNN DEBUG,D.OTYP
JRST NOUT.6
TMSG <
[Debug: PMR message just sent]
>
NOUT.6: MOVE T1,NETJFN
MOVE T2,[POINT 8,0(M)]
MOVNI T3,MAXBUF*4
SINR% ;GET THE REPLY
ERCAL NETERR
TXNE DEBUG,D.ITYP
JRST [TMSG <
[Debug: Receiving reply to PMR message]
>
JRST .+1]
LDB T1,[POINT 8,0(M),7]
CAIE T1,1 ;OK?
JRST PMRBAD
MOVE T1,M
CALL PUTPL
ADJNOD: TMSG <connect OK>
JRST GOTLNK
PMRBAD: SETZ T1,
IDPB T1,T2 ;ASCIZ STRING
TMSG <
?Routing error
>
MOVE T1,[POINT 8,0(M),7]
PSOUT%
TMSG <
>
JRST ENDIT
PAGE
JFNOPN: MOVX T1,GJ%SHT ;SHORT GTJFN
HRROI T2,SPEC ;NETWORK FILE SPEC
GTJFN% ;GET A JFN
ERJMP [TXZE F,F.ADJ
JRST TRYP
TMSG <
?Cannot get network JFN
>
JRST ENDIT]
MOVEM T1,NETJFN ;SAVE THE JFN
MOVX T2,<FLD(^D8,OF%BSZ)+1B9+OF%WR+OF%RD>
OPENF% ;OPEN IT FOR READ AND WRITE
ERJMP [TXZE F,F.ADJ
JRST TRYP
TMSG <
?Failed to open network JFN
>
JRST ENDIT]
MOVE T4,[-^D30,,0] ;WAIT 30 SECONDS
WAITLK: MOVX T1,^D1000 ;WAIT BEFORE CHECKING STATUS
DISMS%
MOVE T1,NETJFN ;NETWORK JFN
MOVX T2,.MORLS ;GET LINK STATUS
MTOPR% ;
TXNE T3,MO%CON ;CONNECTED OK?
RET ;YES
TXNN T3,MO%ABT+MO%SYN ;LINK DEAD?
JRST NOTDED
TXZE F,F.ADJ
JRST TRYP
CALL NETERR
NOTDED: AOBJN T4,WAITLK
TXZE F,F.ADJ
JRST TRYP
TMSG <?Remote node not responding
>
JRST ENDIT
tryp: POP P,T1
JRST TRYPMR
SUBTTL Subroutine - Get remote node specification and escape character
PAGE
;
; Here initialize the variables which describe the remote
; node name, and the escape character.
;
COMAND: MOVEI T1,.RSINI ; Make rescan buffer available
RSCAN% ; as command line to process reading from TTY
ERJMP PRESC1
MOVX T1,.RSCNT ; Get count of characters
RSCAN% ; in rescan buffer
ERJMP PRESC1
JUMPE T1,GETCOM ; None there so we must prompt
MOVEI T1,.PRIIN ; Primary input
BIN% ; Read a character
CAIE T2,"R" ; RUN or R (program name can't start with "R")
CAIN T2,"r" ; Check lowercase also
JRST PRESC0 ; Yes, no prescanning, go eat rest of line
PRES1: CAIE T2," " ; Have we hit a space yet?
CAIN T2," " ; Also accept a tab
JRST PRES2 ; Yes, read the node name
CAIN T2,.CHLFD ; Have we hit EOL yet?
JRST GETCOM ; Yes, no node name, skip return to prompt
BIN% ; Read the next character
JRST PRES1 ; And loop to test
PRES2: MOVEI T1,"P"-100 ; Default to ^P for escape character
HRRM T1,ESCCAR ; Save excape character
CALL COMINI ;SET UP FOR COMMAND JSYS
HRROI T1,[ASCIZ /Host Name: /]
MOVEM T1,COMSTA+.CMRTY
MOVEI T1,RP2
HRRM T1,COMSTA+.CMFLG
JRST RP2 ; PARSE HOST NAME
FINCOM: MOVX T1,.NDGLN ; NODE function for local node name
MOVX T2,T3 ; Argument block is in T3
MOVE T3,[POINT 7,LOCAL] ; Save node name in local
NODE% ; And name of local node
JFCL
RET ; Done
;HERE TO FLUSH REST OF EXEC COMMAND LINE
PRESC0: BIN% ; Get next byte
CAIE T2,.CHLFD ; The end of line?
JRST PRESC0 ; No, Try again
JRST GETCOM ; GO ASK FOR INPUT
;Here if rescan attempt does not succeed
PRESC1: HRROI T1,[ASCIZ/?Unexpected error in scanning command line/] ; If error,
ESOUT% ; tell user
JRST ENDIT
GETCOM: CALL COMINI ; INITIALIZE COMMAND STATE BLOCK
GETESC: HRROI T1,[ASCIZ /Escape character(^P):/]
; Put out prompt to users terminal
MOVEM T1,COMSTA+.CMRTY ;SAVE THE PROMPT TEXT POINTER
PSOUT% ;TYPE IT
MOVEI T1,RP1 ;REPARSE ADDRESS
HRRM T1,COMSTA+.CMFLG
RP1: MOVEI T2,[FLDDB. (.CMTXT,CM%SDH,,<Character for interrupting connection>,<>)]
MOVEI T1,COMSTA ; Command state block
COMND% ;PARSE IT
TXNE T2,CM%NOP ;ERROR?
JRST [TMSG <%Bad escape character
>
JRST GETCOM]
LDB T1,[POINT 7,ATMBUF,6] ; Get character itself
CAILE T1,.TICCZ ; Is it a valid character? (^A to ^Z)
JRST [ HRROI T1,[ASCIZ /Invalid character
/] ; No, tell user
ESOUT%
JRST GETCOM] ; and try again
HRRM T1,ESCCAR ; SAVE IT
MOVEI T1,COMSTA
MOVEI T2,[FLDDB. (.CMCFM)]
COMND% ; PARSE END OF LINE
CALL COMINI
GETHST: HRROI T1,[ASCIZ /Host name: /]
; Put out prompt to users terminal
MOVEM T1,COMSTA+.CMRTY
PSOUT% ;TYPE IT
MOVEI T1,RP2 ;REPARSE ADDRESS
HRRM T1,COMSTA+.CMFLG
RP2: MOVEI T2,[FLDDB. (.CMTXT,CM%SDH,,<Name of system to connect to>)]
MOVEI T1,COMSTA ;ADDRESS OF COMMAND STATE BLOCK
COMND%
TXNE T2,CM%NOP ;ERROR?
JRST [TMSG <%Bad node name
>
JRST GETHST]
HRROI T1,REMOTE ; Pointer to destination buffer
HRROI T2,ATMBUF ; Pointer to source buffer
MOVEI T3,0 ; An ASCIZ string
SOUT% ; Copy the host name
MOVEI T1,COMSTA
MOVEI T2,[FLDDB. (.CMCFM)]
COMND% ;PARSE END OF LINE
JRST FINCOM
SUBTTL Subroutine - Initialize Comnd JSYS
PAGE
;
; Initialize command JSYS data
;
COMINI: HRROI T1,COMBUF
MOVEM T1,COMSTA+.CMRTY
MOVEM T1,COMSTA+.CMBFP
MOVEM T1,COMSTA+.CMPTR
MOVEI T1,^D240
MOVEM T1,COMSTA+.CMCNT
MOVEM T1,COMSTA+.CMABC
HRROI T1,ATMBUF
MOVEM T1,COMSTA+.CMABP
MOVEI T1,COMSTA ;COMMAND STATE BLOCK
MOVEI T2,[FLDDB. (.CMINI)]
COMND%
RET
SUBTTL Interrupt routine - Escape character is typed
PAGE
;
; Here when escape character is typed
;
ESCAST: PUSH P,Q1 ;SAVE ALL ACS
PUSH P,T1
PUSH P,T2
PUSH P,T3
PUSH P,T4
MOVEI Q1,TTYWOR ;ADDRESS OF WORKING CHAR BUFFER
CALL TTYSAV ;SAVE THE WORKING CHARACTERISTICS
MOVEI Q1,TTYORG ;ADDRESS OF ORIGINAL CHARACTERICTCS
CALL TTYRES ;RESTORE THE ORIGINAL TTY CHARACTERISTICS
MOVEI T1,.PRIIN
CFIBF% ;CLEAR TYPE AHEAD
TMSG <
[Connection broken, back at node >
HRROI T1,LOCAL
PSOUT%
MOVE T1,NETJFN ;GET NETWORK JFN
MOVEI T2,.MORLS ;GET LINK STATUS
MTOPR%
TXNN T3,MO%CON ;LINK STILL CONNECTED?
JRST [TMSG <]>
CALL NETERR] ;NO!
TMSG <,
Type CONTINUE to resume connection]
>
HALTF%
MOVEI Q1,TTYORG
CALL TTYSAV
MOVEI Q1,TTYWOR ;
CALL TTYRES ;RESTORE THE TTY CHARACTERISTICS NEEDED
HRRZ T1,PC1 ;GET THE INTERRUPT ADDRESS
MOVE T1,-1(T1) ;GET THE INTERRUPTED INSTRUCTION
CAME T1,[WAIT%]
JRST XXX ;IT WASN'T A WAIT
HRRZ T1,PC1
TXO T1,1B5 ;IF IT WAS A WAIT, MAKE IT FALL THROUGH
MOVEM T1,PC1
XXX: POP P,T4
POP P,T3
POP P,T2
POP P,T1
POP P,Q1
DEBRK%
SUBTTL Exit routine
PAGE
;
; HERE AFTER FATAL ERRORS
;
ENDIT: AOS RABORT ;SET THE ABORT FLAG
MOVEI Q1,TTYORG
TXNE F,F.TTY ;DO WE HAVE ANY CHARACTERISTICS TO RES?
CALL TTYRES ;RESTORE TTY CHARACTERISTICS
MOVEI T1,.FHSLF
GETER%
CAMN T2,[.FHSLF,,LSTRX1]
JRST ENR
TMSG <Last error in this process: >
MOVEI T1,.PRIOU
MOVE T2,[.FHSLF,,-1]
SETZ T3,
ERSTR%
JFCL
JFCL
ENR: MOVX T1,<CZ%ABT>
HRR T1,NETJFN
CLOSF%
JFCL
MOVEI T1,.PRIIN
CFIBF%
HALTF%
JRST .-1
SUBTTL Interrupt routine - ^Y
PAGE
;
; Here when ^Y is typed
;
CTYAST: SAVTQ ;SAVE THE ACS
MOVEI T1,.PRIOU
RFCOC%
DMOVE Q3,T2 ;save the current ccoc words
DMOVE T2,CCOC+TTYORG
SFCOC% ;ALLOW LFS TO BE TYPED
HRROI T1,[BYTE(7) 15,12,"^","Y",15,12,15,12,0]
PSOUT% ;ECHO IT
MOVEI T1,.PRIOU
DMOVE T2,Q3
SFCOC% ;RESTORE CURRENT CCOC WORDS
TXNN F,F.CTCS+F.CTYS ;LAST ONE NOT PROCESSED ET?
JRST GOON ;YES IT WAS
CALL CORY ;SEND INTERRUPT PACKET AFTER 2ND ^C OR Y
TXZ F,F.CTCS+F.CTYS
JRST RETCTY
GOON: TXZN F,F.CTY ;WAS IT ENABLED?
JRST RETCTY ;NO, IGNORE IT
TXO F,F.CTYS ;A CONTROL Y WAS JUST SENT!
CTRL: MOVE T1,PC2
TXO T1,1B5 ;WAKE UP THE MAIN FORK
MOVEM T1,PC2
RETCTY: MOVEI T1,.PRIIN ;THIS TERMINAL
CFIBF% ;FLUSH INPUT
RESTQ ;RESTORE ACS
DEBRK%
SUBTTL Interrupt Routine - ^C
PAGE
;
; Here when ^C is typed
;
CTCAST: TXZN F,F.CTC ;ENABLED?
JRST CTYAST ;NO, CONVERT TO ^Y
SAVTQ ;SAVE ACS
TXO F,F.CTCS ;A CONTROL C WAS JUST SENT!
MOVEI T1,.PRIOU
RFCOC%
DMOVE Q3,T2
DMOVE T2,CCOC+TTYORG
SFCOC% ;ALLOW LFS TO BE TYPED
HRROI T1,[BYTE(7) 15,12,"^","C",15,12,15,12,0]
PSOUT% ;ECHO IT
MOVEI T1,.PRIOU
DMOVE T2,Q3
SFCOC%
JRST CTRL ;COMMON CODE WITH ^Y
PAGE
;
; Here when a char is typed on the TTY and no read is in progress
;
UNSAST: SKIPE READQ
DEBRK% ;IF A READ IS IN PROGRESS DISMISS INT
SAVTQ
MOVE T1,NETJFN
MOVE T2,[POINT 8,INIMSG]
MOVNI T3,INILEN
SOUTR% ;SEND THE UNSOLICITED AST PACKET
ERCAL NETERR
TXNN DEBUG,D.OTYP
JRST NOUT.7
TMSG <
[Debug: Unsolicited input AST message just sent]
>
NOUT.7: RESTQ
DEBRK%
SUBTTL Interrupt routine - Network data or disconnect
PAGE
;
; Process data or disconnect from logical link
;
NETAST: SAVTQ ;SAVE THE ACS
MOVE T1,NETJFN
SIBE%
JRST NETAS1
JRST RETINT
NETAS1: CALL GETPL ;GET A BUFFER
MOVE M,T1 ;PUT ADDRESS IN M
MOVE T1,NETJFN ;NETWORK JFN
MOVE T2,[POINT 8,0(M)] ;BUFFER POINTER
MOVNI T3,MAXBUF*4 ;BUFFER SIZE
SINR% ;GET IT
ERCAL NETERR ;SHOULD ALWAYS WORK
LDW T1,R.OPC ;GET OP CODE
MOVE T2,[-OPCLEN,,0] ;POINT TO OP CODE TAB
CHKOP: HRRE T3,OPCTAB(T2) ;GET AN OP CODE
CAMN T1,T3 ;MATCH?
JRST DISPAT ;YES
AOBJN T2,CHKOP ;TRY AGAIN
TMSG <?Illegal protocol message op code from remote
>
JRST ENDIT
DISPAT: TXNN DEBUG,D.ITYP ;TRACE INCOMING MESSAGES?
JRST NOITYP ;NO
TMSG <
[Debug: >
CALL DIN ;IDENTIFY THE PACKET
XCT OTAB(T2) ;DESCRIBE PACKET ATTRIBUTES
NOITYP: HLRZ T1,OPCTAB(T2)
JRST 0(T1) ;DO IT
PAGE
NETERR: TMSG <
%Link broken at PC >
MOVEI T1,.PRIOU
POP P,T2 ;PC
HRRZ T2,T2
SUBI T2,1
MOVEI T3,^D8
NOUT%
JFCL
TMSG <. Error code >
MOVE T1,NETJFN
MOVEI T2,.MORLS
MTOPR% ;GET LINK STATUS
HRRZ T2,T3 ; Get DECnet error reason code
MOVEI T1,.PRIOU ; Output to users terminal
MOVEI T3,12 ; In decimal
NOUT% ; Type it
JFCL
CAIG T2,MAXMSG ; Know about this error?
SKIPN T1,MSGTBL(T2) ; Yes, have one to type?
SKIPA ; No
PSOUT% ; Yes, type it then
HRROI T1,[ASCIZ /
/]
PSOUT% ; Pretty it
JRST ENDIT ;EXIT
SUBTTL Interrupt routine - NETAST cont... process requests from remote
PAGE
;
; Here to process protocol packets from remote node
;
;
READ: AOS READQ
MOVEI T1,INTRD ;QUEUED FUNCTION CODE
DPW T1,R.OPC ;STORE IN BUFFER
IFDEF VMSDBG,<
AOS PACKTS ;INCR THE PACKET COUNT
MOVE T1,LRREC ;Get ring-buffer pointer
CAIL T1,LRRECB+<SBSIZ*SRSIZ>-SRSIZ-1
MOVEI T1,LRRECB ;RESET THE POINTER
HRRO T2,PACKTS ;GET -1,,PACKET COUNT
MOVEM T2,(T1) ;STORE COUNT AT HEAD OF SAVED PACKET
AOS T1 ;INCR POINTER
MOVE T2,T1 ;GET POINTER IN T2
HRL T1,M ;GET PACKET ADDR
BLT T1,SRSIZ-1(T2) ;MOVE THE DATA
MOVE T1,LRREC ;GET THE POINTER
ADDI T1,SRSIZ ;INCREMENT IT
MOVEM T1,LRREC ;REPLACE IT
>
JRST QUEIT ;QUEUE IT
READP: AOS READQ
MOVEI T1,INTRDP ;QUEUED FUNCTION CODE
DPW T1,R.OPC ;STORE IN BUFFER
IFDEF VMSDBG,<
AOS PACKTS ;INCR THE PACKET COUNT
MOVE T1,LRREC ;Get ring-buffer pointer
CAIL T1,LRRECB+<SBSIZ*SRSIZ>-SRSIZ-1
MOVEI T1,LRRECB ;RESET THE POINTER
HRRO T2,PACKTS ;GET -1,,PACKET COUNT
MOVEM T2,(T1) ;STORE COUNT AT HEAD OF SAVED PACKET
AOS T1 ;INCR POINTER
MOVE T2,T1 ;GET POINTER IN T2
HRL T1,M ;GET PACKET ADDR
BLT T1,SRSIZ-1(T2) ;MOVE THE DATA
MOVE T1,LRREC ;GET THE POINTER
ADDI T1,SRSIZ ;INCREMENT IT
MOVEM T1,LRREC ;REPLACE IT
>
JRST QUEIT
WRITE: TXO F,F.WRIT
MOVEI T1,INTWRT ;QUEUED FUNCTION CODE
DPW T1,R.OPC ;STORE IT
IFDEF VMSDBG,<
AOS PACKTS ;INCR THE PACKET COUNT
MOVE T1,LWREC ;Get ring-buffer pointer
CAIL T1,LWRECB+<SBSIZ*SRSIZ>-SRSIZ-1
MOVEI T1,LWRECB ;RESET THE POINTER
HRRO T2,PACKTS ;GET -1,,PACKET COUNT
MOVEM T2,(T1) ;STORE COUNT AT HEAD OF SAVED PACKET
AOS T1 ;INCR POINTER
MOVE T2,T1 ;GET POINTER IN T2
HRL T1,M ;GET PACKET ADDR
BLT T1,SRSIZ-1(T2) ;MOVE THE DATA
MOVE T1,LWREC ;GET THE POINTER
ADDI T1,SRSIZ ;INCREMENT IT
MOVEM T1,LWREC ;REPLACE IT
>
PUSH P,MD
CALL DOWRIT
POP P,MD
TXZ F,F.WRIT
JRST RETINT
QUEIT: MOVE T1,M ;BUFFER ADDRESS
CALL PUTQ ;QUEUE IT
RETQUE: HRRZ T1,PC2 ;INTERRUPT PC ADDRESS
CAIE T1,WAITH ;WAS IT IN THE DISMS%?
JRST RETINT
TXO T1,1B5 ;PUT IN USER MODE
MOVEM T1,PC2 ;RESTART MAIN FORK
JRST RETINT
PAGE
CANCL:; ;DONT RESPOND TO CANCEL. IF YOU
; ;RESPOND TO CANCEL AFTER A COUPLE
; ;OF SET HOSTS, THE LINK ABORTS????
TXNN DEBUG,D.UNPR
JRST NOUN.5
LDW MD,R.MOD
JUMPE MD,NOUN.5
MOVE T2,MD
TMSG <
[Debug: Unsupported op code modifiers in CANCEL: >
MOVEI T1,.PRIOU
MOVEI T3,^D8
NOUT%
JFCL
TMSG <]
>
NOUN.5:
; CALL NULMES ;RETURN CANCEL OK
CALL QUEINI ;INITIALIZE THE QUEUES
MOVEI T1,DOVMS ;WHERE TO START MAIN FORK
TXO T1,1B5 ;USER MODE
MOVEM T1,PC2 ;RESTART MAIN FORK
JRST RETINT
PAGE
BCST: TXNN DEBUG,D.UNPR ;TRACE UN SUPPORTED OPTIONS?
JRST NOUN.4 ;NO
LDW MD,R.MOD ;GET MODIFIERS
JUMPE MD,NOUN41
TMSG <
[Debug: Unprocessed op code modifiers in broadcast: >
MOVE T2,MD
MOVEI T1,.PRIOU
MOVEI T3,^D8
NOUT%
JFCL
TMSG <]
>
NOUN41: LDW T2,R.CPRE
JUMPE T2,NOUN42
TMSG <
[Debug: Unused prefix carriage control in broadcast: >
MOVEI T1,.PRIOU
MOVEI T3,^D8
NOUT%
JFCL
TMSG <]
>
NOUN42: LDW T2,R.CPST
JUMPE T2,NOUN.4
TMSG <
[Debug: Unused postfix carriage control in broadcast: >
MOVEI T1,.PRIOU
MOVEI T3,^D8
NOUT%
JFCL
TMSG <]
>
NOUN.4: MOVEI T1,RP.END ;OP CODE
DPW T1,R.OPC ;SAVE IN BUFFER
SETZ T1,
DPW T1,R.MOD ;ZERO MODIFIERS
LDW T3,R.CNT ;GET BYTE COUNT
MOVN T3,T3 ;SETUP FOR SOUT
MOVEI T1,.PRIOU ;TO THIS TTY
MOVE T2,R.WDAT ;THE BYTE POINTER
SOUT% ;DISPLAY THE MESSAGE
LDW T1,R.CNT ;BYTE COUNT AGAIN
DPW T1,R.STA1 ;SAVE IN BUFFER
MOVEI T1,NORMAL ;IO STATUS
DPW T1,R.STA ;SAVE IN BUFFER
SETZ T1,
DPW T1,R.STA2 ;
DPW T1,R.STA3 ;
MOVE T1,NETJFN ;NETWORK JFN
MOVE T2,[POINT 8,0(M)] ;BUFFER POINTER
MOVNI T3,^D18 ;BUFFER SIZE
SOUTR%
ERCAL NETERR
TXNN DEBUG,D.OTYP
JRST NOUT.8
TMSG <
[Debug: reply to boadcast just sent]
>
NOUT.8: MOVE T1,M ;BUFFER ADDRESS
CALL PUTPL ;RETURN TO BUFFER POOL
JRST RETINT
PAGE
SETMD: LDW MD,R.MOD ;GET MODIFIERS
TXNN DEBUG,D.UNPR
JRST NOUN.7
TMSG <
[Debug: SET MODE never sets speed, fill, parity, flags, or characteristics]
>
MOVE T2,MD
ANDCM T2,[HANGUP+CC+CY]
JUMPE T2,NOUN.7
TMSG <
[Debug: Unsupported op code modifiers with SET MODE: >
MOVEI T1,.PRIOU
MOVEI T3,^D8
NOUT%
JFCL
TMSG <]
>
NOUN.7: TXNE MD,HANGUP ;HANGUP MEANS..
JRST ENDIT ;ABORT THE LINK
TXNN MD,CC+CY ;CONTROL C OR Y TO BE ENABLED?
JRST NOTCY ;NO
LDW T2,R.ASTP ;GET AST PARAMETER WORD
TXNN MD,CC ;^C ENABLE REQUEST?
JRST NOTC ;NO
TXZ F,F.CTC ;YES, ASSUME DISABLE
SKIPE T2 ;ENABLE?
TXO F,F.CTC ;YES
JRST FINSET
NOTC: TXZ F,F.CTY ;ASSUME DISABLE
SKIPE T2 ;ENABLE?
TXO F,F.CTY ;YES
JRST FINSET
NOTCY: TXNE MD,OBAND
JRST FINSET
LDB T1,R.TYPE ;GET THE VMS TERMINAL TYPE
MOVE T2,[-TTLEN,,0] ;LENGTH OF TERMINAL TYPE TABLE
VTL: HLRZ T3,TYPTAB(T2) ;GET A TYPE
CAMN T1,T3 ;A MATCH?
JRST TYMAT ;YES
AOBJN T2,VTL ;NO, TRY AGAIN
MOVEI T2,.TTDEF ;ALL OUT OF TRS, USE DEFAULT
JRST TYMAT1
TYMAT: HRRZ T2,TYPTAB(T2) ;GET TOPS20 TYPE
TYMAT1: MOVEI T1,.PRIIN
STTYP% ;SET THE TERMINAL TYPE
MOVEI T1,.PRIIN ;FOR THIS TTY
MOVEI T2,.MOSLW ;SET THE WIDTH
LDW T3,R.WID ;GET THE WIDTH
CAIGE T3,0 ;WIDTH OK?
JRST BADWID
CAILE T3,0
CAIL T3,10
JRST OKWID1
JRST BADWID
OKWID1: CAILE T3,^D255
JRST BADWID
MTOPR%
BADWID: MOVEI T2,.MOSLL ;SET THE LENGTH
LDB T3,R.LEN ;GET THE LENGTH
CAIGE T3,0
JRST BADLEN
CAIN T3,1
JRST BADLEN
CAILE T3,^D255
JRST BADLEN
MTOPR% ;SET IT
BADLEN: MOVEI T2,.MOXOF
MOVE T3,PAUSE+TTYORG
MTOPR%
LDB T1,R.CHAW ;GET 1ST 2 BYTES OF CHAR
LDB T2,R.CHAB ;GET THE 3RD BYTE
LSH T2,^D16 ;SHIFT LEFT
ADD T1,T2 ;MAKE IT ONE WORD
MOVEM T1,VMCHAR
LDB T1,R.CHA2 ;GET NEW WORD OF CHARS
MOVEM T1,VMCHAR+1
;HERE PROCESS CHARACTERISTICS
;ASSUME ANY NECESSARY CHARACTERISTICS
;ARE SET ALONG WITH THE TERMINAL TYPE
FINSET: CALL NULMES
MOVE T1,M
CALL PUTPL
JRST RETINT
PAGE
SENMD: MOVEI T1,RP.END ;OP CODE
DPW T1,R.OPC
TXNN DEBUG,D.UNPR
JRST NOUN.6
TMSG <
[Debug: SENSE MODE never returns speed, fill, parity, flags, or characteristics]
>
LDW MD,R.MOD
JUMPE MD,NOUN.6
TMSG <
[Debug: Unsupported op code modifier with SENSE MODE: >
MOVE T2,MD
MOVEI T1,.PRIOU
MOVEI T3,^D8
NOUT%
JFCL
TMSG <]
>
NOUN.6: LDW T1,R.MOD ;GET THE MODIFIERS
CAIN T1,100 ;IS IT TYPAHEAD?
JRST TYPEA ;YES
SETZ T1, ;
DPW T1,R.MOD ;ZERO THE MODIFIERS
MOVEI T1,NORMAL ;IO STATUS
DPW T1,R.STA ;SET IT
SETZ T1,
DPW T1,R.STA1
DPW T1,R.STA2
DPW T1,R.STA3
MOVEI T1,DC$TERM ;DEVICE TYPE
DPB T1,R.DTYP ;SAVE IT
MOVEI T1,.PRIIN
GTTYP%
MOVE T1,T2
MOVE T2,[-TTLEN,,0]
SNMT: HRRZ T3,TYPTAB(T2) ;GET A TYPE
CAMN T3,T1 ;A MATCH?
JRST SNTM ;YES
AOBJN T2,SNMT ;NO KEEP TRYING
MOVEI T2,DEFOFS
SNTM: HLRZ T1,TYPTAB(T2)
DPB T1,R.STYP ;SAVE IT
MOVE T1,VMCHAR ;CHARACTERISTICS
LSHC T1,-^D16
DPB T1,R.SCHB
SETZ T1,
LSHC T1,^D16
DPB T1,R.SCHW
MOVE T1,VMCHAR+1
DPB T1,R.SCH2
MOVEI T1,.PRIIN
MOVEI T2,.MORLW
MTOPR%
DPW T3,R.SWID ;SAVE IT
MOVEI T2,.MORLL
MTOPR%
DPB T3,R.SLEN ;SAVE IT
MOVE T1,NETJFN
MOVE T2,[POINT 8,0(M)]
MOVNI T3,^D30
SENDSN: SOUTR%
TXNN DEBUG,D.OTYP
JRST NOUT.9
TMSG <
[Debug: Reply to sense mode just sent]
>
NOUT.9: MOVE T1,M
CALL PUTPL
JRST RETINT
TYPEA:
SETZ T1, ;
DPW T1,R.MOD ;ZERO THE MODIFIERS
MOVEI T1,NORMAL ;IO STATUS
DPW T1,R.STA ;SET IT
SETZ T1,
DPW T1,R.STA1
DPW T1,R.STA2
DPW T1,R.STA3
MOVE T1,TTYJFN
SIBE
JFCL
DPW T2,[POINT 8,4(M),23]
CAIE T2,0
JRST [MOVE T1,TTYJFN
BIN
BKJFN
JFCL
JRST .+1]
DPB T2,[POINT 8,5(M),7]
MOVE T1,NETJFN
MOVE T2,[POINT 8,0(M)]
MOVNI T3,^D26
JRST SENDSN
RETINT: MOVEI T1,NETJFN
SIBE%
JRST NETAS1 ;DO SOME MORE
RESTQ
TXZE F,F.LOST
RET
DEBRK%
PAGE
;
; Send OK reply with no additional data
;
NULMES: LDW T1,R.RID0
LDW T2,R.RID0
CAIN T1,0
CAIE T1,0
JRST NULME0
RET
NULME0: MOVEI T1,RP.END ;OP CODE
DPW T1,R.OPC ;SET IT
SETZ T1, ;A ZERO
DPW T1,R.MOD ;ZERO THE MODIFIER
MOVEI T1,NORMAL ;STATUS
DPW T1,R.STA ;SET IT
SETZ T1, ;A ZERO
DPW T1,R.STA1
DPW T1,R.STA2
DPW T1,R.STA3
MOVE T1,NETJFN ;NETWORK JFN
MOVE T2,[POINT 8,0(M)] ;BUFFER POINTER
MOVNI T3,^D18 ;BUFFER SIZE
SOUTR% ;SEND THE REPLY
ERCAL NETERR
TXNN DEBUG,D.OTYP
JRST NOUT.A
TMSG <
[Debug: generalized reply message just sent]
>
NOUT.A: RET
SUBTTL Subroutine - Buffer Manipulation
PAGE
;
; BUFFER MANIPULATION SUBROUTINES
;
;Get buffer from pool
GETPL: HRRZ T1,POOLHD ;GET ADDR OF 1'ST NODE IN POOL
CAIN T1,POOLHD ;EMPTY?
JRST [TMSG <
?POOL SPACE EXHAUSTED>
JRST ENDIT]
HRRZ Q2,0(T1) ;GET ADDRESS OF 2ND NODE
HRRM Q2,POOLHD ;MAKE IT THE NEW FIRST
MOVEI Q1,POOLHD ;GET ADDR OF POOL HEADER
HRLM Q1,0(Q2) ;MAKE NEW FIRST NODE POINT BACK TO IT
AOS T1 ;RETURN WITH ADDR OF POOL BUFFER IN T1
RET
;Get buffer from queue
GETQ: HRRZ T1,QUEHD ;GET ADDR OF FIRST NODE IN QUEUE
CAIN T1,QUEHD ;EMPTY?
JRST [SETZ T1, ;YES
RET]
HRRZ Q2,0(T1) ;PATCH FORWARD POINTER
HRRM Q2,QUEHD
MOVEI Q1,QUEHD ;PATCH REVERSE POINTER
HRLM Q1,0(Q2)
AOS T1 ;RETURN WITH ADDR OF BUFFER IN T1
RET
;Return buffer to pool
;call with buffer addr in T1
PUTPL: SOS T1 ;GET ADDR OF POINTER WORD
HLRZ Q1,POOLHD ;GET ADDR OF FIRST NODE IN POOL
HRRM T1,0(Q1) ;PATCH FORWARD POINTER
HRLM T1,POOLHD
MOVEI Q2,POOLHD ;PATCH REVERSE POINTER
HRRM Q2,0(T1)
HRLM Q1,0(T1)
RET
;Enqueue buffer
;Call with buffer addr in T1
PUTQ: SOS T1 ;GET ADDR OF POINTER WORD
HLRZ Q1,QUEHD ;GET FIRST NODE IN QUEUE
HRRM T1,0(Q1)
HRLM T1,QUEHD ;PATCH FORWARD POINTER
MOVEI Q2,QUEHD ;PATCH REVERSE POINTER
HRRM Q2,0(T1)
HRLM Q1,0(T1)
RET
SUBTTL Subroutine - Variable initialization
PAGE
;
; VARIABLE INITIALIZATION
;
QUEINI: SETZM RABORT
SETZM READQ
MOVE T1,[QUEHD,,QUEHD]
MOVEM T1,QUEHD ;NOTHING IN QUEUE AT FIRST
MOVE T1,[POOL+MAXBUF*<NUMBUF-1>,,POOL] ;LAST,FIRST ENTRIES
MOVEM T1,POOLHD ;SAVE IT
MOVE T1,[POOLHD,,POOL+MAXBUF]
MOVEM T1,POOL ;FIRST BUFFER
MOVE T1,[POOL,,POOL+<2*MAXBUF>]
MOVEM T1,POOL+MAXBUF ;SECOND BUFFER
MOVE T2,[-<NUMBUF-2>,,0]
MOVEI T3,POOL+MAXBUF
QLOOP: ADD T1,[MAXBUF,,MAXBUF]
ADDI T3,MAXBUF
MOVEM T1,0(T3)
AOBJN T2,QLOOP
RET
SUBTTL Subroutine - TTY initilization
PAGE
;
; Remember TTY characteristics and set up initial conf message
;
TTYINI: HRREI T1,-1 ;THIS JOB
HRROI T2,T4 ;GET DATA IN T4
MOVEI T3,.JITNO ;TTY NUMBER
GETJI%
MOVEI T4,1 ;ON ERROR USE TTY1
DPW T4,[POINT 8,TTYNUM,7] ;SAVE IT IN CONF MESSAGE
MOVEI Q1,TTYORG
CALL TTYSAV
MOVX T1,GJ%SHT
HRROI T2,[ASCIZ /TTY:/] ;GET LITERAL CHANNEL FOR TERMINAL OUTPUT
GTJFN%
ERJMP ENDIT
MOVEM T1,TTYJFN ;REMEMBER HANDLE ON TERMINAL
MOVX T2,FLD(8,OF%BSZ)!FLD(.GSNRM,OF%MOD)!OF%WR!OF%RD
OPENF% ;OPEN TERMINAL FOR WRITING
ERJMP ENDIT
TXO F,F.TTY ;WE NOW HAVE TTY CHARACTERISTICS
MOVE T1,SYSTYP
CAIE T1,S.VMS ;VMS?
RET ;NO
MOVE T1,TYPE(Q1) ;GET THE TYPE
SETZ T2,
CAIN T1,.TT100 ;IS IT A VT100
MOVEI T2,41
CAIN T1,.TT125
MOVEI T2,53
DPB T2,[POINT 8,CNFMSG+4,31] ;YES, MAKE IT DEC_CRT AND ANSI_CRT
MOVEM T2,VMCHAR+1
MOVE T2,[-TTLEN,,0] ;LOOP COUNTER
LTYPE: HRRZ T3,TYPTAB(T2) ;FOUND TOPS-20 TYPE YET?
CAMN T3,T1 ;..
JRST TMATCH ;YES
AOBJN T2,LTYPE ;KEEP LOOKING
MOVEI T2,DEFOFS ;USE DEFAULT
TMATCH: HLRZ T1,TYPTAB(T2) ;VMS TYPE
DPB T1,[POINT 8,CNFMSG+2,15] ;SAVE IT
MOVE T1,CHRTAB(T2) ;GET CHARACTERISTICS
MOVEM T1,VMCHAR
LSHC T1,-^D16 ;ISOLATE 3RD BYTE
DPB T1,[POINT 8,CNFMSG+3,23] ;SAVE IT
SETZ T1,
LSHC T1,^D16 ;GET 1ST AND 2ND BYTES BACK
DPW T1,[POINT 8,CNFMSG+3,7]
MOVEI Q1,TTYORG
MOVE T1,WIDTH(Q1) ;TERMINAL WIDTH
DPW T1,[POINT 8,CNFMSG+2,23]
MOVEI Q1,TTYORG
MOVE T1,LENGTH(Q1) ;PAGE LENGTH
DPB T1,[POINT 8,CNFMSG+3,31]
RET
SUBTTL Subroutine - Save TTY characteristics
PAGE
;
;
;
TTYSAV: MOVEI T1,.FHSLF
RPCAP% ;GET CAPABILITIES
MOVEM T3,CAP(Q1) ;SAVE THEM
TXO T3,SC%CTC ;ALLOW ^C
EPCAP% ;DO IT
MOVEI T1,.PRIIN ;FOR THIS TTY
RFCOC% ;GET THE CCOC WORDS
DMOVEM T2,CCOC(Q1) ;SAVE THEM
RFMOD%
MOVEM T2,JFNMOD(Q1)
GTTYP%
MOVEM T2,TYPE(Q1)
MOVEI T2,.MORLW
MTOPR%
MOVEM T3,WIDTH(Q1)
MOVEI T2,.MORLL
MTOPR%
MOVEM T3,LENGTH(Q1)
MOVEI T2,.MORXO ;STOP ON END OF PAGE?
MTOPR%
MOVEM T3,PAUSE(Q1) ;SAVE IT
RET
SUBTTL Subroutine - Reset TTY chracteristics
PAGE
;
; Reset TTY characteristics before exit
;
TTYRES: MOVEI T1,.FHSLF
MOVE T3,CAP(Q1)
EPCAP%
MOVEI T1,.PRIIN
DMOVE T2,CCOC(Q1)
SFCOC%
MOVE T2,TYPE(Q1)
STTYP%
MOVE T2,JFNMOD(Q1)
SFMOD%
STPAR%
MOVEI T2,.MOSLW
MOVE T3,WIDTH(Q1)
MTOPR%
MOVEI T2,.MOSLL
MOVE T3,LENGTH(Q1)
MTOPR%
MOVEI T2,.MOXOF
MOVE T3,PAUSE(Q1)
MTOPR%
RET
SUBTTL Subroutine - Send attention packet for ^C or ^Y
PAGE
;
; Send attention packet after ^C or ^Y
;
CORY: CALL GETPL
MOVE M,T1
MOVEI T1,RP.ATN ;ATTENTION
DPW T1,R.OPC
MOVEI T1,RA.CTY ;CONTROL Y
TXNE F,F.CTCS
MOVEI T1,RA.CTC
DPW T1,R.MOD
SETZM 1(M) ;REFERENCE ID
LDW T1,[POINT 8,TTYNUM,7]
DPW T1,R.UNIT
MOVE T1,NETJFN
MOVE T2,[POINT 8,0(M)]
MOVNI T3,^D10
SOUTR%
ERCAL NETERR
TXNN DEBUG,D.OTYP
JRST NOUT.B
TMSG <
[Debug: ^C or ^Y attention packet just sent]
>
NOUT.B: MOVE T1,M
CALL PUTPL
RET
SUBTTL Connection has been made message
page
;
; Type the connection has been made message
;
CONMES: TMSG <[TYPE ^>
HRR T1,ESCCAR
ADDI T1,100
PBOUT%
TMSG < to return to node >
HRROI T1,LOCAL
PSOUT%
TMSG <]
>
RET
SUBTTL Support for non VMS systems
page
;
; Here to support non vms systems
;
DOUNIX: TMSG <]
[Remote host is an ULTRIX system]
>
JRST DO1020
DO10: TMSG <]
[Remote host is a TOPS-10 system]
>
DO10A: JRST DO1020 ;CHANGE THIS WHEN TOPS-10 USES CONFIG MESS
DO20: TMSG <]
[Remote host is a TOPS-20 system]
>
DO1020: CALL CONMES
; MOVE T1,NETJFN
; MOVE T2,[POINT 8,C20MSG]
; MOVNI T3,C20LEN
; SOUTR%
; ERCAL NETERR
CALL GETPL
MOVE M,T1
EMPTY: MOVE T1,NETJFN
SIBE%
SKIPA
JRST NOMORE
MOVE T4,T2
MOVE T1,NETJFN
MOVE T2,[POINT 8,0(M)]
MOVNI T3,MAXBUF*4
SINR%
ERCAL NETERR
TXNE DEBUG,D.ITYP
JRST [TMSG <
[Debug: Receiving user data]
>
JRST .+1]
MOVEI T1,.PRIOU
MOVE T2,[POINT 8,0(M)]
MOVN T3,T4
SOUT%
JRST EMPTY
NOMORE: MOVE T1,M
CALL PUTPL
CON20: MOVEI T1,.PRIIN
RFMOD%
TXO T2,TT%WAK
TXZ T2,TT%ECO!TT%DAM
SFMOD%
MOVE T1,NETJFN
MOVEI T2,.MOSNH
MOVEI T3,SETARG
MTOPR%
ERJMP V4
WT20: WAIT%
JRST CON20
COMMENT #
This section handles connections from a version 3A or4 tops-20 system.
Several coding problems:
1) For ease in coding, a second process is started to
handle terminal input. On an exit condition, whether
error of exit, the inferior process is not terminated.
#
V4: MOVN T2,ESCCAR ;Escape character
MOVX T1,1B0 ;Build interrupt mask
LSH T1,(T2)
TXO T1,1B<.TICTI> ;Allow typein
MOVX T2,.FHJOB ;Set entire job's interrupts
EXCH T1,T2
STIW%
MOVX T1,CR%MAP ;Create fork with same
CFORK% ; address space
ERJMP ENDIT ;If failure, die
MOVEI T2,V4IN ;Start input process
SFORK%
ERJMP ENDIT ;Error, die
V4OUT: MOVE T1,NETJFN ;Network JFN
MOVE T2,[POINT 8,V4BUFI] ;Buffer byte pointer
MOVNI T3,1 ;One byte only
SIN% ;Read from logical link
ERCAL NETERR
MOVE T3,T2 ;Save byte pointer
SIBE% ;Any more data to read?
SKIPA ;Yes, read the rest
JRST [SETZM T4 ;No, type what we got
JRST V4O1]
EXCH T2,T3 ;Restore byte pointer
MOVE T4,T3 ;Save count
MOVNS T3 ;Read exact number available
SIN%
ERCAL NETERR
V4O1: MOVEI T1,.PRIOU ;Primary output
MOVE T2,[POINT 8,V4BUFI] ;Pointer to data
MOVNI T3,1(T4) ;Output count
SOUT% ;Print it!
JRST V4OUT ;Continue
V4IN: MOVE T3,[POINT 7,V4BUF] ;Input byte pointer
MOVEI T4,V4BSZ*5 ;Maximum count
MOVEI T1,.PRIIN ;Primary input
BIN% ;Wait for a byte
JRST V4I2 ;Got one, handle it!
V4I1: SIBE% ;Fast typist?
SKIPA ;Yes, handle backup
JRST V4I3 ;No, dump buffer
BIN% ;Get another byte
V4I2: IDPB T2,T3 ;Stash it in buffer
SOJG T4,V4I1 ;Fill the buffer
V4I3: MOVNI T3,V4BSZ*5 ;Maximum count
ADD T3,T4 ;Compute send count
JUMPE T3,V4IN ;If none, go wait
MOVE T1,NETJFN ;Network JFN
HRROI T2,V4BUF ;Buffer byte pointer
SOUTR% ;Send to remote node
ERCAL NETERR
JRST V4IN ;Continue
DO11M: TMSG <]
[Remote host is an RSX11 system]
>
CALL CONMES ;
MOVEI T1,AST11M ;DATA INTERRUPT ROUTINE
HRRM T1,NETINT ;SAVE IT
MOVEI T1,RSXCTC
HRRM T1,CTCINT
HRLI T1,"C"-100
HRRI T1,5
ATI%
MOVEI T1,.FHSLF ;FOR THIS PROCESS
MOVX T2,3B5 ;CHANNEL 4 & 5
AIC% ;ACTIVATE THE CHANNEL
MOVE T1,NETJFN ;NETWORK JFN
MOVEI T2,.MOACN ;ASSIGN AN INTERRUPT CHANNEL
MOVX T3,<FLD(.MONCI,MO%CDN)+FLD(4,MO%DAV)+FLD(.MONCI,MO%INA)>
MTOPR% ;
MOVE T1,NETJFN
MOVE T2,[POINT 8,SCF11M]
MOVNI T3,CFL11M
SOUTR%
ERCAL NETERR
TXNE DEBUG,D.OTYP
JRST [TMSG <
[Debug: Configuration message just sent]
>
JRST .+1]
WAITM: MOVEI T1,^D5000
DISMS%
TRYM: MOVEI T1,.FHSLF
DIR%
CALL GETQ
MOVE M,T1
MOVEI T1,.FHSLF
EIR%
CAIN M,0
JRST WAITM
LDB T1,RSXFNC ;GET THE FUNCTION CODE
HRRZ T1,RSXDSP(T1) ;DISPATCH ADDRESS
CALL 0(T1) ;DO THE FUNCTION
MOVEI T1,.FHSLF
DIR%
MOVE T1,M
CALL PUTPL
MOVEI T1,.FHSLF
EIR%
JRST TRYM
AST11M: SAVTQ
JRST CHKRSX
AGN11M: CALL GETPL ;GET A BUFFER
MOVE M,T1 ;SAVE IT POINTER
MOVE T1,NETJFN ;GET THE LINKS JFN
MOVE T2,[POINT 8,0(M)] ;POINT TO THE BUFFER
MOVNI T3,MAXBUF*4 ;BUFFER SIZE
SINR% ;GET A MESSAGE
ERCAL NETERR
LDB T1,RSXFNC ;GET THE MESSAGE TYPE
TXNE DEBUG,D.ITYP
JRST [TMSG <
[Debug: Received message type:>
LDB T2,RSXFNC
MOVEI T1,.PRIOU
MOVEI T3,^D10
NOUT%
JFCL
TMSG <]
>
LDB T1,RSXFNC
JRST .+1]
CAILE T1,14 ;KNOWN MESSAGE TYPE?
JRST [TMSG <?Unknown RSX11M message type
>
JRST ENDIT]
HLRZ T2,RSXDSP(T1) ;GET QUEUE FLAG
SKIPN T2
JRST RSXQ
HRRZ T1,RSXDSP(T1)
CALL 0(T1)
JRST CHKRSX
RSXQ: MOVE T1,M
CALL PUTQ ;QUEUE IT
CHKRSX: MOVE T1,NETJFN
SIBE%
JRST AGN11M
HRRZ T1,PC2
CAIE T1,TRYM
JRST RSXRNM
TXO T1,1B5
MOVEM T1,PC2
RSXRNM: RESTQ
DEBRK%
RSXDSP: 1,,RSXNOP ;NO OP
0,,RSXBAD ;DONT EXPECT A CONFIG NOW
0,,RSXBAD ;DISCONNECT
1,,RSXWRT ;WRITE DATA TO TERM
0,,RSXRD ;READ DATA FROM TERMINAL
0,,RSXRDP ;READ DATA WITH PROMPT
0,,RSXBAD ;UNSOLICITED INPUT
0,,RSXBAD ;SINGLE CHARACTER MODE
0,,RSXBAD ;CANCEL IO
0,,RSXBAD ;ATTACH TASK TO TERMINAL
0,,RSXBAD ;GET TERM CHARACTERISTICS
0,,RSXBAD ;SET TERM CHARACTERICTICS
0,,RSXBAD ;EXCEPTION CONDITION REQUEST
RSXBAD: TXNE DEBUG,D.ITYP
JRST [TMSG <
[Debug: This message type is currently unsupported]
>
JRST .+1]
RET
RSXNOP: TXNE DEBUG,D.ITYP
JRST [TMSG <
[Debug: A noop message was just processed]
>
JRST .+1]
RET
RSXWRT:
MOVEI T1,.PRIOU
MOVE T2,RSXDAT
LDB T3,RSXWCT
MOVN T3,T3
SOUT%
TXNE DEBUG,D.ITYP
JRST [TMSG <
[Debug: Processing a write packet]
>
JRST .+1]
LDB T1,RSXMOD ;GET THE MODIFIER
TXNE T1,RM.NRY ;REPLY?
JRST WRTRET
MOVEI T1,0
DPB T1,RSXMOD
DPB T1,RSXFLG
DPB T1,RSXSTA
MOVE T1,NETJFN
MOVE T2,[POINT 8,0(M)]
MOVNI T3,^D10
SOUTR%
ERCAL NETERR
TXNE DEBUG,D.OTYP
JRST [TMSG <
[Debug: Reply sent to write packet]
>
JRST .+1]
WRTRET: MOVE T1,M
CALL PUTPL
RET
RSXRD: SETZM RSXTXB+.RDRTY
TXNE DEBUG,D.ITYP
JRST [TMSG <
[Debug: Processing a read packet]
>
JRST .+1]
JRST RSXNPM
RSXRDP: TXNE DEBUG,D.ITYP
JRST [TMSG <
[Debug: processing a read with prompt packet]
>
JRST .+1]
HRROI T1,PROMPT
MOVE T2,RSXDAT
LDB T3,RSXWCT
MOVN T3,T3
SOUT%
SETZ T2,
IDPB T2,T1
DPB T2,RSXWCT
MOVE T1,[POINT 7,PROMPT]
ILDB T2,T1
CAIE T2,CR
JRST RSXWP
ILDB T2,T1
CAIE T2,LF
RSXWP: HRROI T1,PROMPT
PSOUT%
HRROI T1,PROMPT
MOVEM T1,RSXTXB+.RDRTY
RSXNPM: MOVEI T1,4 ;RETURN RECORD IS TYPE 4
DPB T1,RSXFNC ;SET IT UP
SETZ T1,
DPB T1,RSXFLG
DPB T1,RSXSTA
LDB MD,RSXMOD
TXNE MD,RM.RNE ;ECHO?
JRST [MOVEI T1,.PRIIN
RFMOD%
TXZE T2,TT%ECO
SFMOD%
JRST .+1]
MOVE T1,RSXDAT ;POINT TO THE DATA
MOVEM T1,RSXTXB+.RDDBP ;SAVE FOR TEXTI
MOVEM T1,RSXTXB+.RDBFP
LDB T1,RSXRCT ;SIZE OF LINE
MOVEM T1,RSXTXB+.RDDBC ;
MOVEI T1,RSXTXB
TEXTI%
JRST [TMSG <?TEXTI failed
>
JRST ENDIT]
TXNE MD,RM.RNE
JRST [MOVEI T1,.PRIIN
RFMOD%
TXON T2,TT%ECO
SFMOD%
JRST .+1]
SETZ T1,
DPB T1,RSXMOD
LDB T1,RSXRCT ;ORIGNAL COUNT
SUB T1,RSXTXB+.RDDBC
CAIN T1,1
JRST [MOVE T3,RSXDAT
ILDB T2,T3
CAIG T2,37
SUBI T1,1
CAIE T2,32
JRST RSXNCR
PUSH P,T1
MOVEI T1,15
PBOUT
MOVEI T1,12
PBOUT
POP P,T1
JRST RSXNCR]
MOVE T2,RSXTXB+.RDDBP
HRREI T3,-1
ADJBP T3,T2
LDB T2,T3
SUBI T1,1
CAIN T2,CR
SUBI T1,1
RSXNCR: DPB T1,RSXRCT ;SAVE FOR THE SEND
MOVE T1,NETJFN ;LINK JFN
MOVE T2,[POINT 8,0(M)]
LDB T3,RSXRCT ;SIZE OF THE MESSAGE
ADDI T3,^D11 ;ADD IN HEADER AND TERMINATOR LENGTH
MOVN T3,T3
SOUTR% ;RETURN THE DATA
ERCAL NETERR ;ERROR?
TXNE DEBUG,D.OTYP
JRST [TMSG <
[Debug: Sent reply to read or read with prompt]
>
JRST .+1]
RET
RSXCTC: SAVTQ
MOVE T1,NETJFN
MOVE T2,[POINT 8,RSXCMG]
MOVNI T3,12
SOUTR%
ERCAL NETERR
RESTQ
DEBRK%
DORSTS: TMSG <]
[Remote host is a RSTS/E system]
>
CALL CONMES
HRRZI T1,-5 ;FOR THIS JOB
MOVX T2,1B0
HRRZ T3,ESCCAR
MOVN T3,T3
LSH T2,0(T3) ;TO GENERATE AN INTERRUPT
STIW%
DMOVE T1,STDBRK
DMOVEM T1,CURBRK
DMOVE T1,STDBRK+2
DMOVEM T1,CURBRK+2
TXNE DEBUG,D.OTYP
JRST [TMSG <
[Debug: Sending Configuration message]
>
JRST .+1]
MOVE T1,NETJFN ;NETWORK JFN
MOVE T2,[POINT 8,RSTSCF] ;RSTS CONFIGURATION MESS
MOVNI T3,RSTCFL
SOUTR% ;SEND IT
ERCAL NETERR
TXNE DEBUG,D.OTYP
JRST [TMSG <
[Debug: Sending RSTS control message]
>
JRST .+1]
MOVE T1,NETJFN
MOVE T2,[POINT 8,RSTCNT]
MOVNI T3,RSTCNL
SOUTR%
ERCAL NETERR
MOVEI T1,RSTAST ;NET DATA INTERRUPT ROUTINE
HRRM T1,NETINT ;SAVE IN CHAN TABLE
CALL GETPL ;GET A BUFFER FOR INCOMING MESSAGES
MOVEM T1,RSTSBF ;SAVE ITS ADDRESS
MOVEI T1,.FHSLF
MOVX T2,1B4
AIC% ;ACTIVATE THE DATA INTERRUPT CHANNEL
MOVE T1,NETJFN
MOVEI T2,.MOACN
MOVX T3,<FLD(.MONCI,MO%CDN)+FLD(4,MO%DAV)+FLD(.MONCI,MO%INA)>
MTOPR%
PUSH P,DEBUG ;SAVE THE DEBUG REGISTER
MOVEM P,PFORK ;SAVE PDL FOR LOWER FORK
MOVX T1,<CR%MAP+CR%CAP+CR%ST+RFORK>
CFORK%
HALTF%
MOVEI T1,^D10000
DISMS%
SKIPE RABORT
HALTF%
JRST .-4
SUBTTL RSTS main loop
PAGE
;
; HERE DO A TEXTI AND SEND THE TEXT IN AN INFINITE LOOP
;
RFORK: MOVE P,PFORK
POP P,DEBUG ;GET THE DEBUG REGISTER
CALL GETPL ;GET A BUFFER
MOVE M,T1 ;SAVE ITS ADDRESS
MOVE T1,NETJFN
MOVE T2,[POINT 8,RSTSUP]
MOVNI T3,5
SOUTR%
ERCAL NETERR
NEXTLN: MOVE T1,[POINT 8,1(M)] ;POINT TO DATA PART
MOVEM T1,RSTTXB+.RDDBP ;SAVE FOR TEXTI
MOVEM T1,RSTTXB+.RDBFP
MOVEI T1,^D132 ;SIZE OF STRING (MAX)
MOVEM T1,RSTTXB+.RDDBC ;LENGTH OF STRING
MOVEI T1,RSTTXB ;ARG BLOCK ADDRESS
TEXTI% ;GET SOME INPUT
JFCL
LDB T1,RSTTXB+.RDDBP ;GET THE LAST BYTE
CAIN T1,CR ;WAS IT A CR?
JRST [PBIN% ;YES, GET THE LF
IDPB T1,RSTTXB+.RDDBP ;SAVE IT IN THE BUFFER
SOS RSTTXB+.RDDBC ;ADJUST THE BYTE COUNT
JRST .+1]
MOVE T1,RSTTXB+.RDDBP ;GET BYTE POINTER
HRREI T2,-1 ;ADJUST BY 1
ADJBP T2,T1
LDB T1,T2 ;GET THE 2ND TO LAST BYTE
CAIN T1,CR ;IS IT A CR?
AOS RSTTXB+.RDDBC ;YES, DECREMENT THE BYTE COUNT
MOVE T1,[POINT 8,0(M)] ;POINT TO THE BUFFER
MOVEI T2,5 ;DATA MESS TYPE
IDPB T2,T1 ;SAVE IT
MOVEI T2,^D132+4
SUB T2,RSTTXB+.RDDBC ;COMPUTE MESSAGE LENGTH
IDPB T2,T1 ;SAVE IN MESSAGE
SETZ T3,
IDPB T3,T1 ;2 BYTE COUNT
SUBI T2,4
IDPB T2,T1 ;LENGTH OF DATA PART ONLY
ADDI T2,4
TXNE DEBUG,D.OTYP
JRST [TMSG <
[Debug: Sending text message]
>
JRST .+1]
MOVE T1,NETJFN ;GET THE JFN
MOVN T3,T2 ;MESSAGE LENGTH
MOVE T2,[POINT 8,0(M)] ;BYTE POINTER
SOUTR% ;SEND THE MESSAEG
ERCAL NETERR ;ERROR?
JRST NEXTLN ;DO IT AGAIN
SUBTTL RSTS network data avalable routine
PAGE
;
; HERE WHEN DATA COMES FROM THE RSTS SYSTEM
;
RSTAST: SAVTQ ;SAVE ACS
MOVE M,RSTSBF ;SAVE THE ADDRESS
JRST RETRST
RSTAS1: MOVE T1,NETJFN ;THE NETWORK JFN
MOVE T2,[POINT 8,0(M)]
MOVNI T3,MAXBUF*4 ;BUFFER SIZE
SINR% ;GET A MESSAGE
ERCAL NETERR
MOVE T4,[POINT 8,0(M)]
ILDB T1,T4 ;GET THE MESSAGE TYPE
CAIE T1,5 ;DATA MESSAGE?
JRST NOTDAT ;NO,
TXNE DEBUG,D.ITYP
JRST [TMSG <
[Debug: Receiving data message]
>
JRST .+1]
MOVEI T1,.PRIOU
MOVE T2,[POINT 8,1(M)]
LDB T3,[POINT 8,0(M),31]
MOVN T3,T3
SOUT% ;OUTPUT THE TEXT ON THE TTY
RETRST: MOVE T1,NETJFN
SIBE% ;ANY MORE DATA ON THE LINK?
JRST RSTAS1 ;YES, PROCESS IT
RESTQ
DEBRK%
NOTDAT: CAIE T1,2 ;A CONTROL MESSAGE?
JRST [TMSG <
?Illegal protocol op code from remote
> JRST ENDIT]
TXNE DEBUG,D.ITYP
JRST [TMSG <
[Debug: Receiving control message]
>
JRST .+1]
MOVE T4,[POINT 8,0(M),23] ;POINT TO MESSAGE
ILDB T3,T4 ;GET TE COUNT OF MENU BYTES
ILDB T3,T4 ;GET THE MENU BYTE
TRNN T3,1 ;ECHO FIELD PRESENT
JRST TRYDEL ;NO
ILDB T1,T4 ;GET THE ECHO FLAG BYTE
JUMPN T1,ECOF
MOVEI T1,.PRIIN
RFMOD%
TXO T2,TT%ECO
SFMOD% ;TURN ON ECHOING
JRST TRYDEL
ECOF: MOVEI T1,.PRIIN
RFMOD%
TXZ T2,TT%ECO
SFMOD% ;TURN OFF ECHOING
TRYDEL: JRST RETRST
SUBTTL Dynamic Debugging code
PAGE
;OUTPUT SETMODE PACKET
SETMOD: DMOVEM T1,DEBAC1
DMOVEM T3,DEBAC2
LDW P1,R.MOD ;;GET THE MODIFIER VALUE
CAIE P1,200 ;CTRL-Y AST?
CAIN P1,400 ;CTRL-C AST?
JRST DAST ;YES
CAIN P1,1000 ;HANGUP?
JRST DHANG ;YES
;HERE IF ORDINARY SETMODE
HRROI T2,[ASCIZ/ TERMINAL TYPE: /]
%SOUT
LDB T2,R.TYPE ;GET THE VMS TERMINAL TYPE
%NOUT
%CRLF
HRROI T2,[ASCIZ/ LENGTH: /]
%SOUT
LDB T2,R.LEN
%NOUT
%CRLF
HRROI T2,[ASCIZ/ WIDTH: /]
%SOUT
LDW T2,R.WID ;GET THE WIDTH
%NOUT
%CRLF
HRROI T2,[ASCIZ/ CHARACTERISTICS: /]
%SOUT
LDB T1,R.CHAW ;GET 1ST 2 BYTES OF CHAR
LDB T2,R.CHAB ;GET THE 3RD BYTE
LSH T2,^D16 ;SHIFT LEFT
ADD T2,T1 ;MAKE IT ONE WORD
%NOUT
%CRLF
JRST DBRET
DAST: HRROI T2,[ASCIZ/ AST PARAMETER: /]
%SOUT
LDW T2,R.ASTP
%NOUT
%CRLF
JRST DBRET
DHANG: HRROI T2,[ASCIZ/ HANGUP/]
%SOUT
%CRLF
DBRET: DMOVE T1,DEBAC1
DMOVE T3,DEBAC2
RET
;OUTPUT READ PACKET
OREAD: DMOVEM T1,DEBAC1
DMOVEM T3,DEBAC2
MOVE T2,[POINT 7,[ASCIZ/ BYTE COUNT: /]]
%SOUT
LDW T2,R.CNT ;MAX BYTE COUNT
%NOUT
%CRLF
LDB T1,R.TRMS ;LENGTH OF TERMINATOR MASK
SKIPN T1 ;IS THERE A TERMINATOR MASK?
JRST ORET ;NO
;PROCESS TERMINATOR MASK
LDB T1,R.TRMS ;GET BYTE LENGTH
MOVNS T1 ;NEGATE
HRLZS T1 ;BUILD AOBJN POINTER
MOVE T2,R.TRM ;GET SOURCE BYTE POINTER
MOVE T3,[POINT 8,CMASK] ;GET DESTINATION BYTE POINTER
GTMSK1: ILDB T4,T2 ;GET A BYTE OF THE MASK
MOVE T4,SWAPTB(T4) ;SWAP THE BITS
IDPB T4,T3 ;WRITE THE BYTE
AOBJN T1,GTMSK1 ;BACK FOR MORE
LDB T1,R.TRMS ;GET BYTE COUNT
IDIVI T1,4 ;CONVERT TO WORDS
MOVNS T1 ;NEGATE
HRLZ T4,T1 ;BUILD AOBJN POINTER
MSKLP: MOVE T2,[POINT 7,[ASCIZ/ TERMINATOR MASK: /]]
%SOUT
MOVE T2,CMASK(T4) ;GET A BYTE OF CONVERTED MASK
MOVEI T1,.PRIOU
MOVE T3,[1B0+1B3+1B2+10B35+^D12B17]
NOUT%
JFCL
%CRLF
AOBJN T4,MSKLP
ORET: DMOVE T1,DEBAC1
DMOVE T3,DEBAC2
POPJ P,
;OUTPUT WRITE PACKET
OWRIT: POPJ P,
DIN: DMOVEM T1,DEBAC1
DMOVEM T3,DEBAC2
PUSH P,T2 ;;SAVE T2
MOVE T3,(P) ;;GET TABLE INDEX
HRRO T2,DBGTAB(T3) ;;GET STRING ADDR
%SOUT
LDW T2,R.MOD ;;GET THE MODIFIER VALUE
%NOUT
%CRLF
POP P,T2 ;;RESTORE T2
POPJ P,
DMOVE T1,DEBAC1
DMOVE T3,DEBAC2
SUBTTL Pure Data storage area
PAGE
;
; DATA STRUCTURES (PURE)
;
ENTVEC: JRST V
JRST V
VCUST=0
VERS=6 ;1-> VMS ONLY
;2-> VMS + 10/20 UNDER REL5
;3-> VMS + 10/20 + RSTS
;4-> VMS + 10/20 (REL4/REL5) + RSTS
;5-> vms,10/20(rel 4/5),rsts,rsx11
;6-> improved VMS support
VUPDAT=0
VEDIT=6 ;PLEASE UP THIS FOR EACH EDIT AND
;MAKE AN EDIT HISTORY
BYTE (3)VCUST(9)VERS(6)VUPDAT(18)VEDIT
CONBLK: 0 ;FLAG WORD
POINT 7,REMOTE
^D23
0
10
0
0
0
0
0
0
.PRIOU
.PRIOU
.PRIOU
OPCNAM: -1,,[ASCIZ/IO$_READVBLK(READ)/]
-1,,[ASCIZ/IO$_READLBLK(READ)/]
-1,,[ASCIZ/IO$_READPBLK(READ)/]
-1,,[ASCIZ/IO$_READPROMPT(READP)/]
-1,,[ASCIZ/IO$_TTYREADALL(READ)/]
-1,,[ASCIZ/IO$_TTYREADPALL(READP)/]
-1,,[ASCIZ/IO$_WRITEVBLK(WRITE)/]
-1,,[ASCIZ/IO$_WRITELBLK(WRITE)/]
-1,,[ASCIZ/IO$_WRITEPLBK(WRITE)/]
-1,,[ASCIZ/IO$_SETMODE(SETMD)/]
-1,,[ASCIZ/IO$_SETCHAR(SETMD)/]
-1,,[ASCIZ/IO$_SENSEMODE(SENMD)/]
-1,,[ASCIZ/IO$_SENSECHAR(SENMD)/]
-1,,[ASCIZ/IO$_ACPCONTROL(CANCL)/]
-1,,[ASCIZ/(BCST)/]
OPCTAB: READ,,61 ;IO$_READVBLK
READ,,41 ;IO$_READLBLK
READ,,14 ;IO$_READPBLK
READP,,67 ;IO$_READPROMPT
READ,,72 ;IO$_TTYREADALL
READP,,73 ;IO$_TTYREADPALL
WRITE,,60 ;IO$_WRITEVBLK
WRITE,,40 ;IO$_WRITELBLK
WRITE,,13 ;IO$_WRITEPBLK
SETMD,,43 ;IO$_SETMODE
SETMD,,32 ;IO$_SETCHAR
SENMD,,47 ;IO$_SENSEMODE
SENMD,,33 ;IO$_SENSECHAR
CANCL,,70 ;IO$_ACPCONTROL
BCST,,-1 ;
OPCLEN=.-OPCTAB
;For debugging
DBGTAB: [ASCIZ/ IO$_READVBLK Modifier: /]
[ASCIZ/ IO$_READLBLK Modifier: /]
[ASCIZ/ IO$_READPBLK Modifier: /]
[ASCIZ/ IO$_READPROMPT Modifier: /]
[ASCIZ/ IO$_TTYREADALL Modifier: /]
[ASCIZ/ IO$_TTYREADPALL Modifier: /]
[ASCIZ/ IO$_WRITEVBLK Modifier: /]
[ASCIZ/ IO$_WRITELBLK Modifier: /]
[ASCIZ/ IO$_WRITEPBLK Modifier: /]
[ASCIZ/ IO$_SETMODE Modifier: /]
[ASCIZ/ IO$_SETCHAR Modifier: /]
[ASCIZ/ IO$_SENSEMODE Modifier: /]
[ASCIZ/ IO$_SENSECHAR Modifier: /]
[ASCIZ/ IO$_ACPCONTROL Modifier: /]
[ASCIZ/ BROADCAST Modifier: /]
;For debugging
OTAB: PUSHJ P,OREAD ;IO$_READVBLK
PUSHJ P,OREAD ;IO$_READLBLK
PUSHJ P,OREAD ;IO$_READPBLK
PUSHJ P,OREAD ;IO$_READPROMPT
PUSHJ P,OREAD ;IO$_TTYREADALL
PUSHJ P,OREAD ;IO$_TTYREADPALL
PUSHJ P,OWRIT ;IO$_WRITEVBLK
PUSHJ P,OWRIT ;IO$_WRITELBLK
PUSHJ P,OWRIT ;IO$_WRITEPBLK
PUSHJ P,SETMOD ;IO$_SETMODE
PUSHJ P,SETMOD ;IO$_SETCHAR
JFCL ;IO$_SENSEMODE
JFCL ;IO$_SENSECHAR
JFCL ;IO$_ACPCONTROL
JFCL ;BROADCAST
TYPTAB: DT$L120,,.TT120
DT$L180,,.TT120
DT$L36,,.TTL36
DT$L38,,.TTL38
DT$TTY,,.TTDEF
DT$V05,,.TTV05
DT$V52,,.TTV52
DT$V55,,.TTV52
DT$V100,,.TT100
DT$V100,,.TT102
DT$V125,,.TT125
TTLEN=.-TYPTAB
DEFOFS=3
CHRTAB: TLOWR+TWRAP+THSYNC
TLOWR+TWRAP+THSYNC
TLOWR+TWRAP+THSYNC
TLOWR+TWRAP+THSYNC
TWRAP+THSYNC
TWRAP+TSCOP+THSYNC
TLOWR+TWRAP+TSCOP+THSYNC
TLOWR+TWRAP+TSCOP+THSYNC
TLOWR+TWRAP+TSCOP+THSYNC
TLOWR+TWRAP+TSCOP+THSYNC
TLOWR+TWRAP+TSCOP+THSYNC
PAGE
SUBTTL MSGTBL - Table of DECnet disconnect/abort reason text
;
; This table is used by the NETERR routine to provide an english
; text translation for the DECnet error codes which indicate why
; the network logical link connection was broken
;
;MACRO TO MAKE ENTRIES IN NSP ERROR TABLE
MAXMSG==^D50 ; Maximum number of NSP error messages
DEFINE NSPERR (CODE,TEXT,BASE<MSGTBL>),<
.ORG BASE+CODE
POINT 7,[ASCIZ\: TEXT\]
.ORG
>
MSGTBL: ;DECNET ERROR TEXT TABLE
REPEAT MAXMSG,<POINT 7,[ASCIZ\: Undefined NSP error\]> ;MAKE TABLE SPACE
; & UNDEFINED ENTRIES
NSPERR (.DCX0,<No special error>)
NSPERR (.DCX1,<Resource allocation failure>)
NSPERR (.DCX2,<Destination node does not exist>)
NSPERR (.DCX3,<Node shutting down>)
NSPERR (.DCX4,<Destination NRT or PASS-THROUGH process does not exist>)
NSPERR (.DCX5,<Invalid name field>)
NSPERR (.DCX9,<NRT server aborted link>)
NSPERR (.DCX11,<Undefined error>)
NSPERR (.DCX21,<CI with illegal destination address>)
NSPERR (.DCX24,<Flow control violation>)
NSPERR (.DCX32,<Too many connections to node>)
NSPERR (.DCX33,<Too many connections to destination NRT or PASS-THROUGH process>)
NSPERR (.DCX34,<Access not permitted>)
NSPERR (.DCX35,<Logical link services mismatch>)
NSPERR (.DCX36,<Invalid account>)
NSPERR (.DCX37,<Segment size too small>)
NSPERR (.DCX38,<Process aborted>)
NSPERR (.DCX39,<No path to destination node>)
NSPERR (.DCX40,<Link aborted due to data loss>)
NSPERR (.DCX41,<Destination logical link address does not exist>)
NSPERR (.DCX42,<Confirmation of disconnect initiate>)
NSPERR (.DCX43,<Image data field too long>)
CTAB: ;TABLE OF MASKS FOR BIT POSITIONS IN CCOC WORDS
;INDEX IS ASCII CODE ASSOCIATED WITH A PARTICULAR CCOC FIELD
BYTE (36) 3B1, 3B3, 3B5, 3B7, 3B9, 3B11, 3B13, 3B15, 3B17, 3B19
BYTE (36) 3B21, 3B23, 3B25, 3B27, 3B29, 3B31, 3B33, 3B35
BYTE (36) 3B1, 3B3, 3B5, 3B7, 3B9, 3B11, 3B13, 3B15, 3B17, 3B19
BYTE (36) 3B21, 3B23, 3B25, 3B27
BTAB: ;TABLE OF MASKS FOR BIT POSITIONS IN BREAK MASK
;EG INDEX 3 YIELDS MASK: 1B3
BYTE (36) 1B0 ,1B1 ,1B2 ,1B3 ,1B4 ,1B5 ,1B6 ,1B7 ,1B8 ,1B9 ,1B10
BYTE (36) 1B11,1B12,1B13,1B14,1B15,1B16,1B17,1B18,1B19,1B20,1B21
BYTE (36) 1B22,1B23,1B24,1B25,1B26,1B27,1B28,1B29,1B30,1B31,1B32
SWAPTB: ;TABLE FOR SWAPPING BITS IN AN 8-BIT BYTE
;INDEXED BY 8-BIT VALUE
BYTE (36) 000, 200, 100, 300, 040, 240, 140, 340, 020
BYTE (36) 220, 120, 320, 060, 260, 160, 360, 010, 210
BYTE (36) 110, 310, 050, 250, 150, 350, 030, 230, 130
BYTE (36) 330, 070, 270, 170, 370, 004, 204, 104, 304
BYTE (36) 044, 244, 144, 344, 024, 224, 124, 324, 064
BYTE (36) 264, 164, 364, 014, 214, 114, 314, 054, 254
BYTE (36) 154, 354, 034, 234, 134, 334, 074, 274, 174
BYTE (36) 374, 002, 202, 102, 302, 042, 242, 142, 342
BYTE (36) 022, 222, 122, 322, 062, 262, 162, 362, 012
BYTE (36) 212, 112, 312, 052, 252, 152, 352, 032, 232
BYTE (36) 132, 332, 072, 272, 172, 372, 006, 206, 106
BYTE (36) 306, 046, 246, 146, 346, 026, 226, 126, 326
BYTE (36) 066, 266, 166, 366, 016, 216, 116, 316, 056
BYTE (36) 256, 156, 356, 036, 236, 136, 336, 076, 276
BYTE (36) 176, 376, 001, 201, 101, 301, 041, 241, 141
BYTE (36) 341, 021, 221, 121, 321, 061, 261, 161, 361
BYTE (36) 011, 211, 111, 311, 051, 251, 151, 351, 031
BYTE (36) 231, 131, 331, 071, 271, 171, 371, 005, 205
BYTE (36) 105, 305, 045, 245, 145, 345, 025, 225, 125
BYTE (36) 325, 065, 265, 165, 365, 015, 215, 115, 315
BYTE (36) 055, 255, 155, 355, 035, 235, 135, 335, 075
BYTE (36) 275, 175, 375, 003, 203, 103, 303, 043, 243
BYTE (36) 143, 343, 023, 223, 123, 323, 063, 263, 163
BYTE (36) 363, 013, 213, 113, 313, 053, 253, 153, 353
BYTE (36) 033, 233, 133, 333, 073, 273, 173, 373, 007
BYTE (36) 207, 107, 307, 047, 247, 147, 347, 027, 227
BYTE (36) 127, 327, 067, 267, 167, 367, 017, 217, 117
BYTE (36) 317, 057, 257, 157, 357, 037, 237, 137, 337
BYTE (36) 077, 277, 177, 377
COMMENT \
FOLLOWING TABLES & CODE NEVER TESTED
;ROUTINE TO DO ESCAPE-SEQUENCE SYNTAX VALIDATION
TSTESC: SETZM T3 ;T3 IS FLAG
;HERE IF "GENERAL" ESCAPE SEQUENCE
SKIPN ESTAB(T1) ;VALID?
RET ;NO
SETOM T3
JRST PRSESC ;YES
;HERE IF SPECIFIC ESCAPE SEQUENCE
MOVE T4,[-5,,0]
CHRLP: HLRZ T2,ESTAB(T4)
CAMN T1,T2 ;FOUND MATCHING CHAR IN TABLE?
JRST PRSESC ;YES
AOBJN T1,CHRLP ;NO
RET ;NOT A VALID SEQUENCE
PRSESC: HRRZ T1,ESTAB(T4) ;GET POINTER TO PARSE TAB FOR NEXT CHAR
PRSLP: SKIPN T1(T4) ;VALID CHARACTER?
JRST PRET ;NO - ESCAPE SEQUENCE IS TERMINATED
HRRZ T1,@T1 ;GET POINTER TO NEXT PARSE TABLE
JRST PRSLP ;KEEP PARSING
PRET: RETSKP ;RETURN +2, INDICATING VALID ESCAPE SEQUENCE
;PARSING TABLES FOR ESCAPE SEQUENCES
;FOLLOWING SUPPORTED:
;ESC <;> <40-57>...<60-176>
;ESC <?> <40-57>...<60-176>
;ESC <O> <40-57>...<100-176>
;ESC <Y> <40-176>...<40-176>
;ESC <[> <par>...<par> <int>...<int> <fin>
; par <60-77>
; int <40-57>
; fin <100-176>
;ESC <int>...<int><fin>
; int <40-57>
; fin <60-176>
ESTAB: ";",,[ESINT,,[ESFIN1,,0]]
"?",,[ESINT,,[ESFIN1,,0]]
"O",,[ESINT,,[ESFIN2,,0]]
"Y",,YTAB
"[",,[ESPAR,,[ESINT,,[ESFIN2,,0]]]
ESTAB1: 0,,[ESINT,,[ESFIN1,,0]] ;ESC <int>...<int><fin>
YTAB: ESFIN3,,YTAB ;"INFINITE" LINKED-LIST FOR ESC Y
ESINT: BYTE (36) 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
BYTE (36) 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
BYTE (36) 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1
BYTE (36) 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
BYTE (36) 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
BYTE (36) 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
BYTE (36) 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
BYTE (36) 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
ESFIN1: BYTE (36) 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
BYTE (36) 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
BYTE (36) 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
BYTE (36) 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1
BYTE (36) 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1
BYTE (36) 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1
BYTE (36) 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1
BYTE (36) 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,0
ESFIN2: BYTE (36) 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
BYTE (36) 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
BYTE (36) 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
BYTE (36) 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
BYTE (36) 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1
BYTE (36) 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1
BYTE (36) 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1
BYTE (36) 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,0
ESFIN3: BYTE (36) 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
BYTE (36) 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
BYTE (36) 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1
BYTE (36) 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1
BYTE (36) 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1
BYTE (36) 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1
BYTE (36) 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1
BYTE (36) 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,0
ESPAR: BYTE (36) 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
BYTE (36) 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
BYTE (36) 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
BYTE (36) 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1
BYTE (36) 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
BYTE (36) 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
BYTE (36) 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
BYTE (36) 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0
\
END <3,,ENTVEC>