Trailing-Edge
-
PDP-10 Archives
-
BB-BT99V-BB_1990
-
10,7/cthnrt/cthnrt.mac
There are 7 other files named cthnrt.mac in the archive. Click here to see a list.
TITLE CTHNRT - CTERM Host Network Remote Terminal server
SUBTTL Spider Boardman/RCB 3-Apr-87
;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1985,1986,1987,1988,1989.
;ALL RIGHTS RESERVED.
;
;
;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 THAT IS NOT SUPPLIED BY DIGITAL.
SUBTTL Table of Contents
SUBTTL Revision History
COMMENT `
300 Start of CTHNRT development. Begin at edit 300 and version 5 to
allow for maintenance to the predecessor product, NRT.
301 Fix up feature tests for various things, and the copyright.
302 Fix erroneous "Connection to remote node aborted" messages.
303 Fix various echoing problems.
304 Fix formatting (free-LF) logic with 0-length prompts.
305 Fix the Ultrix echoing problem.
306 Add the /OLD and /CTERM switches, and a message saying which NVT
level we succeeded in connecting through.
307 Fix ^O problem.
310 Give actual username on connects (for VMS).
311 Fix free-CRLF problems.
312 Fix the H[ELP] command text.
313 Fix some buffering problems.
314 Lie to VMS about being on a modem (CTDRIVER screws up otherwise).
315 314 was wrong. It's not the modem, it's the segment size. Don't
diddle the segment size for CTERM mode.
316 Sigh. Gotta support VMS's restriction of DECnet object names
to a maximum of 12 characters, even though it clearly violates
the DECnet architecture specs.
317 Add timestamps to the NRTNSP: trace file.
320 Add feature test FTSYPW for systems that want to require the secondary
password on RTA terminals.
321 Don't be quite so paranoid about the low-water mark in a CTERM
start-read message. Typing ^C at RSX-11M+ loses when we're checking
the low-water mark against the length of the prompt. Just assume
that the -11 meant to include it, and fix it up.
322 Fix the NSP-level trace routine to output an ASCII translation
of the bytes recorded as well as an octal translation.
323 Now that the reason for the 12-byte restriction in edit 316 is known,
accomodate VMS a bit more and use a format-type of 2 in our process
descriptor. It will help disambiguate just who is connecting.
Become V3B
324 Update our terminal handling to accomodate 7.04 and VMS V5.1.
325 Fix undeserved "invalid escape sequence" read terminations. This seems
to fix the problems with an escape sequence as typeahead.
`
SUBTTL Preamble
;Listing control
SALL ;FOR CLEANER LISTINGS
.DIRECTIVE FLBLST ;EVEN CLEANER
.DIRECTIVE SFCOND ;CLEANER STILL
;Definition files
SEARCH JOBDAT,UUOSYM,MACTEN ;TYPICAL TOPS-10 THINGS
SEARCH MACSYM ;TYPICAL DECnet THINGS
SEARCH ACTSYM ;FOR UGMAP$ SYMBOLS
;Hiseg origin
;Keep HIORG low enough for VMDDT, but high enough for lots of lowseg data
ND HIORG,600K
TWOSEG HIORG ;TOPS-10 LIKES SHARED SEGMENTS
RELOC HIORG ;PUT THINGS IN HISEG
;The obligatory .EXE file copyright statement
ASCIZ |
COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1985,1989.
ALL RIGHTS RESERVED.
|
;Debugging/SPR Aid
.TEXT "/SYMSEG:HIGH/LOCALS/PATCHS:400"
;Version info
NRTVER==5 ;SUCCESSOR OF OLD NRT PROGRAM
NRTMIN==2 ;MINOR VERSION
NRTEDT==325 ;LATEST & GREATEST
NRTWHO==0 ;DEC DEVELOPMENT
.ORG .JBVER ;WHERE VERSION NUMBERS BELONG
VRSN. (NRT) ;PUT IT THERE
.ORG ;BACK TO THE HISEG
SUBTTL Feature tests
ND MAXPMR,7 ;Maximum number of nodes in PMR string
ND OUTQUO,200 ;Number of outstanding output buffers
ND FTFUNCTION,0 ;Don't type out function code
ND FTIPMR,0 ;Implicit PMR off
ND FTEPMR,0 ;Explicit PMR off
ND FTPARANOID,0 ;Special checks
ND FTCROCK,-1 ;Code 'cause other systems don't work
ND FTSYPW,0 ;[320] Code for VMS SET TERM/SYSPASSWD
;Additional stuff:
IFN FTIPMR,<
SEARCH PMR
.REQUEST PMR
ND PMRDCN,PMR$DCN ;LOOK FOR DNHOST.TXT ON DCN:
>
SUBTTL AC definitions
F==0 ;FLAGS
T1==1 ;A BLOCK OF FOUR TEMPORARIES
T2==2 ; (USED IN PARAMETER PASSING)
T3==3
T4==4
P1==5 ;START OF FOUR 'PRESERVED' REGISTERS
P2==6 ; (SELDOM TRULY PRESERVED EXCEPT AT
P3==7 ; LOW LEVELS, BUT USED TO PASS GLOBAL
P4==10 ; PARAMETERS AROUND)
CX==11 ;THE MACSYM SUPER-TEMP AC
.SAC==CX ;ANOTHER NAME USED FOR CX
;The following group of ACs is used for NSP. UUO argument blocks
NSAFN==12 ;FUNCTION WORD
NSACH==13 ;CHANNEL NUMBER
NSAA1==14 ;ARGUMENT WORD ONE
NSAA2==15 ;ARGUMENT WORD TWO
NSAA3==16 ;ARGUMENT WORD THREE
P==17 ;THE STACK POINTER
SUBTTL Flag definitions in F
F$IOQ==1B0 ;Inhibit queueing of output buffers
F$UAST==1B1 ;User wants unsolicted input
F$NEC==1B2 ;No-echo
F$LEM==1B3 ;(VMS) Nofilter=set IO.LEM
F$ESC==1B4 ;User wants escape sequence processing (VMS, RSX)
F$ESA==1B5 ;Escape sequence being processed
F$PIM==1B6 ;Set TTY: to PIM mode
F$XPT==1B7 ;EXPerT mode
F$IEC==1B8 ;Ignore LDBECC at TOOUT
F$NEOM==1B9 ;Not EOM on NSP.
F$SYNC==1B10 ;Don't do INs unless you have to
F$PION==1B11 ;PSISER is turned on
F$BRK==1B12 ;Saw a break character (SCNSPC)
F$CTO==1B13 ;Control-O in effect
F$P2==1B14 ;General PASS2 flag (core allocator, SCNLCH)
F$CAST==1B15 ;VMS user wants to see ^C
F$YAST==1B16 ;VMS user wants to see ^Y
F$READ==1B17 ;Read request outstanding (mostly VMS)
F$TMR==1B18 ;Timeout active (RSX)
F$PALL==1B19 ;Passall (even if in line mode)
F$RALL==1B20 ;Temporary passall (READALL, VMS)
F$FLF==1B21 ;(VMS)Free <LF> may be needed
F$ICO==1B22 ;Ignore setting of ^O bit (one time)
F$RUB==1B23 ;I need to process rubout,^R, and ^U
F$ACO==1B24 ;Allow ^O in mask (for RSTS)
F$TEX==1B25 ;Timeout expired (RSX)
F$SCM==1B26 ;(RSX) Single character mode
F$CVL==1B27 ;Temporary CVTLOW. **MUST=VAX CVTLOW**
F$BAD==1B28 ;Terminating due to bad escape sequence
F$NDB==1B29 ;Don't do a DEBRK. (TTY: service)
F$USRV==1B30 ;TTY service call requested at non-PSI level
F$CLF==1B31 ;(VMS, RSX) Free <LF> already given
F$EOMN==1B32 ;(T10/20) Don't put EOM except on last message
F$RU1==1B33 ;First time through unsolicited code (after request
;is enabled)
;** 1B34 ** FREE BIT
F$FRC==1B35 ;TTY: service wants to be called even if no chars
SUBTTL Debugging aids
COMMENT `
In order to generate a trace file (e.g., for submission with an SPR),
define the path(o)logical name NRTNSP (with /OVERRIDE) to refer to the
file to record the DECnet messages exchanged.
Any previous file will be superseded, not appended to, so be careful when
using this feature. Also, the name's definition is not deleted by the
program, so be sure to undefine the name when done.
An example:
.PATH NRTNSP:/OV=CYGNUS.TRA
.SET HOST CYGNUS
....
.PATH NRTNSP:=
.PRINT/FORM:NARROW CYGNUS.TRA
`
SUBTTL Useful OPDEFs
OPDEF IFIW [1B0] ;FOR DISPATCH TABLES
.NODDT IFIW ;DON'T CLOBBER SETZ
OPDEF NOP [TRN] ;CURRENTLY FASTEST NO-OP
SUBTTL SYSTEM MACROS -- TEXT CONCATENATION
;THESE MACROS PROVIDE A CONVENIENT MECHANISM TO ACCUMULATE TEXT
;(ASCIZ STRINGS, MACRO DEFINITIONS ETC.) DURING THE COURSE OF AN
;ASSEMBLY, THEN TO USE THAT TEXT AS DESIRED LATER ON.
;
;TO INITIALIZE:
; CCLEAR(NAME)
;
; WHERE NAME IS 4 CHARACTERS OR LESS.
;
;TO CONCATENATE TEXT ON THE RIGHT:
; CONCAT(NAME,TEXT)
;
; WHERE NAME HAS BEEN INITIALIZED BY CCLEAR, AND TEXT IS
; THE TEXT TO BE CONCATENATED.
;
;AFTER THE CALL TO ANY CONCAT MACRO, NAME WILL BE DEFINED TO BE
;THE TEXT ACCUMULATED SO FAR. USE OF THIS MACRO DOES NOT PREVENT
;ADDITIONAL CALLS TO CONCAT. MULTIPLE STRINGS CAN BE ACCUMULATED
;SIMULTANEOUSLY, USING DIFFERENT NAMES.
;
;EXAMPLE:
; CCLEAR(MSG)
; CONCAT(MSG,ASCIZ /)
; CONCAT(MSG,A )
; CONCAT(MSG,LINE)
; CONCAT(MSG,/)
;
; IS EQUIVALENT TO DEFINE MSG<ASCIZ /A LINE/>
DEFINE CCLEAR(NAME)< ;;CLEAR MACRO
DEFINE C.'NAME(FTXT)< ;;DEFINE FIRST CALL
DEFINE C.'NAME(TEXT)< ;;DEFINE 2ND CALL
C%%%ON <NAME>,<FTXT>,<TEXT> ;;APPEND THE TEXT
>
DEFINE NAME<FTXT> ;;JUST TEXT 1ST TIME
>
.XCREF C.'NAME ;;DON'T CREF TEMP MACRO
DEFINE NAME<> ;;NULL BEFORE CONCAT'S
>
DEFINE C%%%ON(NAME,OTXT,NTXT)< ;;INTERNAL HELPER MACRO
DEFINE C.'NAME(TEXT)< ;;DEF C.NAME FOR LATER
C%%%ON <NAME>,<OTXT'NTXT>,<TEXT> ;;CALL HELPER MACRO
>
DEFINE NAME<OTXT'NTXT> ;;PUT NEW TEXT IN NAME
>
DEFINE CONCAT(NAME,TEXT)<C.'NAME <TEXT>>
.XCREF C%%%ON
;THE CONC MACRO SIMPLY CONCATENATES ITS PARAMETERS AND MAKES
; A CONVENIENT MECHANISM TO BUILD LABELS WITH NUMERIC STRINGS IN THEM.
DEFINE CONC(A,B,C,D,E,F,G,H,I,J)<A'B'C'D'E'F'G'H'I'J>
SUBTTL Constant definitions
PDLLEN==100 ;STACK LENGTH
TTBFSZ==100 ;TTY OUTPUT BUFFER SIZE.
SUBTTL Device channel definitions
$NSP==4 ;NSP. I/O log
$LOG==5 ;Session log (not yet implemented)
$TTY==6 ;Devices
$SWI==7 ;SWITCH.INI
SUBTTL Internal input and output buffer block definitions
.ORG 0
IBF.LK: BLOCK 1 ;Length,,Link to next buffer
;Note that the length is NEGATIVE
;if this is the last block in the chain
IBF.FL: BLOCK 1 ;Flag bits
IF.NEC==1B0 ;This buffer was input under IO.SUP
IF.TRM==1B1 ;This buffer's terminator was not echoed
IBF.CT: BLOCK 1 ;Count of characters in buffer
IBF.PT: BLOCK 1 ;Pointer into buffer
IBF.DT: ;Data starts here
.ORG
.ORG 0
OOB.LK: BLOCK 1 ;Link to next OOB buffer
OOB.DT: ;Data starts here
ND OOBSIZ,20 ;Data size of an OOB buffer
.ORG
IF2,<
IFL OBUFSZ*4-%MINBF,<
PRINTX ?Output buffer size is too small
>
>
ND OBUFSZ,200 ;Be able to do a big request
.ORG 0
OBF.CT: ;Current count to output in LH,
OBF.LK: BLOCK 1 ;Link to next in RH
OBF.PT: BLOCK 1 ;Byte pointer
OBF.DT: ;BLOCK OBUFSZ ;Output buffer size
.ORG
.ORG 0
TOB.CT:
TOB.FL:
$TOICL==1B0 ;Immune to output queue flush
$TOOIN==1B1 ;Override inhibit output
$TOCNT==777B17 ;Count
TOB.LK: BLOCK 1 ;flags+Count,,link.
TOB.DT: ;Start of data area (run time determined size)
.ORG
ND IBUFSZ,^D512 ;Maximum message length we allocate for
BFLEN==<IBUFSZ+3>/4 ;Equivalent in words
SUBTTL MACRO Definitions -- FALL (Address)
;The FALL MACRO is used to insure that the contiguity assumptions
;about routine addresses (so that the extra JRST is not required) are correct.
;FALL will print an error message if the assumption is incorrect.
DEFINE FALL(ADDRESS),<
IF2,<IFN .-ADDRESS,<PRINTX ?Cannot fall into Routine 'ADDRESS>>
> ;End FALL
SUBTTL MACRO Definitions -- ERR(PRE,MSG)
;The ERR MACRO is used to define a fatal error condition for NRT.
;It assembles with a three letter mnemonic which expands the location
;calling the ERR MACRO into the symbol "E..sym". It calls the error
;routine specifying a prefix and a message for output. The error routine
;saves context for a possible dump and exits.
DEFINE ERR(PRE,MSG,CONTIN<NSPER1>)<
E..'PRE::!XCT [PRE::PUSHJ P,DOERR ;; Do an error message
SETA [ASCIZ |NRT'PRE|] ;; IFIW's that
SETA [ASCIZ |MSG|] ;; are no-ops
JRST CONTIN ]>
SUBTTL MACRO Definitions -- ERRMAC(code,pre,text)
;ERRMAC is used to make the standard DECnet error message table.
DEFINE ERRMAC(code,pre,text),<
IF1,<IFN code*2-<.-NSPERC>,<
PRINTX ?NSP. error code out of order in NSPERC table>>
[ASCIZ |pre|]
ERRMC1(\code,text)
>
DEFINE ERRMC1(code,text),<[ASCIZ |code; text|]>
SUBTTL MACRO Definitions -- FCNMAC - Table of NSP. function codes and text
;FCNMAC is called to make the NSP. UUO function description table.
DEFINE FCNMAC(code,text),<
IFN code-<.-FCNTAB>,<PRINTX ?NSP. function code out of order>
[ASCIZ /text/]
>
;MAX MACRO
DEFINE MAX(A,B)<
IFN <<A-B>&400000000000><B>
IFE <<A-B>&400000000000><A>
>
DEFINE SAVE(ACS)<
IRP <ACS><PUSH P,ACS>
>
DEFINE RESTORE(ACS)<
IRP <ACS><POP P,ACS>
>
SUBTTL MACRO Definitions -- Typeout MACROS
;There are three MACROS for various forms of typeout:
;
;TYPE is called to output an ASCIZ string to the controlling terminal.
;
;TYPCRLF is called to output a carriage return-line feed to the controlling
;terminal.
;
;TSIX is called to output a SIXBIT string to the controlling
;terminal.
DEFINE TYPE(STR)<OUTSTR [ASCIZ `STR`]>
DEFINE TYPCRLF<OUTSTR [ASCIZ `
`]>
DEFINE TSIX(STR)<
PUSH P,STR
PUSHJ P,.TSIX
ADJSP P,-1
>
SUBTTL MACRO Definitions -- AC saving MACROS
;There are many AC saving MACROS which call the appropriate routines.
;All of these macros use AC CX as a temporary AC:
;
;SAVE1 saves P1
;
;SAVE2 saves P1 and P2
;
;SAVE4 saves P1 through P4
;
;SAVET1 saves T1
;
;There is also a routine, not called by a MACRO, to save all T ACs (SAVT).
DEFINE SAVE1,<JSP CX,.SAV1>
DEFINE SAVE2,<JSP CX,.SAV2>
DEFINE SAVE4,<JSP CX,.SAV4>
DEFINE SAVET1,<JSP CX,.SAVT1>
DEFINE RETSKP,<JRST CPOPJ1>
SUBTTL MACRO Definitions -- Break masks
;The BRKMSK MACRO is used to define a break mask for usage by NRT.
;The two arguments are a string of control characters to use as the mask
;(except for convenience the user types in the string with all the characters
;"uncontrolified", e.g., to put "^A" in the break mask, specify "A" as
;a character of the first argument to the MACRO) and the "regular" character
;string, which inclues all characters which are not control characters.
DEFINE CTLMSK(STRING)<...BRK==0
IRPC STRING,<...BRK==...BRK!1B<"STRING"&^O37>>
>
DEFINE BRKMSK(CTLSTR,REGSTR,XCTLST,XREGST)<
CTLMSK(CTLSTR)
BRMSK. (...BRK,,,,,'REGSTR')
IFB<XCTLST'XREGST>,<EXP W0.,W1.,W2.,W3.>
IFNB<XCTLST'XREGST>,<
CTLMSK<XCTLST>
BRMSK. (...BRK,,,,,<XREGST>)
>
>
SUBTTL MACRO Definitions -- ASSUME
;The ASSUME MACRO is analagous to the FALL MACRO but is used for values
;rather than addresses.
DEFINE ASSUME (A,B)<IF2 <
IFN <A-B>,<
PRINTX %Assumption wrong: 'A does not equal 'B
>
>
>
SUBTTL MACRO Definitions -- NETOCH macro - output character to network
;The NETOCH MACRO is used to output one character to the network. It takes
;as arguments the AC containing the character and the address of the error
;routine if there is insufficient room in the current buffer. The default
;action taken if no error address is given is to queue the network buffer
;without outputting it and allocate a new buffer in which to continue
;depositing characters.
DEFINE NETOCH (AC,ERRADR<[PUSHJ P,NETQUE
SOS (P)
POPJ P,]>)<
PUSHJ P,[SOSGE OBFCTR
JRST ERRADR
IDPB AC,OBFPTR
POPJ P, ]
>
SUBTTL MACRO Definitions -- NETALC - Allocate contiguous buffer space
;The NETALC MACRO is used to allocate space in the network output buffer
;without actually outputting anything. If the requested amount cannot be
;allocated in the current buffer, it is queued for output (but not output)
;and a new buffer is allocated. The requested allocated space is taken
;from the new buffer. Note that NETALC should not be called with a size
;bigger than the maximum buffer size. If this occurs, an error
;message will be output.
DEFINE NETALC (SIZE)<
IFNDEF %MINBF,<
%MINBF==SIZE
>
IFG SIZE-%MINBF,<
%MINBF==SIZE
>
MOVEI CX,SIZE ;;How much he wants
SUBM CX,OBFCTR ;;Will it fit?
SKIPL OBFCTR ;;(Negative if so
JRST [PUSHJ P,NETQUE
JRST .-3] ;;Try allocate new buffer
MOVNS OBFCTR ;;Make right sign
ADJBP CX,OBFPTR
MOVEM CX,OBFPTR
>
SUBTTL MACRO Definitions -- PTDSP
;The PTDSP MACRO is used to create a dispatch vector for the OSJMP table.
;The arguments to the PTDSP MACRO include the addresses of the operating
;specific initialization routine, network service routine, and TTY:
;service routine.
DEFINE PTDSP (PTCL)<
IF1,< IRP PTCL,<EXP 0>
>
IF2,<
IRP PTCL,<
[OSDSP PTCL,<EC,VD,AD,TT,OB,NT,IN>],,PT%'PTCL
>
>
>
DEFINE OSDSP(PT,LS),<
IRP LS,<
IFDEF PT'.'LS,<IFIW PT'.'LS>
IFNDEF PT'.'LS,<EXP 0>
>>
SUBTTL MACRO Definitions -- NAMTAB
;The NAMTAB MACRO is used to generate a table of SIXBIT names with appropriate
;symbols for the beginning and length of the list (in words). It is used
;to generate tables for use by the .LKNAM routine. This routine is called
;when RESCANning the command line (to parse the possible commands
;by which NRT can be run), the SWITCH.INI support (to parse switches),
;and the exit dialogue in NOVICE mode.
DEFINE NAMTAB(name,list),<
name'L==0
name'A:
IRP list,< name'L==name'L+1
EXP <SIXBIT |list|>>
>
SUBTTL MACRO Definitions -- TRMCHR
;The TRMCHR MACRO is used to define a table of TTY: characteristics to
;save/restore/set.
DEFINE TRMCHR (CHR,VAL,MNEU<SV>)<
T'MNEU'CHR: VAL,,.TO'CHR
>
SUBTTL MACRO Definitions -- VTTCHR
;The VTTCHR MACRO is used to define a VAX terminal characteristic word.
;This word consists of the terminal type in the right half and the
;high order byte of the TT2 characteristics word in the left half.
;This assumes the ANSI/DEC CRT bit is in that byte. The args for the
;MACRO are the ANSI/DEC CRT bit to use and the (up to) three character
;suffix to the DT$xxx symbol for the terminal type.
DEFINE VTTCHR (CRTBIT,TYPE)<
ASSUME <<CRTBIT>&<0,,-1>>,0
<CRTBIT>!DT$'TYPE
>
SUBTTL MACRO Definitions -- ASCII8
;ASCII8 makes eight-bit ASCII strings.
DEFINE ASCII8 (TEXT),<
%%%LEN==0
%%%WRD==0
IRPC TEXT,<
%%%WRD==<%%%WRD_10>+<"TEXT"_4>
%%%LEN==%%%LEN+1
IFE %%%LEN-4,<
EXP %%%WRD
%%%WRD==0
%%%LEN==0
>
>
IFN %%%LEN,<
%%%WRD==%%%WRD_<<4-%%%LEN>*10>
EXP %%%WRD
>
>
SUBTTL CTERM Protocol Definitions
;Define the network-order bit symbols B0-B15
RADIX 10
ZZ==0
REPEAT 16,<CONC(B,\ZZ,<==1_ZZ>)
ZZ==ZZ+1>
RADIX 8
;Define a helper macro for making masks out of network bits
DEFINE NETBIT(FIRST,LAST),<<B'LAST!<B'LAST-B'FIRST>>>
BYTMSK==NETBIT(0,7) ;MASK FOR A LOW-ORDER BYTE
WRDMSK==NETBIT(0,15) ;MASK FOR A 16-BIT WORD
SGNBIT==B15 ;SIGN BIT OF A NETWORK WORD
SUBTTL CTERM Protocol definitions - Foundation layer
;Define the Foundation message types
.FMILL==0 ;ILLEGAL MESSAGE TYPE
.FMBND==1 ;BIND-REQUEST
.FMUNB==2 ;UNBIND
.FMREB==3 ;RE-BIND (*ILLEGAL*)
.FMBAC==4 ;BIND-ACCEPT
.FMENM==5 ;ENTER-MODE
.FMEXM==6 ;EXIT-MODE
.FMCFM==7 ;CONFIRM-MODE
.FMNOM==10 ;NO-MODE
.FMCMD==11 ;COMMON DATA (CTERM MESSAGES)
.FMMDD==12 ;MODE DATA
;Define the O/S types for a Bind message
O.UNSP==0 ;UNSPECIFIED
O.RT11==1 ;RT-11
O.RSTS==2 ;RSTS/E
O.RSXS==3 ;RSX-11S
O.RSXM==4 ;RSX-11M
O.RSXD==5 ;RSX-11D
O.IAS==6 ;IAS
O.VMS==7 ;VAX/VMS
O.T20==10 ;TOPS-20
O.T10==11 ;TOPS-10
O.OS8==12 ;OS-8
O.RTS8==13 ;RTS-8
O.RSXP==14 ;RSX-11M+
O.MCB==15 ;COPOS/11
O.UXB==15 ;ULTRIX RETURNS THIS (INCORRECTLY)
O.POS==16 ;P/OS
O.ELAN==17 ;VAX/ELAN
O.CPM==20 ;CP/M
O.MSD==21 ;MS-DOS
O.UX32==22 ;ULTRIX-32
O.UX11==23 ;ULTRIX-11
O.MXOS==23 ;MAXIMUM DEFINED O/S TYPE
;Define the valid Protocol types for a Bind-Request message
PT%RST==B0 ;RSTS/E HOMOGENEOUS NETWORK TERMINALS
PT%RSX==B1 ;RSX-11 HOMOGENEOUS NETWORK TERMINALS
PT%VMS==B2 ;VMS HOMOGENEOUS NETWORK TERMINALS
PT%PIM==B3 ;PIM (TOPS-10/TOPS-20) HOMOGENEOUS TERMINALS
PT%CTM==B4 ;CTERM HETEROGENEOUS TERMINALS
;Define the valid Options flags for a Bind-Request message
OP%HIA==B0 ;HIGH-AVAILABILITY SYSTEM
;Define the Unbind reasons
.UBILL==0 ;ILLEGAL UNBIND REASON
.UBICV==1 ;INCOMPATIBLE VERSIONS OF THE PROTOCOL(S)
.UBNPA==2 ;NO PORTAL AVAILABLE
.UBUUR==3 ;USER UNBIND REQUEST
.UBDSC==4 ;TERMINAL DISCONNECTED
.UBTIU==5 ;REQUESTED LOGICAL TERMINAL IN USE
.UBNST==6 ;NO SUCH TERMINAL
.UBPED==7 ;PROTOCOL ERROR DETECTED
SUBTTL CTERM Protocol definitions - Command Terminal layer
;Define the CTERM message types
.CMILL==0 ;ILLEGAL MESSAGE TYPE
.CMPIN==1 ;CTERM PROTOCOL INITIATE
.CMSRD==2 ;START-READ
.CMRDD==3 ;READ DATA
.CMOOB==4 ;OUT-OF-BAND CHARACTER
.CMUNR==5 ;UNREAD
.CMCTA==6 ;CLEAR ALL TYPEAHEAD
.CMWRT==7 ;WRITE
.CMWRC==10 ;WRITE COMPLETE
.CMDOS==11 ;DISCARD-OUTPUT STATE
.CMRCH==12 ;READ CHARACTERISTICS
.CMCHR==13 ;CHARACTERISTICS (WRITE/RESPOND)
.CMCHK==14 ;CHECK INPUT COUNT
.CMICT==15 ;INPUT COUNT
.CMIST==16 ;INPUT STATE
.CMQIO==17 ;VMS QIO
.CMULB==20 ;VMS UPLINE BROADCAST
.CMERD==21 ;VMS EXTENDED READ (READ VERIFY)
;Define the valid parameters for a CTERM Protocol Initiate message
.PIILL==0 ;ILLEGAL PROTOCOL PARAMETER
.PIMMS==1 ;MAXIMUM ACCEPTABLE MESSAGE SIZE
.PIIBS==2 ;MAXIMUM ACCEPTABLE INPUT BUFFER SIZE
.PISUP==3 ;PROTOCOL MESSAGES SUPPORTED BIT MASK
.PIVTC==4 ;VMS TERMINAL CHARACTERISTICS (NON-STANDARD)
;Define the various minimum acceptable parameter values
MT.SUP==NETBIT(1,14) ;MUST SUPPORT MESSAGES ^D1-^D14
HSTMMS==^D90 ;HOSTS MUST BE ABLE TO ACCEPT 90-BYTE MESSAGES
SRVMMS==^D139 ;REQUIRED MESSAGE SIZE ACCEPTABLE BY SERVERS
MINIBS==^D80 ;SERVERS MUST ALLOW AN 80-CHAR INPUT BUFFER
NRTMMS==OBUFSZ*4 ;MAXIMUM BYTES IN OUR REQUESTS
NRTIMS==IBUFSZ ;SIZE WE CAN ACCEPT FROM THE NETWORK
NRTIBS==NRTIMS-^D10 ;OUR MAXIMUM INPUT BUFFER SIZE
IFG NRTIBS-^D255,<NRTIBS==^D255> ;LIMITED BY .TOSBS TRMOP.
;Define the CTERM characteristics that can be set and read via the
;CHARACTERISTICS messages.
;First, the types of characteristics:
.CTCFP==0 ;FOUNDATION PHYSICAL
.CTCFL==1 ;FOUNDATION LOGICAL
.CTCMH==2 ;CTERM MODE HANDLER
;Also define the various format types used for the characteristics
.FTASD==0 ;ASCID FORMAT
.FTBYT==1 ;SINGLE-BYTE CHARACTERISTIC
.FTINT==2 ;DOUBLE-BYTE CHARACTERISTIC
.FTCCA==3 ;COMPOUND: CHARACTER ATTRIBUTES
SYN .FTBYT,.FTBOL ;BOOLEANS ARE BYTES
SYN .FTINT,.FT2BY ;2-BYTE MASKS ARE DOUBLE-BYTES
;Define a macro to make it easy to define characteristics and their associated
;formats. Defines .CCnam and FT.nam for each invocation.
DEFINE X(NAM,FMT),<
IF1,<IFDEF .CC'NAM,<PRINTX ? DUPLICATE CHARACTERISTIC .CC'NAM>>
FT.'NAM==.FT'FMT
.CC'NAM==<XX==XX+1>>
;Note that characteristic zero is illegal for each of the three types
.CCILL==0 ;THE ILLEGAL CHARACTERISTIC
XX==.CTCFP_8 ;START DEFINING THE PHYSICAL CHARACTERISTICS
X RSP,INT ;RECEIVE SPEED
X TSP,INT ;TRANSMIT SPEED
X CSZ,INT ;CHARACTER SIZE
X CPE,BOL ;CHARACTER PARITY ENABLED
X CPT,INT ;CHARACTER PARITY TYPE
PAR.EV==1 ;EVEN PARITY
PAR.OD==2 ;ODD PARITY
PAR.SP==3 ;SPACE PARITY
PAR.MK==4 ;MARK PARITY
X MSP,BOL ;MODEM SIGNALS PRESENT (DATASET)
X ABR,BOL ;AUTO-BAUD RECOGNITION
X EMG,BOL ;ENTER-MANAGEMENT GUARANTEED
X SW1,ASD ;SWITCH-CHARACTER 1
X SW2,ASD ;SWITCH-CHARACTER 2
X 8BC,BOL ;8-BIT CHARACTER-SET TERMINAL (INVERTED BIT)
X EME,BOL ;ENTER-MANAGEMENT ENABLED
.CMXFP==XX ;MAXIMUM FOR FOUNDATION PHYSICAL
XX==.CTCFL_8 ;START DEFINING THE LOGICAL CHARACTERISTICS
X MWA,BOL ;MODE WRITING ALLOWED
X TAM,2BY ;TERMINAL ATTRIBUTES MASK
TA%KNO==B0 ;TYPE IS KNOWN TO SENDER'S SYSTEM
TA%DIS==B1 ;DISPLAY TERMINAL
X TTN,ASD ;TERMINAL TYPE NAME
X OFC,BOL ;OUTPUT FLOW CONTROL (TTY XONOFF)
X OPS,BOL ;OUTPUT PAGE STOP (TTY STOP)
X FCP,BOL ;FLOW-CHARACTER PASSTHROUGH
X IFC,BOL ;INPUT FLOW CONTROL
X LNE,BOL ;LOSS NOTIFICATION ENABLED
X WID,INT ;CARRIAGE WIDTH
X LEN,INT ;FORMS LENGTH
X SSZ,INT ;STOP SIZE
X CRF,INT ;C-R FILL
X LFF,INT ;L-F FILL
X WRP,INT ;WRAP HANDLING
WP.NON==1 ;NO WRAPPING AT ALL
WP.TRC==2 ;TRUNCATE AT RIGHT MARGIN
WP.PHY==3 ;HARDWARE IS WRAPPING AND WE'RE TRACKING IT
WP.SFT==4 ;FULL SOFTWARE WRAPPING
X HTM,INT ;HORIZONTAL TAB MODELING
HT.PHY==1 ;PHYSICAL TABS
HT.SIM==2 ;SOFTWARE-SIMULATED TABS
X VTM,INT ;VERTICAL TAB MODELING
VT.PHY==1 ;HARDWARE VT
VT.SIM==2 ;SOFTWARE SIMULATION OF VT
VT.MAP==3 ;TURN INTO FF AND HANDLE AS PER .CCFFM
X FFM,INT ;FORM FEED MODELING
FF.PHY==1 ;HARDWARE FF
FF.SIM==2 ;SOFTWARE-SIMULATED FF
.CMXFL==XX ;MAXIMUM FOR FOUNDATION LOGICAL
XX==.CTCMH_8 ;BEGIN MODE-HANDLER CHARACTERISTICS
X IGN,BOL ;IGNORE INPUT
X CAT,CCA ;CHARACTER ATTRIBUTES
X COP,BOL ;CONTROL-O PASSTHROUGH
X RAI,BOL ;RAISE INPUT
X ECH,BOL ;NORMAL ECHO
X IER,BOL ;INPUT ESCAPE-SEQUENCE RECOGNITION
X OER,BOL ;OUTPUT ESCAPE-SEQUENCE RECOGNITION
X CNT,INT ;INPUT-COUNT MESSAGE STATE
CN.NON==1 ;NEVER SEND INPUT-STATE MESSAGES
CN.NRD==2 ;SEND INPUT-STATE ONLY IF NO READ OUTSTANDING
CN.ALL==3 ;ALWAYS SEND INPUT-STATE MESSAGES
X APE,BOL ;AUTO-PROMPT ENABLED
X EPM,BYT ;ERROR-PROCESSING MASK
EP%LBK==B0 ;LINE BREAK PROCESSING
EP%FRM==B1 ;FRAMING ERROR PROCESSING
EP%PAR==B2 ;PARITY ERROR PROCESSING
EP%OVR==B3 ;RECEIVER OVERRUN PROCESSING
.CMXMH==XX ;MAXIMUM FOR CTERM MODE HANDLER
;Define the flag bits that form the MASK and BITS fields of .CCCAT
CA.OOB==B0!B1 ;OUT-OF-BAND TYPE
.OBNOT==0 ;NOT O-O-B AT ALL
.OBCLR==1 ;IMMEDIATE CLEAR
.OBDFR==2 ;DEFERRED CLEAR
.OBHEL==3 ;IMMEDIATE HELLO
CA.INC==B2 ;INCLUDE FLAG FOR .OBHEL
CA.SDO==B3 ;SETS DISCARD-OUTPUT IF ON & OOB
CA.ECH==B4!B5 ;ECHO FORM (FOR CONTROL CHARACTERS)
CA.SLF==B4 ;ECHO AS SELF
CA.STD==B5 ;ECHO IN STANDARD FORM
;(CA.STD HAPPENS BEFORE CA.SLF)
CA.ENB==B6 ;ENABLE ANY SPECIAL FUNCTIONS IT MIGHT HAVE
CA.MSK==CA.ENB!CA.ECH!CA.SDO!CA.INC!CA.OOB ;SETTABLE BITS
;Define the flags field for a start-read message
SR.UND==B0!B1 ;UNDERFLOW HANDLING
.SRIGN==0 ;IGNORE UNDERFLOW
.SRBEL==1 ;RING BELL ON UNDERFLOW
.SRTRM==2 ;TERMINATE ON UNDERFLOW
SR.CTA==B2 ;CLEAR-TYPEAHEAD IF ON
SR.FMT==B3 ;DO FANCY CR/LF FORMATTING IF ON
SR.VPT==B4 ;TERMINATE ON VERTICAL POSITION CHANGE
SR.CON==B5 ;THIS IS A CONTINUATION READ
SR.RAI==B6!B7 ;RAISE-INPUT HANDLING
.SRUNS==0 ;UNSPECIFIED, USE CHARACTERISTIC
.SRSLC==1 ;SINGLE-READ ALLOW LOWER CASE
.SRSUC==2 ;SINGLE-READ FORCE UPPER CASE
SR.CCD==B8!B9!B10 ;CONTROL-CHARACTER DISABLE FIELD
.SRNON==0 ;NONE ARE DISABLED
.SRLIN==1 ;THE LINE CHARACTERS (^R & ^U) ARE DISABLED
.SREDI==2 ;THE EDITING CHARACTERS ARE DISABLED
.SRALL==3 ;ALL BUT XON/XOFF ARE DISABLED
SR.NEC==B11 ;NO-ECHO FOR THIS READ DESPITE CHARACTERISTIC
SR.ECT==B12 ;ECHO TERMINATORS
SR.TMR==B13 ;TIMER FIELD IS SPECIFIED
SR.TRM==B14!B15 ;TERMINATOR MASK SPECIFICATION
.SRUPT==0 ;USE PREVIOUSLY SPECIFIED MASK
.SRUNT==1 ;USE NEW TERMINATOR MASK (SUPPLIED)
.SRUUT==2 ;USE THE 'UNIVERSAL' TERMINATOR MASK
;(SECOND WORD--REALLY ONLY THIRD BYTE)
S2.IER==B0!B1 ;INPUT ESCAPE-SEQUENCE RECOGNITION
.SRUNS==0 ;UNSPECIFIED, USE CHARACTERISTIC
.SRSIE==1 ;SINGLE-READ IGNORE ESCAPES
.SRSRE==2 ;SINGLE-READ RECOGNIZE ESCAPES
S2.REF==B2 ;RESTRICTED (VMS) EDITING FUNCTIONS
S2.DCR==B3 ;DISABLE (VMS) COMMAND RECALL
;Define the flags for a Read-Data message
RD.TRM==NETBIT(0,3) ;TERMINATION REASON CODE
.RDTRM==0 ;TERMINATOR CHARACTER SEEN
.RDVES==1 ;VALID ESCAPE SEQUENCE
.RDIES==2 ;INVALID ESCAPE SEQUENCE
.RDOOB==3 ;OUT-OF-BAND CHARACTER
.RDIBF==4 ;INPUT BUFFER FULL
.RDTMO==5 ;TIMED-OUT
.RDUNR==6 ;UNREAD RECEIVED
.RDUND==7 ;DELETION UNDERFLOW
.RDTOK==10 ;ABSENTEE TOKEN
.RDVPC==11 ;VERTICAL POSITION CHANGE
.RDLBK==12 ;LINE BREAK ERROR (NOT DETECTED HERE)
.RDFRM==13 ;FRAMING ERROR (NOT DETECTED HERE)
.RDPAR==14 ;PARITY ERROR (NOT DETECTED HERE)
.RDOVR==15 ;RECEIVER OVERRUN (NOT DETECTED HERE)
RD.IIP==B4 ;INPUT IS PRESENT (INPUT-STATE PIGGYBACK)
;Define the bits that can be sent with a Write message
WR.LOK==B0!B1 ;THE LOCK/UNLOCK FIELD
.WRULK==0 ;UNLOCK AT START
.WRLOK==1 ;LOCK & LEAVE LOCKED
.WRLTU==2 ;LOCK AT START THEN UNLOCK AT END
.WRLUR==3 ;.WRLTU FOLLOWED BY REDISPLAY OF INPUT
WR.FMT==B2 ;DO FANCY CR/LF FORMATTING IF ON
WR.CDS==B3 ;CLEAR DISCARD STATE
WR.BOM==B4 ;THIS IS FIRST PART OF WRITE MESSAGE
WR.EOM==B5 ;THIS IS LOGICAL END OF WRITE MESSAGE
WR.PRE==B6!B7 ;PREFIX CHARACTER HANDLING
.WRIGN==0 ;IGNORE THE FIELD
.WRNLC==1 ;FIELD IS NEW-LINE COUNT
.WRCHR==2 ;FIELD IS A CHARACTER
WR.PST==B8!B9 ;POSTFIX CHARACTER HANDLING
;USES SAME VALUES AS WR.PRE
WR.VFY==B10 ;VERIFY BY SENDING A WRITE-COMPLETE WHEN DONE
WR.BIN==B11 ;BINARY (TRANSPARENT) WRITE OF CHARACTERS
;Define the flags that can be sent with a Write-Complete message
WC.DIS==B0 ;SOME OUTPUT WAS LOST DUE TO ^O
;Define the flags that can be sent with a Discard-State message
DS.CDS==B0 ;CLEAR DISCARD STATE IF ON, SET IF OFF
;Define the flags that can be sent with an input state message
IS.IIP==B0 ;INPUT IS NEWLY PRESENT IF ON, ABSENT IF OFF
;Define the flags that can be sent with an Out-of-Band message
OB.DIS==B0 ;SET DISCARD-OUTPUT STATE TRUE
;Define the flag bits that can be sent with an Unread message
UR.OIE==B0 ;WHEN LIT, ONLY CANCEL THE READ IF THERE ARE NO
; CHARACTERS AVAILABLE (AT ALL)
;Helper macro to build byte strings to send over the network
DEFINE BYTSTR (PFX,BYTES),<
IFNB<BYTES>,<
IFDEF PFX'S,<CONCAT PFX'S,<,>>
IFNDEF PFX'S,<
CCLEAR PFX'S
CONCAT PFX'S,<BYTE (8)>
PFX'LEN==0
>
CONCAT PFX'S,<BYTES>
IRP BYTES,<PFX'LEN==PFX'LEN+1>
>
IFB<BYTES>,<
PFX'S
PURGE PFX'S
>>;END DEFINE BYTSTR
;Define macro to build the Parameters portion of our Protocol Initiate message
DEFINE CPI(NAM,VAL),<
BYTSTR(CPI,.PI'NAM)
...CPI==<VAL>
..CPI==0
REPEAT 5,<;;VALUE MUST FIT IN A WORD, AFTER ALL
IFN ...CPI,<
..CPI==..CPI+1
...CPI==...CPI_-8>
>
BYTSTR(CPI,\..CPI)
...CPI==<VAL>
REPEAT ..CPI,<
BYTSTR(CPI,\...CPI)
...CPI==...CPI_-8
>
> ;END DEFINE CPI
SUBTTL Protocol dispatch macros
DEFINE DSPGEN(RTY,PFX,LST),<
..DSP==0
IRP LST,<IFN PFX'LST&^O377-..DSP,<
PRINTX ? DISPATCH OUT OF ORDER: RTY'LST (PFX'LST)>
IF2,<IFNDEF RTY'LST,<RTY'LST==NOTYET>>
IFIW RTY'LST
..DSP==..DSP+1>
>
DEFINE ERRDSP(RTY,LST),<IRP LST,<RTY'LST==CPOPJ>>
SUBTTL PSI system macros
; The PSIS macro defines all conditions for which we will enable
;to receive interrupts via the PSI system.
;
;The arguments to the PSI macro are:
; COND - the xxx of .PCxxx to process
; ISR/VEC - xxx of xxxVEC and xxxPSI for processing
; LEV - the level at which the interrupt is processed
; BITS - the reasons and/or control bits for the condition
.PCTTY==$TTY ;TTY condition is really the TT: I/O channel
DEFINE PSIS,<
PSI NSP,DCN
PSI TMR,TMR
PSI DAT,DAT,2
PSI OOB,OOB,1
PSI TTY,TTY,1,PS.RID!PS.ROD!PS.REF!PS.RIA
PSI STP,STP,3,PS.VPM
PSI UEJ,STP,3
PSI XEJ,STP,3
PSI TLE,STP,3
PSI IUU,IUU,2
PSI IMR,STP,3
PSI WAK,WAK
>
DEFINE PSIVEC,<
DEFINE PSI(COND,ISR,LVL<0>,BITS<0>),<
IFNDEF ISR'VEC,<ISR'VEC:>
IFE ISR'VEC-.,<ISR'VEC: EXP ISR'PSI,0,<<BITS>&<-1,,0>>,0>
>
PSIS
>
DEFINE PSIRSY,<
DEFINE PSI(COND,ISR,LVL<0>,BITS<0>),<
PSY'COND: EXP .PC'COND
XWD ISR'VEC-VECBAS,<<BITS>&<0,,-1>>
XWD <LVL>,0
>
PSIS
>
DEFINE GGVPIL<
TXNE F,F$PION
Z .+1
>
SUBTTL Start the Program
; This section contains the first part of the initialization logic.
;It first sets up basic defaults and flags that this is the first time
;through (sets variable RSTFLG to -1). It then enters RESTRT, which is
;where the program restarts itself if fatal errors occur or the user
;attempts to continue the program from a non-continuable state. RESTRT
;(the label where restarting begins) sets up the pushdown list and reads
;the user's SWITCH.INI file (if present), resetting any defaults to
;those values. If restarting, we then go to label PROMPT for the short
;dialogue, otherwise we attempt to rescan the line and either take arguments
;from the rescanned line if successful or go to LPROMPT for the long
;dialogue if not. If the rescan is successful, we call
;INITDB to initialize NRT's database here and proceed directly to CHKPMR to
;attempt to set up the connection.
GO: JFCL ;Ignore CCL entry
SETOM RSTFLG ;Use long dialogue if necessary
RESTRT: MOVE P,[IOWD PDLLEN,PDL] ;Set up A Stack
SETZ F,
PUSHJ P,INITDB ;Setup database
PUSHJ P,TTYOPN ;Setup the TTY database
PUSHJ P,SWTINI ;Read SWITCH.INI
AOSE RSTFLG ;If restarting
JRST PROMPT ;Use short dialogue
RESCAN 1 ;Rescan the command line
PUSHJ P,DORSCN ;Go process the RESCAN line
JRST LPROMPT ;Error or no node name
JRST CHKPMR ;Note that T2 still has first node name
SUBTTL LPROMPT - Long Dialogue
; Routine LPROMPT is resposible for the long dialogue. Upon
;displaying the current "escape character" (which may be the assembled
;default or the default as obtained from the user's SWITCH.INI) and
;accepting a new one (if requested to by the user by typing a character
;other than <CR> to the question), we proceed to fall into the short
;dialogue (routine PROMPT).
LPROMPT:
OUTSTR [ASCIZ /DECnet Intersystem Remote Terminal service/]
LPR0: OUTSTR [ASCIZ /
Switch sequence (/]
PUSHJ P,TYPSSQ ;Type the switch sequence pair
OUTSTR [ASCIZ/): /]
LPR1: INCHRW T1 ;Get new character
CAIN T1,.CHCRT ;Carriage Return?
JRST LPR1 ;Get the LF
CAIN T1,.CHLFD ;Line feed?
JRST LPR2 ;Yes, don't change it
INCHRW T2 ;Get the second character
CAIN T2,.CHCRT ;Carriage Return?
INCHRW 1(P) ;Yes, eat the LF
CAMN T1,T2 ;Must be distinct
ERR ISS,<Invalid switch sequence>,<LPR0>
MOVEM T1,CC.SW1 ;Save the first character
MOVEM T2,CC.SW2 ;And the second
LPR2: PUSHJ P,CMPESC ;Compute mask for interrupt level
LPROM1: TYPCRLF ;Be friendly
FALL PROMPT ;Put out the normal prompt
SUBTTL PROMPT - Short initialization dialogue
; Routine PROMPT handles the short initialization dialogue. Note that
;the short dialogue is a subset of the long dialogue (which falls into here).
;After requesting the desired remote host's name from the user and inputting
;it, we fall into CHKPMR which establishes the connection. Note that we also
;initialize NRT's data base here.
PROMPT: TYPE <Node Name: >
PRM2: PUSHJ P,SIXINW ;Get node name user wants
CAIN T1,.CHCNZ ;User want out?
JRST NSPER1 ;OK to continue
JUMPE T2,PROMPT ;Ignore null node name
FALL CHKPMR
SUBTTL Check for Poor Man's Routing in User's String
; We enter this section from a number of points; most obviously by
;falling in from the short dialogue. However, we come here with the
;data base initialize and all values for escape character and
;initial node name set up. We check for Poor Man's Routing here;
;if the user specified it we go and parse the string before
;establishing the connection, otherwise we just establish the connection.
;We cue on the user having actually specified a double colon
;as the key to whether he specified PMR or not. The special case
;of the user specifying a double colon followed by a <CR> is checked
;for at DOPMR if FTPMR is turned off so that we don't bomb out
;the user on this special case. This routine is entered
;with T2 containing the name of the first remote node.
CHKPMR: MOVEM T2,RNODE ;Save first node
SETZ P1, ;Remember that it's the first
CAIE T1,":" ;Is it a ":"?
JRST CHKSWT ;No, it's not PMR
INCHSL T1 ;Yes, get a character
IFN FTEPMR,<
ERR EDC,<Expecting double colon in PMR string>
>
IFE FTEPMR,<
ERR EDC,<Expecting double colon at end of node name>
>
;Not PMR if no more characters
CAIE T1,":" ;Second colon?
XCT EDC ;No, but just one is still wrong
FALL DOPMR ;Fall into appropriate PMR routine
SUBTTL DOPMR - Subroutine to do the Poor mans routine string
; Routine DOPMR is fallen into when CHKPMR decides that the
;user may have specified Poor Man's routing. If NRT has been assembled with
;FTPMR turned off, we check for the special case of the user
;typing a double colon followed by a carriage return. If this is the
;case, we proceed with the connection; if not we output an error
;message and exit.
;FTPMR is turned on, we parse the node names in the string and
;store them as sixbit values, one to a word, in the table starting
;at location RNODE. After parsing the string, we proceed to BLDPMR to actually
;build the string to send to the remote PSTHRU task.
DOPMR:
IFE FTEPMR,<
INCHSL T1
JRST DOCONN ;Nope
CAIN T1,.CHCRT ;<CR>?
JRST DOCONN ;Yes, then do the connect
CAIN T1,"/" ;Starting a switch?
JRST CHKSWT ;Yes, go parse switches
CLRBFI ;Clear the input buffer
ERR NPM,<Version not compiled with Poor Man's Routing>
> ;End IFE FTEPMR
IFN FTEPMR,<
MOVE P1,[-<MAXPMR-1>,,1] ;Already have first node
PMRL1: SKPINL ;Anything inputable?
SOJA P1,CHKSWT ;Index
PUSHJ P,SIXIN ;Get the next name
JUMPE T2,.-2 ;If really nothing
MOVEM T2,RNODE(P1) ;Store the first one
CAIG T1," " ;Printing?
JRST CHKSWT ;No, must be done
CAIN T1,"/" ;Time for a switch?
JRST CHKSWT ;Yes, go get it
CAIE T1,":" ;Correct break?
XCT EDC
INCHSL T1 ;Get character
XCT EDC ;Oops
CAIE T1,":"
XCT EDC ;Oops again
AOBJN P1,PMRL1
ERR TMN,<Too many nodes in PMR string>
> ;End IFN FTEPMR
SUBTTL CHKSWT - Parse command-line switches
CHKSWT: PUSHJ P,CHKSWW ;Skip possible whitespace
CAIE T1,"/" ;Want to read a switch?
JRST CHKSWE ;No, must test for EOL
PUSHJ P,SIXIN ;Yes, get the switch name
DMOVE P2,T1 ;Save name & delimiter
MOVE T1,[-CSWL,,CSWA] ;AOBJN pointer to keyword table
PUSHJ P,.LKNAM ;Find name in table
ERR UKS,<Unknown switch >,CHKSWB
PUSHJ P,@CSWP(T1) ;Call its processor
MOVE T1,P2 ;Restore delimiter
JRST CHKSWT ;Loop over all switches present
NAMTAB CSW,<CTERM,NRT,OLD> ;The switch table
CSWP: IFIW CSWNEW ;Process only the new object type
IFIW CSWOLD ;Do only the old type
IFIW CSWOLD ;Alternate name for old object
CSWOLD: SETZM OBJCNT ;Pretend we already tried the new one
CSWNEW: SETOM OBJFRC ;Note that we got a switch
POPJ P, ;Return for more switches
CHKSWW: CAIE T1,.CHTAB ;A tab?
CAIN T1," " ;Or a space?
INCHSL T1 ;And another character?
POPJ P, ;No, done skipping blanks
JRST CHKSWW ;Yes, loop over whitespace
CHKSWB: TSIX P3 ;Type the junky switch
JRST NSPER1 ;Then die
CHKSWE: CAIL T1," " ;Better approximate an EOL now
ERR JFC,<Junk following command>
FALL BLDPMR
SUBTTL BLDPMR - Builds the PMR string
; Routine BLDPMR translates the node string which was parsed by
;DOPMR and stored as SIXBIT nodes in the RNODE table into an eight-bit
;ASCII string suitable for sending to the first node's PSTHRU task.
;It is entered from DOPMR only with P1 containing the maximum index
;into the RNODE table at which a node name was stored. This is
;equivalent to the number of nodes in the string minus one.
IFE FTEPMR,<BLDPMR:! FALL DOCONN>
IFN FTEPMR,<
BLDPMR: HRRZM P1,NODCNT ;Store
MOVE T1,RNODE(P1) ;Get final node in chain
MOVEM T1,LNODE ;Save to get at it easily
MOVE P1,[POINT 8,PMRMSG] ;Get the PMR message
SETZ P3, ;Clear out a count
MOVEI T1,1 ;Start of PMR
AOS P3 ;Increment number of bytes
IDPB T1,P1 ;Put it into the string
MOVE P2,[POINT 6,RNODE+1] ;Get the pointer
BLD0: MOVEI T3,^D6 ;Six character maximum
BLD1: ILDB T1,P2 ;Get a byte from the node list
JUMPE T1,EATBLD ;Eat the rest and finish this one
BLD11: MOVEI T1," "(T1) ;Make it ASCII
AOS P3 ;Increment byte count
IDPB T1,P1 ;Store it
SOJG T3,BLD1 ;Loop for all of them
BLD2: MOVEI T1,":" ;Get the break
IDPB T1,P1
IDPB T1,P1 ;"::"
ADDI P3,2 ;Increment byte count by 2
BLD3: MOVEI T3,^D6 ;Get the number left
ILDB T1,P2 ;Get the first character
JUMPE T1,ENDPMR ;End of the string
JRST BLD11 ;Loop around to store this one too
EATBLD: SOJLE T3,BLD2 ;Put the break
ILDB T1,P2 ;Get the next byte
JRST EATBLD ;End check
ENDPMO: MOVE P1,SAVPMR ;Get string pointer
MOVE P3,SAVPMC ;And the count
MOVE P2,[POINT 7,[ASCIZ |"23="|]] ;The old-style ending string
FALL ENDPM1 ;Try this one, instead
ENDPM1: ILDB T1,P2 ;Get the byte
JUMPE T1,CPOPJ ;Do the connect if done
IDPB T1,P1 ;Put it into the string
AOS P3 ;Increment the byte count
JRST ENDPM1 ;Loop around
ENDPMR: MOVEM P1,SAVPMR ;Save string pointer
MOVEM P3,SAVPMC ;And the count
MOVE P2,[POINT 7,[ASCIZ |"42="|]] ;Get the ending string
PUSHJ P,ENDPM1 ;Store the rest
MOVEM P3,PMRMSG-1 ;Save the count
FALL DOCONN
> ;End IFN FTEPMR
SUBTTL DOCONN - Initiatiate a DECnet connection
; We enter here with all of NRT's data base set up to do final
;initialization and initiate the connection to the remote system.
;We first OPEN device TT: and initialize the core manager.
;We check to see if the user is attempting to connect
;to the same node on which he is running; if so we issue a warning before
;proceeding. We set up the network I/O buffers and call CONECT to initiate
;the connection to the remote node. After a [successful] return from
;CONECT, we read the configuration message. We add all the appropriate
;things the software interrupt system, set up ^C trapping through .JBINT
;(we actually trap on any job error or control-C; although the terminal
;is slaved one can use a FRCUUO function of .HALT to force the program
;to trap in case it gets stuck; this is useful for debugging purposes).
;We then use the information from the remote host's configuration message
;(in particular the operating system type) to set the
;addresses of the operating system specific network and TTY: routines.
;We then call the operating system specific initialization routine
;and call FRCTTY to get things started.
DOCONN: SETZM FRELST ;Clear free core pointer
MOVX T2,<DN.FLE!<.DNLNN,,.DNNMS+1>>
MOVEM T2,NODBLK+.DNFFL
MOVEI T2,NODBLK ;Get the argument pointer
DNET. T2, ;Do the UUO
JRST DOCN1 ;Do the connect anyway
MOVE T2,LNODE ;Get last node
CAME T2,NODBLK+.DNNMS ;Is it this node?
JRST DOCN1 ;No, no warning
OUTSTR [ASCIZ |
%Already at node |] ;Give a message
PUSHJ P,TNODE1 ;Type it out
OUTSTR [ASCIZ | - Proceeding with connection anyway.
|]
DOCN1: PUSHJ P,INIOBF ;INITIALIZE THE FAKE BUFFERS
PUSHJ P,CONECT ;SET UP THE CONNECTION
OPTTY: MOVEI T1,REENTR ;Get routine to handle
MOVEM T1,.JBREN ;Save it
PUSHJ P,GETCFG ;Get the configuration stuff
PUSHJ P,@OSINI ;Call initialization routine
PUSHJ P,SETTTY ;Slave the TTY:
PUSHJ P,TTYSST ;Set TTY: up
MOVEI T1,.TOCIB
MOVE CX,[2,,T1]
MOVE T2,TTYUDX
TRMOP. CX,
JFCL ;Try to make PIM happy
MOVEI T1,PSIRST ;Point to PSI init block
TXO F,F$PION ;Note this for GGVPIL
PIRST. T1, ;Set up a complete PSI vector
ERR CIP,<Can't initialize PSI system>
MOVE NSAFN,[.NSFPI,,.NSAA1+1] ;Now set psi mask
MOVEI NSAA1,(NS.NDA!NS.STA!NS.NDR) ;Just tell me when things can be read
MOVEI T1,NSAFN
NSP. T1,
ERR NPI,<NSP. UUO to set PSI mask failed>
PUSHJ P,FRCTTI ;Wake us up
FALL MAIN
SUBTTL MAIN - Main wait loop for all systems
; The MAIN loop is simply a HIBER UUO. We expect to be woken by
;PSI interrupts when any events of any significance occur.
; The exception to this is a break mask change. This most
;often occurs at network interrupt level. Unfortunately, if type-ahead
;in the input buffer does not satisfy the current break mask, but the break
;mask is then changed so that the existing type-ahead now fulfils the
;current break mask, the monitor does not grant a PSI interrupt. Therefore,
;NRT traps for WAKE UUOs as well as any other conditions and WAKEs itself
;and sets F$USRV (via a call to FRCTTY) if it wishes to force a TTY: interrupt.
;MAIN always returns to sleep if woken.
MAIN: MOVSI T1,(HB.RWJ) ;Defend against others
HIBER T1, ;OR UNTIL SOMETHING HAPPENS
JFCL
JRST MAIN ;Go look for more to do
SUBTTL FRCTTY - Force a look at the TTY:
; As mentioned above, since changing the break mask doesn't
;cause a PSI interrupt if input is done, we need to wake ourselves
;and set F$USRV. Routine FRCTTY is called to do this, or any
;other time we wish to act as if a TTY: service PSI occured. Enter
;at label FRCTTI to be sure PS.RID gets set in TTYSTS, or call
;FRCTTO to be sure PS.ROD gets set in TTYSTS. It uses T1.
FRCTTO: SKIPA T1,[PS.ROD]
FRCTTI: MOVEI T1,PS.RID
IORM T1,TTYSTS ;Set the bit
FRCTTY: TXOE F,F$USRV ;Set flag
POPJ P, ;Already done
SETO T1, ;Wake ourselves
WAKE T1, ;..
TXZ F,F$USRV ;Oops
POPJ P, ;Return
SUBTTL OSJMP - Dispatch table for systems
; The PRTTAB table uses the PTDSP MACRO to define the transfer
;vectors for each type of protocol.
PRTTAB: PTDSP <CTM,PIM,VMS,RSX,RST>
PRTTBL==.-PRTTAB
SUBTTL Initialization subroutines -- Initialize the Data Base
; The INITDB subroutine is called at initialization time to
;initializae the low segment data base.
;It is also this routine's responsiblity to intialize the software
;interrupt system. It sets up the AC sets and pushdown
;lists for the interrupt level routines. It turns off control-C trapping
;(in case this was a restart) so that the user can easily exit
;at this time. It figures the bit mask position and word for the
;escape character so that it can be added easily to any break mask
;at interrupt level. It destroys only AC CX.
INITDB: PUSHJ P,SAVT ;Save everything
SETZM TIBUF ;So won't try to reset
RESET ;Clear the world now
SETZ F, ;Nothing going on just yet
SETZM OSTMR ;No timer stuff yet
STORE T1,FSTZER,LSTZER,0 ;Clear out the zeroable low segment
MOVE T1,[HILOST,,LOLOST] ;Setup Nonzero stuff in loseg
BLT T1,LOLOND ;
; MOVEI T1,.NSDOB+1 ;Get the length of a PDB
; MOVEM T1,DSTPDB+.NSDFL ;Store it
; SETZM DSTPDB+.NSDFM ;This is the format type
PUSHJ P,CMPESC ;Compute escape bit and mask
SETZM .JBREN ;Tell REENTER its not OK to REENTER
MOVE T1,[IOWD PDLLEN,TTYPDL] ;TTY: PDL pointer
MOVEM T1,TTYACS+P ;Set up all interrupt stacks
MOVE T1,[IOWD PDLLEN,OOBPDL] ;OOB PDL pointer
MOVEM T1,OOBACS+P
MOVE T1,[IOWD PDLLEN,NSPPDL] ;NSP pointer
MOVEM T1,NSPACS+P
MOVE T1,[IOWD PDLLEN,TMRPDL]
MOVEM T1,TMRACS+P
GETPPN T1, ;READ OUR PPN
JFCL ;JACCT SHOULD BE CLEAR, BUT ...
MOVEM T1,QUEPPN ;SAVE FOR UGMAP$ FUNCTION
MOVE T1,[QMPLEN,,QUEBLK] ;POINT TO QUEUE. UUO BLOCK
QUEUE. T1, ;OBTAIN OUR USERNAME
JRST INITD1 ;GIVE UP IF NOT THERE
TXNN T1,QU.RBR ;DID WE GET OUR RESPONSE?
JRST INITD1 ;NO, SKIP THIS
MOVE T1,[POINT 8,UNMBLK+1] ;START OF NAME
SETZ T2, ;NAME LENGTH
ILDB T3,T1 ;GET NEXT NAME CHARACTER
SKIPE T3 ;UNLESS DONE,
AOJA T2,.-2 ;SCAN NEXT CHARACTER
JUMPE T2,INITD1 ;IGNORE NULL NAMES
;[316] CAILE T2,^D16 ;Within DECnet limit?
;[316] MOVEI T2,^D16 ;No, enforce limit
CAILE T2,^D12 ;[316] Within VMS limit?
MOVEI T2,^D12 ;[316] No, enforce limit
HRLM T2,SRCNAM ;SETUP AS BYTE COUNT FOR SOURCE NAME
MOVE T1,[UNMBLK+1,,SRCNAM+1] ;TRANSFER VECTOR
BLT T1,SRCNAM+^D39/4+1 ;COPY NAME BLOCK
MOVE T1,UNMBLK ;[323] Get our PPN again
TLNN T1,^-WRDMSK ;[323] If it exceeds 16 bits
TRNE T1,^-WRDMSK ;[323] in either half
JRST INITD1 ;[323] Then we can't use it
MOVEM T1,SRCPDB+.NSDPP ;[323] Store in our PDB
MOVEI T1,2 ;[323] Format type for UIC+name
MOVEM T1,SRCPDB+.NSDFM ;[323] Tell DECnet to user our PPN
INITD1: MOVE T1,['NRTNSP'] ;Logical name for tracing
DEVNAM T1, ;See if it exists
POPJ P, ;No
JUMPE T1,CPOPJ ;Still no
MOVE T1,[.FOLEB+1,,TRACEF] ;Yes, setup for FILOP.
FILOP. T1, ;Try to write the file
JRST [RELEAS $NSP, ;Close the channel (just in case)
POPJ P,] ;Return
SETOM FTRACE ;We're tracing
POPJ P, ;Done
SUBTTL Initialization subroutines -- Process RESCAN Input
; The DORSCN routine parses input as RESCANed from the command line.
;NRT may be run with a variety of command forms; this is so that those
;used to different conventions may find it easy to HOST out to another system.
;The exact commands which may be used are defined with the NAMTAB MACRO.
NAMTAB LIST1,<SET,RUN,START,NRT,CTHNRT,HOST,TO,DEAR,CONNEC,CN> ;FIRST TOKEN
NAMTAB LIST2,<HOSTESS> ;AFTER "SET"
DORSCN: SAVE1 ;Save P1
PUSHJ P,SIXIN ;Get SIXBIT Token From INCHRL
JUMPE T2,DORSCE ;If Nothing There, Error Return
MOVE P1,T1 ;Save Delimiter in P1
MOVE T1,[-LIST1L,,LIST1A]
PUSHJ P,.LKNAM ;See If T2 Holds One of these names
JRST DORSCE ;No, Eat rest of line
JRST @[ DORSC1 ;"SET"
DORSC2 ;"RUN"
DORSC2 ;"START"
DORSC3 ;"NRT"
DORSC3 ;"CTHNRT"
DORSC3 ;"HOST"
DORSC3 ;"TO"
DORSC3 ;"DEAR"
DORSC3 ;"CONNECT"
DORSC3](T1) ;"CN"
;Here if the first token was "SET", delimiter in P1
DORSC1: PUSHJ P,SIXIN ;Get "HOSTESS"
JUMPE T2,DORSCE ;No?
MOVE P1,T1 ;Save delimiter for DORSCE
MOVE T1,[-LIST2L,,LIST2A]
PUSHJ P,.LKNAM ;Is it HOSTESS or Some Abbrev?
JRST DORSCE ;No
JRST DORSC3 ;Yes, Get node name now
;Here if the first token was "RUN", delimiter in P1
DORSC2: CAIE P1,"-" ;Was Program name defaulted
CAIN P1,"(" ;with Either - OR (?
JRST DORSC3 ;Yes, Go get Node name
CAIGE P1," " ;If control
JRST DORSCE ;Error return
PUSHJ P,SIXIN ;No, get program name
MOVE P1,T1 ;Get delimiter again (For DORSCE Too)
JUMPE T2,DORSCE ;Error return if None
JRST DORSC2 ;Ignore node name, try again for delimiter
;Here if the next token is the node name we're after
DORSC3: PUSHJ P,SIXIN ;Get node name
MOVE P1,T1 ;SAVE DELIMITER FOR DORSCE
JUMPN T2,CPOPJ1 ;SUCCESS RETURN IF NAME IS THERE
FALL DORSCE ;NONE, ERROR RETURN
;Here if we had an error in the RESCAN, eat rest of line & return
DORSCE: MOVE T1,P1 ;SET UP FOR DORSE1
DORSE1: CAIE T1,.CHLFD ;CRLF YET?
CAIN T1,.CHESC ;OR ESCAPE?
POPJ P, ;Yes, error return now
INCHSL T1
POPJ P, ;Return now if no more chars to read
JRST DORSE1 ;LOOP UNTIL EOL
SUBTTL FNDFNC - Find function routine
; The FNDFNC routine is provided to dispatch to an address based
;on a value which must not be consecutive. It is called with the table's
;base address in P1 and the value to match on in T1. The format of the
;table it uses is:
; TABLE: value,,address
; value,,address
; .
; .
; .
; 0
;It returns CPOPJ if the function was not found or CPOPJ1 (after
;dispatching) if it was.
FNDFNC: SKIPN CX,(P1) ;Anything?
POPJ P, ;Yes, then give unsupported return
CAIE T1,(CX) ;Are they the same?
AOJA P1,FNDFNC ;Loop for all of them
HLRZS CX
PUSHJ P,(CX) ;Go handle it
JFCL ;Skip return is possible but not error
JRST CPOPJ1 ;And skip return when done
SUBTTL NETCHR - Output a stream of network data to TTY
; The NETCHR routine is used by the TOPS-10 and TOPS-20 network
;service. It takes all characters from the network input buffer
;and outputs then on the TTY:. It also calls RECRSP to record
;response times if the user is running a performance analysis experiment.
;It exits through DOOUT1 to force out the last buffer to the TTY:.
;It uses T1, CX, and the NSP. ACs. NETCHR will grant a TTY: interrupt
;via TTYPS1 if it notices F$USRV is on.
NETCHR: PUSHJ P,NETICH ;Read 1 byte from remote
PJRST DOOUT1 ;Finish up
TXZE F,F$USRV ;Want an interrupt?
PUSHJ P,TTYPS1 ;Grant a TTY: interrupt
TXNN F,F$CTO ;If supposed to flush
PUSHJ P,OUTTTY ;Output character to TTY
JRST NETCHR ;Go see if there are more chars
SUBTTL Exit Routines -- MONITO (Exit Dialogue)
; MONITO is responsible for handling the exit dialogue. It uses
;all T ACs and CX. It is called by the operating system dependent
;TTY: service routine when the user types the break character. It outputs
;the appropriate exit dialogue based on the setting of the user's /MODE
;switch (which translates into flag F$XPT and location NOTICH: F$XPT only is
;non-zero for /MODE:EXPERT and both F$XPT and NOTICH are non-zero for
;/MODE:NOTIFY, and both are zero for /MODE:NOVICE).
;In the case of the "M[onitor]/(CONTINue,REENTEr)", "P[ass]", "O[bscure]",
;"R[econnect]", or "C[hange]" commands, MONITO returns to the caller
;with the escape character in T1. For the "P[ass]" command,
;MONITO returns CPOPJ1 to flag to the caller
;to pass the escape character through to the remote host. For the other
;commands, MONITO returns CPOPJ to inform the caller to proceed as
;if the escape character had not been typed. It is, however, the
;caller's responsibility to remove the break character from any internal
;input stream if that is applicable.
; MONITO has an additional entry point, MONITC, which can be used
;to pass the command character (assuming expert or notify modes) which
;will be "input" to the command parser. The character is passed in T3
;or is passed as zero if there is none.
MONITO: SETZ T3, ;No character input
MONITC: GGVPIL ;Turn off the PI
PUSH P,T3 ;Save character, if any
PUSHJ P,TTYRST ;Reset the TTY
POP P,T3 ;Restore character
TXNN F,F$XPT ;Expert mode?
JRST MONIT0 ;Below only for experts
SETO T1, ;Controlling TTY:
GETLCH T1 ;Get TTY: characteristics
TXO T1,GL.NEC ;Turn off echo
SETLCH T1 ;..
JRST EXCT0 ;Skip typeout
MONIT0: TYPE <
[Connection broken, Back at node > ;Type out the header
MOVE T2,NODBLK+.DNNMS ;Get the sixbit local node name
PUSHJ P,TNODE1 ;Type out the node name
TYPE <::]> ;Type this out
EXCOPT: TXNN F,F$XPT ;Want message?
OUTSTR [ASCIZ/
NRT_EXIT> /] ;Yes
EXCT0: SKIPE T1,NOTICH ;Want notification?
OUTSTR (T1) ;Output the string
EXCT1: TXNE F,F$XPT ;Expert?
SKIPA T2,[INCHRW T1] ;Yes
SKIPA T2,[INCHWL T1] ;No
SKIPN T1,T3 ;If any character
XCT T2 ;Get the character
CAIN T1,.CHCRT ;Have a CRLF?
INCHSL 1(P) ;Eat LF
CAIGE T1," " ;Printing?
JRST NSPER1 ;No, exit
EXCT2:
CAIL T1,"a" ;Lower case?
SUBI T1,"a"-"A" ;Make it UC
EXCOP1: MOVEI T2,-<" "-' '>(T1) ;Convert to SIXBIT
LSH T2,5*6 ;Left justify
TXNE F,F$XPT ;No eats in expert mode
JRST EXCOP2 ;No eats nor SIXIN
PUSHJ P,SIXINA ;Input token
EXCOPX: CAIE T1,.CHCRT ;CR?
CAILE T1," " ;Noise?
INCHSL T1 ;Must eat more
JRST EXCOP2 ;No more to eat
JRST EXCOPX ;Continue
EXCOP2: MOVE T1,[-EXITL,,EXITA] ;Exit function table
PUSHJ P,.LKNAM ;Lookup
JRST EXCP2A ;Not found
SKIPL T1,EXITDS(T1) ;Change status? Get entry.
TXNN F,F$XPT ;Expert mode?
JRST (T1) ;Don't bother if no-echo anyway
SETO T3, ;Controlling TTY:
GETLCH T3
TXZ T3,GL.NEC
SETLCH T3
JRST (T1) ;Dispatch
EXCP2A: TXNN F,F$XPT ;Expert?
OUTSTR [ASCIZ/
%Illegal command, type "H"<CR> for Help/]
TXNE F,F$XPT ;Give some feedback even to experts
IONEOUT [.CHBEL] ;But don't mess up their screens
SETZ T3, ;No rescans this time
JRST EXCOPT ;Ask again
SUBTTL Exit Routines -- Dispatch Table
; This set of tables associates the exit routine keywords with
;the appropriate dispatch vectors. It is assembled to be scanned
;via .LKNAM. The dispatch vectors table entries consist of the
;address of the routine in the right half, and the sign bit in the
;left half iff the routine does not want the echo mode changed
;before execution of the actual command (the echo mode may have
;been explicitly turned off due to the setting of F$XPT).
NAMTAB EXIT,<EXIT,REENTER,CHANGE,MONITOR,HELP,OBSCURE>
EXITDS: NSPER1 ;Exit
G0 ;Reenter
REENTR ;Change
EXCOP3 ;Monitor
400000,,EXCHLP ;Help
FLUSH ;Flush network messages
IFN .-EXITDS-EXITL,<
PRINTX %Wrong number of EXIT functions
>
SUBTTL Exit Routines -- Help Routine
; This routine outputs the appropriate help text ("H[elp]" command)
;and re-enters the exit dialogue.
EXCHLP:
OUTSTR [ASCIZ |
E - To exit to monitor and close the current link.
H - To type this text.
M - To Exit to monitor and leave link open.
R - To reconnect to remote system|]
MOVEI T1,PT%PIM ;PIM protocol flag
TDNE T1,PRTUSD ;Using PIM protocol?
OUTSTR [ASCIZ |
O - To flush network output (TOPS-10/TOPS-20 only).|] ;Yes, give its
OUTSTR [ASCIZ |
C - To change switch sequence and continue.|] ;End of text message
TXNE F,F$XPT
TYPCRLF ;Look pretty
SETZ T3, ;No character already read
JRST EXCOPT ;And back to the question
SUBTTL Exit Routines -- Flush Network Messages
; FLUSH is called to flush network messages ("O[bscure]" command;
;TOPS-10/20 only). This is in lieu of ^O working "correctly" for TOPS-10/20
;connections.
FLUSH: MOVEI T1,PT%PIM ;Must be in PIM protocol
TDNN T1,PRTUSD ;Are we?
JRST EXCP2A ;No, toss it
DOFLSH: PUSHJ P,CLRTOQ ;Clear the TO queue etc.
MOVEI T1,PIM.TM ;Set the routine
MOVEM T1,OSTMR ;..
TXO F,F$CTO ;Set flag
MOVEI T4,[ASCIZ/[^O]
/]
MOVE T1,[3,,T2]
MOVEI T2,.TOOUS
MOVE T3,TTYUDX
TRMOP. T1,
JFCL ;In case I/O mode was different
PUSHJ P,PIM.TM ;Boot it up
PJRST G0 ;And reconnect
SUBTTL Exit Routines -- Return to Monitor
; EXCOP3 is used to return to monitor level ("M[onitor]" command).
EXCOP3: OUTSTR [ASCIZ |
[Type POP to resume connection]
|]
XMOVEI T1,CTXBLK ;Point to our context block
CTX. T1, ;Push
TRNA ;Analyze errors
JRST EXCOP4 ;Fix it up
TXNE T1,CT.ETX ;Did the UUO give us error text?
JRST [OUTSTR [ASCIZ |
? PUSH error: |]
OUTSTR CTXBUF
TYPCRLF
JRST EXCOP4] ;Yes, use it
TYPE <
? PUSH failed
>
EXCOP4: CLRBFI ;Eat junk
FALL G0 ;Continue the session
SUBTTL Continue Remote Session
; This section is entered when the user wishes to continue
;the program from the exit dialogue. Enter at label G0 with F$PERF set
;appropriately for entering performance analysis mode. Enter at GX
;to pass the break character through to the host (i.e. to give skip
;return to the caller). This routine outputs the necessary messages
;and returns to the caller (of MONITO) with T1 containing the escape
;character.
G0:
G1: TXNE F,F$XPT ;Expert mode?
JRST G3 ;Return
MOVEI T1,[ASCIZ/
[Reconnected to /]
G2: OUTSTR (T1)
MOVE T3,OSTYPE ;Type it out right
OUTSTR @OSNAME(T3) ;Type out the operating system
TYPE < system >
MOVE T2,LNODE ;Get the last node name
PUSHJ P,TNODE1 ;And type that out
TYPE <::]> ;And the close
TYPCRLF
G3: PJOB T1, ;Get current job
MOVNS T1 ;For JOBSTS
JOBSTS T1, ;Get word
SETZ T1,
SKIPL TTYUDX ;Detached?
TLNN T1,(JB.UML) ;No, at monitor level?
JRST G4 ;Detached or at user level, proceed
SETZ T1,
OUTCHR T1 ;(We couldn't have reset PIM yet)
CLRBFI ;Make PIM happy
G4: SETSTS $TTY,@TTYBLK ;TTYSST will do this, but could get
;confused if we were in PIM and output
;can get garbled.
PUSHJ P,SETTTY ;Slave TTY:
PUSHJ P,TTYSST ;Reset TTY: status
TXNE F,F$PIM
POPJ P, ;No ^O if PIM
TXZ F,F$ICO
PJRST SETCTO ;Set ^O and return
SUBTTL REENTR - REENTR code
; This section is entered when the user wishes to change the escape
;character. This is if the user either enters the "C[hange]" command
;to the exit dialogue or REENTErs after a "M[onitor]" command to the
;exit dialogue. We output the correct prompt here. We exit with
;the new escape character set to label G0. If the escape character is changed,
;we compute the new bit mask and word position here.
REENTR: OUTSTR [ASCIZ /Enter new switch sequence: /]
INCHRW T1 ;Get new character
INCHRW T2 ;And the second
CAIN T2,.CHCRT ;CR at end?
INCHRW 1(P) ;Yes, eat the LF
CAIE T2,.CHLFD
TYPCRLF
JUMPE T1,REENTR ;Start over if <NUL>
CAIN T1,.CHCRT ;Carriage Return?
JRST REENT1 ;Yes, leave it alone
CAMN T1,T2 ;Must be distinct
ERR BSS,<Bad switch sequence>,<REENTR>
MOVEM T1,CC.SW1 ;Store escape character
MOVEM T2,CC.SW2 ;And the second
PUSHJ P,CMPESC
REENT1: TYPCRLF ;Yes, Add a CRLF
PUSHJ P,TYPESC ;Say what the escape is
JRST G0 ;Continue where ^C interrupted
SUBTTL NETICH - Get a network character from the network buffer
; NETICH is called to get one character (returned in T1) from the
;network. It returns CPOPJ1 with the character if there is one. If there
;are no remaining characters, the action taken depends on the setting of
;F$NEOM (F$NEOM is cleared regardless of which action is taken). If
;F$NEOM was clear, we take the error return (CPOPJ). If F$NEOM was set,
;we call NSPIN which will dismiss any interrupt we are in until data
;is actually available, at which point it will return to us with the new
;buffer.
GETBYT:!
NETICH: SOSGE IBFCNT ;Any characters left in the buffer?
JRST ENDBUF ;No, then check for end of message set
ILDB T1,IBFPTR ;Get a character
JRST CPOPJ1 ;And skip return
ENDBUF: TXZN F,F$NEOM ;Did we have End of Message?
POPJ P, ;Yes, then just return
PUSHJ P,NSPIN ;No, then get the next buffer
JRST NSPERR ;Error return for NSP.
JRST NETICH ;And continue on as before
SUBTTL RBYTEC - Get a byte from the network
; RBYTEC is called to input one character from the network and stop
;if none is available. It calls NETICH and stops with a UED stopcode
;if NETICH takes the error return.
GETBYS:!
RBYTEC: PUSHJ P,NETICH ;Read byte with end an error
ERR UED,<Unexpected end to network data>
POPJ P, ;Return
SUBTTL GETBYZ - Get a byte from the network
; GETBYZ is called to input one character from the network and
;return zero if none is available. It calls NETICH and returns zero if
;NETICH takes the error return.
GETBYZ: PUSHJ P,NETICH ;Read a byte
SETZ T1, ;End gets zero-padded
POPJ P, ;Return
SUBTTL CONECT - Routine to set up the connection
; CONECT is called at initialization time to set up a connection
;to the remote host. It will first call SETNOD to set up the node name
;to connect to in the destination process descriptor block. It will
;call NSPEA to decide whether to enter object .OBHTH or .OBPST and do
;the NSP. UUO to perform the enter active function. It will then send
;the PMR string by exitting through SNDPMR if that is required.
CONERR: SKIPN OBJFRC ;Are we allowed to scan for alternate?
AOSE OBJCNT ;Doing the first type?
JRST NSPERR ;No, die
IFN FTEPMR,<
PUSHJ P,ENDPMO ;Set up alternate PMR string
>
FALL CONECT ;Try it again
CONECT: PUSHJ P,SETNOD ;SET UP THE NODE NAME IN THE DEST PDB
PUSHJ P,NSPEA ;DO THE ENTER ACTIVE
JRST CONERR ;DEAL WITH THE ERROR
IFN FTEPMR,<
SKIPG NODCNT ;Doing PMR?
> ;End IFN FTEPMR
POPJ P, ;No
IFN FTEPMR,<
FALL SNDPMR
>
SUBTTL SNDPMR - Send the PMR string to the remote system
; SNDPMR is entered from CONECT if a PMR string must be sent.
;The PMR message has already been assembled by DOPMR at location PMRMSG.
IFN FTEPMR,<
SNDPMR: MOVE NSAFN,[NS.WAI!NS.EOM!<.NSFDS,,.NSAA2+1>]
MOVE NSAA1,PMRCNT
MOVE NSAA2,[POINT 8,PMRMSG,]
MOVEI T1,NSAFN
NSP. T1,
ERR CSP,<Can't send PMR string>
POPJ P,
> ;End IFN FTEPMR
SUBTTL Error Routines -- SETNER - Set up NSPECD with error code
; SETNER is called with a NSP. UUO error code in T1 to store it
;for later analysis by the NSPERR routine.
SETNER: MOVEM T1,NSPECD ;Store NSP. error code for NSPERR
POPJ P, ;Only return
SUBTTL Error Routines -- NSPERR - Give an NSP. error message
; NSPERR is called when any NSP. UUO error code is encountered. The
;code has been previously stored in location NSPECD, probably by the SETNER
;routine. If the current state of the connection in DR, we output the
;message "[Connection to remote node aborted]"; otherwise we output a
;standard DECnet error message with the numeric code of the error. The
;program is exitted and set up to not continue.
NSPERR:
PUSH P,NSAFN ;Save the current function
PUSHJ P,WATDEQ ;Wait for output to quiet down
MOVE NSAFN,[NS.WAI!<.NSFRS,,.NSACH+1>]
MOVEI T1,NSAFN
NSP. T1,
JFCL
LDB T1,[POINT 6,NSACH,^L<NS.STA>+5]
CAIN T1,.NSSDR ;State Disconnect Received?
JRST [OUTSTR [ASCIZ/
[Connection to remote node aborted]/] ;Output nice message instead
JRST NSPER1] ;Finish nicely
POP P,NSAFN ;Restore the failing function now
MOVE T1,NSPECD ;Get the error code
IFN FTEPMR!FTIPMR,<
JUMPE T1,NSPER1 ;If PMR, assume zero is routing failure
>
OUTSTR [ASCIZ/
?NRT/]
IMULI T1,2 ;prefix & text
OUTSTR @NSPERC(T1) ;Output the refix
LDB T1,[POINTR(NSAFN,NS.AFN)] ;GET FUNCTION CODE FROM ARGS
CAILE T1,FCNTBL ;OFFSET OK?
MOVEI T1,0 ;NO, CALL IT ILLEGAL
MOVE T2,[-1,,.GTWCH] ;Get the watch bits for this job
GETTAB T2, ;Do the GETTAB
SETZ T2, ;Default
TXNN T2,JW.WMS ;Any set?
TXO T2,JW.WFL!JW.WPR ;No, set default
TXNN T2,<JW.WCN!JW.WFL> ;Prefix only?
JRST NSPER1 ;Yes, finished with error message
OUTSTR [ASCIZ | Network |] ;Make it sound bad
OUTSTR @FCNTAB(T1) ;Output the text
OUTSTR [ASCIZ | failure |] ;And the failure part
MOVE T1,NSPECD ;GET ERROR CODE SET UP BY SETNER
IMULI T1,2 ;allow for prefix
CAIG T1,MAXERR ;DO WE KNOW THIS ERROR CODE?
SKIPA T1,NSPERC(T1) ;GET THE POINTER TO THE ERROR TEXT
MOVEI T1,[ASCIZ/Out of range/]-1
OUTSTR 1(T1) ;GIVE THE ERROR CODE
IFN FTFUNCTION,<
OUTSTR [ASCIZ /, function /]
LDB T1,[POINTR(NSAFN,NS.AFN)] ;GET FUNCTION CODE FROM ARGS
CAILE T1,FCNTBL ;OFFSET OK?
MOVEI T1,0 ;NO, CALL IT ILLEGAL
MOVE T1,FCNTAB(T1) ;GET PTR TO ASCIZ STRING
OUTSTR (T1) ;OUTPUT THE STRING
>;END OF IFN FTFUNCTION
TYPCRLF
NSPER1: PUSHJ P,TTYRST ;Be sure the TTY: gets unslaved
SETZM .JBREN ;Tell REENTER its not OK to REENTER
CLRBFI ;Clear out his input buffer in case of type ahead
PJOB T1, ;Get the job number
MOVNS T1 ;Set up for JOBSTS
JOBSTS T1, ;Do the JOBSTS
JRST TYPDOT ;Then type out a DOT
TXNN T1,JB.ULI ;Is job logged in?
TYPDOT: OUTSTR [ASCIZ |
.|] ;Type out the dot
SETZM TIBUF ;Be sure we don't reset again.
SKIPE FTRACE ;If tracing,
RELEAS $NSP, ;Close the file
RELEAS $TTY, ;See if this fixes the terminal well enough
RESET ;Clear the world
TXZ F,F$PION ;Make sure we know we did the reset
MONRT. ;Polite return to monitor
JRST RESTRT ;Restart on CONTINUE
SUBTTL Error Routines -- Protocol error messages
; PROERR is called when something fundamental went wrong. Its
;purpose is to tell the remote that we're aborting the session.
PROERR: AOSE PRCERF ;ONLY TYPE THIS ONCE
PJRST NSPER1 ;GIVE UP IF CALLED TWICE
; SKIPE CCOLIM ;IF PARTIAL CTERM BUFFER,
; PUSHJ P,CCOFIN ;FLUSH IT
; NOP ;ALWAYS SKIPS
PUSHJ P,FNDFIN ;MAKE SURE WE HAVE A BUFFER
MOVEI T1,.FMUNB ;UNBIND MESSAGE
NETOCH T1 ;MESSAGE TYPE
MOVEI T1,.UBPED ;UNBIND REASON: PROTOCOL ERROR DETECTED
CALL PUTINT ;STUFF INTO MESSAGE
PUSHJ P,NSPOUT ;TRY TO SEND IT
NOP ;IGNORE ERRORS HERE
PJRST NSPER1 ;NOW DIE
SUBTTL Error Routines -- DOERR - Output an error message
; DOERR is called via the ERR MACRO. Its purpose is to output the
;text and prefix part of the message. DOERR is responsible for observing
;the user's verbosity bit settings. It is called with text of the error
;at (P)+1 and the prefix at (P)+2. The program cannot be continued.
DOERR: ASSUME P,17 ;P must be last for code to work
MOVEM P,ERRACS+P
MOVEI P,ERRACS
BLT P,ERRACS+P-1 ;Save error ACs
MOVE P,ERRACS+P ;Restore old P
MOVE T1,(P) ;Get return address
HRR T1,-1(T1) ;Get pointer to arg block
OUTSTR [ASCIZ |
?|]
HRROI T2,.GTWCH ;Watch bits arg
GETTAB T2, ;Ask the monitor
SETO T2, ;Assume all
TXNN T2,JW.WMS ;Any set?
TXO T2,JW.WFL!JW.WPR ;No, set a default
TXNE T2,JW.WPR ;Want to see the prefix?
OUTSTR @1(T1) ;Yes, output the text
OUTCHR [" "] ;Output a space
TXNE T2,<JW.WCN!JW.WFL> ;Prefix only?
OUTSTR @2(T1) ;and the message
TYPCRLF
HRRI T1,3(T1) ;Point to return instruction
SKIPE (T1) ;If useful,
MOVEM T1,(P) ;Set a new return address
DMOVE T1,ERRACS+T1 ;Restore ACs used
POPJ P, ;Return to finish up
SUBTTL NSPERC - NSP. Error message table
; The NSPERC table uses the ERRMAC MACRO to assemble a table
;of text and prefixes for standard DECnet error codes.
NSPERC: ERRMAC 0,UEC,<Unknown Error Code>
ERRMAC NSABE%,ABE,<Argument Block Format Error>
ERRMAC NSALF%,ALF,<Allocation failure>
ERRMAC NSBCN%,BCN,<Bad channel number>
ERRMAC NSBFT%,BFT,<Bad format type in process block>
ERRMAC NSCFE%,CBE,<Connect Block format error>
ERRMAC NSIDL%,IDL,<Interrupt data too long>
ERRMAC NSIFM%,IFM,<Illegal flow control mode>
ERRMAC NSILF%,ILF,<Illegal function>
ERRMAC NSJQX%,JQE,<Job quota exhausted>
ERRMAC NSLQX%,LQE,<Link quota exhausted>
ERRMAC NSNCD%,NCD,<No connect data to read>
ERRMAC NSPIO%,POB,<Percentage input out of bounds>
ERRMAC NSPRV%,NEP,<No Privileges to Perform Function>
ERRMAC NSSTB%,OBS,<Obsolete>
ERRMAC NSUKN%,UNN,<Unknown node name>
ERRMAC NSUXS%,UNS,<Unexpected State: Unspecified>
ERRMAC NSWNA%,WNA,<Wrong number of arguments>
ERRMAC NSWRS%,FWS,<Function called in wrong state>
;New error codes (to be re-ordered):
ERRMAC NSCBL%,CBL,<Connect block length error>
ERRMAC NSPBL%,PBL,<Process block length error>
ERRMAC NSSBL%,SBL,<String block length error>
ERRMAC NSUDS%,DSN,<Unexpected State: Disconnect Sent>
ERRMAC NSUDC%,DCN,<Remote node not accepting connects>
ERRMAC NSUCF%,RNR,<Remote node not responding>
ERRMAC NSULK%,RBL,<Remote Node broke link to local node>
ERRMAC NSUCM%,NNR,<Network Node not currently reachable>
ERRMAC NSUNR%,RSR,<Remote system out of resources>
;Error codes which correspond to DECnet disconnect codes.
ERRMAC NSRBO%,RTR,<Remote terminal server rejected connection>
ERRMAC NSDBO%,RTB,<Remote terminal server broke link>
ERRMAC NSRES%,NRR,<No Resources at Remote Node>
ERRMAC NSUNN%,UNN,<Unrecognized Node Name>
ERRMAC NSRNS%,RNS,<Remote Node Shut Down>
ERRMAC NSURO%,NRT,<No remote terminal server at node>
ERRMAC NSIOF%,ION,<Invalid Object Name Format>
ERRMAC NSOTB%,OTB,<Object Too Busy>
ERRMAC NSABM%,NMA,<Network Management aborted connection>
ERRMAC NSABO%,RTA,<Remote terminal server aborted connection>
ERRMAC NSINF%,INN,<Invalid Node Name Format>
ERRMAC NSLNS%,LNS,<Local Node Shut Down>
ERRMAC NSACR%,SPR,<System Password rejected>
ERRMAC NSNRO%,RTO,<Remote Terminal server did not reply in time>
ERRMAC NSNUR%,NNR,<Node Unreachable>
ERRMAC NSNLK%,NLN,<No Link>
ERRMAC NSDSC%,DCM,<Disconnect Complete>
ERRMAC NSIMG%,IFL,<Image Field Too Long>
ERRMAC NSREJ%,URR,<Unspecified Reject Reason>
ERRMAC NSBCF%,BCF,<Bad combination of NS.EOM & NS.WAI flags>
ERRMAC NSADE%,ADE,<Address Error>
MAXERR==.-NSPERC-1
SUBTTL FCNTAB - NSP. function text table
; FCNTAB is the table of text descriptions of each function
;to the NSP. UUO. Its primary purpose is for the typeout of
;functions if NRT is assembled with FTFUNCTION turned on; however,
;the maximum offset is also considered to be the maximum NSP. function
;we should be doing and is used as a legality check in the error routines.
FCNTAB: FCNMAC 0, <Illegal function code>
FCNMAC .NSFEA,<Connection>
FCNMAC .NSFEP,<Enter Passive>
FCNMAC .NSFRI,<Connection>
FCNMAC .NSFAC,<Accept Connect>
FCNMAC .NSFRJ,<Reject Connect>
FCNMAC .NSFRC,<Connection>
FCNMAC .NSFSD,<Synchronous Disconnect>
FCNMAC .NSFAB,<Abort>
FCNMAC .NSFRD,<Read Disconnect Data>
FCNMAC .NSFRL,<Release Channel>
FCNMAC .NSFRS,<Read Channel Status>
FCNMAC .NSFIS,<Send Interrupt Data>
FCNMAC .NSFIR,<Receive Interrupt Data>
FCNMAC .NSFDS,<Send>
FCNMAC .NSFDR,<Receive>
FCNMAC .NSFSQ,<Set Quotas>
FCNMAC .NSFRQ,<Read Quotas>
FCNMAC .NSFJS,<Set Job Quotas>
FCNMAC .NSFJR,<Read Job Quotas>
FCNMAC .NSFPI,<Set PSI Reasons>
FCNTBL==.-FCNTAB
SUBTTL XMTMSG - Transmit network message
; These routines are called to send output to the network.
;XMTMSG is called with T1 pointing to a message block which consists
;of the number of bytes in the message located in the first word, followed
;by the message. XMTMSS is used to force out current network output.
;XMTMSS merely calls NSPOUT and stopcodes on any error.
XMTMSG: SKIPN P4,(T1) ;Get char count
POPJ P,
HRLI T1,(POINT 8,,35) ;8-BIT BYTES
XMTMS1: ILDB P3,T1 ;get
NETOCH P3 ;Output a network character
SOJG P4,XMTMS1 ;Copy it
XMTMSS: PUSHJ P,NSPOUT ;SEND OUT THE BUFFER
JRST [PUSHJ P,NSPERR ;Report the error
JRST XMTMSS] ;..
POPJ P,
XMTMSQ: MOVEI T1,4*OBUFSZ
SUB T1,OBFCTR ;Do anything?
JUMPN T1,XMTMSS ;Yes, force it out
POPJ P,
SUBTTL TTYOPN - Routine to OPEN the TTY
; TTYOPN is called to open device TT:. This is normally the same as
;device TTY:, except it can be reassigned away to another terminal to
;aid debugging. Note that the feature of hitting the break twice
;can have inconsistent results if TT: is assigned to a terminal other than
;TTY:. We remember the UDX of the terminal here in the variable
;TTYUDX and the UDX position in various other TRMOP. blocks.
;The TTY: is OPENed in ASCII line mode with asynchronous I/O.
;The TTY: is added to the sofware interrupt system at this point.
;We also save the TTY: characteristics specified in table TTYSAV here.
;We also read the TTY: baud rate here so we can do the fancy
;segment size and quotas/goals code later for those systems which want it.
;Finally, we read the type of TTY: this is and save it for any
;fancy configuration messages which may have to be sent (e.g. VMS).
TTYOPN: MOVE T1,[BMASK,,IMASK] ;Set up default break mask
BLT T1,ENDMSK ;Set default mask up
MOVE T1,[BMASK+1,,LMASK] ;Set the logical mask too
BLT T1,ELMASK
MOVE T1,[UU.AIO!IO.ABS!.IOAS8] ;Set line mode
MOVEM T1,TTYBLK
SETO T2, ;Ourselves
TRMNO. T2, ;Get controlling TTY:
SETO T2,
MOVEM T2,CTLTTY ;In case different from I/O TTY:
MOVE T2,TTYBLK+.OPDEV ;Get device
IONDX. T2,
SETO T2,
MOVEM T2,TTYUDX
MOVEM T2,SWTUDX ;For switch sequence
MOVEM T2,HPSUDX ;For horizontal position
MOVEM T2,LEDUDX ;For checking line editing stuff
MOVEM T2,LEDCUX ;Ditto
MOVEM T2,CATUDX ;For character attributes
MOVEM T2,ECCUDX ;For checking echo count
MOVEM T2,BKCUDX ;Count of break characters
MOVEM T2,CTOUDX ;For checking ^O bit
MOVEM T2,COSUDX ;For setting ^O
MOVEM T2,BINUDX ;For writing binary characters
MOVEM T2,PAGUDX ;For checking the page bit
MOVE T1,T2 ;Copy device code
DEVCHR T1, ;Check it out
TXNN T1,DV.DSK ;Beware of NUL:
TXNN T1,DV.TTY ;Better be a terminal
ERR DNT,<Device TT: is not a TTY>
TXNN T1,1_.IOAS8 ;Can it do eight-bit?
JRST OLDNRT ;No, must use the old NRT
OPEN $TTY,TTYBLK ;Open the TTY:
ERR ODT,<OPEN of device TT: failed>
INBUF $TTY,1 ;One input buffer
OUTBUF $TTY,10 ;Get the buffers
MOVEI T1,TTYBLK ;Point to the block
DEVSIZ T1, ;...
ERR DSF,<DEVSIZ for device TTY: failed>
MOVEI T1,-3(T1) ;Subtract header
HLL T1,TOBFH+.BFPTR ;Left half of pointer
MOVEM T1,BUFCHR ;Save the characteristics
SOJ T1, ;Last word of a buffer
HRLI T1,T2 ;Indexed by T2
MOVEM T1,LASTT2 ;Save it
MOVEI T1,1(T1) ;Increment back, clear left half
LSH T1,2 ;Convert word-count to character-count
MOVEM T1,CHPBUF ;Characters per buffer
MOVSI T4,-TSVNUM ;Read TTY: characteristics
TSVLP: HRRZ T1,TTYSAV(T4) ;Get characteristic
MOVE CX,[2,,T1]
TRMOP. CX,
SETZ CX,
HRLM CX,TTYSAV(T4)
AOBJN T4,TSVLP
;The below are done separately so we won't try to reset them later.
MOVE CX,[2,,T1] ;Find receive speed so can...
MOVEI T1,.TOTSP ;Set the seg size
TRMOP. CX,
SETZ CX, ;Assume max
MOVEM CX,TTBAUD ;Save it
MOVE CX,[2,,T1]
MOVEI T1,.TOTRM ;Get the TTY: type
TRMOP. CX,
SETZ CX,
MOVE T1,[-TTHLEN,,TTHOFS] ;Pointer to type table
TTYPLP: CAME CX,TTPTB(T1) ;This type?
AOBJN T1,TTYPLP
SKIPL T1 ;If actually found one
SETO T1,
HRREM T1,TTYTYP ;Save the index
MOVEI T1,.TOSWI+.TOSET ;Set the switch sequence
SETO T3, ;To the default
MOVE CX,[3,,T1] ;Arg block pointer
TRMOP. CX, ;Do it
NOP ;Should never fail
MOVEI T1,.TOSWI ;Read it back
MOVE CX,[2,,T1] ;Read pointer
TRMOP. CX, ;Find out what the default is
MOVX CX,<BYTE(8).CHCBS,.CHCRT> ;Make an assumption
MOVEM CX,SWTSEQ ;Save for later
MOVE CX,[POINT 8,SWTSEQ] ;Point to the default
ILDB T1,CX ;Get first character
MOVEM T1,CC.SW1 ;Save first part
ILDB T1,CX ;Get the next
MOVEM T1,CC.SW2 ;Save it, too
MOVEI T1,IO.ABS ;Break-set bit
ANDCAB T1,TTYBLK ;Clear it, get mode
SETSTS $TTY,(T1) ;Clear also in DDB (so have normal line mode)
POPJ P, ;Return with it set up
SUBTTL Routine to set desired TTY: characterstics
; SETTTY is called at initialization time to set any characteristics
;we desire to be set on the user's TTY:. The characteristics should have
;previously been saved. This routine is table driven through
;the TTYSET table.
SETTTY: MOVEI T4,TTYSET
CALL SETTT1 ;Set the items
SKIPE T4,OSSET ;O/S have a table?
PUSHJ P,SETTT1 ;Yes, inoke it too
POPJ P, ;No, just return
SETTT1: MOVE CX,[3,,T1]
MOVE T2,TTYUDX
TTSTLP: SKIPN T1,(T4) ;Get next item to set
POPJ P, ;Zero-terminated table
HLRE T3,T1
MOVEI T1,.TOSET(T1)
TRMOP. CX,
MOVE CX,[3,,T1]
AOJA T4,TTSTLP ;Loop over the table
SUBTTL Routine to reset the TTY: characteristics
; TTYRST is called upon returning to monitor level or executing
;the exit dialogue. It restores the characteristics saved in the
;TTYSAV table. Enter at TTYRS1 if only the TRMOP. characteristics are to
;be done and the TTY: is not to be set to normal ASCII line mode.
TTYRST: SKIPN TIBUF ;Anything set up?
POPJ P, ;No
SETSTS $TTY,.IOAS8 ;Set to a "normal" mode
TXZ F,F$CVL ;Clear all convert bits
TTYRS1: MOVEI T4,TTYSAV ;Point to table to use
PUSHJ P,SETTT1 ;Restore the values
PJRST CLRCO1 ;Undo ^O for now
SUBTTL TTY: Output and Echo Routines
; This section contains routines to output characters and strings
;to the TTY:
;STROUT accepts the address of an ASCIZ string in T4 and outputs the string
;to the TTY:. It uses T1 and T4.
STROUT: HRLI T4,(POINT 7,,)
STRLP: ILDB T1,T4 ;Get character
JUMPE T1,CPOPJ ;Done
PUSHJ P,OUTTTY ;Copy it
JRST STRLP ;Continue
OUTECH: SKIPE OSECH ;Any handler specified?
PJRST @OSECH ;Yes, use it
FALL OUTTTY ;No, just guess
;OUTTTY accepts a character in T1 to output to the TTY:. AC CX is used.
OUTTTY: SOSGE TOBUF+2 ;Any character space left?
JRST DOOUT ;No, Then output the current buffer
SAVE2 ;Preserve abused ACs
MOVEI P1,POSDSP ;Positioning table
PUSHJ P,FNDFNC ;Dispatch on it
TRNA ;Have to handle better
JRST OUTTT1 ;Done with preliminaries
TRNE T1,140 ;If a control character,
CAIN T1,.CHDEL ;or rubout,
JRST OUTTT1 ;Occupies no space
AOS HPOS ;Adjust if it does
OUTTT1: MOVE P1,HPOS ;Get new position
CAMG P1,CC.WID ;Past the end of the line?
JRST OUTTT2 ;No, don't care
MOVE P2,CC.WRP ;Get wrap value
CAIG P2,WP.NON ;Something that requires action?
JRST OUTTT2 ;No, we still don't care
CAIN P2,WP.TRC ;Truncating?
POPJ P, ;Yes, do so
CAIE P2,WP.PHY ;Hardware wrap?
JRST [PUSHJ P,OUTCRL ;No, software, so do it
JRST OUTTT2] ;Then send the character
SETZM HPOS ;Yes, just track
AOS VPOS ; the effects
OUTTT2: SKIPN P1,CC.LEN ;TTY's length
JRST OUTTT3 ;Skip overhead if not setup
CAMG P1,VPOS ;Wrapping?
SUBM P1,VPOS ;Yes, account for it
SKIPGE VPOS ;If wrapped,
MOVNS VPOS ;Keep positive
OUTTT3: IDPB T1,TOBUF+1 ;Output the buffer
SKIPE BADBOY ;If the bad boys,
SKIPE T1 ;Only store if non-null
MOVEM T1,LSTCHR ;This was the last one sent
POPJ P, ;And return to caller
DOOUT: AOS TOBUF+2 ;Not really -1 characters left
PUSHJ P,DOOUT1 ;Do the actual out
JRST OUTTTY ;And try again
;EKOBRK does break string echoing. Call with T4=AOBJN pointer to break table
;and T1 containing the break character to echo. Uses T1, T2, and T4.
EKOBRK: TXNE F,F$ESC ;Escape sequence processing?
PUSHJ P,ISESC ;And processing an escape?
TRNA ;No to one of the above
POPJ P, ;Done
HLRZ T2,(T4)
CAIE T2,(T1) ;The right character?
AOBJN T4,EKOBRK
JUMPL T4,EKOBR1 ;Found
TRNN T4,140 ;Printing?
POPJ P, ;No, ignore
PUSHJ P,OUTTTY ;Output character
JRST DOOUT1 ;Force out
EKOBR1: HRRZ T4,(T4) ;Point to echo string
PUSHJ P,STROUT ;Output the string
FALL DOOUT1 ;Fall into DOOUT1
;DOOUT1 is called to force out any remaining output to the TTY:
;The buffer is queued for output and we allocate a new one.
;We then fall into TOOUT to try to push data out to the TTY:.
;AC CX is used. Note that if location BUFQUO becomes zero or negative,
;DOOUT1 willcall TOBLOK to sleep until a buffer is available.
DOOUT1: PUSH P,T1 ;Save T1
SKIPN TOBUF ;Is there really one?
JRST TOQ5 ;No
MOVE T1,CHPBUF ;Get total number of available chars
SUB T1,TOBUF+2 ;Real number of characters
JUMPLE T1,TPOPJ ;Nothing to do
SOSGE BUFQUO ;Any more buffers left?
PUSHJ P,TOBLOK ;Wait for output to come back
IOR T1,TOFLGS ;Include the flag bits
HRLM T1,@TOBUF ;Store the count
TOQOUT: HRRI T1,TOQUE-TOB.LK ;Point to output queue
TOQ1: HRL T1,TOB.LK(T1) ;Get link
TLNN T1,-1 ;Another buffer?
JRST TOQ4 ;No
HLRZS T1 ;Point ahead
JRST TOQ1 ;Continue
TOQ4: HRL T1,TOBUF ;Get buffer pointer
HLRM T1,TOB.LK(T1) ;Link it in
TOQ5: HRRZ T1,BUFCHR ;Size of buffer
MOVEI T1,TOB.DT(T1) ;Include link word
PUSHJ P,CORGET ;Get core block
HLL T1,BUFCHR ;Header pointer
MOVEM T1,TOBUF+1 ;Pointer
HRRZM T1,TOBUF ;The buffer
MOVE T1,CHPBUF ;Number of characters per buf
MOVEM T1,TOBUF+2 ;Set it
POP P,T1 ;Restore T1
FALL TOOUT
;TOOUT is called either at interrupt level to try to output more data
;to the TTY:, or we fall into it from DOOUT1 to try to force out
;data. It dequeues TTY: buffers queued for output. AC CX used.
;If entered at TOOUTA, T1-T4 are used also.
TOOUT: PUSHJ P,SAVT ;Save T1-T4
TOOUTA: TXZN F,F$IEC ;Ignore ECC?
TXNE F,F$USRV!F$PIM!F$SYNC ;Already have input? or PIM?
JRST TOOUTB ;ECC not reliable then
MOVE T1,[2,,BKCTRM] ;Any break characters?
TRMOP. T1,
SETZ T1,
JUMPN T1,TOOUTB ;Yes, ignore ECC
MOVE T1,[2,,ECCTRM] ;Check the echo stream
TRMOP. T1, ;..
SETZ T1,
JUMPN T1,CPOPJ ;Don't start output if echo pending
TOOUTB: MOVEI T1,PS.ROD ;Going to service this now
ANDCAM T1,TTYSTS ;..
MOVEI T3,TOQUE ;Where to point
SKIPLE TOBFH+.BFCTR ;Any space?
JRST TOOUT1 ;Yes, go BLT in data
TOOUT0: SKIPGE TTYUDX ;Got detached?
PUSHJ P,DETWAT ;Wait
;Note there's a window here where you can get stuck
;if we get detached at exactly this point.
OUT $TTY, ;Do the output
TRNA ;Fine
JRST CHKERR ;See if got detached
TOOUT1: SKIPE T1,(T3) ;Anything to output?
TRNN T1,-1 ;Really anything?
POPJ P,
HLRE T2,TOB.CT(T1) ;Get count
ASSUME F$IOQ,<1B0>
JUMPGE F,TOOUT4 ;Don't worry about inhibit bit
TRNE T2,($TOOIN) ;Override?
JRST TOOUT4 ;Yes
MOVEI T3,(T1) ;Point ahead
JRST TOOUT1
TOOUT4: ANDI T2,($TOCNT) ;Preserve only count
HRLI T1,TOB.DT(T1) ;Point to data
HRR T1,TOBFH+.BFPTR ;Data area
IBP TOBFH+.BFPTR ;Normalize
SOJLE T2,NOADJ ;If nothing more to increment by
ADJBP T2,TOBFH+.BFPTR ;Increment the pointer
MOVEM T2,TOBFH+.BFPTR ;Store it
NOADJ: ASSUME TOB.DT,1
AOS T2,T1 ;Point to real area
BLT T1,@LASTT2 ;Move data
SETOM TOBFH+.BFCNT ;Set count to -1
HRRZ T1,(T3) ;Point to buffer
HRRZ T2,TOB.LK(T1) ;Link to next
HRRM T2,(T3) ;Point to it
HRRZ T2,BUFCHR ;Size of buffer
MOVEI T2,TOB.DT(T2) ;Increment
PUSHJ P,CORFRE ;Free the buffer
AOS BUFQUO ;Just freed a buffer
JRST TOOUT0 ;and try to output
CHKERR: GETSTS $TTY,T1 ;Get the status
TRNE T1,IO.ERR ;Any error bits?
ERR OTF,<OUT to TTY: failed>
TRNN T1,IO.EOF ;EOF?
POPJ P,
MOVEI T1,PS.REF ;Clear EOF pending
ANDCAM T1,TTYSTS
CLOSE $TTY, ;Clear the EOF
JRST TOOUT0 ;Try again
DETWAT: MOVEI T1,^D60 ;Time to sleep
PUSHJ P,TOHIBR
SKIPGE TTYUDX ;Still waiting?
JRST DETWAT ;Nope
POPJ P,
;CLRTOQ is called to clear all output in progress; both queued buffers
;and that currently being output. CLRTOQ does NOT clear buffers which
;have the $TOICL bit on in the buffer status word. CLRTOQ DOES
;do a Clear Output Buffer TRMOP. It uses nothing.
CLRTOQ: GGVPIL ;Since we're mucking with the queues
PUSHJ P,SAVT ;Save the Ts
MOVE T1,[2,,T2] ;Clear any output in progress
MOVEI T2,.TOCOB ;Clear output
MOVE T3,TTYUDX
TRMOP. T1,
JFCL
HRRZ T2,BUFCHR ;Size of output buffer
MOVEI T2,1(T2) ;Including link word
MOVEI T4,TOQUE-TOB.LK ;Start
MOVSI T3,($TOICL) ;Inhibit clearing
CLRTO1: SKIPE T1,TOB.LK(T4) ;Anything in queue?
TRNN T1,-1 ;Really one there?
POPJ P, ;Return if nothing
TDNE T3,TOB.FL(T1) ;Inhibit clear?
JRST CLRTO2 ;Yes
HRR T3,TOB.LK(T1) ;No, get link
HRRM T3,TOB.LK(T4) ;Link around it
HLLZS T3 ;Keep T3 pure
AOS BUFQUO ;Add another buffer
PUSHJ P,CORFRE
JRST CLRTO1 ;Continue
CLRTO2: MOVE T4,T1 ;New last chunk
JRST CLRTO1 ;Continue
POSDSP: POSHT,,.CHTAB
POSLF,,.CHLFD
POSCR,,.CHCRT
POSVT,,.CHVTB
POSFF,,.CHFFD
POSBS,,.CHCNH
Z
POSHT: MOVE P2,HPOS
ADDI P2,8
TRZ P2,7
MOVEM P2,HPOS
POPJ P,
POSLF: AOS VPOS
POPJ P,
POSBS: SOSGE HPOS
POSCR: SETZM HPOS
POPJ P,
POSVT: MOVE P1,VPOS
IDIVI P1,^D11
AOS P1
IMULI P1,^D11
CAML P1,CC.LEN
SETZ P1,
MOVEM P1,VPOS
POPJ P,
POSFF: SETZM VPOS
POPJ P,
SUBTTL Miscellaneous terminal routines
; OUTCRL is called to output a <CR><LF> to the TTY:
OUTCRL: PUSH P,T1 ;Save current character
MOVEI T1,.CHCRT ;Get a CR
PUSHJ P,OUTTTY ;Output to the TTY
MOVEI T1,.CHLFD ;Get a LFD
PUSHJ P,OUTTTY ;Output the LFD
POP P,T1 ;Restore character
POPJ P, ;And return to caller
SUBTTL TTY Input Routines -- INCHR - Get terminal character
; INCHR is called to get a character from the input buffer.
;The characters have actually already been input in the operating
;system independent interrupt service routine; we are here just
;taking them from our internal buffers. Returns CPOPJ1 with
;character in T1, or CPOPJ if there are no more. If a character
;has been stored in variable INPCHR, this is read instead. This
;is a method of forcing a character to be processed immediately.
;Note that ICHCNT is only an upper bound on the number
;of characters available; this is because SCNSER in reality returns
;a word count rather than a byte count. This routine uses T1-T2.
INCHR: SKIPE T1,INPCHR ;Leftover character to read?
JRST [SETZM INPCHR ;Yes. eat it
SOS ICHCNT ;Adjust ICHCNT
JRST CPOPJ1] ;and win
INCHR0: PUSHJ P,TTYCHR ;Get character from TTY:
POPJ P, ;None to read
ANDI T1,377 ;Mask to 8 bits
SKIPE CC.8BC ;Supposed to clear more?
ANDI T1,177 ;Yes, do so
INCHR1: JRST CPOPJ1 ;And return
TTYCHR:
SKIPE T1,INPQUE ;Anything in queue?
SOSGE ICHCNT ;Any characters left?
JRST NOCHRS ;None to input
TTYCH1: SOSGE IBF.CT(T1) ;Any more chars in this buffer?
JRST NEWIBF ;No, go to next
ILDB T1,IBF.PT(T1) ;Get character
JRST CPOPJ1 ;And return with it
NOCHRS: SKIPN T1,INPQUE ;Anything in queue?
POPJ P, ;No
HRRZ T2,IBF.LK(T1) ;This should be zero, but just in case
HRRZM T2,INPQUE
HLRE T2,IBF.LK(T1) ;Return it if so (should be only 1!)
PUSHJ P,CORFRE
JRST NOCHRS ;Check to be sure all deallocate
NEWIBF: PUSH P,T2 ;Save T2
HRRZ T2,IBF.LK(T1) ;Point to next entry
HRRZM T2,INPQUE ;Point to next
HLRE T2,IBF.LK(T1) ;Get size of this buffer
PUSHJ P,CORFRE ;Free the old buffer
HRRZ T1,INPQUE ;Clear left half, put in T1
POP P,T2 ;Restore T2
JUMPN T1,TTYCH1 ;Be defensive
POPJ P,
SUBTTL Output SIXBIT argument to controlling TTY:
; .TSIX is called by th TSIX MACRO. The MACRO pushes the argument
;onto the stack and calls .TSIX. No ACs are used.
.TSIX: EXCH T1,-1(P) ;Fetch argument
PUSH P,T2
.TSIXL: SETZ T2,
ROTC T1,6
MOVEI T2,<" "-' '>(T2)
OUTCHR T2
JUMPN T1,.TSIXL
POP P,T2
EXCH T1,-1(P)
POPJ P, ;Return
SUBTTL Node Name Output Routines
; These routines are used to output a single node (supplied in T2)
;and a list of nodes (for Poor Man's Routing; supplied from table RNODE),
;respectively. TNODE expects the node name in T2 and does not use an ACs;
;TNDLST uses CX and T2.
TNODE:
IFN FTEPMR,<
SKIPE NODCNT ;Doing PMR
JRST TNDLST ;Type the whole list
> ;End IFN FTEPMR
TNODE1: TSIX T2
POPJ P, ;Return
IFN FTEPMR,<
;< ;This is here so that MACRO will not get confused
TNDLST: OUTSTR [ASCIZ |, Routing => |] ;Tell him how he is getting there
SETZ CX, ;Clear out a flag
TNDL1: MOVE T2,RNODE(CX) ;Type it out
JUMPE T2,CPOPJ ;Return when done
TSIX T2 ;Type it out
SKIPE RNODE+1(CX) ;Anything left to type?
OUTSTR [ASCIZ |::|] ;Yes.
AOJA CX,TNDL1 ;Type out the whole list
> ;End IFN FTEPMR
SUBTTL SIXBIT Input
; These routines all input a SIXBIT value from the controlling
;TTY: in AC T2. They return with T3 trashed, T2 containing the SIXBIT
;value, and T1 containing the terminating character.
;SIXIN expects the input to be already waiting to be read from the monitor.
;SIXINW waits until a line is typed before beginning to input.
;SIXINA expects T2 to have been set up with the first character of the
;argument already. The argument is returned left-justified.
SIXINW: SETZ T2, ;Build target here
MOVE T3,[POINT 6,T2] ;Set up bp
SIXIN1: INCHWL T1 ;Get a character
CAIE T1," " ;Is it a space
CAIN T1," " ;or a tab?
JRST SIXIN1 ;Yes, ignore it
JRST SIXIN3 ;No, use it
SIXIN: SKIPA T3,[POINT 6,T2] ;Set up bp
SIXINA: SKIPA T3,[POINT 6,T2,5] ;First character already
TDZA T2,T2 ;Build target here
SETZ T1, ;In case no terminator
SIXIN0: INCHSL T1 ;Get a character
POPJ P, ;Nothing
JUMPN T2,SIXIN3 ;Don't bypass blanks in mid-word
CAIE T1," " ;Eat spaces and tabs
CAIN T1," " ;..
JRST SIXIN0
JRST SIXIN3
SIXIN2: INCHSL T1 ;Get next character
POPJ P, ;Thats all
SIXIN3: CAIL T1,"a" ;Make lowercase
CAILE T1,"z"
TRNA
TRZ T1,"a"-"A"
CAIL T1,"A" ;Alpha?
CAILE T1,"Z" ;.....?
TRNA ;No
JRST SIXIN4 ;Yes
CAIL T1,"0" ;Numeric?
CAILE T1,"9" ;...?
JRST SIXIN5 ;No, done
SIXIN4: MOVEI T1,-40(T1) ;Convert to sixbit
TRNN T2,77 ;Any room left
IDPB T1,T3 ;store
JRST SIXIN2 ;Get next...
SIXIN5: CAIN T1,.CHCRT ;<CR>?
INCHSL 1(P) ;Yes
JFCL
POPJ P,
SUBTTL Scanning Routines -- .LKNAM
; .LKNAM is called to search a command table for a match. It is called
;with T1 containing the AOBJN pointer to the defined commands table and T2
;containing the SIXBIT command name to search for. .LKNAM will allow
;abbreviation to uniqueness. It returns CPOPJ if the specified command is
;a duplicate or is not found in the table. It returns CPOPJ1 with the right
;half of T1 containing the offset from the beginning of the command table
;to the specified entry. The left half of T1 is returned as zero if the
;specified command word was an abbreviation or less than zero if it was
;an exact match. .LKNAM uses T3 and T4 but preserves T2.
.LKNAM: JUMPGE T1,[SETOM T1 ;FLAG UNKNOWN
POPJ P,] ;ERROR RETURN
SAVE2 ;SAVE P1, P2
PUSH P,T1 ;SAVE ARGUMENT
MOVE T3,T2 ;SET ARG TO MASK MAKER
PUSHJ P,.MKMSK ;MAKE MASK
MOVE T2,T3 ;RESTORE NAME
MOVE P1,T1 ;SAVE FOR MATCHING
MOVE T1,(P) ;Recover argument
SETOM P2 ;SET ABBREVIATION MATCH COUNTER
NAME1: MOVE T3,(T1) ;FETCH TABLE ENTRY
TLNE T3,(3B1) ;NOTE THAT * IS 12 IN SIXBIT
JRST NAME2 ;NOT FORCED MATCH
LSH T3,6 ;SEE IF IT MATCHES
XOR T3,T2 ;EVEN IN AN ABBR.
TRZ T3,77 ;CLEAR LAST CHAR SINCE WE DON'T KNOW IT
AND T3,P1 ;..
JUMPE T3,NAME9
JRST NAME3 ;NO--LOOP
NAME2: XOR T3,T2 ;SEE IF EXACT MATCH
JUMPE T3,NAME9 ;YES--A WINNER
AND T3,P1 ;SEE IF A SUITABLE ABBREVIATION
JUMPN T3,NAME3 ;NO--LOOP BACK FOR MORE
MOVE T4,T1 ;SALT AWAY THE LOCATION JUST IN CASE
AOS P2 ;YES--COUNT
NAME3: AOBJN T1,NAME1 ;ADVANCE--LOOP IF NOT DONE YET
HRRZ T1,T4 ;RESTORE LOCATION OF A WINNER
JUMPE P2,NAME9 ;DONE--JUMP IF ONE ABBREVIATION
MOVE T1,P2 ;GIVE FLAG TO CALLER
POP P,(P) ;Fix stack
POPJ P, ;NONE OR TWO, SO FAIL
NAME9: POP P,T3
HRRZS T3
SUBI T1,(T3) ;Make relative index
JRST CPOPJ1 ;And give good return
SUBTTL Scanning Routines -- .MKMSK
; Routine .MKMSK is called to make a mask (returned in T1) with
;"77" (octal) in word positions which are non-blank in the SIXBIT word
;specified in T3. It also uses T2.
.MKMSK: MOVEI T1,0 ;CLEAR MASK
MOVSI T2,(77B5) ;START AT LEFT END
MAKMS1: TDNE T3,T2 ;SEE IF SPACE HERE
IOR T1,T2 ;NO--IMPROVE MASK
LSH T2,-6 ;MOVE RIGHT ONE CHAR
JUMPN T2,MAKMS1 ;LOOP UNTIL DONE
POPJ P, ;RETURN
SUBTTL Memory manglement -- Core allocator
; CORGET is the allocation portion of the memory manager. It is
;called with T1 containing the size (in words) of the block desired. It
;exits CPOPJ with T1 containing the address of the obtained block. It will
;stopcode if the core is not available and the program cannot expand.
;CORGET preserves all ACs except T1.
CORGET:
GGVPIL ;Turn off PSI
IFN FTPARANOID,<
JUMPLE T1,[ERR ICA,<Illegal core allocation>]
>
PUSH P,T2 ;Save the world
PUSH P,T3
PUSH P,T4
SKIPN T2,FRELST ;Any blocks on the free list?
JRST CORG20 ;No, make the block
SETZB T3,T4 ;Not remembering any block
HRLI T2,FRELST ;Remember precessor
CORG1: PUSH P,(T2) ;Push size of block
HLRZS (P) ;Move to right half
CAMN T1,(P) ;Same size as we want?
JRST CORG7 ;Yes, allocate it
CAML T1,(P) ;Do we want smaller than this block?
JRST CORG6 ;No, don't remember it
JUMPE T3,CORG4 ;If not remembering anything, then this
CAMG T4,(P) ;Else is this closer to the size than previous remembered?
JRST CORG6 ;No, remember previous then
CORG4: MOVE T3,T2 ;Remember this block & its predecessor
MOVE T4,(P) ;And its size
CORG6: POP P,(P) ;Fix stack
HRLI T2,(T2) ;Remember precessor
HRR T2,(T2) ;Point to successor
TRNE T2,-1 ;If there is one
JRST CORG1 ;There is, check it out
JUMPE T3,CORG20 ;If didn't find anything
MOVE T2,T3 ;Point T2 to block we want
PUSH P,(T2) ;And push its size
HLRZS (P) ;on the right side
CORG7: CAMN T1,(P) ;Size the same as we want?
JRST CORG9 ;Yes, just de-link it then
PUSH P,(P) ;Duplicate size of desired block
SUBM T1,(P) ;No, subtract out what we want
MOVNS (P) ;Leaving size left
HRRZI T3,(T2) ;Start of the block as it is
ADDI T3,(T1) ;Where it will now start
POP P,(T3) ;Put new size in
MOVSS (T3) ;left half, of course
HRL T3,(T2) ;Get successor
HLRM T3,(T3) ;and place in new block
MOVSS T2 ;Point to predecessor
HRRM T3,(T2) ;Point it to new block
HRRZM T1,(P) ;Put desired size on
HLRZ T1,T2 ;Return with new block in T1
JRST CORG30 ;Cleared, of course
CORG9: HRRZI T1,(T2) ;Point T1 to desired block
HRRZ T3,(T2) ;Get successor
MOVSS T2 ;Get predecessor
HRRM T3,(T2) ;Link to new sucessor
JRST CORG30 ;Clear it and return
CORG20: PUSH P,T1 ;Save size
MOVE T2,.JBFF ;Point to first free location
ADDI T2,(T1) ;The address which must be allocated to
CAMLE T2,.JBREL ;Does that far exist?
JRST CORG23 ;No, go allocate it
MOVE T1,.JBFF ;Point to block
MOVEM T2,.JBFF ;Update first free
JRST CORG30 ;Clear and return
CORG23: MOVE T1,.JBFF ;Point to new block
MOVEM T2,.JBFF ;Store pointer to new
CORE T2, ;Get it
ERR CUF,<CORE UUO failed>
CORG30: EXCH T1,(P) ;Exchange size for address
HRRZ T2,(P) ;Make BLT pointer
HRLI T2,1(T2) ;..
SETZM (T2) ;Clear first location
SOJLE T1,CORG40 ;Skip the BLT if only one word
MOVSS T2
ADD T1,(P) ;Last location(+1)
BLT T2,(T1) ;Clear core
CORG40: POP P,T1
POP P,T4
POP P,T3
POP P,T2
POPJ P,
SUBTTL Memory manglement -- Core De-allocator
; CORFRE is the de-allocation portion of the memory manager. Enter
;it iwth T1 containing the address of the block to free and the absolute
;value of T2 containing the number of words to free. Blocks which are freed
;are placed on a linked list of free blocks for later re-use. Address space
;is never shrunk when core is de-allocated. CORFRE preserves all ACs but
;destroys the setting of F$P2.
CORFRE: GGVPIL
IFN FTPARANOID,<
CAILE T1,LSTZER ;Be sure core in reasonable place
SKIPN T2
ERR ICD,<Illegal core deallocation>
>
TLZ F,(F$P2) ;First pass
PUSHJ P,SAVT
SETZM (T1) ;No links here yet!
MOVMS T2 ;Be sure it's positive
ADDI T2,(T1) ;Compute end address(+1)
HRLI T3,FRELST
HRR T3,FRELST ;Get free list pointer
TRNN T3,-1
JRST CORF10
CORF1: HLRZ T4,(T3) ;Get size of block
ADDI T4,(T3) ;Compute its last addr(+1)
CAME T4,T1 ;Does that block end at us?
JRST CORF4 ;No
SUBI T2,(T1) ;Get length again
TLON F,(F$P2) ;Pass 2?
JRST CORF2 ;No, don't return yet
MOVSS T2 ;Put in left half
ADDM T2,(T3) ;Make that block bigger
POPJ P, ;Return
CORF2: HLRZ T4,(T3) ;Get length of existing block
ADDI T2,(T4) ;Add length of new block
MOVEI T1,(T3) ;Point T1 at new larger block
CORF3: HRR T3,(T3) ;Point T3 at successor
MOVSS T3 ;Get predecessor
HLRM T3,(T3) ;Point it at sucessor
SETZM (T1) ;No links yet to new block
ADDI T2,(T1)
MOVSS T3 ;Point T3 at current block
JRST CORF9 ;And continue scan
CORF4: CAIE T2,(T3) ;Does our block end at his?
JRST CORF7 ;No
SUBI T2,(T1) ;Get length again
HLRZ T4,(T3) ;And length of this block
ADDI T2,(T4) ;Get length of new block
TLON F,(F$P2) ;Pass 2?
JRST CORF3 ;No, de-link and continue search
HRLM T2,(T1) ;Store in proper place
HRRZ T2,(T3) ;Get successor block
HRRM T2,(T1) ;And point us to him
MOVSS T3 ;Get predecessor
HRRM T1,(T3) ;And point him to us
POPJ P, ;Return
CORF7: HRLI T3,(T3) ;Remember us as prececessor
HRR T3,(T3) ;Get successor
CORF9: TRNE T3,-1 ;See if there is one
JRST CORF1 ;Yes, check it
CORF10: MOVSS T3 ;No, point back to last block
HRRM T1,(T3) ;Save
SUBI T2,(T1) ;Get real length again
HRLM T2,(T1) ;Store it
POPJ P, ;Return, turning PSISER on on the way
SUBTTL Trace file support
TRACEI: CAMN NSAA2,[POINT 8,INPBUF] ;Really anything there to log?
POPJ P, ;No, don't bother
PUSHJ P,SAVT ;Preserve ACs
MOVE T2,NSAA2 ;Get ending byte pointer
MOVE T1,[POINT 8,INPBUF] ;And initial pointer
MOVEI T3,[ASCIZ |Network message received|]
PJRST TRACE ;Log the message
TRACEO: PUSHJ P,SAVT ;Preserve ACs
MOVE T2,NSAA2 ;Get terminal byte pointer
ADD T1,[POINT 8,OBF.DT] ;Form initial pointer
MOVEI T3,[ASCIZ |Network message sent|]
PUSHJ P,TRACE ;Log the message
TXNN NSAFN,NS.EOM ;End of message?
SKIPA T3,[[ASCIZ | (without EOM)|]] ;No,
MOVEI T3,[ASCIZ | (with EOM)|] ;or Yes.
PUSHJ P,TRACES ;Write this
FALL TRACEL ;Write a CRLF and return
TRACEL: MOVEI T3,[BYTE(7).CHCRT,.CHLFD] ;CRLF string pointer
FALL TRACES ;Write the string
TRACES: HRLI T3,(POINT 7) ;Make a byte pointer
TRACET: ILDB T1,T3 ;Get next character from string
JUMPE T1,CPOPJ ;Done at end
PUSHJ P,TRACEC ;Write the character
JRST TRACET ;Finish the string
TRACEC: SOSGE TRACEB+.BFCTR ;Space for another?
JRST TRACED ;No, flush the buffer
IDPB T1,TRACEB+.BFPTR ;Yes, stuff away
POPJ P, ;Return
TRACED: SKIPN FTRACE ;File already closed for an error?
POPJ P, ;Yes, ignore this request
OUT $NSP, ;Write the buffer
JRST TRACEC ;Try the character again
ERR TFE,<Trace file output error -- file closed>,<.+1>
RELEAS $NSP, ;Close off the file
SETZM FTRACE ;Not tracing any more
POPJ P, ;Done
TRACE: SAVE4 ;Preserve ACs
DMOVE P1,T1 ;Keep our byte pointers
MOVE P3,P1 ;Keep another copy for ASCII
MOVEI P4,TRACEN ;Where to go to record a byte
PUSH P,T3 ;Don't clobber caller's string
PUSHJ P,TRACEL ;Blank line
MSTIME T1, ;Time-stamp value
PUSHJ P,TRCTIM ;Type it
MOVEI T1,.CHTAB ;Separation
PUSHJ P,TRACEC ;Dump it
POP P,T3 ;Restore caller's string
PUSHJ P,TRACES ;Write the string
SETZ T4, ;Start counter at end
TRACE1: CAMN P1,P2 ;Hit the end yet?
JRST TRACE4 ;Yes, finish this section
AOJL T4,TRACE3 ;Skip this unless time for a new line
MOVNI T4,^D16 ;16*4+8=72
PUSHJ P,TRACEL ;New line
MOVEI T1,.CHTAB ;Indentation
PUSHJ P,TRACEC ;Stuff the character
TRACE3: MOVEI T1," " ;Fill with leading space
PUSHJ P,TRACEC ;Since always need at least one
ILDB T2,P1 ;Get the byte
PUSHJ P,(P4) ;Send a numeric byte
JRST TRACE1 ;Loop over all bytes in message
TRACE4: PUSHJ P,TRACEL ;End the line
CAIE P4,TRACEN ;Still in pass 1?
POPJ P, ;No, just return
MOVEI P4,TRACEA ;Yes, enter pass 2
SETZ T4, ;Reset column counter
MOVE P1,P3 ;Reset starting byte pointer
JRST TRACE1 ;Record the bytes in ASCII this time
TRACEN: CAIG T2,77 ;At least three significant characters?
PUSHJ P,TRACEC ;No, need another fill
CAIG T2,7 ;At least two?
PUSHJ P,TRACEC ;No, fill another
MOVEI T1,"0" ;Just in case it's this easy
JUMPE T2,TRACEC ;Handle zero early
SETZ T1, ;So don't load junk
TRACE2: ROTC T1,-3 ;Move the bytes around
LSH T1,-4 ;Right-justify current byte
TXO T1,<ASCII \0\> ;Make a printable digit
JUMPN T2,TRACE2 ;Loop over all siginificant digits
MOVE T2,T1 ;Copy the string we built
MOVEI T3,T2 ;Point to it
PJRST TRACES ;Write it out & return
TRACEA: TRNN T2,140 ;Is this a control character?
JRST TRACA1 ;Yes, handle specially
CAIL T2,177 ;No, is it normal printable ASCII7?
JRST TRACA2 ;No, handle differently
PUSHJ P,TRACEC ;Another space
PUSHJ P,TRACEC ;and another to line up
MOVEI T1,(T2) ;Copy character
PJRST TRACEC ;Display it and return
TRACA1: PUSHJ P,TRACEC ;Another space to line up
MOVEI T1,"^" ;Prefix for controls
TRZE T2,200 ;But for C1,
MOVEI T1,"$" ;Use escape-echo
PUSHJ P,TRACEC ;Type the prefix
MOVEI T1,100(T2) ;Uncontrollify the character
PJRST TRACEC ;Display it and return
TRACA2: CAIE T2,177 ;Special C0 character?
JRST TRACA3 ;No, have to work harder
MOVEI T3,[ASCIZ / ^?/] ;Yes, echo as if it were C0
PJRST TRACES ;Type the string and return
TRACA3: MOVE T1,[POINT 8,T2,35-8] ;ILDB pointer to our character
MOVEM T1,TRNBLK+.CHSB1 ;Set as source BP
MOVE T1,[POINT 7,TRNWRD] ;IDPB pointer to result
MOVEM T1,TRNBLK+.CHDB1 ;Set as destination BP
MOVEI T1,3 ;Maximum output count
MOVEM T1,TRNBLK+.CHDCT ;Set as output count limit
MOVE T1,[CH.FBR!CH.OVR+1] ;One character to fall back
MOVEM T1,TRNBLK+.CHFLG ;Set as source count & flags
SETZM TRNWRD ;Make sure we get ASCIZ result
XMOVEI T1,TRNBLK ;Point to UUO arguments
CHTRN. T1, ;Try to translate the character
PJRST TRACEN ;Give as numeric if unknown
HRRZ T3,TRNBLK+.CHDCT ;Get remaining output count
JUMPE T3,TRACA4 ;Skip padding if none needed
CAIN T3,2 ;If only got one character,
PJRST TRACEN ;It didn't really translate
MOVEI T1," " ;Pad with space
PUSHJ P,TRACEC ;One character
SOJG T3,.-1 ;Or as many as we need
JRST TRACA5 ;Don't test ^H if not 3 characters
TRACA4: MOVX T3,<BYTE(7)0,^-8,0> ;Special test
TDNE T3,TRNWRD ;Did we get something with a ^H?
JRST TRACA5 ;No, don't fix up for one
MOVX T3,<BYTE(7)0,"_"^!8,0> ;Yes, convert to underscore
XORM T3,TRNWRD ;For more consistent display
TRACA5: MOVEI T3,TRNWRD ;Point to translated string
PJRST TRACES ;Type the string and return
TRCTIM: IDIV T1,[^D<1000*60*60>] ;Split off hours
PUSH P,T2 ;Save remainder
MOVEI T3,":" ;Use colon to separate hh:mm:ss
PUSHJ P,TRCDEC ;Type as decimal
POP P,T1 ;Restore non-hours
IDIVI T1,^D<1000*60> ;Split off minutes
PUSH P,T2 ;Save remainder
PUSHJ P,TRCDEC ;Type as colon+decimal
POP P,T1 ;Restore non-minutes
IDIVI T1,^D1000 ;Split off seconds
PUSH P,T2 ;Save remainder
MOVEI T3,"." ;Separator for fractional seconds
PUSHJ P,TRCDEC ;Type as decimal
POP P,T1 ;Restore non-seconds
IDIVI T1,^D10 ;Split off hundredths
MOVEI T3,"0"(T2) ;Trailer is thousandths
FALL TRCDEC ;Type in decimal and return
TRCDEC: IDIVI T1,^D10 ;Split into 2-digit form
TRO T1,"0" ;Convert first to ASCII
PUSHJ P,TRACEC ;Stuff character
MOVEI T1,"0"(T2) ;Convert second digit
PUSHJ P,TRACEC ;Stuff it away
MOVEI T1,(T3) ;Copy trailing character
PJRST TRACEC ;Stuff trailer & return
SUBTTL SWITCH.INI support -- Read SWITCH.INI
; SWTINI is the main routine which provides support of reading SWITCH.INI.
;It looks up DSK:SWITCH.INI[,] and parses each line searching for a line
;which begins with "CTHNRT". It will attempt to parse each switch on the line;
;if a switch parses incorrectly, SWTINI will abort scanning the line
;and return to the caller. SWTINI uses all T ACs.
SWTINI: OPEN $SWI,[ .IOASC
SIXBIT/DSK/
DSKHDR ]
POPJ P, ;Oh well
MOVE T1,[SIXBIT/SWITCH/]
MOVSI T2,'INI'
SETZ T3,
GETPPN T4,
JFCL
LOOKUP $SWI,T1 ;Lookup the file
JRST RELFIL ;Done
SETZM DSKSAV ;No character to re-read
FNDNRT: PUSHJ P,SIXDSK ;Get sixbit token from disk
CAMN T2,[SIXBIT/CTHNRT/] ;For us?
JRST HAVNRT
PUSHJ P,DSKEAL ;Eat a disk line
JRST RELFIL ;Done
JRST FNDNRT ;Loop around
NRTSWT: PUSHJ P,SIXDSK ;Get it
MOVE T1,[-SWTL,,SWTA] ;The table
PUSHJ P,.LKNAM ;Look for a switch
TRNA ;Do what we can
PUSHJ P,@SWTDSP(T1) ;Process the switch
JRST RELFIL ;Oops
HAVNRT: CAIN P1,"/" ;Look for switches
JRST NRTSWT ;Process switch
PUSHJ P,DSKCH ;Get a character
JRST RELFIL ;Done
CAIE P1," " ;Tab is OK
CAIL P1," " ;But other control chars aren't
JRST HAVNRT ;Continue
RELFIL: RELEAS $SWI,
DMOVE T1,CC.SW1 ;Get the proposed switch characters
CAME T1,T2 ;Are they legal?
JRST CMPESC ;Yes, just go set up
MOVE T2,[POINT 8,SWTSEQ] ;No, point to prototype
ILDB T1,T2 ;Get first character
ILDB T2,T2 ;And second
DMOVEM T1,CC.SW1 ;Restore a legal pair of values
PJRST CMPESC ;Now go setup for interrupt level
SUBTTL SWITCH.INI support -- Switch handling routines
; The following routines handle individual switches:
;ESCSWT handles the /ESCAPE:character switch.
ESCSW1: TDZA T1,T1 ;Offset zero
ESCSW2: HRREI T1,CC.SW2-CC.SW1 ;Offset to second character
PUSH P,T1 ;Save storage offset
CAIN P1,":" ;Validate last character
PUSHJ P,ESCSW3
JRST TPOPJ
POP P,T1 ;Restore offset
MOVEM P1,CC.SW1(T1)
PJRST DSKCH ;Get next character and return
ESCSW3: PUSHJ P,DSKCH ;Get a character to store
POPJ P, ;Not there
CAIE P1,"""" ;Quoted character?
JRST ESCSW5 ;No, try other cases
PUSHJ P,DSKCH ;Yes, get the next one
POPJ P, ;Fail
CAIE P1,"""" ;Quoting a quote?
CAIN P1,.CHCNV ;or using the super-quote?
TRNA ;Yes, try harder
JRST ESCSW4 ;No, set to return this one
PUSHJ P,DSKCH ;Get the quoted character
POPJ P, ;Fail
ESCSW4: SAVE1 ;Return what's now in P1
PJRST DSKCH ;Eat the closing quote
ESCSW5: CAIL P1,"0" ;Is it an octal digit
CAILE P1,"7" ;Of any sort?
JRST CPOPJ1 ;No, assume literal character
MOVEI T1,-"0"(P1) ;Yes, init value
ESCSW6: PUSHJ P,DSKCH ;Get next character
POPJ P, ;Needs to be there
CAIL P1,"0" ;Still an octal digit?
CAILE P1,"7" ;Of some sort?
JRST ESCSW7 ;No, get ready to return
LSH T1,3 ;Yes, shift high-order part over
TRO T1,-"0"(P1) ;Include lower-order part
JRST ESCSW6 ;Loop until out of digits
ESCSW7: MOVEM P1,DSKSAV ;Need to re-read this one
MOVE P1,T1 ;Copy value
TXNN P1,^-377 ;Better be a valid character
AOS (P) ;Yes
POPJ P, ;Nope
;MODSWT handles the /MODE switch. Non-understandable settings of /MODE are
;equivalent to /MODE:NOVICE.
MODSWT: CAIE P1,":" ;Does he really know what he's doing
JRST CPOPJ1 ;Ignore just this
PUSHJ P,SIXDSK ;Get string
MOVE T1,[-MODL,,MODA] ;The table
PUSHJ P,.LKNAM ;Lookup
JRST CPOPJ1 ;Ignore this switch
IOR F,MODTAB(T1) ;The correct flag bits
MOVE T1,MODTB2(T1) ;Get the notify string
MOVEM T1,NOTICH ;Save it
JRST CPOPJ1
SUBTTL SWITCH.INI support -- I/O Routines
; The following routines are used to support the reading of SWITCH.INI:
;SIXDSK returns an alphanumeric SIXBIT token in T2, terminating
;character in P1. It uses T2 and P1.
SIXDSK: SETZ T2,
DSKSX1: PUSHJ P,DSKCH ;Get a disk character
POPJ P,
CAIL P1,"a" ;Is it lower case?
CAILE P1,"z" ; ..
TRNA ;No, don't modify
TRZ P1,40 ;Yes, make upper
CAIL P1,"0" ;Is it a digit?
CAILE P1,"9" ; ..?
CAIL P1,"A" ; or a letter?
CAILE P1,"Z" ; ..?
JRST DSKSX2 ;No, end of token
TLNE T2,770000 ;Still room for characters?
JRST DSKSX1 ;No, just eat the excess
LSH T2,6 ;Yes, make room
TRO T2,-40(P1) ;Include next SIXBIT character
JRST DSKSX1 ;Loop over entire word
DSKSX2: JUMPE T2,CPOPJ ;Done
DSKSX5: TLNE T2,770000 ;Left justify
POPJ P,
LSH T2,6
JRST DSKSX5
;DSKEAL eats characters until a <LF> is seen. It uses P1.
DSKEAL: PUSHJ P,DSKCH
POPJ P,
CAIE P1,.CHLFD
JRST DSKEAL
AOS (P)
POPJ P,
;DSKCH returns with the next character from the file in P1.
;It returns CPOPJ1 if no errors; CPOPJ and P1 zero if error or EOF.
;It uses P1 only.
DSKCH: SETZ P1,
EXCH P1,DSKSAV
JUMPN P1,CPOPJ1
SOSGE DSKHDR+.BFCTR
JRST DSKIN
ILDB P1,DSKHDR+.BFPTR
AOS (P)
POPJ P,
DSKIN: IN $SWI,
JRST DSKCH
POPJ P,
SUBTTL SWITCH.INI support -- Switch tables
; These are the tables which define legal switches and correspond
;them with appropriate actions. SWTA is generated with the NAMTAB MACRO.
;SWTDSP is the list of addresses. The offset of each address corresponds
;to the offset of the affiliated command from the beginning of the SWTA
;table.
NAMTAB SWT,<SWTCH1,SWTCH2,SW1,SW2,MODE>
SWTDSP: IFIW ESCSW1
IFIW ESCSW2
IFIW ESCSW1
IFIW ESCSW2
IFIW MODSWT ;Mode switch
IFN .-SWTDSP-SWTL,<
PRINTX %SWITCH.INI dispatch table doesn't match switch table
>
; These tables define the legal settings of the /MODE switch and
;the corresponding bit setting of F$XPT the value of NOTICH. The offset into
;MODA defined by the input keyword corresponds to the offset into
;MODTAB to obtain the correct flag and MODTB2 to obtain the value
;of NOTICH.
NAMTAB MOD,<EXPERT,NOTIFY>
;Table for /MODE flag bits. Must match order of /MODE names above
MODTAB: EXP F$XPT
EXP F$XPT
IFN .-MODTAB-MODL,<
PRINTX %SWITCH.INI /MODE bits table doesn't match MODES table
>
;Table for value of NOTICH. Must match order of /MODE names above
MODTB2: Z
[ASCIZ//]
IFN .-MODTB2-MODL,<
PRINTX %SWITCH.INI /MODE NOTICH value table doesn't match MODES table
>
SUBTTL GETCFG - Get the configuration message for the system
; GETCFG is called to read the configuration message from the
;remote terminal server. It will read the PMR message and confirm
;that it is a positive response (first byte =/= 2) if that is necessary.
;It will then read and store OSTYPE and PROTMD (the protocol modifier).
;It will type the connect confirmation and escape character reminder
; messages before returning to the user. Enter at TYPESC to just type the
;escape character reminder message.
GETCFG:
TXZ F,F$NEOM ;Force new buffer
PUSHJ P,NSPINW ;Wait for input
JRST NSPERR ;Oh well
IFN FTEPMR,<
SKIPN NODCNT ;Using PMR?
JRST GETCF0 ;Get the next part of message
PUSHJ P,RBYTEC ;Get data
CAIE T1,2 ;Is it a PMR NAK?
JRST GETCF ;No, then it is ok
PUSHJ P,TTYRST ;Reset the TTY:
PMRERR: PUSHJ P,NETCHR ;Output data from network
TXZN F,F$NEOM ;If EOM
PUSHJ P,OUTCRL ;He doesnt supply this either
PUSHJ P,NSPINW ;Get more data
TRNA ;Finish failing mode if no more
JRST PMRERR ;Continue outputting
PUSHJ P,DOOUT1 ;Force out last buffer
SKIPN OBJFRC ;Don't retry if no choice of objects
SKIPN OBJCNT ;Can we still try another object?
JRST RESTRT ;No, ask for a different path
PUSHJ P,CONERR ;Yes, use the alternate object type
PJRST GETCFG ;And await its PMR response
GETCF: TXZ F,F$NEOM ;Wait for some input
PUSHJ P,NSPINW
JRST NSPERR ;Failed
> ;End IFN FTEPMR
GETCF0: PUSHJ P,RBYTEC ;Get byte (defines this as config msg)
CAIE T1,.FMBND ;Is it the right message?
ERR IFM,<Illegal first message received from remote system>
PUSHJ P,RBYTEC ;Get a first byte
MOVEM T1,REMVER ;Save protocol version
PUSHJ P,RBYTEC ;Protocol ECO
MOVEM T1,REMECO ;Save it
MOVEM T1,PROTMD ;This is the VAX protocol modifier
PUSHJ P,RBYTEC ;Customer modification word
MOVEM T1,REMMOD ;Save it
PUSHJ P,GETWRD ;OS type
CAILE T1,O.MXOS ;Do we know about this O/S type?
SETO T1, ;No, say 'unknown'
MOVEM T1,OSTYPE ;Save this
PUSHJ P,GETWRD ;Supported protocols
MOVEM T1,PRTYPE ;Save the mask
MOVEI T3,8 ;NUMBER OF BYTES IN REVISION TEXT STRING
MOVE T2,[POINT 8,REMREV] ;POINTER TO STORAGE FOR STRING
GETCF1: PUSHJ P,GETBYZ ;GET A BYTE OR ZERO
IDPB T1,T2 ;STORE IN STRING
SOJG T3,GETCF1 ;LOOP OVER STRING
PUSHJ P,GETINT ;GET AN INTEGER
SETO T1, ;NOT PRESENT
MOVEM T1,REMLIN ;REMOTE'S LINE NUMBER
PUSHJ P,GETBYZ ;GET A BYTE OR ZERO
MOVEM T1,REMOPT ;STORE OPTIONS BYTE
MOVSI T1,-PRTTBL ;PROTOCOL TABLE LENGTH
MOVE T2,PRTYPE ;PROTOCOL SUPPORT MASK
GETCF2: TDNN T2,PRTTAB(T1) ;IS THIS ONE SUPPORTED?
AOBJN T1,GETCF2 ;NO, LOOK FOR ANOTHER
SKIPL T1 ;DID WE FIND ONE?
ERR NMP,<No mutually-supported protocol>
MOVE T1,PRTTAB(T1) ;YES, GET THE ENTRY
HRRZM T1,PRTUSD ;REMEMBER PROTOCOL IN USE
HRRI T1,OSJMP ;POINT TO DISPATCH VECTOR
BLT T1,OSINI ;COPY TO WHAT WE REFERENCE
GETCF9: TYPE <
[Connected to >
MOVE T1,OSTYPE ;Get O/S type
OUTSTR @OSNAME(T1) ;System type
TYPE < system>
IFN FTEPMR,SKIPG NODCNT ;Poor mans routing
OUTCHR [" "] ;No, then output the space
MOVE T2,RNODE ;Type nodeid
PUSHJ P,TNODE ;
TYPE <::>
; SKIPE OBJFRC ;Was there any question about what?
; JRST GETCF7 ;No, don't bother with it
TYPE <, using >
MOVE T1,OBJCNT ;Get object index
TSIX CSWA+1(T1) ;Type its name in SIXBIT
TYPE < protocol>
GETCF7: TYPE <]
>
TYPESC: TYPE <[Type > ;Say how to get out
PUSHJ P,TYPSSQ ;Display the switch sequence
TYPE < to return]
> ;
POPJ P, ;
TYPSSQ: MOVE T1,CC.SW1 ;Get first character
PUSHJ P,TYFCHR ;Type a possibly funny character
OUTCHR [","] ;Separator
MOVE T1,CC.SW2 ;Get second character
FALL TYFCHR ;Type it and return
TYFCHR: CAILE T1," " ;Printable?
CAIN T1,177 ;?
TRNA ;No, try harder
JRST TYFCH1 ;Yes, go do it simply
MOVSI CX,-TFCHRL ;No, get AOBJN pointer
TYFCH0: MOVE T2,TFCHRT(CX) ;Get next entry
CAIE T1,(T2) ;Does it match?
AOBJN CX,TYFCH0 ;No, look again
JUMPGE CX,TYFCH2 ;No match, type in uparrow form
HLLZS T2 ;Isolate SIXBIT name
OUTCHR ["<"] ;Introducer
TSIX T2 ;Show the name
OUTCHR [">"] ;End the name
POPJ P, ;Done with this case
TYFCH2: TRC T1,1^!"A" ;Convert to printable alternate
OUTCHR ["^"] ;Print uparrow first
TYFCH1: OUTCHR T1 ;Show the character
POPJ P, ;Done here
TFCHRT: 'RET',,.CHCRT
'LF ',,.CHLFD
'NUL',,.CHNUL
'SP ',," "
'TAB',,.CHTAB
'DEL',,.CHDEL
TFCHRL==.-TFCHRT
SUBTTL Set up switch sequence
; CMPESC is called to setup the switch sequence from CC.SW1 & CC.SW2.
CMPESC: MOVE T2,[POINT 8,SWTSEQ] ;Point to TRMOP block
MOVE T1,CC.SW1 ;Part 1
IDPB T1,T2 ;Store for UUO
MOVE T1,CC.SW2 ;Part 2
IDPB T1,T2 ;Likewise
MOVE T1,[3,,SWTSEA] ;UUO arg block
TRMOP. T1, ;Set the sequence
NOP ;Probably just not setup yet
POPJ P,
SUBTTL Fallback code for 7.02 monitors to run NRT
;Here when we've detected an old (pre-7.03) monitor, to run the old NRT
;program (since CTHNRT depends on 7.03 functions).
OLDNRT: MOVE T1,[RUNCOD,,RUNLOW] ;RUN UUO is only safe from lowseg
BLT T1,RUNLOE ;Move the code
JRST RUNLOW ;And try to run the old program
RUNCOD:
PHASE .JBDA ;Low core
RUNLOW: SKIPA T1,.+1 ;Get UUO argument
1,,777 ;Down to 1+0p
CORE T1, ;Contract core
NOP ;Should never fail
MOVEI T1,RUNBLK ;Point to arg block
RUN T1, ;Invoke the program
HALT ;Don't tell me about your problems
RUNBLK: SIXBIT /SYS NRT/ ;SYS:NRT
EXP 0,0,0,0 ;Default ppn & core
RUNLOE==.-1 ;End of run code
DEPHASE ;Back to normal code
SUBTTL Fatal errors in job
; The ERRTRP routine is entered if the program ever gets a trap
;through .JBINT. .JBINT traps are enabled for any kind of fatal error
;(such as illegal memory references, pushdown overflows, etc.) and control-C
;interrupts. These things are specifically not enabled with PSISER because
;the PSI system may be turned off when the error occurs. This routine
;saves the ACs in location CRSACS and loads up a crash pushdown pointer.
;It then attempts to restore the state of the TTY: (unslave it, in
;particular) and exit. The program may then be SAVEd and the dump
;analyzed later with FILDDT.
STPPSI:!
ERRTRP: MOVEM P,CRSACS+P ;Save P
ASSUME P,17 ;P must be last
MOVEI P,CRSACS ;Save all ACs
BLT P,CRSACS+P-1
MOVE P,[-10,,CRSPDL] ;Point to crash PDL
MOVE T1,[PSILEN,,PSISAV] ;Point to save block
PISAV. T1, ;Try to save our info
JFCL ;Oh, well
PUSHJ P,TTYRST ;Free the TTY:
SKIPE FTRACE ;If trace active,
RELEAS $NSP, ;Close the file
RESET ;Clear the world
MONRT. ;Die relatively gracefully
JRST RESTRT ;Restart the prog
SUBTTL Illegal UUO PSI routine
;IUUPSI is a special PI-level-change handler. It allows us to run at
;PI level 2 to do core allocation, reserving level 3 to fatal errors
IUUPSI: PUSH P,T1 ;Save an AC
MOVE T1,IUUVEC+.PSVIS ;Get the UUO executed
CAME T1,IUUVEC+.PSVOP ;Same as the continuation PC?
JRST IUUPS1 ;No, fatal
MOVSI T1,^-37 ;Yes, get mask
ANDCAM T1,-1(P) ;Zap possible flags from section number
POP P,T1 ;Restore the AC
POP P,IUUVEC+.PSVOP ;Use routine's caller as continuation PC
TXZ F,F$PION ;Flag for GGVPIL nesting
PUSHJ P,@IUUVEC+.PSVIS ;And call the invoker
TRNA ;Propagate non-skip
AOS IUUVEC+.PSVOP ; as well as skipness
TXO F,F$PION ;Flag for GGVPIL nesting
DEBRK. ;Return to invoker's caller
ERR DNI,<DEBRK. not implemented>
ERR NIP,<No interrupt in progress> ;(Should never happen)
IUUPS1: SOS IUUVEC+.PSVOP ;Adjust PC to do the same UUO again
MOVE T1,[PS.FAC![EXP .PCIUU
XWD STPVEC-VECBAS,0
XWD 3,0]] ;UUO arg
PISYS. T1, ;Change condition to fatal
HALT ;Maximize damage if can't
POP P,T1 ;Restore AC
DEBRK. ;Get a fatal error trap this time
XCT DNI ; (?)
XCT NIP ;(Should never happen)
SUBTTL ATTACH/DETACH PSI routine
;DATPSI handles an ATTACH/DETACH PSI interrupt. This is so we can reset
;the old terminal and init the new terminal. Note that anything set
;after initialization time will not be preserved over an ATTACH.
;Note that ATTACH/DETACH PSIs occur at a higher PSI level than other
;interrupts.
DATPSI: ADJSP P,4 ;Save the Ts (Don't have our own ACs)
DMOVEM T1,-3(P)
DMOVEM T3,-1(P)
SKIPGE T1,TTYUDX ;Don't reset if was detached
JRST DATPS1 ;Don't reset if was detached
CAME T1,CTLTTY ;TTY: reassigned?
JRST DATRET ;No
PUSHJ P,TTYRS1 ;Reset the settables
DATPS1: MOVE T1,DATVEC+.PSVIS ;Get the UDX
MOVEM T1,TTYUDX ;Save in all the appropriate places
MOVEM T1,SWTUDX
MOVEM T1,HPSUDX
MOVEM T1,LEDUDX ;For checking line editing
MOVEM T1,LEDCUX ;Ditto
MOVEM T1,CATUDX ;For setting character attributes
MOVEM T1,CTLTTY ;Same as before
MOVEM T1,ECCUDX ;..
MOVEM T1,BKCUDX ;Count of characters to echo
MOVEM T1,CTOUDX
MOVEM T1,COSUDX
MOVEM T1,BINUDX
MOVEM T1,PAGUDX ;...
JUMPL T1,DATRET ;If just got detached, return
PJOB T1, ;Get current job
MOVNS T1
JOBSTS T1, ;Get job status word
SETZ T1, ;Oh well
TLNN T1,(JB.UML) ;We at monitor level?
JRST ATTOK ;No, proceed
MOVEI T1,.IOAS8!IO.ABS ;Set a reasonable mode
SETSTS $TTY,(T1)
SETZ T1, ;Fetch a null
OUTCHR T1 ;Wait for user level
CLRBFI ;Make PIM happy
SETSTS $TTY,@TTYBLK ;Reset TTY:
ATTOK: SKIPE OSDAT ;Protocol provide an attach processor?
PUSHJ P,@OSDAT ;Yes, call it
PUSHJ P,SETTTY ;Set the settables
PUSHJ P,TTYSST ;According to what it should be
SETZ T1,
SLEEP T1, ;Cancel old clock req
DATRET: DMOVE T1,-3(P) ;Restore Ts
DMOVE T3,-1(P)
ADJSP P,-4
DEBRK.
XCT DNI
XCT NIP
SUBTTL DECnet interrupt routine
; DCNPSI is the operating system independent NSP. interrupt service
;routine. It calls EXCACS to set up the NSP. ACs. It then decides if
;this is more data available for a previously not completely read
;network message. If so, in dispatches to NSPCON to finish the read.
;Otherwise, it checks the state of the connection, and, if it it is
;DR, it outputs the "[Connection to remote node aborted]" message and
;exits through NSPER1. If neither of the above is true, it checks for
;network input and inputs any available, then attempts to
;push out any pending network output. If any network input now exists,
;it calls the operating system dependent network interrupt service
;routine (whose address was stored at initialization in OSNSP). Upon
;return it loops to check for more input and to attempt to send out
;pending output. When no input is available, it restores the ACs in
;use before the interrupt and dismisses the interrupt.
DCNPSI: AOSE INTLVL ;Get the interlock
ERR INA,<Interlock not available>
PUSH P,[.] ;Get our address
POP P,INTOWN ;Say who got this
PUSHJ P,EXCACS ;Get right ACs
EXP NSPACS ;Which set
TXNE F,F$NEOM ;EOM seen?
JRST NSPCON ;No, continue
NEWNET: PUSHJ P,NSPIN ;See if any network input
JRST NSPERR ;Oops
PUSHJ P,NSPO ;Output network stuff if can
JRST [SKIPG IBFCNT ;Failed, but did we read anything?
JRST NSPERR ;No, die
JRST .+1] ;Yes, try the input anyway
SKIPG IBFCNT ;If nothing then sleep
JRST NSPRET ;Restore the world and return
PUSHJ P,@OSNET ;Process network input
PUSHJ P,DOOUT1 ;Force the buffer out then
TXZE F,F$USRV ;Want TTY: service?
PUSHJ P,TTYPS1 ;Yes
JRST NEWNET ;Check for more
NSPRET: PUSHJ P,EXCACS ;Get the ACs back
EXP NSPACS
SETOM INTLVL ;Clear the interlock
HRROS INTOWN ;Note we released it
DEBRK.
XCT DNI ;Not implemented
XCT NIP ;In case not called at PSI level
SUBTTL TMR PSI routine
; This is the operating system independent PITMR. trap routine.
;It first loads up the timer service ACs. If OSTMR is non-zero, it
;treats it as the address of the operating system dependent timer service
;routine and dispatches there. Upon return, or if OSTMR is zero, it
;loads up the AC set in use at the time of the interrupt and dismisses
;the interrupt. The check for non-zero OSTMR is because this routine is
;not used by all operating systems, and, even then, not all the time.
;Although we should not take a trap unless OSTMR is non-zero, it is probably
;not harmful to dismiss any interrupt we may get.
TMRPSI: AOSE INTLVL ;Get the interlock
XCT INA ;Interlock not available
PUSH P,[.] ;Get our address
POP P,INTOWN ;Say who got this
PUSHJ P,EXCACS ;Switch ACs
EXP TMRACS ;Which ACs
SKIPE OSTMR ;Any routine?
PUSHJ P,@OSTMR ;Yes, call it
PUSHJ P,EXCACS
EXP TMRACS ;Restore the ACs
SETOM INTLVL ;Free the interlock
HRROS INTOWN ;Note we released it
DEBRK.
XCT DNI
XCT NIP
SUBTTL WAKE PSI Service
; WAKPSI is the WAKE UUO PSI service routine. This consists merely of
;checking to see if F$USRV is set. If it is, we proceed to TTYPSI; if not
;we just dismiss the interrupt.
WAKPSI: TXZE F,F$USRV ;Really wanted this?
JRST TTYPSI ;Yes, proceed
DEBRK. ;Toss it
XCT DNI ;Oops
XCT NIP
SUBTTL TTY: OOB PSI Service
; OOBPSI is entered via a PSI interrupt for out-of-band character
;receipt on the TTY. OOB PSIs happen at the same level as TTY: I/O PSIs.
;The OOB character is checked for being the switch-sequence. If so, we
;force an unread and set the appropriate flag for TTY: I/O service. If not,
;we queue the character. In either case, we force an input-done simulation
;to get to TTY: I/O PSI handling.
OOBPSI: SKIPN OOBVEC+.PSVIS ;Extraneous interrupt?
JRST OOBPSD ;Yes, dismiss
PUSHJ P,EXCACS ;Get our AC set
EXP OOBACS ; ...
PUSHJ P,OOBPS1 ;Subroutine so can GGVPIL
PUSHJ P,FRCTTI ;Force input-done wakeup
PUSHJ P,EXCACS ;Restore AC set
EXP OOBACS ; ...
OOBPSD: DEBRK. ;Dismiss
XCT DNI ; (?)
XCT NIP ;In case called via PUSHJ
OOBPS1: HLRE T1,OOBVEC+.PSVIS ;Get the character received
JUMPL T1,OOBPSS ;Switch sequence if negative
SOSGE OOBCNT ;Room left in buffer?
PUSHJ P,OOBALC ;Allocate next if not
IDPB T1,OOBPTR ;Yes, store
AOS OOBAVL ;Another char available
POPJ P, ;Return
OOBPSS: PUSHJ P,UNREAD ;Force an unread
AOS SWSEQN ;Count up another command
POPJ P, ;Defer command to TTYPSI
OOBALC: PUSHJ P,SAVT ;Preserve ACs
MOVEI T1,OOBSIZ+OOB.DT ;Total buffer size
PUSHJ P,CORGET ;Get the core
MOVE T2,T1 ;Copy address
TLO T2,(POINT 8,,35) ;Make ILDB pointer
MOVEM T2,OOBPTR ;Save for later use
MOVEI T2,OOBSIZ*4-1 ;Predecremented byte count
MOVEM T2,OOBCNT ;Set for later
SKIPN T2,OOBCUR ;Get current buffer address
MOVEI T2,OOBHDR ;Start chain if none
MOVEM T1,(T2) ;Link these together
MOVEM T1,OOBCUR ;Make current
POPJ P, ;Return to store
;Here to dequeue an Out-of-Band character for the protocol-specifiec
;OOB routine.
NXTOOB: GGVPIL ;Don't conflict with OOBPSI
SOSGE OOBAVL ;Is there another to give?
JRST NXTOB4 ;No, clean up and return
NXTOB1: SOSGE OOBICT ;More left in this buffer?
JRST NXTOB2 ;No, advance buffers
ILDB T1,OOBIPT ;Yes, fetch it
RETSKP ;Return success
NXTOB2: SKIPN OOBIPT ;First time here?
JRST NXTOB3 ;Yes, don't really advance
MOVE T1,@OOBHDR ;No, get next buffer
EXCH T1,OOBHDR ;Make current
MOVEI T2,OOBSIZ+OOB.DT ;Get its size
CALL CORFRE ;Return the core
NXTOB3: MOVE T1,OOBHDR ;Get buffer address
TLO T1,(POINT 8,,35) ;Make pointer to data
MOVEM T1,OOBIPT ;Set for fetching
MOVEI T1,OOBSIZ*4 ;Characters per buffer
MOVEM OOBICT ;Set as its count
JRST NXTOB1 ;Try again
NXTOB4: SETZM OOBAVL ;Don't leave a negative count
RET ;Give done return
SUBTTL TTY: PSI Service
; TTYPSI is entered via a PSI interrupt for I/O done to the TTY:
;or via a WAKE UUO. TTY: I/O PSIs happen at a higher interrupt than
;other PSIs (except ATTACH/DETACH PSIs). If another interrupt is in
;progress, the location INTLVL is non-negative and TTYPSI will store
;the status bits for the requesting interrupt, queue a forced TTY:
;interrupt via FRCTTY, and dismiss the higher level interrupt.
;Like all interrupt service routines, it first loads up its own AC set.
;If in PIM mode, TTYPSI proceeds to directly read input. Otherwise,
;it checks to see if there is an outstanding read. If there is, it
;proceeds to read, first checking to be sure the TTY: is echoed if it
;should be. If there is not read outstanding, we make sure the TTY: is
;not echoed. This is to simulate the ECHO DEFERed mode which systems
;such as VMS expect. We then attempt to read TTY: input. If the IN
;fails, be check if IO.EOF or any error bits are set. If IO.EOF is set,
;we CLOSE the TTY: and try the read again. If any error bits are set,
;we stopcode. If neither is true, we restore ACs and dismiss the interrupt.
;We then check to be sure OSTTY is non-zero (in case this came in
;before we were set up). If zero, we restore ACs and dismiss the interrupt.
;Otherwise, we allocate an internal buffer for the input and chain it off
;of any existing buffers. We move the haracters to the input buffer and
;call the operating system dependent TTY: service routine. Upon return,
;we loop back to check for more input.
TTYPS1: TXO F,F$NDB ;Don't DEBRK.
JRST TTYPS2 ;Continue
TTYPSI: AOSE INTLVL ;Get the interlock
JRST TTYDFR ;Defer the interrupt
PUSH P,[.] ;Get our address
POP P,INTOWN ;Say who got this
TTYPS2: PUSHJ P,EXCACS ;Set AC set
EXP TTYACS ;TTY: ACs
TXNN F,F$PIM ;PIM?
PUSHJ P,CHKCTO ;Read it
MOVE T1,TTYVEC+.PSVFL ;Reasons
IORM T1,TTYSTS ;Set what we need to do
TTYPS3: SKIPE OOBAVL ;Any OOB characters available?
PUSHJ P,TTYOOB ;Yes, deliver them
SKIPE SWSEQN ;Any switch sequences pending?
PUSHJ P,SWTCOM ;Yes, go handle management mode
MOVEI T1,PS.ROD!PS.REF ;Output done some time?
TDNE T1,TTYSTS ;?
PUSHJ P,TOOUTA ;See if can output anything
MOVEI T1,PS.RID!PS.REF!PS.RIA ;Input done
TDZN T1,TTYSTS ;?
JRST TTYRET ;Nothing more to do
TRNN T1,PS.RIA ;Input available?
TXO F,F$FRC ;Yes, call handler
TTYNEW: MOVEI T1,PS.RID!PS.REF!PS.RIA ;We are going to service this now
ANDCAM T1,TTYSTS ;So clear it here
TXNE F,F$PIM ;PIM
JRST ISREAD ;Skip this stuff then
SETZM TIBUF+.BFCTR ;Assume we'll read no chars
TXNN F,F$READ ;Read pending?
TXNN F,F$SYNC ;Or want to read ahead?
TRNA ;Yes, keep going
JRST TTCFRC ;No, skip the IN
MOVEI T1,IO.SUP ;Get SUP bit
TXNN F,F$READ ;Read active?
TDNE T1,TTYBLK ;Is it already on?
JRST ISREAD ;No problem
IORB T1,TTYBLK ;Update status
SETSTS $TTY,(T1) ;Make TTY: reflect it
ISREAD: PUSHJ P,TTINBF ;Get a buffer
JRST TTCFRC ;Check the force flag if can't
JRST TTYDBK ;Got it
TTCFRC: TXNN F,F$FRC ;Force set?
JRST TTYRET ;Done if not
FALL TTYDBK ;But don't allocate buffers
TTYDBK: SKIPN OSTTY ;Be sure there's a routine
JRST TTYDB1
TXNN F,F$FRC ;Force set?
SKIPLE ICHCNT ;Or nothing to do
PUSHJ P,@OSTTY ;Call the OS's TTY input routine
MOVEI T1,PS.RID ;Be sure we check
IORM T1,TTYSTS ;..
JRST TTYPS3 ;Check for more TTY: input
TTYDB1: TXZ F,F$FRC ;Will exit on no more input
JRST TTYPS3 ;If F$FRC not set
TTYRET: MOVEI T1,PS.RID!PS.ROD!PS.REF!PS.RIA ;Defer something?
TDNE T1,TTYSTS ;?
TXO F,F$USRV ;Make sure can get here if not immediately
PUSHJ P,EXCACS
EXP TTYACS ;Restore the old ACs
TXZE F,F$NDB ;DEBRK.?
POPJ P, ;No
SETOM INTLVL ;Free the interlock
HRROS INTOWN ;Note we released it
DEBRK.
XCT DNI
XCT NIP ;If not called at PSI level
;Here if the interrupt level database is interlocked. Queue the interrupt
;for later
TTYDFR: SOS INTLVL ;Account for trying to obtain interlock
PUSH P,T1 ;Save T1
MOVE T1,TTYVEC+.PSVFL ;Get condition
IORM T1,TTYSTS ;Say what we want to do
TRNE T1,PS.ROD ;Output done?
AOSE T1,SLPFLG ;Waiting for it?
TRNA ;No
SLEEP T1, ;Kill old sleep queue entry
PUSHJ P,FRCTTY ;Queue an interrupt for later
POP P,T1
DEBRK.
XCT DNI
XCT NIP ;?
SUBTTL TTY: Service -- Handle Management Mode
;Here to handle the command mode introduced by a switch sequence.
;Note that both SCNSER and OOBPSI have done unreads on us, so we will
;now proceed to eat all typeahead, remembering the boundary between
;echoed and unechoed characters.
SWTCOM: SOSGE SWSEQN ;One fewer
AOS SWSEQN ;Don't go negative
SETOM LSTINP ;Nothing last in that we want to remember
SWTCO1: PUSHJ P,TTINBF ;Get a buffer
SETZM TIBUF+.BFCNT ;Clear character count if failed
SKIPE TIBUF+.BFCNT ;Finished with those that SCNSER echoed?
JRST SWTCO2 ;No, get the rest
TXNE F,F$PIM ;Were we echoing?
JRST SWTCO2 ;No, don't need to suppress it
MOVEI T1,IO.SUP ;Noecho bit
TDNE T1,TTYBLK ;Already lit?
JRST SWTCO2 ;Yes, skip the UUO
IORB T1,TTYBLK ;No, light it
SETSTS $TTY,(T1) ;Tell the monitor
JRST SWTCO1 ;And try for a non-empty buffer
SWTCO2: MOVE T1,LSTINP ;Get last character input
CAME T1,CC.SW2 ;Is it what we want to see?
JRST SWTCO4 ;No, see if we want more
MOVE P4,LSTBUF ;Fetch buffer address
MOVE P2,LSTPTR ;And B.P.
SETZ P3, ;No more to go (just for consistency)
PUSHJ P,SCNLCH ;Find predecessor
JRST SWTCO4 ;Must not have been it
CAME T1,CC.SW1 ;Is it what we want to find?
JRST SWTCO4 ;No, try again
MOVX T1,CA.ENB ;Function-enabled bit
TDNE T1,CC.CAT+.CHCNV ;Is TTY QUOTE possible?
SKIPL TSTQOT ;Really?
JRST SWTCO3 ;No, don't try it
DMOVE P2,T2 ;Copy some pointer information
MOVE P4,T4 ;Some more
PUSHJ P,SCNLCH ;Yes, see if we can find a predecessor
JRST SWTCO3 ;No, assume it's ok
CAIN T1,.CHCNV ;Yes, is it the magic quote character?
JRST SWTCO4 ;Yes, this isn't the switch sequence after all
SWTCO3: MOVE P4,LSTBUF ;Get buffer address again
MOVE P2,LSTPTR ;And ending B.P.
SETZ P3, ;And follow-on count
PUSHJ P,SPCRUB ;Delete second char, point to first
JFCL ;Can't fail here
PUSHJ P,SPCRMV ;Also remove the first char of the pair
PUSHJ P,MONITO ;Call up management mode (such as it is)
SKIPLE SWSEQN ;Any more to do?
JRST SWTCOM ;Yes, try again
JRST SWTCO5 ;Done if not
SWTCO4: SKIPE TIBUF+.BFCNT ;Read anything?
JRST SWTCO1 ;Yes, try for more
CALL TAHCNT ;Get typeahead count
SUB T1,ICHCNT ;See how many are in chunks
JUMPN T1,SWTCO1 ;Get more if available
SWTCO5: TXNN F,F$READ ;Supposed to have a read outstanding?
PUSHJ P,UNREAD ;No, stop it
POPJ P, ;Try to do other TTY: things
SUBTTL TTY: Service -- OOB handling
TTYOOB: SKIPE OSOOB ;If there's a service routine,
TXNE F,F$PIM ;And we're supposed to get here,
RET ;(No)
PJRST @OSOOB ;Then call it
SUBTTL TTY: Service -- Read a buffer
TTINBF: IN $TTY, ;Try to read a buffer
JRST TTINB1 ;Won, try to copy it
GETSTS $TTY,T1 ;Get the I/O status
TRNN T1,IO.ERR!IO.EOF ;No data condition?
POPJ P, ;Yes, return blindly
TRNN T1,IO.EOF ;EOF?
ERR ITF,<IN UUO for TTY: failed>
MOVEI T1,PS.REF ;Clear EOF pending
ANDCAM T1,TTYSTS
CLOSE $TTY, ;Close TTY:
JRST TTINBF ;Try again after EOF
TTINB1: SKIPG T1,TIBUF+.BFCNT ;Get number of bytes
RETSKP ;Don't bother allocating buffer
ADDI T1,3 ;Round up
LSH T1,-2 ;Compute number of words
MOVEI T1,IBF.DT(T1) ;Include header
MOVNI T2,(T1) ;Get negative size in T2
PUSH P,T1 ;Save on stack
PUSHJ P,CORGET ;Get a block of core
HRLZM T2,IBF.LK(T1) ;Save size
MOVEI T2,INPQUE-IBF.LK ;Point to input queue
TTINB2: SKIPG IBF.LK(T2) ;End yet?
JRST TTINB3 ;Yes
HRRZ T2,IBF.LK(T2) ;Point to next
JRST TTINB2
TTINB3: MOVNS IBF.LK(T2) ;Make it not last
HRRM T1,IBF.LK(T2) ;Point previous to us
MOVE T2,TIBUF+.BFCNT ;Get character count
MOVEM T2,IBF.CT(T1) ;Save it
SKIPGE ICHCNT ;If count is negative
SETZM ICHCNT ;Zap it here
ADDM T2,ICHCNT ;And increase total # of chars
HLL T2,TIBUF+.BFPTR ;Get size
HRRI T2,IBF.DT-1(T1) ;Where it will go
MOVEM T2,IBF.PT(T1) ;Point there
HRL T2,TIBUF+.BFPTR ;First address of data
ADD T2,[1,,1] ;Point past overhead
EXCH T1,(P) ;Save address, get length
ADD T1,(P) ;Compute last word of buffer
BLT T2,-1(T1) ;Copy the data
MOVE T1,(P) ;Restore buffer address
MOVEI T2,IO.SUP ;Get echo-off bit
TDNN T2,TTYBLK ;Check status
TDZA T2,T2 ;Not true
MOVX T2,IF.NEC ;True
MOVEM T2,IBF.FL(T1) ;Init flags
MOVE T2,IBF.CT(T1) ;Get the character count
MOVE T4,IBF.PT(T1) ;Get pointer to it
IBP T4 ;Normalize it
SOS T2 ;Account for normalizing
ADJBP T2,T4 ;Point at terminating character
LDB T4,T2 ;Pick it up
MOVEM T4,LSTINP ;Save for SWTCOM
MOVEM T2,LSTPTR ;Save B.P. for SWTCOM
MOVEM T1,LSTBUF ;Save buffer address for SWTCOM
MOVE T3,[1,,T4] ;Block pointer
MOVE T2,TTYUDX ;Terminal we care about
MOVEI T1,.TOGCS ;Get character status
MOVE CX,[3,,T1] ;Arg pointer
TRMOP. CX, ;Do it
NOP ;Should never fail
POP P,T1 ;Restore buffer address (again)
TXNN T4,TC.BRK_TC.VLO ;Is it set as a break?
RETSKP ;No, we're done
MOVX T2,IF.TRM ;Yes, get terminator flag
IORM T2,IBF.FL(T1) ;Flag that terminator didn't echo
RETSKP ;Return with the buffer
SUBTTL TTY: Service -- Flush all type-ahead
; FLSTAH is called to flush all type-ahead, both in internal
;chunks and monitor chunks. It uses no ACs.
FLSTAH: PUSHJ P,FLSTAM ;Flush the monitor's queue
FALL FLSTAQ ;Then our internal queue
FLSTAQ: PUSHJ P,SAVT ;Save the Ts
GGVPIL ;Hold off interrupts
SETZM ICHCNT ;No characters
SETZM INPCHR ;No character to force
SKIPN T1,INPQUE ;Get queue contents
POPJ P, ;None
FLSTAL: SETZM IBF.CT(T1) ;Clear the count
SKIPLE T1,IBF.LK(T1) ;Point to next
JRST FLSTAL
POPJ P,
FLSTAM: PUSHJ P,SAVT ;Save the Ts
MOVE T1,[2,,T2] ;Clear the chunks too
MOVEI T2,.TOCIB
MOVE T3,TTYUDX
TRMOP. T1,
JFCL ;Oh well
POPJ P,
SUBTTL TTY: Service -- Set Data Mode and Mask
; TTYSST is the general routine to change the state of the terminal.
;It will set the data mode to .IOPIM if F$PIM is set, otherwise it sets
;it to .IOASL with IO.ABS set so break masks may be enabled. Location
;IMASK is used as the argument to the .TOSBS TRMOP. TTYSST guarantees
;that the escape character is part of the break mask. TTYSST also
;includes or excludes ^Q/^S in the mask depending on the setting of
;the page mode bit for the TTY: (.TOPAG TRMOP.) TTYSST uses no ACs.
;TTYSST will clear buffers if the terminal mode changes and it will change
;the pointers in the buffer header blocks. It will also attempt to wait
;(read "BLOCK") for all output buffers to finish being output to the
;TTY: if the data mode (byte size) changes.
TTYSST: PUSHJ P,SAVT ;As advertised
MOVEI T1,IO.ABS ;Always on, for .TOSOP
TXNE F,F$READ ;Read not set, always noecho
TXNE F,F$NEC ;Read set, is noecho?
TRO T1,IO.SUP ;Yes. supress it locally
TLNE F,(F$PIM) ;Want to use PIM (passall)?
TROA T1,.IOPIM!IO.SUP ;Use PIM mode
TRO T1,.IOAS8 ;Use ASCII line if not PIM
TXNN F,F$LEM!F$PALL!F$RALL ;If these are set
TXNN F,F$READ ;Logical read outstanding?
TRO T1,IO.LEM ;No, swallow these too
TLO T1,(UU.AIO) ;Set ASYNC I/O
CAMN T1,TTYBLK ;Any changes?
JRST SETBKM ;No. Just set break mask
XORM T1,TTYBLK ;Get differences
EXCH T1,TTYBLK ;Get XOR, save new status
TRNN T1,IO.MOD ;Any mode differences?
JRST NBFCHG ;No buffer changes
PUSHJ P,WATDEQ ;Wait for buffers to dequeue
SETZM TIBUF+.BFCNT ;Clear buffers
NBFCHG: SETSTS $TTY,@TTYBLK ;Set the bits
SETBKM: TLNE F,(F$PIM) ;Using PIM?
JRST TTYSSZ ;Yes, don't bother with break mask
MOVX T1,1B<.CHESC> ;Escape break bit
TXNE F,F$ESC ;Want escape recognition?
IORM T1,IMASK+1 ;Yes, set it
TXNE F,F$ESC ;Look again
SETOM IMASK+5 ;Catch all C1 characters in this case
MOVE T1,[2,,PAGTRM] ;Find the page bit
TRMOP. T1,
SETZ T1, ;Default
JUMPE T1,TTSNPG ;Don't change anything
MOVX T2,<1B<.CHCNS>!1B<.CHCNQ>>
IORM T2,IMASK+1 ;Default we get them
ANDCM T2,OBMASK ;VAX needs to see these
ANDCM T2,OBMASK+1
TXNN F,F$RALL!F$PALL ;Readall or passall?
ANDCAM T2,IMASK+1 ;Default can't get them
TTSNPG: MOVX T1,1B<.CHCNO>
IORM T1,IMASK+1 ;Default we see it
TXNN F,F$ACO!F$RALL!F$PALL ;Allow ^O if we need to
ANDCAM T1,IMASK+1
SKIPG T1,IMASK ;If field width got zapped,
MOVEI T1,1 ;Make it one
CAIL T1,400 ;Max is 377 (octal)
MOVEI T1,377 ;So set that
MOVEM T1,IMASK ;..
MOVX T1,1B0 ;Starting bit for a word
MOVSI T2,-^D256 ;Length of CATTAB
MOVX T3,TC.BRK_TC.VLO ;Break character bit
SETZ T4, ;Start at beginning of mask
SETBKL: ANDCAM T3,CATTAB(T2) ;Assume not a break
TDNE T1,IMASK+1(T4) ;Good guess?
IORM T3,CATTAB(T2) ;No, get it right
LSH T1,-1 ;Go down the bits
TRNE T1,1B32 ;Time for another word?
JRST [AOS T4 ;Yes, update pointer to mask block
MOVX T1,1B0 ;Start at beginning of new word
JRST .+1] ;Rejoin main line
AOBJN T2,SETBKL ;Loop over all characters
MOVE T2,CC.SW1 ;First switch character
IORM T3,CATTAB(T2) ;Make sure it breaks
MOVE T2,CC.SW2 ;Second switch character
IORM T3,CATTAB(T2) ;This one, too
STTCAT: MOVE T1,[3,,TRMCAT] ;Set break set
TRMOP. T1,
JFCL ;Oops
MOVE T1,[3,,TRMBKS] ;Set break field width
TRMOP. T1,
NOP ;C'est la vie
PUSHJ P,CMPESC ;Make sure we have a switch sequence
TTYSSZ: POPJ P, ;Return
SUBTTL TTY: Service -- Check for line editing
; CHKLED is called to see if line editing needs to be done on
;type-ahead we haven't yet seen. Return CPOPJ if something needs to
;be done; CPOPJ1 if not. **THE BREAK SET IN USE IS ALTERED HERE
;AND NOT CHANGED BACK, BUT IMASK IS LEFT AS THE "DESIRED" MASK**.
;AND IS ALTERED BACK ONLY IF THERE IS NO LINE EDITING TO DO.
;IMASK IS LEFT AS THE "DESIRED" MASK IN ALL CASES, HOWEVER.**
;It uses nothing.
CHKLED: PUSHJ P,SAVT ;Save the ACs
MOVE T1,[3,,LEDTRM] ;Set break width
TRMOP. T1, ;Try it
JRST CHKLEX ;Nothing if detached
MOVE T1,[3,,LEDCAT] ;Attributes for editing breaks
TRMOP. T1, ;Set appropriate break chars
JRST CHKLEX ;Detached just now?
MOVE T1,[2,,T2] ;Find number of characters now
MOVEI T2,.TOBKC ;..
MOVE T3,TTYUDX
TRMOP. T1,
JRST CHKLEX
JUMPN T1,CPOPJ
CHKLEX: AOS (P)
PJRST STTCAT ;Restore the mask
SUBTTL TTY: Service -- Check/Set ^O bit
; These routines handle the control-O bit in relation to F$CTO.
;CHKCTO sets F$CTO according to the bit as the monitor sees it.
;SETCTO sets the output suppression bit if F$CTO is set. **IT DOES
;NOTHING IF F$CTO IS CLEAR**. CLRCTO clears both F$CTO and the monitor's
;output suppression bit. These routines use CX.
CHKCTO: TXNE F,F$ICO ;Didn't do this earlier so could make
POPJ P, ;PIM check at TTYPSI: faster
MOVE CX,[2,,CTOTRM]
TRMOP. CX,
SETZ CX,
DPB CX,[POINT 1,F,<^L<F$CTO>>]
JUMPN CX,CLRTOQ ;Be sure queue is cleared
POPJ P,
SETCTO: TXNN F,F$ICO ;Ignore?
TXNN F,F$CTO
POPJ P, ;Assuming it's clear
MOVE T1,[3,,CTOTRS] ;The TRMOP.
SETOM COSVAL
TRMOP. T1,
JFCL
POPJ P,
CLRCTO: TXZ F,F$CTO!F$ICO
CLRCO1: MOVE CX,[3,,CTOTRS]
SETZM COSVAL
TRMOP. CX,
JFCL
POPJ P,
SUBTTL TTY: Service -- Wait for output to finish
; These routines are called to block for various forms of TTY: output
;to complete. WATDEQ waits until all buffers are dequeued and the buffer
;is empty. WATIDL waits until the characters are also out of the chunks.
;WATOUT first calls WATDEQ and then WATIDL. These routines uses no ACs.
WATOUT: PUSHJ P,WATDEQ
PJRST WATIDL
WATDEQ: PUSHJ P,SAVT ;Save the Ts
PUSH P,F ;Save the flags
TXZ F,F$IOQ ;Must ignore here
SKIPN TOBUF ;Is there a buffer already?
JRST WOUT5A ;No
MOVE T1,CHPBUF ;Get total number of available chars
SUB T1,TOBUF+2 ;Real number of characters
JUMPG T1,WOUT2 ;Nothing to do
HRRZ T1,TOBUF ;Get buffer pointer
HRRZ T2,BUFCHR ;Size
MOVEI T2,1(T2) ;Plus link
PUSHJ P,CORFRE ;Deallocate it
JRST WOUT5
WOUT2: HRLM T1,@TOBUF ;Store the count
HRRI T1,TOQUE ;Point to output queue
WOUT3: HRL T1,(T1) ;Get link
TLNN T1,-1 ;Another buffer?
JRST WOUT4 ;No
HLRZS T1 ;Point ahead
JRST WOUT3 ;Continue
WOUT4: HRL T1,TOBUF ;Pointer to buffer
HLRM T1,(T1) ;Link it in
WOUT5: SETZM TOBUF
SETZM TOBUF+1
SETZM TOBUF+2 ;Zap old pointers
WOUT5A: MOVE T4,TTYUDX
MOVEI T1,^D60 ;Long wait for queueing
TXO F,F$IEC ;Ignore LDBECC
WOUT6: SKIPN TOQUE ;Anything more to queue?
SKIPGE TOBFH+.BFCNT ;Or output?
JRST WOUT7 ;Try to dequeue buffer
WATRET: POP P,T1 ;Saved flags
TXNE T1,F$IOQ ;Was this set before?
TXO F,F$IOQ ;Yes, set it again
TXZ F,F$IEC
POPJ P,
WOUT7: PUSHJ P,TOOUT ;Dequeue buffers
SKIPN TOQUE ;Still stuff to dequeue?
SKIPGE TOBFH+.BFCNT ;Or wait for I/O complete?
PUSHJ P,TOHIBR ;Wait a bit
JRST WOUT6
WATIDL: PUSHJ P,SAVT ;Save the Ts
PUSH P,F ;Save the flags
TXZ F,F$IOQ ;Must ignore here
MOVE T4,TTYUDX ;The terminal to check
WATID1: DMOVE T2,[ 2,,T3
.TOSTP ] ;Output stopped?
TRMOP. T2,
SETZ T2, ;Assume it isn't
SKIPN T2 ;Output stopped?
TDZA T1,T1 ;No, short wait
MOVEI T1,^D60 ;Else long wait
DMOVE T2,[ 2,,T3
.TOSOP ] ;Is output going on?
TRMOP. T2,
JRST WATRET
PUSHJ P,TOHIBR ;Turn PIs off and wait
JRST WATID1 ;Try to force out again
SUBTTL TTY: Service -- Wait for available buffer
; Call TOBLOK to sleep until a buffer ready. TOBLOK uses no ACs.
;Note that TOBLOK only waits for one buffer to become available
;(although more may in fact be available. TOHIBR is used by TOBLOK and WATOUT
;to HIBER using the bits specified in T1 to HIBER with PSI turned off
;(HIBER doesn't hiber if this is not true and an interrupt is pending).
;TOHIBR destroys nothing.
TOBLOK: PUSHJ P,SAVT
MOVEI T1,^D60 ;Sleep time
PUSH P,F ;Save F
TXO F,F$IEC ;Ignore ECC
TXZ F,F$IOQ ;Clear this too
TOBLK1: SKIPLE BUFQUO ;One available?
JRST TOBLK2 ;Return
PUSHJ P,TOHIBR ;So can use PIOSAV
PUSHJ P,TOOUT
JRST TOBLK1
TOBLK2: TXZ F,F$IEC
POP P,T1
TXNE T1,F$IOQ ;Was this on?
TXO F,F$IOQ ;Yes
POPJ P,
TOHIBR: PUSHJ P,TOHB2 ;So can use PIOSAV
SLEEP T1,
POPJ P,
TOHB2: GGVPIL ;Must, so HIBER works
SETZM SLPFLG
AOS SLPFLG ;Set sleep flag
POPJ P, ;Return
SUBTTL TTY: Service -- Scan input for special characters
; Call SCNSPC to scan the input queue for "special" characters.
;Enter with T2 pointing to the appropriate "special" character table
;Returns CPOPJ1 if a special character is not found.
;Returns CPOPJ if one is found, with P4 pointing to
;the input buffer the character was found in (or 0 if in INPCHR),
;P1 containing the character,
;P3 containing the number of characters left in the buffer pointed to by P4,
;and P2 containing the LDB pointer to the character found (NOT ILDB!)
;Table CHRTAB is the bit mask to the "special" characters.
;SCNSPC will also set F$BRK if a break character (as defined by LMASK)
;is seen during the scan (i.e. before a special character if one is
;seen or in the whole string if no special characters). ICHCNT will
;also be updated to be "correct" (no nulls counted) up to the point
;of scan termination. Note that SCNSPC should NOT be called if
;not in "line" mode (as specified by F$PIM). If neither a break nor a
;special character is found, P1 contains the last non-null character scanned.
;SCNSPC uses ALL ACs.
SCNSPC: SETO P1, ;Assume no special chars
TXNE F,F$PIM ;In "line" mode?
JRST CPOPJ1 ;No, nothing is special
PUSH P,P1 ;Last non-special character
TXZ F,F$BRK!F$ESA ;Clear break seen, escape active
PUSHJ P,SCNINI ;Init the character scanner
SPCLP: PUSHJ P,SCNCHR ;Get character from stream
JRST P1POJ1 ;Get last non-special and return
SPLOOK: PUSHJ P,SPCCHK ;Is it special?
TRNA ;Normal
JRST TPOPJ ;Clear junk and return
PUSHJ P,CHKBRK ;Break character?
TLOA F,(F$BRK) ;Set seen
MOVEM P1,(P)
JRST SPCLP ;And look for more
;Here if want to continue scanning
CONSCN: PUSH P,[-1] ;Last non-special
JRST SPCLP ;Continue
; SPCRMV is a routine to remove a "special" character from
;the input stream and shuffle succeeding characters down.
;Call with P2, P3, P4 as returned from SCNSPC. It uses P1-P3 and CX.
SPCRMV: CAIN P4,INPQUE-IBF.LK ;INPCHR being removed?
JRST SPCRM2 ;Yes, do it differently
SOS IBF.CT(P4) ;Take the character out of the string
SOS ICHCNT ;Total number of chars now one less
MOVNI P1,1 ;Back up the byte pointer
ADJBP P1,P2
JUMPE P3,CPOPJ ;If last character, don't worry
SPCRM1: ILDB CX,P2 ;Get next character
IDPB CX,P1 ;Move it back
SOJG P3,SPCRM1 ;Move ahead
POPJ P, ;Done
SPCRM2: SETZM INPCHR ;Remove the character
SOSGE ICHCNT ;Really
SETZM ICHCNT ;Musn't go negative
PJRST SCNINI ;Reset the pointers
; SPCRUB is a routine to remove the character found by SCNSPC, returning
;a valid SCNSPC-style pointer to its predecessor in the Ps. If there is no
;predecessor, it returns non-skip with the Ps unchanged. If there is, returns
;single-skip with the Ps indicating the predecessor, and with the invoking
;character deleted. Trashes T1-T4 and CX.
SPCRUB: PUSHJ P,SCNLCH ;Find predecessor
POPJ P, ;Nonesuch
AOS (P) ;Success
CAMN T4,P4 ;If staying in same buffer,
SOS T3 ;It will have one fewer trailers
ADJSP P,4 ;Make room
DMOVEM T1,-3(P) ;Save values for our return
DMOVEM T3,-1(P) ; ...
PUSHJ P,SPCRMV ;Delete via current pointer
JRST .RES4 ;Return predecessor in the Ps
; SPCFLS is a routine to FLUSH input up to the special chracter found
;by SCNSPC. Call with P2, P3, P4 as returned from SCNSPC. It uses T1-T2.
SPCFLS: CAIE P4,INPQUE-IBF.LK ;Flushing to INPCHR?
JRST SPCFL1 ;No, handle queued case
PJRST SPCRM2 ;Yes, flush the character & return
SPCFL1: MOVE T1,IBF.CT(P4) ;Get total number of chars in buffer
SUBI T1,(P3) ;# skipped over
SUBM T1,ICHCNT ;ICHCNT now has -#chars
MOVEM P3,IBF.CT(P4) ;Set the count
MOVEM P2,IBF.PT(P4) ;Set the pointer
MOVEI T1,INPQUE-IBF.LK ;Point to start of input
FLSLP: HRRZ T1,IBF.LK(T1) ;Point to this buffer
CAIN T1,(P4) ;The current buffer?
JRST FLSDON ;Yes
SKIPLE T2,IBF.CT(T1) ;If real characters,
ADDM T2,ICHCNT ;"Subtract" from total
SETZM IBF.CT(T1) ;None there
JRST FLSLP ;Next buffer
FLSDON: MOVNS ICHCNT ;Make positive again
SKIPN INPCHR ;Leading character to flush?
POPJ P, ;No, we're done
SETZM INPCHR ;Yes, forget it
SOSGE ICHCNT ;Count it gone
SETZM ICHCNT ;Musn't go negative
POPJ P, ;Now we're done
; This is a routine to check if character in P1 is a "special" character.
;Return CPOPJ1 if it's special, CPOPJ otherwise. It uses T1-T2.
SPCCHK:
SPCCH1:!TXNE F,F$PALL!F$RALL ;Pass all?
POPJ P, ;Yes
MOVEI T1,(P1) ;Make copy of char
LSHC T1,-5 ;Split off word & bit
LSH T2,-^D31 ;Right-justify bit number
MOVE T2,BITTBL(T2) ;Get bit number
TDNE T2,CHRTAB(T1) ;Check the bit
AOS (P) ;Flag found character
POPJ P,
SUBTTL TTY: Service -- Input scan routines
; These routines are used to scan the input queue
;for certain conditions being met. You must preserve all
;"P" ACs across calls to these routines in order to use these routines.
;SCNINI - Set up "P" ACs for an input scan.
;SCNINI uses no ACs other than the "P"s.
SCNINI: SKIPN INPCHR ;Start with first character
SKIPN P4,INPQUE ;Point to input queue
JRST [MOVEI P4,INPQUE-IBF.LK
SETZ P3, ;There's nothing to read
MOVE P2,[POINT 36,INPCHR] ;Where there might be a char
SKIPE INPCHR ;Is there?
AOS P3 ;Yes, there's one
SETO P1, ;No initial
POPJ P, ]
MOVE P3,IBF.CT(P4) ;Count
MOVE P2,IBF.PT(P4) ;Pointer
SETO P1, ;No initial character
POPJ P,
;SCNCHR - Return with next input character in T1. Return CPOPJ1 if
;a character is present, CPOPJ if done.
SCNNEW: SKIPLE P4 ;In case called after end
SKIPG P4,IBF.LK(P4) ;Point to next buffer
POPJ P, ;If none
MOVE P3,IBF.CT(P4)
MOVE P2,IBF.PT(P4)
SCNCHR: SOJL P3,SCNNEW ;New buffer time
ILDB P1,P2
JRST CPOPJ1
SCNPOS: MOVNI T1,(P3) ;Initialize the count
MOVEI T2,(P4) ;Init buffer link
POSLP: SKIPG T2,IBF.LK(T2) ;Next
JRST POSDON ;Done
SUB T1,IBF.CT(T2) ;Subtract the characters
JRST POSLP
POSDON: ADD T1,ICHCNT ;From total
POPJ P,
;SCNLBK - Scan to last break character before character pointed to
;by P2. It uses T1-T4 also.
SCNLBK: MOVE T1,P2 ;Save pointer
PUSHJ P,SCNINI ;Re-initialize
ADJSP P,4 ;Allocate stack space
DMOVEM P1,-3(P)
DMOVEM P3,-1(P) ;Initially the beginning
PUSH P,T1 ;And save the pointer
SCNLB1: CAMN P2,(P) ;The final pointer?
JRST SCNLB3 ;Yes
PUSHJ P,SCNCHR ;Scan a character
ERR CSC,<Couldn't find specified character>
PUSHJ P,CHKBRK ;Is it a break?
CAMN P2,(P) ;Yes, but not the target char
JRST SCNLB1 ;No, loop back
DMOVEM P1,-4(P) ;Save the ps
DMOVEM P3,-2(P) ;..
JRST SCNLB1
SCNLB3: POP P,(P) ;...
PJRST .RES4 ;Restore Ps
;SCNLCH - Scan to immediately preceding character.
;Scan to character preceding that pointed to by P4.
;Return with Ps intact, and Ts set to values from SCNINI/SCNCHR.
SCNLCH: SAVE4 ;Save the Ps
PUSHJ P,SCNINI ;Initialize a scan
TXO F,F$P2 ;General PASS2 flag
SCNLC1: DMOVE T1,P1 ;Save it's first character
DMOVE T3,P3
PUSHJ P,SCNCHR ;Get chracter
POPJ P, ;?
CAMN P2,-3(P) ;POinters match
POPJ P, ;Return if so
TXZE F,F$P2 ;If haven't already
AOS (P) ;Flag at least one char to undo
JRST SCNLC1
SUBTTL TTY: Service -- Check for break character
; Enter at CHKBRK with the character in question in P1;
;enter at CHKBR1 with character in T1 to save T1 (RH only saved)
;Return CPOPJ if character IS in the break set, CPOPJ1 otherwise
;Location BRKSIZ is incremented each time a compenent of a break is passed.
;***IT IS THE RESPONSIBILITY OF THE CALLER TO BE SURE LOCATION BRKSIZ
;IS ZEROED AT THE RIGHT TIME***
;Both routines use T1-T2 and CX, except that CHKBR1 saves the right half
;of T1. If the character in T1 IS a break character, CHKBR1 will store it
;in the left half of location BRKCHR.
CHKBRK: SKIPA T1,P1 ;Copy to T1
CHKBR1: HRLM T1,BRKCHR ;Assume it's a character
TXNE F,F$ESC ;Want escape sequences?
JSP CX,CHKESC ;Yes
LSHC T1,-5 ;Separate word & bit numbers
LSH T2,-^D31 ;Right-justify bit number
MOVE T2,BITTBL(T2) ;Get corresponding bit
TDNN T2,LMASK(T1)
AOSA (P) ;Skip return if not a break
AOSA BRKSIZ ;Increment break size
SKIPA T1,BRKCHR ;Get character back
SKIPA T1,BRKCHR ;...
HRRZS BRKCHR ;No break yet
HLRZS T1 ;And restore character to T1
POPJ P,
SUBTTL TTY: Service -- Control-H Routine
;CHKCTH uses T1 and is called to see if the character in P1 is a control-H
;and if so, see if we should output one to the TTY:. This is for the benefit
;of those operating systems from whom control-H doesn't function as a rubout
;and isn't a break.
CHKCTH: MOVE T1,ICHCNT ;Get characters available
EXCH T1,LICHCT ;Update
CAME T1,LICHCT ;As we last remember it?
CAIE P1,.CHCNH ;Yes, did we break for ^H?
POPJ P, ;Doesn't apply then
TXNE F,F$NEC ;Noechoed?
POPJ P, ;Doesn't apply then
MOVEI T1,($TOOIN) ;Override inhibit
MOVEM T1,TOFLGS
MOVEI T1,.CHCNH ;Else output one
PUSHJ P,OUTTTY
PUSHJ P,DOOUT1
SETZM TOFLGS
POPJ P,
SUBTTL TTY: Service -- Escape Sequence processing
;CHKESC is called to check if an escape sequence is beginning or ending.
;If the escape sequence finishes, then F$BRK is set. If an escape sequence
;begins, then F$ESA is set. If a bad character is encountered during
;processing, then F$BAD is set. CHKBRK/CHKBR1 and EKOTAH use this routine.
;It will increment BRKSIZ appropriately to the size of the escape sequence.
;An <ESC> will be stored in BRKCHR. The table driven routine for validating
;the escape sequences is rumoured to let a few bad sequences through, but
;should definitely pass all good ones. It was obtained from WSM of ISWS
;who borrowed it from another ISWSite who modified it from VMS' TTDRIVER
;(friend of a friend of a friend...).
;***Note that it is the caller's responsibility to initialize the appropriate
;parts of the data base, in particular, F$ESA. Note also that in general
;the base must be re-inited at each read request because of multiple
;scanning passes of the same stream with each read request, so
;all bets are off if a partial escape sequence has to be stored
;(i.e. the escape sequence gets split over a read request). VMS
;doesn't guarantee integrity across such anyway and RSX states nothing
;about it. The processing uses T1-T4 and CX.
CHKESC: TXNE F,F$ESA ;Escape sequence already active?
JRST ESCACT ;Yes
PUSHJ P,ISESC ;Is this an escape?
JRST (CX) ;No
PUSH P,T1 ;Save incoming characer
TXO F,F$ESA ;Escape sequence now active
SETZM RULE ;Let's start at the very beginning...
TXZ F,F$BAD ;Assume a good escape sequence
SETOM IMASK+1 ;Break on all now
MOVE T1,[IMASK+1,,IMASK+2]
BLT T1,ENDMSK
MOVEI T1,1 ;Let the field width be 1
MOVEM T1,IMASK
PUSHJ P,TTYSST ;Set up TTY:
PUSHJ P,FRCTTI ;Be sure see changes
POP P,T1 ;Restore introducer
ESCACT: JUMPE T1,CPOPJ1 ;Toss nulls (incomplete requests)
MOVE CX,RULE ;Get the current rule
PUSHJ P,ESCRUL ;Analyze for legality
JRST ESCERR ;Return badness
MOVEM CX,RULE ;Update current rule
AOS BRKSIZ ;Break is one character bigger
JUMPE CX,ESCDON ;Done if at end
AOS (P) ;Skip return if still going
JRST TTYSST ;Return after restoring TTY
ESCERR: TXO F,F$BAD ;Bad escape sequence
ESCDON: TXZ F,F$ESA ;No longer active escape
PUSH P,T3 ;Save character AC
MOVEI T3,.CHESC ;Break character is escape
HRLM T3,BRKCHR ;Save it
POP P,T3
PJRST TTYSST ;Return, resetting TTY:
ESCRUL: ADJSP P,2 ;Make space for variables
DMOVEM P1,-1(P) ;Save previous values
ESCRL1: LDB P1,[POINT 8,ESCTAB(CX),7]
LDB P2,[POINT 8,ESCTAB(CX),15] ;Get lower and upper bounds
CAIL T1,(P1)
CAILE T1,(P2) ;Is character between them?
JRST ESCRL2 ;No
HRRZ CX,ESCTAB(CX) ;In between, advance to next rule
AOS -2(P) ;Skip for validity
PJRST .RES2 ;Restore ACs and return
ESCRL2: HRRZ P1,ESCTAB(CX) ;Didn't fit, another rule?
JUMPE P1,.RES2 ;Bad escape sequence
AOJA CX,ESCRL1 ;Check it
ISESC: TRNE T1,140 ;If not a control character,
POPJ P, ;It's not an escape
TRNN T1,200 ;Both C1 characters,
CAIN T1,.CHESC ;And the named one itself,
AOS (P) ;Are escapes
POPJ P, ;No others are
SUBTTL TTY: Service -- Escape sequence processing tables
; ESCTAB is the rule table used by CHKESC to define what is a legal
;ANSI escape sequence.
DEFINE ESC.(CH1,CH2,NXT),<
BYTE (8) "CH1","CH2"(2)(18)NXT
>
DEFINE ESCX(CH1,CH2,NXT),<
BYTE (8) CH1,CH2(2)(18)NXT
>
ESCTAB:
PHASE 0
ESCX .CHESC,.CHESC,$00 ; START OF SEQUENCE
ESCX 233,233,$15 ; CSI
ESCX "O"^!300,"O"^!300,$20
ESCX "Y"^!300,"Y"^!300,$30
ESCX 200,237,0 ; SINGLE-CHARACTER 'SEQUENCE'
$00: ESC. <;>,<;>,$10 ; <ESC><;><40:57>...<60:176>
ESC. ?,?,$10 ; <ESC><?><40:57>...<60:176>
ESC. O,O,$20 ; <ESC><O><40:57>...<100:176>
ESC. Y,Y,$30 ; <ESC><Y><40:176>...<40:176>
;ANSI control sequence
ESC. <[>,<[>,$15 ; <ESC><[><40:77>...<40:57>...<100:176>
;ESCape sequence <ESC><40:57>...<60:176>
$10: ESC. < >,</>,$10
ESC. <0>,<~>,0
$15: ESC. <0>,<?>,$15
$20: ESC. < >,</>,$20
ESC. <@>,<~>,0
$30: ESC. < >,<~>,$40
$40: ESC. < >,<~>,0
Z
DEPHASE
SUBTTL TTY: Service -- Echo type-ahead
; EKOTAH is called to echo all characters in the input queue. It should,
;of course, only be called once for a given input stream. It uses T1-T4.
EKOTAH: TXNE F,F$NEC ;Noecho?
POPJ P, ;Nice if filtered out earlier, but...
SAVE4 ;Save the Ps
TXO F,F$NEC ;Set no-echo
PUSHJ P,TTYSST
PUSHJ P,CLRCTO
PUSHJ P,WATDEQ ;Wait for output to complete
MOVEI P1,($TOICL!$TOOIN) ;Buffer flags
IORM P1,TOFLGS
PUSHJ P,SCNINI ;Init a scan
ECHOLP: PUSHJ P,SCNCHR ;Get a character
JRST EKOTAD ;Done
MOVEI T1,(P1) ;Copy character
PUSHJ P,CHKBR1 ;Break?
JRST [PUSHJ P,DOOUT1
SETZM TOFLGS
JRST EKOTAR ] ;Done
TXNE F,F$ESC ;Wanted ESC stuff?
TXZN F,F$ESA ;It became active?
TRNA
JRST EKOTAR
PUSHJ P,OUTTTY ;For now, assume just print it
JRST ECHOLP ;Continue
EKOTAD: PUSHJ P,DOOUT1 ;Force it out
SETZM TOFLGS ;Clear the flags
PUSHJ P,WATOUT ;Wait for it to complete
;Note that the below is a heuristic algorithm rather than a water-tight one.
DOFRCU: MOVE T1,[2,,T2] ;Make sure it's OK to do this
MOVEI T2,.TOBKC ;Get break count
MOVE T3,TTYUDX
TRMOP. T1, ;...
JRST EKOTAR
JUMPN T1,EKOTAR ;Don't do it
MOVE T1,[2,,T2] ;Only if priv'd, but c'est la vi
MOVE T2,[SIXBIT/.TYPE/]
MOVE T3,TTYUDX
FRCUUO T1,
JFCL
EKOTAR: TXZ F,F$NEC
PJRST TTYSST
SUBTTL TTY: Service -- Rubout processing
; DORUB is called to do the "normal" thing on a rubout, that is,
;rub out the last character. It uses T1-T4 and P1-P4. Call it with
;P1-P4 set from SCNSPC.
DORUB: PUSHJ P,SPCRUB ;Remove <RUB> and return previous
JRST SPCRMV ;None, remove the <RUB> and return
DORUB1: PUSHJ P,CHKBRK ;Is this a break?
POPJ P, ;Just toss rubout if break
LDB T1,P2 ;Get character rubbed out
PUSHJ P,RUBCHR ;Do a rubout
PUSHJ P,SPCRUB ;Remove character
TRNA ;Try harder if no precessor
POPJ P, ;Return
PUSHJ P,SPCRMV ;Remove character
SETO P1, ;Set a flag for those who care
POPJ P, ;Return
SUBTTL TTY: Service -- Routine to do display for <RUB>
; RUBCHR is called with the rubbed out character in T1. Its purpose
;is to do the "right" think on the screen. VIDRUB is called if we are on
;a CRT; it uses a table indexed by TTY: type to decide the sequence to
;rubout the character on the screen. Otherwise, the rubbed out character
;is delimeted by backslashes (consecutive characters get two backslashes
;between them).
RUBCHR:
PUSH P,T1 ;Save character
MOVEI T1,($TOOIN)
MOVEM T1,TOFLGS
SKIPL T1,TTYTYP ;Can we do a video rubout?
JRST VIDRUB ;yes
MOVEI T1,"\" ;Delimit rubbed out char
PUSHJ P,OUTTTY
POP P,T1 ;Restore character
PUSHJ P,OUTTTY ;...
MOVEI T1,"\"
PUSHJ P,OUTTTY ;..
RUBRET: PUSHJ P,DOOUT1
SETZM TOFLGS
POPJ P,
VIDRUB: PUSH P,T4 ;Save T4
MOVE T1,-1(P) ;Retrieve character for a while
PUSHJ P,VIDSIZ ;Get character width
CAMLE T4,HPOS ;If too big,
MOVE T4,HPOS ;Use position
SUBM T4,HPOS ;Fix it
MOVNS HPOS ;Correct the sign
PUSH P,T4
PUSH P,HPOS ;Make sure HPOS is set our way
VIDRU1: SOSGE -1(P) ;Any more to do?
JRST VIDRU2 ;No, exit routine
MOVE T1,TTYTYP ;Yes, get type index again
HRRZ T4,RUBS1(T1) ;Point to string
PUSHJ P,STROUT ;Output it
JRST VIDRU1 ;Do another
VIDRU2: POP P,HPOS ;Set HPOS correctly
POP P,T4 ;Trash
POP P,T4 ;Restore T4
POP P,T1
JRST RUBRET
VIDSIZ: SKIPE OSVID ;Have a video support routine?
PJRST @OSVID ;Yes, use it
MOVEI T4,1 ;No, assume that all are 1 wide
POPJ P, ;And hope for the best
SUBTTL TTY: Service -- Handle Control-U
; DOCTU is called to do "normal" Control-U processing. Call it with
;P1-P4 set from SCNSPC. It uses P1-P4 and T1-T4.
DOCTU: CAIE P4,INPQUE-IBF.LK ;Doing INPCHR?
JRST DOCTU1 ;No, skip on
PUSHJ P,SPCFLS ;Yes, eat it
PUSHJ P,SCNINI ;Point to new start
PJRST DOCTU4 ;Finish it off
DOCTU1: ADJSP P,3 ;Allocate stack space
DMOVEM P2,-2(P) ;Save P2 and P3
HRRZM P4,(P) ;And right half of P4
PUSHJ P,SCNLBK ;Scan to last break
HRRZS P4 ;Be sure only right half
CAMN P4,(P) ;In the same chunk?
JRST DOCTU5 ;Yes, handle differently
SUBM P3,ICHCNT ;All remaining chars in this chunk gone
SUBM P3,IBF.CT(P4) ;And here
MOVNS IBF.CT(P4) ;Keep the right sign
DOCTU2: HRRZ P4,IBF.LK(P4) ;Point to next link
CAMN P4,(P) ;One with the ^U in it?
JRST DOCTU3 ;Yes
MOVE T1,IBF.CT(P4) ;Get the count
ADDM T1,ICHCNT ;Remember ICHCNT has the wrong sign
SETZM IBF.CT(P4) ;No chars in this chunk
JRST DOCTU2 ;Until we hit the ^U
DOCTU3: POP P,P4 ;Restore where ^U was
POP P,P2 ;Count
POP P,IBF.PT(P4) ;It's where input will start
EXCH P2,IBF.CT(P4) ;Number of chars left
SUB P2,IBF.CT(P4) ;Difference=# chars skipped
ADDM P2,ICHCNT ;Take out of total
MOVNS ICHCNT ;And make right sign
DOCTU4: MOVEI T4,[ASCIZ/^U
/] ;Tell what we did
MOVEI T1,($TOOIN)
MOVEM T1,TOFLGS ;Override stuff
PUSHJ P,STROUT
TXO F,F$IEC ;Don't let LDBECC stop us
PUSHJ P,DOOUT1 ;Force it out
SETZM TOFLGS
POPJ P, ;Done
DOCTU5: ;Here if ^U and last break in same chunk
SUB P3,-1(P) ;# of chars skipped in chunk
MOVNS P3 ;Make negative
ADDM P3,ICHCNT ;So can take out of total
ADDM P3,IBF.CT(P4) ;And in this chunk
POP P,T4 ;Restore pointers in Ts
POP P,T3
POP P,T2
JUMPE T3,DOCTU4 ;If nothing else to do
DOCTU6: ILDB P1,T2
IDPB P1,P2 ;Else shuffle characters down
SOJGE T3,DOCTU6
JRST DOCTU4 ;Then return
SUBTTL TTY: Service -- Handle Control-R
; DOCTR is called to handle a Control-R. Call it with P1-P4 set
;up from SCNSPC and T1 set to address of routine to call after
;outputting "^R<CR><LF>", or zero if none.. It uses P1-P4 and T1-T4.
DOCTR: MOVEI T4,[ASCIZ/^R
/] ;Preceed with <CRLF>
PUSH P,T1 ;Save the routine address
MOVEI T1,($TOOIN)
MOVEM T1,TOFLGS
PUSHJ P,STROUT ;Output it
POP P,T1 ;Get the routine address
JUMPE T1,DOCTR0 ;None
PUSHJ P,(T1) ;Call it
MOVEI T1,($TOOIN)
MOVEM T1,TOFLGS ;Some routines trash this
DOCTR0: PUSHJ P,SCNLBK ;Scan to last break
DOCTR1: PUSHJ P,SCNCHR ;Get a character
JRST DOCTR3 ;Finish up then
CAIN P1,.CHCNR ;Is this the ^R?
JRST DOCTR2 ;Yes
MOVEI T1,(P1) ;Get character
PUSHJ P,OUTECH ;Output it
JRST DOCTR1
DOCTR2: PUSHJ P,SPCRMV ;Remove the character now
DOCTR3: TXO F,F$IEC ;Ignore LDBECC this once
PUSHJ P,DOOUT1 ;Force out
SETZM TOFLGS
POPJ P, ;Return
SUBTTL TTY: Service -- Set to handle ^U, ^R, <RUB>
; STRURB is called to set up masks and the TTY: to be sure we
;handle Ctl-U, Ctl-R, and Rubout ourselves. It uses T1.
STRURB: TXO F,F$RUB ;Flag to handle it ourselves
MOVX T1,<1B<.CHCNR>!1B<.CHCNU>>
IORM T1,IMASK+1
MOVEI T1,1B31 ;<RUB>
IORM T1,IMASK+1+3
SETZM IMASK ;TTYSST sets field width to 1
PUSHJ P,TTYSST ;Set up TTY:
PJRST FRCTTI ;Wake us up
SUBTTL TTY: Service -- Clear Handling of ^U, ^R, <RUB>
; UNRURB and UNRALL clear NRT's handling of Ctl-R, Ctl-U, and Rubout.
;Call UNRALL to clear checking of Ctl-R, Ctl-U, and Rubout unconditionally.
;Call UNRURB to clear "specialness" of UNRURB but not in the mask
;if they are supposed to be reak characters. These routines use T1 and T2.
;Call them with T3 containing the field width to be set (field width
;gets set to one so we can handle Ctl-U, Ctl-R, and Rubout correctly).
UNRURB: MOVX T1,<1B<.CHCNR>!1B<.CHCNU>>
XOR T1,LMASK
ANDX T1,<1B<.CHCNR>!1B<.CHCNU>>
MOVEI T2,1B31 ;Rubout
XOR T2,LMASK+3
ANDI T2,1B31
JRST DOUNRU
UNRALL: MOVX T1,<1B<.CHCNR>!1B<.CHCNU>>
MOVEI T2,1B31 ;And rubout
DOUNRU: ANDCAM T1,IMASK+1
ANDCAM T2,IMASK+1+3
MOVEM T3,IMASK
PUSHJ P,TTYSST
PJRST FRCTTI ;Wake up and return
;No-filter
SUBTTL NSP. Routines -- NSPEA - Make an active connection
; NSPEA does an enter active to a remote's NRTSRV. We are assuming
;that CONBLK has been set up already. NSPEA decides to enter either .OBHTH
;or .OBPST depending on the number of nodes the user has specified.
;NSPEA uses CX. NSPEA returns CPOPJ with the NSP. error code set
;up by SETNER on error, or returns CPOPJ1 with the connection set up.
;If FTPMR is on, NSPEA calls PMR, an external subroutine to actually
;do the connection so. PMR handles "automatic" Poor Man's Routing
;as specified in the file DCN:DNHOST.TXT.
NSPEA: SAVET1 ;Save T1
MOVE T1,OBJCNT ;Get -1 or 0 for indexing
MOVE T1,[EXP .OBCTM,.OBHTH]+1(T1) ;Get desired object type
IFN FTEPMR,<
SKIPE NODCNT ;Doing PMR?
MOVEI T1,.OBPST ;Yes, use pass-through task
>
MOVEM T1,DSTPDB+.NSDOB ;Store it
MOVE NSAFN,[NS.WAI!<.NSFEA>B17!<.NSAA2>+1] ;Set up the function word
SETZ NSACH, ;No channel yet
MOVEI NSAA1,CONBLK ;Point to the connect block
MOVE NSAA2,TTBAUD ;Get baud rate
SKIPL OBJCNT ;Use default if CTERM
CAILE NSAA2,SEGMAX ;Bigger than max?
SETZ NSAA2, ;Use default then
MOVE NSAA2,SEGTBL(NSAA2) ;Get the entry
MOVEI T1,NSAFN ;Point to the function block
IFN FTIPMR,<
TXO T1,PMR$RMR!PMRDCN ;Set to always do direct connection
PUSHJ P,PMR## ;(Look on DCN: to keep TEN happy)
>
IFE FTIPMR,<
NSP. T1, ;Enter Active
>
PJRST SETNER ;Set up NSP. error code for NSPERR
MOVEM NSACH,NSPACS+NSACH ;Channel is global
MOVEM NSACH,TTYACS+NSACH
MOVEM NSACH,OOBACS+NSACH
MOVEM NSACH,TMRACS+NSACH
JRST CPOPJ1 ;Return
SUBTTL NSP. Routines -- Set Link Quotas
; This routine is called to set the link quotas of the link based
;on the controlling TTY:'s baud rate. This is so that if functions
;(such as ^O to TOPS-10 or TOPS-20, for example) which are handled
;remotely are requested, they will not take too long due to network
;messages which have already been buffered ahead.
SETQUO: MOVE NSAFN,[.NSFRQ,,.NSAA3+1]
MOVEI T1,NSAFN
NSP. T1,
POPJ P, ;Can't do anything
MOVE CX,TTBAUD ;Get the baud rate
CAILE CX,QUOMAX ;Up to a certain point only
SETZ CX,
HRLI NSAFN,.NSFSQ ;Set quotas and goals
MOVEI T1,NSAFN
;Note that the below could be done in one NSP. UUO. It is done
;in two so that if the setting of the goal fails, the %input will
;still get set. We assume that the goal may fail due to privilege
;violation if the default goal is set to a low value (at this point
;the monitor doesn't privilege check at all; the goal at this
;point in time is to make the monitor fail if the user tries to set
;the goal higher than the default but not lower. This may change,
;however).
HLRE NSAA2,QUOTBL(CX) ;Get % to allocate
JUMPL NSAA2,SETQU1 ;No change
NSP. T1,
POPJ P, ;Oh well
SETQU1: HRRE NSAA3,QUOTBL(CX) ;Get goal
JUMPL NSAA3,CPOPJ ;No change
NSP. T1,
JFCL
POPJ P,
SUBTTL NSP. Routines -- NSPIN - NSP. Input routine
; NSPIN is called to input data from the network. It returns
;CPOPJ1 on success, or through SETNER on failure. On success, INPBUF
;will contain the network data, IBFCNT will contain the byte count, and
;IBFPTR is the ILDB pointer to the data stored at INPBUF. If called at
;NSPINW, the routine will block until a complete message is read or
;the buffer is full. If called at NSPIN and an incomplete message is
;only available (and the buffer isn't filled), then it will restore ACs
;and dismiss the interrupt in progress.
;NOTE THAT BECAUSE OF THE ABOVE, NSPIN SHOULD BE CALLED ONLY AT NETWORK
;INTERRUPT LEVEL.
;When a network interrupt signals more data is ready, network interrupt
;service will return here to complete the message. When it is complete
;(or the buffer is full), NSPIN will return to the caller.
;These routines use CX and the NSP ACs.
NSPINW: SKIPA NSAFN,[NS.WAI!<.NSFDR>B17!4]
NSPIN: MOVE NSAFN,[<.NSFDR>B17!4] ;Set up function word
SAVET1 ;Save T1
NSPCON: TXNE F,F$NEOM ;Seen EOM last?
JRST DONSPI ;No, don't re-init
SETZM IBFCNT
MOVEI NSAA1,IBUFSZ ;Get this many bytes if possible
MOVE NSAA2,[POINT 8,INPBUF] ;Make up the pointer
DONSPI: MOVEI T1,NSAFN ;Point to the function block
MOVE CX,NSAA1 ;Copy available chars to T1
NSP. T1, ;Data Read
PJRST SETNER ;Set up NSP. error code for NSPERR
TXNN NSAFN,NS.EOM ;End of message?
TXOA F,F$NEOM ;Set the NOT EOM flag
TXZ F,F$NEOM ;Clear the more to come flag
SUB CX,NSAA1 ;Calculate how many we have
ADDM CX,IBFCNT
TXNE NSACH,NS.NDA ;Normal data available?
TXNE NSAFN,NS.EOM ;Yes, is was EOM seen?
TRNA ;No data available or EOM
JUMPG NSAA1,DONSPI ;No EOM and data available, get if more room
SKIPN IBFCNT ;Anything there?
TXZ F,F$NEOM ;No, then clear this flag
JUMPE NSAA1,NINSAT ;Satisfied if full
TXNN F,F$NEOM ;EOM seen
JRST NINSAT ;Satisfied
PUSHJ P,EXCACS ;Restore the ACs
EXP NSPACS
SETOM INTLVL ;Free the interlock
HRROS INTOWN ;Note we released it
DEBRK.
XCT DNI ;DEBRK. not implemented
XCT NIP ;Should never happen
NINSAT: MOVE T1,[POINT 8,INPBUF-1,35] ;Make the pointer up again
MOVEM T1,IBFPTR ;Fake this, also
SKIPE FTRACE ;If trace active,
PUSHJ P,TRACEI ;Trace an input message
JRST CPOPJ1
SUBTTL NSP. Routines -- NSPOUT - Outputs OTPBUF to the network
; Called: OBFPTR/ byte pointer to last data byte
; NSPOUT is called to output the buffer pointer to by OBFPTR to
;the network. This routine call QUEOUT to output buffer, and falls
;into NSPO which attempts to output the buffer. NSPO is also called
;at network interrupt level to force out any buffers which had previously
;been queued (via calling NSPOUT) but could not be output. When buffers
;are completely output, they are returned to the free core pool.
;NSPOUT uses no ACs (other than the NSP ACs); NSPO uses T1-T4.
;The buffer will be sent with EOM unless the sign bit is on in the
;count field of the buffer header, or F$NEOM is set and this is NOT
;the last buffer in the queue.
NSPOUT: PUSHJ P,SAVT ;Save the Ts
PUSHJ P,QUEOUT ;Queue netword output buffer
FALL NSPO ;Fall into NSPO
NSPO: SKIPN T2,OUTQUE ;Anything in the output queue?
JRST CPOPJ1 ;Done
HLRZ NSAA1,OBF.CT(T2);Get count
MOVE NSAA2,OBF.PT(T2);And pointer
MOVE NSAFN,[NS.EOM!<.NSFDS>B17!.NSAA2+1] ;Set up function word
;NSAA1 (the count was set up before)
HRRZ T3,OBF.LK(T2) ;Pointer to next
JUMPE T3,NSPO1 ;If zero, follow EOM in buffer
TXNN F,F$EOMN ;Else use set flag
NSPO1: TRZE NSAA1,400000 ;Sign bit set?
TXZ NSAFN,NS.EOM ;Then clear EOM
SKIPL PRCERF ;Called from protocol error?
TXO NSAFN,NS.WAI ;Yes, then wait
MOVEI T1,NSAFN ;Pointer to argument block
NSP. T1, ;Data Send
PJRST SETNER ;Set up NSP. error code and return
MOVEI T1,(T2) ;Transfer ACs
JUMPN NSAA1,NSPEXI ;If didn't finish
HRRZM T3,OUTQUE ;Point to it
SKIPE FTRACE ;If tracing active,
PUSHJ P,TRACEO ;Write trace message to file
MOVEI T2,OBUFSZ+OBF.DT;Size of buffer
PUSHJ P,CORFRE ;Deallocate it
JRST NSPO ;Back for more
NSPEXI: HRLM NSAA1,OBF.CT(T1);Save count
MOVEM NSAA2,OBF.PT(T1);And pointer
AOS (P)
POPJ P, ;Success return
; NETQUE and QUEOUT are called to queue the buffer pointed to by
;OTPBUF into the network output queue, where it will be pushed out via
;NSPO. NETQUE uses no ACs; QUEOUT uses T1-T4. Both use the byte pointer
;in the buffer header to compute the number of bytes in the buffer. If
;the sign bit of OTPBUF is on, the buffer will be flagged to be output without
;EOM. This is done by setting the sign bit of the count word of the buffer.
;These routines also call INOBUF after queueing the current buffer to
;initialize a new one.
NETFIN: PUSHJ P,SAVT ;With all ACs saved
PJRST QUEOUT ;Send it out
NETQUE: PUSHJ P,SAVT ;With all ACs saved
HRROS OTPBUF ;Force no EOM
QUEOUT: MOVE T1,OTPBUF ;Point to buffer
MOVE T1,OBF.PT(T1) ;Get pointer
MOVE T2,OBFPTR ;Get current location pointer
PUSHJ P,BPLENG ;Calculate length based on difference
SKIPGE T2,OTPBUF ;See if sign bit is set...
TRO T1,400000 ;Set no EOM when sending
HRLZM T1,OBF.CT(T2) ;Store count there
MOVEI T3,OUTQUE-OBF.LK
OUTCHK: SKIPE T4,OBF.LK(T3) ;Make first time a litte faster
TRNN T4,-1 ;Pointer to next?
JRST OUTFND ;No
HRRZI T3,(T4) ;Get next entry
JRST OUTCHK ;Continue
OUTFND: HRRM T2,OBF.LK(T3) ;Queue it up
PJRST INOBUF ;Re-init the output buffers
SUBTTL SETNOD - Sets up node name in ASCNOD in the connect block
; SETNOD is called to translate the SIXBIT node name stored at RNODE
;into an eight-bit ASCII name in the connect block, suitable for use in
;the NSP. .NSFEA function. It falls into SIX2SB and therefore uses
;T1-T2 and P1-P2.
SETNOD: MOVE T1,RNODE ;Get the node name
MOVEI T2,ASCNOD ;PUT IT IN THIS STRING BLOCK
FALL SIX2SB ;Do it
SUBTTL SIX2SB - Store SIXBIT T1 in string block pointed to by T2
; SIX2SB takes a SIXBIT string in T1 and translates it to eight-bit
;ASCII, placing the result in the string block pointed to by T2. SIX2SB
;uses P1-P2 as well.
SIX2SB: SAVE2 ;Save P1,P2
MOVE P1,T2 ;Preserve the string block pointer
MOVE P2,[POINT 8,1(P1)] ;Set up byte pointer to data part of block
SETZ T2, ;Use T2 for count
MOVE T3,[POINT 6,T1] ;and T1 for a byte pointer into SIXBIT name
SIXS21: ILDB T4,T3 ;Get a byte from SIXBIT name
JUMPE T4,SIXS22 ;Nothing there, must be end of name
ADDI T4," " ;ASCIIize the byte
IDPB T4,P2 ;Store it in the string block
CAIE T2,6 ;If we've hit six bytes, don't try anymore
AOJA T2,SIXS21 ;Otherwise, loop
SIXS22: HRLM T2,(P1) ;Put the count in the first block
ASH T2,-2 ;Make count into words
ADDI T2,2 ;Some overhead
HRRM T2,(P1) ;Put max length in
POPJ P, ;And return
SUBTTL INIOBF - Initialize OBUF and IBUF
; These routines are called to initialize IBFPTR/IBFCNT, and
;OBFCTR/OBFPTR. INIOBF initializes both input and output buffers;
;INOBUF initializes only output buffers. They use T1-T2. The input buffer
;is fixed; the output buffers are allocated dynamically from the free core
;pool.
INIOBF:
SETZM IBFCNT ;Just being paranoid
MOVE T1,[POINT 8,INPBUF-1,35]
MOVEM T1,IBFPTR
INOBUF: MOVEI T1,OBUFSZ+OBF.DT ;Include the header
PUSHJ P,CORGET ;Get a buffer
HRRZM T1,OTPBUF ;Save it (Default to send EOM)
MOVE T2,[POINT 8,OBF.DT] ;Make byte pointer to data portion
ADD T2,T1 ;Put into proper perspective
MOVEM T2,OBFPTR ;Set pointer
MOVEM T2,OBF.PT(T1) ;Save for later output
MOVE T1,SNDMMS ;Get maximum allowable message size
MOVEM T1,OBFCTR ;For those who care...
POPJ P, ;Return to sender
SUBTTL BPLENG - Compute length of byte pointer in T1
; BPLENG is called to compute the number of bytes in the buffer. It
;is called with the byte pointer to the beginning of the buffer in T1 and
;the byte pointer to the end of the buffer in T2. Both pointers
;must specify eight-bit bytes and the beginning pointer must be word aligned.
;BPLENG returns with the number of bytes in T1. T1 and T2 are used.
BPLENG: SAVE2 ;Save P1,P2
DMOVE P1,T1 ;Preserve the byte pointers
HLRZ T1,P1 ;Get the s and p stuff
CAIE T1,(POINT 8,) ;Is it word aligned and 8 bits?
ERR IBP,<Illegal byte pointer>
HRRZ T1,P2 ;Get the address part of new BP
HRRZ T2,P1 ;and old BP
SUB T1,T2 ;Get the difference
ASH T1,2 ;Make it into bytes
LDB T2,[POINT 6,P2,6+5] ;Get S field of byte pointer
CAIE T2,^D8 ;Is it eight bits?
ERR IBS,<Illegal byte size>
LDB T2,[POINT 6,P2,5] ;Get P field of byte pointer
SUBI T2,4 ;P starts at the right
ASH T2,-3 ;Divide by eight
SUBI T2,4 ;Reverse the order
SUB T1,T2 ;Figure out the final count
POPJ P, ;And return
SUBTTL Miscellaneous support - Digest a mask
; CPYMSK is called to take a mask from the current position of
;the network input buffer and copy it to the place specified by the
;byte pointer in T3. Enter with T4 containing the count for the
;mask; T4 must be non-zero.
; This routine is provided for systems like RSX and VMS which
;provide a break mask for input termination where the bytes appear
;in the network buffer from low-order to high order and the correspondance
;of bits to ASCII character values (in each byte) proceeds with the
;high order bit representing the highest character value. In TOPS-10
;format we translate the following into the B0-B32 format:
CPYMSK: PUSHJ P,RBYTEC ;Get a byte
REPEAT 0,<
MUL T1,[100200401002] ;Reverse the bits
AND T2,[20420420020];via HACKMEM
ANDI T1,41
DIVI T1,1777 ;Casting out 2**10.-1's
>
MOVE T2,REVBYT(T1) ;Reverse the bits via in-core table
IDPB T2,T3
SOJG T4,CPYMSK ;And continue copying the mask
POPJ P, ;Return
SUBTTL Miscellaneous support - Reverse a network byte
; Since bytes come in from the network in Lilliputian order,
;we must convert them to the proper Blefuscan perspective before they are
;considered useful and ritually clean by the high priests.
ZZ==0
REVBYT:
REPEAT ^D256,<
ZZZ==0
ZZL==B7
ZZR==B0
REPEAT 4,<
IFN ZZ&ZZL,<ZZZ==ZZZ!ZZR>
IFN ZZ&ZZR,<ZZZ==ZZZ!ZZL>
ZZR==ZZR_1
ZZL==ZZL_-1
>
EXP ZZZ
ZZ==ZZ+1
>
PURGE ZZ,ZZZ,ZZL,ZZR
SUBTTL Miscellaneous support - Translate bit number to bit
;Sometimes we need to test a bit in a word via its number. While this can
;be done with negation and a LSH of 1B0, we prefer to index into a table.
BITTBL: ZZ==1B0 ;START HERE
REPEAT ^D36,< ZZ
ZZ==ZZ_-1>
SUBTTL Miscellaneous Support -- GET & PUT word routines
; These routines are for -11 flavoured machines which have
;bytes in reversed order. The GETxxx routines input the appropriate
;quanity (2 bytes for WRD and 4 bytes for LWD) into T1 from the
;current position in the network input buffer; the PUTxxx routines
;output from P1 to the current position in the output buffer.
;These routines use CX and the appropriate argument AC.
;The PUTxxx routines do not destroy the argument.
PUTINT: SAVE1 ;Preserve abused AC
MOVE P1,T1 ;Move argument register
FALL PUTWRD ;Look like following
PUTWRD: NETOCH P1 ;Network character
ROT P1,^D-8 ;Shift down
NETOCH P1 ;And second half
ROT P1,^D8 ;Make it look right
POPJ P, ;And return
PUTLWD: MOVEI CX,^D3 ;Number of times to do it
PUTL1: NETOCH P1
ROT P1,-^D8 ;Do the next 8
SOJG CX,PUTL1 ;Loop for all of them
NETOCH P1
ROT P1,-^D12 ;In place again
POPJ P, ;And return
GETWRD:!
GETINS: PUSHJ P,RBYTEC ;Get a byte from the system
PUSH P,T1 ;Save it
PUSHJ P,RBYTEC ;And another
LSH T1,^D8 ;Put the upper 8 bits first
IOR T1,(P) ;OR in the lower 8 bits
POP P,(P) ;Loose the number we stored
POPJ P, ;And return
GETINT: PUSHJ P,GETBYT ;Get a byte from the system
POPJ P, ;Propagate failure
PUSH P,T1 ;Save it
PUSHJ P,GETBYT ;Get another
JRST TPOPJ ;Propagate failure
LSH T1,8 ;This is the high-order byte
IOR T1,(P) ;Merge in the low-order byte
ADJSP P,-1 ;Trim stack
JRST CPOPJ1 ;Return success
GETINZ: PUSHJ P,GETINT ;Get a two-byte integer
SETZ T1, ;Default to zero if none
POPJ P, ;And return it
SKPCNT: JUMPE T1,CPOPJ ;Nothing to do if no bytes to skip
PUSH P,T1 ;Save the count
SKPCN1: PUSHJ P,RBYTEC ;Get a byte from the system
SOSLE (P) ;Loop if more
JRST SKPCN1 ;Skip as many as were requested
JRST TPOPJ ;Return success when done
GETIND: PUSHJ P,GETBYS ;Get count of bytes to read
GETINC: JUMPE T1,CPOPJ ;Already have it if null
PUSH P,[0] ;Save a clean accumulation value
PUSH P,[0] ;And the initial LSH value
PUSH P,T1 ;Save required count
GETIN1: PUSHJ P,GETBYS ;Get a byte
ASH T1,@-1(P) ;Shift over to correct place
IORM T1,-2(P) ;Merge into return value
MOVEI T1,8 ;Amount to increase shift width
ADDM T1,-1(P) ;Update for next time
SOSLE (P) ;Loop termination test
JRST GETIN1 ;Get as many bytes as were requested
ADJSP P,-2 ;Trim junk from the stack
JRST TPOPJ ;Return the counted integer
GETLWD: MOVSI T1,20000 ;Get an indicator in T1
GETLW1: PUSH P,T1 ;Save T1
PUSHJ P,RBYTEC ;Get a data byte
MOVE T2,T1 ;Save the number in T1+1
POP P,T1 ;Restore the old stuff
ROTC T1,-^D8 ;Put it in place
JUMPGE T2,GETLW1 ;Loop for all of them
ASH T1,-^D4 ;Use the lower 32 bits
POPJ P, ;And return
PUTSTR: SOJL T3,CPOPJ ;Done if no more bytes
ILDB T1,T2 ;Get next byte from string
NETOCH T1 ;Send it
JRST PUTSTR ;Loop over entire string given
SUBTTL Miscellaneous Support -- CTERM GET & PUT routines
CCOSET: SKIPA T2,[CCOBYT] ;GOING TO SEND A BYTE
CCOST2: MOVEI T2,CCOINT ;GOING TO ADD A ZERO FLAGS BYTE
MOVE T3,CCOMMS ;GET CURRENT MAX. MESSAGE SIZE
MOVEM T3,CCOCNT ;SAVE FOR COUNTDOWN LIMIT
MOVE T3,[POINT 8,CCOBUF] ;GET INITIAL POINTER TO COMMON-DATA BUF
MOVEM T3,CCOPTR ;SET FOR OUTPUT ROUTINES
PUSHJ P,(T2) ;SET THE CTERM MESSAGE TYPE
MOVE T2,CCOCNT ;GET REMAINING COUNTER
MOVEM T2,CCOLIM ;SAVE FOR BACKUP LIMIT
POPJ P, ;RETURN
CCOFIN: MOVE T1,CCOLIM ;GET BACKUP LIMIT
CAMN T1,CCOCNT ;ANYTHING TO SEND?
JRST CCOFNE ;NO, DON'T BOTHER
CCOFN2: SKIPN CCOLIM ;SEND ALWAYS, UNLESS ALREADY DONE
ERR CST,<Can't send twice>
HRRZ T1,OTPBUF ;POINT TO CURRENT NSP BUFFER
LDB T1,[POINT 8,OBF.DT(T1),7] ;READ FIRST BYTE
CAIE T1,.FMCMD ;COMMON DATA?
JRST CCOFN3 ;NO, MUST SEND THIS & START UP .FMCMD
MOVE T1,CCOMMS ;YES, GET INITIAL SUB-MSG ALLOCATION
SUB T1,CCOCNT ;FIND SIZE OF SUB-MESSAGE
CAMG T1,OBFCTR ;IS THERE ENOUGH ROOM LEFT TO MERGE IT?
JRST CCOFN4 ;YES, WIN
CCOFN3: PUSHJ P,FNDFIN ;FLUSH OUT THE FOUNDATION MESSAGE
MOVEI T1,0_8!.FMCMD ;FOUNDATION:COMMON-DATA, FLAGS ARE ZERO
PUSHJ P,PUTINT ;SEND THE OVERHEAD
CCOFN4: MOVE T1,CCOMMS ;GET STARTING SIZE OF BUFFER
MOVE T3,CCOCNT ;AND ENDING SIZE
SUBB T1,T3 ;GET SUB-MESSAGE SIZE (TWICE)
PUSHJ P,PUTINT ;SEND THE SIZE
MOVE T2,[POINT 8,CCOBUF] ;POINT TO THE SUB-MESSAGE BLOCK
PUSHJ P,PUTSTR ;SEND IT AFTER ITS SIZE
CCOFNE: SETZM CCOLIM ;DETECT ERRORS
RETSKP ;RETURN WINNITUDE
CCOWRD: PUSHJ P,CCOST2 ;SEND VALUE & FLAGS
PJRST CCOFN2 ;AND THAT'S ALL
CCOINT: SOSL CCOCNT ;COUNT DOWN FOR TWO BYTES
SOSGE CCOCNT ;TO STORE AN INTEGER
ERR CBO,<CTERM buffer overflowed>
IDPB T1,CCOPTR ;SEND LOW-ORDER BYTE
ROT T1,-8 ;POSITION
IDPB T1,CCOPTR ;SEND HIGH-ORDER BYTE
ROT T1,8 ;RESTORE ARGUMENT
POPJ P, ;RETURN
CCOBYT: SOSGE CCOCNT ;COUNT DOWN THE BYTE
XCT CBO ;BOMB IF OVERLOWED BUFFER
IDPB T1,CCOPTR ;STUFF BYTE INTO MESSAGE
POPJ P, ;RETURN
CCOSTR: CAMLE T3,CCOCNT ;MAKE SURE THERE'S ROOM
XCT CBO ;COMPLAIN IF NOT
MOVNS T3 ;MAKE INTO DECREMENTOR
ADDM T3,CCOCNT ;UPDATE THE COUNT IN ONE FELL SWOOP
CCOST1: AOJG T3,CPOPJ ;DONE IF NO MORE BYTES
ILDB T1,T2 ;ELSE GET NEXT BYTE
IDPB T1,CCOPTR ;STUFF INTO MESSAGE
JRST CCOST1 ;LOOP OVER ENTIRE ARGUMENT STRING
CCOSTP: CAMLE T3,CCOCNT ;MAKE SURE THERE'S ROOM
XCT CBO ;COMPLAIN NOW IF NOT
JUMPE T3,CPOPJ ;DONE IF NO BYTES
CCOSP1: ILDB T1,T2 ;GET NEXT BYTE OF STRING
JUMPE T1,CCOSP2 ;START PADDING IF END OF ASCIZ ARG
PUSHJ P,CCOBYT ;NO, STUFF THE BYTE
SOJG T3,CCOSP1 ;LOOP IF MORE BYTES REQUIRED
POPJ P, ;RETURN IF ENOUGH SENT
CCOSP2: MOVEI T1," " ;GET A SPACE FOR PADDING
CCOSP3: PUSHJ P,CCOBYT ;STUFF ANOTHER SPACE
SOJG T3,CCOSP3 ;LOOP UNTIL ENOUGH BYTES INSERTED
POPJ P, ;RETURN AT END OF FIELD
CCIBYZ: SKIPN T1,P1 ;IF NO MORE BYTES,
POPJ P, ;RETURN ZERO
FALL CCIBYT ;ELSE, GET ONE
CCIBYT: SOSGE P1 ;COUNT DOWN ANOTHER BYTE
ERR CBU,<CTERM buffer underflow>
PJRST GETBYS ;GET NEXT BYTE FROM MESSAGE
CCIINZ: SKIPN T1,P1 ;IF NO MORE BYTES,
POPJ P, ;RETURN ZERO
FALL CCIINT ;ELSE, GET SOME
CCIINT: SOSL P1 ;MAKE SURE
SOSGE P1 ;THERE ARE ENOUGH BYTES LEFT
XCT CBU ;SUB-MESSAGE LENGTH RAN OUT
PJRST GETINS ;RETURN AN INTEGER
CCISKP: PUSHJ P,CCICNT ;ACCOUNT FOR BYTES TO BE SKIPPED
PJRST SKPCNT ;SKIP THEM AND RETURN
CCICNT: CAMLE T1,P1 ;ARE THERE THAT MANY TO READ?
XCT CBU ;NO, COMPLAIN
SUB P1,T1 ;YES, USE FOUNDATION-LEVEL ROUTINES
POPJ P, ;BUT GO FOR IT
CCIIND: PUSHJ P,CCIBYT ;GET THE COUNT
CCIINC: PUSHJ P,CCICNT ;ACCOUNT FOR BYTES TO BE SCANNED
PJRST GETINC ;AND GO READ A COUNTED INTEGER
CCISTR: JUMPE T3,CPOPJ ;DONE IF NO MORE BYTES
PUSHJ P,CCIBYT ;GET NEXT BYTE
IDPB T1,T2 ;STORE IN STRING BLOCK
SOJA T3,CCISTR ;LOOP FOR ENTIRE COUNT
CCIASD: PUSHJ P,CCIBYT ;GET THE COUNT
JUMPE T1,CPOPJ ;HANDLE ZERO BYTES
PUSHJ P,CCICNT ;ACCOUNT FOR BYTES TO BE SCANNED
CAMLE T1,IBFCNT ;ENOUGH CHARACTERS TO RECEIVE?
XCT UED ;ERROR IF NOT
MOVE T2,T1 ;COPY BYTE COUNT
ADJBP T2,IBFPTR ;GET 'AFTER' BYTE POINTER
EXCH T2,IBFPTR ;STORE, AND GET B.P. TO DATA
MOVEM T2,TRNBLK+.CHSB1 ;SAVE OUR BYTE POINTER
MOVN T2,T1 ;GET -VE COUNT
ADDM T2,IBFCNT ;THIS MANY FEWER IN THE BUFFER
TXO T1,CH.6BT ;MERGE FLAGS INTO COUNT
MOVEM T1,TRNBLK+.CHSCT ;SAVE IN BLOCK
MOVEI T1,6 ;SIX BYTES IN A WORD
MOVEM T1,TRNBLK+.CHDCT ;STORE AS DEST. COUNT
MOVE T1,[POINT 6,TRNWRD] ;B.P. FOR STORAGE
MOVEM T1,TRNBLK+.CHDB1 ;SET AS DEST. POINTER
SETZM TRNWRD ;CLEAR DESTINATION
XMOVEI T2,TRNBLK ;POINT TO OUR ARG BLOCK
CHTRN. T2, ;TRANSLATE THE CHARACTERS TO SIXBIT
NOP ;IGNORE FAILURES (INVALID CHAR LIKELY)
MOVE T1,TRNWRD ;RETURN SIXBIT VALUE
POPJ P, ;DONE
SUBTTL Miscellaneous Routines
; These are the AC saving/restoring routines/co-routines. Most of
;them are called by MACROS. This is shown in the following table:
; Routine MACRO Call Function
; .SAVT1 SAVT1 JSP Save/restore T1
; SAVT --- PUSHJ Save/restore T1-T4
; REST --- JRST Restore T1-T4
; .SAV1 SAVE1 JSP Save/restore P1
; TPOPJ --- JRST Restore T1
; P1POJ1 --- JRST Restore P1/skip return
; P1POPJ --- JRST Restore P1
; .SAV2 SAVE2 JSP Save/restore P1-P2
; .SAV4 SAVE4 JSP Save/restore P1-P4
; .RES4 --- JRST Restore P1-P4
;In the above, JSP calls use AC CX. Restoration routines restore ACs from
;the stack.
.SAVT1: PUSH P,T1
PUSHJ P,0(CX)
TRNA
AOS -1(P)
POP P,T1
POPJ P,
SAVT: EXCH T1,(P)
PUSH P,T2
PUSH P,T3
PUSH P,T4
PUSH P,[REST]
PUSH P,T1
MOVE T1,-5(P)
POPJ P,
REST: TRNA
AOS -4(P)
POP P,T4
POP P,T3
TTPOPJ: POP P,T2
TPOPJ: POP P,T1
POPJ P,
.SAV1: PUSH P,P1
PUSHJ P,0(CX)
TRNA
P1POJ1: AOS -1(P)
P1POPJ: POP P,P1
POPJ P,
.SAV2: PUSH P,P1
PUSH P,P2
PUSHJ P,0(CX)
TRNA
AOS -2(P)
.RES2: POP P,P2
POP P,P1
POPJ P,
.SAV4: ADJSP P,4
DMOVEM P1,-3(P)
DMOVEM P3,-1(P)
PUSHJ P,(CX)
TRNA
AOS -4(P)
.RES4: DMOVE P1,-3(P)
DMOVE P3,-1(P)
ADJSP P,-4
POPJ P,
REPEAT 0,<
;STKVAR SUPPORT
.XSTKS: ADJSP P,@(CX) ;MAKE ROOM FOR N VARIABLES
PUSH P,(CX) ;SAVE VARIABLE COUNT FOR LATER TRIMMING
PUSHJ P,1(CX) ;CALL OUR CALLER (AFTER THE IN-LINE ARG)
TDZA CX,CX ;ZERO-OFFSET RETURN
MOVEI CX,1 ;+1 RETURN
SETCMM (P) ;N := -N - 1
ADJSP P,@(P) ;TRIM N VARIABLES + OVERHEAD FROM STACK
ADDM CX,(P) ;PROPAGATE SKIPNESS IF PRESENT
POPJ P, ;RETURN ON BEHALF OF CALLER
>
SUBTTL Returns
; These are return routines which are JRSTed to: TPOPJ1 restores
;T1 from the stack and skips, CPOPJ1 skip returns, and CPOPJ just returns.
TPOPJ1: POP P,T1
CPOPJ1: AOS (P) ;Skip
CPOPJ: POPJ P, ;Return to caller
SUBTTL EXCACS
; EXCACS is called by the interrupt service routines to exchange
;AC sets. Call is:
; PUSHJ P,EXCACS ;Call
; EXP ACset ;Block of 20 locations with which to
; ;exchange current ACs
;AC F is not altered.
ASSUME F,0
ASSUME P,17
EXCACS: PUSH P,@(P) ;Push addr of AC block on stack
MOVEM F,@(P) ;Save F
MOVE F,T1 ;Save T1 in F
POP P,T1 ;Address of AC block in T1
EXCH F,T1(T1) ;Switch the T1s
PUSH P,T2 ;Save T2
MOVE T2,P(T1) ;Get the right PDL pointer
EXCH T2,P ;New pointer to P, old one to T2
ADJSP P,2 ;Allocate space
POP T2,(P) ;T2 to new PDL
POP T2,-1(P) ;Return addr to new PDL
MOVEM T2,P(T1) ;What P to restore
POP P,T2 ;Restore T2
EXCH T2,T2(T1) ;And now do the others
EXCH T3,T3(T1)
EXCH T4,T4(T1)
EXCH P1,P1(T1)
EXCH P2,P2(T1)
EXCH P3,P3(T1)
EXCH P4,P4(T1)
EXCH CX,CX(T1)
EXCH NSAFN,NSAFN(T1)
EXCH NSACH,NSACH(T1)
EXCH NSAA1,NSAA1(T1)
EXCH NSAA2,NSAA2(T1)
EXCH NSAA3,NSAA3(T1)
MOVE T1,F(T1) ;Restore flags to T1
EXCH T1,F ;Flags to F, T1 to T1
AOS (P) ;Skip the AC block designator
POPJ P, ;And return
SUBTTL Operating System Specific Support
; The rest of the code in NRT is concerned with supporting specific
;operating system's remote terminal servers. This section contains an
;overview of the general requirements for supporting an operating system.
; Each operating system requires an initialization routine,
;a network interrupt service routine, and a TTY: service interrupt routine.
; The initialization routine is called when NRT knows what type
;of operating system the remote host is. This information is passed in the
;configuration message from the remote host. The initialization routine
;is responsible for setting flags as to which data mode the TTY: should
;be in (PIM or ASCII line) and calling TTYSST to set that up. It is also
;responsible for sending the appropriate return configuration message
;and any other messages which should be sent to the remote host at
;initialization time (e.g. the unsolicited interrupt to VMS to simulate
;typing a <CR> on a terminal).
; The network interrupt routine is responsible for handling any
;messages sent by the remote host over DECnet. This can range
;from simply outputting the data to the TTY: (as is the case
;for TOPS-10 and TOPS-20) or processing the messages as various
;flavours of I/O requests (as is the case for VMS and RSX).
;The network interrupt service is called by DCNPSI, the operating system
;independent network interrupt service routine, when a complete message
;is available or the network input buffer is full.
; The TTY: interrupt service has the responsiblity of handling
;characters typed by the user. It is responsible for noticing the
;escape character was typed and calling MONITO. Other than that, its
;responsibilities may be simply to ship the characters typed by the
;user out to the network (as is the case for TOPS-10 and TOPS-20), or
;they may include local processing and buffering of characters until
;the remote host requests them (VMS and RSX). The TTY: interrupt service
;is called by the operating system independent TTY: service routine
;(TTYPSI) when new TTY: input is available.
; Currently there are two basic types of protocols used.
;The first type is referred to henceforth as a TRANSPARENT protocol; the second
;as a MESSAGE protocol. Some operating systems combine elements from
;each type of protocol.
; A transparent protocol is one in which the DECnet messages
;passed between the local and remote hosts consist simply of the characters
;typed by the user and sent from the programs running on the remote host.
;Messages are passed when the connection is established to confirm that
;the correct protocol is being used, but from that point forward any message
;sent is considered to be data to be input by the remote host or displayed
;on the terminal by the local host. All echoing and special character
;handling is handled by the remote host. Generally, type-ahead is also
;handled by the remote host. Transparent protocols are usually handled
;by doing terminal I/O in PIM mode and simply passing the characters
;directly through to the remote host. Any characters sent from the
;remote host are sent immediately to the terminal. Since all echoing
;is done by the remote host, the remote host is also responsible for
;handling echo deferring, etc.
; A message protocol exists where the DECnet messages passed between
;the local and remote host consist of requests for characters or information
;(generally sent only from the remote to the local host) and acknowledgements
;fulfillments of the above mentioned requests (may be sent in either
;direction). In general, in a message protocol, typed characters are
;not sent from the local to the remote host until they are requested by
;the remote host. Echoing and special character handling are normally
;done by the local host in a message protocol. Type-ahead
;is the responsiblity of the local host. A message protocol
;is handled by not transferring the user's typed characters from NRT's
;internal buffers to the network until a request is received from the
;remote host for them. The remote host provides a break mask (or utilizes
;an implied mask) and a maximum count with each request. At this point,
;characters will be transferred to the remote host as dictated by the
;specific request. If the characters arrive after the request, NRT will
;have allowed the monitor to echo them (assuming they are to be echoed).
;If the characters are typed before the request is received, NRT will
;not allow the monitor to echo them and will echo them when they are
;sent out over the network.
; Rather than describe each routine in detail, the rest of the
;PLM will consist of a general description of each operating system type
;and pointers to appropriate reference manuals. The general description
;will outline the type of protocol which is used to communicate with the
;remote host and any peculiarities of the particular operating system.
;This lack of detailed documentation is in part intentional. The user
;should NOT try to repair any operating system specific routines unless
;he thoroughly understands both NRT's general approach (as described in
;in this manual) AND the appropriate internals (not just the external
;appearance) of the remote host. To this effect, lists of appropriate
;documents will be provided, but it is the user's responsibility to
;read the suggested references.
; In debugging NRT, it is very helpful to utilize the DNSNUP
;program provided on the DECnet Tools Tape. This program is invaluable
;in providing a trace of what the remote operating system is actually
;sending you (as opposed to what the spec says).
; I repeat for emphasis:
;DO NOT TRY TO "FIX" ANY OPERATING SYSTEM SPECIFIC CODE UNLESS YOU THOROUGHLY
;UNDERSTAND THE REMOTE HOST OPERATING SYSTEM, UNDER PENALTY OF GETTING BOTH
;NRT AND YOUR FINGERS BROKEN.
SUBTTL RSTS Support -- Protocol definitions
;Message types:
MT$CFG==1 ;Configuration message
MT$CTL==2 ;Control message
MT$UNS==3 ;Unsupported protocol message
MT$DAT==5 ;Data message
;Menu items (control message)
MN$EKO==1 ;Echo control
MN$MSK==2 ;Change delimiter mask
MN$WID==4 ;TTY: width
;Echo state:
EK$OFF==1 ;Off
EK$ON==2 ;On
SUBTTL RSTS Support -- RSTS network input
RST.NT: PUSHJ P,NETICH ;Anything from the other end?
POPJ P, ;None?
MOVEI P1,RSSFNC ;Get the function code table
PUSHJ P,FNDFNC ;Find the function
ERR IRS,<Illegal RSTS function>
POPJ P, ;Return
SUBTTL RSTS Support -- TTY: input
RST.TT: PUSHJ P,SCNSPC ;Scan for special characters
JRST [PUSHJ P,RST.SC ;Handle them
JRST .-1 ] ;Check again
TXZN F,F$BRK ;Is there a break?
JRST SCRURB ;No, check rubout stuff
MOVEI T1,MT$DAT ;Data message
NETOCH T1 ;Set it
PUSH P,OBFPTR ;Save pointer to counts
NETALC 3 ;Allocate 3 bytes in network buffer
SETZ P1, ;Init character counter
RST.T1: PUSHJ P,INCHR ;Go get what we can from the TTY
JRST RST.T5 ;Nothing
RST.T3: NETOCH T1 ;Output char to networkk
PUSHJ P,CHKBR1 ;Break character?
AOJA P1,RST.T4 ;Yes
AOJA P1,RST.T1 ;Count character
RST.T4: TXNE F,F$NEC ;Noecho?
JRST RST.T5 ;Yes, don't do it then
HLRZ T1,BRKCHR
MOVE T4,[-RSBLEN,,RSBTBL]
PUSHJ P,EKOBRK ;Echo the break character
RST.T5: MOVE T1,OBFPTR
EXCH T1,(P)
MOVEM T1,OBFPTR ;Point to counts
MOVEI T1,3 ;Fudge counts
ADDM T1,OBFCTR
MOVEI T1,(P1) ;Data count
MOVEI P1,4(P1) ;Message size
PUSHJ P,PUTWRD
NETOCH T1 ;Data size
POP P,OBFPTR ;Point to real end of message
PUSHJ P,XMTMSS ;Output the message
MOVE T2,RSTDMK ;Get count
PJRST SCRURB ;Clear as appropriate
SUBTTL RSTS Support -- RST.IN - Initialization Routine
RST.IN: MOVX T1,TC.NSA_TC.VLO ;Special-action value bit
ANDCAM T1,CATTAB+.CHCRT ;RSTS likes LF after CR
MOVEI T1,RST$CF ;Send config
TXO F,F$READ!F$ACO ;Always outstanding read
TXZ F,F$PIM
PUSHJ P,XMTMSG ;
MOVEI T1,RST$UN ;Send input
PUSHJ P,XMTMSG
MOVE T1,[RSTDMK,,IMASK]
BLT T1,ENDMSK
MOVE T1,[RSTDMK+1,,LMASK]
BLT T1,ELMASK
PJRST TTYSST ;Set up TTY
SUBTTL RSTS Support -- RST.CT - RSTS control Message
RST.CT: PUSHJ P,GETWRD ;Get length of message
PUSHJ P,GETIND ;Get menu bytes by count
MOVE P1,T1 ;Save it
PUSHJ P,RBYTEC ;Get echo specifier
TRNN P1,MN$EKO ;Change it?
JRST RS.CT1 ;No
TRNE T1,EK$OFF ;Turn echo off?
TXOA F,F$NEC ;Yes
TXZ F,F$NEC
RS.CT1: TRNN P1,MN$MSK ;Set mask?
JRST RS.CT3 ;No, skip some
MOVE T3,[POINT 8,IMASK+1,] ;Destination pointer
MOVEI T4,^D32 ;Number of bytes
PUSHJ P,CPYMSK ;Copy it
MOVE T1,[IMASK+1,,LMASK] ;Set logical mask too
BLT T1,ELMASK
RS.CT3: PUSHJ P,TTYSST ;Set up TTY:
PJRST FRCTTI ;Look at changes
SUBTTL RSTS Support -- RST.DA - Recieve Data message
RST.DA: IBP IBFPTR ;Skip over the count
IBP IBFPTR ;Second byte
IBP IBFPTR ;And count of characters
MOVNI T1,^D3 ;Adjust for what we just took
ADDM T1,IBFCNT
PJRST NETCHR ;Get some data
SUBTTL RSTS Support -- Handle special characters
RST.SC:
RS.CTU: CAIE P1,.CHCNU ;Control-U?
JRST RS.CTR ;Control-R
PUSHJ P,DOCTU ;Do the control-U
PJRST UNRURB ;Clear the bits
RS.CTR: CAIE P1,.CHCNR ;Control-R?
PJRST DORUB ;Must be rubout
SETZ T1, ;No routine
PUSHJ P,DOCTR ;Do the Control-R
PJRST SPCRMV ;Remove ^R and return
SUBTTL RSTS Support -- Check Set/Clear of Local ^U/^R/<RUB>
SCRURB: SKIPN ICHCNT ;Any chars in buffer?
JRST SURURB ;No, clear
MOVEI T1,<1B<.CHCNR>!1B<.CHCNU>>
AND T1,LMASK ;Don't set special if he's to see
XORI T1,<1B<.CHCNR>!1B<.CHCNU>>
IORM T1,CHRTAB
MOVE T1,LMASK+3 ;Get word with rubout bit
ANDX T1,1B31 ;Isolate it
TRC T1,1B31 ;Complement it
IORM T1,CHRTAB+3 ;Set appropriate
PJRST STRURB ;Set mask bits
SURURB: MOVEI T1,<1B<.CHCNR>!1B<.CHCNU>>
ANDCAM T1,CHRTAB ;Clear specialness
MOVEI T1,1B31
ANDCAM T1,CHRTAB+3 ;...
PJRST UNRURB
SUBTTL RSTS Support -- Break Echo Table
RSBTBL: .CHCRT,,[ASCIZ/
/] ;<CR>
.CHCNZ,,[ASCIZ/^Z
/] ;^Z
.CHESC,,[ASCIZ/$/] ;<ESC>
.CHCNC,,[ASCIZ/^C
/] ;^C
.CHCNO,,[ASCIZ/^O
/] ;^O
RSBLEN==.-RSBTBL
SUBTTL RSX Support -- Protocol defintions
RF.NOP==0 ;NO-OP
RF.SSD==1 ;Set system data (Configuration)
RF.DIS==2 ;Disconnect
RF.WTD==3 ;Write data to terminal
RF.RDD==4 ;Read data from terminal
RF.WRD==5 ;Write-then-read
RF.UNS==6 ;Unsolicited input
RF.RSC==7 ;Single Characters
RF.KIL==10 ;Kill I/O
RF.ATT==11 ;Attach task to terminal (as RSX means it)
RF.GTC==12 ;Get terminal Characteristics
RF.STC==13 ;Set terminal Characteristics
RF.ECR==14 ;Exception condition request
;MODE definitions
RM.WBN==1 ;Image write (RF.(WTD,WRD))
RM.OSA==1 ;Only system attention characters (RF.RSC)
RM.WBT==2 ;Write breaks through read (RF.(WTD,WRD)
RM.NSA==2 ;No system attention characters (RF.RSC)
RM.RBN==4 ;Image read (RF.(RDD,WRD))
RM.NOT==4 ;Notify (RF.RSC)
RM.RTC==10 ;Terminate on all CTL (RF.(RDD,WRD))
RM.RNE==20 ;Read no echo (RF.(RDD,WRD,RSC))
RM.RTO==40 ;Reset timeout on each char (RF.RSC)
RM.CUR==40 ;Cursor info imbedded (RF.(WTD,WRD))
RM.RTT==40 ;Terminator mask supplied (RF.RDD)
RM.RTM==100 ;Timeout (RF.(RDD,WRD))
RM.UNL==100 ;Read entire line (RF.RSC)
RM.NWC==200 ;No write complete (RF.WTD)
RM.TUI==200 ;Terminate unsolicited input (RF.UNS)
RM.TSC==200 ;Terminate single character input (RF.RSC)
RM.DET==200 ;Detach (RF.ATT)
;Flags
RM.PRI==2 ;Process immediately
RM.CAO==4 ;Cancel abort-output
;Status returns:
XS.SFC==0 ;Successful
XS.FPE==1 ;Function processing error
XS.UFC==2 ;Unsupported function requested
XS.IPF==3 ;Illegal protocol function
XS.IPD==4 ;Illegal protocal data
XS.ICF==5 ;Illegal characteristics function
;Exception condition code descriptions
RE.SAR==0 ;System attention request (^C)
RE.HAO==1 ;Host abort output (^O)
;Characteristic variables
RC.TBL==1 ;Buffer size
RC.CCT==2 ;Carriage control type
RC.SCI==3 ;Read single characters
RC.ACL==4 ;Autocrlf
RC.WBT==5 ;Write breaks through read
RC.CAO==6 ;Cancel I/O
RC.LUC==7 ;Case conversion
RC.RNE==^D8 ;Noecho
RC.RTC==^D9 ;Terminate on control characters
RC.CRT==^D10 ;CRT support
RC.RIL==^D11 ;^R
RC.RWB==^D12 ;Image
RC.UNS==^D13 ;Unsolicited input
RC.SCX==^D14 ;Read single extensions
RC.RTT==^D15 ;Break masks
RC.NUC==^D16 ;Case conversion
RC.HFF==^D17 ;Hardware for feeds
RC.HHT==^D18 ;Hardware tabs
RC.NEC==^D19 ;Echo
RC.RSP==^D20 ;Receive speed
RC.TSP==^D21 ;Transmit speed
RC.TTP==^D22 ;TTY: type
RC.SCP==^D23 ;CRT
RC.BIN==^D24 ;Passall
RC.SPN==^D25 ;Suspended output
RC.HFL==^D26 ;Horizontal fill characters
RC.VFL==^D27 ;Vertical fill characters
RC.TPL==^D28 ;Page size
RC.ETA==^D29 ;Typeahead
RC.CTA==^D30 ;Read/clear typeahead buffer
RC.REB==^D31 ;Eight bit characters
RC.RTM==^D32 ;Timeout
RC.CUR==^D33 ;Cursor
RC.CCF==^D34 ;Control-C flush
RC.FDX==^D35 ;Full duplex
RC.IMG==^D36 ;Ignore messages
RC.RAT==^D37 ;Read type-ahead
RC.SMO==^D38 ;Enable lowercase output
RC.SMP==^D39 ;Force lowercase input
RC.MAX==^D39 ;Maximum type
RC.VER==^D127 ;Version type
;Terminal types:
RXV52==11 ;VT52
RXV100==15 ;VT100
RXV101==24 ;VT101
RXV102==25 ;VT102
RXV125==27 ;VT125
RXV131==30 ;VT131
RXV132==31 ;VT132
RXV61==13 ;VT61
RXV55==12 ;VT55
;RSX digested header block:
.ORG 0
R.LINK: ;(RH) Link to next request
R.IDENT: ;(LH) Identifier for this request
BLOCK 1
R.MOD: ;(LH) Modifiers for this request
R.FLAG: BLOCK 1 ;(RH) Flags for this request
R.TIME: BLOCK 1 ;Timeout time if applicable
R.PROMPT:
BLOCK 1 ;Byte count,,pointer to prompt block
R.COUNT: ;I/O request count (read request)
BLOCK 1
R.MASK: BLOCK ^D8 ;Terminator mask
REQSIZ==.
.ORG
ISBTBL: .CHCRT,,[BYTE(7)15] ;<CR> For IAS
.CHCNZ,,[ASCIZ/^Z/] ;No extra <CR>s for IAS
RXBTBL: .CHCRT,,[ASCIZ/
/] ;<CR> for unsolicited read
.CHCNZ,,[ASCIZ/^Z
/] ;^Z for unsolicited read
.CHESC,,[ASCIZ/$/] ;<ESC>
.CHCNC,,[ASCIZ/^C
/] ;^C
RXBLEN==.-RXBTBL
ISBLEN==.-ISBTBL
SUBTTL RSX Support -- RSX.IN - Initialization
RSX.IN: TXO F,F$UAST ;Flag read outstanding
TXZ F,F$PIM ;And not PIM
IFN FTCROCK,< ;Turn of optimistic buffering
MOVEI CX,NSAFN ;Since -11 will hang
MOVE NSAFN,[.NSFRQ,,.NSAA3+1]
NSP. CX,
JRST RX.INC ;Oops
MOVEI CX,NSAFN
HRLI NSAFN,.NSFSQ ;Set quota
SETZ NSAA3, ;To zero
NSP. CX,
JFCL
RX.INC:> ;Done
MOVEI T1,RSX$CF ;Send back configuration msg
PUSHJ P,XMTMSG ;
MOVEI T1,RSX$UN ;Send a message
MOVE T2,OSTYPE ;Get OS
CAIE T2,O.IAS ;RSX? (Might be IAS)
PUSHJ P,XMTMSG ;IAS doesn't like this
MOVE T1,[RXDMSK,,IMASK] ;Set RSX default break mask
BLT T1,ENDMSK ;Set up
MOVE T1,[RXDMSK+1,,LMASK] ;Set the local mask too
BLT T1,ELMASK
MOVX T1,<1B<.CHCNC>!1B<.CHCNO>!1B<.CHCNX>>
MOVEM T1,CHRTAB ;Set ^C, ^O as special
IORM T1,IMASK+1 ;Be sure they're breaks for us
MOVE T1,[3,,T2] ;Set no lower case as that
MOVEI T2,.TOSET+.TOLCT ;Is the default
MOVE T3,TTYUDX
SETO T4,
TRMOP. T1,
JFCL
PJRST TTYSST ;Set up TTY
SUBTTL RSX Support -- Network interrupt
RSX.NT: PUSHJ P,RBYTEC ;Get the function
MOVEI P1,RSXFNC ;Point to function table
PUSHJ P,FNDFNC ;Go do it
ERR IXF,<Illegal RSX function>
POPJ P, ;Return
SUBTTL RSX Support -- TTY: input
RSX.TT: SKIPE P4,READQ ;Is there an outstanding read?
PJRST RX.CRQ ;Finish up
SKIPE P4,XSCREQ ;Is there a single char request?
JRST RX.TT1 ;Yes
HRROS XUNREQ ;Flag from TTY: service
RX.RCN: PUSHJ P,SCNSPC ;Scan special characters
JRST RX.TT0 ;Then anything special
RX.NES: MOVE P4,XUNREQ ;Get the unsolicited request
HRRZS XUNREQ ;Make it the way it was
TXNE F,F$UAST ;Want unsolicited input?
TRNN P4,-1 ;Is there an unsolicted request?
POPJ P, ;Doesn't want it
FALL RX.TU1 ;Fall into unsolicited support
;Here to see if unsolicited input is enabled
RX.TU1: PUSHJ P,CLRCTO
MOVEM F,RSXSVF ;So won't send extra message
MOVE T1,R.COUNT(P4) ;Get its count
TXZN F,F$BRK ;See a break?
CAMG T1,ICHCNT ;Or count satisfied?
JRST RX.TU3 ;Satisfied, one way or another
TXNN F,F$RU1 ;First time through here?
PJRST CHKCTH ;See about ^H stuff
PUSHJ P,SCNINI ;Else echo the char
PUSHJ P,SCNCHR ;...
PJRST XCRURB ;Nothing
MOVEI T1,(P1) ;Put in useful AC
CAIG T1," " ;Not control or space?
CAIN T1,.CHCRT ;But <CR> is special
JRST RX.TU2 ;Output it
PUSHJ P,INCHR ;Eat character
JFCL ;?
PJRST XCRURB ;See about ^U/^R/<RUB>
RX.TU2: TXZ F,F$RU1 ;No longer in first character
PUSHJ P,EKOTAH ;Echo all the type-ahead
MOVE T1,[LMASK,,IMASK+1]
BLT T1,ENDMSK ;Set reasonable mask now
MOVX T1,1B<.CHCNH> ;Be sure can see this
IORM T1,IMASK+1
PUSHJ P,FRCTTI ;Force wakeup
PUSHJ P,CHKLED ;Need to do editing?
POPJ P, ;Yes, do it
PJRST XCRURB ;Set ^U, ^R, etc. in mask
;Note this calls TTYSST
;Here if the read is really satisfied
RX.TU3: SETOM LICHCT ;A read satisfied
MOVEI T1,RF.UNS ;Unsolicited function
PUSHJ P,RSX.BH ;Build the header
SETZ P1,
NETOCH P1 ;Reserved
PUSH P,OBFPTR ;Save pointer
NETALC 2 ;Allocate read count
PUSHJ P,PUTWRD ;And write count
MOVN P1,R.COUNT(P4) ;Get the count
HRLZI P1,(P1)
RX.TU4: PUSHJ P,INCHR ;Get character
JRST RX.TU9 ;Oops
RX.TU5: NETOCH T1
PUSHJ P,CHKBR1 ;If still a break,
JRST RX.TU7 ;Then check it's echo
TLNN P4,400000 ;From TTY: service?
PUSHJ P,OUTTTY ;No, echo character
AOBJN P1,RX.TU4 ;..
SETZ T1, ;Use <NUL> terminator if none
TRNA ;Already have character
RX.TU7: HLRZ T1,BRKCHR
TLNN P4,400000 ;From TTY: service?
PUSHJ P,DOOUT1 ;No, make sure characters get out
MOVE T4,[-RXBLEN,,RXBTBL] ;Break echo table
MOVSI T3,RM.RNE ;To see if noecho
TDNN T3,R.MOD(P4) ;Is it?
TRNN P1,-1 ;Yes, any chars other than term?
JRST RX.TU9 ;No chars except term or noecho
CAIE T1,.CHCNZ ;^Z?
CAIN T1,.CHCRT ;<CR>?
TXOA F,F$CLF ;Warn to cancel <LF>
TXZ F,F$CLF
PUSHJ P,EKOBRK ;Echo break character
RX.TU9: MOVE T1,OBFPTR
EXCH T1,(P) ;Point to count word
MOVEM T1,OBFPTR
MOVEI T1,2 ;Putting in 2 chars
ADDM T1,OBFCTR
PUSHJ P,PUTWRD ;Put the count in
POP P,OBFPTR ;Restore the real pointer
PUSHJ P,XMTMSS ;Send message
PUSHJ P,XCRURB ;Clear ^R/^U/<RUB>
JRST RX.DUN ;Reset up unsolicited
;Here to handle special characters
RX.TT0: PUSHJ P,RX.SPC ;Handle it
JRST RSX.TT ;If a return
PUSHJ P,CONSCN ;?Continue the scan
JRST RX.TT0 ;See about that one
JRST RX.NES ;?
;Here if there is a read single characters active
RX.TT1: PUSHJ P,SCNINI ;Init a scan (in case we need it)
RX.T1A:
RX.TT2: SKIPN ICHCNT ;Anything really there?
POPJ P,
MOVE P4,XSCREQ ;Restore request block
TXZ F,F$TEX ;Flag from TTY: service
;Here for timeouts on single characters
RX.SSS: HLRZ T4,R.MOD(P4) ;Get modifiers
ANDI T4,RM.UNL!RM.NOT!RM.NSA!RM.OSA ;Save only relevant bits
JUMPE T4,RX.ACH ;If any character
CAIE T4,RM.UNL ;Notification for line
CAIN T4,RM.NOT ;Only want notification?
JRST RX.NOT ;Do that then
CAIN T4,RM.NSA ;Only want non-system?
JRST RX.NSA ;Yes, see if that's what is in
CAIN T4,RM.NSA!RM.OSA ;Want any character?
JRST RX.ACH ;Yes, send then
CAIE P1,.CHCNC ;^C?
JRST RX.NOT ;Not system attention, just notify
TXNE F,F$TEX ;From TTY: service?
JRST RX.SCH ;No
RX.ACH: MOVSI T1,RM.RTO ;Reset on each character...
SKIPE R.TIME(P4) ;Any timeout or,
TDNE T1,R.MOD(P4) ;?
JRST RX.SCH ;Terminate request now
POPJ P, ;Didn't timeout yet
RX.SCH: MOVEI T1,RF.RSC ;Function
NETOCH T1
HLRZ T1,R.MOD(P4) ;Get the modifiers
ANDCMI T1,RM.NOT ;We aren't just notifying
JUMPE T1,RX.SCZ ;Doesn't care about character
TRZ T1,RM.OSA ;Assume it's a normal character
TRO T1,RM.NSA ;..
CAIE P1,.CHCNC ;Attention?
TRC T1,RM.OSA!RM.NSA ;No, normal
RX.SCZ: NETOCH T1 ;Put in modifiers
SETZ P1,
ASSUME XS.SFC,0
PUSHJ P,PUTWRD ;Completion status and flags
HLRZ T2,R.IDENT(P4) ;Get request ID
NETOCH T2
ASSUME XS.SFC,0 ;From above
NETOCH P1 ;Reserved byte
PUSH P,OBFPTR ;Save current pointer
SETZB P1,P2 ;Count, last character
PUSHJ P,PUTLWD ;no writes
HLRZ P3,R.MOD(P4) ;Modifiers
TRC P3,RM.OSA!RM.NSA ;Easier to test zeroes
RX.TT3: PUSHJ P,INCHR ;Get character
JRST RX.TT4 ;None
TRNN P3,RM.OSA!RM.NSA ;Were both set?
CAMN T1,P2 ;Or are both the same?
JRST RX.T3A ;Both the same or both not set
JUMPE P2,RX.T3A ;Or if this is first character
CAIE T1,.CHCNC ;Is this a ^C?
CAIN P2,.CHCNC ;Or was that?
TRNA ;One was (blast!)
JRST RX.T3A ;Neither was, continue
EXCH T1,(P) ;Save character, get pointer
MOVEI T2,2
ADDM T2,OBFCTR ;Fudge count
PUSH P,OBFPTR ;Save old pointer
MOVEM T1,OBFPTR ;Fudged pointer
PUSHJ P,PUTWRD ;Current counter
POP P,OBFPTR ;Real pointer
PUSHJ P,XMTMSS ;Send the message
MOVEI T1,RF.RSC ;Function
NETOCH T1 ;Rebuild header
POP P,T1 ;Restore saved character
MOVEI T2,RM.NSA ;Assume normal
CAIN T1,.CHCNC ;Is it?
TRC T1,RM.OSA!RM.NSA ;No
NETOCH T2 ;Output modifiers
SETZ P1,
ASSUME XS.SFC,0
PUSHJ P,PUTWRD ;Completion status and flags
HLRZ T2,R.IDENT(P4) ;Get request ID
NETOCH T2
ASSUME XS.SFC,0 ;From above
NETOCH P1 ;Reserved byte
PUSH P,OBFPTR ;Save current pointer
SETZB P1,P2 ;Count, last character
PUSHJ P,PUTLWD ;no writes
RX.T3A: MOVE P2,T1 ;Remember character
NETOCH T1
AOJA P1,RX.TT3
RX.TT4: MOVEI T1,2
ADDM T1,OBFCTR ;Fudge count
MOVE T1,OBFPTR
EXCH T1,(P) ;Point to read count
MOVEM T1,OBFPTR
PUSHJ P,PUTWRD
POP P,OBFPTR
SKIPE R.TIME(P4) ;Is there a timeout?
PUSHJ P,RX.STM ;Yes, reset it
PJRST XMTMSS ;Send the message
;Here if only want non-system characters
RX.NSA: CAIN P1,.CHCNC ;Is it ^C?
JRST RX.TT0 ;Yes
PJRST RX.ACH ;Send the char
;Here if only notifying
RX.NOT: TRNE T4,RM.UNL ;Only for line?
CAIN P1,.CHCRT ;Line in the RSX sense?
TRNA
POPJ P, ;Don't notify yet
MOVEI T1,RF.RSC ;Function
NETOCH T1
HLRZ T1,R.MOD(P4)
NETOCH T1
SETZ P1, ;Flags and reserved
ASSUME XS.SFC,0
PUSHJ P,PUTWRD
PUSHJ P,PUTLWD ;Counts
PJRST XMTMSS
SUBTTL RSX Support -- NOP function
;Also here is the RX.CCO routine to clear F$CTO in both F and the RSXSVF
;copy of F.
RX.NOP: PUSHJ P,RBYTEC ;Get modifiers (0)
PUSHJ P,RBYTEC ;Get flags
TRNN T1,RM.CAO ;Cancel abort I/O?
POPJ P,
RX.CCO: PUSHJ P,CLRCTO ;Do the cancel
MOVEM F,RSXSVF ;Save F
POPJ P,
SUBTTL RSX Support -- Set unsolicited characters
RX.SUN: PUSHJ P,RSX.EH ;Eat header
PUSHJ P,GETWRD ;Count
MOVEM T1,R.COUNT(P4) ;Set it
MOVSI T1,RM.TUI ;Terminate?
TDNE T1,R.MOD(P4) ;?
JRST RX.TUN ;Yes
MOVEM P4,XUNREQ ;Point to it
SKIPE READQ ;Read pending?
POPJ P, ;Yes
RX.DUN: TXNE F,F$UAST ;Set read status unless attached
TXO F,F$READ!F$RU1 ;Read outstanding, just got re-enabled
MOVE T1,R.COUNT(P4) ;Get the count
MOVEM T1,IMASK ;Set it
MOVE T2,[RXDMSK+1,,LMASK]
BLT T2,ELMASK ;Set both masks
SETOM IMASK+1 ;Break on all chars at first
MOVE T2,[IMASK+1,,IMASK+2]
SOSG T1 ;If more than one character to what we planned
HRLI T2,RXDMSK+1 ;Else it is default too
BLT T2,ENDMSK
JUMPLE T1,RX.DU4
MOVX T2,<1B<.CHCNC>!1B<.CHCNO>!1B<.CHCNR>!1B<.CHCNU>!1B<.CHCNS>!1B<.CHCNQ>!1B<.CHCNX>>
ANDCAM T2,IMASK+1 ;But don't break on these
MOVEI T2,1B31 ;Same for <RUB>
ANDCAM T2,IMASK+1+3
RX.DU4: TXZ F,F$NEC ;Must echo
MOVX T1,<1B<.CHCNC>!1B<.CHCNO>!1B<.CHCNX>>
IORM T1,CHRTAB
IORM T1,IMASK+1 ;Be sure we see them
PUSHJ P,FRCTTI ;Force TTY: check
PUSHJ P,TTYSST ;Set up TTY:
PJRST RX.RCN ;In case some type-ahead
RX.TUN: SKIPN READQ ;Not a read unless there really is one
TXZ F,F$READ
MOVEI T1,(P4)
MOVEI T2,REQSIZ
PUSHJ P,CORFRE
MOVE T1,XUNREQ
SETZM XUNREQ
PJRST CORFRE
SUBTTL RSX Support -- Kill I/O
RX.KIL: NETOCH T1 ;ACK the function
SETZ P1,
PUSHJ P,PUTWRD ;No flags or modifiers
ASSUME XS.SFC,0
NETOCH P1 ;Status is success
PUSHJ P,RBYTEC ;Get modifiers (0)
PUSHJ P,RBYTEC ;Get flags
TRNE T1,RM.CAO ;Cancel ^O?
PUSHJ P,RX.CCO
PUSHJ P,RBYTEC ;Status
PUSHJ P,RBYTEC ;Request ID
NETOCH T1 ;Put it in
MOVEI P2,(T1) ;Save it
HRRZ P4,READQ ;Get current request
JUMPE P4,XMTMSS ;ACK and return
MOVEI P3,READQ-R.LINK ;Predecessor
RX.KI1: HLRZ T1,R.IDENT(P4) ;Get the identifier
CAIE T1,(P2) ;Right one?
JRST [HRRZI P3,(P4) ;This is last block
JRST RX.KI3 ] ;Continue
HRL P3,R.LINK(P4) ;Successor
HLRM P3,R.LINK(P3) ;Link to predecessor
RX.KIA: SKIPN T1,R.PROMPT(P4) ;Prompt?
JRST RX.KI2 ;No
HLRZ T2,T1 ;Size
LSHC T2,-2
TLNE T3,600000
AOJ T2,
HRRZI T1,(T1)
PUSHJ P,CORFRE
RX.KI2: HRRZI T1,(P4) ;Point T1 at core block
MOVEI T2,REQSIZ
PUSHJ P,CORFRE
RX.KI3: HRRZ P4,R.LINK(P3) ;Point to next
JUMPN P4,RX.KI1 ;More
SKIPN P4,XSCREQ ;Single?
JRST RX.KI4 ;No
HLRZ T1,R.IDENT(P4) ;Get identifier
CAIE T1,(P2) ;The required ID?
JRST RX.KI4 ;No
MOVEI P3,XSCREQ-R.LINK ;Fake predecessor
SETZM XSCREQ ;No request any more
SKIPN P4,READQ ;Read request?
TXZA F,F$NEC!F$PALL ;No, clear noecho and passall
TXZ F,F$PALL ;Yes, just clear passall
JRST RX.KIA ;Deallocate
RX.KI4: SKIPN P4,XUNREQ ;Unsolicited request?
JRST RX.KI5
HLRZ T1,R.IDENT(P4)
CAIE T1,(P2) ;Right thing?
JRST RX.KI5 ;No
SETZM XUNREQ
HRRI P3,XUNREQ-R.LINK ;Fake predecessor
JRST RX.KIA ;Kill
RX.KI5: SKIPN READQ
SKIPE XUNREQ
PJRST XMTMSS
SKIPN XSCREQ
TXZ F,F$READ
PJRST XMTMSS
SUBTTL RSX Support -- Disconnect link
RX.DIS: POPJ P, ;We'll find out soon enough
SUBTTL RSX Support -- Single character mode
RX.SSC: PUSHJ P,RSX.EH ;Digest it
MOVSI T1,RM.TSC ;If terminate,
TDNE T1,R.MOD(P4) ;Then exit now
JRST RX.TSC ;And perform it
PUSHJ P,GETLWD ;Eat counts
PUSHJ P,RBYTEC ;Timeout
JUMPE T1,RX.SC1
IMULI T1,^D4000 ;Convert to MS
IDIVI T1,^D60
CAIL T2,^D30
AOJ T1,
TLO T1,(1B0) ;Flag in MS
MOVEM T1,R.TIME(P4) ;Save
RX.SC1: MOVEM P4,XSCREQ ;Save it
SKIPE READQ ;Is there a read outstanding?
POPJ P, ;Then its charactersitics apply
;Enter here with P4 pointing to block
RX.SCS: HLRZ T1,R.MOD(P4)
TRNE T1,RM.RNE ;NO echo?
TXOA F,F$NEC ;Yes
TXZ F,F$NEC ;No
SKIPE R.TIME(P4) ;Timeout?
PUSHJ P,RX.STM ;Yes
MOVEI T1,1 ;Break on each character
MOVEM T1,IMASK
SETOM IMASK+1
MOVE T1,[IMASK+1,,IMASK+2]
ASSUME LMASK,<<ENDMSK+1>>
BLT T1,ELMASK ;..
TXO F,F$PALL ;Set no special characters
PUSHJ P,TTYSST ;Set TTY: up
PUSHJ P,FRCTTI ;Force TTY: look
PJRST RX.TT1 ;See if any typeahead
RX.TSC: SKIPN READQ ;If no read
TXZ F,F$TMR ;Cancel timeout
MOVEI T1,(P4)
MOVEI T2,REQSIZ
PUSHJ P,CORFRE
MOVE T1,XSCREQ
SETZM XSCREQ
PUSHJ P,CORFRE
SKIPN P4,READQ ;Read request?
TXZA F,F$NEC!F$PALL ;No, clear noecho and passall
TXZA F,F$PALL ;Yes, just clear passall
JRST RX.CUN ;Check unsolicited
PUSHJ P,FRCTTI ;Force TTY: look
PJRST RX.PM5 ;In case satisfied from typeahead
SUBTTL RSX Support -- ATTACH/DETACH
RX.DAT: PUSHJ P,RBYTEC ;Get modifiers
TRNE T1,RM.DET ;Detach?
JRST RX.DET ;Yes
TXZ F,F$UAST ;Don't really want unsolicited
SKIPN READQ ;When ATTACHed, if not a read
TXZ F,F$READ ;Then there really isn't one
PUSHJ P,TTYSST ;Change mask
PJRST FRCTTI ;Check for input
RX.DET: TXO F,F$UAST ;Want unsolicited if enabled
SKIPN P4,XUNREQ ;Request?
POPJ P, ;No
PJRST RX.DUN ;Reset unsolicited
SUBTTL RSX Support -- Get terminal characteristics
RX.GTC: MOVEI T1,RF.GTC ;ACK the function
NETOCH T1
SETZ P1, ;Modifiers & flags
PUSHJ P,PUTWRD
PUSHJ P,GETWRD ;Get modifiers, flags
TRNE T1,<RM.CAO>B<35-8>
PUSHJ P,RX.CCO
PUSHJ P,RBYTEC ;Status
ASSUME XS.SFC,0
NETOCH T1 ;Assume it stays the same
PUSHJ P,GETWRD ;Identifier, reserved
MOVE P1,T1
PUSHJ P,PUTWRD ;Return it
PUSHJ P,GETLWD ;Eat counts
SETZ P1,
PUSHJ P,PUTLWD ;Put zero for them
RXCHLP: PUSHJ P,NETICH ;Get characteristic
JRST RXCHGX ;Done
JUMPE T1,RXCHGX ;Or this way
NETOCH T1 ;Type
CAIE T1,RC.CTA ;Type-ahead?
JRST RXCH1 ;No
MOVE T1,[2,,T2]
MOVE T2,TTYUDX
MOVEI T3,.TOTTC ;Figure it out
TRMOP. T1,
SETZ T1,
ADD T1,ICHCNT ;..
TRNA ;Skip normal loading
RXCH1: MOVE T1,RXCHTB-1(T1) ;Get the answer
NETOCH T1 ;Put in
PUSHJ P,RBYTEC ;Eat the "field"
JRST RXCHLP ;Proceed
RXCHGX: SETZ T1,
PUSHJ P,PUTWRD
PJRST XMTMSS ;Finish off and end
SUBTTL RSX Support -- Set terminal characteristics
RX.STC: NETOCH T1 ;Output the function
PUSHJ P,GETWRD ;Get modifiers and flags
TRNE T1,<RM.CAO>B<^D35-8> ;?
PUSHJ P,RX.CCO
SETZ P1,
PUSHJ P,PUTWRD ;Modifiers and flags
ASSUME XS.SFC,0
NETOCH P1 ;Status
PUSHJ P,RBYTEC ;Input status
PUSHJ P,GETWRD ;ID, reserved
MOVE P1,T1 ;Transfer
PUSHJ P,PUTWRD ;And do it
PUSHJ P,GETLWD ;Get counts
MOVE P1,T1
PUSHJ P,PUTLWD
RXSCLP: PUSHJ P,NETICH ;Get a characteristic
SETZ T1,
JUMPE T1,[PUSHJ P,TTYSST
PJRST XMTMSS ]
MOVEI P1,(T1) ;Save it
PUSHJ P,RBYTEC ;Get set field
MOVEM T1,RXCHTB-1(P1) ;Save it
CAIN P1,RC.BIN ;Binary?
XCT [TXZ F,F$PALL ;Yes, set it
TXO F,F$PALL](T1) ;appropriately
CAIN P1,RC.NEC
XCT [TXZ F,F$NEC
TXO F,F$NEC](T1)
CAIN P1,RC.CTA ;Type-ahead function?
PUSHJ P,FLSTAH ;Clear all type-ahead
SKIPN T2,RXTRMP(P1) ;Should we do a TRMOP. here?
JRST RXSCLP ;Continue
TLZE T2,400000 ;Sign bit set?
TRC T1,1 ;Yes, complement setting
MOVE T4,T1 ;Copy
CAIE P1,RC.TTP ;Set TTY: type?
JRST RXSTRM ;No, set other characteristics then
MOVSI T2,-TTPLEN ;Terminal table
HRRZ T3,RTPTB(T2) ;Get RSX terminal type
CAIE T3,(T4) ;Match ours?
AOBJN T2,.-2 ;Keep looking if not
JUMPGE T2,RXSCLP ;Oh well, don't know it
MOVE T4,TTPTB(T2) ;Get TOPS-10 name
RXSTRM: MOVE T3,TTYUDX
MOVE T1,[3,,T2]
TRMOP. T1,
JFCL
JRST RXSCLP
SUBTTL RSX Support -- Read data, Read with prompt
RX.PRD: SKIPA P1,[-1] ;This is a prompt request
RX.RED: SETZ P1,
PUSHJ P,RX.CCO ;Cancel ^O
TXO F,F$READ ;Read outstanding
PUSHJ P,RSX.EH ;Eat the header
MOVEM P1,R.PROMPT(P4) ;Save prompt status
PUSHJ P,GETWRD ;Get read count
MOVEM T1,R.COUNT(P4) ;Save
MOVSI T2,RM.RTM ;Timeout?
TDNN T2,R.MOD(P4) ;??
JRST RX.NT1 ;No
ANDI T1,377 ;Clear count
ANDCAM T1,R.COUNT(P4) ;Clear timout value in count
LSH T1,-^D8 ;Two instrs to save precision
IMULI T1,^D10 ;Convert to seconds
MOVEM T1,R.TIME(P4) ;Save timeout
RX.NT1: SETZ T1, ;Default nothing
MOVSI T2,RM.RTT ;The terminator mask bit
SKIPN R.PROMPT(P4) ;Wanted prompt?
TDNE T2,R.MOD(P4) ;See if terminator bit set
PUSHJ P,GETWRD ;Get write/terminator count
SKIPN R.PROMPT(P4) ;Want prompt?
SKIPN T4,T1 ;Copy count to T4
JRST RX.NMK ;There really isn't a mask
MOVE T3,[POINT 8,R.MASK(P4),];Point to mask area
PUSHJ P,CPYMSK ;Copy in the mask
SETZ T1, ;Can't combine mask and prompt
RX.NMK: MOVSI T2,RM.RTC ;See if terminate on characters
TDNN T2,R.MOD(P4) ;?
JRST RX.NCC ;No
MOVE T2,[777777,,777760] ;Set it
MOVEM T2,R.MASK(P4) ;Control chars
MOVEI T2,7B31 ;Also include <ALT>s and <RUB>
MOVEM T2,R.MASK+3(P4) ;Set them all
RX.NCC: JUMPE T1,RX.NPT ;No prompt
PUSH P,T1 ;Save size of string
LSHC T1,-2
TLNE T2,600000 ;Check remainder
AOS T1
PUSHJ P,CORGET ;Get block for prompt
HRRM T1,R.PROMPT(P4) ;Save it
POP P,T4 ;Get byte count
HRLM T4,R.PROMPT(P4) ;Save it
MOVEI T2,(T1) ;Point to block
HRLI T2,(POINT 8,,) ;Make a byte pointer
RX.PM1: PUSHJ P,RBYTEC ;Get byte of string
IDPB T1,T2
SOJG T4,RX.PM1
RX.NPT: TXZ F,F$PALL ;Not while read active
MOVEI T1,RM.PRI ;Process immediately?
MOVE T4,READQ
TDNN T1,R.FLAG(P4) ;Is this process immediately?
JUMPN T4,XQREAD ;No, queue request here
MOVEM P4,READQ ;This is now current request
HRRM T4,R.LINK(P4) ;In case this is a PRI
RX.NRQ: TXO F,F$IOQ ;Inhibit output
PUSHJ P,XPROMT ;Output the prompt
RX.CTM: SKIPE T1,R.TIME(P4) ;Is there a timeout?
TXO F,F$TMR ;Set there is a timeout
RX.PM5: PUSHJ P,RX.STT ;Set TTY: up for this request
PUSHJ P,CHKLED ;See if need to do editing
PJRST FRCTTI ;Yes, do it
PUSHJ P,EKOTAH ;Echo type-ahead
TLZA P4,400000 ;Flag not from TTY: service
FALL RX.CRQ ;Fall in CRQ
;Here from TTY: service to see if request can now be completed
RX.CRQ: PUSHJ P,CLRCTO ;Clear ^O
MOVEM F,RSXSVF ;Saved copy
TLO P4,400000 ;Flag from TTY: service
TXNE F,F$TMR ;Timeout?
SKIPN R.TIME(P4) ;Really? (not RSC)
TRNA ;Nope
PUSHJ P,RX.STM ;Set it up
MOVEM P4,READQ ;Save the request
PUSHJ P,SCNSPC ;Any special characters in input?
JRST RX.CSC ;Check special characters
RX.NSC: MOVE P4,READQ ;Get the request back
HRRZ T1,R.COUNT(P4) ;Get count desired
CAMLE T1,ICHCNT ;Do we have at least that many?
TLZE F,(F$BRK) ;Or have we seen a break?
JRST RX.RDS ;Read is satisfied
PUSHJ P,XCRURB ;See about rubout etc.
PJRST CHKCTH ;Check ^H
;Also enter here with P4 pointing to header block from TIMEOUT service
RX.RDS: SETOM LICHCT ;Flag to do ^H next time
SETZM XSPCNT ;Going to eat all ^Cs
MOVEI T1,($TOOIN!$TOICL) ;Overrid inhibit for echo
IORM T1,TOFLGS
MOVEI T1,RF.RDD ;Build header for read
PUSHJ P,RSX.BH ;Build header to complete request
SETZ P1, ;Reserved byte
NETOCH P1
PUSH P,OBFPTR ;Save output pointer
NETALC 2 ;Two for the read
PUSHJ P,PUTWRD ;Two for the write
MOVN P2,R.COUNT(P4) ;Get desired count
HRLZI P2,(P2) ;Make AOBJN pointer
JUMPE P2,RX.RDZ ;**Zero length read**
HLRZ P3,R.MOD(P4) ;Get modifiers
RX.RDL: PUSHJ P,INCHR ;Get a character
JRST [HRRZI P2,(P2) ;Flag no break character
MOVSI T1,(<RM.RTM>B15);Set a timeout
IORM T1,@OTPBUF ;...
JRST RX.RDD ] ;Read is done
NETOCH T1
PUSHJ P,CHKBR1 ;Is it a break?
JRST RX.RDD ;yes, read is done
TLNN P4,400000 ;From TTY: service?
TRNE P3,RM.RNE ;No, noecho?
JRST RX.RDF ;From TTY: or noecho
PUSHJ P,OUTTTY ;Output character
RX.RDF: AOBJN P2,RX.RDL ;Continue
RX.RDZ: SETZ T1, ;Make terminator a <NUL>
NETOCH T1
JRST RX.RNB ;No break
RX.RDD: HLRZ T1,BRKCHR
CAIN T1,.CHCNC ;Control-C?
SKIPN T2,XSCREQ ;Any single request?
JRST RX.RDE ;No
HLRZ T2,R.MOD(T2) ;Get modifiers
TRNE T2,RM.OSA ;?
JRST RX.RNB ;Already echoed it
RX.RDE: MOVSI T2,RM.RTC ;Terminate on control?
TDNE T2,R.MOD(P4) ;?
CAIL T1," " ;Is this a control character?
SKIPN R.COUNT(P4) ;Make sure non-zero length request
JRST RX.RNB
CAIE T1,.CHCNZ ;^Z?
CAIN T1,.CHCRT ;<CR>?
TXNE F,F$NEC ;Yes, noecho?
TXZA F,F$CLF ;Don't
TXO F,F$CLF ;Set CLF if all of the above are true
MOVE T4,OSTYPE ;Get OS
CAIN T4,O.IAS ;11M or IAS?
SKIPA T4,[-ISBLEN,,ISBTBL] ;Use IAS table
SKIPA T4,[-RXBLEN,,RXBTBL]
TXZ F,F$CLF ;Skip this stuff if IAS
PUSHJ P,EKOBRK ;Echo if not
RX.RNB: MOVE T1,OBFPTR ;Save real output pointer
EXCH T1,(P) ;Get count pointer
MOVEM T1,OBFPTR ;Point to status word
MOVEI T1,2 ;Was subtracted before
ADDM T1,OBFCTR ;..
MOVEI P1,(P2) ;Character count
PUSHJ P,PUTWRD ;Put it in
POP P,OBFPTR ;Restore real pointer now
RX.RDQ: PUSHJ P,XMTMSS ;Send the message now
TLZN P4,400000 ;From TTY:?
TRNE P3,RM.RNE ;No-echo?
JRST RX.RQ1
PUSHJ P,DOOUT1 ;Force out
SETZM TOFLGS
RX.RQ1: HRRZ T1,R.LINK(P4) ;Point to next request
HRRZM T1,READQ ;which is now current
SKIPN T1,R.PROMPT(P4) ;Prompt block to free?
JRST RX.NPF ;No
HLRE T2,T1 ;Put length in T2
LSHC T2,-2 ;To words
TLNE T3,600000 ;Check remainder
AOJ T2,
HRRZI T1,(T1)
PUSHJ P,CORFRE
RX.NPF: MOVEI T1,(P4) ;Free this block
MOVEI T2,REQSIZ
PUSHJ P,CORFRE ;..
PUSHJ P,XCRUR1 ;...
TXZ F,F$IOQ ;Don't inhibit any more
SKIPE P4,READQ ;New request
JRST RX.NRQ ;New request
SKIPN P4,XSCREQ ;Read single in effect?
TXZA F,F$READ ;No, no read
TXOA F,F$READ ;Be sure it's set
JRST RX.CUN ;See if unsolicited
TXZ F,F$TMR ;Clear timeout
PJRST RX.SCS ;Set it up
;Here to check if an unsolicited request
RX.CUN: SKIPE P4,XUNREQ ;Is there one?
PJRST RX.DUN ;Do setup
PUSHJ P,TTYSST ;Set up TTY:
PJRST FRCTTI ;Look
;Here if a special character was found by SCNSPC, ponder what to do
RX.CSC: SKIPN T1,XSCREQ ;Read single in effect?
JRST RX.DSC ;No
HLRZ T2,R.MOD(T1) ;Get modifiers
CAIE P1,.CHCNC ;Is this the interesting character?
JRST RX.DSC ;No
TRNN T2,RM.OSA ;Want attention characters?
JRST RX.CS2 ;No
SKIPN T2,XSPCNT ;Count of ^C's in buffer
JRST RX.CS5 ;This is the first
PUSH P,T2 ;Save in an interesting place
RX.CS1: PUSHJ P,CONSCN ;Continue the scan
JRST RX.CS3 ;Found one
POP P,(P) ;Clear junk
RX.CS2: MOVEI P1,.CHCNC ;Is the magic character also a break?
PUSHJ P,CHKBRK ;?
TXO F,F$BRK ;Yes, flag it
JRST RX.NSC ;Didn't really see a special character
RX.CS3: CAIE P1,.CHCNC ;The magic character?
JRST [POP P,(P) ;No
JRST RX.DSC] ;Process it
SOSLE (P) ;Yes, notify for it already?
JRST RX.CS1 ;Continue scanning
POP P,(P)
RX.CS5: AOS XSPCNT ;We scanned this one
MOVE P4,XSCREQ ;The unsolicited request
MOVEI T1,RF.RSC ;Function
NETOCH T1
HLRZ T1,R.MOD(P4) ;Get modifiers
ANDI T1,RM.OSA ;Saving only this
NETOCH T1 ;Put in modifiers
SETZ P1,
ASSUME XS.SFC,0
PUSHJ P,PUTWRD ;Completion status and flags
HLRZ T2,R.IDENT(P4) ;Get request ID
NETOCH T2
ASSUME XS.SFC,0 ;From above
NETOCH P1 ;Reserved byte
MOVEI P1,1 ;Number of characters here
PUSHJ P,PUTLWD ;plus zero writes
MOVEI T1,.CHCNC
NETOCH T1
PUSHJ P,XMTMSS ;Send the message
; HLRZ T2,R.MOD(P4) ;Get modifiers
MOVE P4,READQ ;Restore P4 to point to queue block
; TRNE T2,RM.RNE ;Noecho?
; JRST RX.CRQ ;Yes, continue processing
MOVEI T4,[ASCIZ/^C
/]
PUSHJ P,STROUT
PUSHJ P,DOOUT1
JRST RX.CRQ ;Echo before continuing
RX.DSC: PUSHJ P,RX.SPC ;Yes, handle them
JRST RX.DS1 ;Normal return
PUSHJ P,CONSCN ;Continue scan
JRST RX.DSC
JRST RX.NSC ;No special chars at all
RX.DS1: SKIPE P4,READQ ;Still a queued request?
JRST RX.CRQ ;Yes, scan again (must be from TTY:)
PJRST XCRURB ;No, give up now
SUBTTL RSX Support -- Output prompt string
;This routine outputs the prompt string in the RSX digested header block
;pointed to by P4. Uses T1, T3, and T4.
XPROMT: SKIPN T4,R.PROMPT(P4) ;Get the prompt string
POPJ P, ;None to do
MOVEI T3,($TOOIN!$TOICL)
MOVEM T3,TOFLGS
HLRZ T3,T4 ;Get count
HRLI T4,(POINT 8,,) ;Point to data
RX.OPM: ILDB T1,T4
PUSHJ P,OUTTTY
SOJG T3,RX.OPM ;Output all prompt data
PUSHJ P,DOOUT1
SETZM TOFLGS
POPJ P,
SUBTTL RSX Support -- Handle special characters
RX.SPC:
RX.CCC: CAIE P1,.CHCNO
JRST RX.CTC ;Control-C or ^X
PUSHJ P,SPCRMV ;Clear it
PUSHJ P,XCRURB
TXCN F,F$CTO ;Setting ^O?
PUSHJ P,CLRTOQ ;Clear the TO queue
MOVEI T4,[ASCIZ/^O
/] ;How to echo it
PUSHJ P,STROUT
RX.CTO: PUSHJ P,DOOUT1
RX.CO1: MOVEM F,RSXSVF ;Save the current flags
MOVEI T1,RF.ECR
NETOCH T1 ;Tell him to toggle too
SETZ P1,
PUSHJ P,PUTWRD ;No flags or modifiers
MOVEI T1,RE.HAO
NETOCH T1 ;Output reason
PUSHJ P,XMTMSS ;Tell him
TXZ F,F$ICO ;Don't ignore any more
TXNN F,F$CTO ;Set or clear?
PJRST CLRCTO ;Tell the monitor
PUSHJ P,WATOUT ;Wait for it to go out if just set
PJRST SETCTO
RX.CTC: CAIE P1,.CHCNC ;^C?
JRST RX.CTX ;Check ^X if not
PUSHJ P,SPCFLS ;Clear input to ^C
MOVEI T1,RF.ECR ;Request an exception
NETOCH T1
SETZ P1, ;No flags or modifiers
PUSHJ P,PUTWRD
ASSUME RE.SAR,0
NETOCH P1 ;Output the reason
SKIPN P4,READQ ;A request?
PJRST XMTMSS ;Send the message and return
PUSHJ P,XMTMSS ;Send the abort
MOVEI T1,RF.RDD ;Set the request type
PUSHJ P,RSX.BH ;Build it
SETZ P1, ;The reserved byte
NETOCH P1 ;..
PUSHJ P,PUTLWD ;Also the counts
MOVEI P1,.CHCNC ;The terminator
NETOCH P1 ;Output it
PJRST RX.RDQ ;Clean up
RX.CTX: CAIE P1,.CHCNX ;Control-X?
JRST RX.CTU ;Maybe ^U
PUSHJ P,SPCFLS ;Flush input to ^X
SKIPN READQ ;If not inputting
POPJ P, ;Then return
MOVEI T4,[ASCIZ/^U
/]
PUSHJ P,STROUT
PUSHJ P,DOOUT1 ;Force it out
PJRST RX.CU1 ;And check some things
RX.CTU: PUSHJ P,SCNPOS ;Get position
SKIPE T2,READQ ;Read request?
JRST [MOVE T2,R.COUNT(T2) ;Yes, use this count
JRST RX.CCU ] ;Do it
SKIPN T2,XUNREQ ;Get request
JRST CPOPJ1 ;None, ignore these special chars
MOVE T2,R.COUNT(T2) ;Get count
RX.CCU: CAILE T1,(T2)
JRST CPOPJ1 ;Return
CAIE P1,.CHCNU ;Control-U?
JRST RX.CTR ;Maybe ^R
PUSHJ P,DOCTU
RX.CU1: PUSHJ P,RX.CNC ;Count ^Cs
TXNE F,F$PALL ;Shouldn't be here if this is set, but
JRST RX.CU3 ;See about request
SKIPN P4,READQ ;Read request?
JRST RX.CU2
PUSHJ P,XPROMT ;Output the prompt string
PJRST XCRURB ;...
RX.CU2: SKIPN P4,XUNREQ ;No, unsolicited request?
PJRST XCRURB ;No request
PJRST RX.DUN ;Re-set unsolicited stuff
RX.CU3: SKIPN P4,READQ ;Prompt request?
POPJ P,
PJRST XPROMT ;Output and return
RX.CTR: CAIE P1,.CHCNR ;Control-r?
JRST RX.RUB ;Must be rubout
MOVEI T1,RX.CR1 ;For outputting the prompt
PUSHJ P,DOCTR
PJRST XCRURB ;See about flags
RX.CR1: SAVE4 ;Save the Ps
SKIPE P4,READQ ;Request?
PJRST XPROMT ;Finish it
POPJ P,
RX.RUB: PUSHJ P,DORUB ;Do the rubout
PUSHJ P,RX.CNC ;Count ^Cs in buffer
FALL XCRURB ;See about flags
SUBTTL RSX Support -- Check about ^U/^R/<RUB> processing
XCRURB: TDZA T1,T1 ;Flag to set
XCRUR1: SETO T1, ;Don't set
TXNN F,F$READ ;Read pending?
JRST XURURB ;No
TXNN F,F$PALL ;Passall?
SKIPN ICHCNT ;Any chars?
JRST XURURB ;No
XSRURB: JUMPN T1,CPOPJ ;Don't change it
MOVEI T1,<1B<.CHCNR>!1B<.CHCNU>> ;Set to watch them
AND T1,LMASK ;Unless he wanted them
XORI T1,<1B<.CHCNR>!1B<.CHCNU>> ;..
IORM T1,CHRTAB
MOVE T1,LMASK+3 ;Word with rubout bit
ANDX T1,1B31 ;Isolate it
IORM T1,CHRTAB+3 ;Propagate it
PJRST STRURB ;Set and return
POPJ P, ;Return
XURURB: MOVEI T1,<1B<.CHCNR>!1B<.CHCNU>> ;Clear in CHRTAB
ANDCAM T1,CHRTAB
MOVEI T1,1B31 ;Clear rubout too
ANDCAM T1,CHRTAB+3
MOVE T3,RXDMSK ;Default count
SKIPE T1,READQ ;In case a request
MOVE T3,R.COUNT(T1) ;Get count from there
PJRST UNRURB ;Cancel unless in mask
SUBTTL RSX Support -- Count ^Cs
;Here to set XSPCNT correctly. Uses T1-T4
;Note that no interrupt which can affect XSPCNT should be allowed to happen
RX.CNC: SAVE4 ;Save the Ps
PUSHJ P,SCNINI
SETZM XSPCNT ;Init count
RX.CNL: PUSHJ P,SCNCHR
POPJ P, ;Done if no more characters
CAIN P1,.CHCNC ;Is it the magic character?
AOS XSPCNT ;Count it if so
JRST RX.CNL
SUBTTL RSX Support -- Set TTY: up
;Enter with P4 pointing to header block
;Note this should only be called for "normal" read requests
RX.STT: MOVSI T1,RM.RNE ;No-echo?
TDNN T1,R.MOD(P4) ;?
TXZA F,<F$NEC> ;Echo, clear the bit
TXO F,<F$NEC> ;Set it
HRLI T1,RXDMSK+1 ;Assume default
SKIPE R.MASK(P4) ;Is there?
HRLI T1,R.MASK(P4) ;Yes
HRRI T1,IMASK+1 ;Put it in
BLT T1,ENDMSK
MOVE T1,[IMASK+1,,LMASK] ;Set logical mask
BLT T1,ELMASK ;..
MOVSI T1,RM.RTC ;Terminate on control?
TDNN T1,R.MOD(P4) ;?
JRST RX.ST2 ;No
MOVEI T1,37
ANDM T1,CHRTAB
MOVEI T1,1B31
ANDCAM T1,CHRTAB+3
SETZ T1,
JRST RX.ST3
RX.ST2: MOVX T1,<1B<.CHCNC>!1B<.CHCNO>!1B<.CHCNX>>
IORM T1,CHRTAB
RX.ST3: TXO T1,1B<.CHCNH> ;Be sure see this too
IORM T1,IMASK+1
MOVE T1,R.COUNT(P4) ;Set the default field width
MOVEM T1,IMASK
TXNN F,F$TMR ;See if timeouts are involved
JRST RX.ST4 ;Continue
MOVEI T1,1 ;Then field must be only one
MOVEM T1,IMASK
RX.ST4: SKIPN T1,XSCREQ ;Read single active?
JRST RX.ST6 ;No, skip some
HLRZ T1,R.MOD(T1) ;Get modifiers
TRNN T1,RM.OSA ;Want ^C?
JRST RX.ST6 ;Set TTY:
MOVX T1,1B<.CHCNC> ;Be sure in mask
IORM T1,IMASK+1
RX.ST6: PUSHJ P,TTYSST ;Set up TTY:
PJRST FRCTTI ;And wake up
SUBTTL RSX Support -- handle timed requests
;Call with protocol header pointed to by P4
RX.STM: TXO F,F$TEX ;Be sure it's set
MOVEI T1,RX.TMR ;Routine to handle
MOVEM T1,OSTMR ;Set the routine
HLRZ T1,R.IDENT(P4) ;Get identifier
MOVEM T1,TMRSEQ ;Save to be sure right req
MOVE T1,R.TIME(P4) ;Get the time
PITMR. T1,
JFCL
POPJ P,
;Routine to actually handle requests:
RX.TMR: SKIPN P4,READQ ;Any request
JRST RX.CTS ;See if single-character timeout
HLRZ T1,R.IDENT(P4)
MOVSI T2,RM.RTM ;Check ID and timer flag, in case SSC
CAMN T1,TMRSEQ ;Right sequence number?
TDNN T2,R.MOD(P4) ;Single characters maybe
JRST RX.CTS ;No time-out here, check single chars
PJRST RX.RDS ;Read "satisfied"
RX.CTS: SKIPN P4,XSCREQ ;Single characters request?
POPJ P,
HLRZ T1,R.IDENT(P4) ;Be sure ID matches
CAME T1,TMRSEQ ;?
POPJ P, ;Doesn't match
TXO F,F$TEX ;Timeout expired
JRST RX.SSS ;Single satisfied
SUBTTL RSX Support -- Write data
RX.WRT: PUSHJ P,RSX.EH ;Eat common header
PUSHJ P,CHKCTO ;Check status of ^O
MOVE T1,RSXSVF ;Get old flags
XOR T1,F ;Get difference
TXNE T1,F$CTO ;Has state changed?
PUSHJ P,RX.CO1 ;Yes, inform the host
TXNE F,F$CTO ;Control-O in effect?
JRST RX.WR1 ;Yes
PUSHJ P,GETWRD ;Get read count (should be zero)
PUSHJ P,GETWRD ;Get write count
JUMPE T1,RX.WR1 ;No real bytes
MOVEI T4,(T1) ;Transfer ACs
SETZM TOFLGS ;Assume normal write
MOVSI T1,RM.WBT ;Breakthrough type?
TDNN T1,R.MOD(P4) ;?
JRST RX.WR0 ;No
MOVEI T1,($TOOIN)
MOVEM T1,TOFLGS
RX.WR0: PUSHJ P,RBYTEC ;Else get a byte
CAIL T1," " ;Printing?
TXZA F,F$CLF ;No, cancel line feed
CAIN T1,.CHLFD ;Line feed?
TXZN F,F$CLF ;Supposed to cancel one?
PUSHJ P,OUTTTY ;Output character to TTY:
SOJG T4,RX.WR0 ;For all characters
PUSHJ P,DOOUT1
SKIPN TOFLGS
PUSHJ P,WATDEQ
SETZM TOFLGS
RX.WR1: MOVSI T1,RM.NWC ;Want write complete?
TDNE T1,R.MOD(P4) ;?
JRST RX.WR4 ;No
MOVEI T1,RF.WTD ;Write function
PUSHJ P,RSX.BH ;Build a header
PUSHJ P,XMTMSS ;Send ACK
RX.WR4: MOVEI T1,(P4)
MOVEI T2,REQSIZ
PJRST CORFRE ;Free block and return
SUBTTL RSX Support -- Eat common header
;Returns with digested header block (R.xxxx) pointed to by P4
RSX.EH: MOVEI T1,REQSIZ
PUSHJ P,CORGET
MOVEI P4,(T1) ;Point P4 at it
PUSHJ P,RBYTEC ;Get modifiers
HRLM T1,R.MOD(P4) ;Store them
PUSHJ P,RBYTEC ;Get flags
TRNE T1,RM.CAO ;Cancel ^O?
PUSHJ P,RX.CCO ;Clear ^O
HRRM T1,R.FLAG(P4) ;Also flags
PUSHJ P,GETWRD ;Get status and identifier
LSH T1,-^D8 ;Put ID in low order byte
HRLM T1,R.IDENT(P4) ;Save it
PJRST RBYTEC ;Eat reserved byte and return
SUBTTL RSX Support -- Build header for output message
;Enter with T1=function code to build header for; P4=digested header block
RSX.BH: NETOCH T1 ;Put function in header
HLRZ T1,R.MOD(P4) ;Get modifiers
ANDCMI T1,RM.RTM ;Default didn't time out
NETOCH T1
SETZ T1, ;Flags
NETOCH T1
MOVEI T1,XS.SFC ;Set Normal function
NETOCH T1
HLRZ T1,R.IDENT(P4) ;Get identifier
SOSGE OBFCTR
JRST [PUSHJ P,NETQUE
JRST .-1 ]
IDPB T1,OBFPTR ;Do NETOCH by hand
POPJ P, ;So is a few less instructions
SUBTTL RSX Support -- Queue read request
;Enter with RSX digested header block in P4
XQREAD: MOVEI T1,READQ-R.LINK
MOVEI T2,-1 ;So can check queue
XQLP: TDNN T2,R.LINK(T1) ;Anything there?
JRST XQHAV ;Done
HRRZ T1,R.LINK(T1)
JRST XQLP
XQHAV: HRRM P4,R.LINK(T1)
POPJ P, ;Return
SUBTTL VMS Support -- Protocol definitions
;Digested header block:
.ORG 0
V.LINK: BLOCK 1 ;Link to next request
V.IDENT:BLOCK 1 ;Identifier for this request
V.MOD: BLOCK 1 ;Modifiers for this request
V.COUNT:BLOCK 1 ;Request byte count for this request
V.TIME: BLOCK 1 ;Timeout for this request
V.PROM: BLOCK 1 ;Pointer to prompt string and size
V.STAT: BLOCK 1 ;Status we want, if request doesn't complete
V.MASK: BLOCK 11 ;One word length + enough for 256 bits
VRQSIZ==.-V.LINK ;Size of digested request block
.ORG
; op code modifiers
; READ
CVTLOW==400 ;IO$M_CVTLOW
DISMBX==2000 ;IO$M_DSABLMX
NOECHO==100 ;IO$M_NOECHO
NFILTR==1000 ;IO$M_NOFILTR
PURGE==4000 ;IO$M_PURGE
REFRSH==2000 ;IO$M_REFRESH
TIMER==200 ;IO$M_TIMED
TNOEKO==10000 ;IO$M_TRMNOECHO
ESCAPE==40000 ;IO$M_ESCAPE
TYPAHD==100 ;IO$M_TYPEAHDCNT
;Internal modifiers (left half of V.MOD)
VM.RAL==1B0 ;Readall, MUST BE SIGN BIT
; WRITE
CANCTRLO==100 ;IO$M_CANCTRLO
ENAMBX==200 ;IO$M_ENABLMBX
NFORMT==400 ;IO$M_NOFORMAT
; SETMODE
CC=400 ;IO$M_CTRLCAST
CY==200 ;IO$M_CTRLYAST
HANGUP==1000 ;IO$M_HANGUP
OBAND==2000 ;IO$M_OUTBAND
INCLUDE==10000 ;IO$M_INCLUDE
MODEM==2000 ;IO$M_SET_MODEM
; Status codes returned
NORMAL==1 ;SS$_NORMAL
TIMEOUT==1054 ;SS$TIMEOUT
ABORTS==54 ;SS$_ABORT
PARTES==774 ;SS$_PARTESCAPE
BADESC==74 ;SS$_BADESCAPE
CONTRC==3121 ;SS$_CONTROLC
CONTRY==3021 ;SS$_CONTROLY
CANCEL==4060 ;SS$_CANCEL
HNGUPS==1314 ;SS$_HANGUP
CONTRO==3011 ;SS$_CONTROLO
ILLFNC==364 ;SS$_ILLIOFUNC
; Modifiers for attention code
RA.UNS==0 ;Unsolicited data
RA.HUP==1 ;Modem hangup
RA.CTC==2 ;Control C
RA.CTY==3 ;Control Y
RA.RSV==4 ;Reserved
RA.BRD==5 ;Broadcast mailbox
RA.OUB==6 ;Out-of-band completion
;Miscellaneous constants:
MTMBRD==^D83 ;MSG$_TRMBRDCAST
; VAX Terminal symbols
DC$TERM==102 ;Generic terminals
DT$L120==41 ;LA120
DT$L36==40 ;LA36
DT$LAX==40 ;Generic LA terminal
DT$L38==43 ;LA38
DT$L34==42 ;LA34
DT$TTY==0 ;Generic hard copy
DT$V52==100 ;VT52
DT$V100==140 ;VT100
DT$V5X==100 ;Generic CRT
DT$V55==101 ;VT55
DT$101==141 ;VT101
DT$102==142 ;VT102
DT$105==143 ;VT105
DT$V125==144 ;VT125
DT$V131==145 ;VT131
DT$132==146 ;VT132
DT$L100==45 ;LA100
DT$LQP2==46 ;LQP02
DT$VT05==1 ;VT05
DT$VK100==2 ;VK100 (GIGI)
DT$V200==156 ;VT200_SERIES
DT$V300==160 ;VT300_SERIES
DT$LA12==44 ;LA12
; Terminal Definitions
TPSAL==1 ;TT$M_PASSALL
TNEKO==2 ;TT$M_NOECHO
TNTPH==4 ;TT$M_NOTYPEAHEAD
TESCP==10 ;TT$M_ESCAPE
THSYN==20 ;TT$M_HOSTSYNC
TTSYN==40 ;TT$M_TTSYNC
;TT$M_SCRIPT
TLOWR==200 ;TT$M_LOWER
TMTAB==400 ;TT$M_MECHTAB
TWRAP==1000 ;TT$M_WRAP
TCRLF==2000 ;TT$M_CRFILL
TLFFL==4000 ;TT$M_LFFILL
TSCOP==10000 ;TT$M_SCOPE
TRMOT==20000 ;TT$M_REMOTE
THSCR==40000 ;TT$M_HOLDSCREEN
T8BIT==100000 ;TT$M_EIGHTBIT
TMDIS==200000 ;TT$M_MBXDSBL
TNBCS==400000 ;TT$M_NOBROADCAST
TRSYN==1,,0 ;TT$M_READSYNC
TMFRM==2,,0 ;TT$M_MECHFORM
THDUP==4,,0 ;TT$M_HALFDUP
TMODM==10,,0 ;TT$M_MODEM
;TT$M_OPER
;(FREE)
;377*100,,0 ;TT$M_PAGE
;TT2 defs:
;TT2$M_LOCALECHO
T2AUTO==2 ;TT2$M_AUTOBAUD
T2HANG==4 ;TT2$M_HANGUP
T2MHNG==10 ;TT2$M_MODHANGUP
T2BCM==20 ;TT2$M_BRDCSTMBX
;40 ;TT2$M_XON
;100 ;TT2$M_DMA
;200 ;TT2$M_ALTYPEAHD
;400 ;TT2$M_SETSPEED
;1000 ;TT2$M_DCL_MAILBX (DCL SPAWN HACK)
;2000 ;TT2$M_DCL_OUTBND (DCL SPAWN HACK)
;4000 ;TT2$M_DCL_CTRLC (DCL SPAWN HACK)
;10000 ;TT2$M_EDITING
;20000 ;TT2$M_INSERT
T2FLBK==40000 ;TT2$M_FALLBACK
T2DIAL==100000 ;TT2$M_DIALUP
T2SEC==200000 ;TT2$M_SECURE
T2DISC==400000 ;TT2$M_DISCONNECT
;1,,0 ;TT2$M_PASTHRU
T2SYSP==2,,0 ;TT2$M_SYSPWD
T2SIXL==4,,0 ;TT2$M_SIXEL
T2DRCS==10,,0 ;TT2$M_DRCS
T2PPO==20,,0 ;TT2$M_PRINTER
;40,,0 ;TT2$M_APP_KEYPAD
T2ACRT==100,,0 ;TT2$M_ANSICRT
T2RGIS==200,,0 ;TT2$M_REGIS
T2BLOK==400,,0 ;TT2$M_BLOCK
T2AVO==1000,,0 ;TT2$M_AVO
T2EDIT==2000,,0 ;TT2$M_EDIT
T2DCRT==4000,,0 ;TT2$M_DECCRT
T2DCR2==10000,,0 ;TT2$M_DECCRT2
T2DCR3==20000,,0 ;TT2$M_DECCRT3
; Misc 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
;I/O function codes ($IODEF)
VF.WPH==13 ;These are all writes
VF.WLB==40
VF.WVB==60
VF.RPH==14 ;these are all reads
VF.RLB==41
VF.RVB==61
VF.RAL==72 ;READALL
VF.RPR==67 ;Read with prompt
VF.RPA==73 ;READALL with prompt
VF.STC==32 ;Set characteristics
VF.STM==43 ;Set mode
VF.SNC==33 ;Sense characteristics
VF.SNM==47 ;Sense mode
VF.ACC==70 ;ACPcontrol (Kill)
VF.BCS==177777 ;Broadcast
;Return Opcodes
VR.ATT==-1 ;Attention
VR.END==-2 ;I/O complete
VR.ERR==-3 ;Error
SUBTTL VMS Support -- VAX/VMS network input routine
VMS.NT: PUSHJ P,GETWRD ;Get a word (should be there!)
PUSH P,T1 ;Save function
MOVEI T1,VRQSIZ ;Get length of block
PUSHJ P,CORGET ;Get it
MOVEI P4,(T1) ;Copy addr of request block to P4
PUSHJ P,VMS.EH ;Eat common header
POP P,T1 ;Restore function
MOVEI P1,VMSFNC ;Point to QIO table
PUSHJ P,FNDFNC ;Find the function in the table
ERR IVQ,<Illegal VMS QIO function>
VM.ETI: TXZN F,F$NEOM ;If we encountered EOM, then
POPJ P, ;It is OK to return
PUSHJ P,NSPIN ;Else eat to EOM
JRST NSPERR ;Oops
JRST VM.ETI ;Eat all input
SUBTTL VMS Support -- VMS TTY: input routine
VMS.TT:
PUSHJ P,VM.SCT ;Set CHRTAB
JRST VMS.NS ;Nothing is special
PUSHJ P,VM.CHO
PUSHJ P,VM.OOB ;Yes send out of band first
VMS.NS: SKIPE P4,SENSEQ ;Sense pending?
PUSHJ P,VM.SNC ;Finish it up
SKIPE P4,READQ ;Is there a read queued?
JRST [TLO P4,400000 ;Flag here from TTY
PJRST CHKREQ ] ;Check the request
VMS.N1: PUSHJ P,SCNSPC ;Scan for "special" characters
JRST VMS.N5 ;See about treating them
VMS.N3: SKIPE ICHCNT ;Any characters?
PJRST VMS.UN ;Tell him there's data
PJRST VCRURB ;Check setting of F$RUB
VMS.N5: PUSHJ P,VMS.SC ;Treat them
JRST VMS.N1 ;Check again
PUSHJ P,CONSCN ;See if more special chars
JRST VMS.N5 ;Yes
JRST VMS.N3 ;No, ignore the ones we saw
SUBTTL VMS Support -- VMS.DA - Recieve VMS data
VMS.PW: MOVEI T1,NFORMT ;Noformat bit
IORM T1,V.MOD(P4) ;Set it
VMS.DA:
MOVE T1,V.MOD(P4) ;Get modifiers
TRNE T1,CANCTRLO ;Cancel ^O effect?
PUSHJ P,CLRCTO ;Yes
PUSHJ P,CHKCTO ;See what the setting is
TRNE T1,ENAMBX ;Want unsolicited now?
PUSHJ P,VM.SUN ;Set up unsolicited stuff
TXNE F,F$CTO ;Is ^O in effect?
JRST VM.CTO ;Toss the write then
TXNN F,F$PALL ;Passall?
TRNE T1,NFORMT ;Or NOformat?
TXOA F,F$PIM ;Set PIM
JRST VM.DA1 ;OK to use ASCII
PUSHJ P,TTYSST ;Set PIM (wait for pending output to complete)
VM.DA1: PUSHJ P,GETLWD ;Get count
MOVEI P1,(T1) ;Save for later
PUSHJ P,GETWRD ;Get first and second bytes of carcon
ANDI T1,377 ;Save only carcon byte
JUMPN T1,VM.FRT ;FORTRAN carriage control
PUSHJ P,RBYTEC ;Get prefix carcon byte
PUSH P,T1
PUSHJ P,RBYTEC ;Get postfix control
EXCH T1,(P) ;Save postfix, get prefix
VM.DCC: PUSHJ P,VM.CCN ;Do the control
PUSHJ P,VMS.WR ;Write the record out (P1=count)
POP P,T1 ;Get postfix control back
PUSHJ P,VM.CCN ;Do the control
TXZE F,F$PIM ;Clear PIM
PUSHJ P,TTYSST ;Change back
VM.DC2: MOVE T1,V.MOD(P4) ;Get modifiers
TRNE F,REFRSH ;Refresh?
PUSHJ P,VM.CRF ;Need to refresh
PJRST VMS.AK ;ACK the request and return
;Here to interpret a Fortran carriage control character
VM.FRT: DMOVE T3,[ 2 ;2 <LF>s
200!.CHCRT] ;<CR> for postfix
CAIN T1,"0" ;Is it double-space?
JRST VM.FR1 ;Yes, process
DMOVE T3,[200!.CHFFD ;Form-feed prefix
200!.CHCRT] ;<CR> postfix
CAIN T1,"1" ;Eject?
JRST VM.FR1 ;Yes
DMOVE T3,[ Z ;Null prefix
200!.CHCRT] ;<CR> postfix
CAIN T1,"+" ;If overprint control
JRST VM.FR1
DMOVE T3,[ 1 ;1 <LF>
200!.CHCRT] ;<CR> postfix
CAIN T1,"$" ;Unless prompt sequence
DMOVE T3,[ 1 ;1 <LF>
Z ] ;Null postfix
VM.FR1: PUSHJ P,GETWRD ;Eat next two bytes
MOVEI T1,(T3) ;Prefix to T1
PUSH P,T4 ;Postfix to stack
JRST VM.DCC ;Go do it
SUBTTL VMS Support -- Routine to do carriage control
;Call with carriage control byte in T1
VM.CCN: JUMPE T1,CPOPJ ;Nothing to do
TRZE T1,200 ;<LF> count?
JRST [CAIN T1,.CHCRT ;<CR>
TXOA F,F$FLF ;Yes, may need free line feed
TXZ F,F$FLF ;Don't want free <LF>
JRST OUTTTY ] ;...
TXZ F,F$FLF ;Don't need free line feed if already
TXZE F,F$CLF ;Supposed to cancel a line feed?
SOJLE T1,CPOPJ ;Yes, exit if only one to do here
MOVEI T2,(T1) ;Move count to T2
MOVEI T1,.CHCRT ;Do one <CR>
PUSHJ P,OUTTTY ;(don't need more than one)
MOVEI T1,.CHLFD ;Get a line feed
VM.LFS: PUSHJ P,OUTTTY
SOJG T2,VM.LFS ;Do them
POPJ P, ;Then return
SUBTTL VMS Support -- Routine to actually write the record
;Character count in P1, zeroed on return
VMS.WR: JUMPE P1,CPOPJ ;If nothing to do
SETO P2, ;Flag first time through
VM.WR1: PUSHJ P,RBYTEC ;Get a byte from the record
CAIE T1,.CHCRT ;<CR>
TXZA F,F$FLF ;No, don't want free line feed
TXO F,F$FLF ;Flag may want it
AOJG P2,VM.WR2 ;Don't worry about this if not first time
TXNN F,F$CLF ;Cancel on?
JRST VM.WR2 ;No, just ignore
CAIN T1,.CHCRT ;If <CR>...
SOJA P2,VM.WR3 ;Just ignore
CAIN T1,.CHLFD ;A line feed?
TXZA F,F$CLF ;Yes, we already did it
VM.WR2: PUSHJ P,OUTTTY ;Output the character
VM.WR3: SOJG P1,VM.WR1
TXZ F,F$CLF ;Real data, don't cancel any free line feeds
POPJ P, ;Return with characters output
SUBTTL VMS Support -- Check to see if REFRESH needed
VM.CRF: PUSH P,P4
SKIPN P4,READQ ;Is there a request
JRST VM.CF2
PUSHJ P,CHKPRM ;Do the prompt string
MOVE CX,[2,,T1] ;Force out the rescan buffer
MOVE T1,[SIXBIT/.TYPE/]
MOVE T2,TTYUDX
FRCUUO CX,
JFCL ;Ignore; they fail randomly anyway
VM.CF2: POP P,P4
POPJ P,
SUBTTL VMS Support -- Read and Read with prompt
VMS.PA: SKIPA T2,[-1] ;Prompt
VMS.RA: SETZ T2,
MOVSI T1,(VM.RAL) ;Set special mode bit for us
IORM T1,V.MOD(P4) ;Turn it on
JRST VM.RED
VMS.PD: SKIPA T2,[-1]
VMS.RD: SETZ T2,
VM.RED: MOVEM T2,V.PROMPT(P4) ;Set prompt or not flag
PUSHJ P,GETLWD ;Get a longword count for chars
MOVEM T1,V.COUNT(P4) ;Save count
PUSHJ P,GETLWD ;Get time-out
MOVEM T1,V.TIME(P4) ;Save timeout
PUSHJ P,RBYTEC ;Get a byte
JUMPE T1,NOMSK ;No terminator mask
MOVE T4,T1 ;Count of bytes to get
MOVEM T1,V.MASK(P4) ;Flag there is a mask
MOVEI T3,V.MASK+1(P4) ;Point to mask word
HRLI T3,(POINT 8,,) ;Make byte pointer to it
PUSHJ P,CPYMSK ;Set the mask copy
NOMSK: SKIPE V.PROMPT(P4) ;Prompt?
SKIPGE IBFCNT ;Data for one?
JRST NOPMT ;No prompt requested or no data
PUSHJ P,GETWRD ;Get length of string
SKIPN P1,T1 ;Copy to P1 and see if there is any string
JRST NOPMT
CPYPMT: SKIPN P1,T1 ;Copy to P1, is it non-zero?
POPJ P, ;No
LSHC T1,-2
TLNE T2,600000 ;Remainder?
AOJ T1,
PUSHJ P,CORGET ;Get the block
MOVEM T1,V.PROM(P4) ;Point to prompt string
HRLM P1,V.PROM(P4) ;Save number of characters
HRLI T1,(POINT 8,,) ;Byte pointer to data
MOVE T2,T1 ;But don't keep it in T1
PUSHJ P,RBYTEC ;Get a byte
IDPB T1,T2 ;Save
SOJG P1,.-2 ;For all bytes
TRNA ;There really is a prompt
NOPMT: SETZM V.PROMPT(P4) ;There really isn't a prompt
SKIPE READQ ;Read already queued?
JRST VQREAD ;Yes, just queue this request
NVRDRQ: PUSHJ P,CLRCTO ;Clear ^O
MOVX T1,VM.RAL ;Physical type request?
TXNE F,F$PALL ;Physical?
TXZA F,F$FLF ;Skip one useless instruction
TXNN F,F$CLF ;Cancel a free line feed?
TDNE T1,V.MOD(P4) ;(No, physical)?
TXZ F,F$FLF ;Yes, no formatting
MOVE T1,V.MOD(P4) ;Get modifiers
MOVE T2,VMTTCH+1 ;Get terminal characteristics
TRNN T2,TESCP ;Set escape recognition here?
TRNE T1,ESCAPE ;Want escape processing?
TXOA F,F$ESC ;Yes
TXZ F,F$ESC!F$ESA ;Clear all traces
TRNE T1,DISMBX ;Disable unsolicited?
TXZ F,F$UAST ;Yes
TRNE T1,PURGE ;Purge typeahead?
PUSHJ P,FLSTAH ;Flush type-ahead
PUSHJ P,CHKPRM ;See if have to do a prompt
MOVEI T1,NOECHO ;Noecho?
TDNN T1,V.MOD(P4) ;..?
TXNN F,F$FLF ;Echoing, need free line feed?
JRST VM.NFL ;no
MOVEI T1,.CHLFD
PUSHJ P,OUTTTY ;Output
PUSHJ P,DOOUT1 ;...
VM.NFL: HRRZM P4,READQ ;This is the current request
TXO F,F$READ ;Read outstanding
SETOM UNSCNT ;Allow unsolicited messages
MOVEI T1,TIMER ;Timed request?
TDNE T1,V.MOD(P4) ;?
PUSHJ P,VM.STM ;Yes, set a timer request
PUSHJ P,VM.STT ;Set TTY: up
;Enter here on TTY: I/O complete to see if we can now satisfy this request
;Enter with P4 pointing to digested QIO block and sign bit set
;if from TTY: service
CHKREQ:
PUSHJ P,CLRCTO ;Clear ^O
MOVEM P4,READQ ;Store request
CHKRQ1: PUSHJ P,SCNSPC ;Check for special characters
JRST VM.CRS ;See about special characters
CHKRQ2: MOVE P4,READQ ;Get request
MOVE T1,ICHCNT ;Any characters?
TLZN F,(F$BRK) ;Break?
CAML T1,V.COUNT(P4) ;Enough characters input to satisfy?
JRST VM.RDS ;Satisfied
TXZE F,F$TEX ;Timeout expiration?
PJRST FRCTTI ;Give it one more shot
SKIPN V.STAT(P4) ;Set a status?
JRST VQREAD ;Nope, queue the read
VM.RDS: SETOM LICHCT ;Be sure we output ^H next time
MOVEI P2,($TOOIN!$TOICL)
MOVEM P2,TOFLGS
TXZ F,F$ESA ;Be sure zapped
PUSHJ P,VMS.BH ;Build data header
PUSH P,OBFPTR ;Save where iosb goes
NETALC ^D8+2 ;Skip over IOSB and count
MOVN P2,V.COUNT(P4) ;Get character count
HRLZI P2,(P2) ;Make aobjn ptr
MOVE P3,V.MOD(P4) ;Get the modifiers
SETZM BRKSIZ ;Clear size of break string
JUMPE P2,VM.RDZ ;**Zero length read**
JUMPG P2,[MOVE P1,V.STAT(P4) ;Get status desired
JRST VM.RD0 ] ;And complete
VM.RDL: PUSHJ P,INCHR ;Get a character
JRST [SKIPN P1,V.STAT(P4) ;Get status if set (TIMEOUT)
MOVEI P1,TIMEOUT ;?
TLZ P2,400000 ;Be sure don't do terminator stuff
JRST VM.RD0] ;And finish it
TRNN P3,CVTLOW ;Convert lower case?
JRST VM.NLC ;No, don't bother
CAIL T1,"a" ;Is it lower case?
CAILE T1,"z" ;?
TRNA ;No
TRZ T1,<"a"-"A"> ;Convert if it is
VM.NLC: NETOCH T1
PUSHJ P,CHKBR1 ;See if it's a break character
JRST VM.RDD ;Read done if this is break
TXNE F,F$ESA ;Escape sequence active?
SOJA P2,VM.RDQ ;Yes, don't count as part of string
TLNN P4,400000 ;From TTY: service?
TRNE P3,NOECHO ;No (type-ahead), is this no echo?
TRNA ;Yes or yes, don't echo
PUSHJ P,OUTTTY ;Output character if no
VM.RDQ: AOBJN P2,VM.RDL ;Loop for all chars
VM.RDZ: TXNE F,F$ESA ;Is an escape still active?
SKIPA P1,[PARTES] ;Flag it
VM.RDD: MOVEI P1,NORMAL
TXZE F,F$BAD ;Bad escape sequence?
MOVEI P1,BADESC ;Yes
VM.RD0: MOVE T4,OBFPTR ;Get current output pointer
EXCH T4,(P) ;Get pointer to IOSB
EXCH T4,OBFPTR ;Force PUTWRD to put things in the right place
MOVEI T4,^D8+2 ;Account for stuff already gone
ADDM T4,OBFCTR
PUSHJ P,PUTWRD ;Put it in
MOVEI P1,(P2) ;Number of characters in string
PUSHJ P,PUTWRD ;Put it in
JUMPGE P2,[SETZ P1,
PUSHJ P,PUTLWD ;Put it in
SKIPN V.COUNT(P4) ;Zero character read?
JRST VM.RD2 ;No characters
LDB T1,OBFPTR ;Get last character output
TXZ F,F$CLF!F$FLF ;Clear flags
CAIN T1,.CHCRT ;<CR>
TXO F,F$FLF ;Yes, might need this
JRST VM.RD2 ] ;And finish up
HLRZ T1,BRKCHR ;Break char to T1 for echoing
MOVEI P1,(T1) ;Get the break character
PUSHJ P,PUTWRD ;Put it in
HRRZ P1,BRKSIZ ;Size of the break character
ADDI P2,(P1) ;Include in count
PUSHJ P,PUTWRD ;And it too
TXNE F,F$ESC ;Escape sequence?
CAIG P1,1 ;Yes, was this terminated by such?
JRST VM.RDW ;No
CAIN P1,(P2) ;Only the break?
JRST VM.RD2 ;Yes, don't change F$CLF
VM.RDW: SKIPE V.COUNT(P4) ;If count is non-zero, then
TXZ F,F$FLF!F$CLF ;Clear these too
TRNE P3,TNOEKO!NOECHO ;Various flavour of no-echo?
JRST VM.RD2 ;Yes, observe them
CAIE T1,.CHCNZ ;Cancel free <LF> on ^Z
CAIN T1,.CHCRT ; or <CR>?
TXO F,F$CLF ;Cancel free line feed
MOVE T4,[-VBKLEN,,VBKTAB]
PUSHJ P,EKOBRK ;Try and echo it
VM.RD2: MOVEI P1,(P2) ;Total # of chars in record
PUSHJ P,PUTWRD ;Put it in
POP P,OBFPTR ;Restore old byte pointer
VM.FNR: ;Here to finish a read request
;(^C/^Y also come here)
TXZ F,F$RALL!F$ESC!F$FRC ;No readall, no type-ahead echo
TXZE F,F$IOQ
PUSHJ P,FRCTTO
SETZM TOFLGS ;Clear the buffer flags
PUSHJ P,XMTMSS ;Send the message
MOVE T1,V.LINK(P4) ;Get next
HRRZM T1,READQ ;It is now first
VM.RD3: SKIPN T1,V.PROM(P4) ;Deallocate any prompt block
JRST VM.RD4 ;None
HLRZ T2,T1 ;Get size
LSHC T2,-2 ;Convert to words
TLNE T3,600000 ;Remainder?
AOJ T2,
HRRZI T1,(T1)
PUSHJ P,CORFRE
VM.RD4: MOVEI T1,(P4)
MOVEI T2,VRQSIZ ;Free cor block
PUSHJ P,CORFRE ;Free the core block
PUSHJ P,VCRUR1 ;Check F$RUB
SKIPE P4,READQ ;Is there another request ready?
JRST NVRDRQ ;New VAX read request
TXZ F,F$READ!F$RUB ;No read request outstanding
TXNE F,F$UAST ;Want unsolicited?
PJRST VM.SUN ;Yes
PUSHJ P,TTYSST ;Be sure no-echoed
PJRST FRCTTI ;And a look
VM.CRS: PUSHJ P,VMS.SC ;Handle the special character first
JRST VM.CS4 ;See if still a request
PUSHJ P,CONSCN ;See if more characters
JRST VM.CRS ;Yes, see about them
JRST CHKRQ2 ;Continue processing
VM.CS4: SKIPE P4,READQ ;Is there still a request?
JRST CHKRQ1 ;Yes
JRST VCRURB ;See if need to clear bits
SUBTTL VMS Support -- Routine to output prompt
;Routine to output a prompt string if there is one
CHKPRM: SKIPN T4,V.PROM(P4) ;Is there one?
POPJ P, ;No
PUSHJ P,WATDEQ ;Wait for things to settle
PUSH P,TOFLGS ;Save the flags
MOVEI T3,($TOICL!$TOOIN) ;Form of echo
MOVEM T3,TOFLGS
HLRZ T3,T4 ;Get the character count
TXZ F,F$ESA!F$BAD ;Cancel these
HRLI T4,(POINT 8,,) ;Point to string
OUTPMT: ILDB T1,T4 ;Get character
TXNN F,F$ESC ;Escape processing?
JRST OUTPM1 ;No
TXZ F,F$BAD
PUSH P,T4 ;Gotta save those Ts
PUSH P,T3
PUSH P,T1
MOVEI CX,OUTPM0 ;In case it returns this way
PUSHJ P,CHKESC
TXO F,F$BRK
TRNA
OUTPM0: POP P,(P) ;Fix stack
POP P,T1
POP P,T3
POP P,T4
TXNE F,F$ESA!F$BRK ;Active or done?
JRST NOFLF3 ;Don't bother flags
OUTPM1: TRZE F,F$FLF ;Need to give free LF?
CAIN T1,.CHLFD ;Yes, is this a line feed?
JRST NOFLF2 ;Is <LF> or don't need
CAIE T1,.CHCRT ;Is it a <CR>?
JRST FLFA ;No, give <CR> then
MOVE T2,T4 ;Get byte pointer copy
CHKFLF: ILDB T1,T2 ;Get next character
CAIN T1,.CHLFD ;Is it a <LF>
JRST NOFLFA ;Yes, don't need one then
CAIN T1,.CHCRT ;Is it a <CR>?
JRST CHKFLF ;Yes, scan more
FLFA: MOVEI T1,.CHLFD ;Get a line feed
PUSHJ P,OUTTTY ;Output it
NOFLFA: LDB T1,T4 ;Get old character back
NOFLF2: TXNN F,F$CLF ;Cancel free line feed?
JRST NOFLF3 ;No
CAIN T1,.CHCRT ;Yes, if <CR> just toss
TXZA F,F$CLF ;Set bit to zero
CAIN T1,.CHLFD ;If this is a line feed
TXCA F,F$CLF ;Then clear bit and toss
TXZA F,F$CLF ;Don't cancel except in first
TRNA ;Proceed
NOFLF3: PUSHJ P,OUTTTY ;Output to TTY:
SOJG T3,OUTPMT ;Get next
NOPMT1: PUSHJ P,DOOUT1
POP P,TOFLGS ;Restore the flags
TXO F,F$IOQ ;Read is "active"
POPJ P,
SUBTTL VMS Support -- Break echo string table
VBKTAB: .CHCRT,,[BYTE (7)15,12] ;<CR>
.CHESC,,[ASCIZ/$/] ;<ESC>
.CHCNZ,,[ASCIZ/^Z
/] ;^Z
.CHTAB,,[ASCIZ/ /] ;<TAB>
VBKLEN==.-VBKTAB
SUBTTL VMS Support -- Routine to queue a read request for VMS
VQREAD: SKIPE ICHCNT ;Characters?
TXO F,F$IOQ ;Yes
TXO F,F$READ ;Set read request active
TLNN P4,400000 ;Clear sign bit
JRST VQRD1 ;Do other things
SETZM IMASK ;Go into character mode
PUSHJ P,CHKCTH ;See about ^H stuff
VQRD1: MOVEI T1,READQ-V.LINK ;Find the end of the queue
HRRZI T3,(P4) ;Right half only
FNDENV: SKIPN T2,V.LINK(T1) ;Is it here?
JRST ENVFND ;Found it
CAIN T3,(T2) ;Already queued?
JRST ENVFN1 ;Yes, but be sure TTY: kicked
MOVEI T1,(T2) ;Point ahead
JRST FNDENV ;And look there
ENVFND: HRRZM T3,V.LINK(T1) ;Make this last request
ENVFN1: CAMN T3,READQ ;Adding first request to queue?
PUSHJ P,FRCTTI ;Force TTY: if so
VQRD2: TXNE F,F$RALL!F$PALL!F$LEM ;Need to worry about editing?
JRST VQRD3 ;Nope
PUSHJ P,CHKLED ;Line editing to do?
POPJ P, ;Wait for it to happen then
VQRD3: TLNN P4,400000 ;From TTY: service?
PUSHJ P,EKOTAH ;No, do type-ahead
PUSHJ P,VCRURB ;Check this stuff
SKIPE IMASK ;Need to call TTYSST?
POPJ P,
PUSHJ P,TTYSST
PJRST FRCTTI ;Yes, do it
SUBTTL VMS Support -- Eat and store common header
VMS.EH: PUSHJ P,GETWRD ;Go get a VAX word (16 bits)
MOVE P1,T1 ;Get the word in P1
MOVEM P1,V.MOD(P4) ;Save
PUSHJ P,GETLWD ;Get a long word identifier
MOVEM T1,V.IDENT(P4) ;Save identifier
PJRST GETWRD ;get the unit number which is unimportant
;and return With Modifiers in P1, Ident in P2
SUBTTL VMS Support -- Handle Control-O
VM.CTO: PUSHJ P,VMS.BH ;Build header
MOVEI P1,CONTRO ;Say what happened
JRST VM.AK1 ;AK the message
SUBTTL VMS Support -- VMS.KI - Kill I/O
VMS.KI:
TLZ F,(F$CAST!F$UAST) ;Cancel ^Cs
SKIPN P1,READQ ;Point to queue
PJRST VM.AK2 ;Nothing to do
HRLI P1,READQ-V.LINK ;Predecessor
VM.KIL: MOVE T1,V.IDENT(P4) ;Ident he wants to kill
VM.CKI: CAMN T1,V.IDENT(P1) ;This identifier?
JRST VM.KI1
HRLI P1,(P1) ;Next in queue
HRR P1,V.LINK(P1) ;Link to next
TRNE P1,-1 ;Any more?
JRST VM.AK2 ;Nope
JRST VM.CKI ;Check it out
VM.KI1: MOVEI T1,(P4) ;Get this request
MOVEI T2,VRQSIZ ;Free it
PUSHJ P,CORFRE ;...
HRRZI P4,(P1) ;Point P4 at block
HRR P1,V.LINK(P1) ;Get successor to this
MOVSS P1 ;Predecessor,,successor
HLRM P1,V.LINK(P1) ;De-link from here
HRRZ T1,READQ ;Get the first request in the list
HRRZM P4,READQ ;We are now first
HRRZM T1,V.LINK(P4) ;First is now next
MOVEI P1,ABORTS ;Status
MOVEM P1,V.STAT(P4) ;Status to complete with
SETOM V.COUNT(P4) ;Flag not to complete
PJRST VM.RDS ;Finish it up
SUBTTL VMS Support -- VMS.AK - Write complete and Acknowledge
VMS.AK: ;Acknowledgements
SKIPN V.IDENT(P4) ;Is there an identifier?
JRST VM.AK2 ;No, don't AK then
PUSHJ P,VMS.BH ;Build header
MOVEI P1,NORMAL ;Give good return
;Enter here with P1 header built and P1 containing the I/O status
VM.AK1: PUSHJ P,PUTLWD
SETZ P1, ;Zap high order
PUSHJ P,PUTLWD ;Put it in
PUSHJ P,XMTMSS ;Send completion with no data
VM.AK2: MOVEI T1,(P4) ;Free the core block for the request
MOVEI T2,VRQSIZ
PJRST CORFRE ;Do it
SUBTTL VMS Support -- VMS.BH - Build Header
VMS.BH: SKIPN V.IDENT(P4) ;Get identifier (already shifted)
POPJ P, ;Return
MOVX P1,<BYTE (8) 0,0,377,VR.END> ;MOD,MOD,OP,OP
ROT P1,-4 ;Use the lower 4 bits
PUSHJ P,PUTLWD ;Put long word into buffer
MOVE P1,V.IDENT(P4) ;Get the identifier
SKIPGE P1 ;Do we have one for real?
SETZ P1, ;No, then store a zero
PUSHJ P,PUTLWD ;Put long word in buffer
SETZ P1, ;No unit
PJRST PUTWRD ;Put it in and exit
SUBTTL VMS Support -- VMS.IN - Initialization message
VMS.IN: TXZ F,F$READ ;No outstanding read yet
TXO F,F$UAST ;Flag want unsolicited abuse
SETZM UNSCNT ;We are going to send an unsolicited message
PUSHJ P,CTVMTT ;Setup VMTTCH block
MOVEI T2,20 ;Number of characters in pre-V3
SKIPE PROTMD ;If non-zero, V3 or later
MOVEI T2,24 ;Size of characteristics in V3
MOVEM T2,VMS$CF
MOVE T2,[POINT 8,VMS$CF+3] ;Where the characteristics should go
MOVSI T1,-3 ;Three words in V3+
SKIPN PROTMD ;Good assumption?
MOVSI T1,-2 ;Nope
VM.IN1: MOVE T3,VMTTCH(T1) ;Get next longword of TTY characteristics
IDPB T3,T2 ;Stuff byte 0
LSH T3,-8 ;Drop it
IDPB T3,T2 ;Stuff byte 1
LSH T3,-8 ;Drop that
IDPB T3,T2 ;Stuff byte 2
LSH T3,-8 ;Drop this one, too
IDPB T3,T2 ;Stuff byte 3
AOBJN T1,VM.IN1 ;Loop for all relevant longwords
MOVEI T1,VMS$CF ;Return config
PUSHJ P,XMTMSG ;
MOVEI T1,VMS$UN ;Get unsolicited data message
PUSHJ P,XMTMSG ;Send it
MOVE T1,[VXDMSK,,IMASK] ;Set the terminal mask
BLT T1,ENDMSK ;Set it
MOVE T1,[VXDMSK+1,,LMASK] ;Also set logical mask
BLT T1,ELMASK
MOVE T1,[7+4,,TRMBKS]
TRMOP. T1,
JFCL
PUSHJ P,TTYSST ;Set TTY: up
PJRST FRCTTI
SUBTTL VMS Support -- VM.STM - timed requests
;This routine is called if the request is timed.
;QIO block pointed to by P4.
VM.STM: MOVEI T1,VM.TMR ;Be sure timer trap is set
MOVEM T1,OSTMR ;to go to the right place
MOVE T1,V.IDENT(P4) ;Get the identifier
MOVEM T1,TMRSEQ ;Make it the sequence identifier
MOVE T1,V.TIME(P4) ;Get time request
PITMR. T1,
JFCL ;Oh well
POPJ P,
;VMS routine to actually handle the timer trap
VM.TMR: SKIPN P4,READQ ;Point to queue
POPJ P, ;No entry
MOVE T1,V.IDENT(P4) ;Get the sequence number
CAME T1,TMRSEQ ;Right sequence number?
POPJ P, ;Wrong request
MOVE T1,[2,,T2] ;Find how many chars are in the chunks
MOVEI T2,.TOTTC
MOVE T3,TTYUDX
TRMOP. T1,
PJRST VM.RDS ;Oh well
JUMPE T1,VM.RDS ;If none pending
MOVEM T1,IMASK ;Set that many
MOVEI T1,TIMEOUT ;Set status
MOVEM T1,V.STAT(P4) ;Status for read
TXO F,F$FRC!F$TEX ;Force call to TTYSST
PUSHJ P,FRCTTI ;Force wakeup
PJRST TTYSST ;Set TTY: up and return
SUBTTL VMS Support -- Set TTY: up for this read
VM.STT: TXZ F,<F$NEC!F$PIM!F$LEM> ;Clear some bits
MOVE T1,V.MOD(P4) ;Get modifiers
MOVEI CX,TNEKO ;Check perm chars too
TDNN CX,VMTTCH+1 ;?
TRNE T1,NOECHO ;Or program requested?
TLOA F,(F$NEC) ;Flag to TTY: service
TRNA ;Don't do anything
TRO T1,NOECHO ;Make it say so in request
MOVEM T1,V.MOD(P4) ;Store for when request complete
ASSUME CVTLOW,F$CVL
XOR T1,F ;Get the CVTLOW bit
HLRZ T2,TSVLCT ;Get saved lower case ability
JUMPN T2,VM.SMK ;If TTY: already upper case, no problem
TRNN T1,CVTLOW ;Is it on now?
JRST VM.SMK ;No, no change
TRCE F,F$CVL ;Is it set in F?
TDZA T3,T3 ;Yes, must want to set to upper case
SETO T3, ;If F was zero must want to clear upper case
MOVE T2,TTYUDX
MOVEI T1,.TOLCT+.TOSET
MOVE CX,[3,,T1]
TRMOP. CX, ;Do the right thing
JFCL
VM.SMK: HRRZ CX,V.COUNT(P4) ;Get maximum size
MOVEM CX,IMASK ;Set size of field
SKIPN V.MASK(P4) ;Mask specified?
SKIPA CX,[VXDMSK+1,,] ;Set default mask
HRLI CX,V.MASK+1(P4) ;Set it
HRRI CX,IMASK+1
BLT CX,ENDMSK ;Set the mask
MOVE CX,[IMASK+1,,LMASK] ;Set the "local" mask to this too
BLT CX,ELMASK ;To the end
MOVX T1,<1B<.CHCNH>> ;Must always see ^H
IORM T1,IMASK+1
TXNE F,F$PALL ;If passall, then stop here
JRST VM.NRX ;Set it up
ASSUME VM.RAL,<1B0> ;This must be true
SKIPGE V.MOD(P4) ;If READALL bit is set
TROA F,F$RALL ;Set readall bit
TXZA F,F$RALL ;Set readall
PJRST VM.NRX ;Set TTY: up
VM.NRA: MOVE T1,OBMASK ;Get the out of band mask
IORM T1,IMASK+1
MOVE T1,OBMASK+1 ;Both include and exclude
IORM T1,IMASK+1
SETZ T1, ;Initialize
TLNE F,(F$CAST) ;Want ^C?
TXO T1,<<1B<.CHCNC>>> ;Yes
TLNE F,(F$YAST) ;Want ^Y?
TXO T1,<<1B<.CHCNC>>!<1B<.CHCNY>>>
MOVE T2,V.MOD(P4) ;Get modifiers
MOVEI CX,<1B31> ;Default not NFILTR
TRNE T2,NFILTR ;No filter?
JRST VM.NR1 ;Proceed
TXO F,F$RUB ;In case any snuck in
PUSHJ P,VM.SCT ;Set up CHRTAB (must be after setting F$RUB)
JFCL ;? Shouldn't get here
ANDCAM CX,LMASK+3 ;Clear rubout in appropriate places
ANDCAM CX,IMASK+1+3
MOVX CX,<<1B<.CHCNR>>!<1B<.CHCNU>>!<1B<.CHCNX>>>
ANDCAM CX,LMASK ;These too
TXZ CX,<1B<.CHCNX>> ;We must handle ^X
ANDCM CX,OBMASK
ANDCM CX,OBMASK+1
ANDCAM CX,IMASK+1
IORM T1,IMASK+1 ;Set special bits too
VM.NRX: PUSHJ P,TTYSST ;Do it
PJRST FRCTTI
VM.NR1: TXO F,F$LEM ;Set LEM
PUSHJ P,VM.SCT ;Set up CHRTAB
JFCL ;? Shouldn't get here
TXO T1,<<1B<.CHCNR>>!<1B<.CHCNU>>!<1B<.CHCNX>>>
MOVEI CX,<1B31> ;Also set rubout
IORM CX,IMASK+1+3
IORM T1,IMASK+1 ;Set appropriate bits
SKIPE V.MASK(P4) ;Using default mask?
JRST VM.NRX ;No, change TTY:
IORM T1,LMASK ;Default bits change
IORM CX,LMASK+3 ;..
PUSHJ P,TTYSST
PJRST FRCTTI
SUBTTL VMS Support -- Set Unsolicited mode
;This routine sets the break mask for unsolicited input
VM.SUN: SAVE1
TXO F,F$UAST ;Say we want it
SKIPE READQ ;Is there a read request?
POPJ P, ;No
SETZM IMASK ;TTYSST will set it to 1
SETOM IMASK+1 ;Break on all characters
MOVE P1,[IMASK+1,,IMASK+2] ;Set the whole mask
BLT P1,ENDMSK ;Set it
PUSHJ P,TTYSST
PJRST FRCTTI ;Set up and return
SUBTTL VMS Support -- Set CHRTAB
;This routine is to set up CHRTAB
VM.SCT: PUSHJ P,SAVT ;Save the Ts
TXNE F,F$PALL!F$RALL ;If in a flavour of passall
POPJ P, ;Don't diddle CHRTAB
MOVX T1,<1B<.CHCNO>> ;Set control-O normal
TXNN F,F$LEM ;Editor?
TXO T1,<1B<.CHCNX>> ;No, set ^X
MOVE T4,VMTTCH+1 ;Get characters
TXNE T4,TTSYN ;Paged mode?
TXO T1,<1B<.CHCNS>!1B<.CHCNQ>> ;Yes, we must handle these if they come in
MOVEI T4,1B31 ;Assume don't have to do rubouts
ANDCAM T4,CHRTAB+3 ;..
TXNE F,F$RUB ;Do I have to do rubouts etc.?
TXNE F,F$LEM ;Only if not this
JRST VM.NRU ;No
TXO T1,<1B<.CHCNR>!1B<.CHCNU>>
IORM T4,CHRTAB+3 ;..
VM.NRU: TXNE F,<F$CAST> ;Want ^C?
TXO T1,1B<.CHCNC> ;Yes
TXNE F,<F$YAST> ;And if wants ^Y
TXO T1,<1B<.CHCNC>!1B<.CHCNY>>
MOVEM T1,CHRTAB ;Set special characters
JRST CPOPJ1 ;We changed it
SUBTTL VMS Support -- Handle special characters
;This routine handles ^C, ^Y, and the escape character for VMS
VMS.SC:
VM.NBK: CAIN P1,.CHCNO ;Control-O?
JRST VM.SCO ;Yes, set it
CAIN P1,.CHCNX ;^X?
JRST VM.SCX ;Yes, handle it
CAIE P1,.CHCNQ ;^Q?
CAIN P1,.CHCNS ;or ^S?
JRST VM.SCQ ;Yes, handle them
CAIE P1,.CHCNC ;Control-C?
JRST VM.NCC ;No
MOVSI T4,(1B<.CHCNC>) ;One time-AST only
ANDCAM T4,CHRTAB ;So isn't special any more
TDNN T4,LMASK ;Want to see ^C as break?
ANDCAM T4,IMASK+1 ;No, clear in IMASK
TLZN F,(F$CAST) ;User want ^C?
JRST VM.SCY ;No, send ^Y then
PUSH P,[RA.CTC,,CONTRC] ;Abort reason and ^C attention
MOVEI T4,[ASCIZ/
^C
/]
JRST VM.CYC ;Send attention interrupt
VM.NCC: CAIE P1,.CHCNY ;Control-Y?
JRST VM.LED ;See about line editing stuff
VM.SCY: MOVEI T4,1B<.CHCNY> ;^Y is one-time also
ANDCAM T4,CHRTAB
TDNN T4,LMASK ;Does he want ^Y as break
ANDCAM T4,IMASK+1 ;No
TLZN F,(F$YAST) ;Want ^Y?
POPJ P, ;Return
PUSH P,[RA.CTY,,CONTRY] ;Control-Y abort and attention
MOVEI T4,[ASCIZ/
^Y
/]
VM.CYC: PUSHJ P,CLRTOQ ;Flush the output queue
PUSHJ P,STROUT ;Output echo
PUSHJ P,DOOUT1 ;Force it out
PUSHJ P,SPCFLS ;Flush input
HLRZ T1,(P)
PUSHJ P,VMS.AT ;Send attention message too
SKIPN P4,READQ ;Anything in input queue?
JRST TPOPJ ;Fix stack and return
PUSHJ P,VMS.BH ;Build header for it
HRRZ P1,(P) ;Get abort reason
PUSHJ P,PUTLWD ;Put the word in
SETZ P1,
PUSHJ P,PUTLWD ;Zap I/O status
NETOCH P1
POP P,(P) ;Attention reason
PJRST VM.FNR ;Read request finished
;Here on control-O
VM.SCO: TXZ F,F$ICO ;Don't ignore monitor any more
PUSHJ P,SPCRMV ;Eat the ^O
PUSHJ P,VCRURB ;Set special processing
TXCN F,F$CTO ;Complement the bit
PUSHJ P,CLRTOQ ;Clear the TO queue
PUSH P,TOFLGS ;Save the flags
MOVEI T4,($TOOIN!$TOICL)
MOVEM T4,TOFLGS
MOVEI T4,[ASCIZ/^O
/]
PUSHJ P,STROUT ;Output
PUSHJ P,DOOUT1 ;Force out
POP P,TOFLGS
TXNN F,F$CTO ;Did we set it?
PJRST CLRCTO ;Inform the monitor
PUSHJ P,WATOUT ;Wait for string to get there
PJRST SETCTO ;Inform the monitor too
VM.SCX: PUSHJ P,SPCFLS ;Eat all type-ahead
SKIPN READQ
POPJ P, ;Return if no outstanding read
MOVEI T1,($TOOIN!$TOICL)
MOVEM T1,TOFLGS
MOVEI T4,[ASCIZ/^U
/] ;Say what we did
PUSHJ P,STROUT
PUSHJ P,DOOUT1
SETZM TOFLGS
POPJ P,
;Here on ^S/^Q
VM.SCQ: MOVE T1,[3,,T2] ;Change the bit
MOVEI T2,.TOSET+.TOSTP ;The output bit
MOVE T3,TTYUDX
CAIE P1,.CHCNS ;^S?
TDZA T4,T4 ;No, ^Q, clear
MOVEI T4,1
TRMOP. T1,
JFCL
PJRST SPCRMV ;Toss character and return
;Here to see about line editing stuff
VM.LED: PUSHJ P,SCNPOS ;Get position of scan
SKIPN T2,READQ ;Get read request
JRST CPOPJ1 ;None?
CAMG T1,V.COUNT(T2) ;Satisfy already?
TXNE F,F$BRK ;Break seen already?
JRST CPOPJ1 ;Yeah, do this later
VM.LD1: CAIN P1,.CHCNU ;Control-U?
JRST VM.SCU ;Do it also
CAIN P1,.CHDEL ;Rubout?
JRST VM.RUB ;Yes
CAIE P1,.CHCNR ;Control-R?
JRST CPOPJ1 ;Ignore it, I guess
;Here to process ^R
VM.SCR: MOVEI T1,VM.CTR ;Routine to call
PUSHJ P,DOCTR ;Handle the ^R
JRST VCRURB ;Check flag
VM.CTR: SAVE4 ;Save the Ps
VM.CUR: SKIPN P4,READQ ;Get current request, if any
POPJ P, ;None
TXO F,F$CLF ;Cancel a line feed
TXZ F,F$FLF ;None
PJRST CHKPRM ;See if need it
;Here to process ^U
VM.SCU: PUSHJ P,DOCTU ;Handle ^U
PUSHJ P,VM.CUR ;See if prompt
JRST VURURB ;Turn off bits
;Here to process rubout
VM.RUB: PUSHJ P,DORUB ;Do the rubout
JRST VCRURB ;Check flag
SUBTTL VMS Support -- VMS.AT - Send Attention
VMS.AT: MOVEI P1,VR.ATT ;Get Attention header
PUSHJ P,PUTWRD ;Put it in
MOVEI P1,(T1) ;Get attention reason
PUSHJ P,PUTWRD
PJRST XMTMSS ;Send the message
SUBTTL VMS Support -- VMS.ST - Set characteristics/mode
VMS.ST: ;'Set Mode' message
MOVE T1,V.MOD(P4) ;Get the modifier
TRNN T1,CC!CY ;One of these?
JRST VM.COB ;No
PUSHJ P,GETLWD ;Get first arg (P1)
MOVX T3,CC ;^C or ^Y?
TDNN T3,V.MOD(P4) ;^C or ^Y?
JRST VM.CCY ;Check ^Y
SKIPN T1 ;Set or clear?
TXZA F,F$CAST ;Clear it
TXO F,F$CAST ;Set it
MOVE T2,CHRTAB+<.CHCNC/^D32> ;Set ^C bit
TXNN F,F$CAST!F$YAST ;One of ^C or ^Y set?
TXZA T2,1B<.CHCNC> ;Clear ^C
TXO T2,1B<.CHCNC> ;Set ^C
VM.YAK: MOVEM T2,CHRTAB+<.CHCNC/^D32>
PJRST VMS.AK
VM.CCY: ASSUME <<.CHCNC/^D32>>,<<.CHCNY/^D32>>
MOVE T2,CHRTAB+<.CHCNY/^D32>
SKIPN T1 ;Set or clear?
TXZA F,F$YAST ;Clear
TXOA F,F$YAST ;Yes
TXZA T2,1B<.CHCNY> ;Clear ^Y
TXOA T2,<1B<.CHCNC>!1B<.CHCNY>> ;Set both ^C and ^Y
TXNE F,F$CAST ;Affect ^C too?
PJRST VM.YAK ;No
TXZ T2,1B<.CHCNC> ;Clear ^C too
MOVEM T2,CHRTAB+<.CHCNY/^D32>
PJRST VMS.AK ;^C/^Y set/clear and ACK
VM.COB: SKIPE PROTMD ;V3+ protocol?
TRNN T1,OBAND ;Want out-of-band AST?
JRST VM.STC ;No
SETO P3, ;Do this twice
MOVE T3,[POINT 8,P1,]
SETZB P1,P2 ;No bits in mask yet
VM.CB1: PUSHJ P,NETICH ;Get character from network
PJRST VMS.AK ;Done if none
MOVEI T4,4 ;Four times each time
PUSHJ P,CPYMSK ;Copy the mask
AOJE P3,VM.CB1
IORM P1,IMASK+1
IORM P2,IMASK+1 ;Both of them
DMOVEM P1,OBMASK ;Save the masks
IOR P1,P2 ;See if ^O is in mask
TXNE P1,1B<.CHCNO> ;?
TXOA F,F$ACO ;Allow it in mask if so
TXZ F,F$ACO ;Not allowed any more
IORM P1,IMASK+1 ;If any significant changes
PUSHJ P,TTYSST ;(just in case)
MOVE T1,V.MOD(P4) ;Get modifier
PJRST VMS.AK
VM.STC: TRNE T1,777700 ;Any modifiers?
PJRST VMS.UM ;Unsupported modifier if so
PUSHJ P,GETLWD ;Get first word of chars
EXCH T1,VMTTCH ;Store it, get old
XOR T1,VMTTCH ;Get differences
TRNN T1,377B<^D35-^D8>;Type change?
JRST VM.ST0 ;No
LDB T1,[POINT 8,VMTTCH,^D35-^D8] ;Get the type
MOVE T2,[-TTHLEN,,TTHOFS] ;Pointer to type table
VM.STL: HRRZ T3,VTPTB(T2)
CAIE T1,(T3) ;This one?
AOBJN T2,VM.STL ;No
JUMPGE T2,VM.ST0 ;Can't find it
HRREM T2,TTYTYP ;Save it
MOVE T4,TTPTB(T2) ;Get TOPS-10 type
MOVE T3,TTYUDX
MOVEI T2,.TOTRM+.TOSET
MOVE T1,[3,,T2]
TRMOP. T1,
JFCL
VM.ST0: PUSHJ P,GETLWD ;Get second word
TRNN T1,TPSAL ;Check passall
TXZA F,F$PALL
TXO F,F$PALL ;Set or clear as appropriate
EXCH T1,VMTTCH+1 ;Save it too
XOR T1,VMTTCH+1 ;Get changes
MOVE CX,[3,,T2]
MOVE T3,TTYUDX ;Who to change
MOVX T2,TWRAP ;Get the wrap bit
TDNN T1,T2 ;Did it change?
JRST VM.ST1 ;No
TDNE T2,VMTTCH+1 ;On or off?
TDZA T4,T4 ;Off
SETO T4, ;On
MOVEI T2,.TONFC+.TOSET
TRMOP. CX, ;Do it
JFCL
VM.ST1: MOVX T2,TTSYN ;Paged mode?
TDNN T1,T2 ;Change?
JRST VM.ST2 ;No
TDNN T2,VMTTCH+1 ;On or off now?
TDZA T4,T4 ;Off
SETO T4,
MOVEI T2,.TOSET+.TOXNF
MOVE CX,[3,,T2] ;Set as appropriate
TRMOP. CX,
JFCL
VM.ST2: SKIPN PROTMD ;Version 3 or later protocol?
PJRST VMS.AK ;Write the data to the VAX
PUSHJ P,GETLWD ;Version 3, eat speed, fill, and parity
PUSHJ P,GETLWD
PUSHJ P,GETLWD
PUSHJ P,GETLWD ;And get second characteristics word
MOVEM T1,VMTTCH+2 ;Save them away too
PJRST VMS.AK ;AK the message
SUBTTL VMS Support -- VMS.NI - Unsolicited Data Message
VMS.UN: TXNE F,F$UAST ;Want message?
AOSE UNSCNT ;Send unsolicited message?
POPJ P,
MOVEI T1,VMS$UN ;Tell host about unsolicited data
PJRST XMTMSG ;
SUBTTL VMS Support -- Checkout-of-band character
;Scan input for out-of-band character. If found, then
;return CPOPJ with character. If not found, return CPOPJ1
VM.CHO: SKIPN P4,INPQUE ;Get any input
JRST CPOPJ1 ;None
VM.CHA: SKIPG IBF.LK(P4) ;Another buffer?
JRST VM.CHC ;No, done
HRRZ P4,IBF.LK(P4) ;Point to next
JRST VM.CHA
VM.CHC: MOVE P3,IBF.CT(P4) ;Get count
MOVE P2,IBF.PT(P4) ;And pointer
VM.CH1: PUSHJ P,SCNCHR ;Any?
JRST CPOPJ1 ;None
CAIL P1," " ;Must be a control character
JRST VM.CH1 ;No
MOVEI T1,(P1)
LSHC T1,-5 ;Separate word & bit numbers
LSH T2,-^D31 ;Right-justify bit number
MOVE T1,BITTBL(T2) ;Get corresponding bit
TDNN T1,OBMASK ;In include mask?
TDNE T1,OBMASK+1 ;In exclude mask?
TRNA ;In one of them
JRST VM.CH1 ;Check next character
TDNE T1,OBMASK ;In include mask?
JRST VCRURB ;Yes
PUSH P,P1 ;Save character
PUSHJ P,SPCRMV ;Remove the character now
POP P,P1 ;Restore the character
FALL VCRURB ;Check ^R, ^U, <RUB>
;Fall into below
SUBTTL VMS Support -- Check ^R, ^U, and <RUB>
;This routine checks to see if we must do processing for ^R, ^U, or <RUB>
;and sets bits appropriately
VCRURB: TDZA T3,T3 ;Flag to set
VCRUR1: SETO T3, ;Don't set
TXNN F,F$READ ;Read pending?
PJRST VURURB ;No
SKIPE ICHCNT ;Any characters in input?
TXNE F,F$PALL ;Yes, passall?
PJRST VURURB ;Clear if need to
SKIPN T1,READQ
PJRST VCRUR2 ;Set stuff, no request active
MOVX T2,VM.RAL!NFILTR
TDNN T2,V.MOD(T1) ;??
VCRUR2: JUMPE T3,STRURB ;Set
POPJ P,
VURURB: MOVE T3,VXDMSK ;Use default if no request
SKIPE T1,READQ ;Current request
SKIPA T3,V.COUNT(T1) ;Get count from there then
JRST VCKPAL ;Check passall only
HRL T1,V.MOD(T1) ;Get modifiers
TLNN T1,NFILTR ;This no-filter?
VCKPAL: TXNE F,F$PALL ;Passall?
JRST UNRURB ;Conditional based on mask
JUMPE T1,UNRALL ;Always if no request
TXNN F,F$RALL ;Read-all check if a request
JRST UNRALL ;Always then
JRST UNRURB ;Else conditional
SUBTTL VMS Support -- Out-of-band ATTN
VM.OOB: PUSH P,P1 ;Save character
MOVEI P1,VR.ATT ;Get attention reason
PUSHJ P,PUTWRD ;set it
MOVEI P1,RA.OUB ;Modifier
PUSHJ P,PUTWRD ;Also there
SETZ P1,
PUSHJ P,PUTLWD ;Longword
PUSHJ P,PUTWRD
POP P,P1
NETOCH P1 ;Put character in
PJRST XMTMSS ;Send the message
SUBTTL VMS Support -- VMS.BC - Broadcast data
VMS.BC: PUSHJ P,GETLWD ;Get count
SKIPN P3,T1 ;Copy to P1 if any
JRST VMS.AK ;ACK it if no data
SKIPN V.IDENT(P4) ;If no identifier
JRST VM.BNA ;Then just don't ACK this
PUSHJ P,VMS.BH ;ACK the req but don't return the block
MOVEI P1,NORMAL
PUSHJ P,PUTLWD
SETZ P1,
PUSHJ P,PUTLWD
PUSHJ P,XMTMSS ;Send the ACK
VM.BNA: PUSHJ P,GETLWD ;Get junk long-word
PUSH P,TOFLGS ;Save current flags
MOVEI P1,($TOOIN)
MOVEM P1,TOFLGS
PUSH P,F ;Save F
PUSH P,IMASK+1
DMOVE T3,VMTTCH+1 ;Get characteristics
TRNN T3,TNBCS ;No mailbox, is no broadcast set?
TXNE F,F$CTO ;Or is ^O in effect?
JRST [TRNE T4,T2BCM ;Is there a mailbox?
JRST VM.BNB ;Yes
JRST VM.BXD ];No
SKIPN T1,READQ ;Is there a current read request?
JRST VM.BNZ ;No
SKIPE V.PROM(T1) ;Prompt string?
JRST [TXO F,F$FLF ;Yes, set FLF
JRST VM.BNZ ];Continue
TXZ F,F$FLF!F$CLF ;Clear flags
TXNE F,F$NEC ;No-echoed?
JRST VM.BNZ ;Yes
SKIPE ICHCNT ;Any characters there?
TXOA F,F$FLF ;Yes, flag a line feed
TXO F,F$CLF ;No characters, any line feed taken care of
;The above is not quite accurate.
VM.BNZ: TRNN T4,T2BCM ;Is there also a mailbox?
JRST VM.BCL ;No
VM.BNB: SETO P1,
PUSHJ P,PUTWRD ;Attention request
MOVEI P1,5 ;Completion op code
PUSHJ P,PUTWRD ;...
SETZ P1, ;ID (should be ignored
PUSHJ P,PUTLWD
PUSHJ P,PUTWRD ;Unit
MOVEI P1,^D22(P3) ;Remaining data size
PUSHJ P,PUTWRD
MOVEI P1,MTMBRD ;Code
SETZ P1, ;Just to look nice
PUSHJ P,PUTWRD
PUSHJ P,PUTWRD ;BRDUNIT
PUSHJ P,PUTLWD ;BRDNAME
PUSHJ P,PUTLWD
PUSHJ P,PUTLWD
PUSHJ P,PUTLWD
MOVEI P1,(P3) ;Text size
PUSHJ P,PUTWRD
VM.BCL: PUSHJ P,RBYTEC ;Get a byte
TRNE T4,T2BCM ;Mailbox?
NETOCH T1 ;Ship to network
TXNN F,F$CTO ;Control-O?
TRNE T3,TNBCS ;No broadcast?
JRST VM.BX3 ;Skip all this then
TXNN F,F$FLF ;Supposed to be free line feed?
JRST VM.BX1 ;No
CAIN T1,.CHLFD ;Is this a line feed?
TXZA F,F$FLF ;Yes, clear it
CAIGE T1," " ;Printing character?
JRST VM.BX1 ;No
PUSH P,T1
MOVEI T1,.CHLFD ;Output the <LF>
PUSHJ P,OUTTTY
POP P,T1
TXZ F,F$FLF ;Don't do it any more
VM.BX1: TXNE F,F$CLF ;Cancel line feed?
CAIN T1,.CHLFD ;Yes, is this a line feed?
TXZN F,F$CLF ;Yes, clear
VM.BX2: PUSHJ P,OUTTTY ;Output to TTY:
VM.BX3: SOJG P3,VM.BCL ;For all bytes
CAIN T1,.CHCRT ;Last character a <CR>?
TXO F,F$FLF ;Yes
TXZ F,F$CLF ;Don't cancel any more line feeds
TRNE T4,T2BCM ;Mailbox?
PUSHJ P,XMTMSS ;Send mailbox message now
VM.BXD: MOVEI T1,(P4) ;Point to request block
MOVEI T2,VRQSIZ
PUSHJ P,CORFRE ;Free the block
TXNN F,F$CTO ;^O?
TRNE T3,TNBCS ;Nobroadcast?
JRST VM.BC8 ;Return
SKIPN P4,READQ ;Anything in queue?
JRST VM.BC9
MOVX T1,VM.RAL
TDNE T1,V.MOD(P4) ;Any of the physical stuff?
TXZ F,F$FLF ;Yes
PUSHJ P,CHKPRM ;Output prompt it any
SETZ P3, ;Clear who we're remembering
MOVX T1,F$NEC ;Are we supposed to be noechoed?
TDNE T1,-1(P) ;?
JRST VM.BC8 ;Yes
SKIPN P4,INPQUE
JRST VM.BC5 ;Just do FRCUUO
VM.BC0: SKIPG IBF.LK(P4)
JRST VM.BC1
HRRZ P4,IBF.LK(P4)
SKIPLE IBF.CT(P4) ;Is this one real?
HRRZI P3,(P4) ;Yes, remember it
JRST VM.BC0
VM.BC1: SKIPG IBF.CT(P4) ;If this has a real count then it's the one
MOVEI P4,(P3) ;Else this is the one
JUMPE P4,VM.BC5 ;Nothing, just do frcuuo
MOVE P2,IBF.PT(P4) ;Pointer
SKIPN P3,IBF.CT(P4) ;Get count
JRST VM.BC4 ;It's zero
IBP P2 ;Force normalization
SOJE P3,VM.BC4 ;If just one byte
EXCH P2,P3 ;Set up for ADJBP
ADJBP P2,P3
VM.BC4:
PUSH P,P2
PUSHJ P,SCNLBK ;Point to last character before
VM.BC2: PUSHJ P,SCNCHR
JRST VM.BC3
TXNE F,F$FLF ;Need free line feed?
CAIN P1,.CHLFD ;This a line feed?
JRST VM.BC6 ;Proceed
MOVEI T1,.CHLFD ;Output a line feed
PUSHJ P,OUTTTY ;Output
VM.BC6:
TXZ F,F$FLF
MOVEI T1,(P1)
PUSHJ P,OUTTTY
CAME P2,(P)
JRST VM.BC2
VM.BC3:
POP P,(P) ;Clear junk
VM.BC5: TXZN F,F$FLF ;Still need?
JRST VM.BC7 ;No
TXO F,F$CLF ;Say we gave one
TXNE F,F$NEC ;Currently noechoed?
JRST VM.BC7 ;Yes, no line feed
MOVEI T1,.CHLFD ;Output one
PUSHJ P,OUTTTY
VM.BC7: PUSHJ P,DOOUT1
PUSHJ P,DOFRCU ;Do a FRCUUO
VM.BC8: POP P,T2 ;Restore old value for next time
POP P,T1
POP P,TOFLGS ;Restore output flags
TXNN T1,F$NEC
TXZ F,F$NEC ;Clear no-echo
PUSHJ P,TTYSST
MOVEM T2,IMASK+1
TXZ F,F$ACO
POPJ P,
VM.BC9: PUSHJ P,DOOUT1
PJRST VM.BC8
SUBTTL VMS Support -- VMS.SN - Sense Mode message
VMS.SN: ;'Sense Mode' message received
MOVE T1,V.MOD(P4) ;Get the modifiers
TRNE T1,TYPAHD ;Want typeahead count?
JRST VMS.TA ;Yes
TRNE T1,MODEM ;Want modem status
JRST VM.NMD ;Yes, sense modem
PUSHJ P,VMS.BH ;Build the usual header
MOVEI P1,NORMAL
PUSHJ P,PUTWRD
SETZ P1, ;**TEMP
PUSHJ P,PUTWRD
PUSHJ P,PUTLWD
MOVE P1,VMTTCH ;Get first word of characteristics
PUSHJ P,PUTLWD
MOVE P1,VMTTCH+1
PUSHJ P,PUTLWD
SKIPN PROTMD ;Version 3 protocol?
JRST VM.SN1 ;No
MOVE P1,VMTTCH+2 ;Get char 2
PUSHJ P,PUTLWD
VM.SN1: PUSHJ P,XMTMSS
MOVEI T1,(P4)
MOVEI T2,VRQSIZ
PJRST CORFRE
VMS.TA: MOVE T1,[2,,T2] ;Find how many in chunks
MOVEI T2,.TOTTC ;..
MOVE T3,TTYUDX
TRMOP. T1,
SETZ T1,
PUSH P,P4 ;Save P4
PUSHJ P,SCNINI ;Init a scan
PUSHJ P,SCNCHR ;Get the character
JUMPN T1,VM.TA4 ;Figure what's out there
MOVEI P3,(P1) ;Remember character
POP P,P4 ;Restore P4
PUSHJ P,VMS.BH ;Build the usual header
MOVEI P1,NORMAL
PUSHJ P,PUTWRD
SETZ P1, ;**TEMP
PUSHJ P,PUTWRD
PUSHJ P,PUTLWD
MOVE P1,ICHCNT
ADDI P1,(T1) ;Add them in
PUSHJ P,PUTWRD ;Tell him
NETOCH P3 ;Output the character
NETALC 5 ;Rest is reserved
JRST VM.SN1 ;Return
;Here if there are characters in the chunks and none internally. Cheat.
VM.TA4: TXO F,F$FRC ;Force a read
PUSHJ P,FRCTTI ;Force wakeup
SETZM IMASK ;Only want to see first character
POP P,SENSEQ ;Remember the request
PJRST TTYSST ;Set TTY: up and return
;Here at TTY: interrupt level after the read is complete
VM.SNC: TXZ F,F$FRC ;Don't need to force any more
SETZM SENSEQ ;Done here
JRST VMS.TA ;Finish up the sense
;Here if modem modifer is set
VM.NMD: PUSHJ P,VMS.BH ;Build header
MOVEI P1,NORMAL
PUSHJ P,PUTWRD
SETZ P1, ;**TEMP
PUSHJ P,PUTWRD
PUSHJ P,PUTLWD
PUSHJ P,PUTLWD ;Return all zeroes
PUSHJ P,PUTLWD
JRST VM.SN1 ;Finish up
SUBTTL VMS Support -- Return unsupported
;This routine returns an unsupported return for those functions we
;don't know what to do with. Call with request block in P4.
VMS.UM: PUSHJ P,VMS.BH ;Build header
MOVEI P1,ILLFNC ;Say what's wrong
PUSHJ P,PUTWRD ;Put it in
SETZ P1, ;Do the rest
PUSHJ P,PUTWRD
PUSHJ P,PUTLWD ;Of the IOSB
PUSHJ P,XMTMSS ;Send the message
MOVEI T1,(P4) ;Free the block
MOVEI T2,VRQSIZ
PJRST CORFRE
SUBTTL TOPS-10/20 support -- Network service
PIM.NT: SKIPE OSTMR ;Are we enabled for flush?
TXO F,F$CTO ;Yes, flag it
PUSHJ P,NETCHR ;See if we have a network character
POPJ P, ;No, Return (no null messages)
SUBTTL TOPS-10/20 support -- TTY: service
PIM.TT: TXZE F,F$CTO ;Don't flush anything else
SETZM OSTMR ;No more timer stuff
PIM.T1: PUSHJ P,INCHR
JRST XMTMSQ ;See if anything to output
JRST DOT107 ;Process
DOT106: PUSHJ P,INCHR ;Get a character
JRST XMTMSS ;Send the message
DOT107: CAME T1,CC.SW1 ;Start of switch sequence?
JRST DOT109 ;No, don't sweat it
PUSHJ P,INCHR ;Yes, get next
JRST [MOVE T1,CC.SW1 ;Retrieve previous
MOVEM T1,INPCHR ;Re-eat
SETZM ICHCNT ;Adjust for underflow
AOS ICHCNT ;Remember our character
JRST XMTMSQ] ;Send message and await input
CAME T1,CC.SW2 ;Escape character
JRST [PUSH P,T1 ;Save for a moment
MOVE T1,CC.SW1 ;Retrieve previous
NETOCH T1 ;Send it off
POP P,T1 ;Restore current
JRST DOT109] ;Send it along
MOVE T1,TTYUDX ;Get controlling TTY: UDX
CAME T1,CTLTTY ;Same as controlling terminal?
JRST DOT108
TXNE F,F$XPT ;Is he supposed to be an expert?
PUSHJ P,INCHR ;Anything to eat?
DOT108: TDZA T3,T3 ;No character
MOVE T3,T1 ;Put character in T2
PIM.MN: PUSHJ P,MONITC ;Go to the monitor
JRST PIM.T1
DOT109: NETOCH T1 ;Output to network
JRST DOT106 ;Loop for whole message
SUBTTL TOPS-10/20 support -- Timer service
;Timer service is utilized for the "Flush Network Output" command.
;This is implemented so that we can automatically turn off the flush
;command if no network messages are received within the timeout period
PIM.TM: TXZN F,F$CTO ;Clear the flush flag
JRST PIM.TC ;Clear timer stuff and return
MOVEI T1,1 ;Reset for one second
PITMR. T1, ;Set the timer
JFCL
POPJ P, ;Done
PIM.TC: SETZM OSTMR ;Don't come back here
SKIPE T4,NOTICH ;Point to string
TXNN F,F$XPT ;And in some expert mode?
POPJ P,
PUSHJ P,STROUT ;Do it
PJRST DOOUT1 ;Tell him
SUBTTL TOPS-10/20 support -- Initialization
PIM.IN: TXO F,<F$PIM!F$READ!F$EOMN>
;No local echo, PIM, always read active
;No EOM except on last buffer
PUSHJ P,SETQUO ;Set link quotas
PJRST TTYSST
SUBTTL CTERM Protocol support -- Data Definitions
;The structure of a queued read block
.ORG 0
C.LINK:! BLOCK 1 ;POINTER TO NEXT REQUEST (OR ZERO)
C.HPOS:! BLOCK 1 ;STARTING HPOS OF THIS READ
C.VPOS:! BLOCK 1 ;STARTING VPOS
C.COUN:! BLOCK 1 ;THE BUFFER SIZE (BREAK WIDTH)
C.TERM:! BLOCK 1 ;TERMINATION REASON (-1 IF NONE SET)
C.FLG1:! BLOCK 1 ;FLAGS (BYTES 0 & 1)
C.FLG2:! BLOCK 1 ;FLAGS (BYTE 2)
C.PRE1:! BLOCK 1 ;PRE-LOAD BUFFER OR -1 FOR REDISPLAY
C.PRE2:! BLOCK 1 ;OTHER PRE-LOAD BUFFER
C.PROM:! BLOCK 1 ;XWD BYTE-COUNT,ADDR FOR PROMPT (OR ZERO)
C.LOWM:! BLOCK 1 ;LOW WATER MARK
C.TIME:! BLOCK 1 ;TIMER VALUE (-1 IF NO TIMING)
C.IDEN:! BLOCK 1 ;IDENT USED FOR TIMING (COPIED FROM MSGNUM)
C.MASK:! BLOCK 8 ;THE BREAK MASK TO BE USED FOR THIS READ
C.SIZE:! ;SIZE OF A CTERM READ QUEUE ENTRY
.ORG ;BACK TO NORMAL SPACE
SUBTTL CTERM Protocol support -- Initialization
CTM.IN: MOVEI T1,.FMBAC ;BIND-ACCEPT MESSAGE
NETOCH T1 ;SEND A BYTE
MOVEI T3,3 ;LENGTH OF A VERSION STRING
MOVE T2,[POINT 8,FNDVRS] ;POINT TO OUR FOUNDATION VERSION STRING
CALL PUTSTR ;SEND BYTES
MOVEI T1,O.T10 ;OUR O/S TYPE
;IFN FTCROCK,<
; MOVE T2,OSTYPE ;GET REMOTE'S O/S TYPE
; CAIN T2,O.UXB ;CONFUSED ULTRIX VERSION?
; MOVEI T1,O.VMS ;YES, LIE TO IT
;> ;END CROCK
CALL PUTINT ;SEND IT
MOVX T1,%CNCV1 ;ARG FOR FIRST WORD
GETTAB T1, ;GET PART OF REVISION STRING
SETZ T1, ;SHOULD NEVER HAPPEN
MOVX T2,%CNCV2 ;ARG FOR SECOND WORD
GETTAB T2, ;GET REST OF REVISION STRING
SETZ T2, ;SNH
DMOVEM T1,CTHREV ;STORE FOR OUTPUT
MOVEI T3,8 ;LENGTH OF A REVISION STRING
MOVE T2,[POINT 8,CTHREV] ;POINT TO STRING FROM COMMON
CALL PUTSTR ;SEND IT
MOVE T1,TTYUDX ;GET OUR LINE NUMBER
CALL PUTINT ;SEND IT
SETZ T1, ;OPTIONS BYTE IS RESERVED FOR .FMBAC
NETOCH T1 ;SEND IT
SETOM MSGNUM ;NO PROTOCOL MESSAGES SEEN YET
MOVE T1,SNDMMS ;GET SIZE LIMIT
SUBI T1,4 ;OFFSET FOR .FMCMD OVERHEAD
MOVEM T1,CCOMMS ;MAXIMUM SIZE FOR COMMON-DATA BLOCK
MOVE T1,OSTYPE ;GET REMOTE'S O/S TYPE
CAIN T1,O.VMS ;THE BAD PROTOCOL?
SETOM BADBOY ;YES, FLAG IT
SETZB T2,T3 ;BOOLEAN FALSES
CAIN T1,O.UXB ;DEFICIENT ULTRIX IMPLEMENTATION?
DMOVEM T2,CC.IER ;YES, GIVE vi USERS A BREAK
ASSUME CC.OER-1,CC.IER
CAIE T1,O.VMS ;EITHER DEFICIENT
CAIN T1,O.UXB ; IMPLEMENTATION?
SETOM BADECH ;YES, IT DOESN'T WANT ECHO BY THE SPEC
MOVEI T2,CA.SLF ;LITERAL ECHO (RATHER THAN STANDARD)
SKIPE BADECH ;IF CAN'T READ,
MOVEM T2,CC.CAT+.CHTAB ;GIVE THEM TABS THE WAY THEY WOULD LIKE
SETZB T1,P1 ;CONFUSE CCISKP
CALL GETBRU ;SETUP FOR 'UNIVERSAL' BREAK MASK
CALL CTM.AD ;PRETEND WE JUST ATTACHED (READ SOME VALUES)
MOVEI T4,CTMSET ;POINT TO OUR TTY-SETTING BLOCK
MOVEM T4,OSSET ;SAVE IT FOR MANAGEMENT MODE
HRROS TSTQOT ;TELL SETTTY TO ENABLE TTY QUOTE
MOVX T1,1B<.CHCNW>!1B<.CHCNU>!1B<.CHCNR>!1B<.CHCNX>!1B<.CHCNV>
MOVEM T1,CHRTAB ;SET SPECIALS
SETZB T1,T2 ;GET SOME ZEROS
DMOVEM T1,CHRTAB+1
DMOVEM T1,CHRTAB+4
DMOVEM T1,CHRTAB+6
MOVX T1,1B31 ;DELETE IS ALSO SPECIAL
MOVEM T1,CHRTAB+3 ;SO SET IT
MOVX T1,TC.NSA_TC.VLO ;GET DISABLE BIT
IORM T1,CATTAB+.CHDEL ;DISABLE RUBOUT
IORM T1,CATTAB+.CHCNU ;DISABLE ^U
TXO T1,TC.OOB_TC.VLO ;TURN ON OUT-OF-BAND BIT
IORM T1,CATTAB+.CHCNO ;INTERRUPT ON CONTROL-O
TXO T1,TC.CLR_TC.VLO ;MERGE IN CLEAR BIT
IORM T1,CATTAB+.CHCNX ;TO SIMULATE CONTROL-X ACTION
TXZ F,F$PIM!F$READ!F$EOMN ;NOT PIM, NO READ ACTIVE
TXO F,F$ACO!F$LEM!F$RUB!F$SYNC ;MUST HAVE THESE SET
CALL UNREAD ;DON'T GET INPUT THE FIRST TIME
PJRST XMTMSS ;SEND THE MESSAGE & RETURN
ND LFMVER,2
ND LFMECO,4
ND LFMMOD,0
;FOUNDATION PROTOCOL VERSION WE IMPLEMENT
FNDVRS: BYTE (8) LFMVER,LFMECO,LFMMOD
SUBTTL CTERM Protocol - ATTACH event handler
CTM.AD: MOVE T1,TTYUDX ;GET UDX WE CARE ABOUT
GETLCH T1 ;GET SOME BITS
TXNN T1,GL.DSL ;DATASET LINE?
TDZA T2,T2 ;NO, CLEAR VALUE
MOVEI T2,1 ;YES, SET IT
MOVEM T2,CC.MSP ;PROPAGATE TO 'MODEM SIGNALS PRESENT'
TXNE T1,GL.CNE!GL.LCP;ECHO OFF BY COMMAND?
TDZA T2,T2 ;YES, CLEAR ECHO-ON VALUE
MOVEI T2,1 ;NO, SET IT
MOVEM T2,CC.ECH ;SAVE ECHO STATUS
TXNN T1,GL.DSP ;DISPLAY?
TDZA T2,T2 ;NO, CLEAR VALUE
MOVEI T2,1 ;YES, SET IT
MOVEM T2,TTDISP ;SAVE FOR TA%DIS AND VIDRUB
HLRZ T1,TSV8BT ;TTY EIGHTBIT
ADDI T1,7 ;MAKE CHARACTER SIZE
MOVEM T1,CC.CSZ ;SET IT
ANDI T1,1 ;INVERT THE EIGHT-BIT VALUE
MOVEM T1,CC.8BC ;MAP IT INTO 'EIGHTH BIT CLEARED'
MOVE CX,[2,,T1] ;ARG POINTER
MOVEI T1,.TOTRM ;TTY TYPE NAME
MOVE T2,TTYUDX ;WHICH TTY
TRMOP. CX, ;ASK
SETZ CX, ;?!?
MOVEM CX,TTTYPE ;SAVE REAL TYPE
MOVEI T1,.TOTCN ;CLASS NAME
MOVE CX,[2,,T1] ;ARG POINTER
TRMOP. CX, ;GET IT
SKIPA CX,TTTYPE ;SIGH--GOTTA TRY THE OLD WAY
JRST CTMAD1 ;USE CLASS NAME AS CANONICAL TYPE
MOVSI T1,-TTNLEN ;AOBJN POINTER TO TABLE
CAME CX,TTNTYP(T1) ;MATCH?
AOBJN T1,.-1 ;LOOP UNTIL IT DOES
SKIPGE T1 ;FOUND A MATCH?
MOVE CX,TTNALT(T1) ;YES, GET CANONICAL NAME
CTMAD1: MOVEM CX,CC.TTN ;SAVE TTY TYPE
SETOM TTKNOW ;ALWAYS KNOWN WHEN SET LOCALLY
MOVE CX,[2,,T1] ;POINTER AGAIN
MOVEI T1,.TOTSP ;TRANSMIT SPEED
TRMOP. CX, ;GET IT
MOVEI CX,17 ;MAXIMUM
MOVE CX,SPDTBL(CX) ;TRANSLATE INDEX TO SPEED
MOVEM CX,CC.TSP ;SAVE XMIT SPEED
MOVE CX,[2,,T1] ;POINTER YET AGAIN
MOVEI T1,.TORSP ;RECEIVE SPEED
TRMOP. CX, ;GET IT
MOVEI CX,17 ;MAXIMUM
MOVE CX,SPDTBL(CX) ;TRANSLATE IT
MOVEM CX,CC.RSP ;SAVE RCV SPEED
HLRZ T1,TSVSTO ;TTY STOP
MOVEM T1,CC.OPS ;PROPAGATE TO OUTPUT PAGE STOP
HLRZ T1,TSVXNF ;TTY XONOFF
MOVEM T1,CC.OFC ;PROPAGATE TO OUTPUT FLOW CONTROL
HLRZ T1,TSVWID ;TTY WIDTH
MOVEM T1,CC.WID ;SET CHARACTERISTIC
HLRZ T1,TSVLNB ;TTY LENGTH
MOVEM T1,CC.LEN ;TO CHARACTERISTIC
HLRZ T1,TSVSSZ ;STOP SIZE
MOVEM T1,CC.SSZ ;PROPAGATE
HLRZ T1,TSVTAB ;HARDWARE TAB
SKIPN T1 ;IF OFF,
MOVEI T1,HT.SIM ;SAY SOFTWARE SIMULATED
MOVEM T1,CC.HTM ;SET IN CHARACTERISTIC
HLRZ T1,TSVFRM ;TTY FORM
SKIPN T1 ;IF NOT SET,
MOVEI T1,FF.SIM ;SAY WE'LL SIMULATE IT
MOVEM T1,CC.FFM ;SET IN CHARACTERISTIC
MOVEM T1,CC.VTM ;SAME FOR VT MODE
HLRZ T1,TSVNFC ;NO FREE CRLF
SKIPN T1 ;IF ALLOWING CRLF,
MOVEI T1,WP.SFT ;CALL IT FULL SOFTWARE WRAPPING
MOVEM T1,CC.WRP ;PROPAGATE TO WRAP CHARACTERISTIC
MOVEI T1,.TOATR ;GET ATTRIBUTES
MOVE CX,[2,,T1] ;UUO ARGUMENT
TRMOP. CX, ;READ THEM
SETZ CX, ;OLD MONITOR
MOVEM CX,TTATTR ;SAVE FOR ANYONE WHO CARES
MOVEI T1,.TOAT2 ;SECOND ATTRIBUTES WORD
MOVE CX,[2,,T1] ;UUO ARGUMENT
TRMOP. CX, ;READ IT
SETZ CX, ;CAN'T
MOVEM CX,TTATR2 ;SAVE FOR CTVMTT
RET ;DONE WITH SPECIAL READS
SUBTTL CTERM Protocol - OOB Service
CTM.OB: CALL NXTOOB ;DEQUEUE ANOTHER CHARACTER
PJRST XMTMSQ ;DONE
PUSH P,F ;SAVE FLAGS
TXZ F,F$NEC ;DO ECHOING CORRECTLY
MOVE P2,T1 ;PUT CHARACTER IN A SAFE PLACE
MOVE P3,CC.CAT(P2) ;GET ITS ATTRIBUTES
MOVEI P1,CTMOBD ;POINT TO DISPATCH TABLE
TXNE P3,CA.ENB ;IS IT STILL ENABLED?
CALL FNDFNC ;YES, DISPATCH ON IT IF NEEDS SPECIAL TREATMENT
NOP ;DON'T CARE IF IT DIDN'T
;Note that the CTMOBD routines must return with P2 & P3 intact
TXCN P3,CA.OOB ;IS IT SUPPOSED TO BE OOB?
JRST CT.OB2 ;NO, HANDLE THE NEXT ONE
TXCN P3,CA.OOB ;IS IT SUPPOSED TO BE A CLEAR CHARACTER?
ASSUME CA.OOB,.OBHEL
JRST CT.OB1 ;NO, DON'T DO 'CLEAR' TYPE THINGS
TXO F,F$FRC ;YES, MAKE SURE WE SEND INPUT-STATE IF NEEDED
MOVEI T1,.RDOOB ;YES, TERMINATED BY OOB
CALL RDTRMF ;TERMINATE CURRENT READ, IF ANY
CALL FLSTAQ ;DUMP INTERNAL TYPEAHEAD
CALL CLRCTO ;MAKE SURE ECHO STRING TYPES
TXNE P3,CA.SDO ;SET DISCARD?
TXO F,F$CTO ;YES
TXNE P3,CA.SDO ;SET DISCARD?
CALL CLRTOQ ;MAKE SURE ANY TO GETS FLUSHED
MOVEI T1,(P2) ;GET CHARACTER AS ARGUMENT
CALL CTM.EC ;OUTPUT ITS ECHO STRING
CALL WATOUT ;WAIT FOR STRING TO GET THERE
TXNN P3,CA.SDO ;SET DISCARD?
JRST CT.OB1 ;NO, SKIP DISCARD-TYPE THINGS
CALL SETCTO ;INFORM THE MONITOR
TXZ F,F$CLF!F$FLF ;ALLOW NEXT LINEFEED
CT.OB1: MOVEI T1,.CMOOB ;OUT-OF-BAND MESSAGE
TXNE P3,CA.SDO ;SET DISCARD?
TRO T1,OB.DIS_8 ;YES, LIGHT FLAG
CALL CCOST2 ;SEND TWO BYTES
MOVEI T1,(P2) ;GET THE CHARACTER
CALL CCOBYT ;SEND THAT AS WELL
CALL CCOFIN ;DONE WITH THIS SUB-MESSAGE
NOP ;ALWAYS SKIPS
CT.OB2: POP P,T1 ;RESTORE FLAGS
TXNE T1,F$NEC ;SUPPOSED TO SUPPRESS ECHO?
TXO F,F$NEC ;YES, DO SO
JRST CTM.OB ;LOOP OVER ALL OOB CHARS WE HAVE
CTMOBD: CT.OBX,,.CHCNX ;^X HANDLING
CT.OBO,,.CHCNO ;^O HANDLING
Z ;OTHERS ARE NOT (AS) SPECIAL
;Here to handle the out-of-bands that we declare to handle special
;character actions.
CT.OBX: CALL FLSTAQ ;YES, FLUSH QUEUED TYPEAHEAD
TXNN F,F$READ ;IS THERE AN ACTIVE READ?
RET ;NO, WE'RE DONE HERE
MOVEI T1,.CHCNU ;YES, GET CONTROL-U
MOVEM T1,INPCHR ;SAVE AS TYPEAHEAD (UNECHOED)
AOS ICHCNT ;COUNT IT FOR READ TESTS
TXO F,F$FRC ;DEMAND TO GET TO TTY: SERVICE
RET ;NOW RETURN
CT.OBO: SETCMB T1,REQCTO ;TOGGLE THE REQUESTED STATE
JUMPE T1,CT.OO1 ;DON'T CHANGE IT IF WANT IT OFF
SETZM WRTLOK ;NO LONGER LOCKED OUT
MOVEM T1,CURCTO ;SET AS ACTUAL STATE
CALL CLRTOQ ;DISMISS NEW OUTPUT
TXO F,F$FRC ;MAKE SURE WE START ECHO AGAIN
CT.OO1: MOVEI T1,.CHCNO ;THE CHARACTER THAT GOT US HERE
CALL CTM.EC ;ECHO IT
TXZ F,F$FLF!F$CLF ;NOTHING SPECIAL ABOUT <LF> ANY MORE
SKIPN CURCTO ;WANT TO FLUSH?
JRST CT.OO2 ;NO, SO DON'T
CALL WATOUT ;FLUSHING, WAIT FOR ANY OUTPUT TO GO
TXO F,F$CTO ;MAKE SURE WE DO IT
CALL SETCTO ;WE NOW HAVE SUPPRESSION
CT.OO2: MOVEI T1,.CMDOS ;DISCARD-OUTPUT STATE MESSAGE
SKIPN REQCTO ;IF WANT TO STOP FLUSHING,
TXO T1,DS.CDS_8 ;LIGHT THE BIT THAT SAYS SO
PJRST CCOWRD ;SEND THE MESSAGE & RETURN
SUBTTL CTERM Protocol - TTY: Service
CTM.TT: SKIPE SENSEQ ;IF NEED TO SEND A MESSAGE,
CALL CMHCH2 ;GIVE THE BLOODY VAX A CHARACTER
TXZ F,F$FRC ;NOT FORCING UNLESS WE DO SO
SKIPN READQ ;HAVE A READ QUEUED UP?
JRST CT.IDL ;NO, CHECK FOR INPUT-STATE MESSAGE STATUS
SKIPN WRTLOK ;YES, BUT HAS A WRITE LOCKED US OUT?
JRST CT.TT0 ;NO, TRY TO DO THE READ
TXON F,F$SYNC ;YES, WAIT UNTIL UNLOCKED
PUSHJ P,UNREAD ;MAKE SURE WE STOP ECHOING
TXO F,F$NEC ;EVEN MORE SURE
CALL TTYSST ;ECHO OFF
JRST CT.TT2 ;JUST LOOK INTO SENDING INPUT-STATE MESSAGES
CT.TT0: SKIPE REDISP ;NEED TO REDISPLAY?
JRST CT.RED ;YES, TRY IT
PUSHJ P,CT.SCT ;SETUP CHRTAB
PUSHJ P,EKOTAQ ;TRY TO ECHO THE IF.NEC BUFFERS (IF NEEDED)
PUSHJ P,SCNSPC ;LOOK FOR A SPECIAL CHARACTER
JRST CT.SPC ;HANDLE SPECIALS
CT.TT1: MOVE T4,READQ ;POINT TO REQUEST DATA
MOVEI T1,.RDTRM ;TERMINATOR SEEN
TXNE F,F$BRK ;TRUE?
JRST CT.REQ ;YES, TRY TO SATISFY THE REQUEST
MOVEI T1,.RDIBF ;FULL BUFFER
MOVE P4,READQ ;GET REQUEST DATA
MOVE T2,ICHCNT ;SEE HOW MANY CHARACTERS WE HAVE
CAML T2,C.COUN(P4) ;ENOUGH?
JRST CT.REQ ;YES, GO SATISFY THE REQUEST
SKIPL T1,C.TERM(P4) ;SOMEBODY TELL US WE'RE DONE?
JRST CT.REQ ;YES, SATISFY IT FOR THEM
CALL SRNEW ;NO, MAKE SURE WE'RE ECHOING IF WE NEED TO BE
CT.TT2: TXO F,F$SYNC ;ASSUME WE WANT TO SYNCHRONIZE
MOVE T1,CC.CNT ;NO, GET INPUT-STATE MESSAGE STATUS
CAIN T1,CN.ALL ;SEND WHEN READ IS OUTSTANDING?
JRST CT.IDS ;YES, SEND IT
CAIN T1,CN.NON ;DO IT AT ALL?
RET ;NO, SO DON'T WORRY ABOUT IT
SKIPE TAHLST ;IF I SAID THERE WAS SOME,
SKIPE ICHCNT ;BUT I DON'T HAVE IT,
RET ;(NO)
CALL TAHCHK ;YES, SEE IF STILL HAVE SOME
RET ;NOTHING, DON'T SWEAT IT
TXO F,F$FRC ;YES, DEMAND TO TRY AGAIN
RET ;FINALLY DONE WITH THIS PASS
CT.IDL: TXO F,F$SYNC ;ASSUME WE WANT TO SYNCHRONIZE
CALL UNREAD ;MAKE SURE
MOVE T1,CC.CNT ;GET INPUT-STATE MESSAGE STATUS
CAIN T1,CN.NON ;NEVER SEND?
RET ;YES, WE'RE DONE HERE
CT.IDS: CALL TAHCNT ;GET TYPEAHEAD COUNT
EXCH T1,TAHLST ;UPDATE COUNT, GET PREVIOUS
JUMPE T1,CT.ID0 ;IF WAS ZERO, SEE IF NOW NON-ZERO
SKIPE TAHLST ;NON-ZERO, IS IT STILL?
RET ;YES, DON'T SEND
MOVX T1,.CMIST ;YES, SEND INPUT-STATE:NOINPUT
JRST CT.ID1 ;VIA COMMON CODE
CT.ID0: SKIPN TAHLST ;NEWLY NON-ZERO?
RET ;NO, FORGET IT
MOVX T1,IS.IIP_8!.CMIST ;YES, SEND INPUT-STATE:INPUT-PRESENT
CT.ID1: CALL CCOWRD ;AS A WORD-LENGTH MESSAGE
NOP ;ALWAYS SKIPS
PJRST XMTMSS ;FORCE IT OUT
;CTERM read active subroutines
CT.SPC: TXNE F,F$BRK ;BREAK SEEN?
JRST CT.TT1 ;YES, TERMINATE THE READ
CAME P1,CC.SW2 ;STUPID CHARACTER?
JRST CT.SP0 ;NO, DON'T NEED TO CHECK
CALL CHKBRK ;IS IT A BREAK?
JRST [TXO F,F$BRK ;YES, MARK IT
JRST CT.TT1] ;AND GIVE IT TO THE REQUEST
CT.SP0: CALL SCNPOS ;FIND OUT WHERE WE ARE
MOVE T4,READQ ;POINT TO OUR REQUEST
CAMLE T1,C.COUN(T4) ;FAR ENOUGH TO BREAK?
JRST CT.TT1 ;YES, TRY IT
MOVEI T1,(P1) ;NO, COPY THE CHARACTER
MOVEI P1,CTSPCD ;POINT TO DISPATCH TABLE
CALL FNDFNC ;DO SOMETHING WITH IT
JRST CT.SP1 ;CC.SW2
TXZE F,F$BRK ;DID WE DO SOMETHING DANGEROUS?
JRST CT.SP2 ;YES, TAKE IT FROM THE TOP
TXZN F,F$RU1 ;DID WE ECHO?
CALL EKOTAQ ;ECHO MORE TYPEAHEAD
CT.SP1: CALL CONSCN ;FIND ANOTHER
JRST CT.SPC ;FOUND ONE, HANDLE IT
JRST CT.TT1 ;NOTHING, SO TRY TO BREAK
CT.SP2: MOVE T4,READQ ;RETRIEVE POINTER TO DATA
SKIPL C.TERM(T4) ;TERMINATED?
PJRST CT.TT1 ;YES, DON'T LOOP INTERMINABLY
JRST CT.TT0 ;NO, GIVE IT ALL ANOTHER GO
CTSPCD: CT.CNV,,.CHCNV ;QUOTE
CT.CNU,,.CHCNU ;DELETE LINE
CT.CNW,,.CHCNW ;DELETE WORD
CT.DEL,,.CHDEL ;DELETE CHARACTER
CT.CNR,,.CHCNR ;RETYPE LINE
Z ;END OF TABLE
CT.CNV: TXO F,F$RU1 ;SCNSER WON'T BREAK ON AN ENABLED QUOTE
CALL SCNCHR ;KEEP CONSCN FROM FINDING THE NEXT CHARACTER
NOP ;OK IF NONE
RET ;DONE HERE
CT.DEL: CALL SPCRUB ;GET RID OF THE RUBOUT
JRST CTDEL1 ;UNDERFLOW, CHECK FOR HANDLING
CALL DORUB1 ;YES, DUMP IT WITH UN-ECHOING
CAIN P1,.CHCNV ;A QUOTED CHARACTER BEING DELETED?
CALL DORUB1 ;YES, REMOVE THIS ONE, TOO
SKIPGE P1 ;BACKED UP TOO FAR?
TDZA T1,T1 ;YES, AT BEGINNING
CALL SCNPOS ;NO, SEE HOW FAR IN WE NOW ARE
MOVE T3,READQ ;GET MATCHING DATA
CAMGE T1,C.LOWM(T3) ;IF A NEW RECORD,
MOVEM T1,C.LOWM(T3) ;UPDATE LOW-WATER MARK
SKIPGE P1 ;IF BACKED UP TOO FAR,
TXO F,F$BRK ;RE-START THE SCAN
RET ;TRY ANOTHER CHARACTER
CTDEL1: MOVE T4,READQ ;POINT TO REQUEST DATA
LDB T1,[POINTR C.FLG1(T4),SR.UND] ;PICK UP UNDERFLOW HANDLING
CAIE T1,.SRTRM ;TERMINATE?
JRST CTDEL2 ;NO, CHECK FOR BELL
TXO F,F$BRK ;YES, RE-START THE SCAN
MOVX T1,IF.TRM ;UN-ECHOED TERMINATOR
IORM T1,IBF.FL(P4) ;STOP EKOTAQ
MOVEI T1,.RDUND ;TERMINATION FOR UNDERFLOW
PJRST RDTRMF ;END THIS READ
CTDEL2: CALL SPCRMV ;REMOVE THE RUBOUT
TXO F,F$BRK ;RE-START THE SCAN
CAIN T1,.SRBEL ;ANNOY ON UNDERFLOW?
CALL CTBELL ;YES, DO SO
SETZM C.LOWM(T4) ;LOW-WATER NOW AT THE BEGINNING
RET ;TRY ANOTHER CHARACTER
CT.CNW: CALL CTWRD1 ;FIND START OF WORD
JRST CTWRD2 ;CAN'T, CHECK IF WE CARE
PUSH P,T2 ;SAVE POINTER TO START OF WORD
CALL SPCRUB ;REMOVE THE ^W
NOP ;WILL ALWAYS SKIP (AT THIS POINT)
CTWRD3: CALL DORUB1 ;MAKE ONE GO AWAY
CAME P2,(P) ;CAUGHT UP WITH OURSELVES YET?
JRST CTWRD3 ;NO, KEEP DELETING
POP P,T2 ;YES, RESTORE STACK
CALL SCNPOS ;SEE WHERE WE ARE
MOVE T4,READQ ;POINT TO READ DATA
CAMGE T1,C.LOWM(T4) ;IF A NEW RECORD,
MOVEM T1,C.LOWM(T4) ;UPDATE LOW-WATER MARK
RET ;DONE DELETING THIS WORD
CTWRD2: MOVE T4,READQ ;POINT TO READ DATA
LDB T1,[POINTR C.FLG1(T4),SR.UND] ;GET UNDERFLOW HANDLING
CAIE T1,.SRTRM ;TERMINATE ON UNDERFLOW?
JRST CTWRD4 ;NO, CHECK IF BEL
MOVX T1,IF.TRM ;UNECHOED TERMINATOR
IORM IBF.FL(P4) ;STOP EKOTAQ
MOVEI T1,.RDUND ;UNDERFLOW TERMINATION CODE
PJRST RDTRMF ;END THIS READ
CTWRD4: CAIE T1,.SRBEL ;ANNOY WITH A BEEP?
JRST CTWRD5 ;NO, JUST IGNORE
CALL SCNLCH ;YES, CHECK IF SERIOUS UNDERFLOW
CALL CTBELL ;YES, GIVE THE BELL
CTWRD5: MOVE T4,READQ ;POINT TO DATA AGAIN
SETZM C.LOWM(T4) ;LOW-WATER NOW AT THE BEGINNING
CALL SPCFLS ;DELETE UP THROUGH CURRENT SPECIAL CHARACTER
TXO F,F$BRK ;RE-START THE SCAN
RET ;FROM THE TOP
CTWRD1: SAVE4 ;PRESERVE OUR CHARACTERS
CTWRD6: CALL SCNLCH ;FIND PREDECESSOR
RET ;NONESUCH
CALL ISPUNC ;SEE IF CHARACTER IN T1 IS PUNCTUATION
JRST CTWRD7 ;NO, LOOP OVER ALPHANUMERICS
DMOVE P1,T1 ;YES, UPDATE
DMOVE P3,T3 ; POINTERS
JRST CTWRD6 ;LOOP OVER PUNCTUATION
CTWRD7: DMOVE P1,T1 ;ALPHANUMERIC, UPDATE POINTER
DMOVE P3,T3 ; ...
CALL SCNLCH ;FIND PREDECESSOR
RET ;NONE
CALL ISPUNC ;PUNCTUATION?
JRST CTWRD7 ;NO, KEEP LOOKING
RETSKP ;YES, RETURN WITH THE BACKUP LIMIT SET
CT.CNU: TXO F,F$BRK ;RE-START THE SCAN
SETOM REDISP ;RE-DISPLAY THE PROMPT
PJRST DOCTU ;AFTER REMOVING THE CHARACTERS
CT.CNR: TXO F,F$BRK ;RE-START THE SCAN
SETOM REDISP ;RE-DISPLAY THE PROMPT
MOVEI T1,CTRED0 ;ROUTINE TO DO IT
PJRST DOCTR ;GO FOR IT
CTBELL: MOVEI T1,($TOOIN) ;GET FLAG
MOVEM T1,TOFLGS ;SET FOR OUTPUT
MOVEI T1,.CHBEL ;SEND A BELL
CALL OUTTTY ;SEND IT OFF
TXO F,F$IEC ;IGNORE LDBECC FOR NOW
CALL DOOUT1 ;QUEUE IT UP
SETZM TOFLGS ;BACK TO NORMAL
RET ;DONE
ISPUNC: CAIL T1,"0" ;DO TEST FOR ALPHANUMERIC
CAILE T1,"9" ; ...
CAIL T1,"A"
CAILE T1,"Z"
CAIL T1,"a"
CAILE T1,"z"
CAIL T1,300
CAILE T1,376
AOS (P) ;IT'S PUNCTUATION
RET ;RETURN SKIP/NON-SKIP
;Here for more of input processing
CT.RED: MOVEI T1,($TOOIN!$TOICL) ;GET NEW FLAGS
MOVEM T1,TOFLGS ;SET FOR TYPEOUT
CALL CTRED0 ;TYPE THE PROMPT
TXO F,F$IEC ;BYPASS LDBECC CHECK
CALL DOOUT1 ;MAKE SURE IT GOES
SETZM TOFLGS ;CLEAR THE FLAGS AGAIN
MOVX T2,IF.NEC ;NO-ECHO INPUT
MOVEI T1,INPQUE-IBF.LK;PREDECESSOR OF FIRST BUFFER
CTRED5: SKIPG T1,IBF.LK(T1) ;GET NEXT BUFFER
JRST CT.TT0 ;TRY FOR OTHER INPUT AT END
IORM T2,IBF.FL(T1) ;LIGHT FLAG FOR EKOTAQ
JRST CTRED5 ;DO THIS TO ALL TYPEAHEAD
CTRED0: SAVE1 ;PRESERVE AN AC
MOVE P1,READQ ;POINT TO IT
MOVE T1,C.FLG1(P1) ;GET FLAGS
HLRZ T3,C.PROM(P1) ;GET PROMPT COUNT
HRRZ T4,C.PROM(P1) ;AND PROMPT ADDRESS
TLO T4,(POINT 8) ;MAKE B.P.
TXZN F,F$CLF ;IF CANCELING A LINEFEED,
TXNE T1,SR.FMT ;FORMATTING?
CALL CTRED1 ;YES, CHECK <LF> STATUS
JUMPLE T3,CTRED2 ;DON'T TYPE AN EMPTY PROMPT
CTRED3: ILDB T1,T4 ;GET NEXT PIECE OF PROMPT
CALL OUTTTY ;SEND IT OFF
SOJG T3,CTRED3 ;LOOP OVER ENTIRE PROMPT
CTRED2: SETZM REDISP ;DONE UNTIL NEXT TIME
TXO F,F$SYNC ;WE QUEUED OUTPUT, SO DELAY ECHOING
CALL UNREAD ;MAKE SURE
MOVEI T1,.CHCNA ;THE AUTO-PROMPT CHARACTER
SKIPE CC.APE ;VAX SET SCRIPT MODE?
CALL OUTTTY ;YES, SEND THE TURNABOUT CHARACTER
MOVE T4,READQ ;POINT TO READ DATA
MOVE T1,VPOS ;CURRENT VPOS
MOVEM T1,C.VPOS(T4) ;SAVE IN CASE OF SR.VTM
MOVE T1,HPOS ;CURRENT HPOS
MOVEM T1,C.HPOS(T4) ;SAVE FOR READ-DATA
RET ;RETURN
CTRED1: MOVEI T1,.CHLFD ;GET A LINEFEED?
TXZE F,F$FLF ;NEED A FREE LINEFEED?
CALL OUTTTY ;YES, SEND IT
MOVE T1,LSTCHR ;GET LAST CHARACTER OUTPUT
CAIL T1,.CHLFD ;IS IT A VERTICAL MOTION CHARACTER?
CAIL T1,.CHCRT ;OF THE SORT THAT MATTERS HERE?
RET ;NO, DON'T SUPPRESS ANY NEWLINES
JUMPE T3,CPOPJ ;DON'T SKIP AN EMPTY PROMPT
MOVE T2,T4 ;COPY BYTE POINTER
ILDB T1,T2 ;GET FIRST CHARACTER
CAIN T1,.CHLFD ;THE MAGIC CHARACTER?
JRST CTRED4 ;YES, EAT IT
CAIE T1,.CHCRT ;NO, IS IT THE COMMON PREDECESSOR?
RET ;NO, WE'RE DONE
ILDB T1,T2 ;YES, GET SUCCESSOR
CAIE T1,.CHLFD ;LAST CHANCE...
RET ;NOPE
SOS T3 ;YES, COUNT DOWN FOR THE <CR>
CTRED4: SOS T3 ;COUNT DOWN FOR THE <LF>
MOVE T4,T2 ;USE UPDATED BYTE POINTER
RET ;DONE
CTM.EC: MOVEI T2,($TOICL!$TOOIN) ;GET FLAGS
CAMN T2,TOFLGS ;HAVE THE RIGHT ONES ALREADY?
JRST CTECH0 ;YES, GO FOR IT
PUSH P,TOFLGS ;NO, SAVE THEM
PUSH P,T1 ;AND THE CALLER'S CHARACTER
CALL DOOUT1 ;ELIMINATE THE BUFFER
POP P,T1 ;RESTORE THE CHARACTER
MOVEM T2,TOFLGS ;SET OUR FLAGS
CALL CTECH0 ;ECHO THE CHARACTER
TXO F,F$IEC ;DON'T WAIT FOR ECHOING
CALL DOOUT1 ;FLUSH THE BUFFER
POP P,TOFLGS ;RESTORE PREVIOUS FLAGS
RET ;AND RETURN
CTECH0: TRNE T1,140 ;IS THIS A CONTROL CHARACTER?
CAIN T1,.CHDEL ;OR DELETE?
JRST CTECH1 ;YES, ECHO BY CHARACTERISTIC
TXNE F,F$NEC ;NO, AM I REALLY SUPPOSED TO ECHO IT?
RET ;NO, SO DON'T
PJRST OUTTTY ;YES, SEND IT LITERALLY
CTECH1: TXNE F,F$NEC ;NO-ECHOED?
SKIPN BADECH ;AND SOMEONE WHO CAN'T READ?
TRNA ;NO OR NO, SKIP
RET ;YES, IGNORE
SAVE1 ;PRESERVE AN AC
MOVE T2,CC.CAT(T1) ;GET THE CHARACTER'S ATTRIBUTES
TXNN T2,CA.STD ;ECHO IN STANDARD FORM?
JRST CTECH3 ;NO, THAT'S SIMPLER
MOVEI P1,CTECHD ;YES, POINT TO DISPATCHER FOR IT
CALL FNDFNC ;TRY TO DO IT
CALL CTECH2 ;TRULY STANDARD (AMAZING)
CTECH3: MOVE T2,CC.CAT(T1) ;RESTORE ATTRIBUTES
TXNN T2,CA.SLF ;ECHO AS SELF?
RET ;NO, WE'RE DONE
MOVEI P1,WRTSPC ;POINT TO WRITE TABLE
CALL FNDFNC ;SEND IT 'LITERALLY'
CALL OUTTTY ;REALLY IS!
RET ;FINALLY DONE
CTECH2: PUSH P,T1 ;SAVE STARTING CHARACTER
LSH T1,-7 ;KEEP ONLY EIGHTH BIT
MOVE T1,[EXP "^","$"](T1) ;GET INTRODUCER
CALL OUTTTY ;SEND IT
MOVE T1,(P) ;RESTORE CHARACTER FOR A MOMENT
TRZ T1,200 ;DON'T CARE ABOUT 8TH BIT FOR THIS
TRC T1,100 ;MUNG
CALL OUTTTY ;SEND SECOND PART
JRST TPOPJ ;RESTORE CHARACTER AND RETURN
CTECHD: CTECHN,,.CHCRT ;CR GOES AS CRLF
CTECHN,,.CHLFD ;AS DOES LF
CTECHE,,.CHESC ;ESCAPE GOES AS DOLLAR
CTECHR,,.CHDEL ;RUBOUT IS SPECIAL FOR TOPS20
CTECHZ,,.CHCNZ ;^Z IS SPECIAL FOR VMS
CTECHZ,,.CHCNO ;AS IS ^O
CTECHY,,.CHCNY ;AND ^Y
CTECHY,,.CHCNC ;AND EVEN ^C
Z ;THE REST ARE STRAIGHTFORWARD
CTECHN: SKIPE BADBOY ;IF VMESS,
TXO F,F$CLF ;SKIP THE NEXT LF
PJRST OUTCRL ;DO A CRLF
CTECHE: SKIPE BADECH ;IF ULTRIX,
SKIPE BADBOY ;AND NOT VMESS,
TRNA ;(NO OR NO)
PJRST CTECH2 ;THEN SEND IN UP-ARROW FORM
SAVET1 ;PRESERVE THE CHARACTER
MOVEI T1,"$" ;GET THE BLASTED DOLLARSIGN
PJRST OUTTTY ;SEND IT OFF & RETURN
CTECHR: MOVE T2,OSTYPE ;GET REMOTE'S O/S TYPE
CAIE T2,O.T20 ;UNLESS TOPS20,
PJRST CTECH2 ;NO, IT'S STANDARD
RET ;YES, DON'T ECHO IT AFTER ALL
CTECHY: SKIPE BADBOY ;VMESS?
CALL OUTCRL ;YES, GIVE LEADING CRLF
FALL CTECHZ ;THEN CHARACTER, THEN NEWLINE AGAIN
CTECHZ: SKIPN BADBOY ;VMS?
PJRST CTECH2 ;NO, IT'S STANDARD
CALL CTECH2 ;YES, START WITH STANDARD
TXO F,F$CLF ;CANCEL NEXT LF
PJRST OUTCRL ;AND APPEND A NEWLINE
;Here for video support
CTM.VD: TRNE T1,140 ;IF CONTROL,
CAIN T1,.CHDEL ;OR RUBOUT,
JRST CTMVD1 ;HANDLE DIFFERENTLY
SETZ T4, ;ASSUME NOT ECHOED
MOVE T1,READQ ;POINT TO DATA
MOVE T1,C.FLG1(T1) ;GET FLAGS
TXNN T1,SR.NEC ;NO-ECHO?
AOS T4 ;WRONG, ASSUME ONE WIDE
RET ;GIVE THIS BACK
CTMVD1: MOVE T4,CC.CAT(T1) ;GET ATTRIBUTES
ANDX T4,CA.ECH ;KEEP ONLY ECHO BITS
JUMPE T4,CPOPJ ;ZERO MEANS IT
SAVE1 ;PRESERVE DISPATCH REGISTER
MOVEI P1,CTVIDD ;DISPATCH TABLE
CALL FNDFNC ;TREAT WITH THE CHARACTER
TRNA ;DUNNO
RET ;ALREADY DONE
TRNN T4,CA.STD ;STANDARD FORM?
TDZA T4,T4 ;NO, ASSUME ZERO
CTMVD2: MOVEI T4,2 ;YES, ASSUME TWO
RET ;GIVE BACK THIS SIZE
CTVIDD: CTVIDT,,.CHTAB ;TAB IS THE WORST
CTVID0,,.CHCRT ;CR IS ALWAYS ZERO WIDE
CTVID0,,.CHLFD ;AS IS LF
CTVID0,,.CHVTB
CTVID0,,.CHFFD
CTVIDE,,.CHESC
CTVIDB,,.CHCNH
Z
CTVID0: SETZ T4,
RET
CTVIDE: TRNN T4,CA.STD ;DOLLARSIGN?
JRST CTVID0 ;NO, ZERO
MOVEI T4,1 ;YES, ONE
SKIPE BADECH ;UNLESS BAD ECHO,
SKIPE BADBOY ;FROM ULTRIX
RET ;(NO, ONE IS IT)
MOVEI T4,2 ;YES, ECHOES IN UP-ARROW FORM
RET ;GIVE THIS BACK
CTVIDB: MOVE P1,T4 ;COPY TO HANDY PLACE
SETZ T4, ;START FROM ZERO
TRNE P1,CA.SLF ;IF SELF,
SOS T4 ;ADVANCE ONE
TRNE P1,CA.STD ;IF STANDARD,
ADDI T4,2 ;COUNT TWO
RET ;GIVE THIS BACK
CTVIDT: TRNN T4,CA.SLF ;IF ONLY ECHOING IN STANDARD FORM,
PJRST CTMVD2 ;WE'RE SIMPLE AFTER ALL
SAVE4 ;NEED MORE ACS
MOVE T4,READQ ;CURRENT READ
PUSH P,C.HPOS(T4) ;STARTING HPOS
PUSH P,P2 ;SAVE CURRENT POINTER
CALL SCNINI ;START OVER AGAIN
CTVDT1: CAMN P2,(P) ;CAUGHT UP YET?
JRST CTVDT0 ;YES, FIGURE IT UP AND RETURN IT
CALL SCNCHR ;NO, GET NEXT
JRST CTVDT0 ;SHOULDN'T FAIL
CAMN P2,(P) ;DON'T DO THE TAB WE'RE REMOVING
JRST CTVDT0 ;FOUND IT, SO STOP
MOVEI T1,(P1) ;COPY CHARACTER
CAIE T1,.CHTAB ;IS IT A TAB?
JRST CTVDT2 ;NO, DO IT DIFFERENTLY
MOVEI T1,2 ;WIDTH OF TWO IF STANDARD FORM IN USE
MOVE T4,CC.CAT+.CHTAB;GET VALUES
TRNE T4,CA.STD ;IS IT ON?
ADDM T1,-1(P) ;YES, UPDATE HPOS FOR ^I
MOVEI T1,8 ;TAB STOPS ARE 8 APART
ADDM T1,-1(P) ;UPDATE HPOS
MOVEI T1,7 ;BUT AT MULTIPLES OF 8
ANDCAM T1,-1(P) ;SO HOLD OFF A BIT
JRST CTVDT1 ;LOOP FOR NEXT
CTVDT2: CALL CTM.VD ;RECURSE FOR ITS WIDTH
ADDM T4,-1(P) ;UPDATE SCANNING HPOS
JRST CTVDT1 ;LOOP FOR NEXT CHARACTER
CTVDT0: POP P,P2 ;TRIM STACK
POP P,T4 ;GET NEW HPOS
CAMLE T4,HPOS ;WRAPPED?
SETZ T4, ;YES, ASSUME AT LEFT MARGIN
SUB T4,HPOS ;GET -VE LENGTH
MOVMS T4 ;GET SIZE
RET ;GIVE THIS BACK
;Here for yet more of active read logic
CT.SCT: TXNE F,F$RALL ;PASSALL MODE?
PJRST SRSET ;YES, DON'T BOTHER (WE'LL PAY IT NO ATTENTION)
STORE T1,CHRTAB,CHRTAB+7,0 ;NO, START WITH A CLEAN SLATE
MOVE T4,READQ ;POINT TO READ DATA
MOVEI T3,CA.ENB ;CHARACTER ENABLED BIT
SETZ T2, ;START WITH NULL MASK
LDB T1,[POINTR C.FLG1(T4),SR.CCD] ;GET DISABLE FIELD
CAIE T1,.SRNON ;ALLOWING THE LINE CHARACTERS?
JRST CTSCT1 ;NO, SO DON'T
TDNE T3,CC.CAT+.CHCNR;IS ^R ENABLED?
TXO T2,1B<.CHCNR> ;YES, IT'S SPECIAL
TDNE T3,CC.CAT+.CHCNU;IS ^U ENABLED?
TXO T2,1B<.CHCNU> ;YES, IT'S SPECIAL
CTSCT1: CAILE T1,.SRLIN ;DISABLING ALL THE EDITING CHARACTERS?
JRST CTSCT2 ;YES, DON'T LET THEM IN
TDNE T3,CC.CAT+.CHCNW;NO, IS ^W ENABLED?
TXO T2,1B<.CHCNW> ;YES, IT'S SPECIAL
IORM T2,CHRTAB ;SET CONTROL CHARACTERS
MOVX T2,1B31 ;BIT FOR .CHDEL
TDNE T3,CC.CAT+.CHDEL;IS IT ENABLED?
IORM T2,CHRTAB+3 ;YES, HANDLE IT
SETZ T2, ;A NEW MASK FOR WORD 0
CTSCT2: TDNE T3,CC.CAT+.CHCNV;QUOTE ENABLED?
TXO T2,1B<.CHCNV> ;YES, ALLOW IT
IORM T2,CHRTAB+0 ;SET CONTROL MASK FOR SPECIALS
PJRST SRSET ;SETUP THE MASK AS WELL
CT.REQ: MOVEM T1,C.TERM(T4) ;STORE THIS TERMINATION CODE
CTREQ2: CALL UNREAD ;MAKE SURE WE STOP ECHOING HERE
TXO F,F$SYNC ;LIKEWISE
MOVEI T1,.CMRDD ;READ-DATA MESSAGE
CALL CCOSET ;FLAGS WILL BE FILLED IN LATER
SETZB T3,BRKSIZ ;NO CHARACTERS SCANNED YET
TXZ F,F$ESA!F$BAD ;RESTART ESCAPE SEQUENCE PARSER
CALL SCNINI ;LOOK FROM THE START
CTREQ3: CALL SCNCHR ;GET THE NEXT CHARACTER
JRST CTREQ1 ;CHECK FOR TYPE OF TERMINATION
AOS T3 ;GETTING ANOTHER CHARACTER
CALL SPCCHK ;IS IT SPECIAL?
TRNA ;NO
CAIE P1,.CHCNV ;YES, IS IT A QUOTE CHARACER?
JRST CTREQ4 ;NO OR NO
CAME T3,C.COUN(T4) ;IS THIS OUR END OF BUFFER?
JRST CTREQ4 ;NO, IT'S OK AFTER ALL
MOVEI T1,.RDTOK ;ABSENTEE TOKEN
SOJA T3,CTREQE ;GO SEND IT OFF
CTREQ4: CALL CHKBRK ;IS THIS A BREAK?
JRST CTREQ5 ;YES, HANDLE DIFFERENTLY
CAME T3,C.COUN(T4) ;NO, DOES THIS FILL THE FIELD?
JRST CTREQ3 ;NO, GET ANOTHER
TXNE F,F$ESA ;YES, ARE WE LOOKING AT AN ESCAPE SEQUENCE?
JRST CTREQ6 ;YES, MUST BACK OUT
MOVX T1,.RDIBF ;INPUT BUFFER FULL
JRST CTREQE ;END THIS MESSAGE
CTREQ5: MOVEI T1,.RDIES ;INVALID ESCAPE SEQUENCE
TXNE F,F$BAD ;GUESSED RIGHT?
JRST CTREQE ;YES, DELIVER IT
TXNN F,F$ESC ;IS AN ESCAPE SEQUENCE POSSIBLE?
JRST CTREQT ;NO, WE'VE DONE ALL BUT POSSIBLE ECHO
HLRZ T2,BRKCHR ;YES, GET BREAK CHARACTER
CAIE T2,.CHESC ;IS IT ESCAPE?
JRST CTREQT ;NO, IT'S A NORMAL BREAK
MOVEI T1,.RDVES ;VALID ESCAPE SEQUENCE
JRST CTREQE ;DELIVER IT
CTREQ6: CAME T3,BRKSIZ ;DID WE OVERFLOW AN ENTIRE BUFFER?
JRST CTREQ7 ;NO, JUST BACK OFF SOME
TXC F,F$ESA!F$BAD ;YES, CALL IT A BAD ESCAPE SEQUENCE
JRST CTREQ5 ;GO DELIVER IT
CTREQ7: SUB T3,BRKSIZ ;SEND UP TO THE ESCAPE SEQUENCE
SETZM BRKSIZ ;DON'T SEND THE SEQUENCE
TXZ F,F$ESA ;NO LONGER ACTIVE
MOVEI T1,.RDTOK ;ABSENTEE TOKEN TERMINATION
JRST CTREQE ;DELIVER IT
CTREQ1: MOVE T1,C.TERM(T4) ;JUST USE THE SAME TERMINATION CODE
TXNE F,F$ESA ;IF NOT READING AN ESCAPE SEQUENCE
CAIE T1,.RDTMO ;OR NOT FOR A TIMEOUT,
JRST CTREQE ;THEN GO DELIVER THIS REASON
SUB T3,BRKSIZ ;YES--DON'T SEND THE INCOMPLETE TERMINATOR
SETZM BRKSIZ ;DON'T INCLUDE IN ANY COUNT
JRST CTREQE ;AND END IT ALL
CTREQT: LDB T1,P2 ;GET CHARACTER AGAIN
MOVE T2,C.FLG1(T4) ;GET READ FLAGS
TXNE T2,SR.ECT ;ECHO TERMINATORS?
CALL CTM.EC ;YES, ECHO THIS CHARACTER
MOVEI T1,.RDTRM ;TERMINATE WITH BREAK CHARACTER
CTREQE: ASSUME RD.TRM&B0,1 ;ALREADY RIGHT-JUSTIFIED
PUSH P,T1 ;SAVE THE TERMINATION CODE
PUSH P,T3 ;AND THE DATA COUNT
CALL TAHCNT ;COUNT AVAILABLE TYPEAHEAD
POP P,T3 ;RESTORE DATA COUNT
SUB T1,T3 ;OFFSET BY AMOUNT WE WILL NOW REMOVE
MOVEM T1,TAHLST ;MAKE NEW LAST TYPEAHEAD COUNT
POP P,T1 ;RESTORE CODE
MOVE T2,CC.CNT ;INPUT-COUNT PARAMETER
CAIN T2,CN.ALL ;ALWAYS-SEND?
JRST CTREQS ;YES, GO FOR IT
SETZM TAHLST ;NO, DEFER INPUT-PRESENT TO INPUT-STATE
CAIE T2,CN.NON ;DO WE WANT TO SEND INPUT-STATE SOMETIME?
TXO F,F$FRC ;YES, MAKE SURE THAT WE DO
CTREQS: SKIPN TAHLST ;ANY MORE DATA?
TXZA T1,RD.IIP ;NO,
TXO T1,RD.IIP ;OR YES.
CALL CCOBYT ;STUFF THE FLAGS BYTE FOR THE MESSAGE
MOVE T1,C.LOWM(T4) ;GET LOW-WATER MARK
CALL CCOINT ;SEND IT ALONG
MOVE T1,VPOS ;CURRENT VPOS
SUB T1,C.VPOS(T4) ;VPOS DELTA FOR THIS READ
SKIPGE T1 ;IF FORMS WRAP OCCURRED,
ADD T1,CC.LEN ;PRETEND IT DIDN'T
SKIPE BADBOY ;UNLESS FOR VMS
SETZ T1, ;IT DOESN'T KNOW WHAT THESE ARE FOR
CALL CCOBYT ;SEND VPOS CHANGE
MOVE T1,HPOS ;CURRENT HPOS
SUB T1,C.HPOS(T4) ;HPOS DELTA FOR THIS READ
SKIPE BADBOY ;UNLESS FOR VMS
SETZ T1, ;IT DOESN'T KNOW WHAT THESE ARE FOR
CALL CCOBYT ;SEND IT OFF
MOVE T1,T3 ;GET DATA SIZE
SUB T1,BRKSIZ ;SUBTRACT OVERHEAD
CALL CCOINT ;SEND 'ECHOED' DATA SIZE
CTREQ8: SOJL T3,CTREQ9 ;FINISH UP WHEN DATA IS STORED
CALL INCHR ;GET NEXT CHARACTER TO SEND
ERR IBD,<Internal buffer discrepancy> ;SHOULD HAVE BEEN THERE
CALL CCOBYT ;STUFF IT AWAY
JRST CTREQ8 ;LOOP OVER DATA
CTREQ9: CALL CCOFIN ;BIND OFF THE MESSAGE
NOP ;ALWAYS SKIPS
SKIPN T1,@READQ ;GET SUCCESSOR MESSAGE
MOVEM T1,READQT ;STORE ZERO IF AT END
EXCH T1,READQ ;UPDATE QUEUE, GET DEAD MESSAGE
CALL SCNINI ;BACK UP THE POINTER
MOVX T2,IF.NEC!IF.TRM;NO-ECHO + NON-ECHOED TERMINATOR
TXNE F,F$ESA ;STOPPED BY AN ESCAPE SEQUENCE?
IORM T2,IBF.FL(P4) ;YES, UPDATE THE BUFFER FOR EKOTAQ
MOVEI T2,C.SIZE ;SIZE OF QUEUE ENTRY
MOVE T3,C.PROM(T1) ;SAVE PROMPT WORD FOR A BIT
CALL CORFRE ;RELEASE THE STORAGE
HLRZ T2,T3 ;GET BYTE COUNT
ADDI T2,3 ;ROUND UP
LSH T2,-2 ;CONVERT TO WORDS
HRRZ T1,T3 ;GET BUFFER ADDRESS
SKIPE T1 ;IF VALID,
CALL CORFRE ;RELEASE THIS ONE, TOO
SKIPN READQ ;STILL ANOTHER OUTSTANDING?
TXZ F,F$READ ;NO, REMEMBER THAT FACT
CALL XMTMSS ;SEND OUR RESPONSE DATA
SKIPN READQ ;ANYTHING TO DO?
JRST [CALL UNREAD ;NO, SO DON'T
PJRST TTYSST] ;BUT DO STOP ECHOING
CALL SRSET ;YES, SET UP FOR IT
PJRST SRDNEW ;AND TRY ANEW
;Here to echo the typeahead (if necessary)
EKOTAQ: SAVE4 ;PRESERVE SOME REGISTERS
SKIPE P4,INPQUE ;IF NO BUFFER,
SKIPE INPCHR ;OR IF FORCED RE-READ,
RET ;DON'T DO A THING
MOVX T1,IF.NEC!IF.TRM;FLAGS TO TEST
EKOTQ1: TDNE T1,IBF.FL(P4) ;INTERESTING BUFFER?
JRST EKOTQ3 ;YES, HANDLE IT
EKOTQ2: HRRZ P4,IBF.LK(P4) ;NO, POINT TO NEXT
JUMPN P4,EKOTQ1 ;AND LOOK FOR ONE THAT IS INTERESTING
RET ;NOTHING TO DO THIS TIME
EKOTQ3: SKIPN P3,IBF.CT(P4) ;GET THE COUNT
JRST EKOTQ2 ;SKIP BUFFER IF DULL
MOVE P2,IBF.PT(P4) ;AND THE POINTER
MOVX T1,IF.NEC ;NO-ECHO FLAG
TXNE F,F$NEC ;SUPPOSED TO ECHO THIS READ?
ANDCAM T1,IBF.FL(P4) ;NO, SO ALL REQUIRED ECHO IS DONE
TDNE T1,IBF.FL(P4) ;NEED TO DO ECHO?
JRST EKOTQ4 ;YES, SO DO
CALL SCNCHR ;NO, GET A CHARACTER
RET ;SHOULD NEVER FAIL
JUMPN P3,.-2 ;LOOP UNTIL THE END OF THE BUFFER
JRST EKOTQ5 ;NOW HANDLE THE TERMINATOR
EKOTQ4: CALL SCNCHR ;GET NEXT CHARACTER FROM BUFFER
RET ;DONE IF NO MORE ANYWHERE (SHOULD NEVER HAPPEN)
JUMPE P3,EKOTQ5 ;TERMINATORS ARE SPECIAL
MOVEI T1,(P1) ;COPY THE CHARACTER
CALL CTM.EC ;ECHO IT
JRST EKOTQ4 ;DO THE WHOLE BUFFER
EKOTQ5: MOVX T1,IF.NEC!IF.TRM;BITS TO TEST
TDNN T1,IBF.FL(P4) ;NEED TO ECHO THIS TERMINATOR?
JRST EKOTQ6 ;NOPE
ANDCAM T1,IBF.FL(P4) ;YES, AND WE'RE DOING SO
CALL SPCCH1 ;IS IT SPECIAL?
CALL CHKBRK ;OR A REAL TERMINATOR?
RET ;YES, STOP HERE
TXNE F,F$ESA ;NO, IS IT IN A BREAK?
RET ;YES, STOP NOW
MOVEI T1,(P1) ;NO, COPY THE CHARACTER
CALL CTM.EC ;AND ECHO IT
EKOTQ6: CALL SCNCHR ;FIND NEXT NON-EMPTY BUFFER
RET ;DONE IF NO MORE
JRST EKOTQ3 ;LOOK FOR MORE TO DO
SUBTTL CTERM Protocol - Timer logic
CTM.TM: TXNN F,F$READ ;STILL HAVE A READ PENDING?
TXZ F,F$TMR!F$TEX ;NO, SKIP THE TIMER LOGIC
TXNN F,F$TMR ;SUPPOSED TO BE DOING TIMING?
RET ;NO, JUST DISMISS IT
MOVE P4,READQT ;YES, GET ACTIVE REQUEST
MOVE T2,C.IDEN(P4) ;GET IDENTIFIER
CAME T2,TMRSEQ ;STILL THE SAME?
JRST CTIME0 ;NO, GIVE UP
CALL TAHCNT ;YES, SEE HOW MANY
EXCH T1,LICHCT ;UPDATE COUNT IN ANY CASE
CAMN T1,LICHCT ;IS IT THE SAME AS LAST TIME?
JRST CTIME1 ;YES, CHECK UP ON IT
TXZ F,F$TEX ;WE GOT A DIFFERENT VALUE AFTER ALL
SKIPN T1,C.TIME(P4) ;GET TIMER VALUE
JRST CTIME2 ;EXPIRE IMMEDIATELY IF TIME=0
PITMR. T1, ;CHECK AGAIN
NOP ;?!?
RET ;UNTIL LATER
CTIME0: TXZ F,F$TMR!F$TEX ;NO LONGER DOING TIMING
RET ;RETURN WITHOUT REQUEUEING
CTIME1: TXOE F,F$TEX ;NOTE THAT WE EXCEEDED ONCE
JRST CTIME2 ;OOPS, THIS WAS THE GRACE PERIOD!
MOVEI T1,1 ;GRACE PERIOD
PITMR. T1, ;WE'LL LET YOU HAVE ONE MORE TRY...
NOP ;OR MAYBE SEVERAL
RET ;COME BACK LATER
CTIME2: TXZ F,F$TMR!F$TEX ;LIKE, WOW, MAN
MOVEI T1,.RDTMO ;TIMEOUT-VALUE
CALL RDTRMF ;KILL THE REQUEST
RET ;DONE
SUBTTL CTERM Protocol - Foundation Message Dispatch
CTM.NT: CALL GETBYS ;GET A BYTE FROM THE MESSAGE
CAILE T1,0 ;IS IT IN RANGE
CAILE T1,FNDMAX ; OF THE LEGAL FOUNDATION TYPES?
ERR FMI,<Illegal Foundation message received>,<PROERR>
CALL @FNDDSP(T1) ;YES, DISPATCH
XCT FMI ;ABORT ON PROTOCOL ERROR
FALL FNDFIN ;SEND OUT OUR RESPONSE
FNDFIN: HRRZ T1,OTPBUF ;GET POINTER TO OUR BUFFER
MOVE T1,OBF.PT(T1) ;GET ITS STARTING BYTE POINTER
CAME T1,OBFPTR ;IS IT THE SAME AS OUR CURRENT ONE?
PJRST QUEOUT ;NO, WE HAVE A MESSAGE TO SEND
POPJ P, ;YES, DON'T SEND NULL MESSAGES, JUST RETURN
FNDDSP: DSPGEN FND,.FM,<ILL,BND,UNB,REB,BAC,ENM,EXM,CFM,NOM,CMD,MDD>
FNDMAX==.-FNDDSP-1 ;MAXIMUM LEGAL FOUNDATION MESSAGE TYPE
ERRDSP FND,<ILL,BND,REB,BAC,CFM> ;IT IS AN ERROR TO RECEIVE THESE
SUBTTL CTERM Protocol - Foundation Unbind message
FNDUNB: CALL CLRCTO ;ALLOW OUTPUT
CALL WRTLFD ;END THE LINE IF REQUIRED
SKIPE HPOS ;IF NOT EVEN AT LEFT MARGIN,
CALL OUTCRL ;DO BETTER
CALL DOOUT1 ;MAKE SURE WE GET TO SEE IT
DMOVE T1,[2,,T2
.TOFLM] ;GET FUNCTION VALUES
MOVE T3,CTLTTY ;THIS TTY
CAME T3,TTYUDX ;IF NOT THE ONE IN USE
TRMOP. T1, ;THEN DO IT
NOP
CALL WATDEQ ;MAKE SURE THE OUTPUT GETS TO SCNSER
CALL GETINZ ;GET AN INTEGER OR ZERO
CAIL T1,0 ;IS IT IN RANGE
CAILE T1,UNBMAX ; OF THE RECOGNIZED UNBIND REASONS?
SETO T1, ;NO, USE MINUS-ONE
HRRO T1,UNBTAB(T1) ;GET CORRESPONDING TEXT POINTER
OUTSTR [ASCIZ |[Connection closed by remote: |]
OUTSTR (T1) ;DISPLAY THE MESSAGE
OUTCHR ["]"]
JRST NSPER1 ;EXIT POLITELY
DEFINE UNBENT(TAG,TEXT),<
IFN <.-UNBTAB>-.UB'TAG,<PRINTX ? OUT-OF-ORDER UNBIND REASON .UB'TAG>
EXP [ASCIZ |TEXT|]
>
EXP [ASCIZ |Unrecognized unbind reason|]
UNBTAB:
UNBENT ILL,<Illegal unbind reason>
UNBENT ICV,<Incompatible protocol versions>
UNBENT NPA,<No portal is available>
UNBENT UUR,<User unbind request>
UNBENT DSC,<Terminal disconnected>
UNBENT TIU,<Selected terminal or portal is in use>
UNBENT NST,<Selected terminal or portal does not exist>
UNBENT PED,<Protocol error detected>
UNBMAX==.-UNBTAB-1 ;MAXIMUM KNOWN UNBIND REASON
SUBTTL CTERM Protocol - Foundation 'Mode' messages
FNDENM: CALL GETBYS ;MODES ARE INTEGERS
FNDEXM: MOVEI T1,.FMNOM ;NO-MODE
NETOCH T1 ;STUFF IT AWAY
FNDNOM: RETSKP ;NO-MODE WILL JUST SUCCEED
FNDMDD: CALL GETBYS ;SKIP THE RANDOM FLAGS BYTE
FNDMD1: SKIPN IBFCNT ;IF AT EOM,
RETSKP ;SUCCEED
CALL GETINS ;GET THE LENGTH OF THE NEXT SUB-MESSAGE
CALL SKPCNT ;SKIP OVER THE BYTES
JRST FNDMD1 ;LOOP OVER ALL SUB-MESSAGES
SUBTTL CTERM Protocol - Common Data (CTERM Layer) messages
FNDCMD: CALL GETBYS ;SKIP THE FLAGS BYTE
SAVE1 ;PRESERVE P1 FOR SUB-MESSAGE SIZE COUNTDOWN
FNDCD1: SKIPN IBFCNT ;IF AT EOM,
RETSKP ;SUCCEED
CALL GETINS ;GET LENGTH OF NEXT CTERM MESSAGE
CAMLE T1,IBFCNT ;BETTER BE IN RANGE
ERR TLM,<Too long a message received>,<PROERR>
JUMPE T1,FNDCD1 ;SKIP NULL MESSAGES
MOVE P1,T1 ;KEEP SIZE FOR MESSAGE PARSING
CALL CCIBYT ;GET CTERM MESSAGE TYPE
CAILE T1,0 ;IS IT IN RANGE
CAILE T1,CMHMAX ; OF LEGAL CTERM MESSAGE TYPES?
ERR ICM,<Illegal CTERM message received>,<PROERR>
CAIN T1,.CMPIN ;PROTOCOL INITIATE?
AOSN MSGNUM ;YES, BETTER BE FIRST
AOSN MSGNUM ;OR NO, BETTER NOT BE FIRST
ERR WFM,<Wrong first CTERM message received>,<PROERR>
CALL @CMHDSP(T1) ;YES, DISPATCH TO HANDLER
XCT ICM ;ERRORS ARE FATAL TO THE PROTOCOL
JUMPE P1,FNDCD1 ;ERROR IF NOT AT LOGICAL EOM, ELSE LOOP
ERR CMD,<Count did not match data in CTERM message>,<PROERR>
CMHDSP: DSPGEN CMH,.CM,<ILL,PIN,SRD,RDD,OOB,UNR,CTA,WRT,WRC,DOS,RCH,CHR,
CHK,ICT,IST>
CMHMAX==.-CMHDSP-1 ;MAXIMUM SUPPORTED CTERM MESSAGE TYPE
ERRDSP CMH,<ILL,RDD,OOB,WRC,ICT,IST,DOS> ;IT'S ILLEGAL TO RECEIVE THESE
SUBTTL CTERM Protocol - Initiate message
CMHPIN: CALL CCIBYT ;GET FLAGS BYTE
CALL CCIBYT ;GET REMOTE'S VERSION WORD
MOVEM T1,RCMVER ;STORE IT
CALL CCIBYT ;GET REMOTE'S ECO LEVEL
MOVEM T1,RCMECO ;STORE IT
CALL CCIBYT ;GET REMOTE'S CUSTOMER MOD LEVEL
MOVEM T1,RCMMOD ;STORE IT
MOVEI T2,8 ;BYTE COUNT
MOVE T3,[POINT 8,RCMREV] ;STRING POINTER
CMHPI1: CALL CCIBYZ ;GET NEXT BYTE
IDPB T1,T3 ;SAVE AWAY
SOJG T2,CMHPI1 ;LOOP OVER REVISION FIELD
CMHPI2: JUMPE P1,CMHPI3 ;RESPOND AT END OF PARAMETER LIST
CALL CCIBYT ;GET THE PARAMETER ID BYTE
CAIN T1,.PIILL ;MUSN'T BE ZERO
ERR IPI,<Illegal Protocol Initiate parameter received>,<PROERR>
MOVE T2,T1 ;SAVE IT
CALL CCIBYT ;GET THE PARAMETER BYTE LENGTH
CAILE T2,.PIILL ;IS IT IN RANGE OF
CAILE T2,PINDSL ; PARAMETERS WE KNOW ABOUT?
JRST CMHPI4 ;NO, JUST SKIP OVER IT
CALL @PINDSP(T2) ;YES, CALL ITS HANDLER
JRST CMHPI2 ;LOOP OVER ALL PARAMETERS
PINDSP: DSPGEN PIN,.PI,<ILL,MMS,IBS,SUP>
PINDSL==.-PINDSP-1 ;MAXIMUM DISPATCHED .CMPIN PARAMETER
ERRDSP PIN,ILL ;MUSN'T RECEIVE THIS ONE
CMHPI4: CALL CCISKP ;SKIP THE BYTES
JRST CMHPI2 ;LOOP OVER ALL PARAMETERS
PINMMS: CALL CCIINC ;GET INTEGER BY COUNT
CAIGE T1,HSTMMS ;MAKE SURE HOST WANTS ENOUGH MESSAGE BYTES
ERR IMM,<Inadequate maximum message size>,<PROERR>
CAIL T1,NRTMMS ;DOES THIS REPRESENT A RESTRICTION TO US?
RET ;NO, RETURN NOW
MOVEM T1,SNDMMS ;YES, STORE FOR MAXIMUM OUTPUT BUFFERING
SUBI T1,4 ;OFFSET FOR COMMON-DATA OVERHEAD
MOVEM T1,CCOMMS ;MAXIMUM BUFFER SIZE FOR CTERM MESSAGE
RET ;RETURN TO CMHPIN
PINIBS: CALL CCISKP ;SKIP THE BYTES
RET ;RETURN TO CMHPIN
PINSUP: CALL CCIINC ;GET INTEGER BY COUNT
MOVEM T1,RCMSUP ;KEEP MASK OF TYPES SUPPORTED
TRNE T1,B0 ;IS THIS FROM SOMEONE WHO CAN'T READ?
LSH T1,1 ;YES, FIX IT FOR THEM
ANDX T1,MT.SUP ;MASK DOWN TO MINIMAL SUPPORT SET
CAIE T1,MT.SUP ;IS ENOUGH SUPPORTED?
ERR RMT,<Required message types not all supported>,<PROERR>
RET ;RETURN TO CMHPIN
;HERE TO SEND OUR RESPONDING .CMPIN MESSAGE
ND LCMVER,1
ND LCMECO,4
ND LCMMOD,0
CTMVRS: BYTE (8) LCMVER,LCMECO,LCMMOD
CMHPI3: MOVEI T1,.CMPIN ;MESSAGE TYPE
CALL CCOST2 ;PROTOCOL MSG WITH ZERO FLAGS BYTE
MOVEI T3,3 ;THREE BYTES OF BINARY VERSION
MOVE T2,[POINT 8,CTMVRS] ;VERSION INFO
CALL CCOSTR ;SEND COUNTED STRING
MOVEI T3,8 ;REVISION FIELD SIZE & STRING
MOVE T2,[POINT 7,[CONC(<ASCIZ |%>,\NRTVER,.,\NRTMIN,.,\NRTEDT,<|>)]]
CALL CCOSTP ;SEND PADDED STRING
MOVEI T3,CPILEN ;GET PARAMETER STRING LENGTH
MOVE T2,[POINT 8,CPIMSG] ;AND POINTER TO IT
CALL CCOSTR ;SEND COUNTED STRING
SKIPN BADBOY ;TALKING TO VMS?
SKITC:! PJRST CCOFIN ;NO, SEND MESSAGE & SKIP-RETURN
CALL CTVMTT ;YES, SETUP VMS TERMINAL CHARACTERISTICS
MOVEI T1,14_8!.PIVTC ;PARAMETER OF LENGTH 12.
CALL CCOINT ;INTRODUCE IT
MOVE T1,VMTTCH ;GET FIRST LONGWORD
CALL CCOINT ;SEND FIRST WORD
LSH T1,-20 ;SHIFT
CALL CCOINT ;SECOND WORD
MOVE T1,VMTTCH+1 ;GET SECOND LONGWORD
CALL CCOINT ;SEND THIRD WORD
LSH T1,-20 ;POSITION
CALL CCOINT ;SEND FOURTH WORD
MOVE T1,VMTTCH+2 ;GET THIRD LONGWORD
CALL CCOINT ;SEND FIFTH WORD
LSH T1,-20 ;SHIFT
CALL CCOINT ;SEND SIXTH WORD
PJRST CCOFIN ;BREAKFAST AT TIFFANY'S
CPIMSG: CPI MMS,NRTIMS ;OUR MAXIMUM MESSAGE SIZE
CPI IBS,NRTIBS ;OUR MAXIMUM INPUT BUFFER SIZE
CPI SUP,MT.SUP ;OUR SUPPORTED MESSAGES
BYTSTR CPI ;ACCUMULATE STRING
CPILEN==CPILEN ;PUBLISH LENGTH
;Here to build a VMS terminal characteristics block
CTVMTT: SKIPN BADBOY ;CALLED BY CTERM?
CALL CTM.AD ;NO, HAVE IT READ SOME VALUES FOR US
MOVE T1,TTYTYP ;GET TTY TYPE INDEX
MOVE T1,VTPTB(T1) ;GET TYPE & BITS
DPB T1,[POINT 8,VMTTCH,35-8] ;SET IN BLOCK
TRZ T1,BYTMSK ;ISOLATE TT2DEF BITS
SKIPE CC.MSP ;MODEM SIGNALS PRESENT?
TXO T1,T2AUTO!T2MHNG!T2DIAL ;YES, LIGHT MODEM BITS
TXO T1,T2HANG ;SINCE THE VAX WILL ANYWAY
SKIPE CC.8BC ;8BIT?
TXO T1,T2FLBK ;NO, REQUEST FALLBACK CODES
TXO T1,T2DISC ;TRY TO BE USEFUL
IFN FTSYPW,< ;[320] IF REQUESTED,
TXO T1,T2SYSP ;[320] LIGHT TT2$M_SYSPWD
>
MOVEM T1,VMTTCH+2 ;SET IN TT2 WORD
MOVX T1,TESCP!TRMOT ;GET STANDARD BITS
SKIPE CC.OFC ;OUTPUT FLOW CONTROL?
TXO T1,TTSYN ;MAP TO TTSYNCH
SKIPN CC.RAI ;RAISING?
TXO T1,TLOWR ;NO, ALLOW LOWERCASE
SKIPN CC.ECH ;ECHOING?
TXO T1,TNEKO ;NOPE
SKIPN CC.8BC ;8BIT?
TXO T1,T8BIT ;YEP
SKIPE TTDISP ;A DISPLAY?
TXO T1,TSCOP ;MAP TO SCOPE
SKIPE CC.MSP ;MODEM SIGNALS PRESENT?
TXO T1,TMODM ;MAP TO MODEM
HLRZ T2,TSVTAB ;TTY TAB VALUE
SKIPE T2 ;ON?
TXO T1,TMTAB ;MECHTAB
HLRZ T2,TSVFRM ;TTY FORM VALUE
SKIPE T2 ;ON?
TXO T1,TMFRM ;MECHFORM
HLRZ T2,TSVNFC ;NO FREE CRLF?
SKIPN T2 ;OFF?
TXO T1,TWRAP ;WRAP
MOVEM T1,VMTTCH+1 ;SET IN TTDEF WORD
MOVE T1,CC.LEN ;TTY LENGTH
DPB T1,[POINT 8,VMTTCH+1,35-24] ;SAVE IN TTDEF BYTE
MOVE T1,CC.WID ;TTY WIDTH
DPB T1,[POINT 16,VMTTCH,35-16] ;SAVE IN ITS WORD
LDB T1,[POINTR TTATTR,TA.LID!TA.CID] ;GET EDIT TYPES
CAIN T1,3 ;IF BOTH ON,
DPB T1,[POINTR VMTTCH+2,T2EDIT] ;SET EDIT MODE
SETZB T1,T2 ;CLEAR BITS TO ACCUMULATE
MOVE T3,TTATTR ;GET THE BITS WE READ
TXNE T3,TA.AVO ;IF AVO,
TXO T2,T2AVO ;NOTE IT
TXNE T3,TA.PPO ;IF A PRINTER PORT,
TXO T2,T2PPO ;NOTE IT
TXNE T3,TA.GPO ;IF REGIS,
TXO T2,T2RGIS ;NOTE IT
TXNE T3,TA.SXL ;IF SIXEL,
TXO T2,T2SIXL ;NOTE IT
TXNE T3,TA.RCS ;IF DRCS,
TXO T2,T2DRCS ;NOTE IT
TXNE T3,TA.BMT ;IF BLOCK MODE,
TXO T2,T2BLOK ;NOTE IT
MOVE T3,TTATR2 ;GET CONFORMANCE LEVELS
TXNE T3,T2.ACL ;IF ANYTHING LIKE ANSI,
TXO T2,T2ACRT ;NOTE IT
LDB T3,[POINTR T3,T2.DCL] ;ISOLATE DEC CONFORMANCE LEVEL
CAIL T3,1 ;IF ANYTHING,
TXO T2,T2DCRT ;NOTE IT
CAIL T3,2 ;IF AT LEAST 2,
TXO T2,T2DCR2 ;NOTE THAT
CAIL T3,3 ;IF AT LEAST 3,
TXO T2,T2DCR3 ;NOTE THAT
IORM T2,VMTTCH+2 ;UPDATE TT2DEF WORD
RET ;DONE SETTING UP THE BLOCK
SUBTTL CTERM Protocol - Start-Read message
CMHSRD: TXOE F,F$READ ;ARE WE ALREADY PROCESSING A READ?
ERR RIA,<Start-Read received while read active>,<PROERR>
CALL CCIINT ;GET FIRST FLAGS BYTES
MOVEM T1,SRDFL1 ;SAVE
CALL CCIBYT ;GET NEXT BYTE
MOVEM T1,SRDFL2 ;SAVE
CALL CCIINT ;READ THE BUFFER SIZE
;IFN FTCROCK,<
; TXNE T1,SGNBIT ;IS THIS FROM ULTRIX?
; MOVEI T1,1 ;YES, DO THE VMS SIMULATION
;> ;END CROCK
; CAXLE T1,NRTIBS ;WITHIN OUR TOLERANCE?
; ERR OSB,<Start-Read specified outsized buffer>,<PROERR>
MOVEM T1,SRDIBS ;STORE CURRENT BUFFER SIZE
CALL CCIINZ ;READ EOD
MOVEM T1,SRDEOD ;STORE
CALL CCIINZ ;READ TIMEOUT VALUE
MOVEM T1,SRDTMO ;STORE
CALL CCIINZ ;GET PROMPT END
MOVEM T1,SRDEOP ;STORE
CALL CCIINZ ;GET DISPLAY POSITION
MOVEM T1,SRDDSP ;STORE
CALL CCIINZ ;GET LOW-WATER MARK
MOVEM T1,SRDLWM ;STORE
CALL GETBRK ;SETUP BREAK MASK IN CBMASK BLOCK
CALL SRDCON ;DO CONSISTENCY CHECKING AND FORCING
CALL SRDLOD ;LOAD UP THE BUFFER
CALL SRDSET ;SETUP VARIOUS BLOCKS FROM CURRENT READ REQUEST
MOVE T4,READQT ;REQUEST WE JUST CREATED
CAMN T4,READQ ;IS IT THE FIRST
CALL SRDNEW ;YES, CAN'T DEPEND ON TTY: SERVICE TO SET IT UP
TXO F,F$FRC ;REALLY WANT OUR TTY: SERVICE CALLED
CALL FRCTTI ;DO IT (SO READ REQUEST GETS POSTED)
RETSKP ;RETURN SUCCESS
;Here to get the break mask
GETBRK: CALL CCIBYZ ;GET TERMINATOR MASK LENGTH
LDB T2,[POINTR SRDFL1,SR.TRM] ;GET TYPE OF TERMINATOR SUPPLIED
ASSUME .SRUPT,0
JUMPE T2,CCISKP ;IGNORE THE MASK IF 'USE PREVIOUS'
CAIE T2,.SRUNT ;USE NEW, SUPPLIED TERMINATOR?
JRST GETBRU ;NO, GET THE 'UNIVERSAL' SET
SETZM CBMASK ;YES, CLEAR OUT OLD MASK
MOVE T2,[CBMASK,,CBMASK+1] ;GET XFER VECTOR
BLT T2,CBMASK+7 ;CLEAR ENTIRE MASK BLOCK
JUMPE T1,CPOPJ ;DONE IF NULL
CALL CCICNT ;MAKE SURE IT FITS
MOVE T4,T1 ;COPY COUNT
MOVE T3,[POINT 8,CBMASK] ;SET STORAGE POINTER
PJRST CPYMSK ;GET THE MASK AND RETURN
GETBRU: SKIPN BADBOY ;SHOULD WE REALLY BE UNIVERSAL?
SKIPA T2,[UNVBKS,,CBMASK] ;YES, USE ARCHITECTURAL SPEC
MOVE T2,[VMSBKS,,CBMASK] ;NO, USE THE VMS NON-ARCHITECTURAL SET
BLT T2,CBMASK+7 ;COPY THE MASK
PJRST CCISKP ;DUMP THE BYTES AND RETURN
;Here to do consistency checking on the Start-Read parameters
SRDCON: MOVE T1,SRDIBS ;GET BUFFER SIZE REQUESTED
ADD T1,SRDEOP ;ADJUST BY PROMPT SIZE
CAML T1,SRDEOD ;MORE DATA THAN BUFFER?
CAMGE T1,SRDDSP ;DISPLAY AFTER BUFFER?
ERR ISD,<Inconsistent Start-Read Data parameters>,<PROERR>
CAML P1,SRDEOP ;MORE PROMPT THAN BUFFER?
CAME P1,SRDEOD ;DATA NOT MATCH BUFFER?
XCT ISD
MOVE T1,SRDEOP ;END OF PROMPT STRING
CAMLE T1,SRDLWM ;[321] PROMPT IS READ-ONLY
MOVEM T1,SRDLWM ;[321] SO MAKE SURE WE KNOW THAT
CAMLE T1,SRDEOD ;AND IS INITIAL DATA
XCT ISD ;BUFFER NEEDS TO REFLECT THIS
CAMGE P1,SRDDSP ;END-OF-DISPLAY COME AFTER MESSAGE ENDS?
MOVEM P1,SRDDSP ;BLAST VMS ANYWAY
RET ;DATA LOOKS GOOD TO ME
;Here to load up a request block with the data
SRDLOD: MOVEI T1,C.SIZE ;SIZE OF A REQUEST BLOCK
CALL CORGET ;GRAB SOME CORE
MOVE T4,T1 ;SAVE ADDRESS
SKIPN T1,SRDEOP ;GET PROMPT SIZE
JRST SRLOD1 ;NONE
HRLM T1,C.PROM(T4) ;SAVE BYTE COUNT
ADDI T1,3 ;ROUND UP
LSH T1,-2 ;CONVERT TO WORD COUNT
CALL CORGET ;GET THE SPACE
HRRM T1,C.PROM(T4) ;SAVE ADDRESS
MOVE T2,T1 ;COPY IT
TLO T2,(POINT 8) ;MAKE STORAGE POINTER
MOVE T3,SRDEOP ;GET PROMPT SIZE AGAIN
CALL CCISTR ;STORE THE PROMPT AWAY
MOVN T1,SRDEOP ;GET -VE PROMPT SIZE
ADDM T1,SRDLWM ;MAKE EVERYTHING ELSE BE DATA-ORIGINED
ADDM T1,SRDEOD ; ...
ADDM T1,SRDDSP ; ...
SRLOD1: MOVE T1,SRDLWM ;GET LOW-WATER MARK
MOVEM T1,C.LOWM(T4) ;SAVE FOR RESPONSE DATA
MOVE T1,SRDIBS ;GET BUFFER SIZE
MOVEM T1,C.COUN(T4) ;SAVE FOR SETTING BREAK WIDTH
SETOM C.TERM(T4) ;NOT TERMINATED YET
MOVE T1,SRDTMO ;TIMEOUT INTERVAL
MOVEM T1,C.TIME(T4) ;SAVE
MOVE T1,MSGNUM ;A MONOTONIC NUMBER
MOVEM T1,C.IDEN(T4) ;SET FOR TIMING
MOVEI T1,C.MASK(T4) ;POINT TO MASK STORAGE
HRLI T1,CBMASK ;SOURCE ADDRESS
BLT T1,C.MASK+7(T4) ;COPY MASK FOR THIS READ
DMOVE T1,SRDFL1 ;GET THE FLAGS
SKIPE CC.IGN ;DID THE VAX SET NOTYPEAHD?
TXO T1,SR.CTA ;YES, FLUSH TYPEAHEAD
MOVE T3,CC.IER ;INPUT-ESCAPE RECOGNITION
ASSUME S2.IER&B0,1
ASSUME .SRUNS,0
ASSUME .SRSIE,1
ASSUME .SRSRE,2
AOS T3 ;CONVERT TO FIELD VALUE
TRNN T2,S2.IER ;IF NOT SPECIFIED,
TRO T2,(T3) ;DEFAULT FROM CHARACTERISTIC
MOVE T3,CC.RAI ;RAISE INPUT
ASSUME SR.RAI&B0,0
ASSUME .SRUNS,0
ASSUME .SRSLC,1
ASSUME .SRSUC,2
AOS T3 ;CONVERT TO FLAG VALUE
LSH T3,ALIGN.(SR.RAI) ;MOVE INTO POSITION
TXNN T1,SR.RAI ;IF UNSPECIFIED,
TRO T1,(T3) ;DEFAULT FROM CHARACTERISTIC
SKIPN CC.ECH ;IF NOT ECHOING,
TXO T1,SR.NEC ;THEN DON'T
DMOVEM T1,C.FLG1(T4) ;SAVE FOR TTY: SERVICE
TXNN T1,SR.TMR ;DOING TIMING?
SETOM C.TIME(T4) ;NOPE
SKIPLE T1,SRDDSP ;START WITH DISPLAYED DATA
CALL SRLODB ;LOAD UP A BUFFER
MOVEM T1,C.PRE1(T4) ;SAVE
MOVX T1,SR.FMT ;FORMATTING FLAG
TDNE T1,C.FLG1(T4) ;IF LIT,
SKIPE C.PRE1(T4) ;AND NOT ALREADY DOING SOMETHING
TRNA ;(NO OR NO)
SETOM C.PRE1(T4) ;MAKE SURE WE LIGHT REDISP ANYWAY
MOVE T1,SRDEOD ;GET TOTAL DATA TO PRE-LOAD
SKIPLE SRDDSP ;DON'T CHANGE SIZE IF ONLY DISPLAYING PROMPT
SUB T1,SRDDSP ;FIND OUT HOW MUCH NEEDS DISPLAYING
JUMPE T1,SRLOD2 ;SKIP THIS IF NONE
CALL SRLODB ;LOAD UP A BUFFER
MOVX T2,IF.NEC ;GET UNECHOED FLAG BIT
MOVEM T2,IBF.FL(T1) ;NOTE THAT THIS NEEDS DISPLAY
MOVEM T1,C.PRE2(T4) ;SAVE BUFFER
SRLOD2: SKIPN T1,READQT ;POINT TO PREVIOUS ON QUEUE
MOVEI T1,READQ-C.LINK ;START A NEW QUEUE IF EMPTY
MOVEM T4,C.LINK(T1) ;LINK PREVIOUS TO US
MOVEM T4,READQT ;WE'RE NOW THE TAIL OF THE QUEUE
RET ;DONE LOADING UP DATA
;Here to load up an input buffer with data from the network message
SRLODB: MOVE T3,T1 ;COPY BYTE COUNT
ADDI T1,3 ;ROUND UP
LSH T1,-2 ;GET WORD COUNT
ADDI T1,IBF.DT ;PLUS OVERHEAD
MOVE T2,T1 ;KEEP A COPY OF WORD SIZE
CALL CORGET ;GRAB SOME CORE
MOVEM T3,IBF.CT(T1) ;STORE BYTE COUNT
HRLM T2,IBF.LK(T1) ;SAVE BLOCK SIZE
MOVE T2,T1 ;COPY ADDRESS
ADD T2,[POINT 8,IBF.DT-1,35] ;MAKE A POINTER
MOVEM T2,IBF.PT(T1) ;SAVE FOR READERS
SAVET1 ;PRESERVE BUFFER ADDRESS
PJRST CCISTR ;FILL IT WITH ITS DATA & RETURN
;Here to do the one-time characteristic setting for a read request
SRDNEW: CALL UNREAD ;MAKE SURE WE DON'T ECHO TOO SOON
MOVE T4,READQT ;POINT TO VALUES
MOVE T1,VPOS ;CURRENT VPOS
MOVEM T1,C.VPOS(T4) ;SET
MOVE T1,HPOS ;CURRENT HPOS
MOVEM T1,C.HPOS(T4) ;REMEMBER
SKIPGE T1,C.TIME(T4) ;DOING TIMING?
JRST SRNEW ;NO, SKIP THIS
PITMR. T1, ;YES, REQUEST IT
NOP ;SHOULD NEVER HAPPEN
TXO F,F$TMR ;TIMER GOING
SKIPN C.TIME(T4) ;WANT TYPEAHEAD NOW?
TXOA F,F$TEX ;YES, ALREADY EXCEEDED ONCE
TXZ F,F$TEX ;NO, NOT YET EXCEEDED
MOVE T1,C.IDEN(T4) ;GET IDENT
MOVEM T1,TMRSEQ ;THIS IS WHAT WE'RE TIMING
XMOVEI T1,CTM.TM ;TIMER ROUTINE
MOVEM T1,OSTMR ;LET IT GET CALLED
CALL TAHCNT ;COUNT UP CURRENT TYPEAHEAD
MOVEM T1,LICHCT ;SAVE FOR TIMING LOGIC
SRNEW: LDB T1,[POINTR SRDFL1,SR.CCD] ;GET DISABLE FIELD
CAIE T1,.SRALL ;DISABLING OUR SPECIALS?
JRST SRNEW1 ;NO, DON'T NEED TO DO ANYTHING DRASTIC
TXO F,F$RALL ;YES, REMEMBER FOR RDTRMF
MOVX T1,TC.NSA_TC.VLO ;GET DISABLE BIT IN VALUE FIELD
IORM T1,CATTAB+.CHCNV ;TURN OFF TTY QUOTE
MOVX T1,TC.OOB_TC.VLO ;GET OOB BIT TO CLEAR
MOVE T2,CC.CAT+.CHCNO ;GET ^O VALUES
TRNN T2,CA.OOB ;IF NOT OOB BY REQUEST,
ANDCAM T1,CATTAB+.CHCNO ;DON'T TAKE THE PSI
MOVE T2,CC.CAT+.CHCNX ;GET ^X VALUES
TRNN T2,CA.OOB ;IF NOT OOB BY REQUEST,
ANDCAM T1,CATTAB+.CHCNX ;DON'T TAKE THE PSI
SRNEW1: MOVE T1,SRDFL1 ;GET FLAGS
TXZE T1,SR.CTA ;SUPPOSED TO CLEAR TYPEAHEAD?
CALL FLSTAH ;YES, DO IT
MOVEM T1,SRDFL1 ;RESTORE FLAGS
TRNN T1,SR.VPT ;TERMINATE ON VERTICAL POSITION CHANGE?
JRST SRNEW2 ;NO, DON'T FUDGE THE COUNT
MOVE T1,CC.WID ;YES, GET CARRIAGE WIDTH
SUB T1,SRDEOD ;OFFSET BY PRE-LOADED DATA
JUMPL T1,SRNEW2 ;IF REMOTE SCREWED UP, IT'S NOT MY PROBLEM
CAMGE T1,IMASK ;IS THIS A SMALLER BYTE SIZE?
MOVEM T1,IMASK ;YES, RESTRICT THE READ
SRNEW2: MOVE T4,READQT ;GET POINTER TO DATA AGAIN
CALL CLRCTO ;DON'T SUPPRESS OUTPUT
MOVEI T1,.TOSET+.TOSTC;STOP COUNTER
MOVE T2,TTYUDX ;FOR THIS TERMINAL
SETZ T3, ;WANT TO CLEAR IT
MOVE CX,[3,,T1] ;UUO POINTER
TRMOP. CX, ;TRY TO CLEAR IT OUT
NOP ;SHOULDN'T FAIL
SETZM CURCTO ;NO MORE SUPPRESSION
SETZM REQCTO ;OF ANY SORT
MOVEI T1,.TOSET+.TOLCT;LOWERCASE TRANSLATE
TXNE F,F$CVL ;IF CVTLOW,
MOVEI T3,1 ;TURN IT ON
MOVE CX,[3,,T1] ;UUO POINTER
TRMOP. CX, ;SET IT UP
NOP ;SHOULDN'T FAIL
SKIPN T1,C.PRE1(T4) ;ANYTHING TO LOAD AHEAD?
JRST SRNEW4 ;NOT OF FIRST KIND
JUMPL T1,[SETOM REDISP ;IF WE NEED TO REDISPLAY
JRST SRNEW4] ;DON'T LINK IN PROMPT FLAG
SKIPN T2,INPQUE ;YES, WILL IT BE FIRST?
MOVNS IBF.LK(T1) ;YES, FLAG LAST
HRRM T2,IBF.LK(T1) ;LINK TO NEXT
MOVEM T1,INPQUE ;MAKE FIRST
MOVE T1,IBF.CT(T1) ;GET HOW MANY
SKIPGE ICHCNT ;IF OVER-DECREMENTED,
SETZM ICHCNT ;COMPENSATE NOW
ADDM T1,ICHCNT ;THEN UPDATE FOR WHAT WE JUST ADDED
SRNEW4: SETZM C.PRE1(T4) ;DON'T DO IT AGAIN
SKIPN T1,C.PRE2(T4) ;ANYTHING (ELSE) TO LOAD AHEAD?
JRST SRNEW5 ;NOPE
SKIPN T2,INPQUE ;YES, WILL IT BE FIRST?
MOVNS IBF.LK(T1) ;YES, FLAG LAST
HRRM T2,IBF.LK(T1) ;LINK TO NEXT
MOVEM T1,INPQUE ;MAKE FIRST
MOVE T1,IBF.CT(T1) ;GET HOW MANY
SKIPGE ICHCNT ;IF OVER-DECREMENTED,
SETZM ICHCNT ;COMPENSATE NOW
ADDM T1,ICHCNT ;THEN UPDATE FOR WHAT WE JUST ADDED
SETZM C.PRE2(T4) ;DO THIS ONLY ONCE
SRNEW5: TXO F,F$READ ;IN CASE SOMEONE HALTED US MISTAKENLY
TXNE F,F$NEC ;IF ALREADY NOT ECHOING,
PJRST TTYSST ;SET UP THE TTY: AND RETURN
TXO F,F$NEC ;NO, BUT ASSUME WE'LL STOP ECHOING NOW
SKIPE REDISP ;IF NEED TO REDISPLAY,
PJRST TTYSST ;DON'T ECHO YET
SKIPN T1,INPQUE ;START OF QUEUE
JRST SRNEW7 ;NO QUEUE TO WORRY ABOUT
MOVX T2,IF.NEC!IF.TRM;NO-ECHO BITS
SRNEW6: TDNE T2,IBF.FL(T1) ;A NO-ECHO BUFFER PRESENT?
SKIPN IBF.CT(T1) ;WITH CHARACTERS?
TRNA ;NO OR NO
PJRST TTYSST ;YES, DON'T ECHO YET
SKIPL T1,IBF.LK(T1) ;NO, IS THERE ANOTHER?
JRST SRNEW6 ;YES, TEST IT, TOO
SRNEW7: MOVE T1,[2,,T2] ;UUO POINTER
MOVEI T2,.TOTIC ;COUNT 'ECHOED' (BUT UNECHOED) CHARACTERS
MOVE T3,TTYUDX ;FOR THIS TERMINAL
TRMOP. T1, ;READ THE COUNT
PJRST TTYSST ;DON'T ECHO IF DETACHED
TXZ F,F$NEC ;ASSUME WE'LL ALLOW ECHOING AFTER ALL
JUMPE T1,TTYSST ;AND DO SO IF NOTHING TO SCREW US UP
MOVX T1,IO.SUP ;NO-ECHO BIT
TDNE T1,TTYBLK ;WAS THE TYPEAHEAD ECHOED?
TXO F,F$NEC ;NO, DON'T ECHO ANY MORE JUST YET
PJRST TTYSST ;SET UP TTY: AND RETURN
;Here to setup the break mask and such from a read request block
SRDSET: SKIPA T4,READQT ;USE THE QUEUE TAIL
;Enter here to use the read to be completed
SRSET: MOVE T4,READQ ;USE THE QUEUE HEAD
MOVSI T1,C.MASK(T4) ;SOURCE BREAK MASK
HRRI T1,LMASK ;WHERE TO SEND IT
BLT T1,ELMASK ;COPY IT TO TESTING BLOCK
MOVE T1,[LMASK,,IMASK+1] ;COPY TO SCRATCH BLOCK
BLT T1,ENDMSK ; ...
MOVE T3,C.COUN(T4) ;GET REQUESTED WIDTH
SUB T3,ICHCNT ;OFFSET BY AMOUNT ALREADY TYPED IN
SKIPG T3 ;IF OFF THE BOTTOM,
MOVEI T3,1 ;USE SCNSER'S MINIMUM
MOVEM T3,IMASK ;SET AS FIELD WIDTH
SETOM IMASK+1 ;IF NOTHING ELSE, WE PROBABLY NEED TO ECHO THESE
SETOM IMASK+1+4 ;AND THE C1 CHARACTERS
MOVEI T1,1B31 ;COME TO THINK OF IT,
IORM T1,IMASK+1+3 ;ALSO DO <DEL>
IORM T1,IMASK+1+7 ;AND THE INVALID <377>
MOVX T1,1B0 ;ANOTHER INVALID,
IORM T1,IMASK+1+5 ;<240>
MOVSI T1,-8 ;COUNT OF WORDS TO HACK
MOVE T2,CHRTAB(T1) ;SPECIAL CHARACTERS
IORM T2,IMASK+1(T1) ;MAKE THEM BREAKS
AOBJN T1,.-2 ;DO THIS FOR ALL SPECIALS
TXO F,F$LEM ;BE SURE THIS IS ON
MOVE T1,C.FLG2(T4) ;GET SECONDARY FLAGS
ASSUME .SRSRE&.SRSIE,0
TXNN T1,FLD(.SRSRE,S2.IER) ;IF DISABLING,
TXZA F,F$ESC!F$ESA ;THEN DO SO,
TXO F,F$ESC ;ELSE, ENABLE RECOGNITION
MOVE T1,C.FLG1(T4) ;GET PRIMARY FLAGS
TRNE T1,SR.NEC ;IF FORCING NO-ECHO,
TXOA F,F$NEC ;DO SO
TXZ F,F$NEC ;ELSE, DON'T
ASSUME .SRSLC&.SRSUC,0
TXNN T1,FLD(.SRSUC,SR.RAI) ;IF ALLOWING LOWERCASE,
TXZA F,F$CVL ;TURN OFF CVTLOW,
TXO F,F$CVL ;ELSE, TURN IT ON
RET ;DONE HERE
;Here to setup a read termination condition
RDTRMF: TXZN F,F$READ ;ONLY DO THIS ONCE
RET ; ...
TXO F,F$FRC ;MAKE SURE WE SEND THE READ-DATA MESSAGE
MOVE T2,READQT ;GET READ IN PROGRESS
MOVEM T1,C.TERM(T2) ;SET THE TERMINATION REASON
TXZ F,F$RALL ;WE'RE RE-ENABLING THE SPECIALS
MOVX T1,TC.NSA_TC.VLO;YES, GET DISABLE BIT
MOVE T2,CC.CAT+.CHCNV;GET ^V'S PERMANENT CHARACTERISTICS
TRNE T2,CA.ENB ;IF SUPPOSED TO BE ENABLED,
ANDCAM T1,CATTAB+.CHCNV;DO IT
MOVX T1,1B<.CHCNV> ;GET ITS BIT
TRNE T2,CA.ENB ;DID WE ENABLE?
IORM T1,CHRTAB ;YES, IT'S SPECIAL AGAIN
MOVX T1,TC.OOB_TC.VLO;OUT-OF-BAND ENABLE BIT
MOVE T2,CC.CAT+.CHCNO;GET ^O'S VALUES
TXNE T2,CA.ENB ;IF SUPPOSED TO BE ENABLED,
IORM T1,CATTAB+.CHCNO;TAKE THE PSI AGAIN
MOVE T2,CC.CAT+.CHCNX;GET ^X'S STATUS
TRNE T2,CA.ENB ;IF SUPPOSED TO BE ENABLED,
IORM T1,CATTAB+.CHCNX;DO IT
RDTRM1: CALL TTYSST ;SET STATUS ANEW
PUSH P,T3 ;SAVE A REG
MOVEI T1,.TOSET+.TOLCT;RAISE
MOVE T2,TTYUDX ;WHICH TERMINAL
SETZ T3, ;DISABLE IT
MOVE CX,[3,,T1] ;ARG POINTER
TRMOP. CX, ;DO IT
NOP ;ASSUME DETACHED
POP P,T3 ;RESTORE THE REGISTER
UNREAD: MOVEI T1,.TOUNR ;FUNCTION = UNREAD
MOVE T2,TTYUDX ;WHICH TERMINAL
MOVE CX,[2,,T1] ;ARG POINTER
TRMOP. CX, ;STOP INPUT
NOP ;DETACHED?
PJRST FRCTTI ;INPUT DONE
SUBTTL CTERM Protocol - Typehead processing
CMHUNR: CALL CCIBYT ;GET THE FLAG BYTE
MOVE T2,T1 ;COPY BYTE
MOVEI T1,.RDUNR ;UNREAD TERMINATION CODE
TXNE T2,UR.OIE ;ONLY-IF-EMPTY FLAG ON?
CALL TAHCHK ;YES, ANY TYPE-AHEAD PRESENT?
CALL RDTRMF ;NO, DO THE UNREAD
RETSKP ;YES, JUST SUCCEED
CMHCTA: CALL CCIBYT ;SKIP THE FLAGS BYTE
CALL FLSTAH ;FLUSH ALL TYPEAHEAD
RETSKP ;SUCCEED
SUBTTL CTERM Protocol - Write message
CMHWRT: CALL CCIINT ;READ THE FLAGS
MOVE T2,WRTFLG ;GET PREVIOUS FLAGS
TXNN T1,WR.BOM ;IS CURRENT LOGICAL BOM?
JRST [TXNN T2,WR.EOM ;NO, WAS PREVIOUS LOGICAL EOM?
JRST CMHWR1 ;NO, WE'RE GOLDEN
XCT WSE] ;YES, COMPLAIN
TXNE T2,WR.EOM ;YES, WAS PREVIOUS EOM?
JRST CMHWR2 ;YES, JUST USE THE NEW FLAGS
ERR WSE,<Write message sequencing error>,<PROERR>
CMHWR1: TXZ T2,WR.CDS ;FORGET PREVIOUS CLEAR-DISCARD VALUE
ANDX T1,WR.CDS!WR.EOM ;THESE ARE THE ONLY VALID BITS IN THE MIDDLE
IOR T1,T2 ;MAKE A NEW SET OF FLAGS
CMHWR2: MOVEM T1,WRTFLG ;STORE NEW FLAGS
MOVE T4,T1 ;COPY FOR TESTING
CALL CCIBYZ ;READ PRE-FIX VALUE
TXNE T4,WR.BOM ;IF VALID,
MOVEM T1,WRTPRE ;STORE
CALL CCIBYZ ;READ POST-FIX VALUE
TXNE T4,WR.BOM ;IF VALID,
MOVEM T1,WRTPST ;STORE
TXNE T4,WR.CDS ;CLEAR ^O?
PUSHJ P,CLRCTO ;YEP
TXNN T4,WR.BOM ;BEGINNING?
JRST CMHWR3 ;NO, DON'T DO THIS
SETZM WRTLOS ;NO LOST OUTPUT YET
TXNE T4,WR.LOK ;LOCKING IN SOME FASHION?
PUSHJ P,UNREAD ;YES, STOP ECHOING NOW
TXNE T4,WR.LOK ;IF LOCKING,
SETOM WRTLOK ;REMEMBER IT FOR READ ROUTINES
TXNN T4,WR.LOK ;LIKEWISE, IF NOT,
SETZM WRTLOK ;CANCEL .WRLOK
MOVE T1,HPOS ;GET CURRENT HPOS
MOVEM T1,WRHPOS ;SAVE AS VALUE FOR START OF WRITE
MOVE T1,VPOS ;GET CURRENT VPOS
MOVEM T1,WRVPOS ;SIMILARLY
LDB T1,[POINTR T4,WR.PRE] ;GET PREFIX HANDLING CODE
MOVE T2,WRTPRE ;AND THE PREFIX
PUSHJ P,WRTCCR ;HANDLE THE CARRIAGE CONTROL
CMHWR3: TXZ F,F$FLF!F$CLF ;NOTHING SPECIAL ABOUT LINEFEED NOW
TXNE T4,WR.BIN ;BINARY OUTPUT?
PUSHJ P,WATDEQ ;YES, MUST WAIT FOR GOOD OUTPUT TO CLEAR
CALL CHKCTO ;SEE IF OUTPUT IS SUPPRESSED
TXNE F,F$CTO ;IS IT?
JRST CMHWR6 ;YES, SKIP THE DATA
CMHWR4: JUMPE P1,CMHWR6 ;FINISH UP AT END OF BUFFER
CALL CCIBYT ;GET NEXT CHARACTER
SKIPE ESCOUT ;DOING AN OUTPUT ESCAPE SEQUENCE?
JRST WRTES1 ;YES, HANDLE IT
TXNE T4,WR.BIN ;TRANSPARENT WRITE?
JRST [MOVEM T1,BINCHR ;YES, DO A BINARY CHARACTER
MOVE T1,[3,,BINTRM] ;ARG POINTER
TRMOP. T1, ;SEND IT
NOP ;SHOULDN'T FAIL
JRST CMHWR4] ;AND LOOP
PUSH P,P1 ;SAVE COUNTER
MOVEI P1,WRTSPC ;POINT TO SPECIAL CHARACTER TABLE
CALL FNDFNC ;DISPATCH BASED ON THE CHARACTER
TRNA ;NOT THAT SPECIAL, TRY HARDER
SETO T1, ;DONE WITH THIS CHARACTER
POP P,P1 ;RESTORE THE COUNTER
JUMPL T1,CMHWR4 ;LOOP IF DONE
SKIPE CC.OER ;DO WE CARE ABOUT ESCAPE?
CALL ISESC ;AND IS THIS AN ESCAPE?
JRST CMHWR5 ;NO, JUST DUMP IT
JRST WRTESC ;YES, HANDLE ESCAPE SEQUENCE
CMHWR5: PUSHJ P,OUTTTY ;QUEUE THE CHARACTER
JRST CMHWR4 ;LOOP OVER THE BUFFER
CMHWR6: PUSHJ P,CHKCTO ;TEST FOR ^O
TXNE F,F$CTO ;OUTPUT OFF?
AOS WRTLOS ;YES, NOTE THE LOSSAGE
SKIPE T1,P1 ;IF SKIPPED FOR ^O,
CALL CCISKP ;AVOID STOPCODES
TXNN T4,WR.EOM ;IF NOT LAST MESSAGE,
RETSKP ;WE'RE DONE FOR NOW
LDB T1,[POINTR T4,WR.PST] ;GET POSTFIX TYPE
MOVE T2,WRTPST ;AND THE VALUE
PUSHJ P,WRTCCR ;DO THE CARRIAGE CONTROL
MOVEI T1,.CHCRT ;GET A CARRIAGE RETURN
CAMN T1,LSTCHR ;IF THAT WAS THE LAST OUTPUT,
TXO F,F$FLF ;REQUEST A FREE LINEFEED
TXNE T4,WR.FMT ;IF FORMATTING,
PUSHJ P,WRTLFD ;HANDLE THE FORMATTING
LDB T1,[POINTR T4,WR.LOK] ;GET LOCK TYPE
CALL @WLKDSP(T1) ;HANDLE THE UNLOCK PROCESSING (IF ANY)
TXNN T4,WR.VFY ;VERIFY REQUESTED?
RETSKP ;NO, SO WE'RE DONE HERE
PUSHJ P,WATOUT ;YES, SO WAIT FOR IT ALL TO GO
MOVEI T1,.CMWRC ;GET WRITE-COMPLETE VALUE
SKIPE WRTLOS ;DID WE LOSE ANY TO ^O?
TXO T1,WC.DIS_8 ;SOME WAS LOST
CALL CCOST2 ;SETUP FOR RESPONSE
MOVE T1,HPOS ;NEW HPOS
; TRNE T4,WR.BIN ;BINARY?
; TDZA T1,T1 ;YES, FORGET IT
; SUB T1,WRHPOS ;NO, GET DELTA
CALL CCOINT ;SEND HPOS CHANGE
MOVE T1,VPOS ;NEW VPOS
; TRNE T4,WR.BIN ;IF BINARY,
; TDZA T1,T1 ;FORGET ABOUT IT
; SUB T1,WRVPOS ;ELSE, GET DELTA
; SKIPGE T1 ;IF WENT BACKWARDS,
; ADD T1,CC.LEN ;ASSUME WE ONLY CROSSED ONE FORMS BREAK
CALL CCOINT ;SEND VPOS CHANGE
PJRST CCOFIN ;SEND IT OFF
WRTCCR: JUMPE T1,CPOPJ ;DON'T DO IT IF CCR=NON
ASSUME .WRIGN,0
CAIE T1,.WRCHR ;IS IT A CHARACTER?
JRST WRTCC1 ;NO, GO DEAL WITH COUNT
MOVE T1,T2 ;YES, GET THE CHARACTER
CAIE T1,.CHLFD ;IF A LINEFEED,
TXZA F,F$CLF ;NO, JUST SEND IT,
TXZN F,F$CLF ;YES, ONLY SEND IF NOT SUPPRESSING
PJRST OUTTTY ;OK, SEND IT
RET ;IGNORE IT IF SUPPOSED TO CANCEL ONE
WRTCC1: JUMPE T2,CPOPJ ;IGNORE A REQUEST FOR 0 NL'S
TXZE F,F$CLF ;IF SUPPOSED TO CANCEL NEXT LINEFEED,
SOJLE T2,CPOPJ ;DO SO
MOVEI T1,.CHCRT ;GET THE CR
CALL OUTTTY ;SEND IT
MOVEI T1,.CHLFD ;NOW START LF'S
WRTCC2: CALL OUTTTY ;SEND ONE
SOJG T2,WRTCC2 ;OR MORE
RET ;RETURN
WRTLFD: TXZN F,F$FLF ;NEED A FREE LF?
RET ;NO, DON'T BOTHER
TXO F,F$CLF ;YES, DON'T DOUBLE-SPACE
MOVEI T1,.CHLFD ;GET A LF
PJRST OUTTTY ;SEND IT AND RETURN
WRTESC: CALL WATDEQ ;THIS STARTS A BINARY SUB-WRITE
MOVEI T2,.CHESC ;NO MATTER WHAT WE WRITE,
MOVEM T2,LSTCHR ;IT WAS AN ESCAPE (FOR CARRIAGE CONTROL)
WRTES1: MOVEM T1,BINCHR ;CHARACTER TO SEND LITERALLY
MOVE T1,[3,,BINTRM] ;ARG POINTER TO SEND IT
TRMOP. T1, ;GIVE IT TO SCNSER
NOP ;SHOULDN'T FAIL
MOVE T1,BINCHR ;RESTORE THE CHARACTER
MOVE CX,ESCOUT ;GET CURRENT RULE
CALL ESCRUL ;FIGURE OUT WHETHER WE'RE AT THE END YET
SETZ CX, ;DONE IF INVALID
MOVEM CX,ESCOUT ;UPDATE RULE
JUMPN CX,CMHWR4 ;ONLY DO FOLLOWING AT END
SETZM HPOS ;THE SPEC REQUIRES THAT ESCAPE SEQUENCES
SETZM VPOS ;ARE ASSUMED TO POSITION TO 0,0
JRST CMHWR4 ;LOOP FOR NEXT CHARACTER
WLKDSP: DSPGEN WLK,.WR,<ULK,LOK,LTU,LUR>
ERRDSP WLK,<ULK,LOK> ;NOTHING TO DO FOR THESE
WLKLUR: SETOM REDISP ;WE NEED A RE-DISPLAY DONE
WLKLTU: SETZM WRTLOK ;NO LONGER LOCKED
TXO F,F$FRC ;MAKE SURE WE GET TO TTY: PROCESSING
PJRST FRCTTI ;NOTIFY TTY: HANDLER
;Here to examine the outgoing character for special processing
WRTSPC: WRTFF,,.CHFFD ;FORM-FEED
WRTVT,,.CHVTB ;VERTICAL TAB
Z ;END OF TABLE
WRTFF: MOVE T2,CC.FFM ;FORM-FEED MODE
CAIN T2,FF.PHY ;SEND LITERALLY?
PJRST OUTTTY ;YES, DO SO
MOVE CX,VPOS ;GET WHERE WE'RE STARTING FROM
WRTFF1: SUB CX,CC.LEN ;GET -VE COUNT TO NEXT FORMS BREAK
WRTFF2: PUSH P,CX ;SAVE IT
MOVEI T1,.CHLFD ;GET A LINEFEED
CALL OUTTTY ;SEND IT
AOSGE (P) ;NEED TO SEND MORE?
JRST .-2 ;LOOP UNTIL DONE
JRST TPOPJ ;DONE
WRTVT: MOVE T2,CC.VTM ;VERTICAL-TAB MODE
CAIN T2,VT.PHY ;SEND IT LITERALLY?
PJRST OUTTTY ;YES, DO IT
MOVEI T1,.CHFFD ;NO, GET ALTERNATE CHARACTER
CAIN T2,VT.MAP ;MAP TO FF?
PJRST WRTFF ;YES, DO IT
MOVE CX,VPOS ;SEE WHERE WE'RE STARTING FROM
MOVE T1,CX ;COPY VALUE
IDIVI T1,^D11 ;GET NUMBER OF VT INCREMENTS USED
AOS T2,T1 ;GET NEXT
IMULI T2,^D11 ;GET DESIRED COUNT
CAML T2,CC.LEN ;IF GOING OFF THE END,
PJRST WRTFF1 ;JUST GO UNTIL END OF PAGE
SUB CX,T2 ;ELSE, GET -VE COUNT TO SATISFY VT
PJRST WRTFF2 ;AND GO UNTIL THAT COMPLETES
SUBTTL CTERM Protocol - Read Characteristics message
CMHRCH: CALL CCIBYT ;EAT FLAG BYTE
MOVEI T1,0_8!.CMCHR ;GET RESPONSE TYPE & FLAGS
CALL CCOST2 ;SETUP FOR RESPONSE
CMHRC1: JUMPE P1,CCOFIN ;SEND RESPONSE AT END OF REQUEST
CALL CCIBYT ;GET NEXT SUB-TYPE
MOVE T2,T1 ;PRESERVE IT
CALL CCIBYT ;GET MAJOR TYPE OF SELECTOR
CAIL T1,.CTCFP ;IN RANGE OF KNOWN TYPES?
CAILE T1,.CTCMH ;BOTH WAYS?
ERR RCS,<Invalid Read-Characteristics selector>,<PROERR>
SKIPLE T2 ;IS SUB-TYPE IN RANGE?
CAMLE T2,RCHMAX(T1) ;BOTH WAYS?
XCT RCS ;NO
DMOVEM T1,CHRCUR ;SAVE FOR RESPONSE
CALL @RCHDSP(T1) ;DISPATCH ON SELECTOR
JRST CMHRC1 ;LOOP OVER ALL SELECTORS PRESENT
RCHDSP: IFIW @RFPDSP(T2) ;READ FOUNDATION PHYSICAL SET
IFIW @RFLDSP(T2) ;READ FOUNDATION LOGICAL SET
IFIW @RMHDSP(T2) ;READ MODE HANDLER SET
RCHMAX: EXP RFPMAX ;MAX OFFSET FOR FOUNDATION PHYSICAL
EXP RFLMAX ; FOR FOUNDATION LOGICAL
EXP RMHMAX ; FOR MODE HANDLER
RFPDSP: DSPGEN RFP,.CC,<ILL,RSP,TSP,CSZ,CPE,CPT,MSP,ABR,EMG,SW1,SW2,8BC,EME>
RFPMAX==.-RFPDSP-1 ;MAXIMUM FOR .CTCFP
ERRDSP RFP,ILL
RFLDSP: DSPGEN RFL,.CC,<ILL,MWA,TAM,TTN,OFC,OPS,FCP,IFC,LNE,WID,LEN,SSZ,CRF,
LFF,WRP,HTM,VTM,FFM>
RFLMAX==.-RFLDSP-1 ;MAXIMUM FOR .CTCFL
ERRDSP RFL,ILL
RMHDSP: DSPGEN RMH,.CC,<ILL,IGN,CAT,COP,RAI,ECH,IER,OER,CNT,APE,EPM>
RMHMAX==.-RMHDSP-1 ;MAXIMUM FOR .CTCMH
ERRDSP RMH,ILL
;Here to read the simple characteristics
DEFINE DISP1(LIST),<IRP LIST,<DISP2 LIST>>
DEFINE DISP2(LIST),<DISP3 LIST>
DEFINE DISP3(PF,SF),<
IRP SF,<
PF'SF: MOVE T3,CC.'SF ;;GET THE REQUESTED VALUE
PJRST @FMTDSP+FT.'SF ;;SEND IT IN THE RESPONSE
>>
DEFINE RCHXIT(SF),<PJRST @FMTDSP+FT.'SF>
DISP1 <<RFP,<RSP,TSP,CSZ,CPE,CPT,EMG,SW1,SW2,8BC,ABR,MSP>>,
<RFL,<MWA,TTN,OFC,OPS,FCP,IFC,LNE,WID,LEN,SSZ,CRF,LFF,WRP,HTM,VTM,FFM>>,
<RMH,<IGN,CAT,COP,RAI,ECH,IER,OER,CNT,APE,EPM>>>
FMTDSP: DSPGEN FMT,.FT,<ASD,BYT,INT,CCA>
;Here to read the more complicated characteristics
RFPEME: SKIPN T3,CC.EMG ;ENABLED IF GUARANTEED
MOVE T3,CC.EME ;OTHERWISE USE THE MODE SETTING
RCHXIT (EME) ;RETURN THE VALUE
RFLTAM: MOVE T3,TTDISP ;IS THIS A DISPLAY?
LSH T3,ALIGN.<TA%DIS> ;POSITION THE VALUE
SKIPE TTKNOW ;TTY TYPE KNOWN TO THE SYSTEM?
TXO T3,TA%KNO ;YES, LIGHT THE BIT
RCHXIT (TAM) ;RETURN THE VALUE
;Here to send response values that we've read
FMTASD: JUMPE T3,FMTBYT ;SIMPLE TO SEND IF NULL
SKIPL T3 ;CHECK IF VALID CHARACTER
CAILE T3,377 ; ...
JRST FMTAS1 ;NO, ASSUME SIXBIT
LSH T3,8 ;YES, SHIFT OVER
TRO T3,1 ;PREPEND THE LENGTH
PJRST FMTINT ;SEND AS AN INTEGER
FMTAS1: PUSHJ P,FMTCHK ;ASSUME THE WORST
EXP 9 ;2+1+6 FOR CHR, LEN, AND BYTES
MOVE T1,T3 ;COPY THE VALUE
MOVN T2,T1 ;GET ITS NEGATIVE
AND T2,T1 ;KEEP ONLY RIGHTMOST BIT
JFFO T2,.+1 ;FIND ITS BIT NUMBER
IDIVI T3,6 ;MAKE 0..5
EXCH T1,T3 ;RE-POSITION
AOS T1 ;ONE MORE CHARACTER THAN INDICATED
CALL CCOBYT ;SEND THE LENGTH
MOVE T4,T1 ;COPY IT
FMTAS2: SETZ T2, ;CLEAR SOME SPACE
LSHC T2,6 ;GET NEXT SIXBIT CHARACTER
MOVEI T1," "-' '(T2) ;MAKE IT ASCII
CALL CCOBYT ;SEND IT
SOJG T4,FMTAS2 ;LOOP OVER ALL CHARACTERS
RET ;RETURN FOR NEXT CHARACTERISTIC
FMTBYT: CALL FMTCHK ;MAKE SURE THERE'S ROOM
EXP 3 ;2 FOR CHAR AND 1 FOR VALUE
MOVE T1,T3 ;COPY VALUE
PJRST CCOBYT ;AND SEND IT
FMTINT: CALL FMTCHK ;MAKE SURE THERE'S ROOM
EXP 4 ;2 FOR CHAR AND 2 FOR VALUE
MOVE T1,T3 ;COPY VALUE
PJRST CCOINT ;AND SEND IT
FMTCCA: CALL FMTCHK ;MAKE SURE THERE'S ROOM
EXP 5 ;2 FOR CHAR AND 3 FOR VALUE
CALL CCIBYT ;GET CHARACTER TO INVESTIGATE
CALL CCOINT ;SEND IT, AND A NON-MODIFIER MASK
MOVE T1,CC.CAT(T1) ;GET THE VALUE WE WERE LAST SENT
PJRST CCOBYT ;SEND THAT AND RETURN
FMTCHK: MOVE T4,@(P) ;GET NUMBER OF BYTES WE NEED
CAMG T4,CCOCNT ;ARE THERE THAT MANY LEFT?
JRST FMTCH1 ;YES, JUST ACCUMULATE IN MESSAGE
PUSHJ P,SAVT ;NO, PRESERVE SOME ACS (T3)
PUSHJ P,CCOFIN ;SEND IT OFF
NOP ;ALWAYS SKIPS
MOVEI T1,.CMCHR ;RESPONSE TYPE
PUSHJ P,CCOST2 ;SETUP FOR ANOTHER ONE
FMTCH1: MOVE T1,CHRCUR ;GET MAJOR BYTE OF CURRENT SELECTOR
LSH T1,8 ;POSITION IT
IOR T1,CHRCUR+1 ;INCLUDE MINOR BYTE
CALL CCOINT ;SEND THE TYPE IN THE RESPONSE
RETSKP ;SKIP OVER INLINE ARGUMENT
SUBTTL CTERM Protocol - Write Characteristics message
CMHCHR: CALL CCIBYT ;EAT FLAG BYTE
CMHSC1: JUMPE P1,CPOPJ1 ;RETURN SUCCESS AT END OF LIST
CALL CCIBYT ;GET NEXT SUB-TYPE
MOVE T2,T1 ;PRESERVE IT
CALL CCIBYT ;GET MAJOR TYPE OF SELECTOR
CAIL T1,.CTCFP ;IN RANGE OF KNOWN TYPES?
CAILE T1,.CTCMH ;BOTH WAYS?
ERR SCS,<Invalid Set-Characteristics selector>,<PROERR>
SKIPLE T2 ;IS SUB-TYPE IN RANGE?
CAMLE T2,RCHMAX(T1) ;BOTH WAYS?
XCT SCS ;NO
CALL @SCHDSP(T1) ;DISPATCH ON SELECTOR
JRST CMHSC1 ;LOOP OVER ALL SELECTORS PRESENT
SCHDSP: IFIW @SFPDSP(T2) ;WRITE FOUNDATION PHYSICAL SET
IFIW @SFLDSP(T2) ;WRITE FOUNDATION LOGICAL SET
IFIW @SMHDSP(T2) ;WRITE MODE HANDLER SET
SFPDSP: DSPGEN SFP,.CC,<ILL,RSP,TSP,CSZ,CPE,CPT,MSP,ABR,EMG,SW1,SW2,8BC,EME>
SFPMAX==.-SFPDSP-1 ;MAXIMUM FOR .CTCFP
IFN SFPMAX-RFPMAX,<PRINTX ? SFPDSP/RFPDSP DISCREPANCY>
ERRDSP SFP,ILL
SFLDSP: DSPGEN SFL,.CC,<ILL,MWA,TAM,TTN,OFC,OPS,FCP,IFC,LNE,WID,LEN,SSZ,CRF,
LFF,WRP,HTM,VTM,FFM>
SFLMAX==.-SFLDSP-1 ;MAXIMUM FOR .CTCFL
IFN SFLMAX-RFLMAX,<PRINTX ? SFLDSP/RFLDSP DISCREPANCY>
ERRDSP SFL,ILL
SMHDSP: DSPGEN SMH,.CC,<ILL,IGN,CAT,COP,RAI,ECH,IER,OER,CNT,APE,EPM>
SMHMAX==.-SMHDSP-1 ;MAXIMUM FOR .CTCMH
IFN SMHMAX-RMHMAX,<PRINTX ? SMHDSP/RMHDSP DISCREPANCY>
ERRDSP SMH,ILL
;Here to 'set' the read-only values
SFPRSP: ASSUME FT.RSP,.FTINT
SFPTSP: ASSUME FT.TSP,.FTINT
SFPCPT: ASSUME FT.CPT,.FTINT
CALL CCIINT ;READ THE TWO-BYTE VALUE
RET ;RETURN WITHOUT SETTING IT
SFPCPE: ASSUME FT.CPE,.FTBYT
SFPMSP: ASSUME FT.MSP,.FTBYT
SFPABR: ASSUME FT.ABR,.FTBYT
SFPEMG: ASSUME FT.EMG,.FTBYT
SFLMWA: ASSUME FT.MWA,.FTBYT
SFLIFC: ASSUME FT.IFC,.FTBYT
SFLLNE: ASSUME FT.LNE,.FTBYT
SMHEPM: ASSUME FT.EPM,.FTBYT
CALL CCIBYT ;READ THE ONE-BYTE VALUE
RET ;RETURN WITHOUT SETTING IT
SFPSW1: ASSUME FT.SW1,.FTASD
SFPSW2: ASSUME FT.SW2,.FTASD
CALL CCIBYT ;GET THE STRING LENGTH
CALL CCISKP ;SKIP THAT MANY BYTES
RET ;DON'T STORE
;Here to set real values
SFPCSZ: ASSUME FT.CSZ,.FTINT
CALL CCIINT ;GET THE VALUE
SKIPE CC.MWA ;ALLOWED TO CHANGE?
CAMN T1,CC.CSZ ;IS IT A CHANGE?
RET ;NO, SKIP OVERHEAD
CAIL T1,7 ;IF OUT OF OUR RANGE,
CAILE T1,8 ; IS IT?
RET ;YES, IGNORE IT
MOVEM T1,CC.CSZ ;UPDATE FOR READERS
SUBI T1,7 ;CONVERT TO USEFUL VALUE
MOVEI T3,.TOSET+.TO8BT ;MAP TO TTY EIGHTBIT
CALL STRMOP ;CHANGE IT
NOP ;IGNORE FAILURE
TRC T3,1 ;INVERTED RELATIVE TO ALTERNATE
MOVEM T3,CC.8BC ;ALSO CHANGE THIS ONE
RET ;TRY THE NEXT ONE
SFP8BC: ASSUME FT.8BC,.FTBYT ;BOOLEAN
CALL CCIBYT ;GET THE VALUE
ANDI T1,1 ;NORMALIZE
SKIPE CC.MWA ;ALLOWED TO CHANGE IT?
CAMN T1,CC.8BC ;CHANGING IT?
RET ;NO, SKIP OVERHEAD
MOVE T4,T1 ;KEEP A COPY
TRC T1,1 ;IT'S INVERTED RELATIVE TO OURS
MOVEI T3,.TO8BT+.TOSET ;VALUE TO CHANGE
CALL STRMOP ;TRY TO SET IT
MOVEM T4,CC.8BC ;SAVE FOR READ ROUTINES
ADDI T3,7 ;MAKE A CHARACTER SIZE
MOVEM T3,CC.CSZ ;UPDATE THAT AS WELL
RET ;GET NEXT CHARACTERISTIC
SFPEME: ASSUME FT.EME,.FTBYT ;BOOLEAN
CALL CCIBYT ;GET THE VALUE
SKIPN CC.EMG ;MANAGEMENT GUARANTEED?
CAMN T1,CC.EME ;OR NOT CHANGING?
RET ;YES, DON'T BOTHER ME
SKIPN CC.MWA ;ALLOWED TO CHANGE IT?
RET ;NO, DON'T
ANDI T1,1 ;NORMALIZE
SKIPE T4,T1 ;CLEAR IF DISABLING
MOVE T4,SWTSEQ ;ENABLING, GET SEQUENCE
MOVE T3,TTYUDX ;TT:'S UDX
MOVEI T2,.TOSET+.TOSWI ;FUNCTION TO SET SWITCH SEQUENCE
MOVE CX,[3,,T2] ;UUO ARG POINTER
TRMOP. CX, ;TRY IT
RET ;CAN'T
MOVEM T1,CC.EME ;DID IT, UPDATE FOR READERS
RET ;TRY FOR NEXT
SFLTAM: ASSUME FT.TAM,.FTINT ;TWO-BYTE MASK
CALL CCIINT ;GET VALUE
ANDX T1,TA%DIS ;KEEP THE ONLY BIT WE CAN SET
LSH T1,-<ALIGN. TA%DIS> ;RIGHT-JUSTIFY IT
SKIPE CC.MWA ;ALLOWED TO CHANGE IT?
CAMN T1,TTDISP ;REALLY CHANGING IT?
RET ;NO, DON'T BOTHER ME
MOVEI T3,.TOSET+.TODIS ;SET DISPLAY ATTRIBUTE
CALL STRMOP ;TRY TO CHANGE IT
MOVEM T3,TTDISP ;DID IT, UPDATE FOR READERS
RET ;TRY THE NEXT ONE
SFLTTN: ASSUME FT.TTN,.FTASD ;ASCII DESCRIPTOR
CALL CCIASD ;READ THE (SIXBIT) VALUE
SKIPE CC.MWA ;ALLOWED TO CHANGE IT?
CAMN T1,CC.TTN ;REALLY CHANGING ANYTHING?
RET ;NO, SKIP OVERHEAD
MOVEM T1,CC.TTN ;SAVE THIS AS WHAT THE TYPE SHOULD BE
CAMN T1,TTTYPE ;IF NOT REALLY A CHANGE,
RET ;SKIP THE UUO
SETOM TTKNOW ;ASSUME A KNOWN TYPE
MOVEI T3,.TOSET+.TOTRM ;SET TTY TYPE
CALL STRMOP ;TRY TO SET IT
RET ;WE WIN
MOVSI CX,-TTNLEN ;GET AOBJN POINTER TO ALTERNATES TABLE
SFLTT1: CAME T3,TTNALT(CX) ;MATCH?
AOBJN CX,SFLTT1 ;LOOP IF NOT
JUMPGE CX,SFLTT2 ;FAIL IF NO MATCH
MOVE T3,TTNTYP(CX) ;YES, GET LOCAL NAME
MOVE CX,[3,,T1] ;RESTORE ARG POINTER
TRMOP. CX, ;TRY AGAIN
TRNA ;STILL CAN'T
RET ;WE WIN
SFLTT2: SETZM TTKNOW ;CAN'T DO IT
RET ;TRY FOR THE NEXT ONE
DEFINE TYPTTY,<
TTT TTY33,LT33
TTT TTY35,LT35
TTT TTY37,LT37
TTT VT61,VT52
TTT VT185,VT125
>
DEFINE TTT(LOCAL,REMOTE),<EXP SIXBIT |LOCAL|>
TTNTYP: TYPTTY
TTNLEN==.-TTNTYP
DEFINE TTT(LOCAL,REMOTE),<EXP SIXBIT |REMOTE|>
TTNALT: TYPTTY
;Still setting real characteristics
SFLOFC: ASSUME FT.OFC,.FTBYT ;BOOLEAN
CALL CCIBYT ;GET THE VALUE
ANDI T1,1 ;NORMALIZE
SKIPE CC.MWA ;ALLOWED TO CHANGE IT?
CAMN T1,CC.OFC ;CHANGING IT?
RET ;NO, SKIP OVERHEAD
MOVEI T3,.TOSET+.TOXNF ;SET TTY XONOFF
CALL STRMOP ;MUNGE IT
MOVEM T3,CC.OFC ;UPDATE FOR READERS
RET ;TRY FOR THE NEXT ONE
STRMOP: EXCH T1,T3 ;GET VALUES TO RIGHT PLACES
MOVE T2,TTYUDX ;GET TT:'S UDX
MOVE CX,[3,,T1] ;UUO ARG POINTER
TRMOP. CX, ;TRY TO SET IT
AOS (P) ;SKIP RETURN IF COULDN'T
RET ;RETURN TO CALLER
SFLOPS: ASSUME FT.OPS,.FTBYT ;BOOLEAN
CALL CCIBYT ;GET THE VALUE
ANDI T1,1 ;NORMALIZE
SKIPE CC.MWA ;ALLOWED TO CHANGE IT?
CAMN T1,CC.OPS ;CHANGING IT?
RET ;NO, SKIP OVERHEAD
MOVEI T3,.TOSET+.TOSTO ;TTY STOP SETTING
CALL STRMOP ;MUNG IT
MOVEM T3,CC.OPS ;UPDATE FOR READERS
RET ;TRY FOR THE NEXT ONE
SFLFCP: ASSUME FT.FCP,.FTBYT ;BOOLEAN
CALL CCIBYT ;GET THE VALUE
ANDI T1,1 ;NORMALIZE
SKIPE CC.MWA ;ALLOWED TO CHANGE IT?
CAMN T1,CC.FCP ;CHANGING IT?
RET ;NO, SKIP OVERHEAD
DPB T1,[POINTR CATTAB+.CHCNQ,TC.NSA_TC.VLO] ;UPDATE FOR ^Q
DPB T1,[POINTR CATTAB+.CHCNS,TC.NSA_TC.VLO] ;AND FOR ^S
MOVEM T1,CC.FCP ;AND FOR READERS
LSH T1,<ALIGN. TC.NSA>+TC.VLO ;POSITION FOR VALUE
TXO T1,FLD(TC.NSA,TC.MOD) ;WHAT WE'RE MODIFYING
MOVEI T2,.TOSCS ;SET CHARACTER STATUS
MOVE T3,TTYUDX ;ON THIS TTY
MOVE T4,[1,,T1] ;THIS SINGLE CHARACTER
TRO T1,.CHCNQ ;^Q FIRST
MOVE CX,[3,,T2] ;ARG POINTER
TRMOP. CX, ;UPDATE ^Q FOR REAL
RET ;ASSUME GOT DETACHED
TRC T1,.CHCNQ^!.CHCNS ;CHANGE TO ^S
TRMOP. CX, ;UPDATE THIS ONE, TOO
NOP ;IGNORE ERROR
RET ;TRY FOR NEXT ONE
SFLWID: ASSUME FT.WID,.FTINT ;INTEGER
CALL CCIINT ;GET THE VALUE
SKIPE CC.MWA ;ALLOWED TO CHANGE IT?
CAMN T1,CC.WID ;CHANGING IT?
RET ;SKIP OVERHEAD IF NOT
MOVEI T3,.TOSET+.TOWID ;SET TTY WIDTH
CALL STRMOP ;CHANGE IT IF POSSIBLE
MOVEM T3,CC.WID ;UPDATE FOR READERS IF WON
RET ;TRY THE NEXT ONE
SFLLEN: ASSUME FT.LEN,.FTINT ;INTEGER
CALL CCIINT ;GET THE VALUE
SKIPE CC.MWA ;ALLOWED TO CHANGE IT?
CAMN T1,CC.LEN ;CHANGING IT?
RET ;SKIP OVERHEAD IF NOT
MOVEI T3,.TOSET+.TOLNB ;SET TTY LENGTH
CALL STRMOP ;CHANGE IT IF POSSIBLE
MOVEM T3,CC.LEN ;UPDATE FOR READERS IF WON
RET ;TRY THE NEXT ONE
SFLSSZ: ASSUME FT.SSZ,.FTINT ;INTEGER
CALL CCIINT ;GET THE VALUE
SKIPE CC.MWA ;ALLOWED TO CHANGE IT?
CAMN T1,CC.SSZ ;CHANGING IT?
RET ;SKIP OVERHEAD IF NOT
MOVEI T3,.TOSET+.TOSSZ ;SET TTY STOP SIZE
CALL STRMOP ;CHANGE IT IF POSSIBLE
MOVEM T3,CC.SSZ ;UPDATE FOR READERS IF WON
RET ;TRY THE NEXT ONE
SFLCRF: ASSUME FT.CRF,.FTINT ;INTEGER
CALL CCIINT ;GET THE VALUE
SKIPE CC.MWA ;ALLOWED TO CHANGE IT?
MOVEM T1,CC.CRF ;UPDATE FOR READERS IF SO
RET ;TRY THE NEXT ONE
SFLLFF: ASSUME FT.LFF,.FTINT ;INTEGER
CALL CCIINT ;GET THE VALUE
SKIPE CC.MWA ;ALLOWED TO CHANGE IT?
MOVEM T1,CC.LFF ;UPDATE FOR READERS IF SO
RET ;TRY THE NEXT ONE
SFLWRP: ASSUME FT.WRP,.FTINT ;INTEGER
CALL CCIINT ;GET THE VALUE
SKIPE CC.MWA ;ALLOWED TO CHANGE IT?
CAMN T1,CC.WRP ;CHANGING IT?
RET ;SKIP OVERHEAD IF NOT
MOVEM T1,CC.WRP ;UPDATE FOR READERS IF WON
RET ;TRY THE NEXT ONE
SFLHTM: ASSUME FT.HTM,.FTINT ;INTEGER
CALL CCIINT ;GET THE VALUE
SKIPE CC.MWA ;ALLOWED TO CHANGE IT?
CAMN T1,CC.HTM ;CHANGING IT?
RET ;NO, SKIP OVERHEAD
MOVEI T3,.TOSET+.TOTAB ;SET TTY TAB
ASSUME HT.PHY&1,1
ASSUME HT.SIM&1,0
CALL STRMOP ;TRY TO CHANGE IT
MOVEM T3,CC.HTM ;UPDATE FOR READERS IF WON
RET ;TRY THE NEXT ONE
SFLVTM: ASSUME FT.VTM,.FTINT ;INTEGER
CALL CCIINT ;GET THE VALUE
SKIPE CC.MWA ;IF ALLOWED,
MOVEM T1,CC.VTM ;UPDATE FOR READERS
RET ;TRY THE NEXT ONE
SFLFFM: ASSUME FT.FFM,.FTINT ;INTEGER
CALL CCIINT ;GET THE VALUE
SKIPE CC.MWA ;IF ALLOWED
MOVEM T1,CC.FFM ;UPDATE FOR READERS
RET ;TRY THE NEXT ONE
SMHIGN: ASSUME FT.IGN,.FTBYT ;BOOLEAN
CALL CCIBYT ;GET VALUE
ANDI T1,1 ;NORMALIZE
MOVEM T1,CC.IGN ;WE DON'T REALLY DO THIS, STORE IT
RET ;TRY THE NEXT ONE
SMHCOP: ASSUME FT.COP,.FTBYT ;BOOLEAN
CALL CCIBYT ;GET THE VALUE
ANDI T1,1 ;NORMALIZE
CAMN T1,CC.COP ;IF NOT CHANGING,
RET ;DON'T BOTHER
MOVEM T1,CC.COP ;UPDATE FOR READERS
DPB T1,[POINTR CATTAB+.CHCNO,TC.DFR_TC.VLO] ;UPDATE IN MASTER BLOCK
LSH T1,<ALIGN. TC.DFR>+TC.VLO ;POSITION
TXO T1,FLD(TC.DFR,TC.MOD)!.CHCNO ;MAKE UUO ARG
MOVEI T2,.TOSCS ;SET CHARACTER STATUS
MOVE T3,TTYUDX ;FOR THIS TTY
MOVE T4,[1,,T1] ;SUB-POINTER
MOVE CX,[3,,T2] ;ARG POINTER
TRMOP. CX, ;TRY TO CHANGE IT
NOP ;ASSUME WE GOT DETACHED
RET ;TRY FOR THE NEXT ONE
SMHRAI: ASSUME FT.RAI,.FTBYT ;BOOLEAN
CALL CCIBYT ;GET THE VALUE
ANDI T1,1 ;NORMALIZE
MOVEM T1,CC.RAI ;UPDATE FOR READERS
RET ;TRY THE NEXT ONE
SMHECH: ASSUME FT.ECH,.FTBYT ;BOOLEAN
CALL CCIBYT ;GET THE VALUE
ANDI T1,1 ;NORMALIZE
CAMN T1,CC.ECH ;IF NOT CHANGING,
RET ;THEN DON'T BOTHER
MOVEI T3,.TOSET+.TOCLE ;COMMAND-LEVEL ECHOING
CALL STRMOP ;TRY AND CHANGE IT
MOVEM T3,CC.ECH ;UPDATE IT IF CHANGED
RET ;TRY THE NEXT ONE
SMHIER: ASSUME FT.IER,.FTBYT ;BOOLEAN
CALL CCIBYT ;GET THE VALUE
ANDI T1,1 ;NORMALIZE
MOVEM T1,CC.IER ;THEN DO SO
RET ;TRY THE NEXT ONE
SMHOER: ASSUME FT.OER,.FTBYT ;BOOLEAN
CALL CCIBYT ;GET THE VALUE
ANDI T1,1 ;NORMALIZE
MOVEM T1,CC.OER ;THEN DO IT
RET ;TRY THE NEXT ONE
SMHCNT: ASSUME FT.CNT,.FTINT ;INTEGER
CALL CCIINT ;GET THE VALUE
MOVEM T1,CC.CNT ;THEN UPDATE
RET ;TRY THE NEXT ONE
SMHAPE: ASSUME FT.APE,.FTBYT ;BOOLEAN
CALL CCIBYT ;GET THE VALUE
ANDI T1,1 ;NORMALIZE
MOVEM T1,CC.APE ;UPDATE IT
RET ;TRY THE NEXT ONE
;Here to handle changing character attributes
SMHCAT: ASSUME FT.CAT,.FTCCA ;BETTER MATCH
MOVEI T1,3 ;NEED THREE BYTES
CALL CCIINC ;GET AN INTEGER BY COUNT
MOVE T2,T1 ;COPY ARGUMENT
MOVE T3,T1 ;AGAIN
LSH T2,-8 ;RIGHT-JUSTIFY MODIFIER MASK
LSH T3,-^D16 ;RIGHT-JUSTIFY NEW BITS
ANDI T1,BYTMSK ;KEEP ONLY THE CHARACTER HERE
ANDI T2,BYTMSK ;AND ONLY THE MODIFIER MASK HERE
JUMPE T2,CPOPJ ;SKIP OVERHEAD IF NOT REALLY CHANGING
AND T3,T2 ;ONLY UPDATE MODIFIED BITS
MOVE T4,CC.CAT(T1) ;KEEP PREVIOUS SETTING
ANDCAM T2,CC.CAT(T1) ;MAKE ROOM FOR NEW BITS
IORB T3,CC.CAT(T1) ;UPDATE AND GET A COPY
CAMN T4,T3 ;IF NOT REALLY A CHANGE,
RET ;SKIP THE OVERHEAD
SAVE2 ;PRESERVE SOME ACS
MOVE T2,T1 ;START WITH A SIMPLE CHARACTER VALUE
TRNE T3,CA.OOB ;IF SOME OOB PROCESSING IS DESIRED,
TXO T2,TC.OOB_TC.VLO ;NOTE THAT
MOVE T4,T3 ;COPY CTERM VALUE
ANDX T4,CA.OOB ;KEEP ONLY OOB VALUE
CAIE T4,.OBHEL ;UNLESS HELLO,
TRZ T3,CA.INC ;NOT AN INCLUDED HELLO
CAIE T4,.OBNOT ;IF NOT OOB,
CAIN T4,.OBHEL ;OR A HELLO,
TXZ T3,CA.SDO ;CAN'T SET DISCARD OUTPUT
TDO T2,[0 ;(.OBNOT)
TC.CLR_TC.VLO ;(.OBCLR)
<TC.CLR!TC.DFR>_TC.VLO;(.OBDFR)
0](T4) ;(.OBHEL)
TRNE T3,CA.INC ;IF AN INCLUDED HELLO OOB,
TXO T2,TC.DFR_TC.VLO ;MARK IT
TRNN T3,CA.ENB ;ENABLE IT?
TXO T2,TC.NSA_TC.VLO ;NO, DISABLE IT
MOVE P2,T1 ;CURRENT CHARACTER TO CHANGE
MOVEI P1,CATDSP ;DISPATCH TABLE
CALL FNDFNC ;PROCESS SPECIAL CHARACTER ROUTINES
NOP ;OK IF NONE
MOVE T4,T2 ;COPY DESIRED SETTINGS MASK
XOR T4,CATTAB(P2) ;SEE WHAT WE'RE CHANGING
TXZ T4,TC.BRK_TC.VLO ;DON'T CHANGE THE BREAK STATUS
ANDX T4,TC.VAL ;DON'T HURT THE MASTER BLOCK'S MOD FIELD
AND T2,T4 ;REMEMBER WHAT WE'RE MODIFYING
ANDCAM T4,CATTAB(P2) ;MAKE ROOM FOR NEW MASTER BITS
IORB T2,CATTAB(P2) ;INSERT THEM, AND RESTORE THE CHARACTER
TXZ T2,TC.MOD ;CLEAR THIS MODIFIER SET
LSH T4,TC.MDO-TC.VLO ;POSITION FOR A MODIFY MASK
IOR T4,T2 ;MAKE INTO A SUB-BLOCK ENTRY
MOVEI T1,.TOSCS ;SET CHARACTER STATUS
MOVE T2,TTYUDX ;TTY TO AFFECT
MOVE T3,[1,,T4] ;SUB-BLOCK POINTER
MOVE CX,[3,,T1] ;ARG BLOCK POINTER
TRMOP. CX, ;CHANGE IT
NOP ;ASSUME WE GOT DETACHED
RET ;TRY THE NEXT ONE
CATDSP: CATNSA,,.CHCNA ;NEVER ENABLE THESE
CATNSA,,.CHCNB
CATNSA,,.CHCNC
CATNSA,,.CHCND
CATNSA,,.CHCNH
CATNSA,,.CHCRT
CATNSA,,.CHCNP
CATNSA,,.CHCNT
CATNSA,,.CHCNU
CATNSA,,.CHCNW
CATNSA,,.CHCNZ
CATCNO,,.CHCNO ;^O NEEDS SPECIAL TREATMENT
CATCNX,,.CHCNX ;AS DOES ^X
Z
CATNSA: TXO T2,TC.NSA_TC.VLO ;DISABLE THE CHARACTER TO SCNSER
RET ;THAT'S ALL WE REQUIRE
CATCNO: TRNN T3,CA.ENB ;ENABLING?
RET ;NO, THIS SETTING IS FINE
TXO T2,<TC.NSA!TC.OOB>_TC.VLO ;YES, MAKE IT OOB AND NON-SPECIAL
SKIPE CC.COP ;IF CONTROL-O PASSTHROUGH,
TXO T2,TC.DFR_TC.VLO ;THEN MAKE IT PASSED THROUGH AS WELL
RET ;SET IT UP THIS WAY
CATCNX: TRNN T3,CA.ENB ;ENABLING IT?
RET ;NO, THIS SETTING IS FINE
TXO T2,<TC.OOB!TC.CLR>_TC.VLO ;YES, MAKE IT A CLEAR OOB
RET ;SET IT THIS WAY
SUBTTL CTERM Protocol - Check Typeahead message
CMHCHK: CALL CCIBYT ;EAT FLAG BYTE
MOVEI T1,.CMICT ;INPUT-COUNT (RESPONSE TYPE FOR .CMCHK)
CALL CCOST2 ;PROTOCOL MESSAGE WITH ZERO FLAG BYTE
CALL TAHCNT ;GET QUEUED CHARACTER COUNT
CALL CCOINT ;SEND AS AN INTEGER
SKIPE T1 ;IF SOME IS PRESENT,
SKIPN BADBOY ;WATCH OUT FOR BLOODY VMS
PJRST CCOFIN ;NO, BIND IT OFF & SKIP-RETURN
SKIPN ICHCNT ;YES, CAN WE GIVE IT ITS CHARACTER?
JRST CMHCH1 ;NOT YET, DEFER THIS REQUEST
SAVE4 ;YES, PRESERVE IMPORTANT ACS
CALL SCNINI ;SETUP TO GET A CHARACTER
CALL SCNCHR ;DO SO
SETZ T1, ;OOPS
CALL CCOBYT ;SEND THE STUPID CHARACTER
PJRST CCOFIN ;BIND IT OFF & RETURN
CMHCH1: TXZ F,F$SYNC ;ALLOW READING
SETZM IMASK ;ONE CHARACTER ONLY IS REQUESTED
CALL TTYSST ;SETUP FOR THE READ
AOS SENSEQ ;ACCOUNT FOR THIS REQUEST
CALL FRCTTI ;DEMAND ATTENTION
RETSKP ;CLAIM SUCCESS
;HERE TO TRY TO SEND AN ANSWER FROM TTY: SERVICE
CMHCH2: CALL TAHCNT ;GET THE COUNT
JUMPE T1,CMHCH3 ;ANSWER THE MESSAGE IF NOW ZERO
SKIPN ICHCNT ;IF NO CHARACTERS AVAILABLE,
RET ;TRY AGAIN LATER
CMHCH3: SOSGE SENSEQ ;ADMIT TO SEEING THIS
SETZM SENSEQ ;DON'T LET THE COUNT GO NEGATIVE
PUSH P,T1 ;SAVE THE COUNT
MOVEI T1,.CMICT ;INPUT-COUNT MESSAGE
CALL CCOST2 ;FLAGS ARE UNDEFINED
POP P,T1 ;RESTORE THE COUNT
CALL CCOINT ;SEND IT
JUMPE T1,CMHCH4 ;NO CHARACTER IF NO COUNT
CALL SCNINI ;READY TO PEEK
CALL SCNCHR ;PEEK ONE
TDZA T1,T1 ;IT WENT AWAY?
MOVE T1,P1 ;COPY IT
CALL CCOBYT ;SHIP THE CHARACTER AS WELL
CMHCH4: CALL CCOFIN ;BIND IT OFF
NOP ;(ALWAYS SKIPS)
RET ;AND RETURN
TAHCNT: MOVE T1,[2,,T2] ;UUO ARG BLOCK
MOVEI T2,.TOTTC ;TOTAL INCOMING CHARACTERS
MOVE T3,TTYUDX ;WHICH TTY
TRMOP. T1, ;FIND HOW MANY ARE IN THE CHUNKS
SETZ T1, ;NONE IF DETACHED
ADD T1,ICHCNT ;INCLUDE THOSE WE HAD TO BUFFER
RET ;AND RETURN THE COUNT
TAHCHK: PUSHJ P,SAVT ;PRESERVE SOME ACS
PUSHJ P,TAHCNT ;COUNT UP THE TYPEAHEAD
SKIPE T1 ;ANYTHING THERE?
AOS (P) ;YES, SKIP
POPJ P, ;OR NOT
SUBTTL O/S Name table
; The rest of the program is concerned with the data tables and
;variables used by the program:
;Table OSNAME is a list of SIXBIT text names indexed by the operating
;system type as returned in the configuration message.
[ASCIZ 'unknown type of']
OSNAME: [ASCIZ 'RSTS-E'] ;OLD RSTS
[ASCIZ 'RT-11']
[ASCIZ 'RSTS/E']
[ASCIZ 'RSX-11S']
[ASCIZ 'RSX-11M']
[ASCIZ 'RSX-11D']
[ASCIZ 'IAS']
[ASCIZ 'VMS']
[ASCIZ 'TOPS-20']
[ASCIZ 'TOPS-10']
[ASCIZ 'RTS-8']
[ASCIZ 'OS-8']
[ASCIZ 'RSX-11M+']
; [ASCIZ 'COPOS/11']
[ASCIZ 'Ultrix'] ;ULTRIX insists upon returning this
[ASCIZ 'P/OS']
[ASCIZ 'VAX/Elan']
[ASCIZ 'CP/M']
[ASCIZ 'MS-DOS']
[ASCIZ 'Ultrix']
[ASCIZ 'Ultrix-11']
SUBTTL Protocal Dispatch Blocks -- RSTS
;The following are the protocol dispatch blocks for each type of operating
;system type. They defined the legal functions for each operating system.
;The format of an entry in a table is "dispatch-address,,function-key-value".
;RSSFNC is the protocol block for RSTS.
RSSFNC: RST.CT,,MT$CTL ;Control
RST.DA,,MT$DAT ;Data
Z
SUBTTL Protocal Dispatch Blocks -- RSX
;RSXFNC is the protocol block for RSX.
RSXFNC: RX.WRT,,RF.WTD ;Write Data (3)
RX.PRD,,RF.WRD ;Write-then-read (5)
RX.RED,,RF.RDD ;Read Data (4)
RX.NOP,,RF.NOP ;No-op (0)
RX.KIL,,RF.KIL ;Kill I/O (8)
RX.SSC,,RF.RSC ;Single-char input (7)
RX.SUN,,RF.UNS ;Unsolicited input (6)
RX.DIS,,RF.DIS ;Disconnect link
RX.DAT,,RF.ATT ;ATTACH/DETACH
RX.GTC,,RF.GTC ;Get terminal characteristics
RX.STC,,RF.STC ;Set terminal characteristics
Z
SUBTTL Protocal Dispatch Blocks -- VMS
;VMSFNC is the protocol block for VMS.
VMSFNC: VMS.PW,,VF.WPH ;Write
VMS.DA,,VF.WLB ;
VMS.DA,,VF.WVB ;
VMS.RA,,VF.RPH ;Read
VMS.RD,,VF.RLB ;
VMS.RD,,VF.RVB ;
VMS.PD,,VF.RPR ;Read with prompt
VMS.RA,,VF.RAL ;Readall
VMS.PA,,VF.RPA ;Readall with prompt
VMS.KI,,VF.ACC ;Kill I/O
VMS.ST,,VF.STM ;Set mode
VMS.ST,,VF.STC ;
VMS.SN,,VF.SNM ;Sense mode
VMS.SN,,VF.SNC ;
VMS.BC,,VF.BCS ;Broadcast
Z
SUBTTL PSI Initialization Block
PSIRST: PS.SON ! PSILEN ;Used to init the PSI system in one fell swoop
PS.IEA!PS.UCS ! VECBAS ;Extended addressing mode in current section
PSIRSY ;Expand the PISYS blocks
PSILEN==.-PSIRST ;Length of block for PIRST. UUO
SUBTTL Lowseg Initializers Stored in Hiseg
;HILOST is the start of a section of initializing data for the low segment.
HILOST: ;This gets BLTted to the Loseg
RELOC 0
LOLOST:
RELOC
PHASE LOLOST
SUBTTL PSI Vector
VECBAS:!
PSIVEC
SUBTTL Trace file create blocks
TRACEF: XWD $NSP,.FOWRT ;Function & channel
EXP UU.LBF!.IOASC ;ASCII mode, using large disk buffers
SIXBIT /NRTNSP/ ;Pathlogical name used
XWD TRACEB,0 ;Output only
XWD -1,0 ;Ditto
EXP .+1 ;The ENTER block
EXP .RBEXT ;Short block
EXP 0 ;Default path
EXP 0 ;File name specified by logical name
EXP 0 ;Ditto for extension
SUBTTL QUEUE. Request Block
QUEBLK: QF.RSP!FLD(.QUTIM+1,QF.HLN)!.QUMAE ;TIMED DIALOG WITH ACTDAE
EXP 0 ;LOCAL NODE
XWD UU$LEN,UNMBLK ;RESPONSE BUFFER
EXP ^D90 ;WAIT ONLY 90 SECONDS
QA.IMM!.QBAFN ;ACCOUNTING FUNCTION
EXP UGMAP$ ;MAP PPN & USERNAME
QA.IMM!.QBAET(UU$LEN+UU$MAP) ;MAPPING LIST
EXP 0,0,1 ;OVERHEAD + BLOCK COUNT
QUEPPN: BLOCK 1 ;OUR PPN GOES HERE
BLOCK UU$LEN-1 ;EXTRA OVERHEAD SPACE
QMPLEN==.-QUEBLK ;LENGTH OF REQUEST
SUBTTL NSP. Connect Block
;CONBLK, SRCPDB, DSTPDB, and SRCNAM are the prototype parts of
;NSP. argument blocks.
CONBLK: EXP .NSCUD+1 ;ENTER ACTIVE CONNECT BLOCK
EXP ASCNOD ;NODE NAME STRING BLOCK
EXP SRCPDB ;SOURCE PROCESS BLOCK
EXP DSTPDB ;DESTINATION PROCESS BLOCK
EXP USERID ;USERID STRING BLOCK
EXP PASSWD ;PASSWORD STRING BLOCK
EXP ACCOUN ;ACCOUNT STRING BLOCK
EXP USERDA ;USER DATA STRING BLOCK
SRCPDB: .NSDPN+1 ;Length of block
DEC 1 ;Format type
.OBGEN ;Object(=0)
Z ;PPN
SRCNAM ;Pointer to name block
SRCNAM: XWD ^D11,^D39/4+2 ;11 bytes, four words
ASCII8 <TOPS-10 NRT>
BLOCK ^D39/4+2-<.-SRCNAM> ;SPACE FOR REAL USERNAME
;TOBUF is the header for the terminal output buffer.
TOFLGS: BLOCK 1 ;Flags to include when buffer queued
BUFQUO: EXP OUTQUO ;Number of output buffers which can be queued
TOBUF: BLOCK 3 ;Used by us
TOBFH: BLOCK 3 ;Used by OUT UUO
TOQUE: BLOCK 1 ;Output buffer queue
;Used by INOBUF to limit the size of a network buffer
SNDMMS: EXP NRTMMS ;Maximum message size we're allowed to send
;PRCERF is the flag to avoid printing multiple protocol error messages
PRCERF: EXP -1 ;Protocol error detection flag
;Some initial characteristic default values
CC.MWA: 1 ;Mode writing allowed
CC.EMG: 1 ;Enter Management Guaranteed
CC.EME: 1 ;Enter Management Enabled
;The 'previous' Write flags
WRTFLG: WR.EOM
;SWTSEA is the argument block for setting the switch sequence
SWTSEA: EXP .TOSWI+.TOSET
SWTUDX: BLOCK 1 ;For fast access
SWTSEQ: -1 ;The 8-bit sequence
;HPSTRM is the argument block for the maintenance of horizontal position data
HPSTRM: EXP .TOHPS+.TOSET
HPSUDX: BLOCK 1 ;For fast access
HPOS: EXP Z ;The position
;ECCTRM is for checking if characters are pending to be echoed.
ECCTRM: EXP .TOECC
ECCUDX: BLOCK 1
;BKCTRM is for obtaining the count of break characters in the input buffer
BKCTRM: EXP .TOBKC
BKCUDX: BLOCK 1
;PAGTRM is for checking the setting of the page bit.
PAGTRM: EXP .TOPAG
PAGUDX: BLOCK 1
;CTOTRM is used to check the ^O bit; CTOTRS is for setting the ^O bit.
CTOTRM: EXP .TOOSU
CTOUDX: BLOCK 1
CTOTRS: EXP .TOOSU+.TOSET
COSUDX: BLOCK 1
COSVAL: BLOCK 1
;BINTRM is used to output binary characters
BINTRM: EXP .TOOIC
BINUDX: BLOCK 1
BINCHR: BLOCK 1
;BMASK is the default (TOPS-10) break mask.
BMASK: EXP ^D255 ;Field size
BRKMSK <CGJKLZ[>
;TTYBLK is the OPEN block for device TT:.
TTYBLK: Z
SIXBIT 'TT'
TOBFH,,TIBUF
;TTYSAV is the table of TTY: characteristics to be saved on entering NRT
;and restored later.
TTYSAV: ;Start of table of saved TTY: chars.
TRMCHR QOT
TRMCHR ESC
TRMCHR UNP
TRMCHR BKA
TRMCHR LCT ;Lower case
TRMCHR NFC ;Free <CR>
TRMCHR CLE ;Command-level echoing
TRMCHR WID ;Width
TRMCHR LNB ;Page size
TRMCHR SSZ ;Stop size
TRMCHR STO ;Stop at end of page
TRMCHR SST ;Stop only at end of page
TRMCHR DIS ;Display bit
TRMCHR BLK ;Blanks
TRMCHR XNF ;XON/XOFF bit
TRMCHR FRM ;Literal FF/VT
TRMCHR 8BT ;Eight-bit terminal
TRMCHR TAB ;Hardware tabs
TSVNUM==.-TTYSAV ;Number of characteristics
Z ;For SETTT1
;TTYSET is a table of terminal characterstics which NRT wishes to
;be set a particular way while it runs. Entries in TTYSET should also
;be in TTYSAV.
TTYSET: TRMCHR QOT,0,ST
TRMCHR ESC,.CHESC,ST
TRMCHR UNP,.CHCNQ,ST
TRMCHR SST,1,ST
TRMCHR BLK,0,ST
Z
CTMSET: TRMCHR FRM,1,CT
TRMCHR NFC,1,CT
Z
SUBTTL Special stuff for VAX
;VMTTCH is storage for VMS terminal characteristics. The default
;type of terminal we set is a TTY:.
VMTTCH: <BYTE (8)0,0,DT$TTY,DC$TERM>_-4
Z
Z
SUBTTL NSP. UUO DSTPDB Block
DSTPDB: .NSDOB+1 ;Length of block
DEC 0 ;FORMAT TYPE
.OBHTH ;OBJECT NUMBER OF NRT SERVER
SUBTTL Configuration & Control Messages
;Each of the following messages is preceded by its length
DEFINE NETMSG (LENGTH,STRING)<
EXP LENGTH
BYTE (8) STRING
>
RST$CF: NETMSG ^D10,<MT$CFG,^D10,0,O.T10,0,0,0,0,0,0> ;RSTS CONFIG MSG
RST$UN: NETMSG 5,<MT$DAT,5,0,1,.CHCNZ>
RSX$CF: NETMSG ^D42,<RF.SSD,1,0,0,O.T10,0,2,0,^D132,0,
RC.VER,1,
RC.TBL,^D255,
RC.CCT,1,
RC.SCI,1,
RC.WBT,1,
RC.CAO,1,
RC.RNE,1,
RC.RTC,1,
RC.CRT,1,
RC.RIL,1,
RC.RWB,1,
RC.UNS,1,
RC.SCX,1,
RC.RTT,1,
RC.RTM,1,
RC.CUR,0> ;No cursor addressing
RSX$UN: NETMSG 4,<RF.ECR,0,0,RE.SAR>
;This defaults to version 3 protocol. It will be changed accordingly
VMS$CF: NETMSG 24,<1,1,1,0,11,0,4,0,DC$TERM,DT$TTY,0,0,200,0,0,0,0,0,0,0>
VMS$UN: NETMSG 4,<VR.ATT,377,RA.UNS,0>
SUBTTL Special stuff for RSX
;RXCHTB is storage for the RSX terminal characteristics.
RXCHTB: BLOCK RC.MAX ;Terminal characteristics table
SUBTTL Management mode aids
CTLMSK <@CGHIJKLMOQSUZ>
ECHSTD==...BRK ;These don't echo correctly in CA.STD
CTLMSK <@ABCDEFKLNOPQRSTUVWXYZ[\]^_>
ECHSLF==...BRK ;These don't echo correctly in CA.SLF
TRMCAT: EXP .TOSCS ;Set character status (attributes)
CATUDX: BLOCK 1 ;TTY: to hack (for fast access)
^D256,,CATTAB ;Set them from here
CTLMSK <ABCDHMPRTWZ> ;Disable these
CATTAB:
ZZ==0 ;Start with NUL
REPEAT ^D256,<
<TC.CLR!TC.DFR!TC.OOB!TC.NSA!TC.BRK>_TC.MDO!ZZ !
IFN ...BRK&1B<ZZ>,<TC.NSA_TC.VLO>
ZZ==ZZ+1
>
SUBTTL Characteristics
CC.CSZ: EXP 8 ;CHARACTER SIZE
CC.CPE: EXP 0 ;CHARACTER PARITY ENABLED
CC.CPT: EXP PAR.SP ;CHARACTER PARITY TYPE
CC.IER: EXP 1 ;INPUT ESCAPE RECOGNITION
CC.OER: EXP 1 ;OUTPUT ESCAPE RECOGNITION
CC.CNT: EXP CN.NON ;AUTO-INPUT 'COUNT' STATE
CC.IFC: EXP 1 ;INPUT FLOW CONTROL (YES)
CC.LNE: EXP 1 ;LOSS NOTIFICATION ENABLED (YES)
CC.CRF: EXP 0 ;CR FILL
CC.LFF: EXP 0 ;LF FILL
CC.CAT: REPEAT ^D256,< ;CTERM CHARACTER ATTRIBUTES
EXP CA.STD!CA.ENB>
CTXBLK: FLD(.CTDBA+1,CT.LEN)!FLD(.CTSVH,CT.FNC)
^D20
IFIW CTXBUF
CTXBUF: BLOCK ^D20
SUBTTL Break mask blocks
;LEDTRM and LEDUDX are used to check to see if, during type-ahead,
;the user typed some line editing characters.
LEDTRM: .TOSBS ;Set break mask
LEDUDX: BLOCK 1 ;UDX
^D255 ;Mask size
LEDCAT: .TOSCS ;Set character status
LEDCUX: BLOCK 1 ;UDX
400,,LEDTAB ;Characteristics to set
LEDTAB: ZZ==0
REPEAT 400,<
EXP TC.BRK_TC.MDO!ZZ!
IFN <ZZ-.CHCNR>!<ZZ-.CHCNU>!<ZZ-.CHDEL>,<TC.BRK!TC.NSA_TC.VLO!TC.NSA_TC.MDO>
ZZ==ZZ+1
>
;Break mask
TRMBKS: EXP .TOSBS ;Set the break set
TTYUDX: BLOCK 1 ;Storage for UDX of my TTY
FALL IMASK
IMASK: BLOCK 9 ;For break Mask
ENDMSK==.-1
FALL LMASK ;***THESE MUST BE CONTIGUOUS***(RX.SCS)
LMASK: BLOCK 8 ;"Local" or "logical" break mask
ELMASK==.-1
SUBTTL Other initial data
OBJCNT: EXP -1 ;Start with the CTERM object
LICHCT: EXP -1 ;No match on last in count for timer logic
INTLVL: EXP -1 ;Interrupt level is available
INTOWN: EXP 0 ;Who last got interlock
LOLOND:
DEPHASE
SUBTTL Useful break masks
;Default break masks:
;VXDMSK is the VAX default break mask.
VXDMSK: ^D255
BRKMSK <ABCDEFGMNOPQRSTUVWXYZ[\]^_>,,<@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_>
;RXDMSK is the default RSX break mask.
RXDMSK: ^D255
BRKMSK <CGJMNZ[\]^_>,,<@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_>
;RSTDMK is the default RSTS break mask
RSTDMK: ^D130
BRKMSK <CJMOTYZ[>,,<@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_>
;UNVBKS is the architecturally-defined CTERM default break mask
UNVBKS: BRKMSK <@ABCDEFGJKLMNOPQSTVXYZ[\]^_>,,
<@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_>
;VMSBKS is the VMS V4 default break mask
VMSBKS: BRKMSK <BCMYZ[>,,<@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_>
SUBTTL Terminal information tables
;The next set of tables are TTY: type tables. This is so we can
;pass intelligently the type of terminal we are to the remote host.
;The index into each table should yield the corresponding terminal
;type for the appropriate operating system.
;TTPTB is the TOPS-10 version of the table.
TTPTBH: SIXBIT/LA120/ ;Type LA120
SIXBIT/LA12/ ;Type LA12
SIXBIT/LA100/ ;Type LA100
SIXBIT/LA36/
SIXBIT/LA34/
SIXBIT/LA38/
SIXBIT/LQP02/
SIXBIT/TTY/
TTPTB: SIXBIT/VT52/ ;Type VT52
SIXBIT/VT100/ ;Type VT100
SIXBIT/VT61/ ;Type VT61
SIXBIT/VT55/ ;Type VT55
SIXBIT/VT102/ ;Type VT102
SIXBIT/VT101/ ;Type VT101
SIXBIT/VT131/ ;Type VT131
SIXBIT/VT132/ ;Type VT132
SIXBIT/VT125/ ;Type VT125
SIXBIT/VT103/ ;Type VT103
SIXBIT/VT180/ ;Type VT180
SIXBIT/VT185/ ;Type VT185
SIXBIT/VT220/
SIXBIT/VT240/
SIXBIT/VT241/
SIXBIT/VT200/
SIXBIT/VT300/
SIXBIT/VT320/
SIXBIT/VT330/
SIXBIT/VT340/
TTPLEN==.-TTPTB
TTHLEN==.-TTPTBH
TTHOFS==TTPLEN-TTHLEN
;VTPTB is the VMS terminal type table.
;VMS corresponding types (must be same order)
;Left half is the high order byte of the TT2 characteristics, or the
;DEC/ANSI CRT byte
VTPTBH: VTTCHR (0,L120)
VTTCHR (0,LA12)
VTTCHR (0,L100)
VTTCHR (0,L36)
VTTCHR (0,L34)
VTTCHR (0,L38)
VTTCHR (0,LQP)
VTTCHR (0,TTY)
VTPTB: VTTCHR (0,V52) ;VT52
VTTCHR (<T2ACRT!T2DCRT>,V100) ;VT100
VTTCHR (0,V5X) ;VT%x
VTTCHR (0,V55) ;VT55
VTTCHR (<T2ACRT!T2DCRT!T2AVO!T2PPO!T2EDIT>,102)
VTTCHR (<T2ACRT!T2DCRT>,101)
VTTCHR (<T2ACRT!T2DCRT!T2AVO!T2EDIT!T2BLOK>,V131)
VTTCHR (<T2ACRT!T2DCRT!T2AVO!T2EDIT!T2BLOK>,132)
VTTCHR (<T2ACRT!T2DCRT!T2AVO!T2PPO!T2SIXL!T2RGIS>,V125)
VTTCHR (<T2ACRT!T2DCRT!T2AVO!T2EDIT>,102)
VTTCHR (<T2ACRT!T2DCRT!T2AVO>,V100)
VTTCHR (<T2ACRT!T2DCRT!T2AVO!T2PPO!T2SIXL!T2RGIS>,V125)
VTTCHR (<T2ACRT!T2DCRT!T2DCR2!T2AVO!T2EDIT>,V200)
VTTCHR (<T2ACRT!T2DCRT!T2DCR2!T2AVO!T2EDIT!T2RGIS!T2SIXL>,V200)
VTTCHR (<T2ACRT!T2DCRT!T2DCR2!T2AVO!T2EDIT!T2RGIS!T2SIXL>,V200)
VTTCHR (<T2ACRT!T2DCRT!T2DCR2!T2AVO!T2EDIT>,V200)
VTTCHR (<T2ACRT!T2DCRT!T2DCR2!T2AVO!T2EDIT!T2RGIS!T2SIXL>,V300)
VTTCHR (<T2ACRT!T2DCRT!T2DCR2!T2AVO!T2EDIT!T2RGIS!T2SIXL>,V300)
VTTCHR (<T2ACRT!T2DCRT!T2DCR2!T2AVO!T2EDIT!T2RGIS!T2SIXL>,V300)
VTTCHR (<T2ACRT!T2DCRT!T2DCR2!T2AVO!T2EDIT!T2RGIS!T2SIXL>,V300)
IFN <.-VTPTB-TTPLEN>!<.-VTPTBH-TTHLEN>,<
PRINTX %Incorrect number of VAX terminal types
>
;RTPTB is the RSX terminal type table
RTPTB: RXV52 ;VT52
RXV100 ;VT100
RXV61 ;VT61
RXV55 ;VT55
RXV102 ;VT102
RXV101 ;VT101
RXV131 ;VT131
RXV132 ;VT132
RXV125 ;VT125
RXV102 ;VT103
RXV100 ;VT180
RXV125 ;VT185
RXV102 ;VT220
RXV125 ;VT240
RXV125 ;VT241
RXV102 ;VT200
RXV102 ;VT300
RXV102 ;VT320
RXV125 ;VT330
RXV125 ;VT340
IFN <.-RTPTB-TTPLEN>,<
PRINTX %Incorrect # of RSX terminal types
>
;RXTRMP is the table of TRMOP. functions to do (including .TOSET) for
;SET TERMINAL CHARACTERISTICS messages.
;Bit 0 in the left half indicates that the value should be complemented
;before doing the TRMOP.
RXTRMP:
Z ;Zero (undefined)
REPEAT ^D15,<
Z ;1-15 undefined
>
400000,,.TOSET+.TOLCT ;Lower case
.TOSET+.TOFRM ;Form feed
.TOSET+.TOTAB ;Tab
Z ;Handled by F$NEC
Z ;Can't change baud rate
Z ;Can't change baud rate
.TOSET+.TOTRM ;Terminal type
.TOSET+.TODIS ;Display bit
Z ;Handled by F$PALL
.TOSET+.TOSTP ;XON/XOFF done
.TOSET+.TOFLC ;Fill class (horizontal)
.TOSET+.TOFLC ;Fill class (vertical)
.TOSET+.TOPSZ ;Page size
Z ;Enable/disable type-ahead (can't do)
Z ;Handled separately
Z ;Eight bit ascii
Z ;Can't be changed
Z ;Can't be changed
Z ;Control-C flush (always on)
Z ;Full duplex (always on)
Z ;Local GAG (can't do)
Z ;Read type-ahead
Z ;Enable lowercase output
Z ;Force lowercase input
;QUOTBL is the link quota and percentage goal table, indexed by
;TTY: baud rate. The left half of each entry is the percentage to allocate
;for input; the right half is the goal.
QUOTBL: -1 ;Default
-1 ;Assume 50 is really 19.2K
^D7,,0 ;75 BAUD
^D7,,0 ;110 BAUD
^D7,,0 ;134.5 BAUD
^D15,,0 ;150 BAUD
^D15,,1 ;200 BAUD
^D15,,1 ;300 BAUD
^D22,,1 ;600 BAUD
^D22,,2 ;1200 BAUD
^D30,,2 ;1800 BAUD
^D40,,3 ;2400 BAUD
QUOMAX==.-QUOTBL ;4800 and 9600 at MAX
;SEGTBL is the segment size table, also based on baud rate.
SEGTBL: 0 ;Default
0 ;Assume 50 is really 19.2K
^D30 ;75
^D30 ;110
^D30 ;134.5
^D30 ;150
^D30 ;200
^D30 ;300
^D60 ;600
^D60 ;1200
^D100 ;1800
^D100 ;2400
SEGMAX==.-SEGTBL ;Above 2400, use default
SPDTBL: DEC 0,19200,75,110,135,150,200,300,600,1200,1800,2400,4800,
9600,19200,-1
SUBTTL Terminal strings for <RUB>
;RUBS1 is the rubout string table, indexed by terminal type (same as
;the terminal type tables above).
RUBS1: [BYTE (7)^D8,40,^D8] ;VT52: <BSP><SP><BSP>
[BYTE (7)^D8,40,^D8] ;VT100: <BSP><SP><BSP>
[BYTE (7)^D8,40,^D8] ;VT61: <BSP><SP><BSP>
[BYTE (7)^D8,40,^D8] ;VT55: <BSP><SP><BSP>
[BYTE (7)^D8,40,^D8] ;VT102: <BSP><SP><BSP>
[BYTE (7)^D8,40,^D8] ;VT101: <BSP><SP><BSP>
[BYTE (7)^D8,40,^D8] ;VT131: <BSP><SP><BSP>
[BYTE (7)^D8,40,^D8] ;VT132: <BSP><SP><BSP>
[BYTE (7)^D8,40,^D8] ;VT125: <BSP><SP><BSP>
[BYTE (7)^D8,40,^D8] ;VT103: <BSP><SP><BSP>
[BYTE (7)^D8,40,^D8] ;VT180 <BSP><SP><BSP>
[BYTE (7)^D8,40,^D8] ;VT185 <BSP><SP><BSP>
[BYTE (7)^D8,40,^D8] ;VT220 <BSP><SP><BSP>
[BYTE (7)^D8,40,^D8] ;VT240 <BSP><SP><BSP>
[BYTE (7)^D8,40,^D8] ;VT241 <BSP><SP><BSP>
[BYTE (7)^D8,40,^D8] ;VT200 <BSP><SP><BSP>
[BYTE (7)^D8,40,^D8] ;VT300 <BSP><SP><BSP>
[BYTE (7)^D8,40,^D8] ;VT320 <BSP><SP><BSP>
[BYTE (7)^D8,40,^D8] ;VT330 <BSP><SP><BSP>
[BYTE (7)^D8,40,^D8] ;VT340 <BSP><SP><BSP>
IFN .-RUBS1-TTPLEN,<
PRINTX %Number of rubout strings doesn't match number of types
>
SUBTTL STORAGE
RELOC LOLOND+1 ;THIS STUFF MUST BE IN THE LOW SEG
FSTZER:!
IBFCNT: BLOCK 1 ;Count of bytes input
IBFPTR: BLOCK 1 ;Byte pointer to data
OBFCTR: BLOCK 1 ;Count of bytes left in buffer
OBFPTR: BLOCK 1 ;Pointer to next byte in buffer
;Here are the volitile NSP. blocks:
ASCNOD: BLOCK 3 ;NODE NAME
USERID: BLOCK 10 ;USER-ID
PASSWD: BLOCK 10 ;PASSWORD
ACCOUN: BLOCK 10 ;ACCOUNT
USERDA: BLOCK 10 ;USER DATA
NSPECD: BLOCK 1 ;ERROR CODE FOR SETNER
LSTCHR: BLOCK 1 ;Storage for last character just typed
LSTINP: BLOCK 1 ;Last character read
LSTPTR: BLOCK 1 ;Byte pointer to LSTINP in its buffer
LSTBUF: BLOCK 1 ;Address of buffer to find LSTINP
TRMLEN: BLOCK 1 ;Terminator length
INPCHR: BLOCK 1 ;Saved TTY input Character
TIBUF: BLOCK 3 ;TTY input buffer header
CHPBUF: BLOCK 1 ;Number of characters in buffer
BUFCHR: BLOCK 1 ;LH(byte pointer),,#words in buffer
LASTT2: BLOCK 1 ;Pointer to last word in buffer indexed by T2
ICHCNT: BLOCK 1 ;Number of characters available
;LICHCT: BLOCK 1 ;Remember value of ICHCNT
INPQUE: BLOCK 1 ;Pointer to input blocks
PRTUSD: BLOCK 1 ;PROTOCOL TYPE USED FOR THIS CONNECT
PROTMD: BLOCK 1 ;Protocol modifier
OSTYPE: BLOCK 1 ;What kind of system is this?
OSJMP:! ;PROTOCOL-SPECIFIC DISPATCH VECTOR
OSECH: BLOCK 1 ;ROUTINE FOR SPECIAL ECHO HANDLING
OSVID: BLOCK 1 ;ROUTINE FOR SPECIAL VIDEO RUBOUT HANDLING
OSDAT: BLOCK 1 ;Routine to handle ATTACH/DETACH for this OS
OSTTY: BLOCK 1 ;Routine to handle TTY input for this OS
OSOOB: BLOCK 1 ;ROUTINE TO SERVICE OUT-OF-BAND CHARACTERS
OSNET: BLOCK 1 ;Routine to handle network input for this OS
OSINI: BLOCK 1 ;ROUTINE TO INITIALIZE THIS PROTOCOL SERVICE
OSTMR: BLOCK 1 ;TIMER TRAP PROCESSOR (WHEN ENABLED)
OSSET: BLOCK 1 ;SETTT1 TABLE TO INVOKE AT RETURN FROM MONITO/C
TMRSEQ: BLOCK 1 ;IDENTIFIER FOR REQUEST BEING TIMED
REMVER: BLOCK 1 ;REMOTE'S PROTOCOL VERSION
REMECO: BLOCK 1 ;REMOTE'S PROTOCOL ECO
REMMOD: BLOCK 1 ;AND MOD LEVEL
REMREV: BLOCK 2 ;REVISION STRING (8 BYTES)
PRTYPE: BLOCK 1 ;PROTOCOLS-SUPPORTED MASK
REMLIN: BLOCK 1 ;REMOTE'S TTY NUMBER
REMOPT: BLOCK 1 ;REMOTE'S OPTIONS BYTE
CTHREV: BLOCK 2 ;OUR REVISION STRING (FROM COMMON)
MSGNUM: BLOCK 1 ;MESSAGE NUMBER FOR CTERM
RCMVER: BLOCK 1 ;REMOTE'S CTERM VERSION,
RCMECO: BLOCK 1 ; ECO LEVEL,
RCMMOD: BLOCK 1 ; MOD NUMBER,
RCMREV: BLOCK 2 ;AND REVISION STRING
RCMSUP: BLOCK 1 ;REMOTE'S SUPPORTED MESSAGE TYPES
RDACTV: BLOCK 1 ;READ-ACTIVE FLAG FOR TTY: SERVICE
SRDIBS: BLOCK 1 ;INPUT BUFFER SIZE FOR THIS START-READ
SRDTMO: BLOCK 1 ;TIMEOUT VALUE FOR THIS START-READ
SRDEOD: BLOCK 1 ;END-OF-DATA VALUE FOR THIS START-READ
SRDEOP: BLOCK 1 ;END-OF-PROMPT VALUE FOR THIS START-READ
SRDDSP: BLOCK 1 ;START-OF-DISPLAY FOR THIS START-READ
SRDLWM: BLOCK 1 ;LOW-WATER-MARK FOR THIS START-READ
SRDFL1: BLOCK 1 ;FLAGS WORD FOR START-READ
SRDFL2: BLOCK 1 ;EXTRA FLAGS BYTE FOR START-READ
WRTPRE: BLOCK 1 ;PREFIX VALUE FOR THIS WRITE-DATA
WRTPST: BLOCK 1 ;POSTFIX VALUE FOR THIS WRITE-DATA
WRTLOK: BLOCK 1 ;WRITE IS LOCKING OUT READS
WRTLOS: BLOCK 1 ;OUTPUT WAS LOST DUE TO ^O
REDISP: BLOCK 1 ;NEED TO REDISPLAY (.WRLUR DONE)
ESCOUT: BLOCK 1 ;CURRENT RULE IF OUTPUTTING ESCAPE SEQUENCE
CCOBUF: BLOCK OBUFSZ ;SPACE FOR OUTGOING CTERM MESSAGES
CCOCNT: BLOCK 1 ;COUNTDOWN WORD FOR STORING INTO CCOBUF
CCOLIM: BLOCK 1 ;CHECK FOR STORAGE SIGNIFICANCE (SEE CCOFIN)
CCOPTR: BLOCK 1 ;IDPB POINTER TO CCOBUF
CCOMMS: BLOCK 1 ;MAXIMUM AMOUNT TO STORE IN CCOBUF
CHRCUR: BLOCK 2 ;CURRENT CHARACTERISTIC BEING READ
CC.RSP: BLOCK 1 ;RECEIVE SPEED
CC.TSP: BLOCK 1 ;TRANSMIT SPEED
CC.ABR:!
CC.MSP: BLOCK 1 ;MODEM SIGNALS PRESENT (DATASET)
CC.8BC: BLOCK 1 ;EIGHTH BIT CLEARED
CC.TTN: BLOCK 1 ;NETWORK TTY NAME
CC.OFC: BLOCK 1 ;OUTPUT FLOW CONTROL [TTY XONOFF]
CC.OPS: BLOCK 1 ;OUTPUT PAGE STOP [TTY STOP]
CC.FCP: BLOCK 1 ;FLOW CHARACTER PASSTHROUGH
CC.WID: BLOCK 1 ;CARRIAGE WIDTH
CC.LEN: BLOCK 1 ;FORMS LENGTH
CC.SSZ: BLOCK 1 ;STOP LENGTH
CC.WRP: BLOCK 1 ;WRAP
CC.HTM: BLOCK 1 ;TAB MODE
CC.VTM: BLOCK 1 ;VT MODE
CC.FFM: BLOCK 1 ;FF MODE
CC.IGN: BLOCK 1 ;IGNORE INPUT
CC.COP: BLOCK 1 ;CONTROL-O PASS-THROUGH
CC.RAI: BLOCK 1 ;TTY UC
CC.ECH: BLOCK 1 ;TTY ECHO (.TOCLE)
TAHLST: BLOCK 1 ;STORAGE TO IMPLEMENT CC.CNT
CC.APE: BLOCK 1 ;AUTO-PROMPT ENABLED
CC.EPM: BLOCK 1 ;ERROR PROCESSING MASK
TTDISP: BLOCK 1 ;TTY IS A DISPLAY
TTKNOW: BLOCK 1 ;TTY NAME IS KNOWN BY THE MONITOR
TTTYPE: BLOCK 1 ;REAL TTY TYPE AS KNOWN BY MONITOR
TTATTR: BLOCK 1 ;LDBATR WORD
TTATR2: BLOCK 1 ;SECOND ATTRIBUTES WORD
BADBOY: BLOCK 1 ;FLAG FOR INCOMPATIBLE PROTOCOL
BADECH: BLOCK 1 ;BAD PROTOCOL FOR ECHOING
SWSEQN: BLOCK 1 ;COUNT OF MANAGEMENT COMMANDS TO PROCESS
OOBPTR: BLOCK 1 ;STORAGE POINTER FOR OOB CHARS
OOBCUR: BLOCK 1 ;CURRENT STORAGE BLOCK FOR OOB CHARS
OOBCNT: BLOCK 1 ;COUNTDOWN FOR STORAGE OF OOB CHARS
OOBAVL: BLOCK 1 ;TOTAL QUEUED OOB CHARS
OOBIPT: BLOCK 1 ;INPUT RETRIEVAL POINTER FOR OOB CHARS
OOBICT: BLOCK 1 ;RETRIEVAL COUNTDOWN FOR THIS OOB BUFFER
OOBHDR: BLOCK 1 ;POINTER TO OOB BUFFER CHAIN
;The interrupt level database interlock
SLPFLG: BLOCK 1 ;Flag, set to 1 if we're sleeping
;for output to complete
;The TTY interrupts which have been requested. Zero on exit from TTY: service
;IOR requested conditions in when an interrupt is deferred.
TTYSTS: BLOCK 1
;These are the fake buffers that are used by NSPIN and NSPOUT.
OTPBUF: BLOCK 1 ;Pointer to output buffer
;Note that sign bit set means DON'T set EOM
OUTQUE: BLOCK 1 ;Pointer to the output queue
INPBUF: BLOCK BFLEN ;Network input data
IFN FTEPMR,<
RNODE: BLOCK MAXPMR+1 ;Remote node ID
LNODE: BLOCK 1 ;Fast access to real destination node
NODCNT: BLOCK 1 ;Count of number of nodes in string
PMRCNT: BLOCK 1 ;Storage for length of string
PMRMSG: BLOCK MAXPMR+5 ;For the PMR connect string
SAVPMR: BLOCK 1 ;Saved byte pointer for PMR object
SAVPMC: BLOCK 1 ;Saved string length
> ;End IFN FTEPMR
IFE FTEPMR,<
LNODE:!
RNODE: BLOCK 1 ;Remote node name
>
;OBJCNT: BLOCK 1 ;Count of protocol levels tried
OBJFRC: BLOCK 1 ;Flag to disallow scanning for an object
CHRTAB: BLOCK <^D256/^D32> ;Special character table
TTYTYP: BLOCK 1 ;Index into TTY: type tables
OBMASK: BLOCK 2 ;Out of band include & exclude masks
;(VMS)
XSPCNT: BLOCK 1 ;Count of ^Cs in buffer to skip
XSCREQ: BLOCK 1 ;Pointer to request block for Read Single Characters (RSX)
XUNREQ: BLOCK 1 ;Pointer to request block for Unsolicited input (RSX)
BRKCHR: ;(LH) Char to be considered as "break" char
BRKSIZ: BLOCK 1 ;(RH) Size of break string (VMS escape seq.)
CBMASK: BLOCK 8 ;CTERM BREAK MASK BLOCK
CURCHR: BLOCK 1 ;CURRENT CHARACTERISTIC IN CMHRCH
TRNBLK: BLOCK 6 ;Space for CHTRN. UUO arg block
TRNWRD: BLOCK 1 ;Word for CHTRN. to write (ARNGE hates ACs)
UNMBLK: BLOCK UU$LEN ;QUEUE. RESPONSE BUFFER
DSKSAV: BLOCK 1 ;For SWITCH.INI processing
REQCTO: BLOCK 1 ;REQUESTED OUTPUT-DISCARD STATE
CURCTO: BLOCK 1 ;ACTUAL CURRENT OUTPUT-DISCARD STATE
READQ: BLOCK 1 ;Pointer to queued reads for VAX, RSX, CTERM
READQT: BLOCK 1 ;Tail of read queue (for CTERM)
SENSEQ: BLOCK 1 ;Queued Sense Request (VAX)
RSXSVF: BLOCK 1 ;Saved F for RSX (Control-O)
UNSCNT: BLOCK 1 ;Unsolicted count (VAX, really full word flag)
RULE: BLOCK 1 ;Current rule number for ANSI escape sequences
FTRACE: BLOCK 1 ;Trace active flag
TRACEB: BLOCK 3 ;Buffer ring header for trace file
VPOS: BLOCK 1 ;For tracking vertical position
WRVPOS: BLOCK 1 ;Starting value of VPOS for writes
WRHPOS: BLOCK 1 ;Starting value of HPOS for writes
LSTZER==.-1 ;End of Zeroable low segment
NOTICH: BLOCK 1 ;Notification string
CTLTTY: BLOCK 1 ;IONDX for controlling TTY:
NODBLK: BLOCK .DNNMS+1 ;For DNET. UUO
CC.SW1: BLOCK 1 ;Switch character one
CC.SW2: BLOCK 1 ;Switch character two
RSTFLG: BLOCK 1 ;RESTART flag
TTBAUD: BLOCK 1 ;BAUD rate code for controlling TTY:
DSKHDR: BLOCK .BFCNT+1 ;Block for SWITCH.INI input
SUBTTL Low segment for core manager
FRELST: BLOCK 1 ;Pointer to linked list of free blocks
SUBTTL Low segment AC blocks and PDLs
PDL: BLOCK PDLLEN ;Non-interrupt PDL
NSPPDL: BLOCK PDLLEN ;NSP interrupt PDL
TTYPDL: BLOCK PDLLEN ;TTY: service PDL
OOBPDL: BLOCK PDLLEN ;OOB service PDL
TMRPDL: BLOCK PDLLEN ;Timer service PDL
NSPACS: BLOCK 20 ;For NSP.'s ACs
TTYACS: BLOCK 20 ;TTY: service ACs
OOBACS: BLOCK 20 ;OOB service ACs
TMRACS: BLOCK 20 ;Timer trap ACs
ERRACS: BLOCK 20 ;For DOERR
CRSACS: BLOCK 20 ;For crash ACs
CRSPDL: BLOCK 10 ;For resetting things
PSISAV: BLOCK PSILEN ;For PISAV. in ERRTRP
SUBTTL End of Program
LOWEND: ;Label the start of freecore
RELOC ;Back to hiseg
LITS: ;Label the literal pool
END GO