github.com/PDP-10.stacken
1
0
Fork 0
mirror of https://github.com/PDP-10/stacken.git synced 2026-03-01 09:21:15 +00:00
Code Issues Projects Releases Wiki Activity
Files
master
PDP-10.stacken/files/stacken-tape-backup/dskb:10_7/decnet/dts/dts.mac
Lars Brinkhoff 6e18f5ebef Extract files from tape images. 
Some tapes could not be extracted.
2021-01-29 10:47:33 +01:00

2536 lines
70 KiB
Plaintext
Raw Permalink Blame History

This file contains invisible Unicode characters
This file contains invisible Unicode characters that are indistinguishable to humans but may be processed differently by a computer. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.
TITLE DTS - DECnet Test Sender
SUBTTL W. Nichols May, 1981
SEARCH JOBDAT,MACSYM,UUOSYM,DTSPRM,SWIL,MACTEN
$RELOC
SALL ;PRETTIER LISTING
.DIRECTIVE FLBLST ;DON'T GIVE ME CODE FOR ASCIZ
COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1984,1986. ALL RIGHTS RESERVED.\
; This program conforms to the DTS specification version 1.1
; published on 22 April 1981.
; This program does not conform to the DTS specification any more,
; it conforms to reality. Places marked with a [3] indicate where
; reality does not match architecture. This was done since noone else
; implements field 3 in the interrupt test connect.
PRGID=:'DTS ' ;NAME OF THIS PROGRAM
PRGABR=:'DTS' ;3 CHR ABBREVIATION USED FOR PROG.
DTSWHO==0
DTSVER==1 ;MAJOR VERSION
DTSMIN==0 ;MINOR VERSION
DTSEDT==4 ;EDIT NUMBER
DEFINE VRSN. (PROG),<
BYTE (3) PROG'WHO (9) PROG'VER (6) PROG'MIN (18) PROG'EDT
>
LOC .JBVER
VRSN. DTS
RELOC
LOC .JBREN
EXP REENTER
RELOC
;Expand the INTERNAL/EXTERNAL macro from DTSPRM
GLOBAL EXTERNAL,INTERNAL
SUBTTL Revision History
COMMENT &
Edit Description
4 17-Jan-84 by Bill Davenport
Fixed the ENTACT (enter active) routine to accept NSP.
error code NSABO% (abort by object) which can occur on
the disconnect test. Also fix typo in the routine to
process the disconnect response.
&; End Revision History
SUBTTL Command Table
;This implementation of DTS has three parsing levels:
; 1) Commands
; 2) Options
; 3) Switch Lists
;
;A set of tables arranged in a tree hold the parsing directions for each of
;the levels. The root of the tree is in the COMMAND table which is made up
;of CMDENTs (command entries).
DEFINE CMDMAC,<
$XLIST
CMDENT EXIT, .EXIT, .HEXIT
CMDENT TAKE, .TAKE, .HTAKE
CMDENT HELP, .HELP, .HHELP
CMDENT NODENA, .NODE, .HNODENA
CMDENT LOGGIN, .LOG, .HLOGGIN
CMDENT NOLOGI, .NOLOG, .HNOLOGI
CMDENT TEST, .TEST, .HTEST
CMDENT *CONNEC,.TCONNEC, .HCONNEC
CMDENT DISCON, .TDISCON, .HDISCON
CMDENT DATA, .TDATA, .HDATA
CMDENT INTERR, .TINTERR, .HINTERR
CMDENT STATUS, .STATUS, .HSTATUS
CMDENT DDT, .DDT, .HDDT
IFN FTEXTRA,<
CMDENT AUDIT, USAUDIT, .HAUDIT
CMDENT CONGEST,USCONGEST, .HCONGEST
CMDENT DELAY, USDELAY, .HDELAY
CMDENT ETRACE, USETRACE, .HETRACE
CMDENT INACTI, USINACT, .HINACTI
CMDENT JIFFY, USJIFFY, .HJIFFY
CMDENT LINK, USLINK, .HLINK
CMDENT LONGINT,USLONGINT, .HLONGINT
CMDENT MTROLL, USMTROLL, .HMTROLL
CMDENT NOCONGEST,USRELIEVED, .HNOCONGEST
CMDENT RELIEVED,USRELIEVED, .HRELIEVED
CMDENT SHORTINT,USSHORTINT, .HSHORTINT
CMDENT THRESH, USTHRESH, .HTHRESH
CMDENT TIMENOW,USTIME, .HTIMENOW
CMDENT TRACE, USTRACE, .HTRACE
CMDENT TROLL, USTROLL, .HTROLL
CMDENT WEIGHT, USWEIGHT, .HWEIGHT
>
IFN FTNCP,<CMDENT NCP, USNCP, .HNCP>
$LIST
>;End of Command Macro Definition
DEFINE TSTMAC,<
$XLIST
TSTENT CONNEC, CNT
TSTENT DATA, DAT
TSTENT DISCON, DSC
TSTENT INTERR, INT
$LIST
>
DEFINE NODMAC,<
;; Name, Argtyp, Value, Loc, Default, LocLength
$XLIST
;;The first four elements have a default value of STRLNW so that
;;we will fill in the length of the string blocks defined for
;;these commands.
OPTENT NAME, VALARG, STRBLD, NODNAM, STRLNW, STRLNW
OPTENT UID, VALARG, STRBLD, UID, STRLNW, STRLNW
OPTENT PASSWO, VALARG, STRBLD, PASSWO, STRLNW, STRLNW
OPTENT ACCOUN, VALARG, STRBLD, ACCOUN, STRLNW, STRLNW
OPTENT PRINT, LISARG, PRIIOW, PRINT, .VLYES, 1
OPTENT NOPRIN, IMMARG, .VLNO, PRINT, .VLYES, 1
OPTENT STATIS, IMMARG, .VLYES, STATIS, .VLYES, 1
OPTENT NOSTAT, IMMARG, .VLNO, STATIS, .VLYES, 1
OPTENT DISPLA, IMMARG, .VLYES, DISPLA, .VLYES, 1
OPTENT NODISP, IMMARG, .VLNO, DISPLA, .VLYES, 1
OPTENT BAUD, VALARG, DECNW, BAUD, 0, 1
OPTENT SPEED, VALARG, DECNW, BAUD, 0, 1
OPTENT LOG, VALARG, STRLOG, LOGFLG, 0, 1
OPTENT NOLOG, VALARG, STPLOG, LOGFLG, 0, 1
OPTENT OLD, IMMARG, 1, OLDFLG, 1, 1
OPTENT NEW, IMMARG, 0, OLDFLG, 1, 1
$LIST
>
DEFINE CNTMAC,<
;; Name, Argtyp, Value, Loc, Default, LocLength
$XLIST
OPTENT RETURN, LISARG, RETIOW, RETTYP, .VLNO, 1
OPTENT NORETU, IMMARG, .VLNO, RETTYP, .VLNO, 1
OPTENT TYPE, LISARG, CTTIOW, CNTTYP, CTT.AC, 1
OPTENT REJECT, IMMARG, CTT.RE, CNTTYP, CTT.AC, 1
OPTENT ACCEPT, IMMARG, CTT.AC, CNTTYP, CTT.AC, 1
$LIST
>
DEFINE DSCMAC,<
;; Name, Argtyp, Value, Loc, Default, LocLength
$XLIST
OPTENT RETURN, LISARG, RETIOW, RETTYP, .VLNO, 1
OPTENT NORETU, IMMARG, .VLNO, RETTYP, .VLNO, 1
OPTENT TYPE, LISARG, DSTIOW, DSCTYP, DST.SY, 1
OPTENT SYNCHR, IMMARG, DST.SY, DSCTYP, DST.SY, 1
OPTENT ABORT, IMMARG, DST.AB, DSCTYP, DST.SY, 1
$LIST
>
DEFINE DATMAC,<
;; Name, Argtyp, Value, Loc, Default, LocLength
$XLIST
OPTENT TIME, VALARG, RDX60W, TIME, ^D60, 1
OPTENT MSGSIZ, VALARG, DECNW, DMSGSIZ,^D128, 1
OPTENT *SGMSIZ,VALARG, DECNW, DSGMSIZ,^D128, 1
OPTENT SGNSIZ, VALARG, DECNW, DSGMSIZ,^D128, 1
OPTENT SEGSIZ, VALARG, DECNW, DSGMSIZ,^D128, 1
OPTENT BAUD, VALARG, DECNW, BAUD, 0, 1
OPTENT SPEED, VALARG, DECNW, BAUD, 0, 1
OPTENT SQUEUE, VALARG, DECNW, SQUEUE, 1, 1
OPTENT RQUEUE, VALARG, DECNW, RQUEUE, 1, 1
OPTENT SFLOW, LISARG, FLOIOW, SFLTYP, FLO.SEG, 1
OPTENT RFLOW, LISARG, FLOIOW, RFLTYP, FLO.SEG, 1
OPTENT TERMIN, LISARG, TERIOW, TERMIN, TER.SYN, 1
OPTENT TYPE, LISARG, DTTIOW, DATTYP, DTT.SINK, 1
OPTENT SINK, IMMARG, DTT.SI, DATTYP, DTT.SI, 1
OPTENT SEQUEN, IMMARG, DTT.SE, DATTYP, DTT.SI, 1
OPTENT PATTER, IMMARG, DTT.PA, DATTYP, DTT.SI, 1
OPTENT ECHO, IMMARG, DTT.EC, DATTYP, DTT.SI, 1
$LIST
>
DEFINE INTMAC,<
;; Name, Argtyp, Value, Loc, Default, LocLength
$XLIST
OPTENT TIME, VALARG, RDX60W, TIME, ^D60, 1
OPTENT MSGSIZ, VALARG, DECNW, IMSGSIZ,^D16, 1
OPTENT BAUD, VALARG, DECNW, BAUD, 0, 1
OPTENT SPEED, VALARG, DECNW, BAUD, 0, 1
OPTENT SQUEUE, VALARG, DECNW, SQUEUE, 1, 1
OPTENT RQUEUE, VALARG, DECNW, RQUEUE, 1, 1
OPTENT TERMIN, LISARG, TERIOW, TERMIN, TER.SYN, 1
OPTENT TYPE, LISARG, DTTIOW, INTTYP, DTT.SINK, 1
OPTENT SINK, IMMARG, DTT.SI, INTTYP, DTT.SI, 1
OPTENT SEQUEN, IMMARG, DTT.SE, INTTYP, DTT.SI, 1
OPTENT PATTER, IMMARG, DTT.PA, INTTYP, DTT.SI, 1
OPTENT ECHO, IMMARG, DTT.EC, INTTYP, DTT.SI, 1
$LIST
>
;The third parser level: key values used by options.
DEFINE KEYLIS(abbr,keys),<
..NUM==0
IRP keys,<..NUM==..NUM+1>
abbr'.MX==..NUM ;;ESTABLISH MAX OFFSET ALLOWED
abbr'IOW:IOWD ..NUM,.+1
..NUM==0
IRP keys,<
EXP SIXBIT "keys"
..NUM==..NUM+1
IFDEF abbr'.'keys,<IFN abbr'.'keys-..NUM,<
PRINTX ?MISMATCH WITH UNIVERSAL FOR abbr'.'keys>>
abbr'.'keys==..NUM
>
>
;The first key in the list is always the "present default".
KEYLIS PRI, <ALL,NONE,ERROR>
KEYLIS CTT, <ACCEPT,REJECT>
KEYLIS RET, <NONE,STANDARD,RECEIVED> ;SEE ROUTINE DO.CONNECT
KEYLIS DST, <SYNCHR,ABORT>
KEYLIS DTT, <SINK,SEQUENCE,PATTERN,ECHO> ;SEE DO.DATA
KEYLIS FLO, <SEGMENT,NONE,MESSAGE>
KEYLIS TER, <SYNCHR,ABORT>
FCMTRN: .NSFCS ;(DEFAULT TO SEGMENT FLOW CONTROL)
.NSFCS ;TABLE TO TRANSLATE OUR
.NSFC0 ; FLOW CONTROL VALUES TO THOSE
.NSFCM ; OF THE NETWORK
;THESE ARE OUT OF ORDER SO THAT
; SEGMENT FLOW CONTROL WILL BE DEFAULT
.VLNO==0 ;THE "NO" VALUE FOR YES/NO SWITCHES
.VLYES==1 ;THE "YES" VALUE FOR YES/NO SWITCHES
SUBTTL Expand the Command Macros
DEFINE CMDENT(name,proc,hproc),<EXP SIXBIT /name/>
CMDNMT: CMDMAC ;NAMES OF THE MAJOR COMMANDS
CMDLEN==.-CMDNMT
DEFINE CMDENT(name,proc,hproc),<EXP proc>
CMDPRC: CMDMAC ;PROCEDURES FOR THE MAJOR COMMANDS
DEFINE CMDENT(name,proc,hproc),<EXP hproc>
CMDHPR: CMDMAC ;HELP PROCEDURES
DEFINE TSTENT(name,abbr),<EXP SIXBIT /name/>
TSTNMT: TSTMAC ;NAMES OF THE [TEST:] COMMANDS
TSTLEN==.-TSTNMT
BEGSTR TE
WORD NMT
WORD TAB
ENDSTR
DEFINE TSTENT(name,abbr),<
[IOWD abbr'LEN,abbr'NMT ;;POINTER TO OPTION NAME TABLE
EXP abbr'TAB] ;;POINTER TO OPTION PARSE TABLE
>
TSTPRC: TSTMAC ;PROCEDURES FOR THE [TEST:] CMDS
SUBTTL Expand the Option Macros
;Expand the Option Macros
DEFINE TABLST,<
MAKTAB CNT ;;CONNECT
MAKTAB DSC ;;DISCONNECT
MAKTAB DAT ;;DATA
MAKTAB INT ;;INTERRUPT
MAKTAB NOD ;;NODE
>
DEFINE OPTENT(name,argtyp,value,loc,defalt<0>,loclen<1>),<
EXP SIXBIT /name/
..NUM==..NUM+1
>
DEFINE MAKTAB(abbr),<..NUM==0
abbr'NMT: abbr'MAC
abbr'LEN==..NUM
>
TABLST ;MAKE NAMES FOR ALL IN THE TABLE LIST
BEGSTR OE
WORD VAL ;VALUE TO BE STORED
WORD TYP ;THE ARGUMENT TYPE
WORD LOC ;POINTER TO LOCATION
ENDSTR
;OPPLIS depends on the following ordering
IMMARG==0 ;IMMEDIATE ARGUMENT TYPE
VALARG==1 ;GET-A-VALUE ARGUMENT TYPE
LISARG==2 ;OFFSET INTO LIST ARGUMENT TYPE
DEFINE OPTENT(name,argtyp,value,loc,defalt<0>,loclen<1>),<
Z [Z value
Z argtyp
Z loc]
>
DEFINE MAKTAB(abbr),<abbr'TAB: abbr'MAC>
TABLST ;MAKE TABLES FOR ALL IN THE TABLE LIST
$LOW
DEFINE OPTENT(name,argtyp,value,loc,defalt<0>,loclen<1>),<
EXP defalt
IFNDEF loc,<loc=.-1>
IFG loclen-1,BLOCK loclen-1
>
DEFINE MAKTAB(abbr),<abbr'LOC: abbr'MAC>
TABLST ;MAKE LOCS FOR ALL IN THE TABLE LIST
$HIGH
;The Enter Active Connect Block
EACONB: EXP EACONL ;LENGTH OF BLK IN WORDS
EXP NODNAM ;STRING PTR TO NODE NAME (.NSCND)
EXP EASPRC ;PTR TO SOURCE PRC BLK (.NSCSD)
EXP EADPRC ;PTR TO DEST PRC BLK (.NSCDD)
EXP UID ;PTR TO UID STRING BLK (.NSCUS)
EXP PASSWORD ;PTR TO PASSWORD STR BLK (.NSCPW)
EXP ACCOUNT ;PTR TO ACCOUNT STR BLK (.NSCAC)
EXP USERDATA ;PTR TO USER DATA STR BLK (.NSCUD)
EACONL==.-EACONB
;The Source Process Descriptor
EASPRC: EXP 5 ;LENGTH OF BLK IN WORDS
EXP 0 ;FORMAT ZERO
EXP OBJDTR ;THE OBJECT TYPE OF A DTR
EXP 0 ;PPN MUST BE ZERO FOR FORMAT ZERO
EXP 0 ;DITTO PROCESS NAME STRING PTR
;The Destination Process Descriptor
EADPRC: EXP 5 ;LENGTH OF BLK IN WORDS
EXP 0 ;FORMAT ZERO
EXP OBJDTR ;THE OBJECT TYPE OF A DTR
EXP 0 ;PPN MUST BE ZERO FOR FORMAT ZERO
EXP 0 ;DITTO PROCESS NAME STRING PTR
SUBTTL General Impure Storage
$LOW
TSTTYP: BLOCK 1 ;THE TEST TYPE REQUESTED (TEST:xxx)
SNDCNT: BLOCK 1 ;NUMBER OF DATA/INT MSGS SENT
RCVCNT: BLOCK 1 ;NUMBER OF DATA/INT MSGS RECEIVED
SERRCNT: BLOCK 1 ;NUMBER OF NETWORK SEND ERRORS
RERRCNT: BLOCK 1 ;NUMBER OF NETWORK RECEIVE ERRORS
STRTIM: BLOCK 1 ;TEST START TIME
FINTIM: BLOCK 1 ;PREDICTED FINISH TIME
ELPTIM: BLOCK 1 ;ELAPSED TIME OF LAST TEST
ISGMSIZ: DEC 16 ;INTERRUPT SEGMENT SIZE FOR STATS
SGMSIZ: BLOCK 1 ;SEGMENT SIZE FOR STATS
MSGSIZ: BLOCK 1 ;PUT MSG SIZE HERE FOR PSTATS
IDLFLG: BLOCK 1 ;NON-ZERO TO TRACE IDLE TIME IN DTS
SNDMSG: STRBLK MAXMGW ;THE DATA TEST'S OUTGOING MESSAGE
PSNDMSG:POINT 8,SNDMSG+1 ;BYTE POINTER TO DATA TEST'S MESSAGE
$HIGH
SUBTTL Start the Program Here
REENTER:EXIT ;WAIT FOR RESET TO WORK PROPERLY
DTS:: TDZA T1,T1 ;NON-CCL ENTRY
MOVEI T1,1 ;CCL ENTRY
MOVEM T1,CCLF1 ;STORE FOR LATER
OUTSTR [ASCIZ "Type HELP for help
"]
MOVE P,PDLIOW ;SET UP STACK
DTSRES::RESET ;LABEL IS FOR DDT PATCHING
HRRZ T1,.JBREL ;GET FIRST-TIME CORE SIZE
MOVEM T1,INICOR
HRRZ T1,.JBFF ;GET INITIAL .JBFF
MOVEM T1,INIFF ;SAVE FOR LATER
;Some initialization that could be done at compile time, but
;is easier at run time:
MOVEI T1,SEQLEN ;LEAVE SEQLEN BYTES FOR MESSAGE NUMBER
HRLM T1,SNDMSG ;STORE AS CURRENT MESSAGE LENGTH
MOVEI T1,SNDMSG ;POINTER TO STRING BLOCK
MOVEI T2,MAXMSG-SEQLEN;LENGTH OF THE DATA MESSAGE
CALL FILSTD ;FILL THE WHOLE MESSAGE WITH STD DATA
;Fall through to next page
SUBTTL Call .ISCAN
;From previous page
;.ISCAN--SUBROUTINE TO INITIALIZE COMMAND SCANNER
;CALL AC1=XWD LENGTH,BLOCK
;
; BLOCK+0=PROTOCOL VERSION WORD: <MAJOR>,,<MINOR>
; BLOCK+1=0 OR IOWD PTR TO A LIST OF LEGAL MONITOR COMMANDS
; IF 0, NO RESCAN IS DONE
; BLOCK+2=RH 0 OR SIXBIT CCL NAME
; IF 0, NO CCL MODE
; LH 0 OR ADDRESS OF STARTING OFFSET
; BLOCK+3=RH 0 OR ADDRESS OF CHARACTER TYPEOUT ROUTINE
; IF 0, OUTCHR WILL BE DONE FROM T1
; LH 0 OR ADDRESS OF CHARACTER INPUT ROUTINE
; MUST SAVE ALL ACS, CHAR IN P4
; BLOCK+4=0 OR POINTER (XWD LEN,BLOCK) TO INDIRECT FILE BLOCK
; .FXDEV NE 0 TO USE BLOCK
; BLOCK+5=RH 0 OR ADDRESS OF MONRET ROUTINE
; LH 0 OR ADDRESS OF PROMPT ROUTINE
; CALLED WITH CHAR IN RH(T1), LH(T1) HAS
; 0 FOR FIRST LINE, -1 FOR CONTINUATION LINES
; BLOCK+6=LH FLAGS
; RH (FUTURE)
;VALUE AC1=INDEX IN TABLE OF COMMANDS IF FOUND(0,1,...), ELSE -1
MOVE T1,[6,,[12,,%%FXVE ;MAJOR,,MINOR SCAN VERSION
IOWD 1,[PRGID] ;CCL ENTRY NAME
CCLF1,,PRGABR ;CCL FLAG,,PROGRAM NAME ABBREVIATION
STYPIN,,STYPOU ;SPECIAL TYPEIN,,TYPEOUT ROUTINE
0,,0 ;NO USER INDIRECT
0,,.EXIT]] ;MONRET ROUTINE
CALLSCAN .ISCAN## ;INITIALIZE SCAN
;Fall through to next page
SUBTTL Main Loop
;Fall through from previous page
REPARSE:
CALL PARSE ;GET ALL REQUESTS FROM THE USER
JRST REPARSE ;ERROR MESSAGE ALREADY GIVEN
CALL DO.DTS ;NO MORE ERRORS FROM USER, GO DO IT
JRST REPARSE ;ERROR MESSAGE ALREADY GIVEN
JRST REPARSE ;GO DO IT AGAIN
SUBTTL The Parser
;PARSE - Parse the User's commands into global variables
;
;Call: CALL PARSE
; Error Return, message already put out
; Normal Return, ready to call DO.DTS
;Changes T1,T2,T3,T4
PARSE: SAVEAC <P1,P2>
PUSHJ P,.CCLRB## ;CLEAR TYPEAHEAD IF WAS AN ERROR
CAXN C,.CHEOF ;IF WE'VE FINISHED SOMETHING
PJRST .ALDON## ; EXIT UNLESS IN INDIRECT FILE
MOVEI T1,0 ;NO SPECIAL SWICHES FOR .FILIN
CALLSCAN .PSCAN## ;INITIALIZE PARTIAL SCANNER
OUTSTR [ASCIZ \DTS> \] ;SKIP RET IF NO PROMPT NEEDED
;Here we wait, outside the call to SCAN and its PSIOFF for the
;user to type something. This gives PSISER a chance to interrupt
;a waiting DTS.
PARS.1:
REPEAT 0,<
SKPINC ;SEE IF WE'VE GOT A CHARACTER
TRNA ;NO INPUT YET
JRST PARS.2 ;GOT SOME
MOVE T1,[EXP HB.RTL ! HIBTIM] ;WAKE ON CHARACTER INPUT
HIBER T1, ;GIVE PSI A CHANCE TO INTERRUPT
JFCL ; THE INCHRW
JRST PARS.1 ;CHECK FOR FALSEHOOD AND LIES FROM PSISER
> ;END REPEAT 0
PARS.2: CALLSCAN .SIXSW## ;GET A SIXBIT VALUE INTO N
JUMPE N,[CAIN C,"@" ;ASKING FOR INDIRECT FILE?
MOVE N,['TAKE '] ;YES, MAKE A TAKE COMMAND
CAIE C,"?" ;ASKING FOR HELP?
CAIN C,"/" ; (PERHAPS TRYING /HELP)?
MOVE N,['HELP '] ;YES, MAKE A HELP COMMAND
JUMPE N,.POPJ ;NO, NULL COMMAND
JRST .+1 ] ;GO DEAL WITH THIS COMMAND
MOVE T1,[IOWD CMDLEN,CMDNMT] ;LIST OF COMMAND NAMES
MOVE T2,N ;THIS COMMAND NAME IN SIXBIT
CALL LOOKNM ;GET INDEX INTO COMMAND TABLE
JRST UNKCMD ;NOT FOUND OR AMBIGUOUS
HRRZS T1 ;DON'T CARE IF EXACT MATCH OR NOT
SUBI T1,CMDNMT ;MAKE IT AN OFFSET INTO CMD TABLES
;Now T1 holds offset into CMDxxx tables
CALL @CMDPRC(T1) ;CALL APPROPRIATE PROCESSOR
RET ;ERROR RETURN, MESSAGE ALREADY PUT OUT
RETSKP ;SUCCESS RETURN, GO DO DO.DTS
SUBTTL EXIT Command
;Called by the EXIT command and by SCAN's monret routine
.EXIT: CALL CLSLOG ;IN CASE IT WAS OPEN
PJRST .MNRET## ;SCAN'S MONRET HANDLER
SUBTTL TAKE Command
;.TAKE - Read an indirect file
;
;Call: CALL .TAKE
; Error Return, always to cause a REPARSE, now from indirect file
; Normal Return, never.
;Changes T1,T2,T3,T4
.TAKE: JUMPL C,MISARG ;JUMP IF NO COMMAND FILE
PJRST .GTIND## ;READ IN FILE NAME, MAKE IT
; THE INDIRECT FILE
;ERROR RETURN TO CAUSE REPARSE
SUBTTL HELP Command
.HELP: SETOM .FLCBF## ;CLEAR REST OF LINE WHEN NEXT AT TOP LEVEL
JUMPL C,HLPALL ;IF EOL, GIVE TOP LEVEL HELP
caie c,"?" ;DID WE GET HERE AS A RESULT OF
CAIN C,"/" ; THE PSEUDO-HELP COMMANDS?
JRST HLPALL ;YES, GIVE AN OVERVIEW OF HELP
CALLSCAN .SIXSW## ;GET A COMMAND TO GIVE HELP ON
JUMPE N,HLPALL
MOVE T1,[IOWD CMDLEN,CMDNMT];TABLE OF COMMAND NAMES
MOVE T2,N ;THIS COMMAND NAME IN SIXBIT
CALL LOOKNM ;GET INDEX INTO COMMAND TABLE
JRST UNKCMD ;NOT FOUND OR AMBIGUOUS
HRRZS T1 ;DON'T CARE IF EXACT MATCH OR NOT
SUBI T1,CMDNMT ;MAKE IT AN OFFSET INTO HLP TABLES
PJRST @CMDHPR(T1) ;CALL APPROPRIATE HELP PROC
;ERROR RETURN CAUSES REPARSE
HLPALL: OUTSTR HLPTXT
IFN FTEXTRA,OUTSTR HLPTXE ;OUTPUT EXTRA COMMAND'S HELP TOO
IFN FTNCP,OUTSTR HLPTXN ;OUTPUT NCP COMMAND IF ITS COMPILED
RET ;ERROR RETURN CAUSES REPARSE
HLPTXT: ASCIZ \
The commands to DTS are:
HELP
TAKE command-file-name
LOG log-file-name (default is DTS.LOG)
NODENAME nodename options
CONNECT options
DISCONNECT options
DATA options
INTERRUPT options
DDT
STATUS
EXIT (also closes log file)
Type "HELP commandname" for further help with a command's options.
For example,
HELP DATA
will describe the options to the DATA test.
A typical command might be: TEST:CONNECT TYPE:REJECT RETURN:NONE
An equal sign (=) may be used instead of any colon in a command.
\;end of ASCIZ
IFN FTEXTRA,<
HLPTXE: ASCIZ \
Additional commands for developers are:
AUDIT, CONGEST, DELAY, ETRACE, INACTIVITYTIMER, JIFFY, LONGINTERVAL
CONGEST, MTROLL, RELIEVED, SHORTINTERVAL, THRESHOLD, TIMENOW
TRACE, TROLL, WEIGHT, LINK
\>;END OF IFN FTEXTRA
IFN FTNCP,<
HLPTXN: ASCIZ \
The NCP command calls the NTMAN. exercizer.
\
>
.HEXIT: OUTSTR HLTEXIT
RET ;ERROR RETURN CAUSES REPARSE
HLTEXIT: ASCIZ \
The EXIT command takes no arguments. If a log file is open, this
command closes it. It then exits to the monitor. The monitor
CONTINUE command will cause DTS to continue.
\
.HTAKE: OUTSTR HLTTAKE
RET ;ERROR RETURN CAUSES REPARSE
HLTTAKE: ASCIZ \
The TAKE command causes DTS to read commands from a command file.
The format of the command file is exactly as if the user had typed
the commands on a terminal. The default extension for the command
file is .CCL.
\
.HHELP: OUTSTR HLTHELP
RET ;ERROR RETURN CAUSES REPARSE
HLTHELP: ASCIZ \
The HELP command by itself gives an overview of the commands
to DTS. For help with a specific command, type HELP and then the
command name. For example,
HELP
HELP DATA
\
.HLOGG:
.HNOLO: OUTSTR HLTLOG
RET ;ERROR RETURN CAUSES REPARSE
HLTLOG: ASCIZ \
The LOG command causes DTS to start logging to the specified log
file. The default log file name is DTS.LOG. If DTS was already
logging, the old log file is closed and the log file specified is
started.
If a log file by the specified (or defaulted) name already exists,
DTS will append to it, preceeding the new text with a form feed.
The NOLOG command closes any open log file and causes DTS to stop
logging.
\
.HSTAT: OUTSTR HLTSTA
RET ;ERROR RETURN CAUSES REPARSE
HLTsta: ASCIZ \
The STATUS command causes DTS to report the DECnet status variable
for its link.
\
.HTEST: OUTSTR HLTTEST
RET ;ERROR RETURN CAUSES REPARSE
HLTTEST: ASCIZ \
The TEST command takes as argument one of the four DTS tests:
CONNECT
DISCONNECT
DATA
INTERRUPT
The TEST command is meaningless, since to give the command
TEST:testtype
is equivalent to giving the command
testtype
by itself. See HELP for the four test command for more help.
\
.HNODE: OUTSTR HLTNOD
RET
HLTNOD: ASCIZ \
The first argument to the node command is the name of the node
at which the DTR is running. The noise word NAME may preceed the
node name. The options follow the node name.
NODE command options:
UID:user-id
PASSWORD:password
ACCOUNT:account
PRINT:ALL (initial default)
ERROR
NONE
NOPRINT
STATISTICS
NOSTATISTICS
DISPLAY
NODISPLAY
BAUD:baud-rate
SPEED:baud-rate
LOG (default log file name DTS.LOG)
NOLOG
LOG:log-file-name
OLD Use old DTS/DTR protocol
NEW (Default for each new NODE command) Use new protocol
If a filename is given to the LOG option, then the filename must be
the last text on this command line.
\;END OF ASCIZ
.HCONN: OUTSTR HLTCON
RET
HLTCON: ASCIZ \
CONNECT command options:
TYPE:ACCEPT (initial default)
REJECT
RETURN:STANDARD (initial default)
RECEIVED
NONE
NORETURN
\;end of ASCIZ
.HDISC: OUTSTR HLTDIS
RET
HLTDIS: ASCIZ \
DISCONNECT command options:
TYPE:SYNCHRONOUS (initial default)
ABORT
RETURN:STANDARD (initial default)
RECEIVED
NONE
NORETURN
\;end of ASCIZ
.HDATA: OUTSTR HLTDAT
RET
HLTDAT: ASCIZ \
DATA command options:
TYPE:SINK (initial default)
SEQUENCE
PATTERN
ECHO
SFLOW:SEGMENT (initial default)
MESSAGE
NONE
RFLOW:SEGMENT (initial default)
MESSAGE
NONE
MSGSIZE:bytes (initial default 128)
SGMSIZE:bytes (initial default 128)
BAUD:number
SPEED:same as baud
SQUEUE:send queue (initial default 1)
RQUEUE:receive queue (initial default 1)
TERMINATION:SYCNHRONOUS (initial default)
ABORT
TIME:hh:mm:ss (initial default 60 seconds)
or TIME:mm:ss (minutes:seconds)
or TIME:xx HOURS
or TIME:xx MINUTES
or TIME:xx SECONDS
\;end of ASCIZ
.HINTE: OUTSTR HLTINT
RET
HLTINT: ASCIZ \
INTERRUPT command options:
TYPE:SINK (initial default)
SEQUENCE
PATTERN
ECHO
MSGSIZE:bytes (initial default 16)
BAUD:number
SPEED:same as baud
SQUEUE:send queue (initial default 1)
RQUEUE:receive queue (initial default 1)
TERMINATION:SYCNHRONOUS (initial default)
ABORT
TIME:hh:mm:ss (initial default 60 seconds)
or TIME:mm:ss (minutes:seconds)
or TIME:xx HOURS
or TIME:xx MINUTES
or TIME:xx SECONDS
\;end of ASCIZ
IFN FTEXTRA,<
.HAUDIT:
.HCONGEST:
.HDELAY:
.HETRACE:
.HINACTI:
.HJIFFY:
.HLONGINT:
.HNOCONGEST:
.HMTROLL:
.HRELIEVED:
.HSHORTINT:
.HTHRESH:
.HTIME:
.HTRACE:
.HTROLL:
.HWEIGHT:
OUTSTR HLTEXTRA
RET ;ERROR RETURN CAUSES REPARSE
HLTEXTRA: ASCIZ \
This command is a special debugging or fault-insertion command
which is not expected to be used by people other than the
developers.
\
.HLINK: OUTSTR HLTLINK
RET ;ERROR RETURN CAUSES REPARSE
HLTLINK: ASCIZ \
Type out the contents of NSP's port block for the specified link.
Link number is requested in decimal to correspond with the trace.
\
>;END OF IFN FTEXTRA
IFN FTNCP,<
.HNCP: OUTSTR HLTNCP
RET
HLTNCP: ASCIZ \
The NCP command invokes the interim NCP command processor which
exercizes the network management (NTMAN.) UUO.
\>;END OF IFN FTNCP
.HDDT: OUTSTR HLTDDT
RET ;ERROR RETURN CAUSES REPARSE
HLTDDT: ASCIZ \
Go to DDT if it is loaded, else does nothing.
This command fills in .JBOPC, so to return from DDT, type G$G
which does a JRST @.JBOPC
\
SUBTTL Logging and No Logging Commands
.LOG: CALL STRLOG ;START LOGGING
MOVEM N,LOGFLG ;STORE -1 IF SUCCESSFUL, ELSE ZERO
RET ;ERROR RETURN CAUSES REPARSE
.NOLOG: CALL STPLOG ;STOP LOGGING
RET
SUBTTL NODE Command
;.NODE - Get node specification for future action command
;
;Call: CALL .NODE
; Error Return, always, to cause reparse
; Normal Return, never, this is not an action command
;Changes T1,T2,T3,T4
.NODE:
NODE.0: JUMPL C,MISARG ;COMPLAIN IF EOL ALREADY
CALLSCAN .SIXSW## ;THIS SHOULD BE THE NODE NAME
JUMPE C,MISARG ;COMPLAIN IF NO NAME
MOVE T1,[IOWD 1,[SIXBIT /NAME/]]
MOVE T2,N
CALL LOOKNM ;IS IT THE NOISE WORD 'NAME'?
CAIA ;NO, ITS A VALID NODE NAME
JRST NODE.0 ;YES, IGNORE IT AND TRY AGAIN
MOVEI T1,NODNAM ;POINTER TO TARGET STRING BLOCK
MOVE T2,N ;THE SIXBIT SOURCE WORD
CALL SIX2ST ;COPY AND CONVERT TO STRING BLOCK
;Turn off the OLD (old DTR protocol) flag so it does not default
;to being on once turned on for one node. This means user must
;specify OLD anew on each appropriate NODENAME command.
SETOM OLDFLG ;ASSUME THIS IS OLD UNTIL TOLD IT IS NOT
;Now fish for NODE command options
NODE.1: JUMPL C,.POPJ ;LEAVE IF WE HAVE EOL
CALLSCAN .SIXSW## ;GET A SIXBIT LEXEME
JUMPE N,.POPJ ;ERROR RETURN CAUSES REPARSE
MOVE T1,[IOWD NODLEN,NODNMT];LIST OF NODE COMMAND OPTIONS
MOVE T2,N ;GET COMMAND NAME IN SIXBIT
CALL LOOKNM ;LOOK IT UP
PJRST UNKCMD ;NOT FOUND OR AMBIGUOUS
HRRZS T1 ;DON'T CARE IF EXACT MATCH OR NOT
SUBI T1,NODNMT ;MAKE POINTER INTO TABLE OFFSET
MOVE T1,NODTAB(T1) ;GET POINTER TO OPTION TABLE
CALL OPTPRC ;CALL THE OPTION TABLE PROCESSOR
RET ;ERROR RETURN, MESSAGE ALREADY PUT OUT
JRST NODE.1 ;KEEP GOING TO END OF LINE
SUBTTL TEST Command
;.TEST - Get TEST specification
;
;Call: CALL .TEST
; Error Return, message already put out
; Normal Return, main loop will call DO.DTS
;Changes T1,T2,T3,T4
.TEST: JUMPL C,NOTEST ;COMPLAIN IF EOL ALREADY
TEST.0: CALLSCAN .SIXSW## ;THIS SHOULD BE THE TEST NAME
JUMPE C,NOTEST ;COMPLAIN IF NO NAME
MOVE T1,N ;SET UP FOR DFTCMD
PJRST DFTCMD ;NOW WE'RE THE SAME AS THE DEFAULT CMD
;Here when the user has defaulted the TEST:xxx command by
;just giving the name of the test. Pretend the user typed TEST:
;and give the command to the DFTCMD routine.
.TCONNEC:
.TDISCON:
.TDATA:
.TINTERR:
SKIPN T1,CURCMD ;GET CURRENT COMMAND AGAIN
JRST NOTEST ;WEAK INTERNAL TEST
PJRST DFTCMD ;AND PRETEND IT WAS ARG TO TEST:xxx
;Here on error
NOTEST: ERROR No test specified,CRLF
RET
SUBTTL DFTCMD - The Default Command [TEST:]
;DFTCMD - The Default Command [TEST:]
;
;Call: T1/ The SIXBIT test name
; CALL DFTCMD
; Error Return
; Normal Return
;Changes T1,T2,T3,T4
DFTCMD: SAVEAC <P1,P2>
MOVE T2,T1 ;THE SIXBIT COMMAND NAME
MOVE T1,[IOWD TSTLEN,TSTNMT] ;THE TEST NAME TABLE
CALL LOOKNM
PJRST UNKCMD ;ERROR IF NOT FOUND OR AMBIGUOUS
HRRZS T1 ;GOT ONE!
SUBI T1,TSTNMT-1 ;MAKE T1 INTO AN OFFSET
MOVEM T1,TSTTYP ;SAVE AWAY THE TEST TYPE
MOVE P1,TSTPRC-1(T1) ;GET POINTER TO OPTION TABLE INTO P1
;Now fish for TEST command options
TEST.1: JUMPL C,.POPJ1 ;SUCCESS RETURN SAYS DO DO.DTS NOW
CALLSCAN .SIXSW## ;GET A SIXBIT LEXEME
JUMPE N,.POPJ1 ;SUCCESS RETURN SAYS DO DO.DTS NOW
LOAD T1,TENMT,(P1) ;IOWD TO LIST OF TEST COMMAND OPTIONS
HRL P1,T1 ;SAVE BASE OF TABLE FOR OFFSETTING
MOVE T2,N ;GET COMMAND NAME IN SIXBIT
CALL LOOKNM ;LOOK IT UP
PJRST UNKCMD ;NOT FOUND OR AMBIGUOUS
HRRZS T1 ;DON'T CARE IF EXACT MATCH OR NOT
HLRZ T2,P1 ;RECOVER THE TABLE POINTER
SUB T1,T2 ;MAKE POINTER INTO A TABLE OFFSET
LOAD T2,TETAB,(P1) ;GET POINTER TO POINTER TO OPTION BLOCK
ADD T1,T2 ;POINT TO APPROPRIATE OPTION PARSE TBL
MOVE T1,-1(T1) ;GET POINTER TO OPTION BLOCK
CALL OPTPRC ;CALL THE OPTION TABLE PROCESSOR
RET ;ERROR RETURN, MESSAGE ALREADY PUT OUT
JRST TEST.1 ;KEEP GOING TO END OF LINE
SUBTTL OPTPRC - Option Table Processor
;OPTPRC - Process an Option Switch
;
;Call: T1/ Pointer to xxxOPT entry table
; CALL OPTPRC
; Error Return, message already put out
; Normal Return
;Changes T1,T2,T3,T4
OPTPRC: SAVEAC P1
MOVE P1,T1 ;SAVE POINTER TO OPT ENTRY TABLE
LOAD T1,OETYP,(P1) ;GET THE ARGUMENT TYPE
PJRST @[EXP OPPIMM ;IMMEDIATE ARGUMENT TYPE
EXP OPPVAL ;GET-A-VALUE ARGUMENT TYPE
EXP OPPLIS](T1);OFFSET INTO LIST ARGUMENT TYPE
;Here to store an immediate value
OPPIMM: LOAD T1,OEVAL,(P1) ;GET THE IMMEDIATE VALUE TO STORE
LOAD T2,OELOC,(P1) ;GET THE ADDRESS OF LOCATION TO STORE
MOVEM T1,(T2) ; THE IMMEDIATE VALUE IN.
RETSKP
;Here to get a value from the user and store it
OPPVAL: CAIE C,":" ;IS PUNCTUATION A COLON?
CAIN C,"=" ; OR AN EQUAL SIGN?
CAIA ;YES, USER SAYS ARG FOLLOWS
JRST MISARG ;NO, COMPLAIN
LOAD T2,OEVAL,(P1) ;ADDRESS OF ROUTINE TO GET USER'S VALUE
LOAD T1,OELOC,(P1) ;SOME ROUTINES NEED THIS PASSED
CALL (T2) ;ROUTINE LIKE .SWDEC OR .SIXIN
TRNA ;WE NEED TO STORE RESULT
RETSKP ;HE STORED, JUST CLEAN UP
LOAD T1,OELOC,(P1) ;GET THE ADDRESS OF LOCATION TO STORE
MOVEM N,(T1) ;STORE USER'S NOTION
RETSKP
;Here to search a list and store an offset thereinto
;OPPLIS - Search a list for a keyword, store offset found
;
;Call: P1/ Pointer to OPT table
; CALL OPPLIS
; Error Return if keyword not found or no argument offered
; Normal Return
;Changes T1,T2,T3,T4
OPPLIS: SAVEAC <P1,P2>
CAIE C,":" ;IF PUNCTUATION WAS COLON
CAIN C,"=" ; OR EQUAL SIGN,
CAIA ; THEN WE HAVE AN ARGUMENT TO GET
PJRST MISARG ;NO ARGUMENT ERROR
CALLSCAN .SWSIX## ;GET SIXBIT WORD INTO N
LOAD T1,OEVAL,(P1) ;GET PTR TO IOWD TO KEYWORD LIST
MOVE T1,(T1) ;GET THE IOWD
MOVE T2,N
CALL LOOKNM
PJRST UNKCMD ;NOT FOUND OR AMBIGUOUS
HRRZS T1 ;DON'T CARE IF EXACT MATCH OR NOT
LOAD T2,OEVAL,(P1) ;GET POINTER TO BEG OF LIST AGAIN
HRRZS T2
SUBI T1,(T2) ;T2 IS AN IOWD POINTER, SO THIS IS
; A ONE-RELATIVE OFFSET
OPPLST: LOAD T2,OELOC,(P1) ;GET POINTER TO STORAGE LOCATION
MOVEM T1,(T2)
RETSKP
MISARG: MOVEI T1,[ASCIZ /?Missing argument for command /]
PJRST ERRCMD
SUBTTL Make some EXTERNals internal for MACRO's convenience
DEFINE MAKINT(label),<
IRP label,<
label: PJRST .'label##
>
>
MAKINT <DECNW,DATIM,ASCQW,FILIN,SIXSW>
PPNSW: CALLSCAN .ASCQW## ;GET THE STRING IN QUOTED ASCII
RET
SUBTTL .DDT - The DDT command
;.DDT - Call DDT, leaving a trail
;
;Call: CALL .DDT
; Normal Return when user types G$G to DDT
;
;Uses T1
.DDT: HRRZ T1,.JBDDT ;GET DDT'S ADDRESS
JUMPE T1,.POPJ ;LEAVE IF NOT LOADED
POP P,.JBOPC ;ITS THERE, LEAVE RET ADDR FOR G$G
JRST (T1) ;GO TO DDT
SUBTTL DO.DTS - The Executor part of the Program
;DO.DTS - Top level of the executor part (second pass) of DTS
;
;Call: CALL DO.DTS
; Error Return, message already put out
; Normal Return
;Changes T1,T2,T3,T4
DO.DTS: HLRZ T1,NODNAM ;GET LENGTH OF NODE NAME
SKIPN T1 ;IS THE NODE NAME SPEC'D YET?
JRST DODTSN ;NO, ASK FOR IT
SETZM IDLFLG ;DON'T TRACE IDLE TIMES
MOVE T1,TSTTYP ;THE TEST TYPE COLLECTED IN PARSE
PJRST @[Z DO.CONNECT
Z DO.DATA
Z DO.DISCONNECT
Z DO.INTERRUPT]-1(T1) ;THE TEST TYPE STARTS AT 1
DODTSN: ERROR Please specify the NODE NAME first,CRLF
RET
SUBTTL DO.CONNECT - Do the Connect Test
;DO.CONNECT - Do the Connect Test
;
;Call: CALL DO.CONNECT
; Error Return
; Normal Return
;Changes T1,T2,T3,T4
DO.CONNECT:
MOVE T2,CNTTYP ;GET THE CONNECT TYPE CODE
MOVEI T1,[ASCIZ /Connect Accept/]
CAIE T2,CTT.ACC ;WAS IT SUPPOSED TO REJECT?
MOVEI T1,[ASCIZ /Connect Reject/]
CALL STRMSG ;TYPE OUT START MESSAGE
;Build the USERDATA field for the connect message
;Note that USERDATA is expected to hold the user data we sent out.
MOVX T1,.TCCON ;TESTTYPE: CONNECT
MOVEI T2,USERDATA ;STRING BLK TO PUT TESTYPE IN
CALL PUTSTY ;STORE TESTTYPE IN USERDATA
MOVE T1,RETTYP ;GET /RETTYP:xxx VALUE
CAILE T1,RET.MX ;INTERNAL CONSISTENCY CHECK
HALT .+1
MOVE T1,[EXP .CCRJN ;(0)REJECT, NO RETURN
EXP .CCRJN ;(1)REJECT, NO RETURN
EXP .CCRJS ;(2)REJECT, STANDARD RETURN
EXP .CCRJR](T1) ;(3)REJECT, RETURN RECEIVED DATA
MOVE T2,CNTTYP ;GET /TYPE VALUE
CAIE T2,CTT.REJECT ;/TYPE:REJECT?
AOS T1 ;NO, PERMUTE .CCxxx TO ACCEPT
MOVEI T2,USERDATA ;POINTER TO STRING BLOCK
CALL PUT1BY ;STORE CONNECT CODE IN USERDATA
;Fill in next 8 bytes with standard data. We make the total less
;than 16 bytes to test ability to handle partial user data.
MOVEI T1,USERDATA ;POINTER TO STRING BLOCK TO FILL
MOVEI T2,^D8 ;FILL IN 8 BYTES AFTER CURRENT TEXT
CALL FILSTD ;FILL IN WITH STANDARD DATA
;Send off the connect initiate request
SETZB NSAA2,NSAA3 ;NO SEG SIZE YET, AND
; DEFAULT TO SEG FLOW CONTROL
CALL ENTACT ;ENTER ACTIVE
TRNA ;FAILED
CALL CONRSP ;PROCESS THE CONNECT RESPONSE
MOVE T2,CNTTYP ;GET THE CONNECT TYPE CODE
MOVEI T1,[ASCIZ /Connect Accept/]
CAIE T2,CTT.ACC ;WAS IT SUPPOSED TO REJECT?
MOVEI T1,[ASCIZ /Connect Reject/]
CALL STPMSG ;TYPE OUT START MESSAGE
RETSKP
;CONRSP - Process the CONNECT response to the connect initiate
;
;Call: CALL CONRSP
; Normal Return
CONRSP: CAIE T1,.NSSRN ;NOW IN RUN STATE?
JRST CONR.1 ;NO, REJECTED
;Here when the connect succeeded
CALL RDCNDT ;READ CONNECT DATA
RET ;PROPOGATE ERROR RETURN
CALL CHKOPT ;CHECK RETURNED OPTIONAL DATA
PJRST NSPREL ;NO GOOD, RELEASE THE CHANNEL
;OK, the accept is kosher, was it what we wanted?
MOVE T1,CNTTYP ;GET THE CONNECT TYPE CODE
CAIE T1,CTT.ACC ;WAS IT SUPPOSED TO REJECT?
ERROR <Connect accepted>,CRLF
CAIN T1,CTT.ACC ;WAS IT SUPPOSED TO ACCEPT?
INFO <Connect accepted>,CRLF
PJRST CONR.X
;Here when the connect failed
CONR.1: CALL RDDSDT ;READ DISCONNECT DATA
RET ;PROPOGATE ERROR RETURN
CAIE NSAA2,RSNRBO ;REJECTED BY OBJECT?
PJRST REJINC ;NO, GO INTERPRET REJECTION
CALL CHKOPT ;CHECK RETURNED OPTIONAL DATA
PJRST NSPREL ;NO GOOD, RELEASE THE CHANNEL
;OK, the reject is kosher, was it what we wanted?
MOVE T1,CNTTYP ;GET THE CONNECT TYPE CODE
CAIE T1,CTT.REJ ;WAS IT SUPPOSED TO ACCEPT?
PJRST REJINC ;YES, INTERPRET THE ERROR
; AND CLOSE THE CHANNEL
INFO <Connect rejected, reason code: >
MOVE T1,NSAA2 ;GET REASON CODE
CALLSCAN .TDECW## ;PRINT IT IN DECIMAL
CALLSCAN .TRBRK## ;TYPE A RIGHT BRACKET FOR INFO
CALLSCAN .TCRLF##
CONR.X:
IFN FTNSPDCP,<
MOVEI T1,3 ;SECONDS GRACE TO GIVE
SSS: SLEEP T1, ; TO DTR WHILE WE USE DCPNSP
>
PJRST NSPREL
SUBTTL CHKOPT - Check Optional Data
;CHKOPT - Check Optional Data returned in Dis/Connect tests
;
;Call: CNTUSR/ Set up by RDCNDT
; CALL CHKOPT
; Error Return, message already put out
; Normal Return
CHKOPT: MOVE T1,RETTYP ;GET /RETTYP:xxx VALUE
CAILE T1,RET.MX ;INTERNAL CONSISTENCY CHECK
HALT .+1
PJRST @[EXP CHKO.N ;(0)REJECT, NO RETURN
EXP CHKO.N ;(1)REJECT, NO RETURN
EXP CHKO.S ;(2)REJECT, STANDARD RETURN
EXP CHKO.R](T1) ;(3)REJECT, RETURN RECEIVED DATA
;Here if we are expecting NO returned optional data
CHKO.N: HLRZ T1,CNTUSR ;GET THE CURRENT BYTE COUNT FROM BLK
SKIPN T1 ;IS IT ZERO?
RETSKP ;YES, ALL IS WELL
CHKO.1: WARN <Bad returned user data count: >
HLRZ T1,CNTUSR ;GET OFFENDING COUNT AGAIN
CALLSCAN .TDECW## ;PRINT OFFENDING COUNT
CALLSCAN .TCRLF##
RET
;Here if we are expecting STANDARD returned optional data
CHKO.S: HLRZ T1,CNTUSR ;GET BYTE COUNT IN USER DATA STRING BLK
CAIE T1,^D16 ;IS IT MAX OPTIONAL DATA LENGTH?
JRST CHKO.1 ;NO, COMPLAIN
SKIPA T1,.+1 ;ILDB POINTER TO USER DATA
POINT 8,CNTUSR+1 ;MACRO WON'T LET ME PUT THIS IN A LIT
HLRZ T2,CNTUSR ;NUMBER OF BYTES TO COMPARE
CALL CMPSTD ;COMPARE STANDARD DATA
TRNA ;NO-MATCH RETURN
RETSKP ;IT-ALL-MATCHED RETURN
CHKO.2: WARN <Bad user data returned during dis/connect>,CRLF
RET
;Here if we are expecting RECEIVED returned optional data
CHKO.R: HLRZ T1,CNTUSR ;GET RECEIVED BYTE COUNT
HLRZ T2,USERDATA ;GET LENGTH WE SENT OUT
CAME T1,T2 ;COMPARE SENT BYTE COUNT
JRST CHKO.1 ;COMPLAIN IF NO MATCH
MOVEI T1,USERDATA ;STRING BLOCK WITH DATA WE SENT
MOVEI T2,CNTUSR ;STRING BLOCK WITH DATA WE RECEIVED
CALL CMPSTB ;COMPARE STRING BLOCKS
JRST CHKO.2 ;NO-MATCH RETURN
RETSKP ;IT-ALL-MATCHED RETURN
SUBTTL DO.DISCONNECT - Do the Disconnect Test
;DO.DISCONNECT - Do the Disconnect Test
;
;Call: CALL DO.DISCONNECT
; Error Return
; Normal Return
;Changes T1,T2,T3,T4
DO.DISCONNECT:
MOVE T2,DSCTYP ;GET THE DISCONNECT TYPE CODE
MOVEI T1,[ASCIZ /Synchronous Disconnect/]
CAIE T2,DST.SYN ;WAS IT SUPPOSED TO BE SYNCH?
MOVEI T1,[ASCIZ /Abort Disconnect/]
CALL STRMSG ;STANDARD TEST START MSG
;Build the USERDATA field for the disconnect message
;Note that USERDATA is expected to hold the user data we sent out.
MOVX T1,.TCDSC ;TESTTYPE: DISCONNECT
MOVEI T2,USERDATA ;STRING BLK TO PUT TESTYPE IN
CALL PUTSTY ;STORE TESTTYPE IN USERDATA
MOVE T1,RETTYP ;GET /RETTYP:xxx VALUE
CAILE T1,RET.MX ;INTERNAL CONSISTENCY CHECK
HALT .+1
MOVE T1,[EXP .SCSDN ;(0)SYNCH, NO RETURN
EXP .SCSDN ;(1)SYNCH, NO RETURN
EXP .SCSDS ;(2)SYNCH, STANDARD RETURN
EXP .SCSDR](T1) ;(3)SYNCH, RETURN RECEIVED DATA
MOVE T2,DSCTYP ;GET /TYPE VALUE
CAIE T2,DST.SYNCH ;/TYPE:SYNCH?
AOS T1 ;NO, PERMUTE .SCxxx TO ABORT
MOVEI T2,USERDATA ;POINTER TO STRING BLOCK
CALL PUT1BY ;STORE CONNECT CODE IN USERDATA
;Fill in next 8 bytes with standard data. We make the total less
;than 16 bytes to test ability to handle partial user data.
MOVEI T1,USERDATA ;POINTER TO STRING BLOCK TO FILL
MOVEI T2,^D8 ;FILL IN 8 BYTES AFTER CURRENT TEXT
CALL FILSTD ;FILL IN WITH STANDARD DATA
;Send off the connect initiate request
SETZB NSAA2,NSAA3 ;NO SEG SIZE YET, AND
; DEFAULT TO SEG FLOW CONTROL
CALL ENTACT ;ENTER ACTIVE
TRNA ;FAILED
CALL DSCRSP ;PROCESS THE CONNECT RESPONSE
MOVE T2,DSCTYP ;GET THE DISCONNECT TYPE CODE
MOVEI T1,[ASCIZ /Synchronous Disconnect/]
CAIE T2,DST.SYN ;WAS IT SUPPOSED TO BE SYNCH?
MOVEI T1,[ASCIZ /Abort Disconnect/]
CALL STPMSG ;STANDARD TEST STOP MSG
RETSKP
;DSCRSP - Process the DISCONNECT response to the connect initiate
;
;Call: T1/ Current DECnet state
; CALL DSCRSP
; Normal Return
;
;Uses T1,T2,T3,T4
DSCRSP: MOVE T2,DSCTYP ;DTR SUPPOSED TO ABORT IMMEDIATELY?
CAXN T2,DST.ABO ;ABORT TEST?
JRST DSCR.1 ;YES, WE MAY HAVE THE DI ALREADY
;SYNCHRONOUS TEST
CAIE T1,.NSSRN ;NOW IN RUN STATE?
CAIN T1,.NSSDR ; OR IN DISCONNECT RECEIVED STATE?
CAIA ;NO
JRST REJINT ;NO, REJECTED
;Link is now accepted, now wait for a disconnect
DSCR.1: HRRZ NSAA1,USERDATA ;MAX NUMBER OF WORDS
SOJ NSAA1, ;[4] LENGTH INCLUDES COUNT WORD
ASH NSAA1,2 ;MULTIPLY BY 4 TO GET BYTE COUNT
SKIPA NSAA2,.+1 ;BYTE POINTER TO DATA AREA
POINT 8,USERDATA+1 ;MACRO WON'T LET ME PUT THIS IN A LIT
CALNSP .NSFDR,NSAA2,NS.WAIT ;DATA READ (WAIT FOR DISCONNECT)
TRNA ;ERROR IS DISCONNECT
JRST DSCR.1 ;IGNORE ANY DATA RECEIVED
LDB T1,[POINTR(NSACH,NS.STA)]
CAIN T1,.NSSRJ ;IS LINK IN REJECT STATE?
JRST DSCLWNU ;YES, LINK WAS NEVER UP
CAIE T1,.NSSDR ;IS IT "DISCONNECT RECEIVED"?
JRST NSPERL ;NO, PRINT ERROR AND RELEASE CHNL.
;We now have the disconnect, release the channel, test is done
CALL RDDSDT ;READ DISCONNECT DATA
PJRST NSPREL ;FAILED, RELEASE THE CHANNEL
CALL CHKOPT ;CHECK THE OPTIONAL DATA RETURNED
PJRST NSPREL ;FAILED, RELEASE THE CHANNEL
PJRST NSPREL ;SUCCEEDED, RELEASE THE CHANNEL
;Here when we recieved the DI message so quickly after the CC
;message that we were not able to get the CC data.
DSCABO: INFO <Success, with link aborting before we could read it>,CRLF
PJRST NSPREL ;RELEASE THE CHANNEL
DSCLWNU:WARN <Link was never up>
PJRST NSPREL
SUBTTL DO.DATA - Do the Data Test
;DO.DATA - Do the Data Test
;
;Call: CALL DO.DATA
; Error Return
; Normal Return
;Changes T1,T2,T3,T4
DO.DATA:CALL CHKDAT ;CHECK THE ARGS TO DATA CMD
RET ;SOMETHING AMISS, MSG ALREADY OUT
CALL DTYPMG ;GET THE DATA TEST TYPE MESSAGE
CALL STRMSG ;STANDARD TEST START MSG
;Build the USERDATA field for the data message
MOVX T1,.TCDAT ;TESTTYPE: DATA
MOVEI T2,USERDATA ;STRING BLK TO PUT TESTYPE IN
CALL PUTSTY ;STORE TESTTYPE IN USERDATA
MOVE T1,DATTYP ;GET THE DATA TEST'S /TYPE: VALUE
MOVE T1,[EXP .DCSNK ;TRANSLATE THE VALUE TO PROTOCOL VALUE
EXP .DCSNK
EXP .DCSEQ
EXP .DCPAT
EXP .DCECH](T1)
CALL PUT1BY ;STORE DATTYPE FIELD
MOVE T1,RFLTYP ;GET /RFLOW VALUE (DTR'S FLOW)
MOVE T1,FCMTRN(T1) ;TRANSLATE TO PROTOCOL VALUE
CALL PUT1BY ;STORE RFLOW FIELD
MOVE T1,RQUEUE ;GET /RQUEUE FIELD
CALL PUT1BY ;STORE /RQUEUE FIELD
MOVEI T1,0 ;NOW A 2-BYTE
CALL PUT2BY ; RESERVED FIELD
MOVE T1,DMSGSIZ ;GET THE /MSGSIZ VALUE
MOVEM T1,MSGSIZ ;TELL PSTATS OUR MSG SIZE
CALL PUT2BY ;STORE THE MSGLEN FIELD
;Send off the connect initiate request
MOVE NSAA2,DSGMSIZ ;GET SELECTED SEGMENT SIZE
MOVE T1,SFLTYP ;GET /SFLOW (DTS'S) FLOW CONTROL
MOVE NSAA3,FCMTRN(T1);GET THE SELECTED FLOW CONT MODE
CALL ENTACT ;ENTER ACTIVE
TRNA ;FAILED
CALL DATRSP ;PROCESS THE CONNECT RESPONSE
CALL DTYPMG ;GET THE DATA TEST TYPE MESSAGE
CALL STPMSG ;STANDARD TEST STOP MSG
MOVE T1,DSGMSIZ ;GET DATA SEGMENT SIZE
MOVEM T1,SGMSIZ ; FOR STATS
CALL STATS ;PRINT ANY STATS REQUESTED
RETSKP
;CHKDAT checks the argument values. Called by DO.DATA before start.
CHKDAT: MOVE T1,DMSGSIZ ;GET DECLARED MESSAGE SIZE
CAXG T1,MAXMSG ;IS IT TOO BIG?
JRST CHKD.1 ;NO
ERROR <Requested message size too large>,CRLF
RET ;ERROR RETURN
CHKD.1: MOVE T2,DATTYP ;GET TYPE OF DATA TEST
MOVE T2,[EXP 0 ;SINK TEST (DEFAULT)
EXP 0 ;SINK TEST
EXP 4 ;SEQUENCE TEST (4 BYTES OF SEQUENCE)
EXP 5 ;PATTERN TEST (4 + 1 DATA BYTE)
EXP 5](T2) ;ECHO TEST (SAME AS PATTERN)
CAML T1,T2 ;IS IT TOO SMALL?
RETSKP ;NO
ERROR <Requested message size too small for this test>,CRLF
RET ;ERROR RETURN
;CHKINT - Same as CHKDAT, but for interrupt tests
CHKINT: MOVE T1,IMSGSIZ ;GET DECLARED MESSAGE SIZE
CAXG T1,^D16 ;INTERRUPT MESSAGES LIMITED TO 16 BYTES
JRST CHKI.1 ;O.K.
ERROR <Requested messages size too large>,CRLF
RET ;ERROR RETURN
CHKI.1: MOVE T2,INTTYP ;GET TYPE OF INTERRUPT TEST
MOVE T2,[EXP 0 ;SINK TEST (DEFAULT)
EXP 0 ;SINK TEST
EXP 4 ;SEQUENCE TEST
EXP 5 ;PATTERN TEST
EXP 5](T2) ;ECHO TEST
CAML T1,T2 ;IS IT TOO SMALL?
RETSKP ;NO
ERROR <Requested message size too small for this test>,CRLF
RET
;DTYPMG returns a pointer to the title message for current data test
DTYPMG: MOVE T1,DATTYP ;GET TYPE CODE FOR DATA TEST
MOVE T1,[[ASCIZ /Data Sink/]
[ASCIZ /Data Sink/]
[ASCIZ /Data Sequence/]
[ASCIZ /Data Pattern/]
[ASCIZ /Data Echo/]](T1)
RET
;ITYPMG returns a pointer to title message for current interrupt test
ITYPMG: MOVE T1,INTTYP ;GET TYPE CODE FOR INTERRUPT TEST
MOVE T1,[[ASCIZ /Interrupt Sink/]
[ASCIZ /Interrupt Sink/]
[ASCIZ /Interrupt Sequence/]
[ASCIZ /Interrupt Pattern/]
[ASCIZ /Interrupt Echo/]](T1)
RET
;DATRSP - Process the DATA response to the connect initiate
;
;Call: CALL DATRSP
; Normal Return
;
;Uses T1,T2,T3,T4
DATRSP: CAIE T1,.NSSRN ;NOW IN RUN STATE?
JRST REJINT ;NO, REJECTED
CALL DSCLNK ;DESCRIBE THE LINK
RET
;Set the SQUEUE value as the link quota
MOVE T1,SQUEUE ;GET THE /SQUEUE VALUE
CALL SETQTA ;SET THE LINK QUOTA
RET ;ERROR MESSAGE ALREADY GIVEN
;STRTIM is already filled in by STRMSG, here we predict finish time
MOVE T1,TIME ;GET SECONDS TEST IS TO RUN
IMULI T1,^D1000 ;MAKE IT MILLISECONDS
ADD T1,STRTIME ;ADD IN START TIME
MOVEM T1,FINTIME ;THAT'S WHEN WE'RE TO FINISH
CALL DATLOP ;SEND DATA UNTIL TIME EXPIRES
PJRST NSPREL ;ABORT THE LINK
MOVE T1,TERMIN ;GET /TERMIN:[SYNCH or ABORT]
CAXE T1,TER.SYN ;/TERMIN:SYNCHRONOUS_DISCONNECT?
PJRST NSPREL ;NO, ABORT AND FORGET THE LINK
;YES, SYNCH DISCONNECT
CALL DATMOP ;COLLECT ANY ECHOS STILL LYING AROUND
CALNSP .NSFSD,,NS.WAI ;SYNCH DISCONNECT
PJRST NSPERL ;REPORT ERROR AND RELEASE
PJRST NSPREL ;RELEASE THE LINK
;DATLOP - The DATA test's send data loop
;
;Call: CALL DATLOP
; Error Return if link screws up or aborts
; Normal Return
DATLOP:
;See if there's anything doing on the link
DATL.0:!CALNSP .NSFRS ;READ STATUS FUNCTION CODE
PJRST NSPERR
LDB T2,[POINTR(NSACH,NS.STA)] ;LOAD UP THE STATE FIELD
CAXE T2,.NSSRN ;RUN STATE?
CAXN T2,.NSSDS ;OR DISCONNECT SENT?
CAIA ;YES, ALL IS OK
PJRST TYPSTA ;NO, LINK IS WASHED UP, TELL USER
DATL.1: TXNE NSACH,NS.NDA ;NORMAL DATA AVAILABLE?
JRST [CALL RCVNML ;YES, READ AN ECHO
RET ;ABORT TEST ON FORMAT ERROR
JRST DATL.1] ;KEEP READING UNTIL NOTHING MORE THERE
;Have we done this long enough?
CALL GETTIME ;GET UNWRAPPING TIME
CAMGE T1,FINTIME ;REACHED FINISH TIME YET?
JRST DATL.2 ;NO, TRY TO SEND ANOTHER MESSAGE
RETSKP ;YES, DISCONNECT LINK NOW
;More sends needed
DATL.2: TXNE NSACH,NS.NDR ;OK TO SEND NORMAL DATA?
CALL SNDNML ;YES, SEND SOME NORMAL DATA
DATL.3: CALL DBGCHK ;SEE IF USER WANTS DDT
RETSKP ;"STOP THE TEST" RETURN
TXNE NSACH,<NS.NDR ! NS.NDA> ;ANYTHING TO DO NOW?
JRST DATL.0 ;YES, GO DO IT
;NO, SLEEP FOR A BIT
SKIPE IDLFLG ;SHOULD WE TRACE IDLE TIMES?
OUTCHR ["."] ;YES, TYPE A DOT TO SAY WE'RE HIBERING
MOVX T1,<HB.RIO ! HB.RTC ! HIBTIM> ;WAIT FOR ASYNCH I/O OR TIME
HIBER T1,
JFCL ;SHOULD NOT FAIL
CALL DBGCHK ;SEE IF USER WANTS DDT
RETSKP ;"STOP THE TEST" RETURN
JRST DATL.0 ;LOOP UNTIL TIME SAYS STOP
;DATMOP - Mop up any echos still to come, then return
;
;Call: CALL DATMOP
; Normal Return
DATMOP: MOVE T1,DATTYP ;GET TYPE OF TEST
CAXE T1,DTT.ECHO ;WAS IT AN ECHO TEST?
RET ;NO, WE'RE ALL DONE
MOVE T1,TERMIN ;GET /TERMIN:[SYNCH or ABORT]
CAXE T1,TER.SYN ;/TERMIN:SYNCHRONOUS_DISCONNECT?
RET ;NO, ABORT AND FORGET THE LINK
;YES, SYNCH DISCONNECT
;See if there's anything doing on the link
DATM.1:!CALNSP .NSFRS ;READ STATUS FUNCTION CODE
PJRST NSPERR
DATM.2: TXNE NSACH,NS.NDA ;NORMAL DATA AVAILABLE?
JRST [CALL RCVNML ;YES, READ AN ECHO
RET ;ABORT TEST ON FORMAT ERROR
JRST DATM.2]
MOVE T1,SNDCNT ;HAVE WE
CAMG T1,RCVCNT ; RECEIVED ALL ECHOS YET?
RET ;YES, OK TO DISCONNECT LINK NOW
DATM.3: CALL DBGCHK ;SEE IF USER WANTS DDT
RET ;"STOP THE TEST" RETURN
TXNE NSACH,<NS.NDR ! NS.NDA> ;ANYTHING TO DO NOW?
JRST DATM.1 ;YES, GO DO IT
;NO, SLEEP FOR A BIT
SKIPE IDLFLG ;SHOULD WE TRACE IDLE TIMES?
OUTCHR ["."] ;YES, TYPE A DOT TO SAY WE'RE HIBERING
MOVX T1,<HB.RIO ! HB.RTC ! HIBTIM> ;WAIT FOR ASYNCH I/O OR TIME
HIBER T1,
JFCL ;SHOULD NOT FAIL
CALL DBGCHK ;SEE IF USER WANTS DDT
RET ;"STOP THE TEST" RETURN
JRST DATM.1 ;LOOP UNTIL TIME SAYS STOP
;SNDNML - Send a Normal Data Message
;
;Call: CALL SNDNML
; Normal Return (errors are counted and ignored)
;
;Uses T1,T2,T3,T4
SNDNML: AOS T1,SNDCNT ;FIRST MESSAGE IS CALLED #1
HRRZS SNDMSG ;TELL PUTNBY TO STORE AT BEG OF MSG
MOVEI T2,SNDMSG ;POINTER TO STRING BLOCK
MOVEI T3,SEQLEN ;NUMBER OF BYTES IN SEQUENCE NUMBER
CALL PUTNBY ;STORE MSG # AS SEQLEN-BYTE FIELD
MOVE NSAA1,DMSGSIZ ;ALREADY CHECKED FOR LEGAL SIZE
MOVE NSAA2,PSNDMSG ;BYTE POINTER TO SEND MESSAGE
CALNSP .NSFDS,NSAA2,<NS.WAIT!NS.EOM> ;NORMAL DATA SEND
TRNA ;NETWORK ERROR, COUNT IT AND CONTINUE
CALLRET REMIND ;SUCCESS, RETURN TO DATLOP
;Here when we have a network error
CALL NSPERR ;TELL USER ABOUT IT
AOS SERRCNT ;COUNT SEND ERROR FOR STATS
RET ;RETURN FOR MORE PUNISHMENT
;REMIND - Remind the user that the test is still running
;
;Call: CALL REMIND
; Normal Return
;
;Uses T1,T2,T3,T4
REMIND: MOVE T1,SNDCNT ;GET CURRENT SEND COUNT
IDIVI T1,DEC 100 ;ONLY TELL THEM EVERY 100 MESSAGES
JUMPN T2,CPOPJ ;...
INFO <Sent # >
MOVE T1,SNDCNT ;GET CURRENT SEND COUNT
CALLSCAN .TDECW## ;PRINT IT IN DECIMAL
CALLSCAN .TRBRK## ;PRINT A RIGHT BRACKET FOR THE INFO MSG
CALLSCAN .TCRLF##
RET
;RCVNML - Receive a Normal Data Message
;
;Call: CALL RCVNML
; Error Return if data format error
; Normal Return (errors are counted and ignored)
;
;Uses T1,T2,T3,T4
RCVNML: AOS RCVCNT ;RECEIVED ONE MORE MESSAGE
MOVE NSAA1,DMSGSIZ ;ALREADY CHECKED FOR LEGAL SIZE
MOVE NSAA2,PRCVMSG ;BYTE POINTER TO RECEIVE MESSAGE
CALNSP .NSFDR,NSAA2,<NS.WAIT ! NS.EOM> ;NORMAL DATA RECEIVE
JRST RCVN.1 ;NETWORK ERROR, COUNT IT AND CONTINUE
;Now we have a message, check it according to requested test
JUMPN NSAA1,RCVN.4 ;IF RECVD MSG DIDN'T EXACTLY FIT, ERROR
TXNN NSAFN,NS.EOM ;DID WE GET THE WHOLE MESSAGE?
JRST RCVN.5 ;NO, COMPLAIN
MOVE T1,DATTYP ;GET TYPE OF DATA TEST
CAXE T1,DTT.ECHO ;ECHO TEST?
RETSKP ;NO, IGNORE THE RECEIVED MESSAGE
MOVEI T1,SEQLEN ;ADVANCE BY SEQLEN TO SKIP MSG NUMBER
ADJBP T1,PRCVMSG ;BYTE PTR TO RECEIVED MSG
MOVE T2,DMSGSIZ ;LENGTH OF CORRECT MESSAGE
HRLM T2,RCVMSG ;TELL GETNBY THAT WE HAVE DATA IN RCVMSG
SUBI T2,SEQLEN ;DECREMENT BY LENGTH OF MESSAGE NUMBER
CALL CMPSTD ;COMPARE WITH STANDARD DATA
JRST RCVN.2 ;COMPARE FAILED, ABORT THE TEST
MOVEI T1,0 ;OFFSET TO BYTES TO GET
MOVEI T2,RCVMSG ;POINTER TO STRING BLOCK
MOVEI T3,SEQLEN ;NUMBER OF BYTES IN SEQUENCE NUMBER
CALL GETNBY ;GET MESSAGE NUMBER
SETO T1, ;ASSUME ERROR IF CAN'T GET A NUMBER
MOVE T2,RCVCNT ;EXPECTED MESSAGE NUMBER (INCR'D ABOVE)
ANDX T2,MASK.(SEQLEN*^D8,35) ;MAKE IT WRAP AROUND PROPERLY
CAME T1,T2 ;IS IT THE RIGHT MESSAGE?
JRST RCVN.3 ;NO, ABORT THE TEST
;YES, ECHO CHECKED OUT OK
RETSKP ;SUCCESS, RETURN TO DATLOP
;Errors
RCVN.1: CALL NSPERR ;TELL USER ABOUT NETWORK ERROR
AOS RERRCNT ;COUNT RECEIVE ERROR FOR STATS
RETSKP ;RETURN FOR MORE PUNISHMENT
RCVN.2: WARN <Data format error>,CRLF
RET ;ERROR RETURN
RCVN.3: WARN <Sequence number error>,CRLF
RET ;ERROR RETURN
RCVN.4: WARN <Data length error>,CRLF
RET ;ERROR RETURN
RCVN.5: WARN <No EOM flag on received message>,CRLF
RET ;ERROR RETURN
SUBTTL DO.INTERRUPT - Do the Interrupt Test
;DO.INTERRUPT - Do the Interrupt Test
;
;Call: CALL DO.INTERRUPT
; Error Return
; Normal Return
;Changes T1,T2,T3,T4
DO.INTERRUPT:
CALL CHKINT ;CHECK VARIABLES
RET ;SOMETHING FAILED, MESSAGE TYPED OUT.
CALL ITYPMG ;GET TEST TITLE MESSAGE
CALL STRMSG ;STANDARD TEST START MSG
;Build the USERDATA field for the interrupt message
MOVX T1,.TCINT ;TESTTYPE: INTERRUPT
MOVEI T2,USERDATA ;STRING BLK TO PUT TESTYPE IN
CALL PUTSTY ;STORE TESTTYPE IN USERDATA
MOVE T1,INTTYP ;GET THE INTA TEST'S /TYPE: VALUE
MOVE T1,[EXP .ICSNK ;TRANSLATE THE VALUE TO PROTOCOL VALUE
EXP .ICSNK
EXP .ICSEQ
EXP .ICPAT
EXP .ICECH](T1)
CALL PUT1BY ;STORE INTTYPE FIELD
MOVE T1,RQUEUE ;GET /RQUEUE FIELD
CALL PUT1BY ;STORE /RQUEUE FIELD
MOVE T1,IMSGSIZ ;GET THE /MSGSIZ VALUE
MOVEM T1,MSGSIZ ;TELL PSTATS OUR MSG SIZE
;[3] CALL PUT2BY ;STORE THE MSGLEN FIELD
;Send off the connect initiate request
SETZB NSAA2,NSAA3 ;NO SEG SIZE YET, AND
; NO FLOW CONTROL OPTION HERE
CALL ENTACT ;ENTER ACTIVE
TRNA ;FAILED, MESSAGE ALREADY OUT
CALL INTRSP ;PROCESS THE CONNECT RESPONSE
CALL ITYPMG ;GET TEST TITLE MESSAGE
CALL STPMSG ;STANDARD TEST STOP MSG
MOVE T1,ISGMSIZ ;GET INTERRUPT SEGMENT SIZE
MOVEM T1,SGMSIZ ; FOR STATS
CALL STATS ;PRINT ANY STATS REQUESTED
RETSKP
;INTRSP - Process the INTERRUPT response to the connect initiate
;
;Call: CALL INTRSP
; Normal Return
;
;Uses T1,T2,T3,T4
INTRSP: CAIE T1,.NSSRN ;NOW I RUN STATE?
JRST REJINT ;NO, REJECTED
;STRTIM is already filled in by STRMSG, here we predict finish time
MOVE T1,TIME ;GET SECONDS TEST IS TO RUN
IMULI T1,^D1000 ;MAKE IT MILLISECONDS
ADD T1,STRTIME ;ADD IN START TIME
MOVEM T1,FINTIME ;THAT'S WHEN WE'RE TO FINISH
CALL INTLOP ;SEND INTERRUPT UNTIL TIME EXPIRES
PJRST NSPREL ;ABORT THE LINK
MOVE T1,TERMIN ;GET /TERMIN:[SYNCH or ABORT]
CAXE T1,TER.SYN ;/TERMIN:SYNCHRONOUS_DISCONNECT?
PJRST NSPREL ;NO, ABORT AND FORGET THE LINK
;YES, SYNCH DISCONNECT
CALNSP .NSFSD,,NS.WAI ;SYNCH DISCONNECT
PJRST NSPERL ;REPORT ERROR AND RELEASE
;Link is now disconnecting, we may still have echos to listen to
MOVEI T1,777777 ;GIVE SOME EXTRA TIME
ADDM T1,FINTIME ; FOR THE DISCONNECT TO COMPLETE
ITRS.1: CALL INTLOP ;COLLECT ANY ECHOS STILL LYING AROUND
TRNA ;ERROR, HOPE IT WAS THE DISCON CONF
JRST ITRS.1 ;LOOP ON ECHO CHECK UNTIL DONE
CALL TYPSTA ;TELL USER ABOUT CURRENT STATE
PJRST NSPREL ;RELEASE THE LINK
;INTLOP - The INTERRUPT test's send INTERRUPT loop
;
;Call: CALL INTLOP
; Error Return if link screws up or aborts
; Normal Return
INTLOP:
;See if there's anything doing on the link
INTL.1: CALNSP .NSFRS ;READ STATUS FUNCTION CODE
PJRST NSPERR
LDB T2,[POINTR(NSACH,NS.STA)] ;LOAD UP THE STATE FIELD
CAXE T2,.NSSRN ;RUN STATE?
CAXN T2,.NSSDS ;OR DISCONNECT SENT?
CAIA ;YES, ALL IS OK
RET ;NO, LINK IS WASHED UP
TXNE NSACH,NS.IDA ;INTERRUPT AVAILABLE?
JRST [CALL RCVINT ;YES, READ AN ECHO
RET ;ABORT TEST ON FORMAT ERROR
JRST .+1]
;Have we done this long enough?
CALL GETTIME ;GET UNWRAPPING TIME
CAMGE T1,FINTIME ;REACHED FINISH TIME YET?
JRST INTL.2 ;NO, TRY TO SEND ANOTHER MESSAGE
;YES, SEND NO MORE
MOVE T1,INTTYP ;GET TYPE OF TEST
CAXE T1,DTT.ECHO ;WAS IT AN ECHO TEST?
RETSKP ;NO, WE'RE ALL DONE
MOVE T1,TERMIN ;GET /TERMIN:[SYNCH or ABORT]
CAXE T1,TER.SYN ;/TERMIN:SYNCHRONOUS_DISCONNECT?
RETSKP ;NO, ABORT AND FORGET THE LINK
;YES, SYNCH DISCONNECT
MOVE T1,SNDCNT ;HAVE WE
CAMG T1,RCVCNT ; RECEIVED ALL ECHOS YET?
RETSKP ;YES, OK TO DISCONNECT LINK NOW
JRST INTL.3 ;NO, WAIT FOR MORE ECHOS
;More sends needed
INTL.2: TXNE NSACH,NS.IDR ;OK TO SEND AN INTERRUPT?
CALL SNDINT ;YES, SEND AN INTERRUPT
INTL.3: MOVX T1,<HB.RIO ! HB.RTC ! HIBTIM> ;WAIT FOR ASYNCH I/O OR TIME
HIBER T1,
JFCL ;SHOULD NOT FAIL
CALL DBGCHK ;SEE IF USER WANTS DDT
RETSKP ;"STOP THE TEST" RETURN
JRST INTL.1 ;LOOP UNTIL TIME SAYS STOP
;SNDINT - Send an Interrupt Message
;
;Call: CALL SNDINT
; Normal Return (errors are counted and ignored)
;
;Uses T1,T2,T3,T4
SNDINT: SETZM SNDMSG ;TELL PUTNBY TO STORE AT BEG OF MSG
AOS T1,SNDCNT ;FIRST MESSAGE IS CALLED #1
MOVEI T2,SNDMSG ;POINTER TO STRING BLOCK
MOVEI T3,SEQLEN ;NUMBER OF BYTES IN SEQUENCE NUMBER
CALL PUTNBY ;STORE MSG # AS SEQLEN-BYTE FIELD
HRLZ T1,IMSGSIZ ;INT MSG SIZE (BYTES) USER REQUESTED
HRRI T1,MAXMGW ;LENGTH OF STRING BLK IN WORDS
MOVEM T1,SNDMSG ;STORE IN COUNT FIELD OF SEND BLOCK
MOVEI NSAA1,SNDMSG ;POINTER TO STRING BLOCK
CALNSP .NSFIS,NSAA1,NS.WAIT ;INTERRUPT SEND
TRNA ;NETWORK ERROR, COUNT IT AND CONTINUE
CALLRET REMIND ;SUCCESS, RETURN TO INTLOP
;Here when we have a network error
CALL NSPERR ;TELL USER ABOUT IT
AOS SERRCNT ;COUNT SEND ERROR FOR STATS
RET ;RETURN FOR MORE PUNISHMENT
;RCVINT - Receive an Interrupt Message
;
;Call: CALL RCVINT
; Error Return if data format error
; Normal Return (errors are counted and ignored)
;
;Uses T1,T2,T3,T4
RCVINT: AOS RCVCNT ;RECEIVED ONE MORE MESSAGE
HRLZ T1,IMSGSIZ ;LENGTH OF CORRECT MESSAGE
HRRI T1,MAXMGW ;LENGTH OF STRING BLK IN WORDS
MOVEM T1,RCVMSG ;STORE AS LENGTH OF STRING BLOCK
MOVEI NSAA1,RCVMSG ;ALREADY CHECKED FOR LEGAL SIZE
CALNSP .NSFIR,NSAA1,NS.WAIT ;NORMAL DATA RECEIVE
JRST RCVI.1 ;NETWORK ERROR, COUNT IT AND CONTINUE
;Now we have a message, check it according to requested test
MOVE T1,INTTYP ;GET TYPE OF DATA TEST
CAXE T1,DTT.ECHO ;ECHO TEST?
RETSKP ;NO, IGNORE THE RECEIVED MESSAGE
MOVEI T1,SEQLEN ;ADVANCE BY SEQLEN TO SKIP MSG NUMBER
ADJBP T1,PRCVMSG ;BYTE PTR TO RECEIVED MSG
HLRZ T2,RCVMSG ;GET LENGTH OF RECEIVED MSG
CAME T2,IMSGSIZ ;LENGTH OF CORRECT MESSAGE
JRST RCVI.4 ;LENGTH ERROR
SUBI T2,SEQLEN ;DECREMENT BY LENGTH OF MESSAGE NUMBER
CALL CMPSTD ;COMPARE WITH STANDARD DATA
JRST RCVI.2 ;COMPARE FAILED, ABORT THE TEST
MOVEI T1,0 ;OFFSET TO BYTES TO GET
MOVEI T2,RCVMSG ;POINTER TO STRING BLOCK
MOVEI T3,SEQLEN ;NUMBER OF BYTES IN SEQUENCE NUMBER
CALL GETNBY ;GET MESSAGE NUMBER
SETO T1, ;ASSUME ERROR IF CAN'T GET A NUMBER
MOVE T2,RCVCNT ;EXPECTED MESSAGE NUMBER (INCR'D ABOVE)
ANDX T2,MASK.(SEQLEN*^D8,35) ;MAKE IT WRAP AROUND PROPERLY
CAME T1,T2 ;IS IT THE RIGHT MESSAGE?
JRST RCVI.3 ;NO, ABORT THE TEST
;YES, ECHO CHECKED OUT OK
RETSKP ;SUCCESS, RETURN TO DATLOP
;Errors
RCVI.1: CALL NSPERR ;TELL USER ABOUT NETWORK ERROR
AOS RERRCNT ;COUNT RECEIVE ERROR FOR STATS
RETSKP ;RETURN FOR MORE PUNISHMENT
RCVI.2: WARN <Data format error>,CRLF
RET ;ERROR RETURN
RCVI.3: WARN <Sequence number error>,CRLF
RET ;ERROR RETURN
RCVI.4: WARN <Data length error>,CRLF
RET ;ERROR RETURN
SUBTTL STATS - Print out the Statistics
;Called from DO.DATA and DO.INTERRUPT with no args
;Call: CALL STATS
; Normal Return
;
;Uses T1,T2,T3,T4
STATS: SKIPN STATISTICS ;STATS REQUESTED?
RET ;NO
SETOM ALWPRI ;IGNORE THE /PRINT:xxx SWITCH
CALL PSTATS ;PRINT OUT THE STATS
SETZM ALWPRI ;BACK TO NORMAL TYPE OUT MODE
RET
SUBTTL ENTACT - Subroutine to Enter Active
;ENTACT - Subroutine to Enter Active
;
;Call: NSAA2/ segment size (or zero)
; NSAA3/ flow control mode
;
; CALL ENTACT
; Error Return, message put out
; Normal Return with DECnet state in T1, status word in NSAA1
;
;Uses T1,T2,T3,T4
ENTACT: MOVEI NSAA1,EACONB ;POINTER TO CONNECT BLOCK
; NSAA2 filled in by caller
; NSAA3 filled in by caller
CALNSP .NSFEA,NSAA3,NS.WAIT ;WAIT FOR ENTER ACTIVE
JRST [CAXE T1,NSRBO% ;REJECTED BY OBJECT?
CAXN T1,NSDBO% ; OR DISCONNECTED BY OBJECT?
JRST .+1 ;YES, READ THE DISCONNECT DATA
CAXN T1,NSABO% ;[4] OR ABORTED BY OBJECT?
JRST .+1 ;[4] YES, READ THE DISCONNECT DATA
MOVEM NSACH,CHANEL ;STORE CHANNEL FOR NSPREL
PJRST NSPERL] ;NO, INTERPRET ERROR & RELEASE
MOVEM NSACH,CHANEL ;STORE CHANNEL NUMBER RETURNED
LDB T1,[POINTR(NSACH,NS.STA)];GET THE STATE FIELD
CAIE T1,.NSSRN ;NOW IN RUN STATE?
CAIN T1,.NSSRJ ;OR REJECT?
RETSKP ;YES, SUCCESS
CAIN T1,.NSSDR ;OR DISCONNECT RECEIVED (DISCON TEST)?
RETSKP ;YES, SUCCESS
;Here if Enter Active returned the link in an unexpected state
WARN <New link in neither RN nor RJ state, see next message>,CRLF
CALL TYPSTA ;TELL USER ERROR STATE INFO
PJRST NSPREL ;RELEASE THE CHANNEL
SUBTTL DSCLNK - Describe a Link
;DSCLNK - Describe Link Just Set Up
;
;Call: CHANEL/ Channel number of new link
;
; CALL DSCLNK
; Error Return, message put out
; Normal Return
;
;Uses T1,T2,T3,T4
DSCLNK: CALL NSPSTS ;READ LINK STATUS
CALLRET NSPERL ;ERROR AND RELEASE IF CAN'T
;Here to tell user about the link we just built
INFO <Segment size: >
MOVE T1,NSAA1 ;GET SEGSIZE FROM READ STATUS
CALLSCAN .TDECW##
MOVEI T1,[ASCIZ /, RFLOW: /]
CALLSCAN .TSTRG##
HLRZ T1,NSAA2 ;REMOTE FLOW CONTROL IN LH
CALL TYPFLO
MOVEI T1,[ASCIZ /, SFLOW: /]
CALLSCAN .TSTRG##
HRRZ T1,NSAA2 ;LOCAL FLOW CONTROL IN RH
CALL TYPFLO
MOVEI T1,[ASCIZ /, RQUEUE: /]
CALLSCAN .TSTRG##
MOVE T1,RQUEUE ;PICK UP SPECIFIED DTR Q LENGTH
CALL .TDECW##
MOVEI T1,[ASCIZ /, SQUEUE: /]
CALLSCAN .TSTRG##
MOVE T1,SQUEUE ;PICK UP SPECIFIED DTS Q LENGTH
CALL .TDECW##
MOVEI T1,[ASCIZ /]/]
CALLSCAN .TSTRG##
CALLSCAN .TCRLF##
RETSKP
SUBTTL Handle Unexpected Connect Rejection
;REJINT - Interpret Reject Info
;
;Call: CALL REJINT
; Normal Return
;
;Changes T1,T2,T3,T4
REJINT: CALL RDDSDT ;READ DISCONNECT DATA
PJRST NSPREL ;PROPOGATE ERROR RETURN
;REJINC - Here when RDCNDT has already been called
;
;Call: T1/ State returned from RDCNDT
; USRDAT/ Disconnect data returned from RDCNDT
; CALL REJINT
; Normal Return
;
;Changes T1,T2,T3,T4
REJINC: ERROR <Connect failed, reason code: >
MOVE T1,NSAA2 ;GET REASON CODE
CALL RSNTXT ;TYPE OUT TEXT FOR REASON CODE
CALLSCAN .TCRLF##
;Here to report .ECUKT (^D15) errors for the user
MOVEI T1,0 ;GET FIRST BYTE
MOVE T2,NSAA1 ;POINTER TO STRING BLOCK
CALL GET1BY ;GET FIRST BYTE OF STR BLK
JRST NSPREL ;STRING BLOCK WAS EMPTY
CAIE T1,.ECUKT ;UNKNOWN TEST ERROR CODE?
PJRST NSPREL ;NO, QUIT NOW
ERROR <Unsupported DTR test requested in field number >
MOVEI T1,1 ;GET SECOND BYTE
MOVE T2,NSAA1 ;POINTER TO STRING BLOCK
CALL GET1BY ;GET FIRST BYTE OF STR BLK
MOVEI T1,77 ;UNKNOWN FIELD
CALLSCAN .TDECW##
CALLSCAN .TCRLF##
PJRST NSPREL
SUBTTL Utility Routines
;PUTSTY - Put TESTTYPE field in (T2) string block
;Call: T1/ .TCxxx, the test type
; T2/ Pointer to String Block
; CALL PUTSTY
; Normal Return
;
;Uses T1,T2,T3,T4
PUTSTY: HRRZS (T2) ;ZERO THE STRING BLOCK COUNT
MOVE T3,PRINT ;GET VALUE OF "PRINT" SWITCH
CAIN T3,PRI.ALL ;/PRINT:ALL?
TXO T1,.TCPRI ! .TCERR ;YES, MARK BOTH PRINT AND ERROR
CAIN T3,PRI.ERROR ;/PRINT:ERROR?
TXO T1,.TCERR ;YES, SAY SO
SKIPE OLDFLG ;ARE WE TALKING OLD PROTOCOL?
TXZ T1,.TCERR ;YES, DOESN'T KNOW ABOUT .TCERR
;T2 ALREADY HOLDS PTR TO STR BLK
PUTST1: PJRST PUT1BY ;WRITE A ONE-BYTE FIELD
;STRMSG - Type out the standard Test Starting Message
;
;Call: T1/ [ASCIZ /testname/]
; CALL STRMSG
;
;Uses: T1,T2,T3,T4
STRMSG: CALL INFMSG ;OUTPUT (T1) WITH INFO HEADER
MOVEI T1,[ASCIZ / Test Started at /]
CALLSCAN .TSTRG##
CALLSCAN .TTIMN## ;TYPE OUT CURRENT TIME
MOVEI T1,[ASCIZ /]
/]
CALLSCAN .TSTRG##
CALL GETTIM ;GET STARTING TIME
MOVEM T1,STRTIM
;Zero the statistics counters for the STATS routine
SETZM SNDCNT ;START WITH ZERO MSGS SENT
SETZM RCVCNT ; AND RECEIVED
SETZM SERRCNT ; AND ZERO ERRORS
SETZM RERRCNT ; ...
RET
;STPMSG - Type out the standard Test Stopping Message
;
;Call: T1/ [ASCIZ /testname/]
; CALL STPMSG
;
;Uses: T1,T2,T3,T4
STPMSG: CALL INFMSG ;OUTPUT (T1) WITH INFO HEADER
MOVEI T1,[ASCIZ / Test Stopped at /]
STRP.X: CALLSCAN .TSTRG##
CALLSCAN .TTIMN## ;TYPE OUT CURRENT TIME
MOVEI T1,[ASCIZ /]
/]
CALLSCAN .TSTRG##
CALL GETTIM ;GET STOPPING TIME
SUB T1,STRTIM ;SUBTRACT STARTING TIME
SKIPG T1 ;DID WE GO PAST MIDNIGHT?
ADDX T1,<DEC 1000*60*60*24>
MOVEM T1,ELPTIM ;STORE FOR STATS ROUTINE
RET
SUBTTL LOOKNM - Envelope caller for .LKNAM
;LOOKNM - Call .LKNAM
;
;Call: T1/ IOWD Length,Namelist
; T2/ SIXBIT /name-to-search-for/
; CALL LOOKNM
; Error Return, code in T1
; Normal Return, Ptr to matching name in T1
;
;Uses T1,T2,T3,T4
;.LKNAM error code: not found (T1.LT.0) or ambiguous (T1.GE.0)
LOOKNM: MOVEM T2,CURCMD ;SAVE FOR ERROR ROUTINES
CALLSCAN .LKNAM## ;LOOK UP THE NAME
RET ;PROPOGATE ERROR RETURN
MOVE T3,(T1) ;GET FULL MATCHED NAME
LDB T4,[POINT 6,T3,5] ;GET FIRST CHAR
CAIN T4,'*' ;IS IT A STAR FOR .LKNAM?
LSH T3,6 ;YES, SHIFT IT OUT OF NAME
MOVEM T3,CURCMD ;STORE FOR ERROR RTNS
RETSKP
SUBTTL STRBLD - Called from OPPVAL to build a string block
;Call: T1/ Pointer to string block
; CALL STRBLD
; "Caller store value" return, never
; "I stored value" return, always
;
;Uses T1,T2,T3,T4
STRBLD: PUSH P,T1 ;SAVE PTR TO TARGET STRING BLOCK
CALLSCAN .ASCQW## ;GET A POSSIBLY QUOTED ASCII STRING
SKIPA T2,.+1 ;THE STRING IS HERE IN .SCAN
POINT 7,.NMUL## ;MACRO WON'T ALLOW EXTS IN LITS
POP P,T1 ;PASS PTR TO STRING BLOCK TO ASC2ST
CALL ASC2ST ;COPY AND CONVERT TO STRING BLOCK
RETSKP
SUBTTL RDX60W - Input a Radix 60 Number from Command String
;RDX60W -- Input a Radix 60 Number from Command String
;RDX60C -- Ditto (Character already in C)
;Formats are XX:YY:ZZ or xx followed by HOURS,MINUTES or SECONDS
;Call: PUSHJ P,RDX60C/RDX60W
; Return with seconds in N
;Uses T1, T2, T3 Updates C (separator)
RDX60W::CALL RDXDCI ;GET A DECIMAL NUMBER
MOVE T2,N ;PRESET FOR HH:MM:SS FORMAT
CAIE C,":" ;USING HH:MM:SS FORMAT?
JRST RDX6.4 ;NO
RDX6.1: IMULI T2,^D100 ;ADVANCE TO NEXT RESULT
PUSHJ P,RDXDCI ;GET NEXT SUPER-DIGIT
JUMPL N,E.TTL ;ERROR IF NEGATIVE
ADD T2,N ;ADD TO ACCUMULATOR
CAIE C,":" ;SEE IF MORE TO COME
JRST RDX6.2 ;NO--GO CONVERT RESULT
TLNE T2,(777B8) ;DON'T ALLOW OVERFLOW
JRST E.TTL ;ERROR IF TIME TOO LARGE
CAILE N,^D60 ;DON'T ALLOW GARBAGE IN
JRST E.TTL ;ERROR IF DIGIT TOO LARGE
JRST RDX6.1 ;LOOP BACK FOR MORE
RDX6.2: MOVEI N,0 ;CLEAR RESULT
RDX6.3: IDIVI T2,^D100 ;SEPARATE TYPEIN
HRLM T3,(P) ;STORE LEAST DIGIT AWAY
SKIPE T2 ;SKIP IF ALL DONE
PUSHJ P,RDX6.3 ;IF NOT, DO SOME MORE
HLRZ T1,(P) ;GET BACK HIGHEST DIGIT
IMULI N,^D60 ;MAKE ROOM IN RESULT
ADD N,T1 ;INCLUDE RESULT
CAILE T1,^D60 ;SEE IF ERROR
JRST E.TTL ;COMPLAIN IF COMPONENT TOO BIG
CPOPJ: RET ;RETURN
E.TTL: MOVEI N,^D60 ;RETURN DEFAULT TIME
WARN <Unknown time format, assuming 60 seconds>,CRLF
RET
;Here is using TIME:xxx SECONDS format
RDX6.4: SAVEAC <P1,P2>
MOVE P1,N ;SAVE DIGITS WE HAVE SO FAR
JUMPL C,.POPJ ;ASSUME SECONDS IF NO MORE ON LINE
MOVEI T2,.SIXSC## ;ASSUME NEXT CHAR IS AN ALPHA
;.TIAUC HAS ALREADY UP-CASED THE CHAR
CAIL C,"A" ;IS NEXT AN ALPHA?
CAILE C,"Z" ;...
MOVEI T2,.SIXSW## ;NO, DON'T USE IT IN SIXBIT WORD
CALL (T2) ;GET A SIXBIT WORD
JUMPE N,[MOVE N,P1 ;ASSUME SECONDS IF NO MORE ON LINE
RET]
MOVE T1,[IOWD 3,[EXP SIXBIT /HOURS/
EXP SIXBIT /MINUTES/
EXP SIXBIT /SECONDS/]]
MOVE T2,N
MOVE P2,T1 ;SAVE TABLE BASE ADDRESS
CALL LOOKNM
JRST RDX6.5 ;ERROR RETURN
SUBI T1,1(P2) ;GET ZERO-BASE OFFSET INTO TABLE
MOVE N,[DEC 3600
DEC 60
DEC 1 ](T1) ;GET MULTIPLIER
IMUL N,P1 ;MULTIPLY NUMBER USER TYPED
RET ;RETURN SECONDS IN N
RDX6.5: ERROR <Unknown TIME modifier: >
MOVE T1,CURCMD
CALLSCAN .TSIXN##
CALLSCAN .TCRLF##
PJRST E.TTL
RDXDCI: PUSHJ P,.TIAUC## ;PRIME THE PUMP
SETZM N ;COLLECT THE NUMBER HERE
DECIN1: CAIL C,"0" ;SEE IF DECIMAL
CAILE C,"9" ; ..
RET ;NO--AT END
IMULI N,^D10 ;YES--MULTIPLY NUMBER
ADDI N,-"0"(C) ;INCORPORATE DIGIT
CALLSCAN .TIAUC## ;GET NEXT CHARACTER
JRST DECIN1 ;LOOP BACK FOR MORE
;DBGCHK - Debug Check
;
;
; Call:
; No Arguments
;
; Return:
; RET ;IF USER WANTS TEST STOPPED
; RETSKP ;CONTINUE
;
;Saves all ACs
DBGCHK: SAVEAC T1
INCHRS T1 ;USER TYPE SOMETHING?
RETSKP ;NO
CAIL T1,"a" ;A LETTER
CAILE T1,"z" ; (lower case)?
CAIA ;NO
TRZ T1,40 ;YES, MAKE IT UPPER CASE
CAIN T1,"T" ;WANT IDLE TRACE?
JRST [ SETCMM IDLFLG ;YES, COMPLEMENT THE IDLE TRACE FLAG
RETSKP]
CAIN T1,"D" ;WANT DDT?
JRST DBGC.1 ;YES
CAIN T1,14 ;IS IT A FORM-FEED
RETSKP ;YES, ALLOW IT FOR FREE TO CLEAR SCREEN
CAIN T1,"Q" ;USER WANT TO QUIT?
RET ;YES, GIVE QUIT RETURN
;Here if we don't understand the command
OUTSTR [ASCIZ /? Unknown HIBER-time command
/]
RETSKP
;Here if user wants to go to DDT unambiguously
DBGC.1: SKIPN T1,.JBDDT ;DDT LOADED?
JRST DBGC.2 ;NO
POP P,.JBOPC ;YES, REMEMBER WHERE TO RETURN (SAVEAC)
JRST (T1) ;CAN'T JRST @.JBDDT CAUSE OF LEFT HALF
DBGC.2: OUTSTR [ASCIZ /? DDT not loaded
/]
RETSKP
SUBTTL Extra Commands for DECnet-10 Testing
IFN FTEXTRA,<
USTIME: CALLRET NSPJIF##
SUBTTL USTROLL - Set NSP Troll Value
USTROLL:
PROMPT <Present Troll Value: >
MOVE T1,NSPTRI##
CALLSCAN .TDECW##
CALLSCAN .TCRLF##
PROMPT <New Troll Value: >
REDLIN .DECNW## ;GET DECIMAL NUMBER
MOVEM N,NSPTRL##
MOVEM N,NSPTRI##
RET
SUBTTL USMTROLL - Set MEMORY TROLL Value
USMTROLL:
PROMPT <Present Memory Troll Value: >
MOVE T1,MEMTRI##
CALLSCAN .TDECW##
CALLSCAN .TCRLF##
PROMPT <New Memory Troll Value: >
REDLIN .DECNW## ;GET DECIMAL NUMBER
MOVEM N,MEMTRL##
MOVEM N,MEMTRI##
RET
SUBTTL USTHRESH - Set NSP Threshold Value
USTHRESH:
PROMPT <Present Threshold Value: >
MOVE T1,NSPRTH##
CALLSCAN .TDECW##
CALLSCAN .TCRLF##
PROMPT <New Threshold Value: >
REDLIN .DECNW## ;GET DECIMAL NUMBER
SKIPLE T1,N
MOVEM T1,NSPRTH##
RET
SUBTTL USWEIGHT - Set NSP Weight Value
USWEIGHT:
PROMPT <Present Weight Value: >
MOVE T1,NSPWGT##
CALLSCAN .TDECW##
CALLSCAN .TCRLF##
PROMPT <New Weight Value: >
REDLIN .DECNW## ;GET DECIMAL NUMBER
SKIPLE T1,N
MOVEM T1,NSPWGT##
RET
SUBTTL USDELAY - Set NSP Delay Value
USDELAY:
PROMPT <Present Delay Value (16ths): >
MOVE T1,NSPDLY##
CALLSCAN .TDECW##
CALLSCAN .TCRLF##
PROMPT <New Delay Value (16ths): >
REDLIN .DECNW## ;GET DECIMAL NUMBER
SKIPLE T1,N
MOVEM T1,NSPDLY##
RET
SUBTTL USJIFFY - Set NSP JIFFY Value
USJIFFY:
PROMPT <Present JIFFY Value (milliseconds): >
MOVE T1,TMRVAL##
CALLSCAN .TDECW##
CALLSCAN .TCRLF##
PROMPT <New JIFFY Value (milliseconds): >
REDLIN .DECNW## ;GET DECIMAL NUMBER
SKIPLE T1,N
MOVEM T1,TMRVAL## ;IN D36TST
RET
SUBTTL USLONG - Set NSP LONG Value
USLONG:
PROMPT <Present Long Interval Value ("jiffies"): >
MOVE T1,NSPJLI##
CALLSCAN .TDECW##
CALLSCAN .TCRLF##
PROMPT <New Long Interval Value ("jiffies"): >
REDLIN .DECNW## ;GET DECIMAL NUMBER
SKIPLE T1,N
MOVEM T1,NSPJLI##
RET
SUBTTL USSHORT - Set NSP SHORT Value
USSHORT:
PROMPT <Present Short Interval Value ("jiffies"): >
MOVE T1,NSPJSI##
CALLSCAN .TDECW##
CALLSCAN .TCRLF##
PROMPT <New Short Interval Value ("jiffies"): >
REDLIN .DECNW## ;GET DECIMAL NUMBER
SKIPLE T1,N
MOVEM T1,NSPJSI##
RET
SUBTTL USINACTIVITY - Set NSP Inactivity Value
USINACTIVITY:
PROMPT <Present Inactivity Value: >
MOVE T1,NSPINA##
CALLSCAN .TDECW##
CALLSCAN .TCRLF##
PROMPT <New Inactivity Value: >
REDLIN .DECNW## ;GET DECIMAL NUMBER
SKIPLE T1,N
MOVEM T1,NSPINA##
RET
SUBTTL USAUDIT - Set NSP Audit Value
USAUDIT:
PROMPT <Present Audit Value: >
MOVE T1,NSPJAI##
CALLSCAN .TDECW##
CALLSCAN .TCRLF##
PROMPT <New Audit Value: >
REDLIN .DECNW## ;GET DECIMAL NUMBER
SKIPLE T1,N
MOVEM T1,NSPJAI##
RET
SUBTTL - USTRACE - Turn Trace on and off
USTRACE:
PROMPT <SC & USR Trace (0 or 1): >
REDLIN .DECNW## ;GET DECIMAL NUMBER
MOVX T1,TRCSC!TRCUSR
ANDCAM T1,S.TRACE##
SKIPE N
IORM T1,S.TRACE##
PROMPT <NSP Trace (0 or 1): >
REDLIN .DECNW## ;GET DECIMAL NUMBER
MOVX T1,TRCNSP
ANDCAM T1,S.TRACE##
SKIPE N
IORM T1,S.TRACE##
PROMPT <XPT Trace (0 or 1): >
REDLIN .DECNW## ;GET DECIMAL NUMBER
MOVX T1,TRCXPT
ANDCAM T1,S.TRACE##
SKIPE N
IORM T1,S.TRACE##
PROMPT <COM Trace (0 or 1): >
REDLIN .DECNW## ;GET DECIMAL NUMBER
MOVX T1,TRCCOM
ANDCAM T1,S.TRACE##
SKIPE N
IORM T1,S.TRACE##
RET
SUBTTL - USETRACE - Turn ETRACE on and off
USETRACE:
PROMPT <SC & USR ETRACE (0 or 1): >
REDLIN .DECNW## ;GET DECIMAL NUMBER
MOVX T1,TRCSC!TRCUSR
ANDCAM T1,S.ETRACE##
SKIPE N
IORM T1,S.ETRACE##
PROMPT <NSP ETRACE (0 or 1): >
REDLIN .DECNW## ;GET DECIMAL NUMBER
MOVX T1,TRCNSP
ANDCAM T1,S.ETRACE##
SKIPE N
IORM T1,S.ETRACE##
PROMPT <XPT ETRACE (0 or 1): >
REDLIN .DECNW## ;GET DECIMAL NUMBER
MOVX T1,TRCXPT
ANDCAM T1,S.ETRACE##
SKIPE N
IORM T1,S.ETRACE##
PROMPT <COM ETRACE (0 or 1): >
REDLIN .DECNW## ;GET DECIMAL NUMBER
MOVX T1,TRCCOM
ANDCAM T1,S.ETRACE##
SKIPE N
IORM T1,S.ETRACE##
RET
;USCONGEST - Tell NSP that we're congested
;
;Call: T1/ The SCBid
; CALL USCONGEST
; Normal Return
USCONGEST::
CALLRET NSPCGT##
;USRELIEVE - Tell NSP that congestion is relieved
;
;Call: T1/ The SCBid
; CALL USRELIEVE
; Normal Return
USRELIEVE::
CALLRET NSPCGR##
subttl End of the FTEXTRA Commands
>;END OF IFN FTEXTRA
SUBTTL The NCP Command - Invoke NTMAN. Exercizer
;The NCP command calls the NTMAN. exercizer. It leaves the rest
;of the command line for it to read as it will.
IFN FTNCP,<
USNCP: CALLRET NCP##
>
SUBTTL End of Program
END DTS
Reference in New Issue View Git Blame Copy Permalink