mirror of
https://github.com/PDP-10/stacken.git
synced 2026-03-02 01:30:40 +00:00
1273 lines
37 KiB
Plaintext
1273 lines
37 KiB
Plaintext
TITLE DTSCOM - Common Routines for DTS and DTR
|
||
SUBTTL W. Nichols May, 1981
|
||
|
||
SEARCH JOBDAT,UUOSYM,SWIL,DTSPRM,MACTEN
|
||
FTEXTRA==0
|
||
IFN FTEXTRA,SEARCH SCPAR
|
||
|
||
EXTERNAL .ISCAN,.TYOCH ;ASSURE THAT SCAN COMES IN FOR LITTLES
|
||
.REQUEST REL:SWIL
|
||
EXTERNAL .LKWLD ;ASSURE THAT WILD COMES IN FOR E.LKEN
|
||
.REQUEST REL:WILD
|
||
.REQUEST REL:HELPER
|
||
|
||
SALL
|
||
.DIRECTIVE FLBLST ;DON'T GIVE ME CODE FOR ASCIZ
|
||
|
||
|
||
; This program conforms to the DTS specification version 1.1
|
||
; published on 22 April 1981.
|
||
|
||
|
||
|
||
|
||
;Expand the INTERN/EXTERN macro from DTSPRM
|
||
|
||
GLOBAL INTERNAL,EXTERNAL
|
||
|
||
|
||
$RELOC
|
||
$HIGH
|
||
SUBTTL General Impure Storage
|
||
|
||
$HIGH ;SHOULD ALREADY BE IN HISEG, BUT...
|
||
|
||
PDLIOW::IOWD LN$PDL,DTSPDL ;IOWD TO LOAD INTO P UPON STARTUP
|
||
|
||
$LOW
|
||
|
||
DTSPDL::BLOCK LN$PDL+1 ;THE STACK
|
||
CCLF1:: BLOCK 1 ;THE CCL ENTRY FLAG FOR .ISCAN
|
||
TYPBOL::BLOCK 1 ;TYPOUT AT BEG OF LINE IF NON-ZERO
|
||
TYPRCS::BLOCK 1 ;TYPOUT IS RECURSING IF NON-ZERO
|
||
INIFF:: BLOCK 1 ;INITIAL VALUE OF .JBFF
|
||
INICOR::BLOCK 1 ;INITIAL VALUE OF .JBREL
|
||
CURCMD::BLOCK 1 ;CURRENT COMMAND NAME, FOR UNKCMD
|
||
|
||
CHANEL::EXP -1 ;THE NSP. CHANNEL NUMBER ASSIGNED
|
||
|
||
LOGSPC::BLOCK .FXLEN+1 ;SCAN BLOCK FOR LOG SPECIFICATION
|
||
|
||
LOGFOP::BLOCK FOPLEN ;FILOP. BLOCK FOR LOG FILE
|
||
LOGBRH::BLOCK 3 ;LOG FILE'S BUFFER RING HEADER
|
||
LOGENT::BLOCK LN$ENT ;ENTER BLOCK FOR LOG SPEC
|
||
LOGPTH::BLOCK .PTMAX ;PATH FOR .STOPB TO SET UP
|
||
|
||
ERRPRI: BLOCK 1 ;NON-ZERO IF WE'RE PRINTING AN ERROR
|
||
ALWPRI::BLOCK 1 ;NON-ZERO IF WE'RE PRINTING STATS
|
||
LASTIM: BLOCK 1 ;USED BY GETTIM
|
||
|
||
|
||
;The User Data Block
|
||
|
||
USRLEN==1+<<LN$DAT+3>/4> ;STRING POINTER, COUNT+USER DATA(8-BIT)
|
||
IFL USRLEN-STRLNW,USRLEN==STRLNW
|
||
|
||
USERDA: STRBLK USRLEN ;A FREE STRING BLOCK FOR USER DATA
|
||
CNTUSR: STRBLK USRLEN ;READ THE CONNECT/DISCONNECT DATA HERE
|
||
RCVMSG: STRBLK MAXMGW ;THE DATA TEST'S RECEIVED MESSAGE
|
||
|
||
PRCVMSG:POINT 8,RCVMSG+1 ;BYTE POINTER TO DATA TEST'S MESSAGE
|
||
|
||
$HIGH
|
||
|
||
CPRGID: EXP PRGID ;MACRO CAN'T STAND THIS IN A LITERAL
|
||
;Call: CHANEL/ The NSP. channel number
|
||
; CALL NSPREL
|
||
; Normal Return
|
||
;
|
||
;Uses T1,T2,T3,T4
|
||
|
||
NSPREL::SETO T1, ;MAKE A -1 TO COMPARE WITH
|
||
CAMN T1,CHANEL ;IS IT OPEN?
|
||
RET ;NO, DON'T NEED TO RELEASE IT.
|
||
TRACE <NSPREL releasing channel state info follows>,CRLF
|
||
LDB T1,[POINTR(NSACH,NS.STA)]
|
||
CAIE T1,.NSSRN ;IN RUN STATE?
|
||
JRST NSPR.1 ;NO, HAVE TO RELEASE
|
||
;YES, WE SHOULD BE ABLE TO ABORT
|
||
CALNSP .NSFAB,,NS.WAI ;FIRST, TRY ABORT
|
||
TRNA ;FAILED, TRY RELEASE
|
||
JRST NSPR.X ;SUCCESS RETURN
|
||
|
||
CALL NSPERR ;FAILED, TELL USER WHY
|
||
|
||
NSPR.1: CALNSP .NSFRL ;RELEASE (CLOSE) FUNCTION
|
||
CALL NSPERR
|
||
NSPR.X: SETOB NSACH,CHANEL ;THE CHANNEL IS NOW CLOSED
|
||
CPOPJ: RET
|
||
SUBTTL .STATUS - Read the Status of the Link
|
||
|
||
;.STATUS is called by the STATUS command
|
||
;TYPSTA is called by error handlers
|
||
;that have found strange states in NSP. returns.
|
||
;
|
||
;Call: CALL .STATUS
|
||
; Normal Return, message has been typed
|
||
;
|
||
;Uses T1,T2,T3,T4
|
||
|
||
DEFINE TYPSTB(bitname),<
|
||
MOVEI T1,[ASCIZ ", bitname: "]
|
||
CALLSCAN .TSTRG##
|
||
LDB T1,[POINTR(NSACH,NS.'bitname)]
|
||
CALLSCAN .TOCTW##
|
||
>
|
||
|
||
.STATUS::
|
||
SKIPGE CHANEL ;IS THE CHANNEL OPEN?
|
||
JRST NOSTAT ;NO, TELL THEM NOTHING DOING
|
||
|
||
TYPSTA::SAVEAC <P1,P2>
|
||
SKIPL CHANEL ;IS THE CHANNEL OPEN?
|
||
CALL NSPSTS ;YES, GET STATUS INTO NSAA1
|
||
RET ;PROPOGATE ERROR RETURN
|
||
LDB T1,[POINTR(NSACH,NS.STA)]
|
||
CAILE T1,MAXSTA ;LEGAL STATE?
|
||
MOVX T1,-1 ;NO, GET ERROR MESSAGE
|
||
MOVE T1,STATAB(T1)
|
||
CALL INFMSG ;OUTPUT AN INFO MESSAGE HEADER
|
||
MOVEI T1,[ASCIZ / state/]
|
||
CALLSCAN .TSTRG##
|
||
TYPSTB NDA ;NORMAL DATA AVAIL
|
||
TYPSTB NDR ;NORMAL DATA REQUESTS AVAIL
|
||
TYPSTB IDA ;INTERRUPT DATA AVAIL
|
||
TYPSTB IDR ;INTERRUPT DATA REQUESTS AVAIL
|
||
CALLSCAN .TRBRK## ;A RIGHT SQUARE BRACKET FOR INFO
|
||
CALLSCAN .TCRLF##
|
||
RET ;"REPARSE" RETURN
|
||
|
||
|
||
NOSTAT: ERROR <No DECnet channel is open>,CRLF
|
||
RET
|
||
;Type out Flow Control value from T1
|
||
|
||
|
||
TYPFLO::CAIL T1,0
|
||
CAILE T1,3
|
||
MOVEI T1,4 ;UNKNOWN FLOW CONTROL TYPE
|
||
MOVE T1,FLOTYP(T1)
|
||
CALLSCAN .TSTRG##
|
||
RET
|
||
|
||
FLOTYP: [ASCIZ /Unknown/]
|
||
[ASCIZ /None/]
|
||
[ASCIZ /Segment/]
|
||
[ASCIZ /Message/]
|
||
[ASCIZ /Erroneous/]
|
||
DEFINE STATE(code),<
|
||
IFN .NSS'code-<.-STATAB>,PRINTX ?STATAB table wrong for code
|
||
[ASCIZ /code/]
|
||
>
|
||
|
||
[ASCIZ /Too Big (illegal)/] ;-1 value used when state too big
|
||
STATAB: [ASCIZ /Zero (illegal)/]
|
||
STATE CW ;CONNECT WAIT
|
||
STATE CR ;CONNECT RECEIVED
|
||
STATE CS ;CONNECT SENT
|
||
STATE RJ ;LINK WAS REJECTED
|
||
STATE RN ;LINK IS UP AND RUNNING
|
||
STATE DR ;DISCONNECT RECEIVED
|
||
STATE DS ;DISCONNECT SENT
|
||
STATE DC ;DISCONNECT CONFIRMED
|
||
STATE CF ;NO CONFIDENCE
|
||
STATE LK ;NO LINK
|
||
STATE CM ;NO COMMUNICATION
|
||
STATE NR ;NO RESOURCES
|
||
MAXSTA==.-STATAB-1
|
||
;NSPSTS - Get status of NSP channel into NSACH
|
||
;
|
||
;Call: CALL NSPSTS
|
||
; Error Return if NSP. UUO failed, message already output
|
||
; Normal Return with status in register NSACH
|
||
|
||
;This routine is expected to get the status and the other things
|
||
;that a read status function returns: seg size and flow control types.
|
||
|
||
NSPSTS::CALNSP .NSFRS,NSAA2 ;READ STATUS FUNCTION CODE
|
||
RET ;ERROR RETURN, LET USER
|
||
; ANNOUNCE IT IF S/HE WANTS
|
||
RETSKP ;SUCCESS RETURN
|
||
;RDCNDT - Read Connect User Data
|
||
;
|
||
;Call: CALL RDCNDT
|
||
; Error Return, message already put out
|
||
; Normal Return, NSAxx and CNTUSR filled in,
|
||
; and NSAA1 holds pointer to CNTUSR
|
||
; NSAA2 holds Segment Size
|
||
; NSAA3 holds transmit flow control mode
|
||
|
||
|
||
RDCNDT::
|
||
MOVEI NSAA1,CNTUSR ;PTR TO DIS/CONNECT USER DATA
|
||
CALNSP .NSFRC,NSAA3 ;READ CONNECT DATA (NO WAIT)
|
||
PJRST NSPERR
|
||
RETSKP
|
||
|
||
|
||
|
||
|
||
|
||
;RDDSDT - Read Disconnect User Data
|
||
;
|
||
;Call: CALL RDDSDT
|
||
; Error Return, message already put out
|
||
; Normal Return, NSAxx and CNTUSR filled in,
|
||
; and NSAA1 holds pointer to CNTUSR
|
||
; NSAA2 holds Segment Size
|
||
; NSAA3 holds transmit flow control mode
|
||
|
||
|
||
RDDSDT::
|
||
MOVEI NSAA1,CNTUSR ;PTR TO DIS/CONNECT USER DATA
|
||
CALNSP .NSFRD,NSAA2 ;READ DISCONNECT DATA (NO WAIT)
|
||
PJRST NSPERR
|
||
RETSKP
|
||
SUBTTL Error Routines
|
||
|
||
;NSPERR - Call this to interpret the error code from the NSP. UUO
|
||
;NSPERL - Same, but release the channel after printing the message
|
||
;
|
||
;Call: T1/ returned from NSP.
|
||
; CALL NSPERR/NSPERL
|
||
; Normal Return
|
||
|
||
NSPERL::CALL NSPERR ;PRINT OUT THE ERROR
|
||
PJRST NSPREL ;THEN RELEASE THE CHANNEL
|
||
|
||
|
||
NSPERR::PUSH P,T1 ;SAVE ERROR FROM NSP. UUO
|
||
WARN <NSP. error: >
|
||
POP P,T1 ;GET NSP. ERROR MSG BACK
|
||
CAIG T1,MAXERR ;DO WE KNOW THIS ERROR CODE?
|
||
JRST [MOVEI T2,.TSTRG##
|
||
MOVE T1,NSPERC(T1)
|
||
JRST NSPER1]
|
||
MOVEI T2,.TOCTW## ;NO, PRINT AS A OCTAL ERROR CODE
|
||
NSPER1: CALL (T2) ;PRINT STRING OR NUMBER
|
||
MOVEI T1,[ASCIZ /, function /]
|
||
CALLSCAN .TSTRG##
|
||
LDB T1,[POINTR(NSAFN,NS.AFN)] ;GET FUNCTION CODE FROM ARGS
|
||
CAILE T1,FCNTBL ;OFFSET OK?
|
||
MOVEI T1,0 ;NO, CALL IT ILLEGAL
|
||
MOVE T1,FCNTAB(T1) ;GET PTR TO ASCIZ STRING
|
||
CALLSCAN .TSTRG## ;TELL USER ABOUT FUNCTION CODE
|
||
CALLSCAN .TCRLF##
|
||
RET
|
||
DEFINE ERRMAC(code,text),<
|
||
IF1,<IFN code-<.-NSPERC>,<
|
||
PRINTX ?NSP. error code out of order in NSPERC table>>
|
||
ERRMC1(\code,text)
|
||
>
|
||
DEFINE ERRMC1(code,text),<[ASCIZ |(code) text|]>
|
||
|
||
NSPERC: ERRMAC 0, <Unknown Error Code>
|
||
ERRMAC NSABE%,<Argument Block Format Error>
|
||
ERRMAC NSALF%,<Allocation failure>
|
||
ERRMAC NSBCN%,<Bad channel number>
|
||
ERRMAC NSBFT%,<Bad format type in process block>
|
||
ERRMAC NSCFE%,<Connect Block format error>
|
||
ERRMAC NSIDL%,<Interrupt data too long>
|
||
ERRMAC NSIFM%,<Illegal flow control mode>
|
||
ERRMAC NSILF%,<Illegal function>
|
||
ERRMAC NSJQX%,<Job quota exhausted>
|
||
ERRMAC NSLQX%,<Link quota exhausted>
|
||
ERRMAC NSNCD%,<No connect data to read>
|
||
ERRMAC NSPIO%,<Percentage input out of bounds>
|
||
ERRMAC NSPRV%,<No Privileges to Perform Function>
|
||
ERRMAC NSSTB%,<Segment size too big>
|
||
ERRMAC NSUKN%,<Unknown node name>
|
||
ERRMAC NSUXS%,<Unexpected State: Unspecified>
|
||
ERRMAC NSWNA%,<Wrong number of arguments>
|
||
ERRMAC NSWRS%,<Function called in wrong state>
|
||
|
||
;New error codes (to be re-ordered):
|
||
|
||
ERRMAC NSCBL%,<Connect block length error>
|
||
ERRMAC NSPBL%,<Process block length error>
|
||
ERRMAC NSSBL%,<String block length error>
|
||
ERRMAC NSUDS%,<Unexpected State: Disconnect Sent>
|
||
ERRMAC NSUDC%,<Unexpected State: Disconnect Confirmed>
|
||
ERRMAC NSUCF%,<Unexpected State: No Confidence>
|
||
ERRMAC NSULK%,<Unexpected State: No Link>
|
||
ERRMAC NSUCM%,<Unexpected State: No Communication>
|
||
ERRMAC NSUNR%,<Unexpected State: No Resources>
|
||
|
||
;Error codes which correspond to DECnet disconnect codes.
|
||
|
||
ERRMAC NSRBO%,<Rejected by Object>
|
||
ERRMAC NSDBO%,<Disconnected by Object>
|
||
ERRMAC NSRES%,<No Resources at Remote Node>
|
||
ERRMAC NSUNN%,<Unrecognized Node Name>
|
||
ERRMAC NSRNS%,<Remote Node Shut Down>
|
||
ERRMAC NSURO%,<Unrecognized Object>
|
||
ERRMAC NSIOF%,<Invalid Object Name Format>
|
||
ERRMAC NSOTB%,<Object Too Busy>
|
||
ERRMAC NSABM%,<Abort by Management>
|
||
ERRMAC NSABO%,<Abort by Object>
|
||
ERRMAC NSINF%,<Invalid Node Name Format>
|
||
ERRMAC NSLNS%,<Local Node Shut Down>
|
||
ERRMAC NSACR%,<Access Control Rejection>
|
||
ERRMAC NSNRO%,<No Response from Object>
|
||
ERRMAC NSNUR%,<Node Unreachable>
|
||
ERRMAC NSNLK%,<No Link>
|
||
ERRMAC NSDSC%,<Disconnect Complete>
|
||
ERRMAC NSIMG%,<Image Field Too Long>
|
||
ERRMAC NSREJ%,<Unspecified Reject Reason>
|
||
|
||
ERRMAC NSBCF%,<Bad combination of NS.EOM & NS.WAI flags>
|
||
ERRMAC NSADE%,<Address Error>
|
||
; ERRMAC NSIMF%,<Invalid Message Format: Network Error>
|
||
|
||
MAXERR==.-NSPERC-1
|
||
DEFINE FCNMAC(code,text),<
|
||
IFN code-<.-FCNTAB>,<PRINTX ?NSP. function code out of order>
|
||
[ASCIZ /text/]
|
||
>
|
||
|
||
FCNTAB: FCNMAC 0, <Illegal function code>
|
||
FCNMAC .NSFEA,<Enter active>
|
||
FCNMAC .NSFEP,<Enter passive>
|
||
FCNMAC .NSFRI,<Read connect information>
|
||
FCNMAC .NSFAC,<Accept the connect>
|
||
FCNMAC .NSFRJ,<Reject the connect>
|
||
FCNMAC .NSFRC,<Read connect confirm information>
|
||
FCNMAC .NSFSD,<Synchronous disconnect>
|
||
FCNMAC .NSFAB,<Abort>
|
||
FCNMAC .NSFRD,<Read disconnect data>
|
||
FCNMAC .NSFRL,<Release the channel>
|
||
FCNMAC .NSFRS,<Read the channel status>
|
||
FCNMAC .NSFIS,<Send interrupt data>
|
||
FCNMAC .NSFIR,<Receive interrupt data>
|
||
FCNMAC .NSFDS,<Send normal data>
|
||
FCNMAC .NSFDR,<Receive normal data>
|
||
FCNMAC .NSFSQ,<Set quotas>
|
||
FCNMAC .NSFRQ,<Read quotas>
|
||
FCNMAC .NSFJS,<Set job quotas>
|
||
FCNMAC .NSFJR,<Read job quotas>
|
||
FCNMAC .NSFPI,<Set PSI reasons>
|
||
FCNTBL==.-FCNTAB
|
||
;UNKCMD - Call this when .LKNAM fails to find a command
|
||
;
|
||
;Call: CURCMD/ Set up by LOOKNM
|
||
; T1/ The error code from .LKNAM
|
||
; CALL UNKCMD
|
||
; Normal Return, always
|
||
;Changes T1,T2,T3,T4
|
||
|
||
UNKCMD::MOVE T2,T1 ;COPY ERROR CODE FROM .LKNAM
|
||
MOVEI T1,[ASCIZ \Unknown command: \]
|
||
SKIPL T2 ;T2.LT.0 IF NOT MATCH
|
||
MOVEI T1,[ASCIZ \Ambiguous command: \]
|
||
PJRST ERRCMD
|
||
;ERRCMD - Type an error string followed by CURCMD
|
||
;
|
||
;Call: T1/ Ptr to ASCIZ string
|
||
; CALL ERRCMD
|
||
; Normal Return, always
|
||
|
||
ERRCMD::SETOM ERRPRI ;ENABLE PRINT:ERROR
|
||
CALL ERRMSG
|
||
MOVE T1,CURCMD ;TYPE SIXBIT NAME SAVED BEFORE CALL
|
||
CALLSCAN .TSIXN## ; TO .LKNAM
|
||
CALLSCAN .TCRLF##
|
||
PJRST ERWM.2 ;GO TO COMMON EXIT CODE
|
||
|
||
;xxxMSG - Type out a message, subject to /PRINT:xxx
|
||
;
|
||
;Call: T1/ Pointer to ASCIZ string, including CRLF if so desired
|
||
; CALL ERRMSG
|
||
; Normal Return
|
||
|
||
ERRMSG::PUSH P,T1 ;SAVE ERROR MESSAGE
|
||
PUSH P,["E"]
|
||
SETOM ERRPRI ;ENABLE PRINT:ERROR
|
||
MOVEI T1,"?"
|
||
JRST ERWM.1
|
||
|
||
WRNMSG::PUSH P,T1 ;SAVE WARNING MESSAGE
|
||
PUSH P,["W"]
|
||
SETOM ERRPRI ;ENABLE PRINT:ERROR
|
||
MOVEI T1,"%"
|
||
JRST ERWM.1
|
||
|
||
IFN FTTRACE,<
|
||
TRCMSG::PUSH P,T1 ;SAVE WARNING MESSAGE
|
||
PUSH P,["I"]
|
||
MOVEI T1,"["
|
||
JRST ERWM.1
|
||
>
|
||
|
||
INFMSG::PUSH P,T1 ;SAVE INFO MESSAGE
|
||
PUSH P,["I"]
|
||
MOVEI T1,"["
|
||
ERWM.1: CALLSCAN .TCHAR## ;TYPE OUT ?,% OR [
|
||
MOVE T1,CPRGID ;GET 'DTS' OR 'DTR'
|
||
CALLSCAN .TSIXN## ; (ITS IN SIXBIT)
|
||
MOVEI T1,[ASCIZ / --/]
|
||
CALLSCAN .TSTRG##
|
||
POP P,T1 ;POP E,I OR W
|
||
CALLSCAN .TCHAR## ;PRINT THE ERROR-TYPE CHARACTER
|
||
MOVEI T1,[ASCIZ /-- /]
|
||
CALLSCAN .TSTRG##
|
||
POP P,T1
|
||
CALLSCAN .TSTRG##
|
||
ERWM.2: SETOM .FLCBF## ;THERE WAS AN ERROR, CLEAR REST OF LINE
|
||
RET ; WHEN WE NEXT REACH TOP LEVEL
|
||
SUBTTL STYPIN - Special Typeing Routine for SCAN
|
||
|
||
;STYPIN - Called only by SCAN because of argument to .ISCAN call
|
||
;
|
||
;Call: CALL STYPIN
|
||
; Normal Return with char in C
|
||
;
|
||
;Saves all ACs except C
|
||
|
||
;This routine hibers before calling INCHRW so that PSISER will get
|
||
;a chance to interrupt us. The user-mode test bed depends on this.
|
||
|
||
;Here we use SKPINL and INCHRW rather than INCHSL so that
|
||
;MIC will see the INCHWL if the user types a space.
|
||
|
||
STYPIN:
|
||
REPEAT 0,<
|
||
SKPINC ;ANY INPUT YET?
|
||
JRST STYI.1 ;NO, WAIT FOR IT
|
||
JRST STYI.2 ;YES, WAIT FOR A FULL LINE (FOR MIC)
|
||
STYI.1: MOVE C,[EXP HB.RTC ! ^D1000] ;WAKE ON CHARACTER INPUT
|
||
HIBER C, ;GIVE PSI A CHANCE TO INTERRUPT
|
||
JFCL ; THE INCHRW
|
||
SKPINC C ;SEE IF WE REALLY GOT A CHARACTER
|
||
JRST STYI.1 ;NO, FALSEHOOD AND LIES FROM PSISER
|
||
> ;END REPEAT 0
|
||
STYI.2: INCHWL C ;YES, GIVE CHAR TO SCAN
|
||
RET
|
||
|
||
|
||
Comment @
|
||
|
||
Note that this routine will hang in TI state once the
|
||
first character of a line has been typed. This is for
|
||
MIC. The user types a space, then MIC types the rest
|
||
of the line.
|
||
|
||
@
|
||
SUBTTL STYPOU - Output a Char to TTY and/or Log File
|
||
|
||
;STYPOU - Called by SCAN to output a char to the user
|
||
;
|
||
;Call: T1/ The Character
|
||
; CALL STYPOU
|
||
; Normal Return
|
||
|
||
STYPOU::CALL STYPSB ;DO ANY TYPE OUT THAT IS REQUIRED
|
||
CAIN T1,12 ;WAS IT A LINE FEED?
|
||
SETZM ERRPRI ;YES, THAT WAS END OF ERROR LINE
|
||
RET
|
||
|
||
|
||
STYPSB: SAVEAC <T1,T2,T3,T4>
|
||
SKIPE TYPRCS ;SKIP IF NO STYPOU RECURSION
|
||
JRST TYPO.3 ;IF RECURSING, MUST BE TIME STAMPING
|
||
MOVE T2,PRINT ;GET PRINT OPTION FROM USER
|
||
SKIPN ALWPRI ;SET BY STATISTICS PRINTOUT
|
||
CAIN T2,PRI.AL ;PRINT:ALL?
|
||
JRST TYPO.1 ;YES, TELL TTY AND LOG FILE
|
||
CAIN T2,PRI.NO ;PRINT:NONE?
|
||
JRST TYPO.2 ;YES, TELL LOG FILE ONLY
|
||
SKIPN ERRPRI ;MUST BE PRINT:ERROR, PRINTING ERROR?
|
||
JRST TYPO.2 ;NO, TELL LOG FILE ONLY
|
||
;YES, TELL TTY AND LOG FILE
|
||
TYPO.1: OUTCHR T1
|
||
|
||
TYPO.2: SKIPN LOGFLG ;ARE WE LOGGING NOW?
|
||
RET ;NO
|
||
SKIPE TYPBOL ;AT BEG OF LINE?
|
||
CALL TIMSTP ;YES, TIME STAMP THIS LINE
|
||
CAIN T1,12 ;ARE WE STORING A LINE FEED?
|
||
SETOM TYPBOL ;YES, NEXT CHR WILL BE A BEG OF LINE
|
||
TYPO.3: CALL OUTBYT ;YES, PUT THE BYTE OUT TO THE LOG FILE
|
||
RET ;ERROR, ALREADY CLOSED, LOGFLG ZEROED
|
||
RET ;SUCCESS RETURN
|
||
;The TIMSTP subroutine for STYPOU: time stamp a log file
|
||
|
||
|
||
TIMSTP::SAVEAC T1 ;SAVE CHR ABOUT TO BE STORED IN LOG
|
||
|
||
SETOM TYPRCS ;WE ARE RECURSING IN STYPOU
|
||
|
||
CALLSCAN .TDATN## ;TYPE TODAY'S DATE INTO LOG FILE
|
||
CALLSCAN .TSPAC## ;TYPE A SPACE
|
||
CALLSCAN .TTIMN## ;TYPE CURRENT TIME INTO LOG FILE
|
||
CALLSCAN .TTABC## ;TYPE A TAB
|
||
|
||
SETZM TYPRCS ;NO LONGER RECURSING
|
||
SETZM TYPBOL ;NO LONGER AT BEG OF LINE
|
||
RET
|
||
SUBTTL DDT Aid for Logging
|
||
REPEAT 0,<
|
||
;This routine is expected to be called by DDT with CALL LOGIT$X
|
||
;It is meant mostly for DTR, since DTS aleady has the LOG command.
|
||
|
||
LOGIT:: SAVEAC <CX,T1,T2,T3,T4,T5,T6,P1,P2,MB,MS,FREE1,FREE2>
|
||
|
||
MOVX P2,-1 ;-1 MEANS USE THE DEFAULT LOG FILE NAME
|
||
CALL STRLOG
|
||
MOVEM N,LOGFLG
|
||
RET
|
||
> ;END REPEAT 0
|
||
SUBTTL Log File I/O
|
||
|
||
;STRLOG - Start Logging to a Log File
|
||
;
|
||
;Call: CALL STRLOG
|
||
; Normal Return with N set to the value to store in LOGFLG
|
||
;Changes T1,T2,T3,T4
|
||
|
||
STRLOG::SKIPN LOGFLG ;HAVE A LOG FILE OPEN NOW?
|
||
JRST STRL.1 ;NO
|
||
CALL CLSLOG ;YES, CLOSE IT SO WE CAN START ANOTHER
|
||
SETZM LOGSPC ;SMEAR LOGSPC TO ZEROS
|
||
MOVE T1,[LOGSPC,,LOGSPC+1]
|
||
BLT T1,LOGSPC+.FXLEN-1
|
||
|
||
;Return from .FILIN is in T1:
|
||
; T1=0 if nothing typed
|
||
; T1=-1 if file spec typed
|
||
; T1=+1 if nothing but global switches typed
|
||
|
||
STRL.1: JUMPL C,STRL.2 ;DON'T CALL .FILIN IF EOF
|
||
CAIE C,":" ;IS PUNCTUATION A COLON?
|
||
CAIN C,"=" ;OR AN EQUAL?
|
||
CAIA ;YES, GET A FILESPEC
|
||
JRST STRL.2 ;NO, TAKE THE DEFAULTS
|
||
|
||
OUTSTR [ASCIZ /[A log file spec must be the last command on a line]
|
||
/]
|
||
CALLSCAN .FILIN## ;GET THE FILE SPEC FROM THE USER
|
||
|
||
MOVEI T1,LOGSPC ;MOVE THE NEW SPEC TO HERE
|
||
MOVEI T2,.FXLEN ;IT IS THIS LONG
|
||
CALLSCAN .GTSPC## ;...
|
||
|
||
STRL.2: MOVE T1,CPRGID ;DEFAULT TO NAME OF THIS PROGRAM
|
||
SETO T2, ;NON-WILD MASK FOR WILD
|
||
SKIPN LOGSPC+.FXNAM ;USER TYPE A NAME?
|
||
DMOVEM T1,LOGSPC+.FXNAM;NO, FILL IN NAME AND NON-WILD MASK
|
||
|
||
HRLOI T1,'LOG' ;DEFAULT TO .LOG EXTENSION
|
||
SKIPN LOGSPC+.FXEXT ;USER TYPE AN EXT (OR . FOR NULL)?
|
||
MOVEM T1,LOGSPC+.FXEXT;NO, MAKE IT .LOG
|
||
|
||
;Continued on Next Page
|
||
;From Previous Page with SCAN block all defaulted
|
||
|
||
HRRI T1,LOGSPC ;THE SCAN BLOCK,
|
||
HRLI T1,.FXLEN ; AND ITS LENGTH.
|
||
MOVEI T2,LOGFOP+.FOIOS ;OUTPUT RING HDR BLK. (3-WORD)
|
||
HRRI T3,LOGENT ;EXTENDED ENTER BLOCK.
|
||
HRLI T3,LN$ENT ; ITS LENGTH.
|
||
MOVEI T4,LOGPTH ;A PTHLNG-LENGTH-WORD PATH BLK.
|
||
CALLSCAN .STOPB## ;NO-WILD SCAN BLK TO LOOKUP
|
||
JRST STPERR ; BLOCK TRANSLATOR.
|
||
|
||
MOVE T1,[FO.PRV ! <LOGCHN>B17 ! .FOAPP]
|
||
MOVEM T1,LOGFOP+.FOFNC
|
||
MOVEI T1,LN$ENT ;LENGTH OF THE ENTER BLOCK
|
||
MOVEM T1,LOGENT ;STORE AS LENGTH FOR THE FILOP
|
||
MOVEI T1,LOGENT ;PTR TO THE ENTER BLOCK
|
||
MOVEM T1,LOGFOP+.FOLEB
|
||
MOVEI T1,LOGBRH ;GET A BUFFER RING HEADER ADDRESS
|
||
HRLM T1,LOGFOP+.FOBRH ;STORE IN THE FILOP BLOCK
|
||
MOVE T1,[FOPLEN,,LOGFOP]
|
||
FILOP. T1, ;APPEND THE LOG FILE (OR CREATE IT)
|
||
JRST LGEERR ;OPEN ERROR
|
||
|
||
;Start the file with a form feed in case this is an appended file
|
||
|
||
SETOM TYPRCS ;TELL STYPOU THAT WE'RE RECURSING
|
||
MOVEI T1,14 ;A FORM FEED
|
||
CALLSCAN .TCHAR## ;TYPE THE CHAR INTO THE LOG FILE
|
||
CALLSCAN .TCRLF## ;TYPE A CARRIAGE RETURN, LINE FEED
|
||
SETZM TYPRCS ;NO LONGER RECURSING
|
||
|
||
SETOB N,TYPBOL ;WE NOW HAVE A LOG FILE TO WRITE TO
|
||
;RETURN VALUE TO STORE IN LOGFLG
|
||
;SET TYPBOL NON-ZERO TO START TIME-
|
||
RET ; STAMPING
|
||
STPERR: MOVEI T1,[ASCIZ \%Wild cards in log file name not supported\]
|
||
CALL ERRMSG
|
||
MOVEI T1,[ASCIZ \, logging disabled
|
||
\]
|
||
CALL ERRMSG
|
||
JRST LGECOM
|
||
|
||
|
||
LGEERR: MOVEI T1,LOGENT ;ENTER BLOCK
|
||
MOVEI T2,LN$ENT ;LENGTH OF ENTER BLOCK
|
||
MOVEI T3,LOGSPC ;SCAN BLOCK
|
||
SETOM ERRPRI ;ENABLE PRINT:ERROR
|
||
CALLSCAN E.LKEN## ;ERROR ENTERRING LOG FILE
|
||
|
||
|
||
;Common exit for all STRLOG errors: set N to zero.
|
||
;Caller will store N in LOGFLG
|
||
|
||
LGECOM: SETZ N, ;TURN OFF LOGGING
|
||
RET
|
||
;OUTBYT - Output a byte to the log file
|
||
;
|
||
;Call: T1/ The Byte
|
||
; CALL OUTBYT
|
||
; Error Return
|
||
; Normal Return
|
||
;Changes T1,T2,T3,T4
|
||
|
||
OUTBYT:
|
||
OUTB.1: SOSGE LOGBRH+.BFCTR ;LOGBRH = HEADER FOR FILE OUTPUT
|
||
JRST OUTBYN ;NO ROOM, GET A NEW BUFFER
|
||
IDPB T1,LOGBRH+.BFPTR ;THE NORMAL OUTPUT DEPOSIT BYTE.
|
||
AOS (P) ;SUCCESS RETURN
|
||
RET
|
||
|
||
OUTBYN: CALL OUTBUF ;OUTPUT THE BUFFER
|
||
RET ;"DON'T CONTINUE" RETURN
|
||
JRST OUTB.1 ;GOT A BUFFER, GO COUNT IT DOWN
|
||
|
||
|
||
|
||
;CALL CALL OUTBUF
|
||
; "DON'T CONTINUE" RETURN
|
||
; "OK" RETURN
|
||
|
||
OUTBUF: OUT LOGCHN,
|
||
JRST .POPJ1 ;OK RETURN: SUCCESS
|
||
|
||
GETSTS LOGCHN, T1
|
||
PJRST OTIOER ;TELL USER ABOUT I/O ERROR
|
||
;OTIOER - Tell user about output I/O error
|
||
;
|
||
;Call: T1/ GETSTS code
|
||
; CALL OTIOER
|
||
; Normal Return
|
||
|
||
OTIOER: SAVEAC <T1,T2,T3,T4,P1,P2,C,N>;DRASTIC, BUT NOT FREQUENT
|
||
|
||
CALL CLSLOG ;SALVAGE WHAT WE CAN OF THE LOG FILE
|
||
|
||
PUSH P, T1 ;SAVE GETSTS CODE FOR A SEC
|
||
MOVEI T1,[ASCIZ "% Output I/O error, logging stopped"]
|
||
CALLSCAN .TSTRG##
|
||
POP P, T1 ;RESTORE GETSTS CODE
|
||
CALL ERRSTS ;TELL USER ABOUT ERROR
|
||
CALLSCAN .TCRLF##
|
||
RET ;NO, NON-SKIP RETURN
|
||
;CALL T1/ GETSTS code
|
||
; CALL ERRSTS
|
||
; Only return
|
||
|
||
DEFINE ERRMAC (name, text),<
|
||
MOVEI T1,[ASCIZ " name:text"]
|
||
$XLIST
|
||
TXNE T2,name
|
||
CALLSCAN .TSTRG##
|
||
$LIST
|
||
>;END OF DEFINE ERRMAC
|
||
|
||
|
||
|
||
ERRSTS: PUSH P, T1 ;SAVE THE GETSTS CODE
|
||
CALLSCAN .TOCTW## ;PRINT IT IN OCTAL
|
||
|
||
MOVEI T1,[ASCIZ " ("]
|
||
CALLSCAN .TSTRG##
|
||
|
||
POP P,T2 ;RESTORE GETSTS CODE
|
||
|
||
ERRMAC IO.IMP, Software Detected Error
|
||
ERRMAC IO.DER, Device Error
|
||
ERRMAC IO.DTE, Data Error
|
||
ERRMAC IO.BKT, Block Too Large
|
||
|
||
MOVEI T1,[ASCIZ " )"]
|
||
CALLSCAN .TSTRG##
|
||
RET
|
||
SUBTTL STPLOG - Stop Logging to a Log File
|
||
|
||
;STPLOG - Stop Logging to a Log File
|
||
;
|
||
;Call: CALL STPLOG
|
||
; Normal Return with N set to zero for caller to store in LOGFLG
|
||
;Changes T1,T2,T3,T4
|
||
|
||
STPLOG::CALL CLSLOG ;CLOSE ANY LOG FILE THAT MAY HAVE
|
||
; BEEN OPEN.
|
||
SETZB N,LOGFLG ;TELL STYPOU TO STOP LOGGING
|
||
RET ;N GETS STORED IN LOGFLG BY CALLER
|
||
|
||
|
||
|
||
|
||
|
||
|
||
;Close the Log file politely
|
||
|
||
CLSLOG::CLOSE LOGCHN,
|
||
SETZM LOGFLG ;TELL STYPOU NOT TO LOG ANY MORE
|
||
PUSH P,INIFF ;GET THE VALUE OF .JBFF AT STARTUP
|
||
POP P,.JBFF
|
||
SETZM LOGBRH ;NO LONGER HAVE THE BUFFER'S CORE
|
||
SETZM LOGBRH+1
|
||
SETZM LOGBRH+2
|
||
RET
|
||
SUBTTL String Handling Routines
|
||
|
||
;SIX2ST - Convert a sixbit word to a string block
|
||
;
|
||
;Call: T1/ Pointer to a string block big enough for six chars
|
||
; T2/ The SIXBIT word
|
||
; CALL SIX2ST
|
||
; Normal Return
|
||
;
|
||
;Uses T1,T2,T3,T4
|
||
|
||
SIX2ST::SAVEAC <P1,P2>
|
||
MOVSI P1,(POINT 8,)
|
||
HRRI P1,1(T1)
|
||
MOVE P2,[POINT 6,T2]
|
||
MOVEI T4,6 ;UP TO SIX CHARS IN A SIXBIT WORD
|
||
SX2S.1: ILDB T3,P2 ;GET A SIXBIT CHAR
|
||
JUMPE T3,SX2S.2 ;STOP COPYING WHEN WE GET A NULL
|
||
ADDI T3," " ;MAKE IT ASCII
|
||
IDPB T3,P1 ;STORE IN STRING BLOCK
|
||
SOJG T4,SX2S.1 ;LOOP IF WE'VE NOT DONE ALL YET
|
||
SX2S.2: MOVEI T3,6 ;MAX NUMBER WE COULD HAVE MOVED
|
||
SUB T3,T4 ;GET NUMBER WE DID MOVE
|
||
HRLM T3,(T1) ;STORE NUMBER WE DID MOVE IN STRING BLK
|
||
RET
|
||
;PUTxBY - Put a one- or two-byte value into a string block
|
||
;
|
||
;Call: T1/ The value
|
||
; T2/ Pointer to the string block
|
||
; T3/ Number of bytes for PUTNBY, ignored by PUT1BY and PUT2BY
|
||
; CALL PUTxBY
|
||
; Normal Return
|
||
;
|
||
;PUTxBY does NOT change T2, this is required for long sequences
|
||
; of calls to PUTxBY
|
||
|
||
PUT2BY: MOVEI T3,2 ;NUMBER OF BYTES TO PUT
|
||
PUTNBY: JUMPLE T3,.POPJ ;IGNORE IF NO BYTES TO COPY
|
||
CALL PUT1BY ;STORE NEXT LOW-ORDER BYTE
|
||
LSH T1,-^D8 ;SHIFT DOWN
|
||
SOJA T3,PUTNBY ;LOOP UP TO 4 TIMES
|
||
|
||
|
||
PUT1BY::HLRZ T4,(T2) ;GET CURRENT BYTE COUNT FROM STR BLK
|
||
AOS T4 ;INCR COUNT FOR THIS NEW BYTE
|
||
HRLM T4,(T2) ;FINISH UP A LEFT-HALF INCREMENT
|
||
ADJBP T4,[POINT 8,1(T2)] ;BUILD BYTE PTR TO FIRST FREE BYTE
|
||
DPB T1,T4
|
||
RET
|
||
;GETxBY - Get a one- or two-byte value from a string block
|
||
;
|
||
;Call: T1/ The offset of the byte to get (the first is 0)
|
||
; T2/ Pointer to the string block
|
||
; T3/ Number of bytes for GETNBY, ignored by GET1BY and GET2BY
|
||
; CALL GET1BY
|
||
; Error Return with T1 unchanged (for UNSUPT)
|
||
; Normal Return with value in T1
|
||
;
|
||
;GETxBY does NOT change T2, this is required for long sequences
|
||
; of calls to GETxBY
|
||
|
||
GET2BY::MOVEI T3,2 ;NUMBER OF BYTES TO GET
|
||
PJRST GETNBY ;GET THEM
|
||
|
||
GET1BY::MOVEI T3,1 ;NUMBER OF BYTES TO GET
|
||
|
||
GETNBY::SAVEAC T2 ;CALLER EXPECTS THIS FOR MULTIPLE CALLS
|
||
CAILE T3,4 ;MAX WE CAN HANDLE IS 4 BYTES/WORD
|
||
HALT .+1
|
||
MOVE T4,T3 ;GET REQUESTED BYTE COUNT
|
||
ADD T4,T1 ;GET OFFSET OF END OF PROPOSED STRING
|
||
PUSH P,T2
|
||
HLRZ T2,(T2) ;GET COUNT OF BYTES IN STR BLK
|
||
CAMLE T4,T2 ;MUST BE LEAST N MORE BYTES
|
||
JRST [POP P,T2 ;NOPE, ERROR RETURN WITH T1 UNCHANGED
|
||
RET]
|
||
POP P,T2
|
||
MOVE T4,T1 ;GET OFFSET OF BEG OF STRING AGAIN
|
||
ADJBP T4,[POINT 8,1] ;BUILD OFFSET IDLB PTR TO FIRST BYTE
|
||
ADD T4,T2 ;POINT IT INTO THE STRING BLOCK
|
||
PUSH P,T3 ;SAVE COUNT REQUESTED
|
||
GETN.1: ILDB T1,T4 ;GET NEXT HIGHER ORDER BYTE
|
||
LSHC T1,-^D8 ;PUT INTO HIGH BYTE OF T2
|
||
SOJG T3,GETN.1 ;DO ALL REQUESTED BYTES
|
||
POP P,T3 ;HOW MANY WAS THAT?
|
||
ASH T3,3 ;BYTE COUNT * 8 = BIT COUNT
|
||
;WE KNOW T1 IS ZERO NOW
|
||
LSHC T1,(T3) ;RESULT NOW RIGHT JUSTIFIED IN T1
|
||
RETSKP ;SUCCESS RETURN
|
||
;ASC2ST - Convert an ASCII string to a string block
|
||
;
|
||
;Call: T1/ Pointer to a string block big enough
|
||
; T2/ ILDB Byte Pointer to ASCII string
|
||
; CALL ASC2ST
|
||
; Normal Return
|
||
;
|
||
;Uses T1,T2,T3,T4
|
||
|
||
ASC2ST::SAVEAC <P1,P2>
|
||
MOVSI P1,(POINT 8,)
|
||
HRRI P1,1(T1)
|
||
HRRZ T4,(T1) ;LENGTH OF THE STRING BLOCK (WORDS)
|
||
SOJLE T4,CPOPJ ;COUNT INCLUDES COUNT WORD AT BEGINNING
|
||
ASH T4,2 ;MULTIPLY BY 4 TO GET BYTE COUNT
|
||
MOVE P2,T4 ;SAVE COUNT FOR LATER
|
||
AS2S.1: ILDB T3,T2 ;GET A ASCII CHAR
|
||
JUMPE T3,AS2S.2 ;STOP COPYING WHEN WE GET A NULL
|
||
IDPB T3,P1 ;STORE IN STRING BLOCK
|
||
SOJG T4,AS2S.1 ;LOOP IF WE'VE NOT DONE ALL YET
|
||
AS2S.2: SUB P2,T4 ;CALC NUMBER WE DID COPY
|
||
HRLM P2,(T1) ;STORE NUMBER WE MOVED IN STRING BLK
|
||
RET
|
||
;SETQTA - Set SQUEUE or RQUEUE as the link quota
|
||
;
|
||
;Call: T1/ Value of SQUEUE or RQUEUE
|
||
; CALL SETQTA
|
||
; Error Return, message already given
|
||
; Normal Return
|
||
;
|
||
;Uses T1,T2,T3,T4
|
||
|
||
SETQTA::SKIPG T1 ;ZERO OR NEGATIVE IS ILLEGAL
|
||
MOVEI T1,1 ;DEFAULT TO 1 IN, 1 OUT
|
||
IMULI T1,2 ;DOUBLE IT, HALF FOR IN, HALF FOR OUT
|
||
|
||
MOVE NSAA1,T1 ;THE QUOTA
|
||
MOVEI NSAA2,^D50 ;50% INPUT QUOTA
|
||
MOVEI NSAA3,0 ;NO GOAL (YET)
|
||
CALNSP .NSFSQ,NSAA3 ;SET QUOTA FUNCTION CODE
|
||
JRST SETQTE
|
||
RETSKP
|
||
|
||
SETQTE: ERROR <Unable to set buffer quota>,CRLF
|
||
RET
|
||
;.TSTRB - Type out a string block's string
|
||
;
|
||
;Call: T1/ Ptr to string block
|
||
; CALL .TSTRB
|
||
; Normal Return
|
||
;
|
||
;Uses T1,T2,T3,T4
|
||
|
||
.TSTRB::SAVEAC <P1,P2>
|
||
HLRZ P1,(T1) ;GET BYTES IN STRING
|
||
JUMPE P1,CPOPJ ;IGNORE NULL STRING
|
||
MOVEI P2,1(T1)
|
||
HRLI P2,(POINT 8,)
|
||
TSTB.1: ILDB T1,P2 ;LOAD UP AN 8-BIT BYTE
|
||
CALLSCAN .TCHAR## ;TYPE THE LOW-ORDER 7 BIT'S CHARACTER
|
||
SOJG P1,TSTB.1
|
||
RET
|
||
SUBTTL Test String Routines
|
||
|
||
;FILSTD - Fill in a Standard Test String
|
||
;
|
||
;Call: T1/ Pointer to String Block to Fill
|
||
; T2/ Length of String to Fill
|
||
; CALL FILSTD
|
||
; Normal Return
|
||
;
|
||
;Uses T1,T2,T3,T4
|
||
|
||
FILSTD::JUMPLE T2,.POPJ
|
||
HLRZ T4,(T1) ;GET CURRENT BYTE COUNT IN STR BLK
|
||
MOVE T3,T4 ;PREPARE TO UPDATE STRING BLK'S
|
||
ADD T3,T2 ; BYTE COUNT TO TAKE IN NEW STRING
|
||
HRLM T3,(T1) ;STORE NEW COUNT BACK IN STRING BLK
|
||
ADJBP T4,[POINT 8,0] ;BUILD IDPB PTR FOR OFFSET
|
||
ADDI T4,1(T1) ;POINT IT INTO STRING BLOCK
|
||
FILS.1: MOVE T1,STDSPT ;BYTE PTR TO STANDARD STRING
|
||
FILS.2: ILDB T3,T1
|
||
JUMPE T3,FILS.1 ;SOURCE ALL DONE, START OVER
|
||
IDPB T3,T4
|
||
SOJG T2,FILS.2 ;REMAINING LENGTH OF DEST STRING
|
||
RET
|
||
|
||
;CMPSTD - Compare a Standard Test String
|
||
;
|
||
;Call: T1/ Byte Pointer to Target
|
||
; T2/ Length of String to Compare
|
||
; CALL CMPSTD
|
||
; No Match Return
|
||
; Match Return
|
||
;
|
||
;Uses T1,T2,T3,T4
|
||
|
||
CMPSTD::JUMPLE T2,.POPJ1 ;IF NO STRING, IT MATCHES
|
||
SAVEAC P1
|
||
CMPS.1: MOVE T4,STDSPT ;BYTE PTR TO STANDARD STRING
|
||
CMPS.2: ILDB T3,T4 ;GET A STANDARD BYTE
|
||
JUMPE T3,CMPS.1 ;SOURCE ALL DONE, START OVER
|
||
ILDB P1,T1 ;GET A BYTE TO COMPARE
|
||
CAME P1,T3 ;IF NOT EQUAL
|
||
RET ; TAKE NO MATCH RETURN IMMEDIATELY
|
||
SOJG T2,CMPS.2 ;ELSE KEEP COMPARING FOR REST OF
|
||
; STRING PASSED BY USER
|
||
RETSKP ;SUCCESS: MATCHED TO END OF USER STR
|
||
|
||
|
||
STDSPT: POINT 7,STDSTR
|
||
STDSTR: ASCIZ /ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789/
|
||
;CMPSTB - Compare two string blocks
|
||
;
|
||
;Call: T1/ Pointer to first string block
|
||
; T2/ Pointer to second string block
|
||
; CALL CMPSTB
|
||
; No Match Return
|
||
; Match Return
|
||
;
|
||
;Uses T1,T2,T3,T4
|
||
|
||
CMPSTB::SAVEAC <P1,P2>
|
||
HLRZ T3,(T1) ;GET LENGTH OF FIRST BLOCK
|
||
HLRZ P1,(T2) ;GET LENGTH OF SECOND BLOCK
|
||
CAME T3,P1 ;COMPARE THE LENGTHS
|
||
RET ;NO-MATCH IF NOT SAME LENGTH
|
||
HRLI T1,(POINT 8,0,35) ;ILDB POINTER TO (T1)+1
|
||
HRLI T2,(POINT 8,0,35) ;ILDB POINTER TO (T2)+1
|
||
CSTB.1: ILDB P1,T1 ;GET A BYTE OF THE FIRST STRING
|
||
ILDB P2,T2 ;GET A BYTE OR THE SECOND
|
||
CAME P1,P2 ;SAME?
|
||
RET ;NO, NO-MATCH RETURN
|
||
SOJG T3,CSTB.1 ;YES, TRY NEXT IF THERE IS A NEXT
|
||
RETSKP ;ALL DONE, ALL MATCHED
|
||
SUBTTL RSNTXT - Type Out Text for DECnet Reject Reason
|
||
|
||
;RSNTXT - Type Out Text for DECnet Reject Reason
|
||
;
|
||
;Call: T1/ The Reason Code
|
||
; CALL RSNTXT
|
||
; Normal Return
|
||
|
||
|
||
DEFINE RSNMAC(code,text),<
|
||
CAIN T1,code
|
||
MOVEI T2,[ASCIZ |code: text|]
|
||
>
|
||
|
||
RSNTXT::MOVEI T2,0 ;SO WE KNOW IF NO REASON HAS MATCHED
|
||
|
||
RSNMAC RSNDBO,Disconnected/Rejected by Object
|
||
RSNMAC RSNRES,No Resources
|
||
RSNMAC RSNUNN,Unrecognized Node Name
|
||
RSNMAC RSNRNS,Remote Node Shut Down
|
||
RSNMAC RSNURO,Unrecognized Object
|
||
RSNMAC RSNIOF,Invalid Object Name Format
|
||
RSNMAC RSNOTB,Object Too Busy
|
||
RSNMAC RSNABM,Abort by Management
|
||
RSNMAC RSNABO,Abort by Object
|
||
RSNMAC RSNINF,Invalid Node Name Format
|
||
RSNMAC RSNLNS,Local Node Shut Down
|
||
RSNMAC RSNACR,Access Control Rejection
|
||
RSNMAC RSNRNO,No Response from Object
|
||
RSNMAC RSNNUR,Node Unreachable
|
||
RSNMAC RSNNLK,No Link
|
||
RSNMAC RSNDSC,Disconnect Complete
|
||
RSNMAC RSNIMG,Image Field Too Long
|
||
|
||
JUMPE T2,RSNT.1 ;JUMP IF NO MATCH FOUND
|
||
MOVE T1,T2 ;MOVE TO T1 FOR .TSTRG
|
||
CALLSCAN .TSTRG## ;GOT A MATCH, TYPE OUT TEXT
|
||
RET
|
||
|
||
RSNT.1: PUSH P,T1 ;NO MATCH, TYPE OUT CODE IN DECIMAL
|
||
MOVEI T1,[ASCIZ /Unknown reason code: /]
|
||
CALLSCAN .TSTRG##
|
||
POP P,T1
|
||
CALLSCAN .TDECW##
|
||
RET
|
||
SUBTTL Get Unwrapping Time
|
||
|
||
;GETTIM - Get Unwrapping time in Milliseconds
|
||
;
|
||
;Call: CALL GETTIM
|
||
; Normal Return with time in T1
|
||
|
||
|
||
GETTIM::MSTIME T1, ;GET MILLISECONDS SINCE MIDNIGHT
|
||
CAMGE T1,LASTIME ;WRAPPED AROUND?
|
||
ADD T1,[DEC 1000*60*60*24] ;MILLISECS IN A DAY
|
||
MOVEM T1,LASTIME ;STORE FOR NEXT TIME
|
||
RET ;WITH TIME IN T1
|
||
SUBTTL PSTATS - Print Statistics
|
||
|
||
;Called by DTS and by DTR after a DATA or INTERRUPT test.
|
||
|
||
;Call: CALL PSTATS
|
||
; Normal Return
|
||
|
||
|
||
PSTATS::SAVEAC P1
|
||
|
||
CALLSCAN .TCRLF##
|
||
CALLSCAN .TTABC##
|
||
MOVEI T1,[ASCIZ /Test ran for /]
|
||
CALLSCAN .TSTRG##
|
||
MOVE T1,ELPTIM ;GET ELAPSED TIME
|
||
CALLSCAN .TDECW##
|
||
MOVEI T1,[ASCIZ / milliseconds/]
|
||
CALLSCAN .TSTRG##
|
||
CALLSCAN .TCRLF##
|
||
|
||
CALLSCAN .TTABC##
|
||
MOVE T1,MSGSIZ ;GET MESSAGE SIZE
|
||
CALLSCAN .TDECW##
|
||
MOVEI T1,[ASCIZ / bytes per message, /]
|
||
CALLSCAN .TSTRG##
|
||
CALLSCAN .TCRLF##
|
||
|
||
CALLSCAN .TCRLF##
|
||
MOVEI T1,[ASCIZ /Send statistics:/]
|
||
CALLSCAN .TSTRG##
|
||
CALLSCAN .TCRLF##
|
||
MOVE T1,SNDCNT ;LOAD UP # OF MSGS SENT
|
||
MOVE T2,SERRCNT ; AND # OF ERRORS SENDING THEM
|
||
CALL MSGSTS ;TYPE OUT SEND STATS
|
||
|
||
CALLSCAN .TCRLF##
|
||
MOVEI T1,[ASCIZ /Receive statistics:/]
|
||
CALLSCAN .TSTRG##
|
||
CALLSCAN .TCRLF##
|
||
MOVE T1,RCVCNT ;LOAD UP # OF MSGS RECEIVED
|
||
MOVE T2,RERRCNT ; AND # OF ERRORS RECEIVING THEM
|
||
CALL MSGSTS ;TYPE OUT SEND STATS
|
||
|
||
CALLSCAN .TCRLF## ;AN EXTRA CRLF
|
||
RET
|
||
;Subroutine to type out received or sent stats
|
||
|
||
;Call: T1/ SNDCNT or RCVCNT
|
||
; T2/ SERRCNT or RERRCNT
|
||
;Return:
|
||
; Non-skip only
|
||
|
||
MSGSTS: SAVEAC <P1,P2>
|
||
DMOVE P1,T1 ;P1/ Message Count, P2/ Error Count
|
||
CALLSCAN .TTABC##
|
||
MOVE T1,P1 ;MESSAGE COUNT
|
||
CALLSCAN .TDECW##
|
||
MOVEI T1,[ASCIZ / messages (/]
|
||
CALLSCAN .TSTRG##
|
||
MOVE T1,P2 ;NUMBER OF ERRORS
|
||
CALLSCAN .TDECW##
|
||
MOVEI T1,[ASCIZ / errors), /]
|
||
CALLSCAN .TSTRG##
|
||
|
||
MOVX T1,^D1000 ;MILLISECONDS
|
||
IMUL T1,P1 ;GET # OF MSGS
|
||
IDIV T1,ELPTIM ;MAKE MSGS/SECOND OF ELAPSED TIME
|
||
PUSH P,T2 ;SAVE REMAINDER
|
||
CALLSCAN .TDECW## ;PRINT WHOLE-NUMBER PART
|
||
MOVEI T1,"." ;GET A DECIMAL POINT
|
||
CALLSCAN .TCHAR## ;PRINT IT
|
||
POP P,T1 ;GET REMAINDER BACK AGAIN
|
||
IMULI T1,^D100 ;MAKE IT HUNDREDTHS
|
||
IDIV T1,ELPTIM ;CHANGE REMAINDER TO HUNDREDTHS
|
||
MOVEI T2,"0" ;FILL WITH ZERO
|
||
CALLSCAN .TDEC2## ;TYPE 2-DIGIT REMAINDER WITH LEFT FILLER
|
||
MOVEI T1,[ASCIZ \ messages/second\]
|
||
CALLSCAN .TSTRG##
|
||
CALLSCAN .TCRLF##
|
||
|
||
JUMPE P1,CPOPJ ;LEAVE NOW IF NO MESSAGES COUNTED
|
||
|
||
;Characters per second and effective baud rate
|
||
|
||
CALLSCAN .TTABC##
|
||
MOVE T1,P1 ;NUMBER OF MESSAGES
|
||
IMUL T1,MSGSIZ ;TIMES THE MESSAGE SIZE = CHARS SENT
|
||
IMULI T1,^D1000 ;SET TO DIVIDE BY MILLISECONDS
|
||
IDIV T1,ELPTIM ;DIVIDE BY MILLISECONDS ELAPSED
|
||
MOVEI P2,^D8 ;MULTIPLY BY 8 FOR BITS/SEC ("BAUD")
|
||
IMUL P2,T1 ;SAVE EFFECTIVE BAUD RATE
|
||
CALLSCAN .TDECW## ;TYPE CHARS/SECOND
|
||
MOVEI T1,[ASCIZ \ characters/second\]
|
||
CALLSCAN .TSTRG##
|
||
CALLSCAN .TCRLF##
|
||
|
||
CALLSCAN .TTABC## ;TYPE A TAB
|
||
MOVE T1,P2 ;P2 NOW HAS EFFECTIVE BAUD RATE
|
||
CALLSCAN .TDECW## ;TYPE OUT EFFECTIVE "BAUD" RATE
|
||
MOVEI T1,[ASCIZ \ effective baud rate = 8 * chars/sec\]
|
||
CALLSCAN .TSTRG##
|
||
CALLSCAN .TCRLF##
|
||
|
||
;Line efficiency if user declared an ideal baud rate
|
||
SKIPG BAUD ;GET USER-DECLARED BAUD RATE
|
||
RET ;NO BAUD RATE, NO MORE TO SAY
|
||
|
||
CALLSCAN .TTABC## ;TYPE A TAB
|
||
MOVE T1,P2 ;GET EFFECTIVE BAUD RATE AGAIN
|
||
IMULI T1,^D100 ;MAKE IT A PERCENT
|
||
IDIV T1,BAUD ;ACTUAL/THEORETICAL RATE = EFFICIENCY
|
||
CALLSCAN .TDECW## ;TYPE CHARS/SECOND
|
||
MOVEI T1,[ASCIZ /% line efficiency on a /]
|
||
CALLSCAN .TSTRG##
|
||
MOVE T1,BAUD ;GET USER-DECLARED BAUD RATE
|
||
CALLSCAN .TDECW## ;TYPE USER-DECLARED IDEAL BAUD RATE
|
||
MOVEI T1,[ASCIZ / baud line/]
|
||
CALLSCAN .TSTRG##
|
||
CALLSCAN .TCRLF##
|
||
RET ;ONLY RETURN
|
||
SUBTTL Utility Routines
|
||
|
||
G:: PUSH P,.JBOPC ;RETURN FROM DDT
|
||
POPJ P, ; WITHOUT TRASHING ACS
|
||
|
||
IFN FTEXTRA, OPDEF LL [CALL USLINK] ;FOR LL$X IN DDT
|
||
SUBTTL USLINK - Type out the Port Block for a Link
|
||
|
||
IFN FTEXTRA,<
|
||
|
||
;This routine is expected to be called via the LINK command
|
||
;to DTS or by the CALL USLINK$X command to DDT, hence the huge
|
||
;SAVEAC call.
|
||
|
||
|
||
USLINK: SAVEAC <CX,T1,T2,T3,T4,T5,T6,P1,P2,N,C,MB,MS,FREE1,FREE2>
|
||
PROMPT <Link Number: >
|
||
REDLIN .DECNW## ;GET DECIMAL NUMBER
|
||
MOVE T1,N ;GET REQUESTED LINK NUMBER
|
||
|
||
LOAD P1,QHBEG,+NSPAPQ## ;GET HEAD OF NSP'S ALL PORTS QUEUE
|
||
USLNK1: JUMPE P1,USNOLINK ;TELL USER HE'S ASKED FOR BUM LINK
|
||
OPSTR <CAMN T1,>,NPLLA,(P1) ;COMPARE WITH LOCAL LINK ADDRESS
|
||
JRST USLNK2 ;MATCH!
|
||
LOAD P1,NPAPQ,(P1) ;NO MATCH, GET NEXT PORT BLOCK
|
||
JRST USLNK1 ;CHECK THIS NEXT ONE
|
||
|
||
USNOLINK:
|
||
PROMPT <No such link address>
|
||
CALLSCAN .TCRLF
|
||
RET
|
||
|
||
>;END OF IFN FTEXTRA
|
||
IFN FTEXTRA,<
|
||
|
||
EXTERN .TOCTW,.TXWDW,.TDECW,.TCHAR,.TCRLF,.TTABC
|
||
|
||
|
||
DEFINE TYPLNK(heading,symbol,typout,offset,text),<
|
||
PROMPT <heading: >
|
||
LOAD T1,symbol,+offset(P1)
|
||
IFIDN <typout>,<OCT>,< CALLSCAN TYPOCT>
|
||
IFDIF <typout>,<OCT>,< CALLSCAN .TDECW
|
||
MOVEI T1,"."
|
||
CALLSCAN .TCHAR
|
||
>
|
||
CALLSCAN .TTABC
|
||
PROMPT(<;text>)
|
||
CALLSCAN .TCRLF
|
||
>
|
||
|
||
DEFINE TYPLNQ(heading,symbol,offset,text),<
|
||
TYPLNK heading+QHBEG,QHBEG,OCT,$'symbol+offset,<BEG PTR TO text>
|
||
TYPLNK heading+QHEND,QHEND,OCT,$'symbol+offset,<END PTR TO text>
|
||
TYPLNK heading+QHMAX,QHMAX,OCT,$'symbol+offset,<MAX COUNT OF text>
|
||
TYPLNK heading+QHCNT,QHCNT,OCT,$'symbol+offset,<CUR COUNT OF text>
|
||
>
|
||
|
||
TYPOCT: TLNN T1,-1 ;ANYTHING IN THE LEFT HALF?
|
||
CALLRET .TOCTW ;NO, TYPE OUT SIGNED OCTAL (SINGLE #)
|
||
CALLRET .TXWDW ;YES, TYPE OUT 2 HALF-WORDS
|
||
|
||
>;END OF IFN FTEXTRA
|
||
IFN FTEXTRA,<
|
||
|
||
USLNK2:
|
||
|
||
TYPLNK NPAPQ,NPAPQ,OCT,0,<NEXT IN Q OF ALL PORT BLOCKS>
|
||
TYPLNK NPHBQ,NPHBQ,OCT,0,<NEXT IN Q OF PORTS IN A HASH BUCKET>
|
||
TYPLNK NPJFQ,NPJFQ,OCT,0,<NEXT IN Q OF PORTS NEEDING JIFFY SERVICE>
|
||
TYPLNK NPSNC,NPSNC,OCT,0,<SET IF NOT YET TOLD SC ABOUT NO CONF>
|
||
TYPLNK NPCNF,NPCNF,OCT,0,<SET IF WE HAVE CONFIDENCE IN LINK>
|
||
TYPLNK NPSCM,NPSCM,OCT,0,<SEND CONNECT MESSAGE NEXT JIFFY>
|
||
TYPLNK NPABO,NPABO,OCT,0,<ABORTING THIS LOGICAL LINK>
|
||
TYPLNK NPOJQ,NPOJQ,OCT,0,<PORT IS ON THE JIFFY-REQUEST QUEUE>
|
||
TYPLNK NPSTA,NPSTA,DEC,0,<NSP STATE OF THIS PORT>
|
||
TYPLNK NPVER,NPVER,DEC,0,<VERSION OF REMOTE NSP, 0=VER3.2,1=VER3.1>
|
||
TYPLNK NPSIZ,NPSIZ,DEC,0,<MAX SIZE OF A SEGMENT ON THIS LINK>
|
||
TYPLNK NPLLA,NPLLA,DEC,0,<LOCAL LINK ADDRESS>
|
||
TYPLNK NPRLA,NPRLA,DEC,0,<REMOTE LINK ADDRESS>
|
||
TYPLNK NPOTC,NPOTC,DEC,0,<COUNT OF MSGS OUT IN TRANSPORT>
|
||
TYPLNK NPDSG,NPDSG,DEC,0,<MSG SEGMENT BEING TIMED FOR DELAY CALC>
|
||
TYPLNK NPDTM,NPDTM,DEC,0,< AND TIME IT WAS FIRST SENT>
|
||
TYPLNK NPNNM,NPNNM,OCT,0,<THE REMOTE'S NODE NUMBER>
|
||
TYPLNK NPNDB,NPNDB,OCT,0,<PTR TO NSP NODE BLOCK>
|
||
TYPLNK NPTMA,NPTMA,DEC,0,<INACTIVITY TIMER>
|
||
TYPLNK NPSCV,NPSCV,OCT,0,<SCTL CALL VECTOR BASE ADDRESS>
|
||
TYPLNK NPSCB,NPSCB,OCT,0,<SESSION CONTROL BLOCK ID>
|
||
TYPLNK NPDIM,NPDIM,OCT,0,<PTR TO DI MESSAGE>
|
||
CALLSCAN .TCRLF
|
||
PROMPT <The normal sublink block>
|
||
CALLSCAN .TCRLF
|
||
TYPLNK NSOTH,NSOTH,OCT,NP.NSL,<SET IF THIS IS OTHER SUBLINK>
|
||
TYPLNK NSACK,NSACK,OCT,NP.NSL,<SEND ACK FOR THIS SUBLINK NEXT JIFFY>
|
||
TYPLNK NSROF,NSROF,OCT,NP.NSL,<RECEIVE IS OFF>
|
||
TYPLNK NSROC,NSROC,OCT,NP.NSL,<RECEIVE OFF HAS CHANGED>
|
||
TYPLNK NSXOF,NSXOF,OCT,NP.NSL,<XMIT IS OFF>
|
||
TYPLNK NSXOC,NSXOC,OCT,NP.NSL,<XMIT OFF HAS CHANGED>
|
||
TYPLNK NSRFL,NSRFL,DEC,NP.NSL,<RECEIVE FLOW CONTROL TYPE>
|
||
TYPLNK NSXFL,NSXFL,DEC,NP.NSL,<XMIT FLOW CONTROL TYPE>
|
||
TYPLNK NSGOL,NSGOL,DEC,NP.NSL,<DATA REQUEST GOAL>
|
||
TYPLNK NSCGL,NSCGL,DEC,NP.NSL,<AFTER-CONGESTION RECOVERY GOAL>
|
||
TYPLNK NSXLD,NSXLD,DEC,NP.NSL,<XMIT DRQS OUTSTANDING TO LOCAL SC>
|
||
TYPLNK NSXRD,NSXRD,DEC,NP.NSL,<XMIT DRQS OUTSTANDING TO REMOTE NSP>
|
||
TYPLNK NSXSD,NSXSD,DEC,NP.NSL,<XMIT DRQS NEED TO SEND TO SC>
|
||
TYPLNK NSRLD,NSRLD,DEC,NP.NSL,<RECEIVE DRQS OUTSTANDING TO LOCAL SC>
|
||
TYPLNK NSRRD,NSRRD,DEC,NP.NSL,<RECEIVE DRQS OUTSTANDING TO REMOTE NSP>
|
||
TYPLNK NSRSD,NSRSD,DEC,NP.NSL,<RECEIVE DRQS NEED TO SEND TO SC>
|
||
TYPLNK NSLMA,NSLMA,OCT,NP.NSL,<LAST MESSAGE NUMBER ASSIGNED>
|
||
TYPLNK NSLAR,NSLAR,OCT,NP.NSL,<LAST ACK RECEIVED (AND PROCESSED)>
|
||
TYPLNK NSLMR,NSLMR,OCT,NP.NSL,<LAST MESSAGE RECEIVED>
|
||
TYPLNQ NSAKQ,NSAKQ,NP.NSL,<TO-BE-ACKED Q>
|
||
TYPLNQ NSRCQ,NSRCQ,NP.NSL,<RECEIVE Q>
|
||
TYPLNQ NSXMQ,NSXMQ,NP.NSL,<XMIT Q>
|
||
CALLSCAN .TCRLF
|
||
PROMPT <The other sublink block>
|
||
CALLSCAN .TCRLF
|
||
TYPLNK NSOTH,NSOTH,OCT,NP.OSL,<SET IF THIS IS OTHER SUBLINK>
|
||
TYPLNK NSACK,NSACK,OCT,NP.OSL,<SEND ACK FOR THIS SUBLINK NEXT JIFFY>
|
||
TYPLNK NSROF,NSROF,OCT,NP.OSL,<RECEIVE IS OFF>
|
||
TYPLNK NSROC,NSROC,OCT,NP.OSL,<RECEIVE OFF HAS CHANGED>
|
||
TYPLNK NSXOF,NSXOF,OCT,NP.OSL,<XMIT IS OFF>
|
||
TYPLNK NSXOC,NSXOC,OCT,NP.OSL,<XMIT OFF HAS CHANGED>
|
||
TYPLNK NSRFL,NSRFL,DEC,NP.OSL,<RECEIVE FLOW CONTROL TYPE>
|
||
TYPLNK NSXFL,NSXFL,DEC,NP.OSL,<XMIT FLOW CONTROL TYPE>
|
||
TYPLNK NSGOL,NSGOL,DEC,NP.OSL,<DATA REQUEST GOAL>
|
||
TYPLNK NSCGL,NSCGL,DEC,NP.OSL,<AFTER-CONGESTION RECOVERY GOAL>
|
||
TYPLNK NSXLD,NSXLD,DEC,NP.OSL,<XMIT DRQS OUTSTANDING TO LOCAL SC>
|
||
TYPLNK NSXRD,NSXRD,DEC,NP.OSL,<XMIT DRQS OUTSTANDING TO REMOTE NSP>
|
||
TYPLNK NSXSD,NSXSD,DEC,NP.OSL,<XMIT DRQS NEED TO SEND TO SC>
|
||
TYPLNK NSRLD,NSRLD,DEC,NP.OSL,<RECEIVE DRQS OUTSTANDING TO LOCAL SC>
|
||
TYPLNK NSRRD,NSRRD,DEC,NP.OSL,<RECEIVE DRQS OUTSTANDING TO REMOTE NSP>
|
||
TYPLNK NSRSD,NSRSD,DEC,NP.OSL,<RECEIVE DRQS NEED TO SEND TO SC>
|
||
TYPLNK NSLMA,NSLMA,OCT,NP.OSL,<LAST MESSAGE NUMBER ASSIGNED>
|
||
TYPLNK NSLAR,NSLAR,OCT,NP.OSL,<LAST ACK RECEIVED (AND PROCESSED)>
|
||
TYPLNK NSLMR,NSLMR,OCT,NP.OSL,<LAST MESSAGE RECEIVED>
|
||
TYPLNQ NSAKQ,NSAKQ,NP.OSL,<TO-BE-ACKED Q>
|
||
TYPLNQ NSRCQ,NSRCQ,NP.OSL,<RECEIVE Q>
|
||
TYPLNQ NSXMQ,NSXMQ,NP.OSL,<XMIT Q>
|
||
CALLSCAN .TCRLF
|
||
TYPLNK NPCHK,NPCHK,OCT,0,<ADDRESS OF THIS PB, FOR ADDR CHECK>
|
||
|
||
RET
|
||
|
||
>;END OF IFN FTEXTRA
|
||
SUBTTL End of Library
|
||
|
||
END
|