Trailing-Edge
-
PDP-10 Archives
-
TOPS-20_V6.1_DECnetDistr_7-23-85
-
decnet-sources/server.mac
There are 11 other files named server.mac in the archive. Click here to see a list.
; UPD ID= 146, SNARK:<6.1.UTILITIES>SERVER.MAC.23, 19-Jun-85 22:31:00 by MELOHN
; UPD ID= 129, SNARK:<6.1.UTILITIES>SERVER.MAC.22, 23-May-85 16:53:19 by MELOHN
;Change message supported fields to not support 0,
;Set speed on indeterminate lines to 9600 for VMS,
;correctly initialize terminal width, wrap, length, and page mode.
; UPD ID= 123, SNARK:<6.1.UTILITIES>SERVER.MAC.21, 3-May-85 22:20:53 by GLINDELL
; More work on PMR
; UPD ID= 122, SNARK:<6.1.UTILITIES>SERVER.MAC.20, 3-May-85 20:22:34 by GLINDELL
; Change FTPMR default to be OFF
; UPD ID= 121, SNARK:<6.1.UTILITIES>SERVER.MAC.19, 3-May-85 20:15:47 by GLINDELL
; Support poor mans routing - use CTDNCN (DNCONN for CTERM-SERVER)
; UPD ID= 112, SNARK:<6.1.UTILITIES>SERVER.MAC.18, 9-Apr-85 19:45:57 by MELOHN
; Fix from last edit - make normal echo BIN% terminator work properly.
; UPD ID= 110, SNARK:<6.1.UTILITIES>SERVER.MAC.17, 4-Apr-85 14:36:45 by MELOHN
; Fix input count routine to not echo the BIN% to get the first waiting char.
; Add cell TRMFLG, set when TEXTI% has echoed a terminator when echo terminator
; was disabled. In this case, we attempt to throw away the next write message
; in the hope that it was echoing the terminator that we have already echoed.
; UPD ID= 109, SNARK:<6.1.UTILITIES>SERVER.MAC.16, 29-Mar-85 15:45:01 by MELOHN
; Clean up stuff from the last edit. If QUIET, try NRT on illegal nodenames.
; UPD ID= 107, SNARK:<6.1.UTILITIES>SERVER.MAC.10, 28-Mar-85 22:57:33 by MELOHN
; Add routine to set the program name to the name of the connected node.
; Add QUIET cell to keep server connection/error msgs to a mimimum(default OFF)
; Make error msgs returned to users identify CTERM-SERVER as the source of err.
; Remove timout on initial connect since 6.1 systems will do it for us.
; UPD ID= 98, SNARK:<6.1.UTILITIES>SERVER.MAC.9, 18-Mar-85 17:02:03 by MELOHN
; Fix parsing of nodename to accept :: at the end of the string.
; UPD ID= 72, SNARK:<6.1.UTILITIES>SERVER.MAC.8, 27-Jan-85 22:57:40 by MELOHN
; Make default no input escape recognition to fix DECalc problem on VMS.
; UPD ID= 71, SNARK:<6.1.UTILITIES>SERVER.MAC.7, 25-Jan-85 21:08:19 by MELOHN
; Fix terminal settings restoration to correctly restore terminal len and wid
; UPD ID= 68, SNARK:<6.1.UTILITIES>SERVER.MAC.5, 16-Jan-85 20:23:41 by MELOHN
; Add a new entry in the entry vector for the EXEC to use when running the
; server via the SET HOST command. Using this vector will suppress the error
; messages usually supplied by the server to the user, since the EXEC will
; handle that for us.
;
; Add code to set error code NSPX20 when no CTERM destination process so that
; the EXEC can go and try running NRT with the SET HOST command.
;
; Remove special handling code for freelfs in OUPENT, since it was eating
; messages with only CRLF in them.
;
;WORK:<MELOHN.CTS>SERVER.MAC.11 27-Nov-84 15:56:50, Edit by MELOHN
;
; If a read is terminated because of underflow, check to see if it is a
; continuation read. If so, re-read the editing character and send it
; to the host.
;
; Change the edit number, not the version number.
;
; UPD ID= 24, SNARK:<6.1.UTILITIES>SERVER.MAC.2, 8-Aug-84 12:08:39 by WEISBACH
; Add routines TRMSTX and TRMRTX to save and restore the terminal
; characteristics for the case that the TEXTI is interrupted (by
; out-of-band character PSI) and later restarted.
TITLE SERVER
SEARCH MACSYM,MONSYM,CMD
.REQUIRE SYS:MACREL,SYS:CMD
SALL
;Feature switches
IFNDEF FTPMR,<FTPMR==:0>
DEFINE $PMR,<IFN FTPMR,>
DEFINE $NOPMR,<IFE FTPMR,>
IF1,<IFN FTPMR,<PRINTX -- Building with PMR support -->>
;If FTPMR is non-zero, then CTERM-SERVER will be built with CTDNCN. That
;is a modified version of DNCONN, which is the PMR support module.
SUBTTL Table of Contents
; Table of Contents for SERVER
;
;
; Section Page
; 1. VERSION NUMBER AND ENTRY VECTOR. . . . . . . . . . . . 4
; 2. DEFINITIONS
; 2.1. REGISTERS . . . . . . . . . . . . . . . . . . 5
; 2.2. MACROS. . . . . . . . . . . . . . . . . . . . 6
; 3. NUMBER TO BIT MASK TABLE AND SWAP BYTE TABLE . . . . . 10
; 4. DEFINITIONS
; 4.1. NAMES FOR FIELD VALUES . . . . . . . . . . . 11
; 4.2. CHARACTER ATTRIBUTES . . . . . . . . . . 12
; 4.3. DEBUG PROCESS . . . . . . . . . . . . . . . . 13
; 4.4. TERMINAL STORAGE. . . . . . . . . . . . . . . 15
; 4.5. MESSAGE TEMPLATES . . . . . . . . . . . . . . 18
; 4.6. INPUT PROCESS . . . . . . . . . . . . . . . . 20
; 4.7. OUTPUT PROCESS. . . . . . . . . . . . . . . . 24
; 4.8. TIMER PROCESS . . . . . . . . . . . . . . . . 25
; 4.9. DECNET LAYER. . . . . . . . . . . . . . . . . 26
; 4.10. FOUNDATION LAYER. . . . . . . . . . . . . . . 27
; 4.11. CTERM LAYER . . . . . . . . . . . . . . . . . 28
; 4.12. CHARACTERISTICS DATA BASE . . . . . . . . . . 29
; 4.13. PSI SYSTEM. . . . . . . . . . . . . . . . . . 30
; 5. MISCELLANEOUS STORAGE AND DEFINITIONS. . . . . . . . . 31
; 6. PROTOCOL ERROR HANDLER . . . . . . . . . . . . . . . . 32
; 7. STKVAR SUPPORT ROUTINE . . . . . . . . . . . . . . . . 33
; 8. INITIALIZE STORAGE . . . . . . . . . . . . . . . . . . 34
; 9. ENTRY. . . . . . . . . . . . . . . . . . . . . . . . . 35
; 10. DECNET LAYER
; 10.1. INITIALIZATION. . . . . . . . . . . . . . . . 36
; 10.2. Poor Mans Routing . . . . . . . . . . . . . . 37
; 10.3. LINK DOWN . . . . . . . . . . . . . . . . . . 38
; 10.4. SEND AND RECEIVE MESSAGE. . . . . . . . . . . 39
; 10.5. DATA AVAILABLE INTERRUPT. . . . . . . . . . . 40
; 11. FOUNDATION LAYER
; 11.1. INITIALIZATION. . . . . . . . . . . . . . . . 41
; 11.2. OS NAME TABLE . . . . . . . . . . . . . . . . 42
; 11.3. RECEIVE MESSAGE
; 11.3.1. ENTRY AND SHORT ROUTINES . . . . . . 43
; 11.3.2. COMMON DATA OR MODE DATA . . . . . . 44
; 12. CTERM LAYER
; 12.1. INITIALIZATION. . . . . . . . . . . . . . . . 45
; 12.2. SET CTERM DEFAULTS. . . . . . . . . . . . . . 46
; 12.3. MESSAGE RECEIVED
; 12.3.1. ENTRY AND SHORT MESSAGES . . . . . . 48
; 12.3.2. START-READ . . . . . . . . . . . . . 49
; 12.3.3. WRITE . . . . . . . . . . . . . . . 51
; 12.3.4. READ CHARACTERISTICS . . . . . . . . 52
; 12.3.5. CHARACTERISTICS . . . . . . . . . . 59
; 12.3.6. CHECK INPUT . . . . . . . . . . . . 65
; 13. PREINPUT PROCESS
; 13.1. OUT OF BAND CHARACTER INTERRUPT ROUTINES. . . 66
; 13.2. OUT OF BAND INTERRUPT PROCESSING. . . . . . . 68
; 13.2.1. SIMULATE ECHO. . . . . . . . . . . . 69
; 13.3. CONTROL-O AND CONTROL-X . . . . . . . . . . . 70
; 13.4. SET CHARACTER ATTRIBUTES. . . . . . . . . . . 71
; 13.4.1. PSI CHARACTER. . . . . . . . . . . . 72
; 13.4.2. SET UP PSI . . . . . . . . . . . . . 73
; 13.4.3. CLEAR OUT PSI. . . . . . . . . . . . 74
; 13.4.4. SET ECHO . . . . . . . . . . . . . . 75
; 13.4.5. SPECIAL FLAG . . . . . . . . . . . . 76
; 14. OUTPUT PROCESS
; 14.1. WRITE MESSAGE
; 14.1.1. ENTRY. . . . . . . . . . . . . . . . 77
; 14.2. WRTE MESSAGE
; 14.2.1. HANDLE LOCK . . . . . . . . . . . . 78
; 14.3. WRITE MESSAGE
; 14.3.1. BEGINNING SEGMENT. . . . . . . . . . 79
; 14.3.2. ENDING SEGMENT . . . . . . . . . . . 80
; 14.3.3. PREFIX AND POSTFIX . . . . . . . . . 81
; 14.4. UTILITY ROUTINES. . . . . . . . . . . . . . . 82
; 15. INPUT PROCESS
; 15.1. POKE. . . . . . . . . . . . . . . . . . . . . 84
; 15.2. INITIALIZATION. . . . . . . . . . . . . . . . 85
; 15.3. START A READ. . . . . . . . . . . . . . . . . 86
; 15.3.1. MOVE PROMPT. . . . . . . . . . . . . 87
; 15.3.2. SET UP RAISE . . . . . . . . . . . . 88
; 15.3.3. SET UP ECHO. . . . . . . . . . . . . 89
; 15.3.4. SET UP BREAK MASK. . . . . . . . . . 90
; 15.3.5. HANDLE FORMAT FLAG . . . . . . . . . 91
; 15.3.6. CHECK FOR SINGLE CHARACTER READ. . . 92
; 15.4. SEND INPUT STATE MESSAGE. . . . . . . . . . . 93
; 15.5. TERMINAL INPUT AVAILABLE. . . . . . . . . . . 94
; 15.5.1. RESTART . . . . . . . . . . . . . . 95
; 15.5.2. ORDINARY . . . . . . . . . . . . . . 96
; 15.5.3. SINGLE CHARACTER READ. . . . . . . . 97
; 15.5.4. READ RETURNED. . . . . . . . . . . . 98
; 15.5.5. TERMINATOR CHARACTER . . . . . . . . 99
; 15.5.6. START QUOTE. . . . . . . . . . . . . 100
; 15.5.7. START ESCAPE SEQUENCE RECOGNITION. . 101
; 15.5.8. QUOTE IN PROGRESS. . . . . . . . . . 102
; 15.5.9. ESCAPE SEQUENCE . . . . . . . . . . 103
; 15.6. CLEAR INPUT BUFFER. . . . . . . . . . . . . . 108
; 15.7. TERMINATE A READ. . . . . . . . . . . . . . . 109
; 15.7.1. RESTORE TTY STATE. . . . . . . . . . 110
; 15.8. DISPLAY INPUT BUFFER. . . . . . . . . . . . . 111
; 16. TIMER PROCESS
; 16.1. THE TIMER . . . . . . . . . . . . . . . . . . 112
; 16.2. CLEARING AND SETTING THE TIMER. . . . . . . . 113
; 17. UTILITY ROUTINES
; 17.1. TURN OFF SINGLE CHARACTER INTERRUPTS. . . . . 114
; 17.2. TURN ON SINGLE CHARACTER INTERRUPTS . . . . . 115
; 17.3. SET UP PSI SYSTEM . . . . . . . . . . . . . . 116
; 17.4. SAVE CTERM TERMINAL STATE . . . . . . . . . . 117
; 17.5. SAVE ORIGINAL TERMINAL STATE. . . . . . . . . 118
; 17.6. SAVE TERMINAL STATE FOR TEXTI RESTART . . . . 119
; 17.7. SET UP TERMINAL . . . . . . . . . . . . . . . 120
; 17.8. RESTORE ORIGINAL TERMINAL STATE . . . . . . . 121
; 17.9. RESTORE CTERM TERMINAL STATE. . . . . . . . . 122
; 17.10. RESTORE TERMINAL STATE FOR TEXTI RESTART. . . 123
; 17.11. EXIT WITH REENTRY ALLOWED . . . . . . . . . . 124
; 17.12. ERROR ROUTINES. . . . . . . . . . . . . . . . 125
; 17.13. STRING LENGTH . . . . . . . . . . . . . . . . 126
; 17.14. GET INTERRUPT SEQUENCE. . . . . . . . . . . . 127
; 17.15. GET THE RSCAN BUFFER. . . . . . . . . . . . . 128
; 17.16. NODE NAMES. . . . . . . . . . . . . . . . . . 129
; 18. DEBUG PROCESS
; 18.1. ENTRY . . . . . . . . . . . . . . . . . . . . 130
; 18.2. SET LOGGING FILE. . . . . . . . . . . . . . . 131
; 18.3. HELP COMMAND. . . . . . . . . . . . . . . . . 132
; 18.4. SHOW COMMAND. . . . . . . . . . . . . . . . . 133
; 18.5. DISPLAY BUG . . . . . . . . . . . . . . . . . 134
SUBTTL VERSION NUMBER AND ENTRY VECTOR
VEDIT==^D4
VMAJOR==1
VMINOR==0
VWHO==0
SCVN==<VWHO>B2+<VMAJOR>B11+<VMINOR>B17+VEDIT
;Entry vector
ENTVEC: JRST START
JRST [HALTF%
JRST .-1]
VERSIN: SCVN
JRST EXCSRT ; Entry for SET HOST command
SUBTTL DEFINITIONS -- REGISTERS
;General temporary registers
T1=:1
T2=:2
T3=:3
T4=:4
;General preserved registers
Q1=:5
Q2=:6
Q3=:7
;Special purpose preserved registers
OOBAC1=:10 ;For out of band interrupt
ESCSTA=:11 ;Input escape sequence parsing state
BUGREG=:12 ;Debug flags
INPSTA=:13 ;Input state
P6=:15 ;Frame pointer for TRVARs
CX=:16 ;Very temporary register - used by macros
P=:17 ;Stack pointer
;Free registers
FREE2==0
FREE1==14
SUBTTL DEFINITIONS -- MACROS
;Save temporary register
DEFINE SAVET <
JSP CX,.SAVT
>
.SAVT: ADJSP P,4
DMOVEM T1,-3(P)
DMOVEM T3,-1(P)
CALL (CX)
TRNA
AOS -4(P)
DMOVE T1,-3(P)
DMOVE T3,-1(P)
ADJSP P,-4
RET
;A skippable call to the error handler
;MSG is the error message
DEFINE PROERR (MSG)<
JSP T2,[ HRROI T1,[ASCIZ\MSG\]
JRST PERRHN]
>
;****Alternative definition.
;DEFINE PROERR (MSG)<
; CALL [ PUSH P,T1
; PUSH P,T2
; PUSH P,T3
; TMSG <
;** CTERM-Server Protocol error. >
; HRROI T1,[ASCIZ\MSG\]
; PSOUT%
; TMSG < **
;>
; POP P,T3
; POP P,T2
; POP P,T1
; RET]
;>
;Get one byte from a message, with error check
;PTR - byte pointer to current byte of message
;COUNT - number of bytes left in the message
;REG - register where next byte is to go.
;Updates PTR, COUNT, and REG
DEFINE GET1BY (PTR,COUNT,REG)<
SOSGE COUNT
PROERR <Parse error in getting a byte, no bytes left>
ILDB REG,PTR
>;END GET1BY
;Get a two byte value (PDP-11 style) from a message, with error check
;PTR - byte pointer to current byte of message
;COUNT - number of bytes left in the message
;REG - register where next byte is to go.
;Updates PTR, COUNT, and REG
DEFINE GET2BY (PTR,COUNT,REG)<
SOS COUNT
SOSGE COUNT
PROERR <Parse error in getting two bytes, not enough bytes>
ILDB CX,PTR
ILDB REG,PTR
LSH REG,10
IOR REG,CX
>;END GET2BY
;Insert a two byte value (PDP-11 style) into a CTERM message
;Preserves PTR which is assumed to be a DPB pointer
;REG - register containing the value to be inserted
;PTR - byte pointer into message
;Nonskippable
DEFINE PUT2BY (REG,PTR)<
MOVE CX,PTR
DPB REG,CX
LSH REG,-10
IDPB REG,CX
>;END PUT2BY
;Like PUT2BY, except that PTR is a IDPB pointer and is updated, and COUNT
;is updated
DEFINE IPT2BY (REG,PTR,COUNT)<
IDPB REG,PTR
LSH REG,-10
IDPB REG,PTR
AOS COUNT
AOS COUNT
>;END IPT2BY
;Like IPT2BY, except for being a one byte field
DEFINE IPT1BY (REG,PTR,COUNT)<
IDPB REG,PTR
AOS COUNT
>;END IPT1BY
;Send bytes to the terminal - use this macro for any data sent to the
;terminal as a result of a START-READ or WRITE message. This is used
;to keep track of the last character sent to the terminal so that
;the format flag of the START-READ message can be implemented
;Nonskippable
;Uses only ACs T1,T2,T3
DEFINE $PSOUT (PTR,COUNT)<
IFN PTR-3,<
MOVN T3,COUNT ;;Get negative of source count
IFN PTR-2,<MOVE T2,PTR> ;;Get source pointer, if needed
>
IFE PTR-3,<
IFN COUNT-2,<MOVE T2,PTR> ;;Source pointer
IFE COUNT-2,<EXCH T2,T3> ;;Source pointer and count
MOVN T3,COUNT ;;Get negative of source count
>
MOVEI T1,.PRIOU ;;Destination
IFN. T3
SOUT% ;;Do it.
LDB T3,T2 ;;Get last character
MOVEM T3,OUPCR ;;Save it
ENDIF.
>;END $PSOUT
;As above, but for a single byte
;Nonskippable
DEFINE $PBOUT (THEBYT)<
IFN THEBYT-1,<MOVE T1,THEBYT>
PBOUT%
MOVEM T1,OUPCR
>;END $PBOUT
;Command parsing macro
;Parse a keyword - value is in T1
; KEYTAB is address of the keyword table,
; FAIL is the address to go to on failure.
;Nonskippable.
;Returns value of key in T1
DEFINE KEYWRD (KEYTAB)<
MOVEI T1,[FLDDB.(.CMKEY,,KEYTAB)] ;;Address of function descriptor block
CALL RFIELD ;;Do work.
HRRZ T1,(T2) ;;Get value of key
>;END OF KEYWRD
COMMENT #
This macro generates the action codes and the corresponding
dispatch tables. CODPRE is the first three characters of the action
code names, RTNPRE is the first three characters of the dispatch
routines. CODLST is a list of three character suffixes for the names of
the action codes which will also serve as the suffixes for the names of
the dispatch routines.
#
DEFINE DSPGEN (CODTYP,RTNTYP,CODLST)<
IRP CODLST,<IFIW ! RTNTYP'CODLST>
.ZZ==0
IRP CODLST,<
CODTYP'CODLST==.ZZ
.ZZ==.ZZ+1
>
>;END OF DSPGEN
;Generate bit number to bit mask translation table
DEFINE BITIT <
XLIST
.ZZ==^D35
REPEAT ^D36,<
EXP 1_.ZZ
.ZZ==.ZZ-1
LIST
>
>;END OF BITIT
;Generate 8 bit byte swap table
;The CTERM termination bit map is flipped w.r.t. the TOPS20 style of numbering
;bits, and it is more convenient for this program to used the TOPS20 style.
DEFINE SWAPIT <
XLIST
.ZZ==0 ;;Current index
REPEAT ^D256,<
.YY==0 ;;Current bit
.XX==0 ;;Result
REPEAT 8,<
IFN <.ZZ & <1_.YY>>,<.XX==<.XX ! 1_<7-.YY>>> ;;Generate swapped bit
.YY==.YY+1 ;;Step bit
> ;;end of inner loop
EXP .XX ;;Make table entry
.ZZ==.ZZ+1 ;;Step index
LIST
> ;;end of outer loop
>;END OF SWAPIT
;Generate BUG messages.
;FLAG - which trace flag controls this bug
;MSG - message to be printed
;PTR - pointer to string to be displayed (optional, ASCIZ string unless COUNT
; is present.
;COUNT - count to string to be displayed (optional)
;NOTE - the data that PTR points to may not be in the ACs
;Skippable
DEFINE BUGMSG (FLAG,MSG,PTR,COUNT)<
JUMPN BUGREG,[ TXNN BUGREG,FLAG ;;Is this flag set ?
JRST .+1 ;;No. Go away
PUSH P,BUGREG
HRROI BUGREG,[ASCIZ\MSG\]
MOVEM BUGREG,BUGMPT
MOVE BUGREG,PTR
MOVEM BUGREG,BUGDPT
MOVE BUGREG,COUNT
MOVEM BUGREG,BUGCNT
POP P,BUGREG
CALL BUGDSP ;;Call display routine
JRST .+1] ;;Done.
>;END OF BUGMSG
SUBTTL NUMBER TO BIT MASK TABLE AND SWAP BYTE TABLE
;Table to translate bit number to bit mask
BITS: BITIT
;Table to swap 8 bit bytes around for bit maps.
SWPBYT: SWAPIT
SUBTTL DEFINITIONS -- NAMES FOR FIELD VALUES
;Out of band characteristic
OB.CLR==1 ;Clear out of band
OB.DEF==2 ;Deferred clear out of band
OB.HEL==3 ;Hello out of band
;Echo characteristic
EC.NON==0 ;No echo
EC.SLF==1 ;Echo as self
EC.STD==2 ;Standard echo
EC.FMT==3 ;Simulate format action
;Terminate on underflow field in START-READ message
TM.IGN==0 ;Ignore underflow
TM.BEL==1 ;Send bell to terminal
TM.TRM==2 ;Terminate on underflow
SUBTTL DEFINITIONS -- CHARACTER ATTRIBUTES
;Out of band character attributes
BEGSTR OB
FILLER ^D29 ;right justify
FIELD SPC,1 ;Special flag
FIELD ECH,2 ;Control character echoing characteristics
FIELD DSC,1 ;Output discard state flag
FIELD INC,1 ;Include flag
FIELD OOB,2 ;Out of band type
ENDSTR
;Out of band characteristics
OOBCHA: BLOCK ^D32
;DELETE characteristics
DELCHA: BLOCK 1
;Interrupt handling routines & PSI channel assignments
OOBTAB: OOB0
OOB1
OOB2
OOB3
OOB4
OOB5
OOB6
OOB7
OOB8
OOB9
OOB10
OOB11
OOB12
OOB13
OOB14
OOB15
OOB16
OOB17
OOB18
OOB19
OOB20
OOB21
OOB22
OOB23
OOB24
OOB25
OOB26
OOB27
OOB28
OOB29
OOB30
OOB31
DELTAB: OOBDEL
OOBMSG: POINT 7,[ASCIZ/Control-@/]
POINT 7,[ASCIZ/Control-A/]
POINT 7,[ASCIZ/Control-B/]
POINT 7,[ASCIZ/Control-C/]
POINT 7,[ASCIZ/Control-D/]
POINT 7,[ASCIZ/Control-E/]
POINT 7,[ASCIZ/Control-F/]
POINT 7,[ASCIZ/Control-G/]
POINT 7,[ASCIZ/Control-H/]
POINT 7,[ASCIZ/Control-I/]
POINT 7,[ASCIZ/Control-J/]
POINT 7,[ASCIZ/Control-K/]
POINT 7,[ASCIZ/Control-L/]
POINT 7,[ASCIZ/Control-M/]
POINT 7,[ASCIZ/Control-N/]
POINT 7,[ASCIZ/Control-O/]
POINT 7,[ASCIZ/Control-P/]
POINT 7,[ASCIZ/Control-Q/]
POINT 7,[ASCIZ/Control-R/]
POINT 7,[ASCIZ/Control-S/]
POINT 7,[ASCIZ/Control-T/]
POINT 7,[ASCIZ/Control-U/]
POINT 7,[ASCIZ/Control-V/]
POINT 7,[ASCIZ/Control-W/]
POINT 7,[ASCIZ/Control-X/]
POINT 7,[ASCIZ/Control-Y/]
POINT 7,[ASCIZ/Control-Z/]
POINT 7,[ASCIZ/ESCAPE /]
POINT 7,[ASCIZ/Control-\/]
POINT 7,[ASCIZ/Control-]/]
POINT 7,[ASCIZ/Control-^/]
POINT 7,[ASCIZ/Control-_/]
BLOCK .CHDEL-^D31-1
POINT 7,[ASCIZ/DELETE/]
SUBTTL DEFINITIONS -- DEBUG PROCESS
DEBUG: BLOCK 1 ;Debug is on.
BUGACS: BLOCK 20 ;Storage for DDT
BUGFIL: BLOCK 1 ;The tracing file JFN
BUGMPT: BLOCK 1 ;BUG message pointer
BUGDPT: BLOCK 1 ;BUG data pointer
BUGCNT: BLOCK 1 ;BUG data count
SETHOS: BLOCK 1 ;Entry was via EXEC SET HOST command
QUIET: BLOCK 1 ;Don't print connection msgs.
BG.ALL==777776 ;All flags except enable.
BG.ENA==1B35 ;Debugging enabled.
BG.OOB==1B34 ;OUT-OF-BAND processing flag
BG.MSI==1B33 ;RECEIVED-DECNET-MESSAGES flag
BG.MSO==1B32 ;SENT-DECNET-MESSAGES flag
BG.CTR==1B21 ;RECEIVED-CTERM-MESSAGES flag
BUGJFN: BLOCK 1 ;The interim file JFN
;The main command keyword table - right half contains routine address
KEYMAI: 10,,10
XWD [ASCIZ\CONTINUE\],BUGCON
XWD [ASCIZ\DDT\],BUGDDT
XWD [ASCIZ\EXIT\],BUGEXI
XWD [ASCIZ\HELP\],BUGHLP
XWD [ASCIZ\LOG\],BUGLOG
XWD [ASCIZ\SHOW\],BUGSHO
XWD [ASCIZ\TRACE\],BUGTRC
XWD [ASCIZ\UNTRACE\],BUGUNT
;The trace keyword table - right half contains mask
KEYTRC: 5,,5
XWD [ASCIZ\ALL\],BG.ALL
XWD [ASCIZ\OUT-OF-BANDS\],BG.OOB
XWD [ASCIZ\RECEIVED-CTERM-MESSAGES\],BG.CTR
XWD [ASCIZ\RECEIVED-DECNET-MESSAGES\],BG.MSI
XWD [ASCIZ\SENT-DECNET-MESSAGES\],BG.MSO
;This is a macro from CMD to generate needed COMND% storage
CMDSTG
SUBTTL DEFINITIONS -- TERMINAL STORAGE
;Terminal characteristics of interest
BEGSTR TM
FIELD VID,1 ;Video
FIELD MFF,1 ;Mechanical form feed
FIELD MTB,1 ;Mechanical tab
FIELD LOW,1 ;Lower case
ENDSTR
;Original terminal state storage.
OLDCOC: BLOCK 2 ;The CCOC words
OLDRFM: BLOCK 1 ;The JFN mode word
OLDMOD: BLOCK 1 ;The pause on end of page mode
OLDWID: BLOCK 1 ;The terminal page width
OLDLEN: BLOCK 1 ;The terminal page length
OLDRTI: BLOCK 2 ;The terminal interrupt mask for the process.
OLDRTJ: BLOCK 1 ;The terminal interrupt mask for the job.
OLDSWI: BLOCK 1 ;Two character switch sequence
OLDTYP: BLOCK 1 ;Terminal type
;Current terminal state storage (for reentry).
CTMCOC: BLOCK 2 ;The CCOC words
CTMRFM: BLOCK 1 ;The JFN mode word
CTMMOD: BLOCK 1 ;The pause on end of page mode
CTMWID: BLOCK 1 ;The terminal page width
CTMLEN: BLOCK 1 ;The terminal page length
CTMRTI: BLOCK 2 ;The terminal interrupt mask for the process.
CTMRTJ: BLOCK 1 ;The terminal interrupt mask for the job.
CTMSWI: BLOCK 1 ;Two character switch sequence
CTMTYP: BLOCK 1 ;Terminal type
;Terminal state storage (for TEXTI restart)
TXTCOC: BLOCK 2 ;The CCOC words
TXTRFM: BLOCK 1 ;The JFN mode word
TXTFW: BLOCK 1 ;The field width
TXTMSK: BLOCK 5 ;The character break mask
;Terminal characteristics kept in this program
LINWID: BLOCK 1 ;Line width
LINWRP: BLOCK 1 ;Line wrap characteristic
CHRIEX: BLOCK 1 ;Input escape recognition characteristic
CHROEX: BLOCK 1 ;Output escape recognition characteristic
CHRATP: BLOCK 1 ;Auto prompt characteristic
CHRICT: BLOCK 1 ;Input count state characteristic
;Translation table from TOPS20 terminal type (as returned from GTTYP%)
;to characteristics of interest (currently only one - video)
TRMTAB: 0 ;TTY model 33
TMMFF+TMMTB ;TTY model 35
TMLOW ;TTY model 37
TMLOW ;TI/EXECUPORT
REPEAT 4,<0> ;(reserved for customer)
TMLOW ;Default
TMMFF+TMMTB+TMLOW ;Ideal
TMVID+TMMTB ;VT05
TMVID ;VT50
0 ;LA30
TMLOW ;GT40
TMLOW ;LA36
TMVID+TMMTB ;VT52
TMVID+TMMTB ;VT100
TMMTB+TMLOW ;LA38
TMMFF+TMMTB+TMLOW ;LA120
REPEAT <.TT125-.TT120-1>,<0> ;Gap in table
TMMTB+TMVID ;VT125
TMMTB+TMVID ;VK100
TMMTB+TMVID ;VT102
TMMTB+TMVID ;H19
TMMTB+TMVID ;VT131
TMMTB+TMVID ;VT200
TRMTBL==.-TRMTAB ;Length of table
;Translation table from terminal name string to TOPS20 terminal type number
TTYTBL: TTYTLL,,TTYTLL
[ASCIZ\GT40\],,.TTG40
[ASCIZ\H19\],,.TTH19
[ASCIZ\LA120\],,.TT120
[ASCIZ\LA30\],,.TTL30
[ASCIZ\LA36\],,.TTL36
[ASCIZ\LA38\],,.TTL38
[ASCIZ\LT33\],,.TT33
[ASCIZ\LT35\],,.TT35
[ASCIZ\LT37\],,.TT37
[ASCIZ\VT05\],,.TTV05
[ASCIZ\VK100\],,.TTK10
[ASCIZ\VT100\],,.TT100
[ASCIZ\VT102\],,.TT102
[ASCIZ\VT125\],,.TT125
[ASCIZ\VT131\],,.TT131
[ASCIZ\VT200\],,.TT200
[ASCIZ\VT50\],,.TTV50
[ASCIZ\VT52\],,.TTV52
TTYTLL==.-TTYTBL-1
;Translation table from TOPS20 terminal type (as returned from GTTYP%)
;to length and name of terminal
TRMSTB: 4,,[ASCIZ\LT33\] ;TTY model 33
4,,[ASCIZ\LT35\] ;TTY model 35
4,,[ASCIZ\LT37\] ;TTY model 37
1,,[0] ;TI/EXECUPORT
REPEAT 4,<1,,[0]> ;(reserved for customer)
1,,[0] ;Default
1,,[0] ;Ideal
4,,[ASCIZ\VT05\] ;VT05
4,,[ASCIZ\VT50\] ;VT50
4,,[ASCIZ\LA30\] ;LA30
1,,[0] ;GT40
4,,[ASCIZ\LA36\] ;LA36
4,,[ASCIZ\VT52\] ;VT52
5,,[ASCIZ\VT100\] ;VT100
4,,[ASCIZ\LA38\] ;LA38
5,,[ASCIZ\LA120\] ;LA120
REPEAT <.TT125-.TT120-1>,<1,,[0]> ;Gap in table
5,,[ASCIZ\VT125\] ;VT125
5,,[ASCIZ\VK100\] ;VK100
5,,[ASCIZ\VT102\] ;VT102
3,,[ASCIZ\H19\] ;H19
5,,[ASCIZ\VT131\] ;VT131
5,,[ASCIZ\VT200\] ;VT200
;A number LARGER than the length of any string
TRMMAX==6
TRMTYP: BLOCK 1 ;TOPS20 Terminal type
TRMCHA: BLOCK 1 ;Terminal characteristics
CCCODE: BYTE (2)2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2 ;CCOC words at initialization
ESCCHR: BLOCK 1 ;First character of switch sequence
SUBTTL DEFINITIONS -- MESSAGE TEMPLATES
;****************************************
;Note that all pointers are DPB pointers.
;****************************************
;Template for the foundation BIND-ACCEPT message
;
BNDACS==^D17 ;Size of BIND-ACCEPT message
BNDACX: BYTE (8)4,2,0,0 ;TYPE,VERSION,ECO,MOD
BYTE (8)10,0,"6","." ;OPSYS1,OPSYS2,REV1,REV2
BYTE (8)"1","B","L","1" ;REV3,REV4,REV5,REV6
BNDACZ: BYTE (8)".","0",0,0 ;REV7,REV8,ID1,ID2
BYTE (8)0 ;OPTIONS
BNDACP: POINT 8,BNDACZ,23 ;Pointer to terminal id.
BNDPTR: POINT 8,BNDACX ;Pointer to message
;CTERM initiate message
INISIZ==^D28 ;Size of message
INIMSX: BYTE (8)11,0,30,0 ;FOUND-TYPE,FLAGS,SIZE1,SIZE2
BYTE (8)1,0,1,4 ;CTERM-TYPE,FLAGS,VERSION,ECO
BYTE (8)0,"6",".","1" ;MOD,REV1,REV2,REV3
BYTE (8)"B","L","1","." ;REV4,REV5,REV6,REV7
BYTE (8)"0",1,2,0 ;REV8,MAX-LENGTH-PROTOCOL-MESSAGE(3)
BYTE (8)5,2,1,377 ;MAX-LENGTH-ST(3),MESSAGES-SUPP(1)
BYTE (8)3,2,376,177 ;MESSAGES-SUPP(3)
INIPTR: POINT 8,INIMSX ;Pointer to message
;Template CTERM read message.
REDMAX==3*1000 ;Max size of read data
REDHDR==4 ;Size of foundation header
REDCSZ==10 ;Size of fixed part of CTERM message
REDSIZ==REDMAX+REDHDR+REDCSZ ;Max size of buffer in bytes
READX1: BYTE (8)11,0,0,0 ;FOUND-TYPE,FLAGS,SIZE1,SIZE2
READX2: BYTE (8)3,0,0,0 ;CTERM-TYPE,FLAGS,LOW-WATER(2)
READX3: BYTE (8)0,0,0,0 ;VERTICAL-CHANGE,HORZONTAL-CHANGE,TERMINATOR-POS(2)
READX4: BLOCK <REDSIZ-14>/4 ;Read data storage
REDSPT: POINT 8,READX1,23 ;Pointer to size bytes
REDCPT: POINT 4,READX2,15 ;Pointer to "completion code" field
REDTPT: POINT 1,READX2,11 ;Pointer to "more typeahead data" field
REDLPT: POINT 8,READX2,23 ;Pointer to LOW-WATER bytes
REDVPT: POINT 8,READX3,7 ;Pointer to VERTICAL-POS byte
REDHPT: POINT 8,READX3,15 ;Pointer to HORIZONTAL-POS byte
REDPPT: POINT 8,READX3,23 ;Pointer to TERMINATOR-POS bytes
REDDPT: POINT 8,READX4
REDPTR: POINT 8,READX1 ;Pointer to the buffer
;Template for CTERM out-of-band message
OOBSIZ==7 ;Size of out-of-band message
OOBMSX: BYTE (8)11,0,3,0 ;FOUND-TYPE,FLAGS,SIZE1,SIZE2
OOBXXX: BYTE (8)4,0,0 ;CTERM-TYPE,FLAGS,O-O-B-CHAR
OOBP: POINT 8,OOBXXX,23 ;Pointer to where out-of-band character goes
OOBP1: POINT 8,OOBXXX,15 ;Pointer to where flags go
OOBPTR: POINT 8,OOBMSX ;Pointer to message
;Template for CTERM discard state message
DSCSIZ==6 ;Size of out-of-band message
DSCMSX: BYTE (8)11,0,2,0 ;FOUND-TYPE,FLAGS,SIZE1,SIZE2
DSCXXX: BYTE (8)11,0 ;CTERM-TYPE,DISCARD-FLAGS
DSCP: POINT 8,DSCXXX,15 ;Pointer to where new requested state goes
DSCPTR: POINT 8,DSCMSX ;Pointer to message
;Template for CTERM input count message
CNTSIZ==9 ;Size of out-of-band message
CNTMSX: BYTE (8)11,0,4,0 ;FOUND-TYPE,FLAGS,SIZE1,SIZE2
CNTXXX: BYTE (8)15,0,0,0 ;CTERM-TYPE,FLAGS,COUNT1,COUNT2
CNTYYY: BYTE (8)0 ;CHAR1 (VMS-CTERM "Extension")
CNTPC: POINT 8,CNTYYY,7 ;Pointer to CHAR1
CNTP: POINT 8,CNTXXX,23 ;Pointer to where count bytes goes.
CNTPTR: POINT 8,CNTMSX ;Pointer to message
;Template for CTERM input state message
INSSIZ==6 ;Size of out-of-band message
INSMSX: BYTE (8)11,0,2,0 ;FOUND-TYPE,FLAGS,SIZE1,SIZE2
INSXXX: BYTE (8)16,1 ;CTERM-TYPE,INPUT-STATE
INSPTR: POINT 8,INSMSX ;Pointer to message
;Template for CTERM write completion message
WRCSIZ==^D10 ;Size of write-completion message
WRCMSX: BYTE (8)11,0,6,0 ;FOUND-TYPE,FLAGS,SIZE-1,SIZE-2
WRCXXX: BYTE (8)10,0,0,0 ;CTERM-TYPE,STATUS,HPOS1,HPOS2
WRCYYY: BYTE (8)0,0 ;VPOS1,VPOS2
WRCFLG: POINT 8,WRCXXX,15 ;Pointer to status byte
WRCHPS: POINT 8,WRCXXX,23 ;Pointer to horizontal position bytes
WRCVPS: POINT 8,WRCYYY,7 ;Pointer to vertical position bytes
WRCPTR: POINT 8,WRCMSX ;Pointer to start of message
;Template for CTERM characteristics message
CHAHDR==4 ;Size of foundation header
CHACSZ==2 ;Size of fixed part of CTERM message
CHAMSX: BYTE (8)11,0,0,0 ;FOUND-TYPE,FLAGS,SIZE-1,SIZE-2
CHAXXX: BYTE (8)13,0,0,0 ;CTERM-TYPE,FLAGS,SELECTOR-VALUE fields
CHAYYY: BLOCK 100 ;
CHASZZ: POINT 8,CHAMSX,23 ;Pointer to SIZE bytes
CHAVAL: POINT 8,CHAYYY ;Pointer to VALUE field
CHASL1: POINT 8,CHAXXX,23 ;Pointer to characteristics identifier
CHASL2: POINT 8,CHAXXX,31 ;Pointer to identifier type
CHAPTR: POINT 8,CHAMSX ;Pointer to start of message
SUBTTL DEFINITIONS -- INPUT PROCESS
RDACTV: BLOCK 1 ;A read is active
;Storage and definitions for parsing START-READ message
INPFPT: POINT 8,.+1 ;Pointer to flags
INPFLG: BLOCK 1 ;Storage for flags
INPLEN: BLOCK 1 ;MAX-LENGTH
INPEOD: BLOCK 1 ;END-OF-DATA
INPTIM: BLOCK 1 ;TIMEOUT
INPEOP: BLOCK 1 ;END-OF-PROMPT
INPSOD: BLOCK 1 ;START-OF-DISPLAY
INPLOW: BLOCK 1 ;LOW-WATER
INPTML==^D8
INPTBM: BLOCK INPTML ;TERMINATOR-SET
INPBPT: BLOCK 1 ;DATA-POINTER
INPBCT: BLOCK 1 ;DATA-COUNT
;START-READ flags
BEGSTR RD
;first byte
FIELD RAI,2 ;raise input
FIELD CON,1 ;continuation read
FIELD VTF,1 ;terminate on vertical change
FIELD FMT,1 ;Formatting
FIELD CLT,1 ;Clear typeahead
FIELD UND,2 ;Underflow
;second byte
FIELD TRM,2 ;non-default terminator
FIELD TIM,1 ;timeout
FIELD TEC,1 ;echo terminator
FIELD NEC,1 ;no-echo
FIELD DCD,3 ;disable control definition
;third byte
FILLER 6
FIELD ESS,2 ;escape sequence recognition
ENDSTR
;Input dispatch table and action codes
YYYY: BLOCK 100
INPDSP: DSPGEN .IN,INP,<ORD,ESC,QUT,BIN>
COMMENT #
Input process states
.INORD==0 ;Put into input buffer, and echo.
.INESC==1 ;Start escape sequence
.INQUT==2 ;Quote character
.INBIN==3 ;Single character read
#
INPIGN: BLOCK 1 ;"Ignore input" flag.
INPQOT: BLOCK 1 ;"Quote character (control-V) enabled" flag
INPTMO: BLOCK 1 ;"Timeout enabled" flag
INPRAI: BLOCK 1 ;"Restore raise on completion" flag
INPECH: BLOCK 1 ;"Restore echo on completion" flag
INPCTL: BLOCK 1 ;"Enable character interrupts on completion" flag
INPTIW: BLOCK 2 ;Terminal interrupt words, if needed.
INPESR: BLOCK 1 ;"Input esc seq recognition enabled" flag
INPUBM: BLOCK 4 ;"Unediting" break mask.
INPEBM: BLOCK 4 ;"Editing" break mask.
INPSEE: BLOCK 1 ;A character has been seen during this read.
INPCHR: BLOCK 1 ;First input char from input count message
INPUNX==1B<.CHBSP>+1B<.CHTAB>+1B<.CHCNR>+1B<.CHCNU>+1B<.CHCNW>
INPUNV: -1 ^! INPUNX ;Universal CTERM break mask
0
0
0
;Flags always set in TEXTI% argument block -
;JFNs in .RDJFN, return on input empty,
;return on backup limit reached, disable editing characters in break mask
TXTFLG==RD%JFN+RD%RIE+RD%BEG+RD%NED
INPXBM: BLOCK 4 ;TEXTI% break mask
;TEXTI% argument block with the permanent data filled in.
INPBLK: .RDBKL ;.RDCWB - count of words in block
TXTFLG ;.RDFLG - flags
.PRIIN,,.PRIOU ;.RDJFN - input JFN and output JFN
0 ;.RDDBP - destination string buffer pointer
0 ;.RDDBC - number of bytes in destination string
0 ;.RDBFP - destination string buffer start ptr
POINT 8,INPPMT ;.RDRTY - CTRL/R buffer pointer
INPXBM ;.RDBRK - address of break mask
0 ;.RDBKL - backup limit pointer
INPPMT: BLOCK 100 ;Storage for prompt.
;Read termination codes
.TMTRM==^D0 ;Termination character
.TMVES==^D1 ;Valid escape sequence
.TMIES==^D2 ;Invalid escape sequence
.TMOOB==^D3 ;Out of band character
.TMFUL==^D4 ;Input buffer full
.TMTIM==^D5 ;Timeout
.TMUNR==^D6 ;Unread
.TMUND==^D7 ;Underflow
.TMABS==^D8 ;Absentee token
.TMVRT==^D9 ;Vertical position change
.TMBRK==^D10 ;Line break *
.TMFRM==^D11 ;Frame error *
.TMPAR==^D12 ;Parity error *
.TMRUN==^D13 ;Receiver overrun *
;* - not detected by this implementation
;Input escape sequence parsing variables
ESCMAX==40 ;Maximum size of escape sequence in bytes
ESCBUF: POINT 8,.+1 ;Escape sequence buffer starting pointer
BLOCK <ESCMAX+3>/4
ESCPTR: BLOCK 1 ;Pointer into escape sequence buffer
ESCCNT: BLOCK 1 ;Count of characters in escape sequence buffer
ESCMOD: BLOCK 1 ;Saved JFN mode word.
;State dispatch table for input escape sequence parsing.
;T1/ character
TSTATE: IFIW ! @ESCST0(T1) ;Initial state
IFIW ! @ESCST1(T1) ;VT52 sequence starting with ";","?"
IFIW ! @ESCST2(T1) ;VT52 sequence starting with "O" or ANSI sequence intermediate character.
IFIW ! @ESCST3(T1) ;VT52 sequence starting with "Y", 1st char
IFIW ! @ESCST4(T1) ;VT52 sequence starting with "Y", 2nd char
IFIW ! @ESCST5(T1) ;ANSI sequence parameter
IFIW ! VALDON ;Valid escape sequence already parsed.
XLIST
;Character dispatch tables for each state
;State 0 - initial state
ESCST0: REPEAT ^D32,<IFIW ! INVALD> ;0.-31. Invalid
REPEAT ^D16,<IFIW ! STATE1> ;32.-47. Continue at state 1
REPEAT ^D11,<IFIW ! VALID> ;48.-58. Valid.
IFIW ! STATE1 ;59. (";") Continue at state 1
REPEAT ^D3,<IFIW ! VALID>;60.-62. Valid.
IFIW ! STATE1 ;63. ("?") Continue at state 1
REPEAT ^D15,<IFIW ! VALID> ;64.-78. Valid
IFIW ! STATE2 ;79. ("O") Continue at state 2
REPEAT ^D9,<IFIW ! VALID> ;80.-88. Valid
IFIW ! STATE3 ;89. ("Y") Continue at state 3
IFIW ! VALID ;90. valid
IFIW ! STATE5 ;91. ("[") Continue at state 5
REPEAT ^D35,<IFIW ! VALID> ;92.-126. Valid
IFIW ! INVALD ;127. Invalid.
;State 1 - VT52 sequence starting with ";","?"
ESCST1: REPEAT ^D32,<IFIW ! INVALD> ;0.-31. Invalid
REPEAT ^D16,<IFIW ! RSKP> ;32.-47. Continue at same state
REPEAT ^D79,<IFIW ! VALID> ;48.-126. Valid escape sequence
IFIW ! INVALD ;127. Invalid
;State 2 - VT52 sequence starting with "O" or ANSI sequence intermediate character.
ESCST2: REPEAT ^D32,<IFIW ! INVALD> ;0.-31. Invalid
REPEAT ^D16,<IFIW ! RSKP> ;32.-47. Continue at same state
REPEAT ^D16,<IFIW ! INVALD> ;48.-63. Invalid
REPEAT ^D63,<IFIW ! VALID> ;64.-126. Valid escape sequence
IFIW ! JRST INVALD ;127. Invalid
;State 3 - VT52 sequence starting with "Y", first character
ESCST3: REPEAT ^D32,<IFIW ! INVALD> ;0.-31. Invalid
REPEAT ^D95,<IFIW ! STATE4> ;32.-126. Continue at state 4
IFIW ! INVALD ;127. Invalid
;State 4 - VT52 sequence starting with "Y", second character
ESCST4: REPEAT ^D32,<IFIW ! INVALD> ;0.-31. Invalid
REPEAT ^D95,<IFIW ! VALID> ;32.-126. Valid
IFIW ! INVALD ;127. Invalid
;state 5 - ANSI sequence parameter
ESCST5: REPEAT ^D32,<IFIW ! INVALD> ;0.-31. Invalid
REPEAT ^D16,<IFIW ! STATE2> ;32.-47. Continue at state 2
REPEAT ^D16,<IFIW ! RSKP> ;48.-63. Continue at same state
REPEAT ^D63,<IFIW ! VALID> ;64.-126. Valid
IFIW ! INVALD ;127. Invalid
LIST
COMMENT #
State diagram for escape sequence parsing
+-+(32-47)
| |
<ESC> ";","?" | | (48-126)
* --------> (0) ----------> (1) -------------> [VALID]
/|\ \
[INVALID] / | \ \ (0-31,127)
^ "Y"/ | \"O" \------------> [INVALID]
|(0-31,127) / V \
+----<---- (3)<+ | \
| | \_____
(32-126)| |"[" \ +-+(32-47)
V | \ | |
(0-31,127) | | \ | | (64-126)
+----------(4) +----+ \--> (2) --------------> [VALID]
V | | / \
[INVALID] | (48-63)/\ | (32-47) / \ (0-31,48-63,127)
V / (5)---->------/ \------------------> [INVALID]
(32-126)| \_/ |\ (0-31,127)
+------<----+ | \--->-------------------------------> [INVALID]
V | (64-126)
[VALID] +--->---------------------------------> [VALID]
#
SUBTTL DEFINITIONS -- OUTPUT PROCESS
;Storage and definitions for CTERM WRITE message parsing
WRFLAG: BLOCK 1 ;Storage for flags
WRFPTR: POINT 8,WRFLAG
OUPSKP: BLOCK 1 ;Skip-next-line-feed
OUPCR: BLOCK 1 ;Last character sent to terminal OR
; 0 if it wasn't CR.
FREELF: BLOCK 1 ;Free LF was supplied by TOPS20.
TRMFLG: BLOCK 1 ;non-zero if we echoed a terminator by mistake.
BEGSTR WR
FIELD PFX,2 ;Prefix code
FIELD EOM,1 ;End of message
FIELD BOM,1 ;Beginning message
FIELD DSC,1 ;Set output discard state
FIELD NWL,1 ;Newline flag
FIELD LOK,2 ;Lock handling definition
FILLER 4
FIELD TRN,1 ;Transparent output
FIELD CMP,1 ;Completion status requested
FIELD PSX,2 ;Postfix code
FIELD PFC,8 ;Prefix character/count
FIELD PSC,8 ;Postfix character/count
ENDSTR
;Fields from WRITE message
OUPLOK: BLOCK 1 ;Lock definition
OUPNWL: BLOCK 1 ;Newline flag
OUPOUT: BLOCK 1 ;Allow input echoing
OUPBOM: BLOCK 1 ;BEGINNING-OF-MESSAGE
OUPEOM: BLOCK 1 ;END-OF-MESSAGE
OUPPFX: BLOCK 1 ;Prefix code
OUPPFC: BLOCK 1 ;Prefix character/count
OUPPSX: BLOCK 1 ;Postfix code
OUPPSC: BLOCK 1 ;Postfix character/count
OUPCMP: BLOCK 1 ;Completion status requested
OUPTRN: BLOCK 1 ;Transparent output
OUPBPT: BLOCK 1 ;Data byte pointer
OUPBCT: BLOCK 1 ;Data byte count
OUPIPT: BLOCK 1 ;Point to queued input data
OUPICT: BLOCK 1 ;Negative count of queued input data
OUPLCK: BLOCK 1 ;Output is locked against echoing.
;Output discard states - 1 means "do not discard."
OUPDS1: BLOCK 1 ;Requested output discard state
OUPDS2: BLOCK 1 ;Real output discard state
SUBTTL DEFINITIONS -- TIMER PROCESS
TIMDSP: DSPGEN .TM,TIM,<NUL,STT,TIK>
COMMENT #
;Timer states
.TMNUL==0 ;Off
.TMSTT==1 ;Set request
.TMTIK==2 ;Ticking
#
TIMSTA: BLOCK 1 ;Timer state
TIMOUT: BLOCK 1 ;Timeout period.
JOBNO: BLOCK 1 ;Job number
SUBTTL DEFINITIONS -- DECNET LAYER
;CTERM host DECnet object type
CTHOBJ==^D42 ;The number
CTHOBA: ASCIZ\-42\ ;In ascii, for the connection.
;Network JFN
NETJFN: BLOCK 1
;Storage for the remote file specification for NETJFN
NODSPC: BLOCK 5
;DECnet buffer for message from remote
REMBSZ==10*400 ;Buffer size in bytes
REMPTR: POINT 8,.+1 ;Byte pointer to start of buffer
BLOCK REMBSZ/4 ;The buffer
;Pointer to and storage for escape sequence
TCESIZ==^D80
TCEPTR: POINT 7,.+1
BLOCK TCESIZ/5
;Pointer to and storage for remote node name
NODPTR: POINT 7,.+1 ;Pointer to node name
BLOCK 2 ;Node name buffer
;Waiting interval time
LPVAL: ^D300
SUBTTL DEFINITIONS -- FOUNDATION LAYER
;Dispatch table for received message on faoundation message type
FNDDSP: DSPGEN .FN,FND,<ILL,BND,UNB,REB,BAC,ENT,EXI,CFM,NOM,COM,MOD>
FNDDSL==.-FNDDSP ;dispatch table length
COMMENT #
Foundation message types
.FNILL - illegal message type
.FNBND - bind message
.FNREB - rebind message (not implemented)
.FNUNB - unbind message
.FNBAC - bind accept message (never received)
.FNENT - enter mode message (not implemented)
.FNEXI - exit mode message (not implemented)
.FNCFM - confirm mode message (never received)
.FNNOM - no mode message (never received)
.FNCOM - common data message
.FNMOD - mode data message
#
REMVER: BLOCK 1 ;Remote's version number
REMECO: BLOCK 1 ;Remote's ECO number
REMMOD: BLOCK 1 ;Remote's modification number
REMOS: BLOCK 1 ;Remote's OS code
REMTID: BLOCK 1 ;Remote's terminal id
REMRVP: BLOCK 8 ;Remote's revision field
.FNDBN==1 ;BIND-REQUEST message type
CM%PRO==1B31 ;CTERM protocol supported flag
SUBTTL DEFINITIONS -- CTERM LAYER
;Dispatch table on received CTERM message type
CTMDSP: DSPGEN .CT,CTM,<ILL,INT,STR,RED,OOB,UNR,CLI,WRI,WRC,DSC,RDC,CHA,CKI>
CTMDSL==.-CTMDSP ;Length of dispatch table
COMMENT #
CTERM message types
.CTILL - Illegal message type
.CTINT - INITIATE message
.CTSTR - START-READ message
.CTRED - READ message (never received)
.CTOOB - OUT-OF-BAND message (never received)
.CTUNR - UNREAD message (never received)
.CTCLI - CLEAR-INPUT message
.CTWRI - WRITE message
.CTWRC - WRITE-COMPLETE message (never received)
.CTDSC - DISCARD-STATE message (never received)
.CTRDC - READ-CHARACTERISTICS message
.CTCHA - CHARACTERISTICS message
.CTCKI - CHECK-INPUT message
#
;State of CTERM layer - nonzero means initializing
CTMSTA: BLOCK 1
SUBTTL DEFINITIONS -- CHARACTERISTICS DATA BASE
;Writing
ACCESW: IFIW ! @PHYCHW(T1) ;Physical
IFIW ! @LOGCHW(T1) ;Logical
IFIW ! @HANCHW(T1) ;Handler
ACCESL==.-ACCESW-1 ;Largest identifier type
;Writing - physical characteristics
PHYCHW: IFIW ! RTN ;Illegal characteristic selector
IFIW ! CHWINP ;Input speed (integer)
IFIW ! CHWOUP ;Output speed (integer)
IFIW ! CHWINT ;Character size (integer) - not writeable
IFIW ! CHWBOL ;Parity enabled (boolean) - not writeable
IFIW ! CHWINT ;Parity type (integer) - not writeable
IFIW ! CHWBOL ;Modem present (boolean) - not writeable
IFIW ! CHWBOL ;Auto baud detect (boolean) - not writeable
IFIW ! CHWBOL ;Management guaranteed (boolean) - not writeable
IFIW ! CHWSW1 ;Switch character 1 (string)
IFIW ! CHWSW2 ;Switch character 2 (string)
IFIW ! CHWBOL ;Eight bit (boolean) - not writeable
IFIW ! CHWBOL ;Terminal management enabled (boolean) - not writeable
PHYCHL==.-PHYCHW-1 ;Largest characteristic identifier
;Writing - logical characteristics
LOGCHW: IFIW ! RTN ;Illegal characteristic selector
IFIW ! CHWBOL ;Mode writing allowed (boolean) - not writeable
IFIW ! CHWINT ;Terminal attributes (integer) - not writeable
IFIW ! CHWSTG ;Terminal type (string)
IFIW ! CHWOFC ;Output flow control (boolean)
IFIW ! CHWOPS ;Output page stop (boolean)
IFIW ! CHWBOL ;Flow character passthrough (boolean) - not writeable
IFIW ! CHWBOL ;Input flow control (boolean) - not writeable
IFIW ! CHWBOL ;Loss notification (boolean) - not writeable
IFIW ! CHWWID ;Line width (integer)
IFIW ! CHWPGL ;Page length (integer)
IFIW ! CHWPGL ;Stop length (integer)
IFIW ! CHWINT ;CR fill (integer) - not writeable
IFIW ! CHWINT ;LF fill (integer) - not writeable
IFIW ! CHWWRP ;Wrap (integer)
IFIW ! CHWINT ;Horizontal tab (integer) - not writeable
IFIW ! CHWINT ;Vertical tab (integer) - not writeable
IFIW ! CHWINT ;Form feed (integer)
LOGCHL==.-LOGCHW-1 ;Largest characteristic identifier
;Writing - handler characteristics
HANCHW: IFIW ! RTN ;Illegal characteristic selector
IFIW ! CHWIGN ;Ignore input (boolean)
IFIW ! CHWCHR ;Character characteristic (compound)
IFIW ! CHWBOL ;Control-O passthrough (boolean) - not writeable
IFIW ! CHWRAI ;Raise input (boolean)
IFIW ! CHWECH ;Normal echo (boolean)
IFIW ! CHWIES ;Input escape sequence recognition (boolean)
IFIW ! CHWOES ;Output escape sequence recognition (boolean)
IFIW ! CHWICS ;Input count state (integer)
IFIW ! CHWAP ;Auto prompt (boolean)
IFIW ! CHWBOL ;Error processing (boolean) - not writeable
HANCHL==.-HANCHW-1 ;Largest characteristic identifier
;Table of highest legal characteristic identifiers for each identifier type
ACCLEG: PHYCHL ;Physical
LOGCHL ;Logical
HANCHL ;Handler
;Reading
ACCESR: IFIW ! @PHYCHR(T1) ;Physical
IFIW ! @LOGCHR(T1) ;Logical
IFIW ! @HANCHR(T1) ;Handler
;Reading - physical characteristics
PHYCHR: IFIW ! CHRILL ;Illegal characteristic selector
IFIW ! CHRINP ;Input speed (integer)
IFIW ! CHROUP ;Output speed (integer)
IFIW ! CHRSIZ ;Character size (integer) - always seven.
IFIW ! CHRFLS ;Parity enabled (boolean) - always false
IFIW ! CHRZRO ;Parity type (integer) - always zero
IFIW ! CHRFLS ;Modem present (boolean) - always false
IFIW ! CHRFLS ;Auto baud detect (boolean) - always false
IFIW ! CHRTRU ;Management guaranteed (boolean) - always true
IFIW ! CHRSW1 ;Switch character 1 (string)
IFIW ! CHRSW2 ;Switch character 2 (string)
IFIW ! CHRFLS ;Eight bit (boolean) - always false
IFIW ! CHRTRU ;Management enabled (boolean) - always true
;Reading - logical characteristics
LOGCHR: IFIW ! CHRILL ;Illegal characteristic selector
IFIW ! CHRTRU ;Mode writing allowed (boolean) - always true
IFIW ! CHRVID ;Terminal attributes (integer)
IFIW ! CHRTYP ;Terminal type (string)
IFIW ! CHROFC ;Output flow control (boolean)
IFIW ! CHROPS ;Output page stop (boolean)
IFIW ! CHRFLS ;Flow character passthrough (boolean) - always false
IFIW ! CHRTRU ;Input flow control (boolean) - always true
IFIW ! CHRTRU ;Loss notification (boolean) - always true
IFIW ! CHRWID ;Line width (integer)
IFIW ! CHRPGL ;Page length (integer)
IFIW ! CHRPGL ;Stop length (integer)
IFIW ! CHRZRO ;CR fill (integer) - always zero
IFIW ! CHRZRO ;LF fill (integer) - always zero
IFIW ! CHRWRP ;Wrap (integer)
IFIW ! CHRONE ;Horizontal tab (integer) - always one
IFIW ! CHRONE ;Vertical tab (integer) - always one
IFIW ! CHRONE ;Form feed (integer) - always one
;Reading - handler characteristics
HANCHR: IFIW ! CHRILL ;Illegal characteristic selector
IFIW ! CHRIGN ;Ignore input (boolean)
IFIW ! CHRCHR ;Character characteristic (compound)
IFIW ! CHRFLS ;Control-O passthrough (boolean) - always false
IFIW ! CHRRAI ;Raise input (boolean)
IFIW ! CHRECH ;Normal echo (boolean)
IFIW ! CHRIES ;Input escape sequence recognition (boolean)
IFIW ! CHROES ;Output escape sequence recognition (boolean)
IFIW ! CHRICS ;Input count state (integer)
IFIW ! CHRAP ;Auto prompt (boolean)
IFIW ! CHRFLS ;Error processing (boolean) - always false
SUBTTL DEFINITIONS -- PSI SYSTEM
;Permanent PSI channel definitions
DNCHAN==0 ;DECnet data available
TTCHAN==1 ;Terminal data available
ESCCHN==2 ;Two character escape channel
SWILEV==1 ;Switch sequence level.
OOBLEV==2 ;Out of band level.
DATLEV==3 ;DECnet and terminal input level.
;PSI system storage.
LEV1PC: BLOCK 1
LEV2PC: BLOCK 1
LEV3PC: BLOCK 1
LEVTAB: LEV1PC
LEV2PC
LEV3PC
CHNTAB: XWD DATLEV,MSGINT ;DECnet interrupt
XWD DATLEV,INPENT ;Terminal data available interrupt
XWD SWILEV,REENTR ;Switch sequence channel
BLOCK ^D33
;Pointer to free PSI channel list
PSIPTR: 0
;Allocatable PSI channel table.
PSITAB: BLOCK ^D36
SUBTTL MISCELLANEOUS STORAGE AND DEFINITIONS
RESCAN: BLOCK 1 ;RSCAN% flag
RSCCNT: BLOCK 1 ;RSCAN count
RSCPTR: POINT 7,.+1 ;RSCAN buffer pointer
BLOCK 20 ;RSCAN buffer
STSIZ==200
STACK: BLOCK STSIZ
DDTMOD: BLOCK 1 ;Storage for JFN mode word for DDT command.
FULMSK: 777777,,777760 ;Break mask word with all bits on.
RSKP: AOS 0(P)
RTN: RET
;Pointer to CRLF
CRLFPT: POINT 7,[BYTE(7).CHCRT,.CHLFD,0] ;Pointer to CRLF.
;Operating system types
OS.VMS==7
OS.T20==10
OS.T10==11
OS.UTX==22 ;Ultrix
;Connect block for DNCONN to do poor mans routing
CONBLK: 0 ;Flag word
BLOCK 1 ;Node name pointer is stored here
CTHOBJ ;CTERM object #
0 ;Local object #
^D8 ;Byte size
Repeat 6,<
0
>
Repeat 3,<
.PRIOU ;Output designator
>
SUBTTL PROTOCOL ERROR HANDLER
;Protocol error handler
;CALL PERRHN with
; T1/ byte pointer to error string
; T2/ PC of error
;Never returns.
PERRHN: STKVAR <PERR,PC>
MOVEM T1,PERR ;Save pointer to error text
MOVEM T2,PC ;Save PC
;Print out helpful message
TMSG <
CTERM-SERVER Protocol error, >
MOVE T1,PERR
PSOUT%
;Print out PC
TMSG <
PC = >
MOVEI T1,.PRIOU
MOVEI T3,8
MOVE T2,PC
NOUT%
TRN
JRST FATAL
SUBTTL STKVAR SUPPORT ROUTINE
.XSTKS: ADJSP P,@(CX)
PUSH P,(CX)
CALL 1(CX)
IFSKP.
POP P,CX
MOVNS CX
ADJSP P,(CX)
RETSKP
ENDIF.
POP P,CX
MOVNS CX
ADJSP P,(CX)
RET
SUBTTL INITIALIZE STORAGE
INISTO: SETZM OOBCHA
MOVE T1,[OOBCHA,,OOBCHA+1]
BLT T1,OOBCHA+^D31
MOVEI T1,OOBDEL
MOVEM T1,DELTAB
MOVSI T1,-^D32
DO.
HRRZS OOBTAB(T1)
AOBJN T1,TOP.
ENDDO.
SETZM OLDCOC
MOVE T1,[OLDCOC,,OLDCOC+1]
BLT T1,CHRICT
SETZM RDACTV
SETZM INPIGN
MOVE T1,[INPIGN,,INPIGN+1]
BLT T1,INPSEE
SETZM OUPSKP
SETZM OUPCR
SETZM NETJFN
;Initialize CHNTAB
SETZM CHNTAB+3
MOVE T1,[CHNTAB+3,,CHNTAB+4]
BLT T1,CHNTAB+^D35
;Initialize the allocatable part of the PSI table
MOVEI T1,PSITAB+3 ;Free pointer
MOVEM T1,PSIPTR
MOVE T1,[3,,PSITAB+4] ;Link up the first three
MOVEM T1,PSITAB+3
MOVE T1,[4,,PSITAB+5]
MOVEM T1,PSITAB+4
MOVE T1,[5,,PSITAB+^D23]
MOVEM T1,PSITAB+5
MOVSI T1,-^D12 ;Link up the next twelve
MOVE T2,[^D23,,PSITAB+^D24]
DO.
MOVEM T2,PSITAB+^D23(T1)
ADD T2,[1,,1]
AOBJN T1,TOP.
ENDDO.
HRLZI T1,^D35 ;Make the last oen the end of the list.
MOVEM T1,PSITAB+^D35
SETZM RESCAN ;Some state variables
SETZM RDACTV
SETZM OUPLCK
SETZM OUPSKP
SETZM OUPCR
SETZM FREELF
SETZM CTMSTA
RET
SUBTTL ENTRY
EXCSRT: SETOM SETHOS ; Entry via the EXEC SET HOST command
START: RESET%
MOVE P,[IOWD STSIZ,STACK] ;Initialize the stack
CALL INISTO ;Initialize storage
CALL GETRSC ;Get the RSCAN buffer, if any.
CALL TRMSAV ;Save the current terminal state.
CALL TRMSTP ;Save the current CTERM terminal state.
CALL CMDINI ;Initialize COMND% stuff
CALL GETINS ;Get CTERM switch sequence.
CALL GETNOD ;Get remote node name.
SKIPE DEBUG ;Debugging turned on ?
CALL BUGENT ;Yes. Run debug process.
CALL MSGINI ;Initialize DECnet
CALL PSIINI ;Initialize the PSI system.
CALL TRMINI ;Initialize the terminal for CTERM
CALL FNDINI ;Initialize foundation and CTERM layers.
CALL TIMINI ;Run in the timer process (turn on PSIs)
HALTF% ;Should not return.
JRST .-1
SUBTTL DECNET LAYER -- INITIALIZATION
;Initialization of the DECnet layer
;Make DECnet connection, then call foundation layer init.
;CALL MSGINI with no arguments
;Returns +1 always
MSGINI: HRROI T1,NODSPC ;Point to the file spec storage.
HRROI T2,[ASCIZ\DCN:\] ;DECnet device
SETZ T3,
SOUT%
MOVE T2,NODPTR ;Remote node name
SOUT%
HRROI T2,CTHOBA ;Object type
SOUT%
MOVX T1,<GJ%SHT> ;Get the associated JFN
HRROI T2,NODSPC
GTJFN%
ERJMP [SKIPE QUIET ;Are we quiet? If so, we dont print errors.
JRST TRYNRT ;Yes, let NRT: try and parse it.
JRST ERR] ;No, Print the error and exit.
MOVEM T1,NETJFN
MOVE T2,[OF%WR+OF%RD+FLD(^D8,OF%BSZ)] ;Open the JFN
OPENF%
ERJMP [SKIPE QUIET ;Are we quiet? If so, we dont print errors.
JRST TRYNRT ;Yes, let NRT: try and parse it.
$NOPMR <JRST ERR>
$PMR <
CAIE T1,NSPX24 ;Node name not assigned?
JRST ERR ;No, Print the error and exit.
MOVE Q1,T1 ;Save error code
MOVE T1,NETJFN ;Get rid of
RLJFN% ; JFN
ERJMP MSGIN1 ;Ignore error
MSGIN1: SETO T1, ;Flag that TRYPMR should type message
CALL TRYPMR ;See if PMR will do it
IFNSK. ;No,
MOVE T1,Q1 ;Retrieve error code
JRST ERR ;Print the error and exit
ENDIF.
JRST MSGCON ;Proceed in success path
>
]
SKIPE QUIET ;we don't want msgs.
IFSKP.
TMSG <
[Attempting a connection, >
ENDIF.
;Wait for connect
DO.
MOVE T1,LPVAL ;Get time to wait
DISMS%
MOVE T1,NETJFN ;Get link status
MOVEI T2,.MORLS
MTOPR%
TXNE T3,MO%CON ;Is it connected ?
EXIT. ;Yes.
TXNN T3,MO%ABT+MO%SYN ;Is it disconnected ?
IFSKP.
MOVE T1,NETJFN ;Get JFN
TXO T1,CZ%ABT ;Abort
CLOSF% ;Close JFN
ERJMP .+1 ;Ignore error
HRRZS T3 ;Get disconnect reason code.
$PMR <
CAIE T3,47 ;Node unreachable?
IFSKP. ;Yes, try PMR
SETZ T1, ;No message needed
CALL TRYPMR ;Yes, see if PMR will do it
SKIPA ;No
JRST MSGCON ;Yes, PMR did it, continue
CAIN T1,4 ;PMR failed because of no CTERM at remote?
MOVEI T3,4 ;Yes, indicate that we should try with NRT
ENDIF.
>
SKIPE QUIET ;Don't print msgs.
IFSKP.
TMSG <
CTERM Connect failed - >
ENDIF.
SKIPN QUIET ;If we aren't printing status msgs
CAIN T3,4 ;Or if disconnect reason is no dest process
SKIPN SETHOS ;And SET HOST command was issued - try NRT.
JRST MSGHLT ;nope, just print the error code and exit.
JRST TRYNRT ;yes, seter the correct code and exit.
ENDIF.
LOOP. ;No. Wait some more.
ENDDO.
MSGCON: SKIPE QUIET ;Don't print msgs.
IFSKP.
TMSG <connect OK, ]> ;Succeeded.
CALL SETPNM ;Set the program name to the node name.
ENDIF.
RET
SUBTTL DECNET LAYER -- Poor Mans Routing
;Here to try poor mans routing
;CALL TRYPMR with
; T1/ non-zero if a "connectin..." message is needed
;
;Returns +1 on failure with error code in T1,
; +2 on success with NETJFN containing new JFN
;Preserves T3
$PMR <
EXTERN .DNINI,.DNCON ;Entry points to DNCONN
TRYPMR: SAVEAC <T3,Q1> ;Preserve T3 and Q1
MOVE Q1,T1 ;Save output message flag
MOVE T1,NODPTR ;Get pointer to node name
MOVEM T1,CONBLK+1 ;Save in connect block for DNCONN
MOVEI T1,CONBLK ;Load address of connect block
CALL .DNINI ;Initialize DNCONN
JRST NOPMR ;Failed, take fail return
MOVE T2,NODPTR ;T1 points to host table
TBLUK% ;Is our destination in tables?
ERJMP NOPMR ;Fail return on error
TXNN T2,TL%EXM ;Match?
JRST NOPMR ;No, just return, no point in trying PMR
HRRZ T1,(T1) ;Point to route string block
ADDI T1,2 ;Move to route string
SKIPN (T1) ;Make sure non-zero
JRST NOPMR ;Bad, don't do PMR
HRLI T1,(POINT 7,0) ;Make byte pointer to route string
MOVE T2,NODPTR ;Get pointer to node name
EXCH T1,T2 ;Get AC's for STCMP%
STCMP% ;Compare them
ERJMP NOPMR ;Bad, don't do PMR
SKIPE T1 ;Identical or
TXNE T1,SC%SUB ;not substring?
JRST NOPMR ;Yes, means no real routing, don't do PMR
SKIPN Q1 ;Want message?
IFSKP. ;Yes
TMSG <
[Attempting a connection, >
ENDIF.
MOVEI T1,CONBLK ;Load argument for .DNCON
CALL .DNCON ;Try to connect to remote
RET ;Fail with error code in T1
HRRZM T1,NETJFN ;Save network JFN
RETSKP ;Success return
NOPMR: SETO T1, ;Indicate failure
RET
>
SUBTTL DECNET LAYER -- LINK DOWN
;Here when the link has gone
;CALL MSGHLT with:
; T3/ Link status word
;Does not return.
MSGHLT: HRRZS T3 ;Get disconnect reason code.
HRRO T1,MSGDSC(T3) ;Get the corresponding message
PSOUT% ;Print it out
JRST FATAL ;Go away
MSGDSC: [ASCIZ\No special error\]
[ASCIZ\Resource allocation failure\]
[ASCIZ\Destination node does not exist\]
[ASCIZ\Node shutting down\]
[ASCIZ\Destination process does not exist\]
[ASCIZ\Invalid name field\]
[ASCIZ\Destination process queue overflow\]
[ASCIZ\Unspecified error\]
[ASCIZ\Third party aborted link\]
[ASCIZ\User abort\]
REPEAT 1,<[ASCIZ\Undefined disconnect code\]>
[ASCIZ\Undefined error code\]
REPEAT 9,<[ASCIZ\Undefined disconnect code\]>
[ASCIZ\Connect initiate with illegal destination address\]
[ASCIZ\Connect confirm with illegal destination address\]
[ASCIZ\Connect initiate or confirm with zero source address\]
[ASCIZ\Flow control violation\]
REPEAT 7,<[ASCIZ\Undefined disconnect code\]>
[ASCIZ\Too many connections to node\]
[ASCIZ\Too many connections to destination process\]
[ASCIZ\Access not permitted\]
[ASCIZ\Logical link services mismatch\]
[ASCIZ\Invalid account\]
[ASCIZ\Segment size too small\]
[ASCIZ\Process aborted\]
[ASCIZ\No path to destination node\]
[ASCIZ\Link aborted due to data loss\]
[ASCIZ\Destination process does not exist\]
[ASCIZ\Confirmation of disconnect initiate\]
[ASCIZ\Image data field too long\]
SUBTTL DECNET LAYER -- SEND AND RECEIVE MESSAGE
;Get a DECnet message.
;CALL MSGGET with:
; T1/ byte pointer to buffer
; T2/ max byte count
;On failure, HALTF%s
;ON success, returns +1 with:
; T1/ byte pointer to start of message
; T2/ number of bytes received
MSGGET: STKVAR <COUNT,PTR>
MOVEM T2,COUNT ;Save count
MOVEM T1,PTR ;Save pointer
MOVN T3,T2 ;Max count for SINR%
MOVE T2,T1 ;Byte pointer
MOVE T1,NETJFN ;JFN
SINR% ;Get that message
ERJMP ERR
ADD T3,COUNT ;Compute byte count of message
MOVE T2,T3 ; in proper register.
MOVE T1,PTR ;Byte pointer
BUGMSG (BG.MSI,<Received DECnet message>,T1,T2)
RET
;Send a DECnet message
;CALL MSGPUT with:
; T1/ byte pointer to buffer
; T2/ byte count
;On failure, HALTF%s
;On success, returns +1 with T2/ updated byte pointer
MSGPUT: BUGMSG (BG.MSO,<Sending DECnet message>,T1,T2)
MOVN T3,T2 ;Byte count
MOVE T2,T1 ;Byte pointer
MOVE T1,NETJFN ;JFN
SOUTR% ;Put the message
ERJMP ERR
RET ;Done
SUBTTL DECNET LAYER -- DATA AVAILABLE INTERRUPT
;Here on DECnet data available PSI - process received DECnet message
;On failure HALTF%s
;On success DEBRK%s
MSGINT: CALL MSGIN0 ;Do work
DEBRK%
MSGIN0: SAVET ;Save temporary registers
DO.
MOVEI T1,.FHSLF ;Turn off
DIR% ; interrupts
MOVE T1,NETJFN ;Get link status - link may be down.
MOVEI T2,.MORLS
MTOPR%
TXNN T3,<MO%SYN+MO%ABT> ;Is link down ?
IFSKP.
;Yes.
TMSG <
[Connection broken, back at node >
CALL PRTNOD
TMSG <]
%Link broken - >
JRST MSGHLT
ENDIF.
SIBE% ;Anything here ?
IFSKP.
MOVEI T1,.FHSLF ;No. Turn on
EIR% ; interrupts
RET ;Done.
ENDIF.
;Here when there is a message (or at least one segment of a message)
MOVE T1,REMPTR ;Point to buffer
MOVX T2,REMBSZ ;Buffer size
CALL MSGGET ;(T1,T2/T1,T2) Get a message (may block if multisegment message)
CALL FNDGET ;(T1,T2) Tell foundation about it.
MOVEI T1,.FHSLF ;Turn on
EIR% ; interrupts
LOOP.
ENDDO.
SUBTTL FOUNDATION LAYER -- INITIALIZATION
;Initialization of the foundation layer
;CALL FNDINI with
; DECnet link connected,
; The interrupt system disabled
;Returns +1 always
FNDINI: MOVE T1,REMPTR ;Get the first message.
MOVEI T2,REMBSZ
CALL MSGGET ;(T1,T2/T1,T2)
;Parse the BIND-REQUEST message
GET1BY T1,T2,T3 ;Get the first byte
CAIE T3,.FNDBN ;Is the type BIND-REQUEST ?
PROERR <Expected BIND-REQUEST> ;No. Protocol error.
GET1BY T1,T2,T3 ;Yes. Get the version number.
MOVEM T3,REMVER ; and save it.
GET1BY T1,T2,T3 ;Get the ECO number.
MOVEM T3,REMECO ; and save it.
GET1BY T1,T2,T3 ;Get the customer modification number.
MOVEM T3,REMMOD ; and save it.
GET2BY T1,T2,T3 ;Get the OSTYPE
MOVEM T3,REMOS ; and save it.
GET2BY T1,T2,T3 ;Get the protocols supported
TXNN T3,CM%PRO ;Is CTERM present ?
PROERR <Remote does not support CTERM> ;No. Protocol error.
SUBI T2,10 ;Account for REVISION field
SKIPGE T2
REPEAT 0,<
PROERR <Parse error, count is zero>
MOVE T4,[POINT 8,REMRVP] ;Point to revision field
MOVEI Q1,10 ;The length.
DO.
ILDB T3,T1
IDPB T3,T4
SOJG Q1,TOP.
ENDDO.
GET2BY T1,T2,T3 ;Get remote terminal id.
MOVEM T3,REMTID
>
;Tell user about remote system
TRN
SKIPE QUIET ;Don't print msgs.
IFSKP.
TMSG <
[Remote host is a >
MOVE T1,REMOS
HRRO T1,OSNAM(T1)
PSOUT%
TMSG < system]>
ENDIF.
TMSG <
[TYPE >
CALL PRTINS
TMSG < to return to node >
CALL PRTNOD
TMSG <]
>
;Construct the BIND-ACCEPT message
HRROI T1,[ASCIZ\TTY:\] ;Get the
STDEV% ; TTY
HRRZS T2 ; number
PUT2BY T2,BNDACP ;Put into message
MOVE T1,BNDPTR ;Pointer to the BIND-ACCEPT message
MOVEI T2,BNDACS ;Byte count
CALL MSGPUT ;(T1,T2) Send it off.
;ENTER-MODE, CONFIRM-MODE exchange would take place here.
CALL CTMINI ;Now initialize CTERM
MOVE T1,REMPTR ;Point to buffer
MOVEI T2,REMBSZ ;Buffer size
CALL MSGGET ;(T1,T2/T1,T2) Get next message
CALLRET FNDGET ;And parse it.
SUBTTL FOUNDATION LAYER -- OS NAME TABLE
OSNAM: [ASCIZ\unspecified\]
[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\OS-8\]
[ASCIZ\RTS-8\]
[ASCIZ\RSX-11M+\]
[ASCIZ\Ultrix\]
OSNAML==.-OSNAM
SUBTTL FOUNDATION LAYER -- RECEIVE MESSAGE -- ENTRY AND SHORT ROUTINES
;Here when foundation message has been received.
;CALL FNDGET with:
; T1/ byte pointer
; T2/ byte count
;Returns +1 always
FNDGET: GET1BY T1,T2,T3 ;Get the foundation message type.
CAIG T3,FNDDSL ;Range check.
JRST @FNDDSP(T3) ;(T1,T2,T3) Dispatch on type.
JRST FNDILL ;Range check failure.
;Illegal or unsupported message
FNDILL: PROERR <Invalid foundation message type received>
FNDBND: PROERR <Illegal foundation message type received - bind>
FNDREB: PROERR <Invalid foundation message type received>
FNDBAC: PROERR <Illegal foundation message type received - bind accept>
FNDENT: PROERR <Unsupported foundation message type received - enter mode>
FNDEXI: PROERR <Unsupported foundation message type received - exit mode>
FNDCFM: PROERR <Illegal foundation message type received - confirm mode>
FNDNOM: PROERR <Illegal foundation message type received - no mode>
;Here when UNBIND message received
;T1/ byte pointer to message
;T2/ byte count of message
FNDUNB: GET1BY T1,T2,T3 ;Get reason code
TMSG <
[Connection broken by remote - >
CAILE T3,0 ;Range
CAILE T3,FNDUBL ; check
PROERR <reason out of range> ;Failed.
HRRO T1,FNDUBT(T3) ;Get message
PSOUT% ;Print it.
TMSG <]>
JRST FATAL ;Go away
;Unbind reason code to string translation table.
FNDUBT: [ASCIZ\?\]
[ASCIZ\incompatible versions\]
[ASCIZ\no portal available\]
[ASCIZ\user unbind request\]
[ASCIZ\terminal disconnected\]
[ASCIZ\selected logical terminal or portal is in use\]
[ASCIZ\selected logical terminal or portal does not exist\]
[ASCIZ\selected logical terminal or portal not in REBIND-WAIT state\]
[ASCIZ\rebind collision\]
FNDUBL=.-FNDUBT
SUBTTL FOUNDATION LAYER -- RECEIVE MESSAGE -- COMMON DATA OR MODE DATA
;Here when a COMMON DATA or MODE DATA message is received
;T1/ byte pointer
;T2/ byte count
FNDMOD:
FNDCOM: STKVAR <PTR,COUNT>
GET1BY T1,T2,T3 ;FILL field
DO.
GET2BY T1,T2,T3 ;LENGTH
CAMLE T3,T2 ;Is LENGTH larger than message length ?
PROERR <LENGTH field larger than count> ;Yes. Fail.
MOVE T4,T3 ;No. Find pointer past
ADJBP T4,T1 ; this CTERM message
MOVEM T4,PTR ; and save it.
EXCH T2,T3 ;T2/ LENGTH of this CTERM message
SUB T3,T2 ;T3/ remaining bytes after this CTERM message
MOVEM T3,COUNT ;Save remainder
CALL CTMGET ;(T1,T2) Give it to CTERM layer
SKIPN COUNT ;Any other CTERM messages packed in here ?
RET ;No. Done.
MOVE T1,PTR ;Yes. Get the pointer to it.
MOVE T2,COUNT ; and the count
LOOP. ;Continue.
ENDDO.
ENDSV. ;END STKVAR
SUBTTL CTERM LAYER -- INITIALIZATION
;CALL CTMINI with foundation already initialized
;Returns +1 always
CTMINI: SETOM CTMSTA ;Initializing.
CALL CTMDEF ;Initialize data base
;Send off CTERM INITIATE message
MOVE T1,INIPTR
MOVEI T2,INISIZ
CALL MSGPUT ;(T1,T2)
RET
SUBTTL CTERM LAYER -- SET CTERM DEFAULTS
;Here to set up the default CTERM characteristics for the terminal
;CALL CTMDEF with no arguments and PSI system initialized.
;Returns +1 always
CTMDEF: SAVEAC <Q1>
;Set up special flag for the special characters
MOVEI T1,.CHCNO ;Control-O
MOVX T2,OBSPC
CALL PRECHR
MOVEI T1,.CHCNR ;Control-R
MOVX T2,OBSPC
CALL PRECHR
MOVEI T1,.CHCNU ;Control-U
MOVX T2,OBSPC
CALL PRECHR
MOVEI T1,.CHCNV ;Control-V
MOVX T2,OBSPC
CALL PRECHR
MOVEI T1,.CHCNW ;Control-W
MOVX T2,OBSPC
CALL PRECHR
MOVEI T1,.CHCNX ;Control-X
MOVX T2,OBSPC
CALL PRECHR
MOVEI T1,.CHDEL ;DELETE
MOVX T2,OBSPC
CALL PRECHR
;Set up output discard states
MOVEI T1,1 ;"1" means do not discard output.
MOVEM T1,OUPDS1
MOVEM T1,OUPDS2
;Set up default echo characteristics for control characters.
MOVEI Q1,^D31 ;Loop index
DO.
MOVE T1,Q1 ;Get character
MOVE T2,OOBCHA(T1) ;Get current characteristics
MOVEI T3,EC.STD ;Get standard echo value
STOR T3,OBECH,+T2 ;Pass it down.
CALL PRECHR ;(T1,T2)
SOJGE Q1,TOP.
ENDDO.
MOVEI T1,1 ;Set up characteristics -
SETZM CHRIEX ; Seems to work better under VMS.
; MOVEM T1,CHRIEX ; input escape sequence recognition
MOVEM T1,CHROEX ; output escape sequence recognition
MOVEM T1,CHRICT ; input count state (do not send)
MOVEI T1,4 ;Set
MOVEM T1,LINWRP ; line wrap to wrap
MOVEI T1,.CHESC ;Set no echo
MOVEI T2,EC.NON ; for escape (since esc seq rec is on)
CALL PREECH ;(T1,T2)
CALL CTMSPC ;Set system-specific defaults
RET
;Here for setting up system specific defaultss for those systems which are
;ignorant of the architecturally defined defaults.
;CALL CTMSPC with no arguments
;Returns +1 always
CTMSPC: SAVEAC <Q1>
MOVE T1,REMOS ;Get remote OS type
CAIE T1,OS.VMS
RET
;Set up control characters to not echo.
MOVEI Q1,^D31 ;Loop index
DO.
MOVE T1,Q1 ;Get character
MOVE T2,OOBCHA(T1) ;Get current characteristics
MOVEI T3,EC.NON ;Get standard echo value
STOR T3,OBECH,+T2 ;Pass it down.
CALL PRECHR ;(T1,T2)
SOJGE Q1,TOP.
ENDDO.
;There are some characters that echo.
MOVEI T1,.CHLFD ;Get LF
MOVE T2,OOBCHA(T1) ;Get current characteristics
MOVEI T3,EC.SLF ;Get self code
STOR T3,OBECH,+T2 ;Pass it down.
CALL PRECHR ;(T1,T2) Set it.
MOVEI T1,.CHCRT ;Get CR
MOVE T2,OOBCHA(T1) ;Get current characteristics
MOVEI T3,EC.SLF ;Get self code
STOR T3,OBECH,+T2 ;Pass it down.
CALL PRECHR ;(T1,T2) Set it.
MOVEI T1,.CHFFD ;Get FF
MOVE T2,OOBCHA(T1) ;Get current characteristics
MOVEI T3,EC.STD ;Get standard code
STOR T3,OBECH,+T2 ;Pass it down.
CALL PRECHR ;(T1,T2) Set it.
MOVEI T1,.CHTAB ;Get TAB
MOVE T2,OOBCHA(T1) ;Get current characteristics
MOVEI T3,EC.SLF ;Get self code
STOR T3,OBECH,+T2 ;Pass it down.
CALL PRECHR ;(T1,T2) Set it.
MOVEI T1,.CHCNW ;Get control-W
MOVE T2,OOBCHA(T1) ;Turn off the special flag
SETZ T3,
STOR T3,OBSPC,+T2
CALL PRECHR ;(T1,T2) Set it.
RET
SUBTTL CTERM LAYER -- MESSAGE RECEIVED -- ENTRY AND SHORT MESSAGES
;Here when a CTERM message was received.
;CALL CTMGET with
; T1/ byte pointer to CTERM message
; T2/ byte count
;Returns +1 always
CTMGET: BUGMSG (BG.CTR,<Received CTERM message>,T1,T2)
GET1BY T1,T2,T3 ;Get CTERM type
CAIGE T3,CTMDSL ;Range check.
JRST @CTMDSP(T3) ;Go do it.
JRST CTMILL ;Fail.
;Here when invalid or illegal message received
CTMRED:
CTMOOB:
CTMWRC:
CTMDSC:
CTMILL: PROERR< Illegal or invalid CTERM message type received>
;Here when a INITIATE message was received
;CALL CTMINT with
; T1/ byte pointer
; T2/ byte count
;Returns +1 always
CTMINT: SKIPN CTMSTA ;Are we initializing ?
PROERR <Initiate message received in wrong state>
SETZM CTMSTA ;Yes. Finished init.
RET
;Here when a CLEAR-INPUT message was received
;CALL CTMCLI with
; T1/ byte pointer
; T2/ byte count
;Returns +1 always
CTMCLI: MOVEI T1,.PRIIN ;() Clear
CFIBF% ; typeahead buffer
CALLRET INPCIB ;() Clear input buffer
;Here when an UNREAD message was received
;CALL CTMUNR with
; T1/ byte pointer
; T2/ byte count
;Returns +1 always
CTMUNR: SKIPN RDACTV ;Is there a READ active ?
RET ;No. That's OK, just ignore it.
GET1BY T1,T2,T3 ;Yes. Get flags byte
TRNN T3,1 ;Test the flag
IFSKP.
MOVEI T1,.PRIIN ;It is set. Is typeahead buffer empty ?
SIBE%
IFSKP.
SKIPN INPSEE ;Yes. Now check the input buffer.
RET ;It is empty.
ENDIF.
ENDIF.
MOVEI T1,.TMUNR ;Terminate the read with an unread
SETZ T2, ;No terminator
CALLRET INPEND ;(T1,T2)
SUBTTL CTERM LAYER -- MESSAGE RECEIVED -- START-READ
;Here when a START-READ message was received
;Parse it.
;CALL CTMSTR with
; T1/ byte pointer
; T2/ byte count
;Returns +1 always
CTMSTR: SKIPE RDACTV ;Is there a read active ?
PROERR <START-READ message received when READ is active>
MOVE T4,INPFPT ;Get pointer to flags storage
GET1BY T1,T2,T3 ;Get first flag byte
IDPB T3,T4 ;Save first flag byte
GET1BY T1,T2,T3 ;Get second flag byte
IDPB T3,T4 ;Save it
GET1BY T1,T2,T3 ;Get third flag byte
IDPB T3,T4 ;Save it
GET2BY T1,T2,T3 ;Get MAX-LENGTH
MOVEM T3,INPLEN ;Save it
GET2BY T1,T2,T3 ;Get END-OF-DATA
MOVEM T3,INPEOD ;Save it
GET2BY T1,T2,T3 ;Get TIMEOUT
MOVEM T3,INPTIM ;Save it.
GET2BY T1,T2,T3 ;Get END-OF-PROMPT
MOVEM T3,INPEOP ;Save it.
GET2BY T1,T2,T3 ;Get START-OF-DISPLAY
MOVEM T3,INPSOD ;Save it.
GET2BY T1,T2,T3 ;Get LOW-WATER.
MOVEM T3,INPLOW ;Save it.
CALL CTMTMG ;(T1,T2/T1,T2) Get TERMINATOR-SET.
MOVEM T1,INPBPT ;Save pointer to data.
MOVEM T2,INPBCT ;Save count of data.
SETOM RDACTV ;Say there's a read active.
CALL INPSTR ;Inform input process.
RET
;Here to interpret the TERMINATOR-SET of a received START-READ message
;CALL CTMTMG with
; T1/ byte pointer
; T2/ byte count
;Uses T1-T4
;Returns +1 always with T1 and T2 updated
CTMTMG: SAVEAC <Q1,Q2>
OPSTR <SKIPN Q1,>,RDTRM,+INPFLG ;Using previous read's terminators ?
IFSKP.
SETZM INPTBM ;No. Clear out the terminator set
MOVE T3,[XWD INPTBM,INPTBM+1]
BLT T3,INPTBM+INPTML-1
ENDIF.
GET1BY T1,T2,T3 ;Get length of terminator set in message
CAIE Q1,1 ;Using terminator set in message ?
IFSKP.
JUMPE T3,RTN ;Yes. If no set, done.
MOVE Q2,[POINT 8,INPTBM] ;Point to input process's terminator set.
DO.
GET1BY T1,T2,T4 ;Yes. Get a byte.
MOVE T4,SWPBYT(T4) ;Swap the bits around
IDPB T4,Q2 ;Save it
SOJG T3,TOP. ;Continue.
ENDDO.
ELSE.
CAMGE T2,T3 ;Not using terminator set. Message parse error ?
PROERR <Parse error in terminator set, no bytes left> ;Yes.
SUB T2,T3 ;No. Update count
ADJBP T3,T1 ;Update
MOVE T1,T3 ; pointer
CAIE Q1,2 ;Using universal terminator set ?
IFSKP.
MOVE T4,INPUNV ;Yes. Get it (in first word only)
MOVEM T4,INPTBM ; and set it.
ENDIF.
ENDIF.
RET
SUBTTL CTERM LAYER -- MESSAGE RECEIVED -- WRITE
;Here when a WRITE message was received
;CALL CTMWRI with
; T1/ byte pointer
; T2/ byte count
;Returns +1 always
CTMWRI: MOVE T4,WRFPTR
GET1BY T1,T2,T3 ;Get flags (1)
IDPB T3,T4 ;Save
GET1BY T1,T2,T3 ;Get flags (2)
IDPB T3,T4 ;Save
GET1BY T1,T2,T3 ;Get prefix
IDPB T3,T4 ;Save
GET1BY T1,T2,T3 ;Get postfix
IDPB T3,T4 ;Save
MOVEM T2,OUPBCT ;Save count of data
MOVEM T1,OUPBPT ;Save pointer to data
LOAD T1,WRDSC,+WRFLAG ;Get discard state flag
MOVEM T1,OUPOUT ;Stash it
LOAD T1,WRBOM,+WRFLAG ;Get BOM flag
MOVEM T1,OUPBOM ;Stash it
LOAD T1,WREOM,+WRFLAG ;Get EOM flag
MOVEM T1,OUPEOM ;Stash it
SKIPN OUPBOM ;Beginning of message ?
IFSKP.
LOAD T1,WRLOK,+WRFLAG ;Yes. Set up the rest of the flags. The lock
MOVEM T1,OUPLOK ; definition
LOAD T1,WRPFX,+WRFLAG ;The
MOVEM T1,OUPPFX ; prefix code
LOAD T1,WRPFC,+WRFLAG ;The
MOVEM T1,OUPPFC ; prefix character/count
LOAD T1,WRPSX,+WRFLAG ;The
MOVEM T1,OUPPSX ; postfix code
LOAD T1,WRPSC,+WRFLAG ;The
MOVEM T1,OUPPSC ; postfix character/count
LOAD T1,WRTRN,+WRFLAG ;The
MOVEM T1,OUPTRN ; transparent flag,
LOAD T1,WRCMP,+WRFLAG ;The
MOVEM T1,OUPCMP ; completion requested flag
LOAD T1,WRNWL,+WRFLAG ;The
MOVEM T1,OUPNWL ; newline flag
ENDIF.
CALL OUPENT ;Give to output process
RET
SUBTTL CTERM LAYER -- MESSAGE RECEIVED -- READ CHARACTERISTICS
;Here when a READ-CHARACTERISTICS message was received
;CALL CTMRDC with
; T1/ byte pointer
; T2/ byte count
;Returns +1 always
;Note: unknown characteristics are ignored.
CTMRDC: TRVAR <INPTR,INCNT,OUTPTR,OUTCNT> ;Used by all subroutines.
MOVEM T1,INPTR ;Initialize pointer to incoming message
MOVEM T2,INCNT ;Initialize count to incoming message
MOVEI T1,CHACSZ ;Size of CTERM header
MOVEM T1,OUTCNT ;Initialize outgoing message count
HRROI T1,-1 ;Get ILDB pointer
ADJBP T1,CHASL1 ; to first field
MOVEM T1,OUTPTR ;Initialize outgoing message pointer
GET1BY INPTR,INCNT,T1 ;Go past flag byte
DO.
GET1BY INPTR,INCNT,T1 ;Get characteristic identifier
GET1BY INPTR,INCNT,T2 ;Get identifier type
CAILE T2,ACCESL ;Is identifier type legal ?
IFSKP.
SKIPE T1 ;Yes. Is
CAMLE T1,ACCLEG(T2) ; characteristic identifier legit ?
IFSKP.
IDPB T1,OUTPTR ;Yes. Put char id into outgoing message
AOS OUTCNT ;Update count
IDPB T2,OUTPTR ;Put ident type into outgoing message
AOS OUTCNT ;Update count
CALL @ACCESR(T2) ;(T1,T2) Handle VALUE field; update the TRVARs
ENDIF.
ENDIF.
SKIPLE INCNT ;Any more ?
LOOP. ;Yes.
ENDDO.
MOVE T2,OUTCNT ;Get count of CTERM message
PUT2BY T2,CHASZZ ;Stick into message
MOVE T1,CHAPTR ;Point to message
MOVE T2,OUTCNT ;Add in size of
ADDI T2,CHAHDR ; foundation header/
CALL MSGPUT ;(T1,T2) Send out message
RET
;Here when an illegal READ-CHARACTERISTICS message was received
;CALL CHRILL with
; INPTR, INCNT, OUTPTR, OUTCNT set up
;Returns +1 always with INPTR, INCNT, OUTCNT, OUTPTR updated and
;value inserted at OUTPTR
CHRILL: PROERR <Illegal READ-CHARACTERISTICS message was received>
SETZM INCNT
RET
;Here when a READ-CHARACTERISTICS message was received, for which the
;characteristic is boolean and always false
;CALL CHRFLS with
; INPTR, INCNT, OUTPTR, OUTCNT set up
;Returns +1 always with INPTR, INCNT, OUTCNT, OUTPTR updated and
;value inserted at OUTPTR
;VALUE field set in CHARACTERISTICS message
CHRFLS: SETZ T1, ;VALUE field is false
IPT1BY T1,OUTPTR,OUTCNT ;Put into message
RET
;Here when a READ-CHARACTERISTICS message was received, for which the
;characteristic is boolean and always true
;CALL CHRTRU with
; INPTR, INCNT, OUTPTR, OUTCNT set up
;Returns +1 always with INPTR, INCNT, OUTCNT, OUTPTR updated and
;value inserted at OUTPTR
CHRTRU: MOVEI T1,1 ;VALUE field is true
IPT1BY T1,OUTPTR,OUTCNT ;Put into message
RET
;Here when a READ-CHARACTERISTICS message was received, for which the
;characteristic is integer and always zero
;CALL CHRZRO with
; INPTR, INCNT, OUTPTR, OUTCNT set up
;Returns +1 always with INPTR, INCNT, OUTCNT, OUTPTR updated and
;value inserted at OUTPTR
CHRZRO: SETZ T1, ;VALUE field is zero
IPT2BY T1,OUTPTR,OUTCNT ;Put into message
RET
;Here when a READ-CHARACTERISTICS message was received, for which the
;characteristic is integer and always one
;CALL CHRONE with
; INPTR, INCNT, OUTPTR, OUTCNT set up
;Returns +1 always with INPTR, INCNT, OUTCNT, OUTPTR updated and
;value inserted at OUTPTR
CHRONE: MOVEI T1,1 ;VALUE field is one
IPT2BY T1,OUTPTR,OUTCNT ;Put into message
RET
;Here when a READ-CHARACTERISTICS message was received, for the character size
;CALL CHRSIZ with
; INPTR, INCNT, OUTPTR, OUTCNT set up
;Returns +1 always with INPTR, INCNT, OUTCNT, OUTPTR updated and
;value inserted at OUTPTR
CHRSIZ: MOVEI T1,7 ;VALUE field is seven
IPT2BY T1,OUTPTR,OUTCNT ;Put into message
RET
;Here when a READ-CHARACTERISTICS message was received for input speed
;CALL CHRINP with
; INPTR, INCNT, OUTPTR, OUTCNT set up
;Returns +1 always with INPTR, INCNT, OUTCNT, OUTPTR updated and
;value inserted at OUTPTR
CHRINP: MOVEI T1,.PRIIN ;Get speed
MOVEI T2,.MORSP
MTOPR%
HLRZ T1,T3 ;Isolate input speed
CAIN T1,777777 ;Speed "indeterminate"?
MOVEI T1,^D9600 ;Set to 9600; keeps VMS happy.
IPT2BY T1,OUTPTR,OUTCNT ;Put into message
RET
;Here when a READ-CHARACTERISTICS message was received for output speed
;CALL CHROUP with
; INPTR, INCNT, OUTPTR, OUTCNT set up
;Returns +1 always with INPTR, INCNT, OUTCNT, OUTPTR updated and
;value inserted at OUTPTR
CHROUP: MOVEI T1,.PRIIN ;Get speed
MOVEI T2,.MORSP
MTOPR%
HRRZS T3 ;Isolate output speed
CAIN T3,777777 ;Speed "indeterminate"?
MOVEI T3,^D9600 ;Set to 9600; keeps VMS happy.
IPT2BY T3,OUTPTR,OUTCNT ;Put into message
RET
;Here when a READ-CHARACTERISTICS message was received for switch character 1
;CALL CHRSW1 with
; INPTR, INCNT, OUTPTR, OUTCNT set up
;Returns +1 always with INPTR, INCNT, OUTCNT, OUTPTR updated and
;value inserted at OUTPTR
CHRSW1: MOVEI T1,.PRIIN ;Get switch sequence
MOVEI T2,.MORTC
MTOPR%
MOVEI T1,1 ;Get length of string
IPT1BY T1,OUTPTR,OUTCNT ;Put into message
LDB T1,[POINT 7,T3,28] ;Get first character
IPT1BY T1,OUTPTR,OUTCNT ;Put into message
RET
;Here when a READ-CHARACTERISTICS message was received for switch character 2
;CALL CHRSW2 with
; INPTR, INCNT, OUTPTR, OUTCNT set up
;Returns +1 always with INPTR, INCNT, OUTCNT, OUTPTR updated and
;value inserted at OUTPTR
CHRSW2: MOVEI T1,.PRIIN ;Get switch sequence
MOVEI T2,.MORTC
MTOPR%
MOVEI T1,1 ;Get length of string
IPT1BY T1,OUTPTR,OUTCNT ;Put into message
IPT1BY T3,OUTPTR,OUTCNT ;Put character into message
RET
;Here when a READ-CHARACTERISTICS message was received for terminal type
;CALL CHRTYP with
; INPTR, INCNT, OUTPTR, OUTCNT set up
;Returns +1 always with INPTR, INCNT, OUTCNT, OUTPTR updated and
;value inserted at OUTPTR
CHRTYP: MOVE T2,TRMTYP ;Get terminal name
HLRZ T1,TRMSTB(T2) ; length
IPT1BY T1,OUTPTR,OUTCNT ;Put into message
HRRO T2,TRMSTB(T2) ;Get pointer to terminal name
MOVN T3,T1 ;Get negative length of name
ADDM T1,OUTCNT ;Update message count
MOVE T1,OUTPTR ;Point to message
SOUT% ;Move string.
MOVEM T1,OUTPTR ;Update message pointer
RET
;Here when a READ-CHARACTERISTICS message was received for output flow control
;CALL CHROFC with
; INPTR, INCNT, OUTPTR, OUTCNT set up
;Returns +1 always with INPTR, INCNT, OUTCNT, OUTPTR updated and
;value inserted at OUTPTR
CHROFC: MOVEI T1,.PRIIN ;Get JFN mode word
RFMOD%
LOAD T1,TT%PGM,+T2 ;Get output flow control field
IPT1BY T1,OUTPTR,OUTCNT ;Put into message
RET
;Here when a READ-CHARACTERISTICS message was received for output page stop
;CALL CHROPS with
; INPTR, INCNT, OUTPTR, OUTCNT set up
;Returns +1 always with INPTR, INCNT, OUTCNT, OUTPTR updated and
;value inserted at OUTPTR
CHROPS: MOVEI T1,.PRIIN ;Get output page stop
MOVEI T2,.MORXO
MTOPR%
IPT1BY T3,OUTPTR,OUTCNT ;Put into message
RET
;Here when a READ-CHARACTERISTICS message was received for page width
;CALL CHRWID with
; INPTR, INCNT, OUTPTR, OUTCNT set up
;Returns +1 always with INPTR, INCNT, OUTCNT, OUTPTR updated and
;value inserted at OUTPTR
CHRWID: MOVE T1,LINWID ;Get page width
IPT2BY T1,OUTPTR,OUTCNT ;Put into message
RET
;Here when a READ-CHARACTERISTICS message was received for page length
;CALL CHRPGL with
; INPTR, INCNT, OUTPTR, OUTCNT set up
;Returns +1 always with INPTR, INCNT, OUTCNT, OUTPTR updated and
;value inserted at OUTPTR
CHRPGL: MOVEI T1,.PRIIN ;Get page length
MOVEI T2,.MORLL
MTOPR%
IPT2BY T3,OUTPTR,OUTCNT ;Put into message
RET
;Here when a READ-CHARACTERISTICS message was received for wrap
;CALL CHRWRP with
; INPTR, INCNT, OUTPTR, OUTCNT set up
;Returns +1 always with INPTR, INCNT, OUTCNT, OUTPTR updated and
;value inserted at OUTPTR
CHRWRP: MOVE T1,LINWRP ;Get the characteristic
IPT2BY T1,OUTPTR,OUTCNT ;Put into message
RET
;Here when a READ-CHARACTERISTICS message was received for ignore input
;CALL CHRIGN with
; INPTR, INCNT, OUTPTR, OUTCNT set up
;Returns +1 always with INPTR, INCNT, OUTCNT, OUTPTR updated and
;value inserted at OUTPTR
CHRIGN: MOVE T1,INPIGN ;Get the characteristic
IPT1BY T1,OUTPTR,OUTCNT ;Put into message
RET
;Here when a READ-CHARACTERISTICS message was received for character attributes
;CALL CHRCHR with
; INPTR, INCNT, OUTPTR, OUTCNT set up
;Returns +1 always with INPTR, INCNT, OUTCNT, OUTPTR updated and
;value inserted at OUTPTR
CHRCHR: GET1BY INPTR,INCNT,T3 ;Get the character
IPT1BY T3,OUTPTR,OUTCNT ;Put character into message
SETZ T2, ;Mask is always zero - also use for char'istics
IPT1BY T2,OUTPTR,OUTCNT ;Put mask into message.
CAIL T3,^D32 ;Is character a control character ?
IFSKP.
MOVE T2,OOBCHA(T3) ;Yes. Get characteristics,
ELSE.
CAIN T2,.CHDEL ;No. Is it DELETE ?
MOVE T2,DELCHA ;Yes. Get characteristics.
ENDIF.
IPT1BY T2,OUTPTR,OUTCNT ;Put characteristics into message
RET
;Here when a READ-CHARACTERISTICS message was received for raise input
;CALL CHRRAI with
; INPTR, INCNT, OUTPTR, OUTCNT set up
;Returns +1 always with INPTR, INCNT, OUTCNT, OUTPTR updated and
;value inserted at OUTPTR
CHRRAI: MOVEI T1,.PRIIN ;Get the characteristic
RFMOD%
LOAD T1,TT%LIC,+T2
IPT1BY T1,OUTPTR,OUTCNT ;Put into message
RET
;Here when a READ-CHARACTERISTICS message was received for echo
;CALL CHRECH with
; INPTR, INCNT, OUTPTR, OUTCNT set up
;Returns +1 always with INPTR, INCNT, OUTCNT, OUTPTR updated and
;value inserted at OUTPTR
CHRECH: MOVEI T1,.PRIIN ;Get the characteristic
RFMOD%
LOAD T1,TT%ECO,+T2
IPT1BY T1,OUTPTR,OUTCNT ;Put into message
RET
;Here when a READ-CHARACTERISTICS message was received for input esc seq recog
;CALL CHRIES with
; INPTR, INCNT, OUTPTR, OUTCNT set up
;Returns +1 always with INPTR, INCNT, OUTCNT, OUTPTR updated and
;value inserted at OUTPTR
CHRIES: MOVE T1,CHRIEX ;Get the characteristic
IPT1BY T1,OUTPTR,OUTCNT ;Put into message
MOVEI T1,.CHESC ;Set up echo for escape
SKIPN CHRIEX ;Is escape recognition on ?
IFSKP.
MOVEI T2,EC.NON ;Yes. Turn echo off.
ELSE.
LOAD T2,OBECH,+OOBCHA(T1) ;No. Get echo characteristic.
ENDIF.
CALL PREECH ;(T1,T2). Set echo.
RET
;Here when a READ-CHARACTERISTICS message was received for output esc seq recog
;CALL CHROES with
; INPTR, INCNT, OUTPTR, OUTCNT set up
;Returns +1 always with INPTR, INCNT, OUTCNT, OUTPTR updated and
;value inserted at OUTPTR
CHROES: MOVE T1,CHROEX ;Get the characteristic
IPT1BY T1,OUTPTR,OUTCNT ;Put into message
RET
;Here when a READ-CHARACTERISTICS message was received for input count state
;CALL CHRICS with
; INPTR, INCNT, OUTPTR, OUTCNT set up
;Returns +1 always with INPTR, INCNT, OUTCNT, OUTPTR updated and
;value inserted at OUTPTR
CHRICS: MOVE T1,CHRICT ;Get the characteristic
IPT2BY T1,OUTPTR,OUTCNT ;Put into message
RET
;Here when a READ-CHARACTERISTICS message was received for auto prompt
;CALL CHRAP with
; INPTR, INCNT, OUTPTR, OUTCNT set up
;Returns +1 always with INPTR, INCNT, OUTCNT, OUTPTR updated and
;value inserted at OUTPTR
CHRAP: MOVE T1,CHRATP ;Get the characteristic
IPT1BY T1,OUTPTR,OUTCNT ;Put into message
RET
;Here when a READ-CHARACTERISTICS message was received for terminal attributes
;CALL CHRVID with
; INPTR, INCNT, OUTPTR, OUTCNT set up
;Returns +1 always with INPTR, INCNT, OUTCNT, OUTPTR updated and
;value inserted at OUTPTR
CHRVID: LOAD T1,TMVID,+TRMCHA ;Get video flag
LSH T1,1 ;Put into position
IORI T1,1 ;Set "known" flag.
IPT2BY T1,OUTPTR,OUTCNT ;Put into message
RET
ENDTV. ;End TRVAR in CTMRDC
SUBTTL CTERM LAYER -- MESSAGE RECEIVED -- CHARACTERISTICS
;Here when a CHARACTERISTICS message was received
;CALL CTMCHA with
; T1/ byte pointer
; T2/ byte count
;Returns +1 always
;Note: unknown characteristics cause rest of message to be ignored.
CTMCHA: TRVAR <PTR,CNT> ;Used by all subroutines.
MOVEM T1,PTR ;Initialize pointer to incoming message
MOVEM T2,CNT ;Initialize count to incoming message
GET1BY PTR,CNT,T1 ;Go past flag byte
DO.
GET1BY PTR,CNT,T1 ;Get characteristic identifier
GET1BY PTR,CNT,T2 ;Get identifier type
CAILE T2,ACCESL ;Is identifier type legal ?
RET ;No. Give up.
SKIPE T1 ;Yes. Is
CAML T1,ACCLEG(T2) ; characteristic identifier legit ?
RET ;No. Give up.
CALL @ACCESW(T2) ;(T1,T2) Uses and update the above TRVARs
SKIPLE CNT ;Any more ?
LOOP. ;Yes.
ENDDO.
RET ;Done.
;Here to eat up a non writeable boolean (1 byte) characteristic
;CALL CHWBOL
; PTR, CNT set up
;Returns +1 always with PTR and CNT updated.
CHWBOL: GET1BY PTR,CNT,T1
RET
;Here to eat up a non writeable integer characteristic
;CALL CHWINT
; PTR, CNT set up
;Returns +1 always with PTR and CNT updated.
CHWINT: GET2BY PTR,CNT,T1
RET
;Here to set up terminal type
;CALL CHWSTG
; PTR, CNT set up
;Returns +1 always with PTR and CNT updated.
CHWSTG: STKVAR <<STRNG,2>>
GET1BY PTR,CNT,T1 ;Get count byte
CAIL T1,^D9 ;Check size
PROERR <Terminal type too large>
MOVEI T2,STRNG
HRLI T2,(POINT 7,0)
DO. ;Suck up the string.
SOJL T1,ENDLP.
GET1BY PTR,CNT,T3
IDPB T3,T2
LOOP.
ENDDO.
SETZ T3,
IDPB T3,T2 ;Null terminate string
MOVEI T2,STRNG ;Point to string.
HRLI T2,(POINT 7,0)
MOVEI T1,TTYTBL ;Point to terminal type table
TBLUK% ;(T1,T2/T1,T2)
TXNN T2,TL%EXM ;Got a match ?
IFSKP.
HRRZ T2,(T1) ;Yes. Get type.
MOVEI T1,.PRIIN
STTYP% ;(T1,T2) Set the type
ENDIF.
RET
;Here to set the input speed characteristic
;CALL CHWINP with
; PTR, CNT set up
;Returns +1 always with PTR and CNT updated.
CHWINP: GET2BY PTR,CNT,T4 ;Get desired speed
MOVEI T1,.PRIIN ;Get current speed
MOVEI T2,.MORSP
MTOPR% ;(T1,T2/T3)
HRL T3,T4 ;Set input speed
MOVEI T2,.MOSPD
MTOPR% ;(T1,T2,T3)
RET
;Here to set the output speed characteristics
;CALL CHWOUP with
; PTR, CNT set up
;Returns +1 always with PTR and CNT updated.
CHWOUP: GET2BY PTR,CNT,T4 ;Get desired speed
MOVEI T1,.PRIIN ;Get current speed
MOVEI T2,.MORSP
MTOPR% ;(T1,T2/T3)
HRR T3,T4 ;Set input speed
MOVEI T2,.MOSPD
MTOPR% ;(T1,T2,T3)
RET
;Here to set switch character 1
;CALL CHWSW1 with
; PTR, CNT set up
;Returns +1 always with PTR and CNT updated.
CHWSW1: GET1BY PTR,CNT,T4 ;Get length of string (1)
GET1BY PTR,CNT,T4 ;Get character
MOVEI T1,.PRIIN ;Get current switch sequence
MOVEI T2,.MORTC
MTOPR% ;(T1,T2/T3)
DPB T4,[POINT 7,T3,28] ;Set first character
MOVEI T2,.MOTCE
MTOPR% ;(T1,T2,T3)
RET
;Here to set switch character 2
;CALL CHWSW2 with
; PTR, CNT set up
;Returns +1 always with PTR and CNT updated.
CHWSW2: GET1BY PTR,CNT,T4 ;Get length of string (1)
GET1BY PTR,CNT,T4 ;Get desired character
MOVEI T1,.PRIIN ;Get current switch sequence
MOVEI T2,.MORTC
MTOPR% ;(T1,T2/T3)
DPB T4,[POINT 7,T3,35] ;Set second character
MOVEI T2,.MOTCE
MTOPR% ;(T1,T2,T3)
RET
;Here to set output flow control
;CALL CHWOFC with
; PTR, CNT set up
;Returns +1 always with PTR and CNT updated.
CHWOFC: GET1BY PTR,CNT,T4 ;Get setting
MOVEI T1,.PRIIN ;Get current JFN mode word
RFMOD% ;(T1/T2)
STOR T4,TT%PGM,+T2 ;Change it
STPAR% ;(T1,T2)
RET
;Here to set output page stop
;CALL CHWOPS with
; PTR, CNT set up
;Returns +1 always with PTR and CNT updated.
CHWOPS: GET1BY PTR,CNT,T3 ;Get setting
MOVEI T1,.PRIIN ;Set it
MOVEI T2,.MOXOF
MTOPR% ;(T1,T2,T3)
RET
;Here to set page width
;CALL CHWWID with
; PTR, CNT set up
;Returns +1 always with PTR and CNT updated.
CHWWID: GET2BY PTR,CNT,T3 ;Get width
MOVEM T3,LINWID ;Set our copy of characteristic
MOVE T4,LINWRP ;Get wrap characteristic
CAIE T4,1 ;Is it
CAIN T4,2 ; no wrap ?
RET ;Yes. Done.
MOVEI T1,.PRIIN ;It is wrap. So set it.
MOVEI T2,.MOSLW
MTOPR% ;(T1,T2,T3)
RET
;Here to set page length
;CALL CHWPGL with
; PTR, CNT set up
;Returns +1 always with PTR and CNT updated.
CHWPGL: GET2BY PTR,CNT,T3 ;Get width
MOVEI T1,.PRIIN
MOVEI T2,.MOSLL
MTOPR% ;(T1,T2,T3) Set it.
RET
;Here to set ignore input
;CALL CHWIGN with
; PTR, CNT set up
;Returns +1 always with PTR and CNT updated.
CHWIGN: GET1BY PTR,CNT,T3 ;Get setting
MOVEM T3,INPIGN ;Save it
RET ;Done.
;Here to set the input count state
;CALL CHWICS with
; PTR, CNT set up
;Returns +1 always with PTR and CNT updated.
CHWICS: GET2BY PTR,CNT,T3 ;Get setting
MOVEM T3,CHRICT ;Set it.
RET ;Done.
;Here to set line wrap
;CALL CHWWRP with
; PTR, CNT set up
;Returns +1 always with PTR and CNT updated.
CHWWRP: GET2BY PTR,CNT,T4 ;Get setting
MOVEM T4,LINWRP ;Set wrap characteristic.
SETZ T3, ;Assume nowrap (set line width to zero)
CAIE T4,1 ;Is it
CAIN T4,2 ; wrap ?
IFSKP.
MOVE T3,LINWID ;Yes. Get width.
ENDIF.
MOVEI T1,.PRIIN ;Set monitor's line width
MOVEI T2,.MOSLW
MTOPR% ;(T1,T2,T3)
RET
;Here to set a character's attributes
;CALL CHWCHR with
; PTR, CNT set up
;Returns +1 always with PTR and CNT updated.
CHWCHR: GET1BY PTR,CNT,T1 ;Get character.
CAIL T1,^D32 ;Is it a control character ?
IFSKP.
MOVE T4,OOBCHA(T1) ;Yes. Get current characteristic.
ELSE.
CAIN T3,.CHDEL ;No. Is it DELETE ?
MOVE T4,DELCHA ;Yes. Get current characteristic.
ENDIF.
GET1BY PTR,CNT,T3 ;Get change mask.
GET1BY PTR,CNT,T2 ;Get new characteristic.
AND T2,T3 ;Mask out unchanged fields in new
ANDCA T3,T4 ;Mask out changed fields in old
IOR T2,T3 ;Combine for new setting.
CALL PRECHR ;(T1,T2) Set characteristic.
RET
;Here to set raise input
;CALL CHWRAI with
; PTR, CNT set up
;Returns +1 always with PTR and CNT updated.
CHWRAI: GET1BY PTR,CNT,T3 ;Get setting
MOVEI T1,.PRIIN ;Get current JFN mode word setting
RFMOD% ;(T1/T2)
STOR T3,TT%LIC,+T2 ;Change
STPAR% ;(T1,T2) it
RET ;Done.
;Here to set normal echo
;CALL CHWECH with
; PTR, CNT set up
;Returns +1 always with PTR and CNT updated.
CHWECH: GET1BY PTR,CNT,T3 ;Get setting
MOVEI T1,.PRIIN ;Get current JFN mode word setting
RFMOD% ;(T1/T2)
STOR T3,TT%ECO,+T2 ;Change
STPAR% ;(T1,T2) it
RET ;Done.
;Here to set input escape sequence recognitin
;CALL CHWIES with
; T1/ byte pointer into CHARACTERISTICS message
; T2/ byte count
CHWIES: GET1BY PTR,CNT,T3 ;Get setting
MOVEM T3,CHRIEX ;Set it.
RET ;Done.
;Here to set output escape sequence recognition
;CALL CHWOES with
; T1/ byte pointer into CHARACTERISTICS message
; T2/ byte count
CHWOES: GET1BY PTR,CNT,T3 ;Get setting
MOVEM T3,CHROEX ;Set it.
RET ;Done.
;Here to set auto prompt
;CALL CHWAP with
; T1/ byte pointer into CHARACTERISTICS message
; T2/ byte count
CHWAP: GET1BY PTR,CNT,T3 ;Get setting
MOVEM T3,CHRATP ;Set it.
RET ;Done.
SUBTTL CTERM LAYER -- MESSAGE RECEIVED -- CHECK INPUT
;Here when a CHECK-INPUT message was received
;CALL CTMCKI with no arguments
;Returns +1 always, sending the INPUT-COUNT message to the host
CTMCKI: MOVEI T1,.PRIIN ;Get typeahead buffer count
SIBE% ;(T1/T2)
TRNA
SETZ T2,
SKIPN RDACTV ;Is there a read active ?
IFSKP.
ADD T2,INPLEN ;Yes. Add in input buffer count
SUB T2,INPBLK+.RDDBC
ENDIF.
MOVE T3,T2 ;Save count
PUT2BY T2,CNTP ;Put count in the message
SKIPN T3 ;Are there any characters waiting?
IFSKP.
RFMOD%
TXZE T2,TT%ECO ;Yes. Force echo off - was it on ?
SETOM INPECH ;Yes. Must restore it after the read completes.
SFMOD%
EXCH T2,T3 ;Save JFN mode word for use later
BIN% ;Get the first character &
MOVEM T2,INPCHR ;store it away for use in the READ TEXTI%
EXCH T3,T2 ;Restore JFN mode word
SKIPE INPECH ;Is ECHO to be restored ?
TXO T2,TT%ECO ;Yes.
SFMOD% ;Restore mode.
ENDIF.
DPB T3,CNTPC ;put the character in the message.
MOVE T1,CNTPTR ;Get pointer to message
MOVEI T2,CNTSIZ ;Get size of message
CALL MSGPUT ;(T1,T2) Send it out
RET ;Done.
SUBTTL PREINPUT PROCESS -- OUT OF BAND CHARACTER INTERRUPT ROUTINES
;Here when an out of band character is typed in.
OOB0: MOVEI OOBAC1,^D0
JRST PREOOB
OOB1: MOVEI OOBAC1,^D1
JRST PREOOB
OOB2: MOVEI OOBAC1,^D2
JRST PREOOB
OOB3: MOVEI OOBAC1,^D3
JRST PREOOB
OOB4: MOVEI OOBAC1,^D4
JRST PREOOB
OOB5: MOVEI OOBAC1,^D5
JRST PREOOB
OOB6: MOVEI OOBAC1,^D6
JRST PREOOB
OOB7: MOVEI OOBAC1,^D7
JRST PREOOB
OOB8: MOVEI OOBAC1,^D8
JRST PREOOB
OOB9: MOVEI OOBAC1,^D9
JRST PREOOB
OOB10: MOVEI OOBAC1,^D10
JRST PREOOB
OOB11: MOVEI OOBAC1,^D11
JRST PREOOB
OOB12: MOVEI OOBAC1,^D12
JRST PREOOB
OOB13: MOVEI OOBAC1,^D13
JRST PREOOB
OOB14: MOVEI OOBAC1,^D14
JRST PREOOB
OOB15: MOVEI OOBAC1,^D15
JRST PREOOB
OOB16: MOVEI OOBAC1,^D16
JRST PREOOB
OOB17: MOVEI OOBAC1,^D17
JRST PREOOB
OOB18: MOVEI OOBAC1,^D18
JRST PREOOB
OOB19: MOVEI OOBAC1,^D19
JRST PREOOB
OOB20: MOVEI OOBAC1,^D20
JRST PREOOB
OOB21: MOVEI OOBAC1,^D21
JRST PREOOB
OOB22: MOVEI OOBAC1,^D22
JRST PREOOB
OOB23: MOVEI OOBAC1,^D23
JRST PREOOB
OOB24: MOVEI OOBAC1,^D24
JRST PREOOB
OOB25: MOVEI OOBAC1,^D25
JRST PREOOB
OOB26: MOVEI OOBAC1,^D26
JRST PREOOB
OOB27: MOVEI OOBAC1,^D27
JRST PREOOB
OOB28: MOVEI OOBAC1,^D28
JRST PREOOB
OOB29: MOVEI OOBAC1,^D29
JRST PREOOB
OOB30: MOVEI OOBAC1,^D30
JRST PREOOB
OOB31: MOVEI OOBAC1,^D31
JRST PREOOB
OOBDEL: MOVEI OOBAC1,.CHDEL
JRST PREOOB
SUBTTL PREINPUT PROCESS -- OUT OF BAND INTERRUPT PROCESSING
;Common routine to handle out of band character interrupt
;JRST PREOOB with
; OOBAC1/ character
;DEBRK%s always
PREOOB: CALL PREOB0 ;Do work.
DEBRK% ;Done.
PREOB0: SAVET ;Save temporary registers
MOVEI T1,.FHSLF ;Turn off
DIR% ; interrupts
CALL PREOB1 ;Do work
MOVEI T1,.FHSLF ;Turn on
EIR% ; interrupt
RET
PREOB1: BUGMSG (BG.OOB,<Out of band interrupt - >,<OOBMSG(OOBAC1)>,[^D10])
HRRZ T1,LEV2PC ;Get interrupted PC
CAIE T1,INPORX ;Is it the TEXTI% ?
CAIN T1,INPBIX ; or the PBIN% ?
IFNSK.
MOVEI T1,INPREC ;Yes. Restart
MOVEM T1,LEV2PC ; it.
ENDIF.
MOVE T4,OOBCHA(OOBAC1) ;Get its characterisitics
CAIN OOBAC1,.CHDEL ;But wait, is it DELETE ?
MOVE T4,DELCHA ;Yes. Get its characteristics
MOVE T1,OOBAC1 ;Get character.
LOAD T2,OBECH,+T4 ;Get the echo characteristic
CALL @PRESEC(T2) ;(T1) Simulate echo, if needed.
OPSTR <SKIPN >,OBSPC,+OOBCHA(OOBAC1) ;Is this a special ?
IFSKP.
CAIN OOBAC1,.CHCNX ;Yes. Control-X ?
JRST PRECTX ;Yes. Go do it.
CAIN OOBAC1,.CHCNO ;No. Control-O ?
JRST PRECTO ;Yes. Go do it.
ENDIF.
LOAD T1,OBOOB,+T4 ;Get the out of band type
CAIE T1,OB.CLR ;Is it clear or
CAIN T1,OB.DEF ; deferred clear out of band ?
IFNSK.
MOVEI T1,.PRIIN ;Yes. Clear the
CFIBF% ; typeahead buffer
CALL OUPULK ;Unlock output if needed.
ENDIF.
TXNN T4,OBDSC ;Is it a discard out of band ?
IFSKP.
CALL OUPSTP ;Yes. Set the output state to "discard".
MOVEI T4,1 ; set "discard" in the out of band message.
ELSE.
SETZ T4, ;Clear "discard" in the out of band message.
ENDIF.
DPB OOBAC1,OOBP ;Set the character in the out of band message
DPB T4,OOBP1 ;Set the flags in the out of band message
MOVE T1,OOBPTR ;Send
MOVEI T2,OOBSIZ ; the
CALL MSGPUT ;(T1,T2) out of band message
LOAD T1,OBOOB,+OOBCHA(OOBAC1) ;Get the out of band type
CAIE T1,OB.CLR ;Is it clear or
CAIN T1,OB.DEF ; deferred clear out of band ?
IFNSK.
SKIPN RDACTV ;Yes. Is there a read active ?
RET ;No. Done.
MOVEI T1,.TMOOB ;Yes. Terminate the read with out of band
SETZ T2, ;Size of terminator.
CALL INPEND ;(T1,T2)
ENDIF.
RET ;Done.
SUBTTL PREINPUT PROCESS -- OUT OF BAND INTERRUPT PROCESSING -- SIMULATE ECHO
;Routines to simulate echo of out of band
;CALL @PRESEC(T2) with
;T1/ character
;Returns +1 always
PRESEC: IFIW ! RTN ;If no echo then done.
IFIW ! PRESE1 ;Straight echo.
IFIW ! PRESE2 ;Standard form
IFIW ! PRESE3 ;Simulate format action
;Echo the character
;CALL PRESE1
;Uses no ACs
;Returns +1 always
PRESE1: $PBOUT (T1)
RET
;Echo in standard form
;CALL PRESE2
;Uses T1,T2 only
;Returns +1 always
PRESE2: CAIE T1,.CHCRT ;Carriage return or
CAIN T1,.CHLFD ; line feed ?
IFSKP.
CAIE T1,.CHESC ;No. Escape ?
IFSKP.
MOVEI T1,"$" ;Yes.
ELSE.
MOVE T2,T1 ;No. Save character
MOVEI T1,"^" ;Put out
$PBOUT (T1) ; marker
MOVE T1,T2 ;Restore character
XORI T1,100 ;Convert to visible
ENDIF.
$PBOUT (T1) ;Put it out
ELSE.
$PSOUT (CRLFPT,<[2]>) ;Put out CRLF
ENDIF.
RET
;Simulate format action
;CALL PRESE3
;Uses T1,T2,T3
;Returns +1 always
PRESE3: MOVE T3,T1 ;Save character
CALL PRESE2 ;(T1) Echo in standard form
$PBOUT (T3) ;Echo as self.
RET
SUBTTL PREINPUT PROCESS -- CONTROL-O AND CONTROL-X
;Here when a control-O was typed in, and control-O is enabled for
;its special function (discard output)
;Preserves all ACs and DEBRK%s
PRECTO: BUGMSG (BG.OOB,<Control-O>,[0],[0])
CALL OUPTOG ;Toggle the output discard state.
RET
;Here when a control-X was typed in, and control-X is enabled for
;its special function (clear typeahead and input buffers
;Preserves all ACs and DEBRK%s
PRECTX: BUGMSG (BG.OOB,<Control-X>,[0],[0])
MOVEI T1,.PRIIN ;Clear typeahead
CFIBF% ; buffer
SKIPN RDACTV ;Read active ?
RET ;No. Done.
MOVX T2,.CHCNU ;Yes. Convert to control-U
STI% ;(T1,T2) and send to terminal.
RET
SUBTTL PREINPUT PROCESS -- SET CHARACTER ATTRIBUTES
;Set up a character's characteristics
;CALL PRECHR with
; T1/ character
; T2/ new characteristics
;Returns +1 always.
;Uses T1-T4
PRECHR: SAVEAC <Q1,Q2,Q3>
JUMPL T1,RTN ;Negatives not allowed.
CAIE T1,.CHDEL ;Delete is allowed
CAIG T1,^D31 ; and so are control characters
TRNA
RET ;Not allowed.
MOVE Q1,T1 ;Put character in a safe place
MOVE Q3,T2 ;Put new characteristics in a known place
CAIE Q1,.CHDEL ;Is this character DELETE ?
IFSKP.
MOVE Q2,DELCHA ;Yes. Get its old characteristics
MOVEM Q3,DELCHA ;Set its new characteristics
ELSE.
MOVE Q2,OOBCHA(Q1) ;No. Get the old characteristics
MOVEM Q3,OOBCHA(Q1) ;Set the new characteristics
ENDIF.
LOAD T2,OBOOB,+Q3 ;Get the new out of band definition
OPSTR <SKIPN>,OBSPC,+Q3 ;Is the special flag set ?
IFSKP.
CAIE Q1,.CHCNO ;Yes. Is this character control-O
CAIN Q1,.CHCNX ; or control-X ?
IFNSK.
MOVEI T2,OB.CLR ;Yes. Force clear out of band.
ENDIF.
ENDIF.
CALL PRESOB ;(T1,T2) Make the change.
MOVE T1,Q1 ;Get character
LOAD T2,OBECH,+Q3 ;Get the new echo definition
CALL PREECH ;(T1,T2) Make the change.
MOVE T1,Q1 ;Get character.
LOAD T2,OBSPC,+Q3 ;Get new special definition.
CALL PRESPC ;(T1,T2) Make the change.
RET
SUBTTL PREINPUT PROCESS -- SET CHARACTER ATTRIBUTES -- PSI CHARACTER
;Set the characteristics that involve the PSI system - out of band and
; "special" flag for control-O and control-X.
;CALL PRESOB with
; T1/ character
; T2/ PSI characteristic - OB.xxx
;Returns +1 always
PRESOB: SAVEAC <Q1>
CAILE T1,.CHESC ;Legal out of band character ?
CAIN T1,.CHDEL
TRNA
RET ;No. Leave now.
HLRZ T3,OOBTAB(T1) ;Get PSI channel this character has (0 if none)
CAIN T1,.CHDEL ;Is the character DELETE ?
HLRZ T3,DELTAB ;Yes. Get PSI channel this character has (0 if none)
IFG. T2 ;Need a PSI channel ?
SKIPN T3 ;Yes. Have one ?
CALL PREPSA ;(T1) No. Get one and hook it up to character.
CAIE T2,OB.DEF ;Is this a deferred interrupt ?
IFSKP.
SETO Q1, ;Yes. Flag it.
ELSE.
SETZ Q1, ;No. Flag it.
ENDIF.
MOVE T4,T1 ;Put character in a safe place.
MOVE T4,BITS(T4) ;Get terminal interrupt mask for this character.
CAIN T1,.CHDEL ;Is the character DELETE ?
MOVX T4,1B<.TICRB> ;Yes. Get its terminal interrupt mask
MOVX T1,<ST%DIM+.FHSLF> ;Must set up deferred terminal interrupt word
RTIW% ;First get them.
IFN. Q1 ;Deferred interrupt ?
IORM T4,T3 ;Yes. Set bit in deferred word.
ELSE.
ANDCAM T4,T3 ;No. Clear bit in deferred word.
ENDIF.
STIW% ;Set the interrupt words.
ELSE.
SKIPE T3 ;Don't need a PSI channel. Have one ?
CALL PREPSD ;(T1,T3) Yes. Clear out PSI channel.
ENDIF.
RET
SUBTTL PREINPUT PROCESS -- SET CHARACTER ATTRIBUTES -- SET UP PSI
;Set up a PSI channel for an out of band character
;CALL PREPSA with
; T1/ character
;Returns +1 always
;Preserves all registers
PREPSA: SAVEAC <T1,T2,T3>
SKIPE T2,PSIPTR ;No. Need a channel. Any channels left ?
IFSKP.
TMSG <
== SERVER: out of band resource failure ==
>
RET ;No. Just go away
ENDIF.
HRRZ T3,(T2) ;Yes. Get address of next entry
MOVEM T3,PSIPTR ; and update free pointer.
HLRZ T2,(T2) ;Get channel.
CAIE T1,.CHDEL ;Is character DELETE ?
IFSKP.
HRLM T2,DELTAB ;Remember channel number
HRRZ T3,DELTAB ;Get routine address
ELSE.
HRLM T2,OOBTAB(T1) ;Remember channel number
HRRZ T3,OOBTAB(T1) ;Get routine address
ENDIF.
HRLI T3,OOBLEV ;Get PSI level.
MOVEM T3,CHNTAB(T2) ;Put entry in the channel table
CAIN T1,.CHDEL ;Is the character DELETE ?
MOVEI T1,.TICRB ;Yes. Get its terminal code.
MOVE T4,T1 ;Save it
MOVE T3,T2 ;Save channel number
MOVEI T1,-5 ;Get job wide terminal interrupt word
RTIW%
IOR T2,BITS(T4) ;Add in this one.
STIW% ;Set it.
HRLZ T1,T4 ;Set up for ATI% - terminal code in LH.
HRR T1,T3 ;PSI channel number in RH
ATI% ;Associate terminal code and PSI channel.
MOVEI T1,.FHSLF ;Activate
MOVE T2,BITS(T3) ; the
AIC% ; channel.
CAME T4,ESCCHR ;Is this the first character of the switch seq ?
RET ;No. Done.
TMSG <
== WARNING FROM SERVER: MUST TYPE ">
MOVE T1,T4
CALL PRESE2
TMSG <" TWICE TO MAKE IT WORK ==>
RET
SUBTTL PREINPUT PROCESS -- SET CHARACTER ATTRIBUTES -- CLEAR OUT PSI
;Clear out PSI channel for a newly disabled out of band
;CALL PREPSD with
; T1/ character
; T3/ PSI channel
;Returns +1 always
PREPSD: SETZM CHNTAB(T3) ;Clear out this channel table entry
MOVE T2,PSIPTR ;Update
HRRM T2,PSITAB(T3) ; the
MOVEI T2,PSITAB(T3) ; free
MOVEM T2,PSIPTR ; list
SETZ T2,
CAIE T1,.CHDEL ;Is the character DELETE ?
IFSKP.
HRLM T2,DELTAB ;Yes. Forget it here.
MOVEI T1,.TICRB ; and get its terminal code.
ELSE.
HRLM T2,OOBTAB(T1) ;No. Forget it here.
ENDIF.
DTI% ;Disassociate terminal code and PSI channel.
MOVE T4,T1 ;Save terminal code
MOVEI T1,-5 ;Get job wide terminal interrupt word.
RTIW%
MOVE T4,BITS(T4) ;Clear
ANDCAM T4,T2 ; out this
STIW% ; code. (If I'm not using it. nobody can)
MOVEI T1,.FHSLF ;Deactivate
MOVE T2,BITS(T3) ; the
DIC% ; channel.
RET ;Done.
SUBTTL PREINPUT PROCESS -- SET CHARACTER ATTRIBUTES -- SET ECHO
;Set up echo characteristics
;CALL PREECH with
; T1/ character
; T2/ CTERM echo code
;Returns +1 always
PREECH: SAVEAC <Q1,Q2>
CAIN T1,.CHDEL ;DELETE ?
RET ;Yes. Nothing to do.
MOVE Q1,T1 ;No. Save character
CALL @PREECT(T2) ;(T1/T2) Convert CTERM code to CCOC code.
MOVE Q2,T2 ;Save the code
MOVEI T1,.PRIIN ;Get current CCOC words.
RFCOC%
MOVE T4,[POINT 2,T2] ;Byte pointer to CCOC words
ADJBP Q1,T4 ;Number of bytes to adjust by = character.
IDPB Q2,Q1 ;Set that field
SFCOC% ;Set the CCOC words
RET ;Done.
;Dispatch on CTERM echo codes
;T2/ character
;Returns +1 always with T2/ code
PREECT: IFIW ! RTN
IFIW ! PRECD1
IFIW ! PRECD2
IFIW ! PRECD3
PRECD1: MOVEI T2,2
RET
PRECD3: MOVEI T2,3
RET
;CR, LF, ESC translate to 3. All others translate to 1.
PRECD2: MOVEI T2,3 ;Assume CR or LF.
CAIE T1,.CHCRT ;Is it CR
CAIN T1,.CHLFD ; or LF ?
IFSKP.
CAIE T1,.CHESC ;No. Is it ESC ?
MOVEI T2,1 ;No. Code is 1
ENDIF.
RET
SUBTTL PREINPUT PROCESS -- SET CHARACTER ATTRIBUTES -- SPECIAL FLAG
;Process the "special" flag for the editing characters.
;CALL PRESPC with
; T1/ character
; T2/ new value of special flag
PRESPC: CAIE T1,.CHDEL ;Is character DELETE ?
IFSKP.
MOVEI T3,.CHDEL-3*32 ;Yes. Bit position.
MOVEI T4,3 ;Word offset
ELSE.
CAIE T1,.CHCNR ;Check the character. Control-R or
CAIN T1,.CHCNU ; control-U ?
IFSKP.
CAIE T1,.CHCNV ;No. Control-V or
CAIN T1,.CHCNW ; control-W ?
TRNA ;Yes.
RET ;No. Go away.
ENDIF.
SETZ T4, ;Word offset
MOVE T3,T1 ;Bit position
ENDIF.
MOVE T3,BITS(T3) ;Mask.
IFN. T2 ;Enable special character ?
IORM T3,INPEBM(T4) ;Yes. Update editing break mask
ANDCAM T3,INPUBM(T4) ;Update unediting break mask
ELSE.
ANDCAM T3,INPEBM(T4) ;No. Update editing break mask
IORM T3,INPUBM(T4) ;Update unediting break mask
ENDIF.
RET
SUBTTL OUTPUT PROCESS -- WRITE MESSAGE -- ENTRY
;Here to process a WRITE message received from the host.
;CALL OUPENT with WRITE message parsed
; Returns +1 always
OUPENT: SKIPN TRMFLG ;Is this the termination echo write msg?
IFSKP. ;Ayup.
SETZM TRMFLG ;Clear it and dont process this message
RET ;since we have already echoed the terminator.
ENDIF.
SKIPN OUPOUT ;"output discard" field set ?
IFSKP.
MOVEI T1,1 ;Yes.
MOVEM T1,OUPDS1 ;Set requested state to do not discard
MOVEM T1,OUPDS2 ;Set real state to do not discard
ENDIF.
SKIPN OUPTRN ;transparent output ?
IFSKP.
MOVEI T1,.PRIOU ;Yes. Get mode word
RFMOD%
MOVEI T3,.TTBIN ;Set data mode to binary.
STOR T3,TT%DAM,+T2
SFMOD%
STPAR%
ENDIF.
SKIPE OUPBOM ;Beginning segment ?
CALL OUPBEG ;Yes. Handle it.
SKIPN OUPDS2 ;Discarding output ?
IFSKP.
$PSOUT (OUPBPT,OUPBCT) ;No. Send bytes to terminal
ENDIF.
SKIPE OUPEOM ;End of message ?
CALL OUPEND ;Yes. Handle postfix, newline, and completion status.
SKIPN OUPTRN ;transparent output ?
IFSKP.
MOVEI T1,.PRIOU ;Yes. Get mode word.
RFMOD%
MOVEI T3,.TTATE ;Set data mode back to "translate echo".
STOR T3,TT%DAM,+T2
SFMOD%
STPAR%
ENDIF.
SKIPN OUPEOM ;End of message ?
RET ;No. Done.
MOVE T1,OUPLOK ;Get locking parameter.
CALL OUPDOL ;(T1) Handle it.
RET
SUBTTL OUTPUT PROCESS -- WRTE MESSAGE -- HANDLE LOCK
;here to handle lock parameter at end message
;CALL OUPDOL with
; T1/ lock parameter
;Returns +1 always
OUPDOL: CAIG T1,1 ;If it was "unlock" or "lock" there is
RET ; nothing to do.
CALL OUPULK ;Unlock output
MOVE T1,OUPLOK ;Get back locking parameter.
CAIN T1,3 ;Was it "redisplay on completion" ?
SKIPN RDACTV ;Yes. AND is there a read active ?
RET ;No to either. Done.
CALL INPDPL ;Yes to both. Display input buffer.
RET ;Done.
SUBTTL OUTPUT PROCESS -- WRITE MESSAGE -- BEGINNING SEGMENT
;Handle beginning segment of a WRITE
;CALL OUPBEG
;returns +1 always
OUPBEG: SKIPG T4,OUPLOK ;Lock field significant ?
IFSKP.
SETOM OUPLCK ;Yes. Set the lock.
; MOVEI T1,.FHSLF
; MOVX T2,1B<TTCHAN> ;Deactivate terminal input interrupts
; DIC%
ENDIF.
MOVE T1,OUPPFX ;Get prefix code
MOVE T2,OUPPFC ;Get prefix count
SKIPN OUPSKP ;Skip-next-line-feed set ?
SKIPE FREELF ;No. Free LF set ?
IFNSK.
IFN. T1 ;Yes to one. Is there a prefix ?
CAIN T1,1 ;Yes. Is it line feed(s) ?
SOS T2 ;Yes. Take one away.
SETZM FREELF ;Clear the free LF.
ENDIF.
ENDIF.
SKIPE T1 ;Any prefix ?
CALL OUPFIX ;(T1,T2) Yes. Go do it.
RET
SUBTTL OUTPUT PROCESS -- WRITE MESSAGE -- ENDING SEGMENT
;Handle ending segment of WRITE message
;CALL OUPEND
;Returns +1 always
;Note: No way of telling if any output was discarded due to control-O.
OUPEND: STKVAR <LFSKP>
SETZM LFSKP ;Initialize LF skip flag
SKIPN OUPTRN ;Transparent output ?
SETZM OUPSKP ;No. Reset skip next line feed flag
MOVE T2,OUPPSC ;Get postfix character/count
SKIPE T1,OUPPSX ;Get postfix code
CALL OUPFIX ;(T1,T2) Go do it, if code nonzero.
SKIPN OUPNWL ;Newline flag set ?
IFSKP.
MOVE T1,OUPBCT ;Yes. Get size of data.
IFE. T1 ;No data ?
SKIPN FREELF ;Yes. And was free LF already given ?
IFSKP.
SETOM LFSKP ;Yes. Don't put out the newline,
SETZM FREELF ; and that uses up the free LF,
SETZM OUPCR ; and the last character output was LF.
ENDIF.
ENDIF. ;END OF NO-DATA IF.
CAIE T1,1 ;Single character write ?
IFSKP.
MOVE T1,OUPBPT
ILDB T1,T1 ;Yes. Get the character.
CAIN T1,.CHCRT ;Is it CR ?
SKIPN FREELF ;Yes. And was free LF already given ?
IFSKP.
SETOM LFSKP ;Yes to all. Don't put out the newline,
SETZM FREELF ; and that uses up the free LF,
SETZM OUPCR ; and the last character output was LF.
ENDIF.
ENDIF. ;END OF SINGLE CHARACTER IF
SKIPE LFSKP ;Is it OK to put out the newline ?
IFSKP.
$PBOUT ([.CHLFD]) ;Yes. Do so.
ENDIF.
SETOM OUPSKP ;Set skip-next-line-feed flag
ENDIF. ;END OF NEWLINE IF.
MOVE T1,OUPBCT ;Get count of write
MOVE T2,OUPBPT ;Initialize.
ILDB T2,T2 ;Get first character, if any.
SKIPN T1 ;Are there characters ?
IFSKP.
CAIN T1,1 ;Yes. Single character write
CAIE T2,.CHCRT ; and the character is CR ?
IFNSK.
SKIPN OUPTRN ;No. Transparent output ?
SETZM FREELF ;No. Free LF has been used up.
ENDIF.
ENDIF.
SKIPN OUPCMP ;Completion status requested ?
RET ;No. Done.
MOVEI T1,.PRIOU ;Get horizontal and vertical positions
RFPOS%
HLRZ T3,T2 ;Vertical
HRRZS T2 ;Horizontal
PUT2BY T2,WRCHPS ;Put it in the message
PUT2BY T3,WRCVPS ;Put it in the message
MOVE T1,WRCPTR ;Send off
MOVEI T2,WRCSIZ ; the
CALL MSGPUT ;(T1,T2) message
RET
ENDSV. ;End STKVAR
SUBTTL OUTPUT PROCESS -- WRITE MESSAGE -- PREFIX AND POSTFIX
;Output post- or prefix.
;CALL OUPFIX with
; T1/ code
; T2/ character/count
;Returns +1 always
OUPFIX: JUMPE T1,RTN ;If none, do nothing.
SKIPN OUPDS2 ;Discarding output ?
RET ;Yes. Do nothing
CAIE T1,1 ;Newline repetitions ?
IFSKP.
MOVE T4,T2 ;Yes. Put out CRLFs
DO.
SOJL T4,ENDLP.
$PSOUT (CRLFPT,[2])
LOOP.
ENDDO.
ELSE.
$PBOUT(T2) ;No, it's a character, put it out.
ENDIF.
RET
SUBTTL OUTPUT PROCESS -- UTILITY ROUTINES
;Toggle the output discard state
;CALL OUPTOG with no arguments
;Returns +1 always
OUPTOG: MOVEI T1,1 ;Toggle the
SUB T1,OUPDS1 ; requested output
MOVEM T1,OUPDS1 ; discard state
IFE. T1 ;Is it now "discard" ?
SETZM OUPDS2 ;Yes. Make real output discard state "discard"
CALL OUPULK ; and unlock output if it was locked.
ENDIF.
DPB T1,DSCP ;Set the discard state in the message
MOVE T1,DSCPTR ;Send off
MOVEI T2,DSCSIZ ; the
CALL MSGPUT ;(T1,T2) DISCARD-STATE message
RET
;Set output discard state to do not discard
;CALL OUPSTP with no arguments
;Uses T1
OUPGO: MOVEI T1,1
MOVEM T1,OUPDS1
MOVEM T1,OUPDS2
RET
;Set output discard state to discard
;CALL OUPSTP with no arguments
;Preserves all registers
OUPSTP: SETZM OUPDS1
SETZM OUPDS2
RET
;Unlock output, if needed
;CALL OUPULK with no arguments
;Returns +1 always
;Preserves all ACs
OUPULK: SAVET
SKIPN OUPLCK ;Is it locked ?
RET ;No. Done.
SETZM OUPLCK ;Yes. Unlock it.
SKIPE RDACTV ;Is there a read active ?
SKIPN OUPICT ;Yes. Is there queued input to be displayed ?
IFSKP.
$PSOUT (OUPIPT,OUPICT);Yes. Display it
SETZM OUPICT ;No more queued input.
ENDIF.
CALL INPPOK ;Poke input process
RET ;Done.
;Display input process's prompt and initial data
;CALL OUPDSP with
; T1/ pointer
; T2/ count
OUPDSP: JUMPLE T2,RTN ;Eliminate trivialities
MOVE CX,REMOS ;Get remote OS type
CAIN CX,OS.T20 ;Is it Tops-20?
RET ;Yup, no need to print prompt
SKIPN OUPLCK ;Output locked ?
IFSKP.
MOVE T3,T2 ;Yes. Queue request - get count
MOVE T2,T1 ;Get pointer
MOVE T1,OUPICT ;Point past what it already
ADJBP T1,OUPIPT ; queued
ADDM T3,OUPICT ;Update count.
MOVNS T3 ;Get negative of count
SOUT% ;Move request.
ELSE.
$PSOUT (T1,T2) ;No. Send data to terminal
ENDIF.
RET
SUBTTL INPUT PROCESS -- POKE
;Poke input process
;CALL INPPOK with no arguments
;Returns +1 always
INPPOK: MOVEI T1,.FHSLF ;Poke
MOVE T2,BITS+TTCHAN ; input
IIC% ; process.
RET
SUBTTL INPUT PROCESS -- INITIALIZATION
;Initialize the input process
;CALL INPINI with no arguments
;Returns +1 always
INPINI: RET
SUBTTL INPUT PROCESS -- START A READ
;START-READ message received
;CALL INPSTR with message parsed.
;Returns +1 always
INPSTR: CALL OUPGO ;Set output discard state to "do not discard"
SETZM INPSEE ;Input buffer is now empty.
MOVX T1,TXTFLG ;Get "always on" flags for TEXTI% arg block
MOVEM T1,INPBLK+.RDFLG ;Set them.
MOVE T1,REDDPT ;Set up pointer to TEXTI%
MOVEM T1,INPBLK+.RDBFP ; data storage area.
CALL INPMVP ;Move prompt to TEXTI% prompt storage area
MOVE T1,INPBLK+.RDBFP ;Point to TEXTI% data storage area
MOVE T3,INPEOP ;Negative size of
SUB T3,INPEOD ; initial data
SKIPE T3 ;If there is initial data,
SOUT% ;(T1,T2,T3) move it.
; SKIPN T2,INPCHR ;Was a character read for input-count message?
; IFSKP. ;Yes,
; DPB T2,T1 ;put this character into the data storage area
; SETZM INPCHR ;and zero its old location.
; ENDIF.
MOVEM T1,INPBLK+.RDDBP ;Set up destination string pointer for TEXTI%
MOVE T1,INPBLK+.RDBFP ;Point to TEXTI% data storage area
MOVE T2,INPLOW ;LOW-WATER count
SUB T2,INPEOP ;Make it relative to data area
ADJBP T2,T1 ;Convert to pointer
MOVEM T2,INPBLK+.RDBKL ;Set backup limit pointer for TEXTI%
MOVE T2,INPLEN ;Compute count
SUB T2,INPEOD ; of space
ADD T2,INPEOP ; left in buffer.
MOVEM T2,INPBLK+.RDDBC ;Set space count for TEXTI%
LOAD T1,RDTIM,+INPFLG ;Put timeout flag in
MOVEM T1,INPTMO ; its own word.
LOAD T1,RDUND,+INPFLG ;Get underflow flag
CAIE T1,TM.TRM ;Is it terminate on underflow ?
IFSKP.
SETONE RD%RND,+INPBLK+.RDFLG ;Yes. Make TEXTI% return on underflow.
ELSE.
SETZRO RD%RND,+INPBLK+.RDFLG ;No. Make TEXTI% handle underflow.
ENDIF.
MOVEI T1,.PRIOU ;Get JFN mode
RFMOD% ;(T1/T2) word.
CALL INPDOR ;(T1,T2/T1,T2) do the raise set up
CALL INPDEC ;(T1,T2/T1,T2) do the echo/noecho set up
SFMOD% ;(T1,T2) Set the
STPAR% ;(T1,T2) characteristics
CALL INPSBM ;Set up TEXTI% break mask and related things
CALL INPFMT ;Handle format flag and display prompt &
; initial data
CALL INPPOK ;Poke input process
MOVE T1,INPTIM ;Get timeout period
SKIPE INPTMO ;Timeout enabled ?
CALL TIMSET ;(T1) Yes. Set timer.
CAIN INPSTA,.INESC ;Still parsing escape sequences ?
JRST @TSTATE(ESCSTA) ;Yes. Dispatch on state & terminate read.
CALL INPISB ;No. Check for single character read
IFSKP.
MOVEI INPSTA,.INBIN ;It is. Set the state
ELSE.
MOVEI INPSTA,.INORD ;No. State is ordinary.
CALL TRMSTX ;Save terminal characteristics.
ENDIF.
RET ;Done.
SUBTTL INPUT PROCESS -- START A READ -- MOVE PROMPT
;Move prompt to TEXTI% storage area, moving nulls to end.
;CALL IMPMVP
;Returns +1 always
INPMVP: SAVEAC <Q1>
SETZ T4, ;Null counter
MOVE T1,INPBLK+.RDRTY ;Point to TEXTI% prompt storage area
MOVE T2,INPBPT ;Point to prompt in START-READ message
SKIPG T3,INPEOP ;Size of prompt
IFSKP.
DO. ;Move bytes
ILDB Q1,T2 ;Get byte
IFN. Q1 ;Is it null ?
IDPB Q1,T1 ;No. Put byte.
ELSE.
AOS T4 ;Yes. Increment counter
ENDIF.
SOJG T3,TOP.
ENDDO.
ENDIF.
SETZ Q1, ;Get a null.
DO. ;Null terminate and move trailing nulls
IDPB Q1,T1 ;Put a null.
SOJGE T4,TOP. ;Do some more.
ENDDO.
RET ;Done.
SUBTTL INPUT PROCESS -- START A READ -- SET UP RAISE
;Set up raise characteristics
;CALL INPDOR with
; T1/ JFN
; T2/ Current mode word
;Returns +1 always with
; T1/ JFN
; T2/ New mode word
INPDOR: SETZM INPRAI ;Assume term no raise is already true.
LOAD T3,RDRAI,+INPFLG ;Get raise flag.
CAIE T3,1 ;No raise for this read only ?
IFSKP.
TXZE T2,TT%LIC ;Yes. Force no raise. Was it raise ?
SETOM INPRAI ;Yes. Mark change.
ENDIF.
CAIE T3,2 ;Raise for this read only ?
IFSKP.
TXON T2,TT%LIC ;Yes. Force raise. Was it no raise ?
SETOM INPRAI ;Yes. Mark change.
ENDIF.
RET
SUBTTL INPUT PROCESS -- START A READ -- SET UP ECHO
;Set up echo/noecho stuff and underflow
;CALL INPDEC
; T1/ JFN
; T2/ Current mode word
;Returns +1 always with
; T1/ JFN
; T2/ New mode word
INPDEC: STKVAR <JFN,MODWRD>
SETZM INPECH ;Initialize.
OPSTR <SKIPN>,RDNEC,+INPFLG ;No echo for this read only ?
IFSKP.
TXZE T2,TT%ECO ;Yes. Force echo off - was it on ?
SETOM INPECH ;Yes. Must restore it after the read completes.
ENDIF.
LOAD T3,RDUND,+INPFLG ;Get underflow flag
CAIN T3,TM.TRM ;Is it not "terminate" ?
IFSKP.
MOVEM T1,JFN ;Yes. Save JFN
MOVEM T2,MODWRD ; and mode word
MOVX T2,EC.NON ;Yes. Assume it is "ignore".
CAIE T2,TM.IGN ;Is it ?
MOVX T2,EC.SLF ;No. It is "bell".
MOVX T1,.CHBEL ;The character.
CALL PREECH ;(T1,T2) Make the change.
MOVE T1,JFN ;Restore JFN
MOVE T2,MODWRD ; and mode word
ENDIF.
RET
ENDSV.
SUBTTL INPUT PROCESS -- START A READ -- SET UP BREAK MASK
;Set up TEXTI% break mask, quote flag, input esc rec flag,
; and restore character interrupts flag
;CALL INPSBM
;Returns +1 always
INPSBM: MOVE T1,[INPTBM,,INPXBM] ;Set up TEXTI%
BLT T1,INPXBM+3 ; break mask - CTERM terminator set.
MOVE T1,INPUBM ;Unediting break mask - break on
IORM T1,INPXBM ; editing characters that have lost
MOVE T1,INPUBM+3 ; their
IORM T1,INPXBM+3 ; functions
MOVE T1,INPEBM ;Editing break mask - don't break on
ANDCAM T1,INPXBM ; editing character that still have
MOVE T1,INPEBM+3 ; their
ANDCAM T1,INPXBM+3 ; functions
MOVX T1,<1B<.CHLFD>+1B<.CHCRT>+1B<.CHCNV>> ;Control-V and CR/LF
IORM T1,INPXBM ; are always in the break mask.
MOVX T3,1B<.CHESC> ;Assume ESCAPE should be on in the break mask.
OPSTR <SKIPE T2,>,RDESS,+INPFLG ;INPUT-ESCAPE-SEQUENCE-RECOGNITION flag
IFSKP.
SKIPN CHRIEX ;Not set. Is characteristic set ?
SETZ T3, ;No.
ELSE.
CAIE T2,2 ;Does flag say yes ?
SETZ T3, ;No.
ENDIF.
IORM T3,INPXBM ;Set break mask.
MOVEM T3,INPESR ;Set recognition flag.
LOAD T1,OBSPC,+OOBCHA+.CHCNV ;Set quote enabled flag.
MOVEM T1,INPQOT
SETZM INPCTL ;Initialize the "restore control char" flag
OPSTR <SKIPN T1,>,RDDCD,+INPFLG ;Get disable control character field.
RET ;There is none.
MOVX T2,1B<.CHCNU>+1B<.CHCNR> ;Disable control-U and control-R
IORM T2,INPXBM ; by setting the TEXTI% break mask
SOJE T1,RTN ;Done ?
MOVX T2,1B<.CHCNV>+1B<.CHCNW> ;No. Disable control-V and control-U
IORM T2,INPXBM ; by setting the TEXTI% break mask
MOVX T2,1B<.CHDEL-3*^D32> ; and disable DELETE
IORM T2,INPXBM+3 ; by setting the TEXTI% break mask
SETZM INPQOT ;Clear quote enabled flag
SOJE T1,RTN ;Done ?
CALL PSINSC ;No. Must disable out of bands
SETOM INPCTL ;Set the restore flag.
SETZM INPESR ;Clear input escape recognition.
RET
SUBTTL INPUT PROCESS -- START A READ -- HANDLE FORMAT FLAG
;CALL INPFMT
;Returns +1 always
INPFMT: STKVAR <PRMPTR,PRMCNT,DATPTR,DATCNT,LFFLAG>
SETZM LFFLAG ;Initialize free LF flag (assume no free LF)
MOVE T1,INPBLK+.RDRTY ;Initialize prompt
MOVEM T1,PRMPTR ; pointer
MOVE T1,INPEOP ;Initialize prompt
MOVEM T1,PRMCNT ; count
MOVE T1,INPBLK+.RDBFP ;Initialize data
MOVEM T1,DATPTR ; pointer
MOVE T1,INPEOD ;Initialize
SUB T1,INPEOP ; data
MOVEM T1,DATCNT ; count
MOVE T1,OUPCR ;Get last character output
OPSTR <SKIPE>,RDFMT,+INPFLG ;Format flag set ?
CAIE T1,.CHCRT ;Yes. Was last character CR ?
IFSKP.
SKIPG INPEOD ;Yes. Is there prompt/initial data ?
IFSKP.
SKIPG INPEOP ;Yes. Is there a prompt ?
IFSKP.
MOVE T2,PRMPTR ;Yes. Point to prompt.
MOVEI T3,PRMPTR ;Get address of the pointer
MOVEI T4,PRMCNT ;Get address of the count
ELSE.
MOVE T2,DATPTR ;Yes. Point to prompt.
MOVEI T3,DATPTR ;Get address of the pointer
MOVEI T4,DATCNT ;Get address of the count
ENDIF.
ILDB T1,T2 ;Get the first byte.
CAIE T1,.CHCRT ;Is it a carriage return ?
IFSKP.
ILDB T1,T2 ;Yes. Get the next byte
SOSLE (T4) ;Update count - assume next byte is LF.
CAIE T1,.CHLFD ;Is next byte LF ?
IFSKP.
MOVEM T2,(T3) ;Yes. Wipe out CR/LF from the display this time
SOS (T4)
ELSE.
AOS (T4) ;Wrong assumption. Restore count.
ENDIF.
ELSE.
CAIE T1,.CHLFD ;No. Is first byte LF ?
IFSKP.
MOVEM T2,(T3) ;Yes. Wipe out LF from the display this time
SOS (T4)
ENDIF.
ENDIF.
SETOM LFFLAG ;No. Do free LF by hand.
ELSE.
OPSTR <SKIPN>,RDNEC,+INPFLG ;No prompt/initial data - echoing on ?
SETOM LFFLAG ;Yes. Do free LF by hand.
ENDIF.
ENDIF.
;Here to output the "free" line feed
SKIPN FREELF ;Did we already do a LF ?
SKIPN LFFLAG ;No. Output the free LF by hand ?
IFSKP.
MOVE T1,[POINT 8,[BYTE(8).CHLFD,0]] ;Yes. Do it.
MOVEI T2,1 ;Count
CALL OUPDSP ;(T1,T2)
SETZM OUPCR ;Clear flag
ENDIF.
SETZM FREELF ;Clear the free LF flag.
MOVE T1,PRMPTR ;Send prompt
MOVE T2,PRMCNT ; data to the terminal.
CALL OUPDSP ;(T1,T2)
MOVE T1,DATPTR ;Send initial
MOVE T2,DATCNT ; data to the terminal.
CALL OUPDSP ;(T1,T2)
MOVEI T1,.PRIIN ;Initialize line position
RFPOS%
HRRZS T2
SFPOS%
RET
ENDSV. ;End STKVAR
SUBTTL INPUT PROCESS -- START A READ -- CHECK FOR SINGLE CHARACTER READ
;CALL INPISB
;Returns +2 if a single character read
;Returns +1 otherwise
INPISB: MOVE T1,INPBLK+.RDDBC ;Get max buffer size.
CAILE T1,1 ;Is it small enough ?
IFSKP.
LOAD T1,RDDCD,+INPFLG ;Yes. Get flags
CAIL T1,2 ;Editing character disabled ?
RETSKP ;Yes. It is a single character read
ENDIF.
DMOVE T1,INPTBM ;Get first two words of terminator set.
CAMN T1,FULMSK ;All bits on
CAME T2,FULMSK ; on ?
RET ;No.
DMOVE T1,INPTBM+2 ;Get last two words of terminator set.
CAMN T1,FULMSK ;All bits on
CAME T2,FULMSK ; on ?
RET ;No.
RETSKP ;Yes. It is a single character read
SUBTTL INPUT PROCESS -- SEND INPUT STATE MESSAGE
;Here when the buffer has newly become non empty
;CALL INPICT
;Returns +1 always
INPICT: MOVE T1,CHRICT ;Get input count state characteristic
CAIN T1,1 ;Is it IGNORE ?
RET ;Yes. Done.
SKIPE RDACTV ;Is there a read active ?
CAIE T1,2 ;Yes. AND is it NO-READ-SEND ?
TRNA ;No to either
RET ;Yes to both. Done.
MOVE T1,INSPTR ;Point to message
MOVEI T2,INSSIZ ;Size of message
CALLRET MSGPUT ;(T1,T2) Send it off.
SUBTTL INPUT PROCESS -- TERMINAL INPUT AVAILABLE
;Here on PSI for terminal input available
;CALL INPENT
;Saves all ACs, DEBRK%s always
INPENT: CALL INPEN0 ;Do work.
DEBRK%
INPEN0: SAVET ;Save temporary registers
MOVEI T1,.FHSLF ;Turn off
DIR% ; interrupts
CALL INPEN1 ;Do work
MOVEI T1,.FHSLF ;Turn on
EIR% ; interrupts
RET
INPEN1: SKIPN INPIGN ;Ignoring input ?
IFSKP.
MOVEI T1,.PRIIN ;Yes. Clean out
CFIBF% ; input bufffer
RET ;Done.
ENDIF.
SKIPE INPSEE ;Was buffer empty ?
IFSKP.
MOVEI T1,.PRIIN ;Yes.
SIBE% ;Is it nonempty now ?
IFNSK.
CALL INPICT ;Yes. Send INPUT-COUNT state message, maybe.
SETOM INPSEE ;Input buffer is now not empty.
ENDIF.
ENDIF.
SKIPN OUPLCK ;Is terminal unlocked against echoing ?
SKIPN RDACTV ;Yes. Is there a read active ?
RET ;No or no. Done.
;Loop while read is active and input is available
DO.
CALL @INPDSP(INPSTA) ;No. Dispatch on input state. Read active ?
IFSKP.
MOVEI T1,.PRIIN ;Yes. Any more
SIBE% ; input ?
LOOP. ;Yes. Go get it.
ENDIF.
ENDDO.
RET ;Done.
SUBTTL INPUT PROCESS -- TERMINAL INPUT AVAILABLE -- RESTART
INPREC: POP P,(P) ;Pop return address off stack
CAIN INPSTA,.INORD ;If input state = ordinary, TEXTI% will restart
CALL TRMRTX ; so restore original terminal characteristics.
JRST INPEN1 ;Start over
SUBTTL INPUT PROCESS -- TERMINAL INPUT AVAILABLE -- ORDINARY
;Here when the input state is ordinary.
;CALL INPORD with no arguments
;Returns +2 if read is still active.
;Returns +1 if read has been terminated.
;This routine is optimized because it is the critical path.
INPORD: MOVEI T1,.FHSLF ;Turn on interrupts
EIR%
MOVEI T1,INPBLK ;Address of argument block
TEXTI% ;Get available data
;Label is for out of band process detecting restart necessary
INPORX: ERJMP ERR
MOVEI T1,.FHSLF ;Turn off interrupts
DIR%
MOVE T1,INPBLK+.RDFLG ;Get flags
ANDX T1,<RD%BLR+RD%BTM+RD%BFE> ;Isolate returned flags.
JUMPN T1,INPOFL ;If any set, handle them.
INPOR1: SKIPG INPBLK+.RDDBC ;Input buffer full ?
JRST [ MOVEI T1,.TMFUL ;Yes. Terminate read with input buffer full
SETZ T2, ;size of terminator.
CALLRET INPEND] ;(T1,T2)
SKIPN INPTMO ;Is this read timeout controlled ?
RETSKP ;No. Done.
MOVE T1,INPTIM ;Yes. Set
CALL TIMSET ;(T1) timer.
RETSKP ;Done.
SUBTTL INPUT PROCESS -- TERMINAL INPUT AVAILABLE -- SINGLE CHARACTER READ
;CALL INPBIN with no arguments
;Returns +2 if read is still active.
;Returns +1 if read has been terminated.
;This routine is optimized because it is the critical path.
INPBIN: MOVEI T1,.PRIIN ;Any characters available ?
SIBE%
TRNA
JRST INPOR1 ;No. Finish up.
OPSTR <SKIPE>,RDTEC,+INPFLG ;Is terminator to be echoed ?
IFSKP.
RFMOD%
TXZE T2,TT%ECO ;Yes. Force echo off - was it on ?
SETOM INPECH ;Yes. Must restore it after the read completes.
SFMOD%
ENDIF.
MOVEI T1,.FHSLF ;Yes. Turn on interrupts
EIR%
PBIN% ;Get character
;Label is for out of band process detecting restart necessary
INPBIX: MOVE T3,T1 ;Save it.
MOVEI T1,.FHSLF ;Turn off interrupts
DIR%
IDPB T3,INPBLK+.RDDBP ;Put character into buffer.
SOS INPBLK+.RDDBC ;Account for it.
IDIVI T3,^D32 ;Get word offset and bit offset
MOVE T4,BITS(T4) ;Change bit offset to mask
TDNN T4,INPXBM(T3) ;Is this character in the TEXTI% break mask ?
JRST INPOR1 ;No. Must be buffer full.
MOVX T1,RD%BTM ;Yes. Terminate the read just like
JRST INPOFL ; INPORD does.
SUBTTL INPUT PROCESS -- TERMINAL INPUT AVAILABLE -- READ RETURNED
;Here when flags returned from the TEXTI% (or INPBIN) are nonzero
;JRST INPOFL with T1/ flags
;Returns +2 if read is still active.
;Returns +1 if read has been terminated.
INPOFL: TXNN T1,RD%BTM ;Break character terminated read ?
IFSKP.
SETZM FREELF ;Initialize the free LF given flag
LDB T3,INPBLK+.RDDBP ;Yes. Get last character
CAIE T3,.CHCRT ;Is character CR ?
IFSKP.
PBIN% ;No. Eat the LF.
OPSTR <SKIPN>,RDNEC,+INPFLG ;Is echo on ?
SETOM FREELF ;Yes. Free LF was output.
ENDIF.
CAIN T3,.CHESC ;Is it escape
SKIPN INPESR ; AND is input escape sequence recognition on ?
IFSKP.
CALLRET INPDES ;Yes to both, set up escape sequence recognition
ELSE.
CAIN T3,.CHCNV ;No. Is it the quote character ?
SKIPN INPQOT ; AND is quoting enabled for this read ?
IFSKP.
CALLRET INPDOQ ;Yes to both, set up for quoting.
ENDIF.
ENDIF.
CAIE T3,.CHCNQ ;Is it control-Q or
CAIN T3,.CHCNS ; control-S ?
IFNSK.
HRROI T1,-1 ;Yes. Ignore it.
ADJBP T1,INPBLK+.RDDBP
MOVEM T1,INPBLK+.RDDBP
AOS INPBLK+.RDDBC
JRST INPOR1 ;Keep trying
ENDIF.
IDIVI T3,^D32 ;Get word offset and bit offset
MOVE T4,BITS(T4) ;Change bit offset to mask
TDNE T4,INPTBM(T3) ;Is this character in the CTERM terminator set ?
JRST INPTRD ;Yes. Terminate the read with terminator char.
JRST INPOR1 ;No. Keep trying
ENDIF.
TXNN T1,RD%BFE ;Underflow occurred ?
IFSKP.
MOVE T1,INPFLG ;Get the START-READ flags
TXNN T1,RDCON ;Is it a continuation read also?
IFSKP. ;Yes. Must be handled by the host.
MOVEI T1,.PRIIN ;Backup and re-read the
BKJFN% ; editing character
MOVEI T1,.PRIIN ; to be sent to the
PBIN% ; host.
IDPB T1,INPBLK+.RDDBP;Deposit in the message buffer.
MOVEI T1,.TMTIM ;Termination reason is timeout(none other fits)
SOS INPBLK+.RDDBC ;Account for the character
ELSE. ;No continuation read.
MOVEI T1,.TMUND ;Terminate read with condition "underflow"
ENDIF.
SETZ T2, ;No terminator
CALLRET INPEND ;(T1,T2)
ENDIF.
;Must be backup limit reached
MOVE T1,INPBLK+.RDDBP ;Yes. Reset
HRROI T2,-1 ; backup
ADJBP T2,T1 ; limit
MOVEM T2,INPBLK+.RDBKL ; pointer
RETSKP
SUBTTL INPUT PROCESS -- TERMINAL INPUT AVAILABLE -- TERMINATOR CHARACTER
;Here to terminate read with reason terminator character
;and to remember the last character sent to the terminal (OUPCR)
;CALL INPTRD with no arguments
;returns +1 always
INPTRD: LDB T3,INPBLK+.RDDBP ;Get last input character
MOVEI T1,.PRIIN ;Get current mode.
RFMOD%
TXNN T2,TT%ECO ;Was echo on ?
IFSKP.
CAIE T3,.CHCRT ;Yes. Is the character CR ?
IFSKP.
LOAD T2,OBECH,+OOBCHA(T3) ;Yes. Get echo characteristic
CAIN T2,EC.STD ;Is it standard format ?
MOVEI T3,.CHLFD ;Yes. Last character sent to terminal was LF.
ENDIF.
MOVEM T3,OUPCR ;Save last character echoed.
CAIL T3,.CHSPC ;Was it a control character?
CAIN T3,.CHDEL ;or DEL?
IFSKP. ;No, the terminator might have been echoed.
OPSTR <SKIPE>,RDTEC,+INPFLG ;should terminator have been echoed?
IFSKP. ;No.
CAIN INPSTA,.INORD;Was the input mode normal (TEXTI% used)?
SETOM TRMFLG ;Yes. Set flag that we echoed the terminator
ENDIF. ;by "mistake" so that we can toss the echo
ENDIF. ;message sent by the host. (ugly but effective)
ENDIF.
MOVEI T1,.TMTRM ;Terminate read with terminator reason.
MOVEI T2,1
CALLRET INPEND ;(T1,T2)
SUBTTL INPUT PROCESS -- TERMINAL INPUT AVAILABLE -- START QUOTE
;Here when quoting is starting.
;CALL INPDOQ
;Returns +2 if the read is still active.
;Returns +1 if the read was terminated
INPDOQ: CALL PSINSC ;Turn off single character interrupts.
MOVEI INPSTA,.INQUT ;Change state to "quote in progress"
MOVE T1,INPBLK+.RDDBC ;Is there room in the ?
SUBI T1,2 ; buffer for the next char
JUMPGE T1,RSKP ;Yes. Read is still active.
MOVEI T1,.TMABS ;No. Terminate read with absentee token.
SETZ T2, ;No terminator.
CALLRET INPEND ;(T1,T2)
SUBTTL INPUT PROCESS -- TERMINAL INPUT AVAILABLE -- START ESCAPE SEQUENCE RECOGNITION
;Here when input escape recognition is starting.
;CALL INPDES
;Returns +2 always since the read is still active.
INPDES: MOVEI T1,.PRIIN ;Get mode
RFMOD% ; word
MOVEM T2,ESCMOD ;Save it.
TXZ T2,TT%ECO ;Turn off
SFMOD% ; echoing
STPAR%
MOVEI INPSTA,.INESC ;Set state to "parsing escape sequence parsing"
HRROI T1,-1 ;Remove
ADJBP T1,INPBLK+.RDDBP ; escape
MOVEM T1,INPBLK+.RDDBP ; from
AOS INPBLK+.RDDBC ; buffer.
SETZ ESCSTA, ;Initialize the state
MOVEI T1,ESCMAX ;Initialize the
MOVEM T1,ESCCNT ; count
MOVE T1,ESCBUF ;Initialize the
MOVEM T1,ESCPTR ; pointer.
MOVEI T1,.CHESC ;Put in the
IDPB T1,ESCPTR ; ESCAPE
SOS ESCCNT ;Account for it.
RETSKP ;Done.
SUBTTL INPUT PROCESS -- TERMINAL INPUT AVAILABLE -- QUOTE IN PROGRESS
;Here when the input state is quote in progress.
;CALL INPQUT with no arguments
;Returns +2 if read is still active
;Returns +1 if read was terminated
INPQUT: MOVEI INPSTA,.INORD ;Put state back to ordinary.
MOVEI T1,.CHCNV ;Get the quote character
IDPB T1,INPBLK+.RDDBP ;Put it into the buffer
SOS INPBLK+.RDDBC ;Account for it.
PBIN% ;Get the next character
IDPB T1,INPBLK+.RDDBP ;Put it into the buffer
SOS INPBLK+.RDDBC ;Account for it.
CALL PSIRSC ;Restore single character interrupts.
SKIPLE INPBLK+.RDDBC ;Is buffer full ?
RETSKP ;No. Read is still active
MOVEI T1,.TMFUL ;Yes. Terminate read with buffer full
SETZ T2, ;No terminator
CALLRET INPEND ;(T1,T2)
SUBTTL INPUT PROCESS -- TERMINAL INPUT AVAILABLE -- ESCAPE SEQUENCE
;Here when the input state is escape sequence parsing in progress.
;CALL INPESC with no arguments
;Returns +2 if read is still active
;Returns +1 if read was terminated
INPESC: PBIN% ;Get byte
IDPB T1,ESCPTR ;Save it
SOSLE ESCCNT ;Account for it. Out of space ?
JRST @TSTATE(ESCSTA) ;No. Invoke the state machine.
CALLRET INVALD ;Yes. Terminate read - invalid escape sequence
;The intermediate state machine routines - just change the state
;Transition to state 1
STATE1: MOVEI ESCSTA,1 ;Set the state and
RETSKP ; continue
;Transition to state 2
STATE2: MOVEI ESCSTA,2 ;Set the state and
RETSKP ; continue
;Transition to state 3
STATE3: MOVEI ESCSTA,3 ;Set the state and
RETSKP ; continue
;Transition to state 4
STATE4: MOVEI ESCSTA,4 ;Set the state and
RETSKP ; continue
;Transition to state 5
STATE5: MOVEI ESCSTA,5 ;Set the state and
RETSKP ; continue
;Here on invalid escape sequence
;Clean up and terminate the read with absentee token or invalid escape sequence
INVALD: MOVEI T1,.PRIIN ;Restore the
MOVE T2,ESCMOD ; state of
SFMOD% ; the echo.
STPAR%
;Common entry for terminating with invalid escape sequence
INVAL1: SAVEAC <Q1>
MOVEI T3,ESCMAX ;Compute how many characters
SUB T3,ESCCNT ; are in the escape buffer.
MOVE Q1,INPBLK+.RDDBC ;Compute how much room will be
SUB Q1,T3 ; left in the input buffer.
IFL. Q1 ;Will it even fit ?
MOVE T3,INPBLK+.RDDBC ;No. Put in as many as will fit.
MOVE T4,Q1 ;Get pointer to
ADJBP T4,ESCPTR ; leftovers
MOVEI T1,.PRIIN ;Put the leftovers back.
DO.
ILDB T2,T4 ;Get byte
STI% ;Put it back.
AOJL Q1,TOP. ;If more, continue.
ENDDO.
ENDIF.
MOVEI T1,.TMIES ;Invalid escape sequence code.
CALL ESCTRM ;(T1,T3) termination.
MOVEI T1,.PRIIN ;Now put the leftovers back.
DO.
AOJG Q1,RTN ;If done, leave.
ILDB T2,Q2 ;Get byte
STI%
LOOP.
ENDDO.
;Here on valid escape sequence
VALID: MOVEI T1,.PRIIN ;Restore the
MOVE T2,ESCMOD ; state of
SFMOD% ; the echo.
STPAR%
MOVEI T3,ESCMAX ;Compute the
SUB T3,ESCCNT ; count.
CAMG T3,INPBLK+.RDDBC ;Will it fit in input buffer ?
IFSKP.
MOVE T3,INPBLK+.RDDBC ;No. Is the input
CAML T3,INPLEN ; buffer empty ?
JRST INVAL1 ;Yes. Terminate with invalid escape sequence.
MOVEI ESCSTA,6 ;No. Set state to retry later and
MOVEI T1,.TMABS ;terminate with absentee token.
SETZ T2, ;no terminator
CALLRET INPEND ;(T1,T2)
ENDIF.
MOVEI T1,.TMVES ;Valid escape sequence
CALLRET ESCTRM ;(T1,T3) termination
;Here to move characters from the escape buffer to the read message
;and terminate the read
;CALL ESCTRM with
;T1/ termination reason code
;T3/ count of character to move
;Returns +1 always
ESCTRM: SAVEAC <Q1>
MOVE Q1,T1 ;Save reason code
MOVEI INPSTA,.INORD ;Put input state back to ordinary.
MOVE T1,INPBLK+.RDDBP ;The destination
MOVE T2,ESCBUF ;The source
MOVE T4,T3 ;Save count
MOVNS T3 ;The negative of the count.
ADDM T3,INPBLK+.RDDBC ;Update the count
SOUT%
MOVEM T1,INPBLK+.RDDBP ;Update the destination
MOVE T2,T4 ;Size of terminator
MOVE T1,Q1 ;Restore reason code.
CALLRET INPEND ;(T1,T2)
;Here when there is a valid escape sequence, and a brand new read was issued
;for it
;CALL VALDON with no arguments
VALDON: MOVEI T3,ESCMAX ;Get length of
SUB T3,ESCCNT ; sequence
CAMLE T3,INPBLK+.RDDBC ;Is it too big ?
JRST INVAL1 ;Yes. Terminate with invalid esc seq
MOVEI T1,.TMVES ;No.
CALLRET ESCTRM ;(T1,T3) Terminate with valid esc seq
SUBTTL INPUT PROCESS -- CLEAR INPUT BUFFER
;CALL INPCIB with no arguments
;Returns +1 always
INPCIB: SKIPN RDACTV ;Is there a read active ?
RET ;No. Done.
MOVE T1,INPBLK+.RDBFP ;Get start of buffer
MOVEM T1,INPBLK+.RDDBP ;Make the destination the start.
MOVE T1,INPLEN ;Get size of buffer
MOVEM T1,INPBLK+.RDDBC
RET
SUBTTL INPUT PROCESS -- TERMINATE A READ
;Construct the READ message from the input process data base.
;CALL INPEND with
; T1/ completion code
; T2/ size of terminator in bytes.
; and terminator, if any, in the input buffer
;Returns +1 always
INPEND: STKVAR <TRMSIZ>
MOVEM T2,TRMSIZ ;Save size of terminator
DPB T1,REDCPT ;Stash away the completion code.
SETZ T2, ;Assume no more data
MOVEI T1,.PRIIN ;Is there
SIBE% ; more data ?
MOVEI T2,1 ;Yes.
DPB T2,REDTPT ;Stash the more typeahead flag
MOVEM T2,INPSEE ; and remember for later.
MOVE T1,INPBLK+.RDBKL ;Get low water pointer
MOVE T2,INPBLK+.RDBFP ;Get starting pointer
CALL CHDIFF ;(T1,T2/T1) Compute low water position
SKIPGE T1 ;Is it negative ?
SETZ T1, ;Yes. Make it zero.
PUT2BY T1,REDLPT ;Put into message
MOVEI T1,.PRIIN ;Get horizontal and
RFPOS% ; vertical positions
DPB T2,REDHPT ;Put horizontal into message
HLRZ T3,T2 ;Get vertical
DPB T3,REDVPT ;Put vertical into message
MOVE T1,INPLEN ;Compute number of data bytes in message
SUB T1,INPBLK+.RDDBC
MOVE T2,T1 ;Copy it
SUB T1,TRMSIZ ;Compute terminator position
PUT2BY T1,REDPPT ;Put into message
ADDI T2,REDCSZ ;Add in size of rest of CTERM message
MOVE T1,T2 ;Copy it
PUT2BY T1,REDSPT ;Put into message
ADDI T2,REDHDR ;Add in size of foundation header
MOVE T1,REDPTR ;Point to message
CALL MSGPUT ;(T1,T2/T2) Send it off.
CALL INPTTY ;Restore the state of the terminal
SETZM RDACTV ;Read is no longer active.
CALL TIMCLR ;Reset the timer
RET ;Done.
SUBTTL INPUT PROCESS -- TERMINATE A READ -- RESTORE TTY STATE
;Restore the state of the terminal - raise, echo, control-G echoing.
;CALL INPTTY with no arguments
;Returns +1 always
INPTTY: MOVEI T1,.PRIIN ;Get mode word.
RFMOD% ;(T1/T2)
SKIPN INPRAI ;Was RAISE changed ?
IFSKP.
TXZN T2,TT%LIC ;Yes. Assume it was RAISE - restore NO RAISE
TXO T2,TT%LIC ;No, it was NO RAISE - restore RAISE
ENDIF.
SKIPE INPECH ;Is ECHO to be restored ?
TXO T2,TT%ECO ;Yes.
SFMOD% ;Restore mode.
STPAR%
MOVX T1,.CHBEL ;Restore ^G
LOAD T2,OBECH,+OOBAC1+.CHBEL ; echo
CALL PREECH ;(T1,T2) characteristic.
SKIPN INPCTL ;Do control characters need to be reenabled ?
IFSKP.
CALL PSIRSC ;Restore single character interrupts
SETZM INPCTL ;Done.
ENDIF.
RET
SUBTTL INPUT PROCESS -- DISPLAY INPUT BUFFER
;Display the input buffer
;CALL INPDPL with no arguments
INPDPL: $PSOUT (<INPBLK+.RDRTY>,INPEOP) ;Prompt
MOVE T2,INPLEN ;Data - compute
SUB T2,INPBLK+.RDDBC ; count
$PSOUT (<INPBLK+.RDBFP>,T2)
RET
SUBTTL TIMER PROCESS -- THE TIMER
;This routine implements the timer for the timeout option on the START-READ
;as well as being the idle loop for this program
;CALL TIMINI with no arguments
;Never returns.
TIMINI: SETOM T1 ;Get
MOVE T2,[-1,,JOBNO] ; my
MOVE T3,.JIJNO ; job
GETJI% ; number
TRN
MOVEI T1,.FHSLF
DIR% ;No interrupts.
CALL TIMNUL ;(/T1) Start off in state "off"
;Infinite loop
DO.
MOVE T2,T1 ;Save timeout period
MOVEI T1,.FHSLF ;Allow
EIR% ; interrupts
MOVE T1,T2 ;Get sleep time
THIBR% ;Sleep
TRN
MOVEI T1,.FHSLF ;No interrupts
DIR% ; allowed
MOVE T1,TIMSTA ;Get the timer state
CALL @TIMDSP(T1) ;(/T1) Dispatch per state
LOOP. ;Go back to sleep
ENDDO.
;Dispatch routine - here when the state is "ticking"
;CALL TIMTIK
;Returns +1 always with T1/ sleep time
TIMTIK: MOVEI T1,.TMTIM ;Yes. Terminate the read with timeout
SETZ T2, ;No terminator
CALL INPEND ;(T1,T2)
MOVEI T1,.TMNUL ;Set the timer's state
MOVEM T1,TIMSTA ; to off.
HRRZI T1,777777 ;Set up to sleep for a long time
RET ;Done
;Dispatch routine - here when the state is "off"
;CALL TIMNUL
;Returns +1 always with T1/ sleep time
TIMNUL: HRRZI T1,777777 ;Set up to sleep for a long time
RET ;Done
;Dispatch routine - here when the state is "set request"
;CALL TIMSTT
;Returns +1 always with T1/ sleep time
TIMSTT: MOVEI T1,.TMTIK ;Set the state
MOVEM T1,TIMSTA ; to ticking
MOVE T1,TIMOUT ;Get the timeout interval
RET ;Done
SUBTTL TIMER PROCESS -- CLEARING AND SETTING THE TIMER
;This routine clears the timer
;CALL TIMCLR with no arguments
;Returns +1 always
TIMCLR: MOVEI T1,.TMNUL ;Set the state of the timer
MOVEM T1,TIMSTA ;to "off"
RET ;Done.
;This routine sets up the timer for the timeout option on the START-READ
;CALL TIMSET with T1/ number of seconds timer is to be set for
;Returns +1 always
;Uses T1 only
TIMSET: MOVEM T1,TIMOUT ;Set the timeout period
MOVEI T1,.TMSTT ;Set the state of the timer "set request"
MOVEM T1,TIMSTA ;Set the state
MOVE T1,JOBNO ;Get my job number
TWAKE% ;Wake the timer up to process the request
TRN
RET ;Done
SUBTTL UTILITY ROUTINES -- TURN OFF SINGLE CHARACTER INTERRUPTS
;CALL PSINSC with no arguments
;Returns +1 always
PSINSC: MOVEI T1,-5 ;Get terminal
RTIW% ; interrupt word
MOVEM T2,INPTIW ;Save it.
TDZ T2,[777777,,777700] ;Clear all single character interrupts.
STIW%
RET
SUBTTL UTILITY ROUTINES -- TURN ON SINGLE CHARACTER INTERRUPTS
;CALL PSIRSC with no arguments
;Returns +1 always
PSIRSC: MOVEI T1,-5 ;Get terminal
MOVE T2,INPTIW ;Get saved word.
IORI T2,<1B<.TICTI>+1B<.TITCE>> ;Plus two character interrupts and data
; available.
STIW% ;Restore it.
RET
SUBTTL UTILITY ROUTINES -- SET UP PSI SYSTEM
;Set up the PSI system
;CALL PSIINI with
; NETJFN/ DECnet JFN.
;Returns +1 always
PSIINI: MOVX T1,.FHSLF ;Set up the interrupt system
MOVE T2,[LEVTAB,,CHNTAB]
SIR%
MOVX T2,1B<ESCCHN>+1B<DNCHAN>+1B<TTCHAN> ;Activate channels
AIC% ; that are always on.
MOVEI T1,-5 ;Allow only two character switch sequence &
MOVX T2,<1B<.TITCE>+1B<.TICTI>> ; input buffer nonempty interrupts.
STIW%
MOVE T1,[XWD .TITCE,ESCCHN] ;Hook up switch sequence
ATI%
MOVE T1,[XWD .TICTI,TTCHAN] ;Hook up terminal input available
ATI% ;
MOVE T1,NETJFN ;Hook up DECnet channel -
MOVEI T2,.MOACN ; data available & disconnect interrupt.
MOVX T3,<FLD (DNCHAN,MO%DAV)>
MTOPR% ;Don't enable PSIs (EIR%) until later
RET
SUBTTL UTILITY ROUTINES -- SAVE CTERM TERMINAL STATE
;Save the terminal state just before exiting (in case of reentry)
;CALL TRMSTP with no arguments
;Returns +1 always
TRMSTP: MOVEI T1,.PRIIN ;Get the CCOC words
RFCOC%
DMOVEM T2,CTMCOC ;Save them
MOVEI T1,.PRIIN
RFMOD% ;Get the JFN mode word
MOVEM T2,CTMRFM ;Save it.
MOVX T2,.MORLW ;Get the terminal page width
MTOPR%
MOVEM T3,CTMWID ;Save it.
MOVX T2,.MORLL ;Get the terminal page length
MTOPR%
MOVEM T3,CTMLEN ;Save it.
MOVX T2,.MORXO ;Get the end of page mode
MTOPR%
MOVEM T3,CTMMOD ;Save it.
MOVX T2,.MORTC ;Get two character switch sequence
MTOPR%
MOVEM T3,CTMSWI ;Save it.
GTTYP% ;Get terminal type
MOVEM T2,CTMTYP ;Save it.
MOVX T1,RT%DIM+.FHSLF ;Get the terminal interrupt mask
RTIW%
DMOVEM T2,CTMRTI ;Save it.
MOVEI T1,-5 ;Get the job wide terminal interrupt mask.
RTIW%
MOVEM T2,CTMRTJ ;Save it.
RET ;Done.
SUBTTL UTILITY ROUTINES -- SAVE ORIGINAL TERMINAL STATE
;Save the original terminal state.
;CALL TRMSAV with no arguments
;Returns +1 always
TRMSAV: MOVEI T1,.PRIIN ;Get the CCOC words
RFCOC%
DMOVEM T2,OLDCOC ;Save them
MOVEI T1,.PRIIN
RFMOD% ;Get the JFN mode word
MOVEM T2,OLDRFM ;Save it.
MOVX T2,.MORLW ;Get the terminal page width
MTOPR%
MOVEM T3,OLDWID ;Save it.
MOVX T2,.MORLL ;Get the terminal page length
MTOPR%
MOVEM T3,OLDLEN ;Save it.
MOVX T2,.MORXO ;Get the end of page mode
MTOPR%
MOVEM T3,OLDMOD ;Save it.
MOVX T2,.MORTC ;Get two character switch sequence
MTOPR%
MOVEM T3,OLDSWI ;Save it.
GTTYP% ;Get terminal type
MOVEM T2,OLDTYP ;Save it.
MOVX T1,RT%DIM+.FHSLF ;Get the terminal interrupt mask
RTIW%
DMOVEM T2,OLDRTI ;Save it.
MOVEI T1,-5 ;Get the job wide terminal interrupt mask.
RTIW%
MOVEM T2,OLDRTJ ;Save it.
HRROI T1,[ASCIZ\TTY:\] ;Get terminal type
STDEV% ;(T1/T2)
ERJMP ERR
MOVE T1,T2
GTTYP% ;(T1/T2)
ERJMP ERR
CAILE T2,TRMTBL ;In range ?
SETZ T2,
MOVEM T2,TRMTYP ;Save the TOPS20 terminal type.
CAIL T2,0 ;Range
CAIL T2,TRMTBL ; check
RET ;Failed.
MOVE T2,TRMTAB(T2) ;Get the characteristics
MOVEM T2,TRMCHA ;Save them.
RET ;Done.
SUBTTL UTILITY ROUTINES -- SAVE TERMINAL STATE FOR TEXTI RESTART
;Save the terminal state before a TEXTI% JSYS in case it is interrupted
;by an out-of-band interrupt.
;CALL TRMSTX with no arguments
;Returns +1 always
TRMSTX: MOVEI T1,.PRIIN ;Get the CCOC words
RFCOC%
DMOVEM T2,TXTCOC ;Save them
MOVEI T1,.PRIIN
RFMOD% ;Get the JFN mode word
MOVEM T2,TXTRFM ;Save it.
MOVX T2,.MORFW ;Get the field width
MTOPR%
MOVEM T3,TXTFW ;Save it
MOVEI T2,4 ;Argument block length
MOVEM T2,TXTMSK
MOVEI T2,.MORBM ;Get the break mask
MOVEI T3,TXTMSK ;Save it here.
MTOPR%
RET ;Done.
SUBTTL UTILITY ROUTINES -- SET UP TERMINAL
;Set up the terminal for CTERM processing
;CALL TRMINI with no arguments
;Returns +1 always
TRMINI: MOVEI T1,.PRIIN ;Make all control characters
MOVE T2,CCCODE ; give
MOVE T3,CCCODE ; their code.
SFCOC% ;(T1,T2,T3)
MOVEI T1,.PRIIN ;Get the mode word
RFMOD% ;(T1/T1,T2)
;ALlow echo, form-feed, mech-tab, lower-case, pause on command, if they already exist.
ANDX T2,<TT%ECO+TT%MFF+TT%TAB+TT%LCA+TT%LEN+TT%WID+TT%PGM>
MOVX T3,.TTATE ;Set data mode to
STOR T3,TT%DAM,+T2 ; translate echo only.
SFMOD% ;(T1,T2)
STPAR% ;(T1,T2)
MOVX T2,.MOXOF ;Disable pause on end of page
MOVX T3,.MOOFF
MTOPR% ;(T1,T2,T3)
MOVX T2,.MORLW ;Read line width
MTOPR%
MOVEM T3,LINWID ;Set up line width characteristic
CFIBF% ;(T1)
RET
SUBTTL UTILITY ROUTINES -- RESTORE ORIGINAL TERMINAL STATE
;Restore the original terminal state
;CALL TRMRST with no arguments
;Returns +1 always
TRMRST: MOVEI T1,.PRIIN ;CCOC words
MOVE T2,OLDTYP ;Set terminal type
STTYP%
DMOVE T2,OLDCOC
SFCOC%
MOVEI T1,.PRIIN ;JFN mode word
MOVE T2,OLDRFM
SFMOD%
STPAR%
MOVX T2,.MOXOF ;Pause on end of page
MOVE T3,OLDMOD
MTOPR%
MOVX T2,.MOSLW ;Terminal page width
MOVE T3,OLDWID
MTOPR%
MOVX T2,.MOSLL ;Terminal page width
MOVE T3,OLDLEN
MTOPR%
MOVX T2,.MOTCE ;Set two character switch sequence
SKIPE T3,OLDSWI ; if it exists.
MTOPR%
CFIBF% ;(T1)
MOVEI T1,-5 ;Set the job wide terminal interrupt mask.
MOVE T2,OLDRTJ
STIW%
MOVX T1,ST%DIM+.FHSLF ;Terminal interrupt mask
DMOVE T2,OLDRTI
STIW%
RET
SUBTTL UTILITY ROUTINES -- RESTORE CTERM TERMINAL STATE
;Restore the terminal state after reentry
;CALL TRMREE with no arguments
;Returns +1 always
TRMREE: MOVEI T1,.PRIIN ;CCOC words
DMOVE T2,CTMCOC
SFCOC%
MOVEI T1,.PRIIN ;JFN mode word
MOVE T2,CTMRFM
SFMOD%
STPAR%
MOVX T2,.MOXOF ;Pause on end of page
MOVE T3,CTMMOD
MTOPR%
MOVX T2,.MOTCE ;Set two character switch sequence
MOVE T3,CTMSWI
MTOPR%
MOVE T2,CTMTYP ;Set terminal type
STTYP%
MOVX T2,.MOSLW ;Terminal page width
MOVE T3,CTMWID
MTOPR%
MOVX T2,.MOSLL ;Terminal page width
MOVE T3,CTMLEN
MTOPR%
MOVEI T1,-5 ;Set the job wide terminal interrupt mask.
MOVE T2,CTMRTJ
STIW%
MOVX T1,ST%DIM+.FHSLF ;Terminal interrupt mask
DMOVE T2,CTMRTI
STIW%
MOVEI T1,.PRIIN ;Get terminal type
GTTYP%
MOVEM T2,TRMTYP
CAIL T2,0 ;Range
CAIL T2,TRMTBL ; check
RET ;Failed.
MOVE T2,TRMTAB(T2) ;Get the characteristics
MOVEM T2,TRMCHA ;Save them.
RET ;Done.
SUBTTL UTILITY ROUTINES -- RESTORE TERMINAL STATE FOR TEXTI RESTART
;Restore the terminal state before a TEXTI% JSYS restart after it has been
;interrupted by an out-of-band character.
;CALL TRMRTX with no arguments
;Returns +1 always
TRMRTX: MOVEI T1,.PRIIN
DMOVE T2,TXTCOC ;Get original CCOC words
SFCOC% ;Restore them.
MOVEI T1,.PRIIN
MOVE T2,TXTRFM ;Get orginal JFN mode word
SFMOD% ;Restore it.
MOVX T2,.MOSFW ;Get the field width
MOVE T3,TXTFW ;Restore it.
MTOPR%
MOVEI T2,4 ;Argument block length
MOVEM T2,TXTMSK
MOVEI T2,.MOSBM ;Get the original break mask
MOVEI T3,TXTMSK ;Restore it.
MTOPR%
RET ;Done.
SUBTTL UTILITY ROUTINES -- EXIT WITH REENTRY ALLOWED
;Here when two character escape sequence is typed.
;Returns +1, if at all.
;Preserves all ACs, DEBRK%s always
REENTR: CALL REENT0 ;Do work.
DEBRK%
REENT0: SAVET ;Save temporary registers
MOVEI T1,.FHSLF ;Turn off
DIR% ; interrupts
CALL REENT1 ;Do work
MOVEI T1,.FHSLF ;Turn on
EIR% ; interrupt
RET
REENT1: SKIPE DEBUG ;If not debugging.
IFSKP.
CALL TRMSTP ;Save CTERM terminal state
CALL TRMRST ;() Restore original state of terminal
CALL SETPNM ;restore program(node) name
ENDIF.
TMSG <
[Connection interrupted, back at node >
CALL PRTNOD ;Print local node name
TMSG <,
Type CONTINUE to resume connection]
>
SKIPN DEBUG ;Is debugger on ?
IFSKP.
CALL BUGENT ;Yes. Go to it instead.
ELSE.
HALTF% ;Exit program.
CALL TRMSAV ;() Restart - save current terminal state
CALL TRMREE ;() Restore CTERM terminal
CALL SETPNM ;restore program(node) name
SKIPE DEBUG ;Is debugger on ?
CALL BUGENT ;Yes. Go to it.
ENDIF.
RET ;Done.
SUBTTL UTILITY ROUTINES -- ERROR ROUTINES
;Bomb out of this program
;CALL FATAL with no arguments
;Never returns
FATAL: CALL TRMRST ;Restore state of terminal
RESET% ;Be on the safe side.
HALTF% ;Exit program
JRST .-1 ;Do not allow reentry
;Print jsys error and die
;CALL ERR with no arguments
;Prints error
;Returns +1 always
ERR: TMSG <
?>
MOVEI T1,.PRIOU ;Send it to the terminal
MOVE T2,[XWD .FHSLF,-1] ;Latest error
SETZ T3, ;No limit
ERSTR% ;Print out the error.
TRN
TRN
JRST FATAL
SUBTTL UTILITY ROUTINES -- STRING LENGTH
;Routine to find the difference of two eight bit byte pointers
;CALL CHDIFF with
; T1/ finishing byte pointer
; T2/ starting byte pointer
;Returns +1 always with T1/ difference in bytes.
CHDIFF: DMOVE T3,T1
LSH T3,-^D33 ;Get byte offset within word
LSH T4,-^D33 ;Get byte offset within word
SUB T4,T3 ;The byte difference
HRRZS T2 ;Now
HRRZS T1 ; compute
SUB T1,T2 ; the word difference
LSH T1,2 ;Convert to bytes.
ADD T1,T4 ;Add them up
RET ;Done.
SUBTTL UTILITY ROUTINES -- GET INTERRUPT SEQUENCE
;Gets the two character interrupt sequence from the user.
;CALL GETINS with no arguments
;Returns +1 always with SWCHR1 and SWCHR2 set up.
GETINS: SKIPE RESCAN ;Rescan buffer filled in ?
IFSKP.
HRROI T1,[ASCIZ/Two character interrupt sequence (^\,<RET>): /] ;No.
PSOUT% ;Prompt user.
MOVEI T1,.PRIIN ;Initialize.
CFIBF%
SETZ T4, ;Initialize string storage.
MOVE T1,TCEPTR ;Byte pointer to string (in T4)
MOVX T2,<RD%BEL+RD%CRF+TCESIZ> ;Suppress CR, break on LF, max is 5
HRROI T3,[ASCIZ/Two character interrupt sequence (^\,<RET>): /] ;Prompt
RDTTY%
ERJMP ERR ;Error. Print message and die
TXNE T2,RD%BTM ;Saw terminator ?
IFSKP.
DO.
PBIN% ;No. Eat characters until CR/LF
CAIN T1,.CHLFD
LOOP.
ENDDO.
ENDIF.
MOVE T1,TCEPTR ;Get the
ILDB T2,T1 ; first character
ILDB T3,T1 ;Get the second.
CAIE T2,.CHLFD ;Is the first character line feed ?
IFSKP.
MOVEI T3,<<.CHCBS_7> ! .CHCRT> ;Yes. Use the default.
ELSE.
LSH T2,7 ;No. Use the
IORM T2,T3 ; given sequence.
ENDIF.
ELSE.
MOVEI T3,<<.CHCBS_7> ! .CHCRT> ;Yes. Use the default.
ENDIF.
LDB T4,[POINT 7,T3,28] ;Get first character
MOVEM T4,ESCCHR ;Save it
MOVEI T1,.PRIIN ;Now set up the
MOVEI T2,.MOTCE ; two character
MTOPR% ; escape sequence
ERJMP ERR ;Error. Print message and die
RET ;Done.
SUBTTL UTILITY ROUTINES -- GET THE RSCAN BUFFER
;If the node name was specified in the RSCAN buffer, pick it up.
;CALL GETRSC with no arguments
;Returns +1 always with RESCAN set accordingly and node name set up if present
GETRSC: SETZM RESCAN ;Initialize RESCAN flag
SKIPE DEBUG ;Is debugging on ?
RET ;Yes. Force user to type in node & escape seq.
MOVX T1,.RSINI ;Initialize RSCAN% buffer
RSCAN%
RET ;On failure, give up.
MOVEM T1,RSCCNT ;Save count.
MOVN T3,T1 ;Get RESCAN buffer
MOVEI T1,.PRIIN
MOVE T2,RSCPTR
SIN%
HRROI T1,[ASCIZ\CTERM-SERVER\] ;Is first word CTERM-SERVER ?
MOVE T2,RSCPTR
STCMP%
TXNN T1,SC%SUB ;Is it ?
RET ;No. Done.
DO. ;Yes. Get past white space.
ILDB T3,T2 ;Get next byte
CAIE T3,.CHSPC ;Is it SPACE
CAIN T3,.CHTAB ; or TAB ?
LOOP. ;Yes. Continue
ENDDO.
CAIE T3,.CHLFD ;Is last char LF or
CAIN T3,.CHCRT ; CR ?
RET ;Yes. Done.
CAIN T3,.CHFFD ;Is last char form feed ?
RET ;Yes. Done.
SETOM RESCAN ;No. There must a node name.
MOVEI T1,6 ;Max node name size
MOVE T4,NODPTR ;Now fill in the node name
DO.
SOSL T1 ;Decrement count and test for done
IDPB T3,T4 ;Put byte into storage.
ILDB T3,T2 ;Get next byte
CAIE T3,.CHLFD ;Is last char LF or
CAIN T3,.CHCRT ; CR ?
EXIT. ;Yes. Exit loop.
CAIN T3,.CHFFD ;Is last char form feed ?
EXIT. ;Yes. Done.
CAIN T3,":" ;Is last char a colon?
EXIT. ;Yes. Done.
LOOP.
ENDDO.
SETZ T1, ;Null
IDPB T1,T4 ; terminate
;At this point T3 will probably contain ":". If so, see if another node
; name follows. If so, it is a PMR case and we hand over control to NRT.
CAIE T3,":" ;Is it colon?
IFSKP. ;Yes
ILDB T3,T2 ;This should be another colon
CAIE T3,":" ;Is it?
RET ;No, done
ILDB T3,T2 ;Get one more byte
CAIE T3,.CHLFD ;LF?
CAIN T3,.CHCRT ;or CR?
RET ;All done then
CAIN T3,.CHFFD ;Form feed?
RET ;Yes, done
HRROI T1,[ASCIZ /
/]
PSOUT% ;Give a new line
MOVEI T1,.FHSLF ;Set error for fork so that exec can try NRT.
MOVEI T2,NSPX20 ;This is the error that SET HOST looks for.
SETER% ;Set it
HALTF% ;Stop
JRST .-1 ;Yes, stop
ENDIF.
RET ;Done.
SUBTTL UTILITY ROUTINES -- NODE NAMES
;Gets the remote node name from the user.
;CALL GETNOD with no arguments
;Returns +1 always
GETNOD: SKIPE RESCAN ;Rescan succeeded ?
RET ;Yes. Node name already set up.
MOVEI T1,.PRIIN ;Initialize.
CFIBF%
PROMPT <Node name: >
MOVEI T1,[FLDDB.(.CMNOD,<CM%NSF>)]
CALL CFIELD ;Get field and confirm command.
MOVE T1,NODPTR ;Move to right place
HRROI T2,ATMBUF
SETZ T3,
SOUT%
RET ;Done.
;Print out escape sequence
;CALL PRTINS with no arguments
;Preserves all ACs
PRTINS: SAVEAC <T1,T2,T3>
MOVEI T1,.PRIIN
MOVEI T2,.MORTC
MTOPR% ;(T1,T2/T3)
LDB T1,[POINT 7,T3,28] ;Get first character.
CALL PRTIN1 ;(T1) Print it
MOVEI T1,"," ;Delimiter.
PBOUT%
LDB T1,[POINT 7,T3,35] ;Get second character.
CAIE T1,.CHCRT ;Is it carriage return ?
JRST PRTIN1 ;No. Print it and done.
HRROI T1,[ASCIZ\<RET>\] ;Yes. Print this
PSOUT%
RET
;Print character visibly
;CALL PRTIN1 with
; T1/ character
;Uses T1 and T2 only
PRTIN1: CAIL T1," " ;Is it a control character ?
CAIN T1,.CHDEL ;Or DELETE ?
IFNSK.
MOVE T2,T1 ;Yes. Save it.
MOVEI T1,"^" ;Get a hat.
PBOUT% ;Put it out.
MOVE T1,T2 ;Get back the character
XORI T1,100 ;Convert it.
ENDIF.
PBOUT% ;Put it out.
RET
;Print local node name
;CALL PRTNOD with no arguments
;Returns +1 always
;Preserves all ACs
PRTNOD: SAVET
STKVAR <<NAME,2>>
MOVEI T1,.NDGLN ;Function code
MOVEI T2,T3 ;Address of argument block
HRROI T3,NAME ;Byte pointer to node name
NODE%
HRROI T1,NAME ;Point again to node name
PSOUT% ;Print it out.
RET
;Set program name - sets the program name displayed via SYSTAT to the
;nodename of the remote node.
;Returns +1 always.
SETPNM: SETZ T1,
MOVEI T4,6 ;Node name count
MOVE T3,NODPTR ;Get pointer to nodename
MOVE T2,[POINT 6,T1];Point to SIXBIT program name
GTNOD: ILDB CX,T3 ;Get a Byte
JUMPE CX,GTDON ;if null, then done
CAIL CX,140 ;is this a lower case character?
TRZA CX,100 ;yes, make it SIXBIT
SUBI CX,40 ;make it SIXBIT
IDPB CX,T2 ;Save it
SOJG T4,GTNOD ;get all six characters
GTDON: SETNM% ;Set program name to NODENAME
RET
;TRYNRT - Set up correct error msg so that EXEC tries NRT: on return.
;Takes nothing and never returns.
TRYNRT: MOVEI T1,.FHSLF ;Set error for fork so that exec can try NRT.
MOVEI T2,NSPX20 ;This is the error that SET HOST looks for.
SETER% ;Set it
HRROI T1,[ASCIZ\Trying NRT: ]\]
SKIPN QUIET ;Are we printing status msgs?
PSOUT% ;Yes, let them know that we'll try NRT
JRST FATAL ;No, no more to do.
SUBTTL DEBUG PROCESS -- ENTRY
;Entry to debug process
;CALL BUGENT with no arguments
;Returns +1 always
;Preserves all ACs
BUGENT: SAVET ;Save temporary registers
TXO BUGREG,BG.ENA ;Say debugging enabled.
CALL TRMSTP ;Save current terminal state
CALL TRMRST ;Restore original terminal state
CALL BUGCMD ;Go to command parser.
CALL TRMREE ;Restore terminal state
RET ;Done.
;The debug command parser - top level.
;CALL BUGCMD with no arguments
;Returns +1 always (if at all)
BUGCMD: PROMPT (DEBUG>) ;Prompt.
KEYWRD (KEYMAI) ;Main command level dispatch
JRST (T1) ;Do it.
;Here for parse failure - T2 contains error code
;Returns +1 always
BUGBAD: SKIPE T1,BUGJFN ;Extraneous JFN ?
RLJFN% ;Yes. Get rid of it.
MOVEI T1,.PRIOU ;Output designator
HRLI T2,.FHSLF ;Fork handle
SETZ T3,
ERSTR%
TRN
TRN
JRST BUGCMD
;Here for reparse
BUGRPS: SKIPE T1,BUGJFN ;Extraneous JFN ?
RLJFN% ;Yes. Get rid of it.
JRST BUGCMD
;Debug command - continue the program
BUGCON: CALL CFMRTN ;Confirm the command
RET ;Done
;Debug command - go to DDT
BUGDDT: MOVEI T1,.PRIIN ;Save JFN mode word
RFMOD%
MOVEM T2,DDTMOD
CALL CFMRTN
MOVEM P,BUGACS+17 ;Save registers
MOVE P,[0,,BUGACS]
BLT P,BUGACS+16
TMSG <
The registers are in BUGACS.
Type "JRST DDTRET$X" to return.
>
JRST 770000 ;Go to DDT
DDTRET: MOVE P,[BUGACS,,0] ;Restore registers
BLT P,CX
MOVE P,BUGACS+17
MOVEI T1,.PRIIN ;Restore JFN mode word
MOVE T2,DDTMOD
SFMOD%
STPAR%
JRST BUGCMD
;Debug command - exit the program.
BUGEXI: CALL CFMRTN ;Confirm the command
HALTF% ;Stop
CALL TRMSAV ;() Restart - save current terminal state
JRST BUGCMD ;Continue
;Debug command - set trace flag(s)
BUGTRC: KEYWRD (KEYTRC,BUGBAD) ;Get the trace flag id.
MOVE T4,T1 ;Save it
CALL CFMRTN ;Confirm the command
IORM T4,BUGREG ;Set the flags
JRST BUGCMD ;Continue
;Debug command - clear trace flag(s)
BUGUNT: KEYWRD (KEYTRC,BUGBAD) ;Get the trace flag id.
MOVE T4,T1 ;Save it
CALL CFMRTN ;Confirm the command
ANDCAM T4,BUGREG ;Clear the flags
JRST BUGCMD ;Continue
SUBTTL DEBUG PROCESS -- SET LOGGING FILE
;Debug command - Log trace output to file
BUGLOG: SKIPE T1,BUGJFN ;Have a temporary JFN ?
RLJFN% ;Yes. Get rid of it.
MOVEI T1,[FLDDB.(.CMOFI)] ;Function descriptor block
CALL RFIELD ;Parse
MOVEM T2,BUGJFN ;Save JFN.
CALL CFMRTN ;Confirm the command.
SKIPN T1,BUGFIL ;Have a JFN already ?
IFSKP.
CAME T1,BUGJFN ;Yes. Same as new one ?
RLJFN% ;No. Get rid of it.
NOP
ENDIF.
MOVE T1,BUGJFN ;Make
MOVEM T1,BUGFIL ; this the trace file
SETZM BUGJFN ;No longer temporary
MOVX T2,<FLD(7,OF%BSZ)+OF%APP> ;Make the file exist
OPENF%
NOP
TXO T1,<CO%NRJ> ;Keep JFN around
CLOSF%
NOP
JRST BUGCMD ;Continue
SUBTTL DEBUG PROCESS -- HELP COMMAND
;Debug command - help
BUGHLP: CALL CFMRTN ;Confirm the command
TMSG <
The debugger commands are:
CONTINUE - resume the program.
DDT - go into DDT. Type JRST DDTRET$X to return.
EXIT - exit the program. It is continuable.>
TMSG <
HELP - print this text.
LOG {file-spec} - send all tracing to this file.
TRACE {identifier} - trace a collection of events:
ALL, RECEIVED-DECNET-MESSAGES, SENT-DECNET-MESSAGES, CTERM-READ,
CTERM-WRITE, OUT-OF-BANDS, TIMER>
TMSG <
UNTRACE {identifier} - turn off the tracing of a collection of events
The debugger is enabled by depositing a 1 in location "DEBUG", before starting
or continuing this program.
>
JRST BUGCMD ;Continue
SUBTTL DEBUG PROCESS -- SHOW COMMAND
;Debug command - show
BUGSHO: CALL CFMRTN ;Confirm the command
SKIPE BUGFIL
IFSKP.
TMSG <
No logging file set up.>
ELSE.
TMSG <
Logging file is >
MOVEI T1,.PRIOU
MOVE T2,BUGFIL
SETZ T3,
JFNS%
ENDIF.
TMSG <
Flags that are on
-----------------
>
TXNN BUGREG,BG.CTR
IFSKP.
TMSG <RECEIVED-CTERM-MESSAGES
>
ENDIF.
TXNN BUGREG,BG.OOB
IFSKP.
TMSG <OUT-OF-BAND
>
ENDIF.
TXNN BUGREG,BG.MSI
IFSKP.
TMSG <RECEIVED-DECNET-MESSAGES
>
ENDIF.
TXNN BUGREG,BG.MSO
IFSKP.
TMSG <SENT-DECNET-MESSAGES
>
ENDIF.
JRST BUGCMD ;Continue
SUBTTL DEBUG PROCESS -- DISPLAY BUG
;Put message in debug file
;CALL BUGDSP with
;BUGMPT, BUGDPT, BUGCNT set up.
;Returns +1 always
;Uses no ACs
BUGDSP: SAVEAC <T1,T2,T3,T4,Q1,Q2,Q3>
SKIPN T1,BUGFIL ;Is there a debug file ?
RET ;No. Done.
MOVX T2,<OF%APP+FLD(7,OF%BSZ)>
OPENF%
JRST ERR
CALL BUGDS0 ;Display the data
MOVE T1,BUGFIL ;Close the file.
TXO T1,CO%NRJ
CLOSF%
JRST ERR
RET
BUGDS0: HRROI T2,[ASCIZ\
*****************
\]
SETZ T3,
SOUT% ;Put out delimiter.
MOVE T2,BUGMPT
SETZ T3,
SOUT% ;Put out message
HRROI T2,[ASCIZ\ at \]
SOUT%
HRROI 2,-1 ;Output time
SETZ T3,
ODTIM%
HRROI T2,[ASCIZ\
\]
SOUT%
SKIPN BUGCNT ;If no additional data, done.
RET
MOVE Q1,BUGCNT ;Get count
MOVE Q2,BUGDPT ;Get pointer to data
DO.
MOVE T3,[NO%LFL+FLD(4,NO%COL)+10] ;Octal format numbers
MOVEI Q3,^D18 ;per line count
DO. ;Output string as numbers.
SOJL Q1,BUGDS1
ILDB T2,Q2 ;Get byte
NOUT%
TRN
SOJG Q3,TOP.
ENDDO.
HRROI T2,[ASCIZ\
\]
SETZ T3,
SOUT%
LOOP.
ENDDO.
BUGDS1: HRROI T2,[ASCIZ\
\]
SETZ T3,
SOUT%
MOVE Q1,BUGCNT ;Get count
MOVE Q2,BUGDPT ;Get pointer to data
DO.
MOVEI Q3,^D18 ;Line length
DO. ;Output string as characters.
SOJL Q1,BUGDS2
ILDB T2,Q2 ;Get byte
ANDI T2,177 ;Make it 7 bits
CAIL T2,^D32 ;Is it a control character ?
CAIN T2,.CHDEL ;No. Is it DELETE ?
IFNSK.
PUSH P,T2 ;Yes to either. Save character
MOVEI T2,"^" ;Get hat.
BOUT% ;Put it out.
POP P,T2 ;Get character back.
XORI T2,100 ;Make it visible.
ENDIF.
BOUT%
MOVEI T2," " ;Get a space
BOUT% ;Put it out
SOJG Q3,TOP.
ENDDO.
HRROI T2,[ASCIZ\
\]
SETZ T3,
SOUT%
LOOP.
ENDDO.
BUGDS2: HRROI T2,[ASCIZ\
\]
SETZ T3,
SOUT%
RET
END <4,,ENTVEC>