Trailing-Edge
-
PDP-10 Archives
-
BB-JR93N-BB_1990
-
10,7/mon/llmop.mac
There are 26 other files named llmop.mac in the archive. Click here to see a list.
;TITLE LLMOP - Low Level Maintenance OPeration Layer of Phase IV DECnet V012
; By D. C. Gunn 29 NOV 90
SUBTTL Module Header
SEARCH D36PAR,MACSYM
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED
; OR COPIED ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;
;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1985,1986,1988,1990.
;ALL RIGHTS RESERVED.
; FUTURE ENHANCEMENT LOG
; 1. Change to use D36COM queue routines
; 2. Change buffer posting algorithm to account for responses to requests.
; 3. Fix D36SYM AC purge definition problem.
; 4. Add system time field to System Id message.
; 5. Move $BUILD macro and friends to MACSYM.
; DATE LOAD EDIT #
; ---- ---- ------
;
LLMOP==:1+^D1458 ;Insert file M61A:UID.TXT here
ENTRY LLMINI ;The entry point
; see procedures for calling sequence
SALL
IFN FTOPS20,<
SEARCH PROLOG,MONSYM,NIPAR
TTITLE (LLMOP,,< - Low Level Maintenance OPeration Layer of Phase IV DECnet>)
>
IFN FTOPS10,<
SEARCH F,S,LLMPRM,ETHPRM
.CPYRT<1985,1990>
$RELOC
$HIGH
TITLE LLMOP - Low Level Maintenance Operation Layer
>
D36SYM
RESCD
;This module implements the Low Level Maintenance Operation (LLMOP)
;portion of the Network Management layer (NML) of Phase IV DECnet. It
;is the system independent MOP service for the Ethernet. Below LLMOP
;is the Data Link layer, which handles access to the NI Ethernet
;communications medium.. Above NML is the Application layer, in which
;the user of this service resides.
SUBTTL Special Definitions for TOPS10/TOPS20 Compatibility
DEFINE JSUERR(JSE,UUE),<
IFN FTOPS20,<RETBAD (JSE)>
IFN FTOPS10,<RETBAD (UUE)>
>; END DEFINE JSUERR
IFN FTOPS10,<
EXTERN RTN ;COMMON SUBROUTINE RETURN (CPOPJ)
EXTERN LLMACT ;IDENTIFY SELF TIMER WORD
Q1==T5
Q2==T6
Q3==FREE1
OPDEF NOP [TRN]
DEFINE RESCD <$HIGH>
DEFINE SWAPCD <$HIGH>
DEFINE EA.ENT <SE1ENT>
DEFINE MCENT <> ;DON'T NEED THESE IN TOPS10
DEFINE NOSKED <>
DEFINE OKSKED <>
DEFINE SAVEPQ <SAVEAC <P1,P2,P3,P4,Q1,Q2,Q3>>
DEFINE RETBAD(COD),<
IFNB <COD>,<RETBD1 \COD>
IFB <COD>,<POPJ P,>
>; END DEFINE RETBAD
DEFINE RETBD1(COD),<
IFLE <COD+1-ECDMAX>,<JRST ECDX'COD##>
IFG <COD+1-ECDMAX>,<JRST [MOVEI T1,COD
MOVS M,.USMUO
JRST STOTAC##]>
>; END DEFINE RETBD1
DEFINE DEFAC (NEW,OLD) <
IF1,<
NEW=OLD
PURGE OLD>>
XCDSEC==MS.HGH ;USED FOR TOPS20 SECTION CALLING
;THE FOLLOWONG IS USED IN PLACE OF THE LOAD AND STOR MACROS WHEN
;PREVIOUS CONTEXT IS TO BE REFERENCED. LOAD AND STOR CANNOT
;BE USED DIRECTLY UNDER XCTU BECAUSE THEY MAY ASSEMBLE BYTE
;INSTRUCTIONS WHICH REQUIRE DIFFERENT XCT BITS.
DEFINE ULOAD (AC,STR,Y)<
..STR0 (..ULDB,AC,STR,Y)>
DEFINE ..ULDB (AC,LOC,MSK)<
..TSIZ (..PST,MSK)
.CASE ..PST,<<
XCTU [MOVE AC,LOC]>,<
XCTU [HRRZ AC,LOC]>,<
XCTU [HLRZ AC,LOC]>,<
XCTBMU[LDB AC,[POINTR (LOC,MSK)]]>>>
DEFINE USTOR (AC,STR,Y)<
..STR0 (..UDPB,AC,STR,Y)>
DEFINE ..UDPB (AC,LOC,MSK)<
..TSIZ (..PST,MSK)
.CASE ..PST,<<
XCTU [MOVEM AC,LOC]>,<
XCTU [HRRM AC,LOC]>,<
XCTU [HRLM AC,LOC]>,<
XCTBMU[DPB AC,[POINTR (LOC,MSK)]]>>>
>; END IFN FTOPS10
SUBTTL Table of Contents
SUBTTL Symbol Definitions -- Register Definitions
;Registers T1 through T6 and P1 through P2 are defined in D36PAR for
;all of DECnet-36. Register P4 is redefined as MS for
;the DNxyBY routines in D36COM. Register MB is defined in D36PAR for
;NSP and Router only. The registers defined below are additions
;used in LLMOP only. The registers FREEn are defined in D36PAR to be
;registers not otherwise used in DECnet-36.
MS=MS ;THESE ARE DEFINED AS .NODDT GLOBALS
CX=CX ; IN THE UNIVERSAL, CHANGE THAT HERE
DEFAC (WK,Q1) ;Define a preserved general purpose work AC
DEFAC (FX,Q3) ;Define fork index pointer
DEFAC (LM,FREE1) ;Preserved global
DEFAC (RB,FREE2)
DEFAC (SB,P1)
DEFAC (UN,P2)
SUBTTL Symbol Definitions -- Macros $BUILD,$SET,$EOB
;Following page is from GLXMAC...
; - Build pre-formed data blocks
;Many components have a need to build simple and complex blocks which
; contain pre-formatted data, such as FOBs,IBs and other blocks
; which are made up of several words, each containing from 1 to several
; fields. Since data structures change, these blocks should not be
; just created using EXP or whatever. These macros will take values
; and install them in the right field and word of a structure.
; Start off a structure, argument is the size of the structure.
DEFINE $BUILD(SIZE)<
IFDEF ..BSIZ,<PRINTX ?Missing $EOB after a $BUILD>
..BSIZ==0 ;;START COUNTER
..BLOC==. ;;REMEMBER OUR STARTING ADDRESS
REPEAT SIZE,< ;;FOR EACH WORD IN THE BLOCK
BLD0.(\..BSIZ,0) ;;ZERO OUT IT'S ACCUMULATOR
..BSIZ==..BSIZ+1> ;;AND STEP TO NEXT
>;END OF $BUILD DEFINITION
; For each value installed somewhere in the structure, set it into the block
; Arguments are word offset,field in word (optional) and value to set.
DEFINE $SET(STR,VALUE,OFFSET),<
IFNDEF ..BSIZ,<PRINTX ?$SET without previous $BUILD>
IFNB <STR>,<
IFB <OFFSET>,<..STR0 (..SET,<VALUE>,STR)>
IFNB <OFFSET>,<..STR0 (..SET,<VALUE>,STR,OFFSET)>>
IFB <STR>,<
IFB <OFFSET>,<..STR0 (..SET,<VALUE>,FWMASK)>
IFNB <OFFSET>,<..STR0 (..SET,<VALUE>,FWMASK,OFFSET)>>
> ; END OF $SET DEFINITION
DEFINE ..SET (VALUE,LOC,MSK) <
IFGE <<<LOC>&777777>-..BSIZ>,<
PRINTX ?WORD offset greater than $BUILD size parameter>
SET0. (\<LOC>,MSK,<VALUE>)
> ;END ..SET DEFINITION
; After all values are declared, the block must be closed to do its actual
; creation.
DEFINE $EOB,<
IFNDEF ..BSIZ,<PRINTX ?$EOB without previous $BUILD>
IFN <.-..BLOC>,<PRINTX ?Address change between $BUILD and $EOB>
LSTOF. ;;DON'T SHOW THE BLOCK
..T==0
REPEAT ..BSIZ,<
BLD0.(\..T,1) ;;STORE EACH WORD
..T==..T+1 >
PURGE ..BSIZ,..T,..BLOC ;;REMOVE SYMBOLS
LSTON.
>; END OF $EOB DEFINITION
DEFINE BLD0.(N,WHAT),<
IFE WHAT,<..T'N==0>
IFN WHAT,<EXP ..T'N
PURGE ..T'N>
> ;END OF BLD0. DEFINITION
DEFINE SET0.(LOC,MSK,VALUE),<
IFN <<..T'LOC>&MSK>,<PRINTX ?Initial field not zero in $SET>
..TVAL==<VALUE>
..TMSK==<MSK>
..T'LOC==..T'LOC!<FLD(..TVAL,..TMSK)>
PURGE ..TVAL,..TMSK
>;END OF SET0. DEFINITION
SUBTTL Symbol Definitions -- Macros LSTIN.,LSTOF.
;Other Miscellaneous GLXMAC def's
;Macros to turn on and off listings with nesting and level control
; LSTOF. ;TURNS OFF LISTINGS ONLY
; LSTOF. XCREF ;TURNS OFF LISTINGS AND CREF
; LSTON. ;RESTORES LISTINGS AND CREF AT TOP LEVEL
;IF LSTIN. IS DEFINED AS .MINFI THEN ALL LISTINGS ARE ON
DEFINE LSTOF.(FOO),<
IFNDEF LSTIN.,LSTIN.==0 ;;INITIALIZE LEVEL COUNTER
IFE LSTIN.,<
IFIDN <XCREF><FOO>,<.XCREF> ;;CONDITIONALLY SUPPRESS CREF
XLIST> ;;TURN OFF LISTINGS
LSTIN.==LSTIN.+1> ;;BUMP LIST LEVEL
DEFINE LSTON.,<
IFG LSTIN.,LSTIN.==LSTIN.-1 ;;DECR LIST LEVEL
IFLE LSTIN.,<.CREF ;;RESUME CREFS
LIST>> ;;RESUME LISTS
SUBTTL Symbol Definitions -- Macros INCRF and DECRF
DEFINE INCRF (STR,Y),<
..STR1 (..INC1,,<STR>,<Y>)>
DEFINE ..INC1 (AC,LOC,MSK),<
..TSIZ (..PST,MSK) ;;SET ..PST TO CASE NUMBER
.CASE ..PST,<<
JSP .SAC,[AOSG LOC ;;FULLWORD CASE
SOS LOC
JRST (.SAC)]>,<
JSP .SAC,[HRRE AC,LOC ;;RIGHT HALFWORD CASE
AOSLE AC
HRRM AC,LOC
JRST (.SAC)]>,<
JSP .SAC,[HLRE AC,LOC ;;LEFT HALFWORD CASE
SOSL AC
HRLM AC,LOC
JRST (.SAC)]>,<
JSP .SAC,[LDB AC,[POINTR (<LOC>,MSK)]
..MSK==MASK.(WID(MSK),35)
TXNE AC,LFTBT.(..MSK) ;;TEST SIGN BIT OF BYTE
TXO AC,^-..MSK ;;NEG, ALL 1S IN REST
PURGE ..MSK
SOSL AC
DPB AC,[POINTR (<LOC>),MSK)]
JRST (.SAC)]>>>
DEFINE DECRF (STR,Y),<
..STR1 (..DEC1,,<STR>,<Y>)>
DEFINE ..DEC1 (AC,LOC,MSK),<
..TSIZ (..PST,MSK) ;;SET ..PST TO CASE NUMBER
.CASE ..PST,<<
JSP .SAC,[SOSGE LOC ;;FULLWORD CASE
AOS LOC
JRST (.SAC)]>,<
JSP .SAC,[HRRE AC,LOC ;;RIGHT HALFWORD CASE
SOSL AC
HRRM AC,LOC
JRST (.SAC)]>,<
JSP .SAC,[HLRE AC,LOC ;;LEFT HALFWORD CASE
SOSL AC
HRLM AC,LOC
JRST (.SAC)]>,<
JSP .SAC,[LDB AC,[POINTR (<LOC>,MSK)]
..MSK==MASK.(WID(MSK),35)
TXNE AC,LFTBT.(..MSK) ;;TEST SIGN BIT OF BYTE
TXO AC,^-..MSK ;;NEG, ALL 1S IN REST
PURGE ..MSK
SOSL AC
DPB AC,[POINTR (<LOC>),MSK)]
JRST (.SAC)]>>>
SUBTTL Symbol Definitions -- Macros MIN.,MAX.,MAXENT
;
; Macro MIN. (symbol,list) - Assigns minimum arithmetic value of list of items.
;
DEFINE MIN. (SYM,LIST),
<IRP LIST,<..X==LIST ;;Assign first value in list
STOPI>
IRP LIST,<IFL <LIST-..X>,<..X==LIST>> ;;Assign lowest in list
SYM==:..X> ;;Generate value
;
; Macro MAX. (symbol,list) - Assigns maximum arithmetic value of list of items.
;
DEFINE MAX. (SYM,LIST),
<IRP LIST,<..X==LIST ;;Assign first value in list
STOPI>
IRP LIST,<IFG <LIST-..X>,<..X==LIST>> ;;Assign highest in list
SYM==:..X> ;;Generate value
DEFINE MAKENT (TABLE,CODE,ROUTINE) <
.ORG <TABLE+CODE>
IFIW ROUTINE
.ORG>
SUBTTL Data Structure Definitions -- Request Block (RB)
;Low Level MOP Request Block
BEGSTR RB ;Common header portion of RB
WORD FWD ;List chain pointer to next RB
WORD STT ;Request State
FIELD FLG,^D18 ;Flags
BIT FTI ; Transmit Request Initiated
BIT FTC ; Transmit Request Complete
BIT FTF ; Transmit Request Failed
BIT FRC ; Receive Response Complete
BIT FRF ; Receive Response Failed
BIT ABT ; Abort this request
IFN FTOPS10,<
BIT EVW ; Job in event wait for this RB
>; END IFN FTOPS10
IFN FTOPS20,<
FIELD AIC,^D1 ;Assign Interrupt Channel
FILLER ^D10
FIELD ICH,^D6 ;Interrupt Channel Number (0 to 35)
>; END IFN FTOPS20
WORD RNO ;Receipt Number
WORD CID ;Channel Id
WORD DST,2 ;Destination Address
WORD MSO ;MSD Address for Output
WORD MSI ;MSD Address for Input
IFN FTOPS20,<
WORD FRK ;Fork Number
WORD JOB ;Job Number
>; END IFN FTOPS20
IFN FTOPS10,<
WORD JCH ;Job-Context Number
>; END IFN FTOPS10
ENDSTR
RBL.LN==:RB.LEN ;Save length of RB header
;Request (RB) State Definitions
.RQINV==:-1 ;Request state invalid
.RQPND==:.LMPND ;Request pending
.RQCMP==:.LMSUC ;Request complete
.RQCCE==:.LMCCE ;Channel Communication Error
;Loopback portion of Request Block
BEGSTR LB,RB.LST ;Message Block for Loopback
WORD AAD ;Assistant Address
WORD ALV ;Assistance Level
ENDSTR
;Loopback LLMOP Header MSD
LHH.LN==^D<2+3*<2+6>+2+2+2> ;(32) Header Length in bytes
BEGSTR LH,LB.LST ;MSD for header
WORD IDD ;***** ID word to hack for Transmit Complete
WORD MSD,MD.LEN
WORD DAT,<<LHH.LN+3>/4> ;Room for Largest Loopback header (Full Assist)
ENDSTR
;Loopback Data Area, Data Buffer supplied by User
BEGSTR LD,LH.LST ;Loopback Data Output MSD
WORD MSD,MD.LEN
ENDSTR
;Remote Console LLMOP Header MSD
MAX. (RCH.LN,<<^D1+^D8+^D1+^D1+^D18+^D18>,<^D4>,<^D3>,<^D9>,1,2>)
BEGSTR CH,RB.LST ;MSD for header
WORD IDD ;***** ID word to hack for Transmit Complete
WORD MSD,MD.LEN
WORD DAT,<<RCH.LN+3>/4> ;Room for Largest Remote Console header
ENDSTR
;Remote Console Command Data Area, Data Buffer supplied by User
BEGSTR CD,LH.LST ;Remote Console Command Data Output MSD
WORD MSD,MD.LEN
ENDSTR
;Remote Console Response Buffer MSD
MAX. (RB.LEN,<LD.LST,CD.LST>) ;Redefine length of RB
SUBTTL Symbol Definitions -- External Declarations
EXTERN RTN ;NON-SKIP RETURN LABEL
EXTERN RSKP ;SKIP RETURN LABEL
;NISRV -- The NI Data Link Layer interface
EXTERN DLLUNI ;DLL Interface Routine
;NTMAN -- The Network Management Interface
;D36COM -- The DECnet-36 Common Utilities
IFN FTOPS20,<
EXTERN DNPINI ;Initialize MSD for output use by DNPxxx
EXTERN DNP1BY ;Put a byte
EXTERN DNP2BY ;Put a word, 2 bytes
EXTERN DNP4BY ;Put double word, 4 bytes
EXTERN DNP2BS ;Put word at caller specified offset
EXTERN DNPENA ;Put 6 byte Ethernet address
EXTERN DNPHIO ;Put bytes 0,1,2,3 from AC
EXTERN DNGMSI ;Initialize MSD to point to input buffer
EXTERN DNGMSS ;Initialize MSD for input use by DNGxxx
EXTERN DNRPOS ;Read the current position in the input data
EXTERN DNG1BY ;Get a byte
EXTERN DNG2BY ;Get a word, 2 bytes
EXTERN DNSKBY ;Skip over caller specified number of bytes
EXTERN DNBKBY ;Backup 'n' bytes in message
EXTERN DNGENA ;Get 6 byte Ethernet address
EXTERN DNGWDS ;Get block of memory words
EXTERN DNGWDZ ;Get block of zeroed memory words
EXTERN DNFWDS ;return free words
EXTERN DNCM2U ;Copy message to user buffer
EXTERN DNCU2M ;Copy user buffer to message
;PAGUTL -- Pager utility routines
EXTERN MLKMA ;Lock down a page given virtual address
EXTERN MULKCR ;Unlock a page given physical page number
;STG -- Monitor Storage
EXTERN LLMACT ;CLK2TM entry, Periodic Identify-Self timer
>; END IFN FTOPS20
SUBTTL Symbol Definitions -- LLMOP Internal Definitions
NOPAD==0 ;Don't let KLNI do padding on transmit
PAD==1 ;Let KLNI do padding on transmit
EN.MAX==^D1500 ;Maximum Ethernet Data in Bytes
EN.CRC==^D4 ;Ethernet CRC length
BUFLEN==EN.MAX+EN.CRC ;Ethernet Buffer Length in Bytes
BUFSIZ==<<BUFLEN+3>/4> ;Ethernet Buffer Size in Words
LPSIBN==^D20 ;Initial Number of Buffers for LPS
IFN FTOPS20,<
LLPILM==<1B<POS(PICHNM)-WID(PICHNM)+DLSCHN>> ;PI Level mask for KLNI
>; END IFN FTOPS20
NKLNI==1 ;Number of KLNI's supported by LLMOP
IFN FTOPS10,<
VGNPTR==<POINT 8,0(T6)>
>; END IFN FTOPS10
;
; Define LLMOP arg block fields as BEGSTR fields for use by ULOAD/USTOR
;
MSKSTR LMMRF,.LMCID,LM%MRF
MSKSTR LMCBF,.LMCID,LM%CBF
MSKSTR LMMNO,.LMCID,LM%MNO
MSKSTR LMCCF,.LMCID,LM%CCF
MSKSTR LMRDL,.LMCID,LM%RDL
MSKSTR LMRDO,.LMCID,LM%RDO
MSKSTR LMCDL,.LMCID,LM%CDL
MSKSTR LMRCF,.LMCID,LM%RCF
MSKSTR LMCID,.LMCID,LM%CID
MSKSTR LMDST,.LMDST,.FWORD
MSKSTR LMSRC,.LMSRC,.FWORD
MSKSTR LMMCA,.LMDST,LM%MCA
MSKSTR LMRTC,.LMSTF,LM%RTC
IFN FTOPS20,<
MSKSTR LMAIC,.LMREQ,LM%AIC
MSKSTR LMICH,.LMREQ,LM%ICH
>; END IFN FTOPS20
MSKSTR LMHWA,.LMHWA,.FWORD
MSKSTR LMCST,.LMCST,.FWORD
MSKSTR LMPYA,.LMPYA,.FWORD
MSKSTR LMPID,.LMPID,LM%PID
MSKSTR LMREQ,.LMREQ,LM%REQ
MSKSTR LMPWD,.LMPWD,.FWORD
MSKSTR LMBSV,.LMCIF,LM%BSV
MSKSTR LMBDV,.LMCIF,LM%BDV
MSKSTR LMPRO,.LMCIF,LM%PRO
MSKSTR LMCFB,.LMCIF,<LM%BDV!LM%BSV!LM%PRO>
MSKSTR LMDID,.LMDID,.FWORD
MSKSTR LMSID,.LMSID,.FWORD
MSKSTR LMRML,.LMRBL,LM%RML
MSKSTR LMMBL,.LMRBL,LM%MBL
MSKSTR LMRBP,.LMRBP,.FWORD
MSKSTR LMAST,.LMAST,.FWORD
MSKSTR LMHLP,.LMHLP,.FWORD
SUBTTL Symbol Definitions -- LLMOP Protocol
;MOP Message Function codes
FCLODT==^D00 ;Memory Load with Transfer Address
FCDMPC==^D01 ;Dump Complete
FCLOAD==^D02 ;Memory Load
FCAVOL==^D03 ;Assistance Volunteer
FCRDMP==^D04 ;Request Dump
FCRQID==^D05 ;Request ID
FCBOOT==^D06 ;Remote Console Boot
FCSSID==^D07 ;System ID
FCRPGM==^D08 ;Request Program
FCRQCT==^D09 ;Request Counters
FCRLOD==^D10 ;Request Memory Load
FCRDMS==^D12 ;Request Dump Service
FCCNTR==^D11 ;Counters
FCRSVC==^D13 ;Reserve Console
FCDDAT==^D14 ;Memory Dump Data
FCRELC==^D15 ;Release Console
FCCCAP==^D17 ;Console Command and Poll
FCCRAK==^D19 ;Console Response and Acknowledge
FCPRMT==^D20 ;Parameter Load with Transfer Address
;INFO TYPE values
IT.MVN==^D1 ;Maintenance Version
IT.FCT==^D2 ;Functions
IT.CSU==^D3 ;Console User
IT.RVT==^D4 ;Reservation Timer
IT.CCS==^D5 ;Console Command Size
IT.CRS==^D6 ;Console Response Size
IT.HAD==^D7 ;Hardware Address
IT.SYT==^D8 ;System Time
IT.CDV==^D100 ;Communication Device
IT.SID==^D200 ;Software ID
IT.SPR==^D300 ;System Processor
IT.DLK==^D400 ;Data Link
IT.DBS==^D401 ;Data Link Buffer Size
;PDP-11 bit definitions
BIT0==1B35
BIT1==1B34
BIT2==1B33
BIT3==1B32
BIT4==1B31
BIT5==1B30
BIT6==1B29
BIT7==1B28
;Maintenance Function bit definitions
MFLOOP==BIT0 ;Loop
MFDUMP==BIT1 ;Dump
MFPLOD==BIT2 ;Primary Loader
MFMBLD==BIT3 ;Multi-block Loader
MFBOOT==BIT4 ;Boot
MFCCAR==BIT5 ;Console Carrier
MFDLCT==BIT6 ;Data Link Counters
MFCCRS==BIT7 ;Console Carrier Reservation
SUBTTL Symbol Definitions -- INTERNAL Symbols
;The following INTERNALs are for NMXSER, which reads and writes these
;parameters.
INTERNAL MOPVER ;MOP VERSION NUMBER
INTERNAL MOPECO ;MOP VENDOR ECO NUMBER
INTERNAL MOPUEC ;MOP USER ECO NUMBER
SUBTTL Data Structure Definitions -- Counters Block (CB)
;Counters Block
BEGSTR CB
WORD ID ;Requester ID for this block
WORD BR ;BYTES RECEIVED
WORD BX ;BYTES TRANSMITTED
WORD FR ;FRAMES RECEIVED
WORD FX ;FRAMES TRANSMITTED
WORD MCB ;MULTICAST BYTES RECEIVED
WORD MCF ;MULTICAST FRAMES RECEIVED
WORD FXD ;FRAMES XMITTED, INITIALLY DEFERRED
WORD FXS ;FRAMES XMITTED, SINGLE COLLISION
WORD FXM ;FRAMES XMITTED, MULTIPLE COLLISIONS
WORD XF ;TRANSMIT FAILURES
WORD XFM ;TRANSMIT FAILURE BIT MASK
WORD CDF ;CARRIER DETECT CHECK FAILED
WORD RF ;RECEIVE FAILURES
WORD RFM ;RECEIVE FAILURE BIT MASK
WORD DUN ;DISCARDED UNKNOWN
WORD D01 ;DISCARDED POSITION 1
WORD D02 ;DISCARDED POSITION 2
WORD D03 ;DISCARDED POSITION 3
WORD D04 ;DISCARDED POSITION 4
WORD D05 ;DISCARDED POSITION 5
WORD D06 ;DISCARDED POSITION 6
WORD D07 ;DISCARDED POSITION 7
WORD D08 ;DISCARDED POSITION 8
WORD D09 ;DISCARDED POSITION 9
WORD D10 ;DISCARDED POSITION 10
WORD D11 ;DISCARDED POSITION 11
WORD D12 ;DISCARDED POSITION 12
WORD D13 ;DISCARDED POSITION 13
WORD D14 ;DISCARDED POSITION 14
WORD D15 ;DISCARDED POSITION 15
WORD D16 ;DISCARDED POSITION 16
WORD FBE ;FREE BUFFER LIST EMPTY
WORD SBU ;SYSTEM BUFFER UNAVAILABLE
WORD UBU ;USER BUFFER UNAVAILABLE
WORD UFD ;UNRECOGNIZED FRAME DEST
WORD XXX ;THIS WORD ACTUALLY RESERVED FOR UCODE
WORD UNI ;PORTAL ID
ENDSTR
SUBTTL Data Structure Definitions -- Overview
; The Request Block queue
;
;
;LPSSVB: +-------+
; | |
; | |
; | |
; |-------|
; | SVRQH |========>RB:+-------+
; |-------| | RBFWD |======>RB:+-------+
; | SVRQT |====== |-------| | RBFWD |========>RB:+-------+
; |-------| | | | |-------| =======>| RBFWD |
; | | | | | | | | |-------|
; | | | | | | | | | |
; | | | +-------+ | | | | |
; | | | +-------+ | | |
; | | | | +-------+
; +-------+ | |
; ========================================
;
;
;
; The Response MSD Input list
;
;
; RB:+-------+
; | |
; |-------|
; | RBMSI |===========>MD:+-------+
; |-------| | MDNXT |=============>MD:+-------+
; | | |-------| =======> | MDNXT |=======>...
; | | | | | |-------|
; | | |-------| | | |
; +-------+ | MDALA | | |-------|
; |-------| | | MDALA |=======
; | | | |-------| |
; UN:|=======| | | | |
; | | | UN:|=======| |
; |-------| | | | |
; | UNRID | | |-------| |
; |-------| =========| UNRID | |
; | | |-------| |
; | | | | |
; |=======| | | |
; | | |=======| |
; | | | |<======
; | | | |
; | | | |
; +-------+ | |
; +-------+
;
SUBTTL Data Structure Definitions -- Server Variable Block (SVB)
;LLMOP Generic Server Variable Block
;
; The definition, structure and use of this block
; is shared between the Loopback Protocol Server
; and the Remote Console Server.
;
BEGSTR SV ;Server Variable Block
WORD IFG ;Initialization Flag
WORD DLS ;Data Link State
WORD STT ;Server State
WORD AST ;Server Assistant State
IFN FTOPS20,<
FIELD AIC,^D1 ;Assign Interrupt Channel
FILLER ^D11
FIELD ICH,^D6 ;Interrupt Channel Number (0 to 35)
FILLER ^D2
>; END IFN FTOPS20
FIELD NXR,^D16 ;Next Receipt Number
WORD QLK ;Queue Lock
WORD RQH ;Request Queue Head
WORD RQT ;Request Queue Tail
WORD RCT ;Total Receive Count
WORD TIC ;Total Invalid Receive Count
WORD SRC ;Server Receive Count
WORD SIC ;Server Invalid Receive Count
WORD RRC ;Requestor Receive Count
WORD RIC ;Requestor Invalid Receive Count
WORD TTI ;Total Transmit Initiated Count
WORD TCT ;Total Transmit Complete Count
WORD TTF ;Total Transmit Failure Count
WORD STC ;Server Transmit Count
WORD RTC ;Requestor Transmit Count
WORD BPC ;Buffer Post Count
WORD LBC ;Lost Buffer Count
WORD IBN ;Initial Buffer Number
WORD MCA,2 ;Multicast Address
IFN FTOPS20,<
WORD CJN ;Configurator Job Number
WORD CFN ;Configurator Fork Number
>; END IFN FTOPS20
IFN FTOPS10,<
WORD CJC ;Configurator Job-Context Number
>; END IFN FTOPS10
WORD IXB,UN.LEN ;DLL Interface Block
WORD CCB,CC.LEN ;Start of Channel Counters Block
; WORD PCB,CB.LEN ;Start of Portal Counters Block
ENDSTR
SUBTTL Data Structure Definitions -- Identify-self Message Block (IM)
SID.SZ==^D100 ;Size of System Id message in bytes
BEGSTR IM
WORD IDD ;Special ID word
WORD MSD,MD.LEN ;MSD for System ID message
WORD DAT,<<SID.SZ+3>/4> ;Buffer for message
ENDSTR
SUBTTL Storage Allocation -- Resident Write-protected
RESCD
;The architecture version number of this implementation
MOPVER: DEC 3 ;MOP PROTOCOL VERSION NUMBER (AS SEEN BY USERS)
MOPECO: DEC 0 ;DEC ECO NUMBER
MOPUEC: DEC 0 ;USER ECO NUMBER
SUBTTL LLMOP BUG. Expansions
;The following contains all BUG.'s issued within this module.
BUG. (CHK,LPSIFC,LLMOP,SOFT,<LLMOP LPSCBR called with invalid function code>,<<T1,FUNCODE>>,<
Cause: The LLMOP Loopback Protocol Server Call Back Routine was called by
the Data Link Layer with an invalid callback function code. This is
a software bug. Call your DIGITAL Software Specialist.
>)
BUG. (INF,LLMIL1,LLMOP,SOFT,<LLMOP Received Invalid Loopback Message>,<<T1,MSGLEN>,<T2,HIORD>,<T3,LOORD>>,<
Cause: LLMOP Received a Loopback message that was too short or was
improperly formatted. This is a MOP protocol violation by a
remote node.
T1 contains the received message length.
T2-T3 contains the Ethernet address of the transmitting node.
>)
BUG. (INF,LLMILF,LLMOP,SOFT,<LLMOP Invalid Loopback Function Code>,<<T1,FUNCOD>,<T2,HIORD>,<T3,LOORD>>,<
Cause: LLMOP Received a Loopback message that was neither a Loopback
reply message or a forward data message. This is a MOP protocol
violation by a remote node.
T1 contains the function code.
T2-T3 contains the Ethernet address of the transmitting node.
>)
BUG. (HLT,LPRIXC,LLMOP,SOFT,<LLMOP Invalid Xmit Complete>
,<<T1,RBSTT>,<T3,STATUS>>,<
Cause: NIDLL called back to LLMOP with a transmit complete event
for an RB which is not in Transmit Initiated state. This is
a software bug. Call your DIGITAL Software Specialist.
T1 contains the current RB state
T3 contains the status in the UN block
>)
BUG. (INF,LLMSTC,LLMOP,SOFT,<LLMOP Data Link State Change - CHAN,PID,STS>,<<T1,CHANNEL>,<T2,PRTLID>,<T3,STATUS>>,<
Cause: LLMOP was called by NIDDL on change of state. This is for
information only. No corrective action required.
>)
BUG. (INF,LLMSCA,LLMOP,SOFT,<LLMOP Ethernet Channel Address Change - CHAN,ADDR1,ADDR2>,<<T1,CHANNEL>,<T2,ADDR1>,<T3,ADDR2>>,<
Cause: LLMOP was called by NIDDL on change of state.
>)
BUG. (INF,LLMLXF,LLMOP,SOFT,<LLMOP Loopback Transmit Failed>
,<<T1,DLLERC>,<T2,STATUS>,<T3,CHANNEL>>,<
Cause: LLMOP was unable to transmit a forward data message.
T1 contains the error code returned from the DLL
T2 contains the channel status returned from the DLL
T3 contains the channel on which the failure occurred
>)
BUG. (CHK,RCSIFC,LLMOP,SOFT,<LLMOP RCSCBR called with invalid function code>,<<T1,FUNCODE>>,<
Cause: The LLMOP Remote Console Protocol Server Call Back Routine was
called by the Data Link Layer with an invalid callback function
code. This is a software bug. Call your DIGITAL Software Specialist.
>)
BUG. (INF,LLMIR1,LLMOP,SOFT,<LLMOP Received Invalid Remote Console Message>,<<T1,MSGLEN>>,<
Cause: LLMOP Received a Remote Console message that was too short, too long
or was improperly formatted. This is a MOP protocol violation by a
remote node.
>)
BUG. (INF,MOPIFC,LLMOP,SOFT,<LLMOP Received an invalid MOP message>,<<T1,FUNCODE>>,<
Cause: The LLMOP Remote Console Protocol Server received a MOP message
with an invalid function code. This is a MOP protocol violation by a
remote node.
>)
BUG. (INF,LLMRRF,LLMOP,SOFT,<LLMOP Response Transmit Failed>,<<T1,DLLERC>,<T2,CHANNEL>>,<
Cause: LLMOP was unable to transmit a MOP request message.
T1 contains the error code returned from the DLL
T3 contains the channel on which the failure occurred
>)
BUG. (INF,RCS3XF,LLMOP,SOFT,<LLMOP Transmit Failed>,<<T1,DLLERC>,<T2,CHANNEL>>,<
Cause: LLMOP was unable to transmit a forward data message.
T1 contains the error code returned from the DLL
T2 contains the channel on which the failure occurred
>)
BUG. (INF,RCSPIS,LLMOP,SOFT,<LLMOP Ethernet Periodic Identify-Self>,,<
Cause: This is a temporary debugging BUGINF. It is here to provide an
indication that the periodic Identify-Self transmission
is being performed.
>)
BUG. (INF,LPRLXF,LLMOP,SOFT,<LLMOP Loop Request Transmit Failed>,<<T1,DLLERC>,<T2,STATUS>,<T3,CHANNEL>>,<
Cause: LLMOP was unable to transmit a forward data message.
T1 contains the error code returned from the DLL
T3 contains the channel on which the failure occurred
>)
BUG. (CHK,LLMOPF,LLMOP,SOFT,<LLMOP Open Portal Failed>,<<T1,DLLERC>>,<
Cause: LLMOP Failed to open an NI portal with the Data Link Layer.
T1 contains the error code returned from the DLL
>)
BUG. (CHK,LLMMCF,LLMOP,SOFT,<LLMOP Declare Multicast Address Failed>,<<T1,DLLERC>>,<
Cause: LLMOP Attempt to declare the Assistant Multi-Cast Address
failed when the Data Link Layer was called.
T1 contains the error code returned from the DLL
>)
BUG. (CHK,LLMRQC,LLMOP,SOFT,<LLMOP RB Queue Corrupted>,<<T1,RBADDRESS>>,<
Cause: LLMOP Attempted to remove an RB queue entry from an empty queue or
the RB was not on the queue.
>)
SUBTTL Storage Allocation -- Resident Writeable
RESDT
;Server Variable Blocks for Loopback Server, one per channel
..CH==0 ;Initialize at Channel 0
LPSSVB: REPEAT <NKLNI>,<
$BUILD (SV.LEN) ;Loopback Protocol Server Variable Block
$SET (SVIFG,0) ;Initialization Flag - Clear
$SET (SVDLS,<-1>) ;Data Link State - Initially invalid
$SET (SVSTT,1) ;Server State - ON
$SET (SVAST,1) ;Server Assistant State - ON
$SET (SVRQH,0) ;Request Queue Head - Empty
$SET (SVRQT,<..LRQH>) ;Request Queue Tail - Empty
$SET (SVIBN,2) ;Initial Buffer Number - 2
$SET (SVMCA,<BYTE (8)317,0,0,0>) ;Loopback Multicast
$SET (SVMCA,<BYTE (8)0,0,0,0>,<+1>) ;Address CF-00-00-00-00-00
$SET (UNCHN,..CH,SV.IXB) ;Channel
$SET (UNPAD,NOPAD,SV.IXB) ;No padding for Loopback
$SET (UNPRO,<BYTE (4)0(8)0,0,220,0>,SV.IXB) ;Protocol Type 90-00
IFN FTOPS20,<
$SET (UNPMS,<LLPILM>,SV.IXB) ;PI level at which we call NI Data Link
>; END IFN FTOPS20
$SET (UNUID,<LPSSVB+..CH>,SV.IXB) ;Address of SVB is our UID
$SET (UNCBA,<IFIW LPSCBR>,SV.IXB) ;Call Back Vector Address
$EOB
..LRQH==<LPSSVB+<<1+..CH>*SV.RQH>>
..CH==..CH+1>
;Server Variable Blocks for Remote Console Server, one per channel
..CH==0 ;Initialize at Channel 0
RCSSVB: REPEAT <NKLNI>,<
$BUILD (SV.LEN) ;Remote Console Server Variable Block
$SET (SVIFG,0) ;Initialization Flag - Clear
$SET (SVDLS,<-1>) ;Data Link State - Initially invalid
$SET (SVSTT,1) ;Server State - ON
$SET (SVAST,1) ;Server Assistant State - ON
$SET (SVRQH,0) ;Request Queue Head - Empty
$SET (SVRQT,<..CRQH>) ;Request Queue Tail - Empty
$SET (SVIBN,2) ;Initial Buffer Number - 2
$SET (SVMCA,<BYTE (8)253,0,0,02>) ;Remote Console Multicast
$SET (SVMCA,<BYTE (8)0,0,0,0>,<+1>) ;Address AB-00-00-02-00-00
$SET (UNCHN,..CH,SV.IXB) ;Channel
$SET (UNPAD,PAD,SV.IXB) ;Padding for Remote Console
$SET (UNPRO,<BYTE (4)0(8)0,0,140,02>,SV.IXB) ;Protocol Type 60-02
IFN FTOPS20,<
$SET (UNPMS,<LLPILM>,SV.IXB) ;PI level at which we call NI Data Link
>; END IFN FTOPS20
$SET (UNUID,<RCSSVB+..CH>,SV.IXB) ;Address of SVB is our UID
$SET (UNCBA,<IFIW RCSCBR>,SV.IXB) ;Call Back Vector Address
$EOB
..CRQH==<RCSSVB+<<1+..CH>*SV.RQH>>
..CH==..CH+1>
SUBTTL Storage Allocation -- Resident Writeable
;Storage for Remote Console Server Identify Self function
RCSSIM: $BUILD (IM.LEN)
$SET (IMIDD,<'SID'>)
$SET (MDVMC,<VMC.XC>,<IM.MSD>)
$SET (MDALA,<RCSSIM+IM.DAT>,<IM.MSD>)
$EOB
PIDSUN:
$BUILD (UN.LEN) ;UN Block for Periodic Identify-Self
$SET (UNCHN,0) ;Channel
$SET (UNBSZ,0) ;Will always use MSD's
$SET (UNUID,<PIDSUN>) ;Address of PIDSUN is our UID
$SET (UNDAD,<BYTE (8)253,0,0,02>) ;Remote Console Multicast
$SET (UNDAD,<BYTE (8)0,0,0,0>,<+1>) ;Address AB-00-00-02-00-00
$SET (UNCBA,<IFIW RCSCBR>) ;Call Back Vector Address
$EOB
ONESEC==<^D1000> ;One second -- 1000 milliseconds
ONEMIN==<^D60*ONESEC> ;One minute -- sixty seconds
TENMIN==<^D10*ONEMIN> ;Ten minutes
RCSATB: EXP TENMIN ;Periodic Identify-Self Time Base (10 Min)
RCSITF: EXP 0 ;Initial Timer Flag
SUBTTL LLMINI - LLMOP Server/Requestor Initialization
;LLMINI - Initialize NI Ethernet LLMOP Protocol Servers
;
;Call:
; CALL LLMINI
; Normal Return, Always
;Changes T1
;This entry is called at system startup. Before this initialization
;is done, all calls to LLMOP will fail.
CN=WK
RESCD
LLMINI: EA.ENT ;Make sure of extended section addressing
SAVEAC <CN> ;Storage for negative channel loop counter
SETZ CN, ;Set up loop counter to start at channel 0
LLMIN1: CAIL CN,NKLNI ;Done all channels?
JRST LLMIN2 ;Yes, finish up initialization
MOVE T1,CN ;Get channel number to initialize
IMULI T1,SV.LEN ;Get offset of SVB for this channel
XMOVEI T1,LPSSVB(T1) ;Get address of LPS SV block for this channel
CALL PSVINI ;Initialize Loopback Protocol Server
NOP ;Initialization Failed - Ignore
MOVE T1,CN ;Get channel number to initialize
IMULI T1,SV.LEN ;Get offset of SVB for this channel
XMOVEI T1,RCSSVB(T1) ;Get address of SV block for RCS
CALL PSVINI ;Initialize Remote Console Protocol Server
NOP ;Initialization Failed - Ignore
AOJA CN,LLMIN1 ;Bump channel number, loop for each channel
LLMIN2:
IFN FTOPS20,<
CAILE CN,0 ;Any channels at all?
IFSKP. ;Yes, Set up Identify Self timer
CALL NRANDM ;Get a 16 bit random value treated as MS/4
LSH T1,2 ;Make it milliseconds and sign bit in B17
HRREI T1,(T1) ;Make it a signed value +/- 2 Min 11 Sec
ADDX T1,TENMIN ;Timer goes off every ten (10) +/- minutes
ELSE.
MOVX T1,<^-<1_^D35>> ;Get largest positive 36 bit value
ENDIF.
>; END IFN TOPS20
IFN FTOPS10,<
MOVEI T1,^D10 ;Identify self is every ten minutes
>; END IFN FTOPS10
MOVEM T1,RCSATB ;Store in Identify-Self Timer Base
MOVEM T1,LLMACT ;Yes, store in timer word
RET ;RETURN from LLMINI
;END of Routine LLMINI
SUBTTL LLMMIN - Once a minute identify self timer routine
IFN FTOPS10,<
;Routine to decrement the identify self timer and send
;identify self message if time.
;
;Called from: CLOCK1 once a minute.
;
; PUSHJ P,LLMMIN##
; Always returns here
LLMMIN::SE1ENT ;Run in NZS
SAVEAC <CN> ;Storage for negative channel loop counter
SETZ CN, ;Set up loop counter to start at channel 0
LLMMI1: CAIL CN,NKLNI ;Done all channels?
JRST LLMMI2 ;Yes, go check if time to send SID message
MOVE T1,CN ;Get channel number
IMULI T1,SV.LEN ;Get offset of SVB for this channel
XMOVEI T1,LPSSVB(T1) ;Get address of LPS SV block for this channel
CALL PSTBUF ;Post any needed buffers
NOP ;Error, ignore
MOVE T1,CN ;Get channel number
IMULI T1,SV.LEN ;Get offset of SVB for this channel
XMOVEI T1,RCSSVB(T1) ;Get address of SV block for RCS
CALL PSTBUF ;Post any needed buffers
NOP ;Error, ignore
AOJA CN,LLMMI1 ;Bump channel number, loop for each channel
LLMMI2: SOSG LLMACT## ;TEN MINUTES UP YET?
PUSHJ P,RCSIDS ;YES, SEND SID MESSAGE
RET ;RETURN
>; END IFN FTOPS10
SUBTTL LLMOFF - LLMOP Server/Requestor Reset (Turn OFF)
;LLMOFF - Reset (turn OFF) Ethernet LLMOP for a channel
;
;Call: T1/ NI Channel Number
; CALL LLMOFF
; Normal Return
;Changes T1
IFN FTDEBUG,< ;Include this code only for debugging
;until the network management MODULE
;LOOPER is implemented to call here.
SWAPCD
LLMOFF: SAVEAC <CN,SB> ;Allocate named AC variables for block pointers
MOVEM T1,CN ;Save channel number
;Turn off Loopback Protocol Server
IMULI T1,SV.LEN ;Get offset of SVB for this channel
XMOVEI SB,LPSSVB(T1) ;Get address of SV block for LPS
MOVEI T1,NU.CLO ;DLL Close Function code
XMOVEI T2,SV.IXB(SB) ;Pass address of UN Block
CALL DLLUNI ;Call DLL User to NI Interface Block
NOP ;Ignore any failure
SETZRO SVIFG,(SB) ;Not initialized any longer
MOVE T1,CN ;Restore channel number
;Turn off Remote Console Protocol Server
IMULI T1,SV.LEN ;Get offset of SVB for this channel
XMOVEI SB,RCSSVB(T1) ;Get address of SV block for LPS
MOVEI T1,NU.CLO ;DLL Close Function code
XMOVEI T2,SV.IXB(SB) ;Pass address of UN Block
CALL DLLUNI ;Call DLL User to NI Interface Block
NOP ;Ignore any failure
SETZRO SVIFG,(SB) ;Not initialized any longer
RET ;Return
>
;END of Routine LLMOFF
SUBTTL LLMPSI - PSISER Status Routine
;Routine called when an LLMOP PSI is granted by PSISER. Routine should
;return status word.
;
;Call: J/ JCH
; CALL LLMPSI
;
;Returns status word in T2.
IFN FTOPS10,<
LLMPSI::SETZ T2, ;Needs to be written
POPJ P, ;Return
>; END IFN FTOPS10
SUBTTL Loopback Protocol Server -- LPSCBR - DLL Callback Routine
;LPSCBR - DLL Callback Dispatch Routine
;
;Call: T1/ DLL Interface Function Code NU.xxx
; T2/ UN Block address
; CALL LPSCBR
; Normal Return
;Changes UN,SB
;Get minumum/maximum valued function
MIN. (MINLPF,<NU.CLO,NU.RCV,NU.XMT,NU.EMA,NU.DMA,NU.RPC,NU.RCI,NU.SCA,NU.RCC>)
MAX. (MAXLPF,<NU.CLO,NU.RCV,NU.XMT,NU.EMA,NU.DMA,NU.RPC,NU.RCI,NU.SCA,NU.RCC>)
LPFSIZ==<MAXLPF-MINLPF+1> ;Size of Dispatch Table
RESCD
LPSCBR: SAVEPQ ;Save all AC's to be safe
TRVAR <SKPCNT> ;Allocate named stack variables
CAIL T1,MINLPF ;Range check function code
CAILE T1,MAXLPF
IFSKP.
MOVE UN,T2 ;Get address of DLL's UN Block
LOAD SB,UNUID,(UN) ;Get SVB address
CALL @LPSDSP-MINLPF(T1) ;Call the function dependent routine
ELSE.
XCT LPSIFC ;Do the BUG.
ENDIF.
RET ;Return
LPSDSP: BLOCK <LPFSIZ> ;DLL Callback Dispatch Table
MAKENT (LPSDSP,NU.CLO-MINLPF,RTN) ;Close complete
MAKENT (LPSDSP,NU.RCV-MINLPF,LPSRCV) ;DLL Receive Complete
MAKENT (LPSDSP,NU.XMT-MINLPF,LPSXTC) ;DLL Transmit Complete
MAKENT (LPSDSP,NU.EMA-MINLPF,RTN) ;Enable Multicast Addr Complete
MAKENT (LPSDSP,NU.DMA-MINLPF,RTN) ;Disable Multicast Addr Complete
MAKENT (LPSDSP,NU.RPC-MINLPF,RTN) ;Read Portal Ctrs Complete
MAKENT (LPSDSP,NU.RCI-MINLPF,LPSRCI) ;Read Channel Info Complete
MAKENT (LPSDSP,NU.SCA-MINLPF,RTN) ;Set Channel Address Complete
MAKENT (LPSDSP,NU.RCC-MINLPF,RTN) ;DLL Read Channel Ctrs Complete
;END of Routine LPSCBR
SUBTTL Loopback Protocol Server -- LPSRCV - Receive Datagram Handler
;LPSRCV - Exit Routine to Handle Received Loopback Datagram
;
;This routine is called by the DLL at interrupt level,
;when an Ethernet Loopback Protocol Datagram is received.
;
;Call: T1/ NU.RCV
; T2,UN/ DLL's UN Block address
; SB/ SV Block address
; CALL LPSRCV
; Normal Return
;Changes T1,T2
; SKPCNT/ Skip Count
RESCD
LPSRCV: CALL LLMRCV ;Do common receive processing
RETBAD ;Return on failure
CAILE T1,^D14 ;Message must be at least minimum size
IFSKP.
LOAD T2,UNSAD,(UN) ;Get source of this request
LOAD T3,UNSAD,+1(UN)
XCT LLMIL1 ;Do the BUG.
JRST LPSRCY ;Go to common exit on BUG
ENDIF.
;Get function code from loopback message
CALL DNG2BY ;Get skip count
JRST LPSRCY
MOVEM T1,SKPCNT ;Save skip count
CALL DNSKBY ;Skip past that in message
JRST LPSRCY
CALL DNG2BY ;Get the function code
JRST LPSRCY
CAIE T1,1 ;Is this a reply message?
IFSKP.
CALL LPSRPY ;Yes, go process reply
JRST LLMRCX ;Error, Drop message
RET ;Return to DLL
ENDIF.
CAIN T1,2 ;Is this a forward data message?
IFSKP. ;No..., It's invalid
LOAD T2,UNSAD,(UN) ;Get source of this request
LOAD T3,UNSAD,+1(UN)
XCT LLMILF ;Do the BUG.
JRST LPSRCY ;Go to common exit on BUG
ENDIF.
;YES, Check to ensure Loop Server state is enabled
OPSTR <SKIPN>,SVSTT,(SB) ;Loopback server enabled?
JRST LLMRCX ;No, Go to common exit
;Check if destination address is a multi-cast address (CF-00-00-00-00-00)
LOAD T1,UNDAD,(UN) ;Get first 4 bytes of destination address
LSH T1,^D7 ;Shift to make multicast bit the sign bit
SKIPL T1 ;Is it multi-cast?
IFSKP. ;Yes, Destination is Multicast address
OPSTR <SKIPN>,SVAST,(SB) ;Loop Assistance enabled?
IFSKP. ;Yes, Enabled
CALL LPSLBK ;Process Loopback data message
JRST LLMRCX ;Failed, Drop it, release buffer
RET ;Return
ELSE. ;No, Disabled
JRST LLMRCX ;Drop it, release buffer
ENDIF.
ELSE. ;No, Destination not Multicast address
CALL LPSLBK ;Process Loopback data message
JRST LLMRCX ;Failed, Drop it, release buffer
RET ;Return
ENDIF.
LPSRCY: MOVE T1,SB ;Pass SV block address
CALL PSTBUF ;Post a receive buffer
NOP ;Ignore failure
CALLRET LLMRCX
;END of Routine LPSRCV
SUBTTL Loopback Protocol Server -- LPSXTC - Process Transmit Complete
;LPSXTC - Exit Routine to Handle NI Datagram Transmit Completion
;
;Call: T1/ NU.XMT
; T2,UN/ UN Block address
; SB/ SV Block address
; CALL LPSXTC
; Normal Return
;Changes T1,T2,RB
RESCD
LPSXTC: LOAD T1,UNBSZ,(UN) ;Get Transmitted Message length
INCRF SVTCT,(SB) ;Increment total count of transmits completed
;Nota Bene: Have to know whether this is transmitted by server or requester
LOAD MS,UNRID,(UN) ;Get MSD address
MOVX T2,'LLM' ;Get special ID
CAMN T2,-1(MS) ;Transmitted by requester?
IFSKP. ;NO - Transmitted by Loop Server
INCRF SVSTC,(SB) ;Bump Loop Server transmit count
MOVE T1,MS ;Pass buffer address
CALL DNFWDS ;Release the buffer
MOVE T1,SB ;Pass SV block address
CALL PSTBUF ;Post a receive buffer
NOP ;Ignore failure
ELSE. ;YES - Transmitted by Loop Requestor
XMOVEI RB,-<RBL.LN+LB.LEN+1>(MS) ;Get address of RB
TMNN RBFTI,(RB) ;Ensure transmit was initiated
XCT LPRIXC ;It wasn't, Do the BUG.
INCRF SVRTC,(SB) ;Bump requester transmit count
SKIPN T3 ;Check Transmit Status
IFSKP. ;Failed...
SETONE RBFTF,(RB) ;Set Transmit Failure flag
ELSE. ;Success...
SETONE RBFTC,(RB) ;Set Transmit Complete flag
ENDIF.
CALL SETRBS ;Set state in RB
IFN FTOPS20,<
LOAD T1,MDALA,+LD.MSD(RB) ;Get physical address
LSH T1,-<WID(777)> ;Convert to core page number
CALL MULKCR ;Unlock the page
>; END IFN FTOPS20
IFN FTOPS10,<
XMOVEI T1,LD.MSD(RB) ;Get address of MSD
CALL FREMBF ;Free up monitor buffer
>; END IFN FTOPS10
ENDIF.
RET ;Success - RETURN from LPSXTC
;END of Routine LPSXTC
SUBTTL Loopback Protocol Server -- LPSRCI - Process Chan State Change
;LPSRCI - Exit Routine to Handle NI Channel State Change
;
;Call: T1/ NU.RCI
; T2,UN/ UN Block address
; SB/ SV Block address
; CALL LPSRCI
; Normal Return
;Changes T1,T2
RESCD
LPSRCI: LOAD T1,UNCHN,+SV.IXB(SB) ;Get channel from static UN block
LOAD T2,UNPID,(UN) ;Get portal id
LOAD T3,UNSTA,(UN) ;Get Data Link status
IFN FTDEBUG,<
IFN FTOPS10,<SKIPA> ;Enable BUGINF by patching
XCT LLMSTC ;BUGINF to let someone know what's happened
>
LOAD T1,UNCAR,(UN) ;Get current physical address
LOAD T2,UNCAR,+1(UN)
STOR T1,UNCAR,+SV.IXB(SB) ;Store physical adrress
STOR T2,UNCAR,+SV.IXB+1(SB) ; in the static UN block
STOR T3,UNSTA,+SV.IXB(SB) ;Store status in static UN Block
LOAD T1,UNHAD,(UN) ;Get hardware address
LOAD T2,UNHAD,+1(UN)
STOR T1,UNHAD,+SV.IXB(SB) ;Store it in the static UN block
STOR T2,UNHAD,+SV.IXB+1(SB)
IFN FTOPS20,<
LOAD T1,UNEXS,(UN) ;Get external DLL state
CAIE T1,UNS.RN ;Running?
>; END IFN FTOPS20
IFN FTOPS10,<
TMNN UNRUN,(UN) ;Portal running?
>; END IFNF TOPS10
IFSKP.
SETZRO SVDLS,(SB) ;Yes...
ELSE.
SETONE SVDLS,(SB) ;No...
ENDIF.
RET ;Success - RETURN from LPSRCI
;END of Routine LPSRCI
SUBTTL Loopback Protocol Server -- LPSSCA - Process Channel Address
;LPSSCA - Exit Routine to Handle Set Channel Address Callback
;
;Call: T1/ NU.SCA
; T2,UN/ UN Block address
; SB/ SV Block address
; CALL LPSSCA
; Normal Return
;Changes T1,T2
RESCD
LPSSCA: LOAD T1,UNCHN,+SV.IXB(SB) ;Get channel
LOAD T2,UNDAD,(UN) ;Get new physical address
LOAD T3,UNDAD,+1(UN)
IFN FTDEBUG,<
IFN FTOPS10,<SKIPA> ;Enable BUGINF by patching
XCT LLMSCA ;BUGINF to let someone know what's happened
>
LOAD T1,UNSTA,(UN) ;Get Data Link status
XMOVEI UN,SV.IXB(SB) ;Address the static UN block for this channel
STOR T1,UNSTA,+SV.IXB(SB) ;Store status in static UN Block
STOR T2,UNCAR,+SV.IXB(SB) ;Store new physical adrress
STOR T3,UNCAR,+SV.IXB+1(SB) ; in the static UN block
LOAD T1,UNHAD,(UN) ;Get hardware address
LOAD T2,UNHAD,+1(UN)
STOR T1,UNHAD,+SV.IXB(SB) ;Store it in the static UN block
STOR T2,UNHAD,+SV.IXB+1(SB)
IFN FTOPS20,<
LOAD T1,UNEXS,(UN) ;Get external DLL state
CAIE T1,UNS.RN ;Running?
>; END IFN FTOPS20
IFN FTOPS10,<
TMNN UNRUN,(UN) ;Portal running?
>; END IFN FTOPS10
IFSKP.
SETZRO SVDLS,(SB) ;Yes...
ELSE.
SETONE SVDLS,(SB) ;No...
ENDIF.
RET ;Success - RETURN from LPSSCA
;END of Routine LPSSCA
SUBTTL Loop Server -- LPSLBK - Process Forward Data Loop Message
;LPSLBK - Loopback a message
;
;Call:
; T2,UN/ DLL's UN Block address
; SKPCNT/ Skip Count
; MS/ MSD address
; SB/ SVB address
; CALL LPSLBK
; Error Return, Drop message
; Normal Return
;Note: This routine expects the MSD pointer to point to the next byte
; after the function code in the loopback message.
;
;Changes T1,T2,T3,T4
RESCD
LPSLBK: INCRF SVSRC,(SB) ;Bump received loopback server message count
CALL DNGENA ;Get forward address in UNDAD format
RET
STOR T1,UNDAD,(UN) ;Set as destination address in UN block
STOR T2,UNDAD,+1(UN)
IFN FTOPS20,<
SETZRO UNPTR,(UN) ;Indicate immediate address passed in UNDAD
>; END IFN FTOPS20
;If forward address is a multicast address (CF-00-00-00-00-00-00),
;then drop the message. Otherwise process for transmission.
LOAD T1,UNDAD,(UN) ;Get first 4 bytes of destination address
LSH T1,^D7 ;Shift to make multicast bit the sign bit
SKIPGE T1 ;Is it multi-cast?
RET ;Yes, It is; Drop this message
;Bump skip count by 8 and store in message
MOVX T1,0 ;Position of skip count in message
MOVE T2,SKPCNT ;Get current skip count
ADDI T2,^D8 ;Add eight to skip count
CALL DNP2BS ;Put back updated skip count
;Send to forward address on this portal id, using DLL's UN block
MOVEI T1,NU.XMT ;DLL Transmit Function code
MOVE T2,UN ;Pass address of UN Block
CALL DLLUNI ;Call DLL User to NI Interface Block
IFNSK.
;
;***** Analyze why failed here. If it's because the port is off or
;broken that's OK. But any other reason might indicate some software
;problem. If it's a port problem, that's interesting because it means
;the port was well enough to receive this datagram, but now it can't
;do a transmit. Or, maybe the driver is sick.
LOAD T3,UNCHN,+SV.IXB(SB) ;Get channel number
LOAD T2,UNSTA,(UN) ;Get Channel Status
XCT LLMLXF ;Do the BUG.
INCRF SVTTF,(SB) ;Bump count of total transmit failures
RET ;Take failure return
ENDIF.
INCRF SVTTI,(SB) ;Keep count of transmits initiated
RETSKP ;Success - RETURN from LPSLBK
;END of Routine LPSLBK
SUBTTL Loop Requester -- LPSRPY - Process Loopback Reply Message
;LPSRPY - Handle Loopback Reply Message
;
;Call:
; SKPCNT/ Skip Count
; SB/ SVB address
; CALL LPSRPY
; Error Return, Drop message
; Normal Return
;Note: This routine expects the MSD pointer to point to the next byte
; after the function code in the loopback message.
;Changes T1,T2,RB
; RB/ Request Block address
RESCD
LPSRPY: INCRF SVRRC,(SB) ;Bump received loopback requestor message count
CALL DNG2BY ;Get receipt number from message
RET
;Lookup the request for this receipt number
;Pass the receipt number in T1
MOVE T2,SB ;Pass SVB address
CALL LPSSXQ ;Search queue for this RB
IFNSK. ;Not found..., count and drop the packet
INCRF SVRIC,(SB) ;Bump count of invalid request replies
RET
ENDIF.
MOVE RB,T2 ;Found, T2 contains address of RB
CALL QUEMSD ;Queue this MSD
SETONE RBFRC,(RB) ;Set receive complete flag
CALL SETRBS ;Set state in RB
IFN FTOPS20,<
OPSTR <SKIPN >,RBAIC,(RB) ;Interrupt channel assigned?
RETSKP ;No, return now
LOAD T1,RBICH,(RB) ;Get Interrupt Channel number
LOAD T2,RBFRK,(RB) ;Get Fork Index
CALL PSIRQ ;Notify user that request completed
>; END IFN FTOPS20
IFN FTOPS10,<
CALL RBWAKE ;Wake up job
>; END IFN FTOPS10
RETSKP ;Success - RETURN from LPSRPY
;END of Routine LPSRPY
ENDTV. ;End scope of SKPCNT
SUBTTL Remote Console Protocol Server -- RCSCBR - DLL Callback Routine
;RCSCBR - DLL Callback Dispatch Routine
;
;Call: T1/ DLL Interface Function Code NU.xxx
; T2/ UN Block address
; CALL RCSCBR
; Normal Return
;Changes
;Get minumum/maximum valued function
MIN. (MINRCF,<NU.CLO,NU.RCV,NU.XMT,NU.EMA,NU.DMA,NU.RPC,NU.RCI,NU.SCA,NU.RCC>)
MAX. (MAXRCF,<NU.CLO,NU.RCV,NU.XMT,NU.EMA,NU.DMA,NU.RPC,NU.RCI,NU.SCA,NU.RCC>)
RCFSIZ==<MAXRCF-MINRCF+1> ;Size of Dispatch Table
RESCD
RCSCBR: SAVEPQ ;Save all AC's to be safe
CAIL T1,MINRCF ;Range check function code
CAILE T1,MAXRCF
IFSKP.
MOVE UN,T2 ;Get address of DLL's UN Block
LOAD SB,UNUID,(UN) ;Get SVB address
CALL @RCSDSP-MINRCF(T1) ;Call the function dependent routine
ELSE.
XCT RCSIFC ;Do the BUG.
ENDIF.
RET ;Return
RCSDSP: BLOCK <RCFSIZ> ;DLL Callback Dispatch Table
MAKENT (RCSDSP,NU.CLO-MINRCF,RTN) ;Close complete
MAKENT (RCSDSP,NU.RCV-MINRCF,RCSRCV) ;DLL Receive Complete
MAKENT (RCSDSP,NU.XMT-MINRCF,RCSXTC) ;DLL Transmit Complete
MAKENT (RCSDSP,NU.EMA-MINRCF,RTN) ;Enable Multicast Addr Complete
MAKENT (RCSDSP,NU.DMA-MINRCF,RTN) ;Disable Multicast Addr Complete
MAKENT (RCSDSP,NU.RPC-MINRCF,RTN) ;Read Portal Ctrs Complete
MAKENT (RCSDSP,NU.RCI-MINRCF,RCSRCI) ;Read Channel Info Complete
MAKENT (RCSDSP,NU.SCA-MINRCF,RTN) ;Set Channel Address Complete
MAKENT (RCSDSP,NU.RCC-MINRCF,RCSRCC) ;DLL Read Channel Ctrs Complete
;END of Routine RCSCBR
SUBTTL Remote Console Protocol Server -- RCSXTC - Process Transmit Complete
;RCSXTC - Exit Routine to Handle NI Datagram Transmit Completion
;
;Call: T1/ NU.XMT
; T2,UN/ UN Block address
; SB/ SV Block address
; CALL RCSXTC
; Normal Return
;Changes T1,T2,RB
RESCD
RCSXTC: LOAD T1,UNBSZ,(UN) ;Get Transmitted Message length
INCRF SVTCT,(SB) ;Increment total count of transmits completed
;Nota Bene: Have to know whether this is transmitted by server or requester
LOAD MS,UNRID,(UN) ;Get MSD address
MOVX T2,'SID' ;Get special ID for Identify Self System ID
CAMN T2,-1(MS) ;Transmitted by requester?
IFSKP. ;NO - Transmitted by Remote Console Server
MOVX T2,'LLM' ;Get special ID for RC Requestor
CAMN T2,-1(MS) ;Transmitted by RC Server or Requestor?
IFSKP. ;Transmitted by RC Server
INCRF SVSTC,(SB) ;Bump server transmit count
MOVE T1,MS ;Pass buffer address
CALL DNFWDS ;Release the buffer
MOVE T1,SB ;Pass SV block address
CALL PSTBUF ;Post a receive buffer
NOP ;Ignore failure
ELSE. ;Transmitted by RC Requestor, Really have RB
XMOVEI RB,-<RBL.LN+1>(MS) ;Get address of RB
TMNN RBFTI,(RB) ;Ensure transmit was initiated
XCT LPRIXC ;It wasn't, Do the BUG.
INCRF SVRTC,(SB) ;Bump requester transmit count
SKIPN T3 ;Check Transmit Status
IFSKP. ;Failed...
SETONE RBFTF,(RB) ;Set Transmit Failure flag
ELSE. ;Success...
SETONE RBFTC,(RB) ;Set Transmit Complete flag
ENDIF.
CALL SETRBS ;Set state in RB
IFN FTOPS20,<
LOAD T1,MDALA,+LD.MSD(RB) ;Get physical address
LSH T1,-<WID(777)> ;Convert to core page number
LOAD T2,MDVMC,+LD.MSD(RB) ;Get the memory type code
CAIN T2,VMC.NO ;If this was a user page...
CALL MULKCR ;Unlock the page
>; END IFN FTOPS20
IFN FTOPS10,<
XMOVEI T1,LD.MSD(RB) ;Get address of MSD
CALL FREMBF ;Free up monitor buffer
>; END IFN FTOPS10
TMNN RBABT,(RB) ; Function aborted?
IFSKP. ; Yes.
LOAD T1,RBMSI,(RB) ; Get address of input MSD and buffer
CAIN T1,0 ; An MSD there?
IFSKP. ; Yes...
CALL DNFWDS ; Release the buffer
ENDIF.
MOVE T1,RB ; Get address of RB
CALLRET DNFWDS ; Release the RB
ENDIF. ; End of abort code
ENDIF.
ELSE. ;MSD - SID Transmitted by Console Requestor
INCRF SVRTC,(SB) ;Bump requester transmit count
ENDIF.
RET ;Success - RETURN from RCSXTC
;END of Routine RCSXTC
SUBTTL Remote Console Protocol Server -- RCSRCI - Process Chan State Change
;RCSRCI - Exit Routine to Handle NI Channel State Change
;
;Call: T1/ NU.RCI
; T2,UN/ UN Block address
; SB/ SV Block address
; CALL RCSRCI
; Normal Return
;Changes T1,T2
RESCD
RCSRCI:
IFN FTOPS20,<
LOAD T1,UNEXS,(UN) ;Get external DLL state
CAIE T1,UNS.RN ;Running?
>; END IFN FTOPS20
IFN FTOPS10,<
TMNN UNRUN,(UN) ;Portal running?
>; END IFNF TOPS10
IFSKP.
SETZRO SVDLS,(SB) ;Yes...
ELSE.
SETONE SVDLS,(SB) ;No...
ENDIF.
RET ;Success - RETURN from RCSRCI
;END of Routine RCSRCI
SUBTTL Remote Console Protocol Server -- RCSRCV - Receive Datagram Handler
;RCSRCV - Exit Routine to Handle Received Remote Console Datagram
;
;This routine is called by the DLL, at **scheduler/interrupt** level,
;when an Ethernet Remote Console Protocol Datagram is received.
;
;Call: T1/ NU.RCV
; T2,UN/ UN Block address
; SB/ SV Block address
; CALL RCSRCV
; Normal Return
;Changes T1,T2
RESCD
RCSRCV: CALL LLMRCV ;Do common receive processing
RETBAD ;Return on failure
CAIL T1,^D1 ;Is it at least minimum of 1 byte?
IFSKP. ;No...
XCT LLMIR1 ;Do the BUG.
JRST LLMRCX ;Go to common exit
ELSE. ;Yes...
CAIG T1,^D1500 ;Bigger than Ethernet allows?
IFSKP.
XCT LLMIR1 ;It's a BUG.
JRST LLMRCX ;Go to common exit
ENDIF.
ENDIF.
CALL RCSFCD ;Go process message based on function code
JRST LLMRCX ;On RET
RET ;On RETSKP Success - RETURN from RCSRCV
;END of Routine RCSRCV
SUBTTL Protocol Server -- LLMRCV - Common Receive Datagram Processing
;LLMRCV - Routine to Handle Received Remote Console Datagram
;
;
;Call: T1/ NU.RCV
; T2,UN/ UN Block address
; SB/ SV Block address
; CALL LLMRCV
; Error Return, Drop message
; Normal Return T1/ Message length
;Changes T1,T2
RESCD
LLMRCV: CAIE T3,0 ;Receive error?
JRST LLMRCX ;Yes...
MOVE T1,UN ;Pass UN Block address
CALL INPMSD ;Set up input MSD
INCRF SVRCT,(SB) ;Count receipt of all messages
DECRF SVBPC,(SB) ;Decrement count of receive buffers posted
MOVE T1,SB ;Pass SV block address
CALL PSTBUF ;Post a receive buffer
NOP ;Ignore failure
CALL DNRPOS ;Get message length
RETSKP ;Return +2 with length in T1
LLMRCX: ;Common error exit from LLMRCV
INCRF SVTIC,(SB) ;Count Total Invalid receive Counter
FREBUF: LOAD T1,UNRID,(UN) ;Get buffer address saved when buffer posted
CALLRET DNFWDS ;Free the buffer and RETURN from LLMRCV
;END of Routine LLMRCV
SUBTTL Remote Console Protocol Server -- RCSFCD - MOP Function Code Dispatch
;RCSFCD - Dispatch on Received MOP Function Code
;
;Call: SB/ SV Block address
; UN/ UN Block address
; MS/ MS Block address
; CALL RCSFCD
; Normal Return
;Changes T1,T2
MIN. (MINFCD,<FCLOAD,FCDMPC,FCLODT,FCAVOL,FCRDMP,FCRQID,FCBOOT,FCSSID,FCRPGM,FCRQCT,FCRLOD,FCRDMS,FCCNTR,FCRSVC,FCDDAT,FCRELC,FCCCAP,FCCRAK,FCPRMT>)
MAX. (MAXFCD,<FCLOAD,FCDMPC,FCLODT,FCAVOL,FCRDMP,FCRQID,FCBOOT,FCSSID,FCRPGM,FCRQCT,FCRLOD,FCRDMS,FCCNTR,FCRSVC,FCDDAT,FCRELC,FCCCAP,FCCRAK,FCPRMT>)
FCDSIZ==<MAXFCD-MINFCD+1> ;Size of Dispatch Table
RESCD
RCSFCD: CALL DNG1BY ;Get MOP function code
RET ;Protect against short message
CAIL T1,MINFCD ;
CAILE T1,MAXFCD ;Range check function code
JRST RCSFC1 ;
SKIPE FCDDSP-MINFCD(T1) ;Is there a routine for this function?
CALLRET @FCDDSP-MINFCD(T1) ;Yes, do function
RCSFC1: XCT MOPIFC ;No, invalid function
RET ;
RCSUSF: CALL FREBUF ; Release the buffer
RETSKP ;
FCDDSP: BLOCK <FCDSIZ> ;Remote Console MOP Functon Dispatch Table
MAKENT (FCDDSP,FCRQID-MINFCD,RCSRID) ;Request ID
MAKENT (FCDDSP,FCSSID-MINFCD,RCSSID) ;System ID
MAKENT (FCDDSP,FCRQCT-MINFCD,RCSRCT) ;Request Counters
MAKENT (FCDDSP,FCCNTR-MINFCD,RCSCTR) ;Counters
MAKENT (FCDDSP,FCCRAK-MINFCD,RCSRAK) ;Console Response and Ack
;Don't support these messages
MAKENT (FCDDSP,FCLODT-MINFCD,RCSUSF) ;Memory Load with Trans Addr
MAKENT (FCDDSP,FCDMPC-MINFCD,RCSUSF) ;Dump Complete
MAKENT (FCDDSP,FCLOAD-MINFCD,RCSUSF) ;Memory Load
MAKENT (FCDDSP,FCAVOL-MINFCD,RCSUSF) ;Assistance Volunteer
MAKENT (FCDDSP,FCRDMP-MINFCD,RCSUSF) ;Request Dump
MAKENT (FCDDSP,FCBOOT-MINFCD,RCSUSF) ;Remote Console Boot
MAKENT (FCDDSP,FCRPGM-MINFCD,RCSUSF) ;Request Program
MAKENT (FCDDSP,FCRLOD-MINFCD,RCSUSF) ;Request Memory Load
MAKENT (FCDDSP,FCRDMS-MINFCD,RCSUSF) ;Request Dump Service
MAKENT (FCDDSP,FCRSVC-MINFCD,RCSUSF) ;Reserve Console
MAKENT (FCDDSP,FCRSVC-MINFCD,RCSUSF) ;Reserve Console
MAKENT (FCDDSP,FCDDAT-MINFCD,RCSUSF) ;Memory Dump Data
MAKENT (FCDDSP,FCRELC-MINFCD,RCSUSF) ;Release Console
MAKENT (FCDDSP,FCCCAP-MINFCD,RCSUSF) ;Console Command and Poll
MAKENT (FCDDSP,FCPRMT-MINFCD,RCSUSF) ;Parm Load with Trans Addr
;END of Routine RCSFCD
SUBTTL Console Server -- RCSRID - Process Request ID
;RCSRID - Process MOP REQUEST ID message
;
;Call: SB/ SV Block address
; UN/ UN Block address
; MS/ MS Block address
; CALL RCSRID
; Normal Return
;Changes T1,T2
RESCD
RCSRID: CALL DNG1BY ;Get the reserved field
RET
; OPSTRM <AOS >,MDBYT,(MS) ;***** Patch - EVDWC sends wrong pad count ***
CALL DNG2BY ;Get the receipt number
RET
INCRF SVSRC,(SB) ;Bump count of server receives
MOVE T2,MS ;Get MSD address
CALL BLDSID
CALL XMTRPY ;Transmit the reply resonse
RET ;Take failure return
RETSKP ;Success - RETURN from RCSRID
;END of Routine RCSRID
SUBTTL Console Server/Requestor -- RCSSID - Process System ID
;RCSSID - Process MOP SYSTEM ID message
;
;Call: SB/ SV Block address
; UN/ UN Block address
; MS/ MS Block address
; CALL RCSSID
; Normal Return
;Changes T1,T2
RESCD
RCSSID: CALL DNG1BY ;Ignore Reserved field
RET
CALL DNG2BY ;Get the receipt number
RET
SKIPE T1 ;Is the receipt number zero?
IFSKP. ;Yes, this is an unsolicited configuration msg
IFN FTOPS20,<
OPSTR <SKIPN>,SVCFN,(SB) ;Is there a Configurator Fork?
>; END IFN FTOPS20
IFN FTOPS10,<
OPSTR <SKIPN>,SVCJC,(SB) ;Is there a Configurator JCH?
>; END IFN FTOPS10
IFSKP. ;Yes..., Notify process requesting SID messages
INCRF SVSRC,(SB) ;Bump count of server receives
;Note: The Configurator process obtains the ability to be notified when
; unsolicited SYSTEM ID messages arrive by issuing an LLMOP% JSYS with
; function code .RCAIC and flag LM%ENU set. The process will then get a
; software interrupt on the channel provided in the call. Only one process
; on the system may be enabled to get this interrupt. When the process
; gets the interrupt indicating a SYSTEM ID message is available it must
; issue an LLMOP% JSYS with function code .RCRPY with a request number of
; zero.
;Build an RB for this buffer...
MOVEI T1,RB.LEN ;Allocate block for an RB
CALL DNGWDZ ;Cleared to zeroes
JSUERR (MONX07,) ;Failed... Return with Error Code
MOVE RB,T1 ;Save address of RB
STOR MS,RBMSI,(RB) ;Store address of input MSD in RB
SETZRO RBRNO,(RB) ;Set Receipt Number to zero
SETONE RBFRC,(RB) ;Set receive complete flag
MOVX T1,.RQCMP ;Set state to COMPLETE
STOR T1,RBSTT,(RB) ;Initialize the state in RB
IFN FTOPS20,<
LOAD T1,SVCFN,(SB) ;Get Fork Number of Configurator Module
STOR T1,RBFRK,(RB) ;Store in RB
LOAD T1,SVICH,(SB) ;Get PSI channel number
STOR T1,RBICH,(RB) ;Store in RB
>; END IFN FTOPS20
IFN FTOPS10,<
LOAD T1,SVCJC,(SB) ;Get JCH of Configurator Module
STOR T1,RBJCH,(RB) ;Store in RB
>; END IFN FTOPS10
MOVE T1,RB ;Get address of RB
MOVE T2,SB ;Pass address of SVB
CALL LLMQUE ;Queue RB on request queue
ELSE. ;No..., just drop the message and free buffer
RET ;Return now
ENDIF.
ELSE. ;No..., Handle response to RC request
INCRF SVRRC,(SB) ;Bump count of requestor receives
MOVE T2,SB ;Pass SVB address
CALL LPSSXQ ;Search the request queue for this RB
RET ;Not found, drop it. Maybe keep a count?
MOVE RB,T2 ;Found, T2 contains address of RB
CALL QUEMSD ;Queue this MSD
SETONE RBFRC,(RB) ;Set receive complete flag
CALL SETRBS ;Set state in RB
ENDIF.
IFN FTOPS20,<
OPSTR <SKIPN >,RBAIC,(RB) ;Interrupt channel assigned?
RETSKP ;No, return now
LOAD T1,RBICH,(RB) ;Get Interrupt Channel number
LOAD T2,RBFRK,(RB) ;Get Fork Index
CALL PSIRQ ;Notify user that request completed
>; END IFN FTOPS20
IFN FTOPS10,<
CALL RBWAKE ;Wake up job
>; END IFN FTOPS10
RETSKP ;Success - RETURN from RCSSID
;END of Routine RCSSID
SUBTTL Console Server -- RCSRCT - Process Request Counters
;RCSRCT - Process MOP REQUEST COUNTERS message
;
;Call: SB/ SV Block address
; UN/ UN Block address
; MS/ MS Block address
; CALL RCSRCT
; Normal Return
;Changes T1,T2
RESCD
RCSRCT: STKVAR <RCPTNO>
CALL DNG2BY ;Get the receipt number
RET
MOVEM T1,RCPTNO ;Save receipt number
INCRF SVSRC,(SB) ;Bump count of server receives
MOVX T1,RB.LEN ;Allocate an RB for this request
CALL DNGWDZ
RET
MOVE RB,T1 ;Point to RB
MOVE T2,SB ;Pass address of SVB
STOR MS,RBMSO,(RB) ;Save MSD address for output later
MOVE T1,RCPTNO ;Get receipt number
STOR T1,RBRNO,(RB) ;Save it in RB
LOAD T1,UNSAD,(UN) ;Get source of this request
LOAD T2,UNSAD,+1(UN)
STOR T1,RBDST,(RB) ;Store as request destination
STOR T2,RBDST,+1(RB)
;Get the current counters from the port driver
LOAD T1,UNCHN,(UN) ;Get channel request received on
STOR T1,RBCID,(RB) ;Save Channel ID in RB
XMOVEI T1,SV.CCB(SB) ;Get address of counters buffer
STOR T1,UNBFA,(UN) ;Store in UN
MOVEI T1,CC.LEN ;Size of Counters Block
STOR T1,UNBSZ,(UN) ;Save length in UN
STOR RB,UNRID,(UN) ;Store RB address
SETZRO UNZRO,(UN) ;Don't zero counters when read
MOVEI T1,NU.RCC ;DLL Read Counters Function code
MOVE T2,UN ;Pass address of UN Block
CALL DLLUNI ;Call DLL User to NI Interface Block
RET ;A real problem?
RETSKP ;Success - RETURN from RCSRCT
;END of Routine RCSRCT
SUBTTL Console Requestor -- RCSCTR - Process Counters
;RCSCTR - Process MOP COUNTERS message
;
;Call: SB/ SV Block address
; UN/ UN Block address
; MS/ MS Block address
; CALL RCSCTR
; Normal Return
;Changes T1,T2
RESCD
RCSCTR: CALL DNG2BY ;Get the receipt number
RET
INCRF SVRRC,(SB) ;Bump count of requestor receives
MOVE T2,SB ;Pass SVB address
CALL LPSSXQ ;Search the request queue for this RB
RET ;Not found, drop it. Maybe keep a count?
MOVE RB,T2 ;Found, T2 contains address of RB
SETONE RBFRC,(RB) ;Set receive complete flag
STOR MS,RBMSI,(RB) ;Store address of input MSD in RB
CALL SETRBS ;Set state in RB
IFN FTOPS20,<
OPSTR <SKIPN >,RBAIC,(RB) ;Interrupt channel assigned?
RETSKP ;No, return now
LOAD T1,RBICH,(RB) ;Get Interrupt Channel number
LOAD T2,RBFRK,(RB) ;Get Fork Index
CALL PSIRQ ;Notify user that request completed
>; END IFN FTOPS20
IFN FTOPS10,<
CALL RBWAKE ;Wake up job
>; END IFN FTOPS10
RETSKP ;Success - RETURN from RCSCTR
;END of Routine RCSCTR
SUBTTL Console Requestor -- RCSRAK - Process Console Response Ack
;RCSRAK - Process MOP CONSOLE RESPONSE ACK message
;
;Call: SB/ SV Block address
; UN/ UN Block address
; MS/ MS Block address
; CALL RCSRAK
; Normal Return
;Changes T1,T2
RESCD
RCSRAK: INCRF SVRRC,(SB) ;Bump count of requestor receives
;
;Here we use the low order source Ethernet address to use as a faked
;up Request Number. This was set in the RB in SCCINI.
;
LOAD T1,UNSAD,+1(UN) ;Get the low order destination address
LSH T1,-<^D36-^D16>
MOVE T2,SB ;Pass SVB address
CALL LPSSXQ ;Search the request queue for this RB
RET ;Not found, drop it. Maybe keep a count?
MOVE RB,T2 ;Found, T2 contains address of RB
SETONE RBFRC,(RB) ;Set receive complete flag
STOR MS,RBMSI,(RB) ;Store address of input MSD in RB
CALL SETRBS ;Set state in RB
IFN FTOPS20,<
OPSTR <SKIPN >,RBAIC,(RB) ;Interrupt channel assigned?
RETSKP ;No, return now
LOAD T1,RBICH,(RB) ;Get Interrupt Channel number
LOAD T2,RBFRK,(RB) ;Get Fork Index
CALL PSIRQ ;Notify user that request completed
>; END IFN FTOPS20
IFN FTOPS10,<
CALL RBWAKE ;Wake up job
>; END IFN FTOPS10
RETSKP ;Success - RETURN from RCSRAK
;END of Routine RCSRAK
SUBTTL Remote Console Protocol Server -- RCSRCC - Process Read Counters Complete
;RCSRCC - Exit Routine to Handle KLNI Read Counters Completion
;
;Call: T1/ NU.RCC
; T2,UN/ UN Block address
; SB/ SV Block address
; CALL RCSRCC
; Normal Return
;Changes T1,T2,RB
RESCD
RCSRCC: LOAD RB,UNRID,(UN) ;Get RB address
LOAD MS,RBMSO,(RB) ;Get MSD address
LOAD T1,RBRNO,(RB) ;Pass receipt number
LOAD T2,UNBFA,(UN) ;Pass address of counter block
MOVE T3,MS ;Pass MSD address
CALL BLDCTR ;Build counters message
LOAD T1,RBDST,(RB) ;Get source of this request
LOAD T2,RBDST,+1(RB)
STOR T1,UNSAD,(UN) ;Store as request source for XMTRPY
STOR T2,UNSAD,+1(UN)
MOVE T1,RB ;Pass RB address
CALL DNFWDS ;Release the RB
CALL XMTRPY ;Transmit the reply resonse
RET ;Take failure return
RET ;Success - RETURN from RCSRCC
;END of Routine RCSRCC
SUBTTL Remote Console Protocol Server -- RCSRSC - Process Read Station Complete
;RCSRSC - Exit Routine to Handle KLNI Read Station Info Completion
;
;Call: T1/ NU.RSC
; T2,UN/ UN Block address
; SB/ SV Block address
; CALL RCSRSC
; Normal Return
;Changes T1,T2,RB
RESCD
RCSRSC: RET
RETSKP ;Success - RETURN from RCSRSC
;END of Routine RCSRSC
SUBTTL Console Server -- XMTRPY - Transmit MOP Reply
;XMTRPY - Transmit LLMOP Reply Using Received MSD/Buffer and Callback UN
;
;Call: SB/ SV Block address
; UN/ UN Block address
; MS/ MSD address
; CALL XMTRPY
; Error Return
; Normal Return
;Changes T1,T2
;
RESCD
XMTRPY: LOAD T1,UNSAD,(UN) ;Get Source Address
LOAD T2,UNSAD,+1(UN) ; ans send from whence it came
CALL XMTMSD ;Transmit this MSD
RET ;Failed...
RETSKP ;Success - RETURN from XMTRPY
;END of Routine XMTRPY
SUBTTL Console Server -- RCSIDS - Identify Self
;RCSIDS - Perform Remote Console Server Identify Self Function
;
;Call: From SCHED CLKLV2
; CALL RCSIDS
; Normal Return
;Changes T1
;
;Nota Bene: The periodic Identify-Self function must always
; succeed in order to meet the DIGITAL Ethernet Node
; Product Architecture Specification requirements. To
; meet this requirement all memory for performing this
; function is preallocated here.
;
; ***** This routine needs to be updated to handle multiple KLNI's *****
;
RESCD
RCSIDS::SAVEAC <UN,SB>
TRVAR <MSGLEN,BP,MP>
XMOVEI SB,RCSSVB ;Set up SB
MOVE T1,RCSATB ;Get Identify-Self Timer Base
MOVEM T1,LLMACT ;Reset the clock timer
TMNE SVDLS,(SB) ;Data Link State ON for this channel?
RET ;No, just return
;Send to multi-cast address on each channel
XMOVEI UN,SV.IXB(SB) ;Get address of RCS UN block
LOAD T3,UNPID,(UN) ;Get RCS's Portal-id
XMOVEI UN,PIDSUN ;Get address of our UN Block
STOR T3,UNPID,(UN) ;Set our Portal-id in this UN
XMOVEI T1,RCSSIM ;Get address of IM block
XMOVEI MS,IM.MSD(T1) ;Get address of MSD
MOVX T1,0 ;Pass receipt number of zero
MOVE T2,MS ;Pass MSD address
CALL BLDSID ;Build the SYSTEM ID message
STOR MS,UNBFA,(UN) ;Store MSD address in UN
STOR MS,UNRID,(UN) ;And make it our return ID
MOVEI T1,NU.XMT ;DLL Transmit Function code
MOVE T2,UN ;Pass address of UN Block
CALL DLLUNI ;Call DLL User to NI Interface Block
IFNSK.
LOAD T2,UNCHN,(UN) ;Get channel number
XCT RCS3XF ;Do the BUG.
ELSE.
INCRF SVTTI,(SB) ;Bump count of transmits initiated
SKIPA ;Enable BUGINF by patching
XCT RCSPIS ;Do the BUG.
ENDIF.
RET ;Normal return
;END of Routine RCSIDS
SUBTTL Console Server -- BLDSID - Build SYSTEM ID message
;BLDSID - Build SYSTEM ID message
;
;Call: T1/ Receipt Number
; T2/ MSD Address
; CALL BLDSID
; Error Return
; Normal Return
;Changes T1,T2
;
RESCD
BLDSID: SAVEAC <P1> ;Preserve an AC
MOVE P1,T1 ;Save RECEIPT NUMBER
MOVE T1,T2 ;Get MSD Address
CALL DNPINI ;Initialize MSD for output
MOVEI T1,FCSSID ;Get System ID function code
CALL DNP1BY ;Store in message
MOVEI T1,0 ;Store reserved field
CALL DNP1BY
MOVE T1,P1 ;Get receipt number given us
CALL DNP2BY ;Store receipt number in message
;Build MAINTENANCE VERSION in SYSTEM ID message
MOVEI T1,3 ;Pass INFO LENGTH
MOVEI T2,IT.MVN ;Pass INFO TYPE
CALL INFHDR ;Build INFO header
MOVE T1,MOPVER
CALL DNP1BY ;Store maintenance version
MOVE T1,MOPECO
CALL DNP1BY ;Store ECO
MOVE T1,MOPUEC
CALL DNP1BY ;Store User ECO
;Build FUNCTIONS in SYSTEM ID message
MOVEI T1,2
MOVEI T2,IT.FCT ;Functions
CALL INFHDR ;Build INFO header
MOVX T1,<MFLOOP!MFDLCT> ;We support Loop and Data Link counters
CALL DNP2BY
;Build HARDWARE ADDRESS in SYSTEM ID message
MOVX T1,NU.RCI ;Get Read Channel Info function code
MOVE T2,UN ;Pass address of UN Block
SETZRO UNBSZ,(UN) ;Indicate no aux buffer
CALL DLLUNI ;Call DLL User to NI Interface
NOP ;Ignore error
MOVEI T1,6
MOVEI T2,IT.HAD ;Hardware Address
CALL INFHDR ;Build INFO header
LOAD T1,UNHAD,(UN) ;Get hardware address
LOAD T2,UNHAD,+1(UN)
CALL DNPENA
;Build SYSTEM TIME in SYSTEM ID message
;
;*****
;Might have to do this in JOB0 (MEXEC) or look into possibility
; of calling routines in DATIME.
;*****
MOVEI T1,^D10
MOVEI T2,IT.SYT ;System Time
CALL INFHDR ;Build INFO header
MOVX T1,^D19
CALL DNP1BY ;Store CENTURY
MOVX T1,^D84
CALL DNP1BY ;Store YEAR
MOVX T1,^D2
CALL DNP1BY ;Store MONTH
MOVX T1,^D23
CALL DNP1BY ;Store DAY
MOVX T1,^D12
CALL DNP1BY ;Store HOUR
MOVX T1,^D30
CALL DNP1BY ;Store MINUTE
MOVX T1,^D30
CALL DNP1BY ;Store SECOND
MOVX T1,^D50
CALL DNP1BY ;Store 100TH
MOVX T1,-^D5
CALL DNP1BY ;Store TDFH
MOVX T1,^D0
CALL DNP1BY ;Store TDFM
;Build COMMUNICATION DEVICE in SYSTEM ID message
MOVEI T1,1
MOVEI T2,IT.CDV ;Communication Device
CALL INFHDR ;Build INFO header
MOVX T1,^D15 ;Code for KLNI Device
CALL DNP1BY
;Build DATA LINK in SYSTEM ID message
MOVEI T1,1
MOVEI T2,IT.DLK ;Data Link
CALL INFHDR ;Build INFO header
MOVX T1,1
CALL DNP1BY
;Build DATA LINK BUFFER SIZE in SYSTEM ID message
MOVEI T1,2
MOVEI T2,IT.DBS ;Data Link Buffer Size
CALL INFHDR ;Build INFO header
MOVX T1,^D262
CALLRET DNP2BY
;END of Routine BLDSID
SUBTTL Console Server -- QUEMSD - Queue an INPut MSD
;QUEMSD - Queue an INPut MSD
;
;Call: RB/ Request Block address
; MS/ address of MSD to be queued
; CALL QUEMSD
; Normal Return always
;Changes T1
;
RESCD
QUEMSD: ETHLOK ;Interlock the RB
TMNE RBMSI,(RB) ;Is the queue empty?
IFSKP. ;Yes...
STOR MS,RBMSI,(RB) ;Just link this MSD
ELSE. ;No...
LOAD T1,RBMSI,(RB) ;Get first MSD address
DO. ;Loop thru to end of list
TMNN MDNXT,(T1) ;At end?
IFSKP. ;No...
LOAD T1,MDNXT,(T1) ;Get next MSD address
JRST TOP. ;Do next
ENDIF.
ENDDO. ;Yes..
STOR MS,MDNXT,(T1) ;Link this MSD at end
ENDIF.
ETHULK ;Let go of RB interlock
RET
;END of Routine QUEMSD
SUBTTL Console Server -- DEQMSD - DEQueue an input MSD
;DEQMSD - DEQueue an input MSD
;
;Call: RB/ Request Block address
; CALL DEQMSD
; Return +1: Queue Empty
; Return +2: MS/ Address of MSD Dequeued
;Changes T1
;
RESCD
DEQMSD: ETHLOK ;Interlock the RB
TMNE RBMSI,(RB) ;Is there an MSD available?
IFSKP. ;No...
ETHULK
SETZ MS, ;Clear the MSD address
RET
ENDIF.
LOAD MS,RBMSI,(RB) ;Get address of input MSD
LOAD T1,MDNXT,(MS) ;Get next MSD address
STOR T1,RBMSI,(RB) ;Make this the next MSD
ETHULK ;Let go of RB interlock
RETSKP
;END of Routine DEQMSD
SUBTTL Console Server -- INFHDR - Build INFO Header
;INFHDR - Build INFO Header in SYSTEM ID message
;
;Call: T1/ INFO LENGTH value
; T2/ INFO TYPE value
; CALL INFHDR
; Error Return
; Normal Return
;Changes T1,T2
;
RESCD
INFHDR: SAVEAC <P1> ;Preserve an AC
MOVE P1,T1 ;Save INFO LENGTH
MOVE T1,T2 ;Get INFO TYPE
CALL DNP2BY ;Store INFO TYPE in message
MOVE T1,P1 ;Get INFO LENGTH
CALL DNP1BY ;Store INFO LENGTH in message
RET
;END of Routine INFHDR
SUBTTL Console Server -- BLDCTR - Build COUNTERS Message
;BLDCTR - Build COUNTERS Message
;
;Call: T1/ Receipt Number
; T2/ Counter Block Address
; T3/ MSD Address
; CALL BLDCTR
; Error Return
; Normal Return
;Changes T1,T2
;
CC=WK ;CC used in this routine only
RESCD
BLDCTR: SAVEAC <P1,P2> ;Preserve some ACs
DMOVE P1,T1 ;Save RECEIPT NUMBER and COUNTER BLOCK address
SAVEAC <CC>
MOVE T1,T3 ;Get MSD Address
CALL DNPINI ;Initialize MSD for output
MOVEI T1,FCCNTR ;Get COUNTERS function code
CALL DNP1BY ;Store in message
MOVE T1,P1 ;Get receipt number given us
CALL DNP2BY ;Set receipt number
MOVE CC,P2 ;Get address of counter block
LOAD T1,CCSLZ,(CC) ;Pass Seconds since last zeroed
CALL DNP2BY ;Output Seconds since last zeroed
LOAD T1,CCBYR,(CC) ;Pass Bytes received
CALL DNP4BY ;Output Bytes Received
LOAD T1,CCBYS,(CC) ;Pass Bytes sent
CALL DNP4BY ;Output Bytes Sent
LOAD T1,CCDGR,(CC) ;Pass Datagrams received
CALL DNP4BY ;Output Frames Received
LOAD T1,CCDGS,(CC) ;Pass Datagrams sent
CALL DNP4BY ;Output Frames Sent
LOAD T1,CCMBR,(CC) ;Pass Multicast bytes received
CALL DNP4BY ;Output Multicast Bytes Received
LOAD T1,CCMDR,(CC) ;Pass Multicast datagrams received
CALL DNP4BY ;Output Multicast Frames Received
LOAD T1,CCDSD,(CC) ;Pass Datagrams sent, initially deferred
CALL DNP4BY ;Output Frames Sent, Initially Deferred
LOAD T1,CCDS1,(CC) ;Pass Datagrams sent, single collision
CALL DNP4BY ;Output Frames Sent, Single Collision
LOAD T1,CCDSM,(CC) ;Pass Datagrams sent multiple collisions
CALL DNP4BY ;Output Frames Sent, Multiple Collisions
LOAD T1,CCSF,(CC) ;Pass Send failures
CALL DNP2BY ;Output Send Failure
LOAD T1,CCSFM,(CC) ;Pass Send failure bit mask
LSH T1,-4 ;Right justify it
CALL DNP2BY ;Output Send Failure Reason Bitmap
LOAD T1,CCRF,(CC) ;Pass Receive failure
CALL DNP2BY ;Output Receive Failure
LOAD T1,CCRFM,(CC) ;Pass Receive failure bit mask
LSH T1,-4 ;Right justify it
CALL DNP2BY ;Output Receive Failure Reason Bitmap
LOAD T1,CCUFD,(CC) ;Pass Unrecognized frame destination
CALL DNP2BY ;Output Unrecognized Frame Destination
LOAD T1,CCDOV,(CC) ;Pass Data overrun
CALL DNP2BY ;Output Data Overrun
LOAD T1,CCSBU,(CC) ;Pass System buffer unavailable
CALL DNP2BY ;Output System Buffer Unavailable
LOAD T1,CCUBU,(CC) ;Pass User buffer unavailable
CALL DNP2BY ;Output User Buffer Unavailable
RET
;END of Routine BLDCTR
SUBTTL Console Server -- INPMSD - Initialize INPut MSD
;INPMSD - Initialize INPut MSD
;
;Call: T1/ UN Block Address
; CALL INPMSD
; Normal Return always, MS/ MSD address
;Changes T1,T2,T3,T4
;
RESCD
INPMSD: SAVEAC <UN> ;Allocate UN block pointer
MOVE UN,T1 ;Save address of UN block
MOVX T1,UN.LEN ;Get length of UN block
MOVE T2,UN ;Get source UN address
LOAD T3,UNRID,(UN) ;Get address of MSD we saved as ID
XMOVEI T3,MD.LEN(T3) ;'Shadow' UN is appended to MD
EXTEND T1,[XBLT] ;Copy the UN block to 'shadow'
LOAD T1,UNRID,(UN) ;Get address of MSD we saved as ID
LOAD T2,UNBFA,(UN) ;Get received pointer
LOAD T3,UNBFA,+1(UN) ; and global address
LOAD T4,UNBSZ,(UN) ;Get received message length in bytes
CALLRET DNGMSS ;Set up MSD for receive buffer
;END of Routine INPMSD
SUBTTL Protocol Server -- SETRBS - SET RB State
;SETRBS - SET RB State based on status flags
;
;Call: RB/ Request Block address
; CALL SETRBS
; Normal Return
;Changes T1
;
RESCD
SETRBS: LOAD T1,RBFLG,(RB) ;Get flags
TXNN T1,RB%FTI ;Transmit initiated?
IFSKP. ;And...
TXNN T1,<RB%FRC!RB%FRF> ;Receive done?
ANSKP. ;And...
TXNN T1,<RB%FTC!RB%FTF> ;Transmit done?
ANSKP. ;Yes...
MOVX T1,.RQCMP ;Then request is complete to user
ELSE. ;No...
MOVX T1,.RQPND ;Then its pending to user
ENDIF.
STOR T1,RBSTT,(RB) ;Set state in RB
RET
;END of Routine SETRBS
SUBTTL LLMOP Requestor -- .LLMOP - LLMOP% (Low Level MOP) JSYS Entry
IFN FTOPS20,<
;.LLMOP - Entry point to LLMOP JSYS handler
;
;Call: T1/ LLMOP% Function Code
; T2/ Argument Block Address
; CALL .LLMOP
; Error Return
; Normal Return
;Changes T2,T3,SB,LM
SWAPCD
.LLMOP::MCENT ;Establish "slow" JSYS context
SAVEAC <SB,RB,LM,UN> ;Allocate named AC variables for block pointers
MOVE LM,T2 ;Save address of users LLMOP% argument block
MOVX T3,SC%WHL!SC%OPR!SC%MNT ;Check for sufficient privilege
TDNN T3,CAPENB ;Against ENABLED capabilities
ITERR <WHELX1> ;Not good enough
CAIGE T1,.LLMIN ;Function code within range?
ITERR <ARGX02> ;No, error return 'Invalid Function'
ULOAD T2,LMCID,(LM) ;Get channel number
CAIL T2,0 ;Check for valid channel 0 to NKLNI-1
CAILE T2,NKLNI-1
ITERR <LLMX05> ;Not valid, return 'Invalid Channel Number'
IMULI T2,SV.LEN ;Get offset to SVB for this channel
CAILE T1,.ELSTS ;Is it a Loopback function?
IFSKP. ;Yes...
XMOVEI SB,LPSSVB(T2) ;Get address of channels SVB
ELSE. ;No..., Not Loopback
CAIL T1,LMTBMX ;Within range for Remote Console?
ITERR <ARGX02> ;No, error return 'Invalid Function'
XMOVEI SB,RCSSVB(T2) ;Get address of channels SVB
ENDIF.
TMNE SVDLS,(SB) ;Data Link State ON for this channel?
ITERR <LLMX02> ;No, LLMOP is OFF
CALL @FUNTAB(T1) ;Yes, Dispatch to Function specific routine
ITERR ;Return on error from .LLMOP
MRETNG ;Return on success from .LLMOP
>; END IFN FTOPS20
SUBTTL LLMOP - TOPS10 .LLMOP UUO Handler
IFN FTOPS10,<
;LLMOP. - Entry point for LLMOP. UUO handler
;
;Call: T1/ LLMOP. Function Code
; T2/ Argument Block Address
; CALL LLMOP.
; Error Return
; Normal Return
;
; Changes: T2,T3,SB,LM
ULLMOP::SAVEAC <SB,RB,LM,UN> ;ALLOCATE VARIABLES FOR BLOCK POINTERS
MOVSI T1,JP.POK ;
CALL PRVBIT## ;WHEEL or POKE privileges?
SKIPA ;OK, CONTINUE
JSUERR (,LMPRV%) ;INSUFFICIENT PRIVILEGES
MOVE M,P1 ;GET UUO AC
CALL GETWDU## ;GET FIRST AC
MOVE P2,T1 ;SAVE FUNCTION CODE
CALL GETWD1## ;GET SECOND AC
MOVE LM,T1 ;SAVE ARG BLOCK ADDRESS
MOVEI T2,10 ;CHECK ARG LIST
PUSHJ P,ARNGE## ;...
JSUERR (,LMADC%) ;ADDRESS CHECK
JFCL ;ADDRESS ILLEGAL FOR I/O
CAIGE P2,.LLMIN ;FUNCTION CODE WITHIN RANGE?
JSUERR (,LMILF%) ;NO, ILLEGAL FUNCTION
ULOAD T2,LMCID,(LM) ;GET CHANNEL NUMBER
CAIL T2,0 ;CHECK FOR VALID CHANNEL 0 TO NKLNI-1
CAILE T2,NKLNI-1
JSUERR (,LMICN%) ;INVALID CHANNEL NUMBER
IMULI T2,SV.LEN ;GET OFFSET TO SVB FOR THIS CHANNEL
CAILE P2,.ELSTS ;IS IT A LOOPBACK FUNCTION?
IFSKP. ;YES
XMOVEI SB,LPSSVB(T2) ;GET ADDRESS OF CHANNELS SVB
ELSE. ;NO, NOT LOOPBACK
CAIL P2,LMTBMX ;WITHIN RANGE FOR REMOTE CONSOLE?
JSUERR (,LMILF%) ;NO, ILLEGAL FUNCTION
XMOVEI SB,RCSSVB(T2) ;GET ADDRESS OF CHANNELS SVB
ENDIF.
TMNE SVDLS,(SB) ;DATA LINK STATE ON FOR THIS CHANNEL?
JSUERR (,LMOFF%) ;NO, LLMOP IS OFF
MOVX T1,FUNBUF ;DOES THIS FUNCTION HAVE A BUFFER?
TDNN T1,FUNTAB(P2) ;...
PJRST @FUNTAB(P2) ;NO, DISPATCH TO ROUTINE
ULOAD T1,LMRBP,(LM) ;GET BUFFER POINTER
ULOAD T2,LMMBL,(LM) ;AND LENGTH OF BUFFER
PUSHJ P,CHKBPT## ;ADDRESS CHECK BUFFER
JSUERR (,LMADC%) ;ADDRESS CHECK
PJRST @FUNTAB(P2) ;DISPATCH TO ROUTINE
>; END IFN FTOPS10
SUBTTL LLMOP - JSYS/UUO FunctionTable
FUNBUF==100000,,000000 ;Function has secondary buffer
FUNTAB: IFIW+FUNBUF+LPRDIR ;Ethernet Loop Direct
IFIW+FUNBUF+LPRAST ;Ethernet Loop Assisted
IFIW+FUNBUF+LPRRPY ;Ethernet Loop Read Reply
IFIW LPRAIC ;Ethernet Loop Assign Interrupt Channel
IFIW LPRABT ;Ethernet Loop Abort
IFIW LPRSTS ;Ethernet Loop Get Request Status
IFIW RCRRID ;Remote Console Read Identity
IFIW RCRRCT ;Remote Console Read Counters
IFIW RCRIDS ;Remote Console Identify Self
IFIW RCRRBT ;Remote Console Remote Boot
IFIW+FUNBUF+RCRRPY ;Remote Console Read Reply
IFIW RCRRSV ;Reserve Remote Console
IFIW RCRREL ;Release Remote Console
IFIW+FUNBUF+RCRSND ;Send Console Command
IFIW+FUNBUF+RCRPOL ;Console Response Poll
IFIW RCRAIC ;Assign Interrupt channel
IFIW RCRABT ;Abort Request
IFIW RCRSTS ;Remote Console Check Request Status
IFIW RCRADR ;Obtain Ethernet Addresses
LMTBMX==.-FUNTAB ;Maximum Table Entry
SUBTTL Loop Protocol Requestor -- LPRDIR - Ethernet Loop Direct
;LPRDIR - Perform Ethernet Loop Direct Loopback Requestor Function
;
;Call: T1/ LLMOP% Function Code
; LM/ Argument Block address
; SB/ SV Block address
; CALL LPRDIR
; Error Return
; Normal Return
;Changes T1,T2
; RB/ Request Block address
;
SWAPCD
LPRDIR: CALL LRQINI ;Initialize Protocol Request Block
RETBAD ;If failed...
CALL LPHDRI ;Initialize loopback message header
LOAD T1,UNCAR,+SV.IXB(SB) ;Get HI order Channel Physical Address bytes
LOAD T2,UNCAR,+<SV.IXB+1>(SB) ;Get LO order CPA
CALL LPHDRF ;Create forward data packet
CALL LPHDRN ;Create reply data packet
;Set up destination address
ULOAD T2,LMDST,(LM) ;Get 1st word of destination address
STOR T2,RBDST,(RB) ;Store in RB
ULOAD T2,LMDST,+1(LM) ;Get 2nd word of destination address
STOR T2,RBDST,+1(RB) ;Store in RB
CALL XMTREQ ;Transmit the request message
RETBAD ;If failed...
RETSKP ;Success - RETURN from LPRDIR
;END of Routine LPRDIR
SUBTTL Loop Protocol Requestor -- LPRAST - Ethernet Loop Assisted
;LPRAST - Perform Ethernet Loop Assisted Loopback Requestor Function
;
;Call: T1/ LLMOP% Function Code
; LM/ Argument Block Address
; SB/ SV Block address
; CALL LPRAST
; Error Return
; Normal Return
;Changes T1,T2
; RB/ Request Block address
;
SWAPCD
LPRAST: CALL LRQINI ;Initialize Protocol Request Block
RETBAD ;If failed...
CALL LPHDRI ;Initialize loopback message header
ULOAD T3,LMHLP,(LM) ;Get the assistance level
CAIE T3,.LMRCV
IFSKP. ;Do receive assistance
ULOAD T2,LMDST,(LM) ;Get destination address
STOR T2,RBDST,(RB) ;Store in RB
ULOAD T2,LMDST,+1(LM)
STOR T2,RBDST,+1(RB)
ULOAD T1,LMAST,(LM) ;Get assistance address
ULOAD T2,LMAST,+1(LM)
CALL LPHDRF ;Create forward data packet
ELSE. ;Do transmit or full assistance
ULOAD T2,LMAST,(LM) ;Get assistance address
STOR T2,RBDST,(RB) ;Store in RB
ULOAD T2,LMAST,+1(LM)
STOR T2,RBDST,+1(RB)
ULOAD T1,LMDST,(LM) ;Get destination address
ULOAD T2,LMDST,+1(LM)
CAIN T3,.LMXMT
IFSKP.
CAIE T3,.LMFUL
IFSKP. ;Do full assistance
CALL LPHDRF ;Create forward data packet
ULOAD T1,LMAST,(LM) ;Get assistance address
ULOAD T2,LMAST,+1(LM)
CALL LPHDRF ;Create forward data packet
ELSE. ;Invalid assistance level
RETBAD
ENDIF.
ELSE. ;Do transmit assistance
CALL LPHDRF ;Create forward data packet
ENDIF.
ENDIF.
LOAD T1,UNCAR,+SV.IXB(SB) ;Get HI order Channel Physical Address bytes
LOAD T2,UNCAR,+<SV.IXB+1>(SB) ;Get LO order CPA
CALL LPHDRF ;Create forward data packet
CALL LPHDRN ;Create reply data packet
CALL XMTREQ ;Transmit the request message
RETBAD ;If failed...
RETSKP ;Success - RETURN from LPRAST
;END of Routine LPRAST
SUBTTL Loop Protocol Requestor -- LPHDRI - Loopback Message Header Initialization
;LPHDRI - Initialize the header portion of a loopback request message
;
;Call: RB/ Request Block address
; CALL LPHDRI
; Normal Return MS/ Loop header MSD address
;Changes T1,MS
;
SWAPCD
LPHDRI: ;Entry
;Set skip count to zero
MOVEI T1,0 ;Skip count zero
CALLRET DNP2BY ;Write into message and RETURN from LPHDRI
;END of Routine LPHDRI
SUBTTL Loop Protocol Requestor -- LPHDRF - Loopback Message Header Forward Packet
;LPHDRF - Create Loopback Message Forward Packet
;
;Call: T1/ Bytes 0-3 of Ethernet Address
; T2/ Bytes 4,5 of Ethernet Address
; MS/ Loop header MSD address
; CALL LPHDRF
; Normal Return
;Changes T1,T2
;
SWAPCD
LPHDRF: SAVEAC <P1,P2> ;Preserve some ACs
DMOVE P1,T1 ;Save Hi and LO order bytes
;Set function code to 'forward data' (02)
MOVEI T1,2 ;Function code 02
CALL DNP2BY ;Write into message
;Store our Ethernet address as forward address
MOVE T1,P1 ;Get Hi Order 4 bytes
MOVE T2,P2 ;Get Lo Order 2 bytes
CALL DNPENA ;Store address in message
RET ;RETURN from LPHDRF
;END of Routine LPHDRF
SUBTTL Loop Protocol Requestor -- LPHDRN - Loopback Message Header Reply and Request Number
;LPHDRN - Create Loopback Reply Packet
;
;Call: MS/ MSD address
; RB/ Request Block address
; CALL LPHDRN
; Normal Return
;Changes T1
;
SWAPCD
LPHDRN: ;Entry
;Set next function code to 'reply data' (01)
MOVEI T1,1 ;Function code 01
CALL DNP2BY ;Write into message
;Set receipt number
LOAD T1,RBRNO,(RB) ;Get receipt number from RB
CALL DNP2BY ;Write into message
RET ;RETURN from LPHDRN
;END of Routine LPHDRN
SUBTTL Loop Protocol Requestor -- LPRRPY - Read Loop Reply
;LPRRPY - Read Loop Reply
;
;Call: T1/ LLMOP% Function Code
; LM/ Argument Block Address
; SB/ SV Block address
; CALL LPRRPY
; Error Return
; Normal Return
;Changes T1,T2,MS
SWAPCD
LPRRPY: CALLRET RCRRPY ;Same function as RCRRPY
;END of Routine LPRRPY
SUBTTL Loop Protocol Requestor -- LPRAIC - Assign Interrupt Channel
;LPRAIC - Assign Interrupt Channel
;
; Nota bene: This function was originally planned but later
; implemented by LPRAIC bit in request. It's not needed but left
; in as a dinosaur.
;
;Call: T1/ LLMOP% Function Code
; LM/ Flags, Interrupt Channel
; SB/ SV Block address
; CALL LPRAIC
; Error Return
; Normal Return
;Changes T1
SWAPCD
LPRAIC: ;Ethernet Loop Assign Interrupt Channel
JSUERR (ARGX02,) ;Error return 'Invalid Function' from LPRAIC
;END of Routine LPRAIC
SUBTTL Loop Protocol Requestor -- LPRABT - Ethernet Loop Abort
;LPRABT - Perform Ethernet Loop Abort Loopback Requestor Function
;
;Call: T1/ LLMOP% Function Code
; LM/ Argument Block Address
; SB/ SV Block address
; CALL LPRABT
; Error Return
; Normal Return
;Changes T1,T2,RB
SWAPCD
LPRABT: ULOAD T1,LMREQ,(LM) ;Get the Receipt Number of the request
MOVE T2,SB ;Pass address of SVB
CALL LPSSXQ ;Search queue for RB for this request
JSUERR (LLMX04,) ;Request does not exist
MOVE RB,T2 ;Make RB Address safe
MOVE T1,RB ;Get address of RB
MOVE T2,SB ;Pass address of SVB
CALL LPSRMQ ;Remove it from queue
JFCL ;Failed...
LOAD T1,RBMSI,(RB) ;Get address of input MSD and buffer
CAIN T1,0 ;An MSD there?
IFSKP. ;Yes...
CALL DNFWDS ;Release the buffer
ENDIF.
MOVE T1,RB ;Get address of RB
CALL DNFWDS ;Release the RB
RETSKP ;Success - RETURN from LPRABT
;END of Routine LPRABT
SUBTTL Loop Protocol Requestor -- LPRSTS - Get Request Status
;LPRSTS - Get Request Status of Loop Request
;
;Call: T1/ LLMOP% Function Code
; LM/ Argument Block Address
; SB/ SV Block address
; CALL LPRSTS
; Error Return
; Normal Return
;Changes T1,T2
SWAPCD
LPRSTS: ULOAD T1,LMREQ,(LM) ;Get the Receipt Number of the request
MOVE T2,SB ;Pass address of SVB
CALL LPSSXQ ;Search queue for RB for this request
JSUERR (LLMX04,) ;Request does not exist
MOVE RB,T2 ;Get RB address
LOAD T1,RBFLG,(RB) ;Get flags, Assume RB%FTI
TXNN T1,<RB%FRC!RB%FRF> ;Receive done?
IFSKP. ;And...
TXNN T1,<RB%FTC!RB%FTF> ;Transmit done?
ANSKP. ;Yes...
MOVX T1,.RQCMP ;Then request is complete to user
ELSE. ;No...
MOVX T1,.RQPND ;Then its pending to user
ENDIF.
USTOR T1,LMRTC,(LM) ;Store the new status and flags
RETSKP ;Success - RETURN from LPRSTS
;END of Routine LPRSTS
SUBTTL Loop Protocol Requestor -- LRQINI - Request Block Initialization
;LRQINI - Perform Ethernet Protocol Requestor Request Block Initialization
;
;Call: LM/ Argument Block Address
; CALL LRQINI
; Error Return
; Normal Return RB/ Request Block Address
;Changes T1,T2,RB
SWAPCD
LRQINI: ;Request Block Initialization
MOVEI T1,RB.LEN ;Obtain and Initialize a Request Block (RB)
CALL DNGWDZ ;Get a clean block for RB
JSUERR (MONX07,) ;Failed... Return with Error Code
MOVE RB,T1 ;Save address of RB
;Initialize the state in RB
MOVX T1,.RQINV ;Set request state invalid
STOR T1,RBSTT,(RB)
IFN FTOPS20,<
MOVE T1,JOBNO ;Get Users Job Number
STOR T1,RBJOB,(RB) ;Store in RB
MOVE T1,FORKX ;Get Users Fork Number
STOR T1,RBFRK,(RB) ;Store in RB
>; END IFN FTOPS20
IFN FTOPS10,<
MOVE T1,.CPJCH## ;Get current JCH
STOR T1,RBJCH,(RB) ;Store in RB
>; END IFN FTOPS10
;Initialize MSD chain in RB
XMOVEI MS,LH.MSD(RB) ;Get address of Header MSD
XMOVEI T1,LD.MSD(RB) ;Get address of User Data MSD
MOVX T2,LHH.LN ;Length of LH buffer
XMOVEI T3,LH.DAT(RB) ;Get address of LH buffer
CALL MSDINI ;Initialize MSD
;Store a special ID for transmit complete
MOVX T1,'LLM' ;Identifier for LLMOP
STOR T1,LHIDD,(RB) ;Store special ID
;Copy info from users argument block to RB
ULOAD T2,LMCID,(LM) ;Get channel id
STOR T2,RBCID,(RB) ;Store in RB
IFN FTOPS20,<
ULOAD T1,LMAIC,(LM) ;Interrupt channel assigned?
STOR T1,RBAIC,(RB) ;Store interrupt assigned flag
ULOAD T1,LMICH,(LM) ;Get the interrupt channel
STOR T1,RBICH,(RB) ;Store Interrupt Channel number
>; END IFN FTOPS20
;Initialize User Data MSD
SETZRO MDALL,+LD.MSD(RB) ;Clear allocated length, not relevant here
SETZRO MDALA,+LD.MSD(RB) ;Clear allocated address, not relevant here
;Set receipt number in RB
NOSKED ;Interlock the SVB from other processes
LOAD T2,RBCID,(RB) ;Get channel number
IMULI T2,SV.LEN ;Get offset of SVB for this channel
XMOVEI SB,LPSSVB(T2) ;Get address of SV block for LPS
CALL SETRNO ;Set up receipt number
OKSKED ;Let go of SVB interlock
;Build Request Block (RB) from User's Argument Block
;Store receipt number in user argument block
LOAD T2,RBRNO,(RB) ;Get receipt assigned to this request
USTOR T2,LMREQ,(LM) ;Give to user as Request Number
;Set up MSD for user data
ULOAD T1,LMMBL,(LM) ;Get length of user loopback data
STOR T1,MDBYT,+LD.MSD(RB) ;Store bytes written in user data MSD
;*****
;
; Convert users Loopback data pointer to user virtual address.
; MAP User Virtual Address to Physical page number and LOCK
; the page down in resident memory. Store the Physical address
; in the MSD for use by the driver. LPSXTC will UNLOCK the page
; when Transmit is complete.
;
;*****
ULOAD T1,LMRBP,(LM) ;Get users Loopback data pointer
STOR T1,MDPTR,+LD.MSD(RB) ;Store users virtual pointer in MSD
CALL CNVPTR ;Convert User pointer to address
RET ;Illegal Ptr, Return with error
STOR T1,MDAUX,+LD.MSD(RB) ;Store indexed pointer
STOR T2,MDALA,+LD.MSD(RB) ;Store users virtual address
IFN FTOPS20,<
MOVE T1,T2 ;Make copy of virtual address
TXO T1,<1B0> ;Set bit 0 to indicate user virtual
CALL MLKMA ;Lock the page, returning core page number
LSH T1,WID(777) ;Convert page to physical address
LOAD T2,MDALA,+LD.MSD(RB) ;Get users virtual address
TXZ T2,<777777,,777000> ;Get just the offset
IOR T1,T2 ;Set offset into physical page
STOR T1,MDALA,+LD.MSD(RB) ;Store physical address
MOVX T1,VMC.NO ;Get code for Physical Address
STOR T1,MDVMC,+LD.MSD(RB) ;Store it in MSD
>; END IFN FTOPS20
IFN FTOPS10,<
XMOVEI T1,LD.MSD(RB) ;Get address of MSD
CALL MAKMBF ;Create a monitor buffer
RET ;Error
>; END IFN FTOPS10
RETSKP ;Success - RETURN from LRQINI
;END of Routine LRQINI
SUBTTL Remote Console Protocol Requestor -- RCRRID - Read Identity
;RCRRID - Perform Read Identity Remote Console Requestor Function
;
;Call: T1/ LLMOP% Function Code
; LM/ Argument Block Address
; SB/ SV Block address
; CALL RCRRID
; Error Return
; Normal Return
;Changes
SWAPCD
RCRRID: CALL CRQINI ;Initialize Remote Console ReQuest Block
RETBAD
CALL SETRNO ;Set up receipt number
MOVX T1,FCRQID ;Get Request ID function code
CALL DNP1BY ;Store function code in message
MOVX T1,0
CALL DNP1BY ;Store reserved byte in message
LOAD T1,RBRNO,(RB) ;Get Receipt Number of this request
CALL DNP2BY ;Store in message
CALL XMTREQ ;Transmit the request message
RETBAD ;If failed...
RETSKP ;Success - RETURN from RCRRID
;END of Routine RCRRID
SUBTTL Remote Console Protocol Requestor -- RCRRCT - Read Counters
;RCRRCT - Perform Read Counters Remote Console Requestor Function
;
;Call: T1/ LLMOP% Function Code
; LM/ Argument Block Address
; SB/ SV Block address
; CALL RCRRCT
; Error Return
; Normal Return
;Changes
SWAPCD
RCRRCT: CALL CRQINI ;Initialize Remote Console ReQuest Block
RETBAD
CALL SETRNO ;Set up receipt number
MOVX T1,FCRQCT ;Get Request Counters function code
CALL DNP1BY ;Store function code in message
LOAD T1,RBRNO,(RB) ;Get Receipt Number of this request
CALL DNP2BY ;Store in message
CALL XMTREQ ;Transmit the request message
RETBAD ;If failed...
RETSKP ;Success - RETURN from RCRRCT
;END of Routine RCRRCT
SUBTTL Remote Console Protocol Requestor -- RCRIDS - Identify Self
;RCRIDS - Perform Identify Self Remote Console Requestor Function
;
;Call: T1/ LLMOP% Function Code
; LM/ Argument Block Address
; SB/ SV Block address
; CALL RCRIDS
; Error Return
; Normal Return
;Changes
SWAPCD
RCRIDS: ;Remote Console Identify Self
CALL RCSIDS ;Same as server
RETSKP ;Success - RETURN from RCRIDS
;END of Routine RCRIDS
SUBTTL Remote Console Protocol Requestor -- RCRRBT - Remote Boot
;RCRRBT - Perform Remote Boot Remote Console Requestor Function
;
;Call: T1/ LLMOP% Function Code
; LM/ Argument Block Address
; SB/ SV Block address
; CALL RCRRBT
; Error Return
; Normal Return
;Changes
SWAPCD
RCRRBT:
IFN FTOPS10,<
ULOAD T1,LMCFB,(LM) ;Get Control Information
TXNN T1,LM%BDV ;Specify boot device?
IFSKP. ;Yes, address check string
ULOAD T1,LMDID,(LM) ;Get byte pointer to string
MOVEI T2,^D18 ;And maximum string length
PUSHJ P,CHKBPT## ;Check byte pointer
JSUERR (,LMADC%) ;Address check
ENDIF.
ULOAD T1,LMSID,(LM) ;Get byte pointer to string
MOVEI T2,^D18 ;And maximum string length
PUSHJ P,CHKBPT## ;Check byte pointer
JSUERR (,LMADC%) ;Address check
>; END IFN FTOPS10
SAVEAC <WK> ;Save preserved work AC
CALL CRQINI ;Initialize Remote Console ReQuest Block
RETBAD
MOVX T1,FCBOOT ;Get Remote Boot function code
CALL DNP1BY ;Store function code in message
ULOAD T1,LMPWD,(LM) ;Get Verification Password
CALL DNPHIO ;Use this also for password bytes 0,1,2,3
ULOAD T1,LMPWD,+1(LM) ;And bytes 4,5,6,7 also
CALL DNPHIO
ULOAD T1,LMCFB,(LM) ;Get Control Information
CALL DNP2BY ;Store fields in message
TXNN T1,LM%BDV ;Boot Device Specified?
IFSKP. ;Yes, put Device Id field in message
MOVX T1,1 ;Copy just first byte (count)
ULOAD T2,LMDID,(LM) ;Get Device Id (Pointer)
CALL DNCU2M ;Copy from user buffer to message
OPSTR <LDB T1,>,MDPTR,(MS) ;Get the count byte back
CAIG T1,^D17 ;Ensure C-17 field
IFSKP.
CALL DNBKBY ;Back up over count byte
MOVX T1,^D17 ;Get maximum count
CALL DNP1BY ;Put count in message
ENDIF.
ULOAD T2,LMDID,(LM) ;Get Device Id (Pointer) again
IBP T2 ;Bump pointer past count byte
CALL DNCU2M ;Copy from user buffer to message
ENDIF.
MOVX T1,1 ;Copy just first byte (count)
ULOAD T2,LMSID,(LM) ;Get Software Id (Pointer)
CALL DNCU2M ;Copy from user buffer to message
OPSTR <LDB T1,>,MDPTR,(MS) ;Get the count byte back
CAILE T1,277 ;Is it negative? (-n for generic form)
IFSKP. ;No, T1 has length of Id field
CAIG T1,^D17 ;Ensure C-17 field
IFSKP. ;Field too long...
CALL DNBKBY ;Back up over count byte
MOVX T1,^D17 ;Get maximum count
CALL DNP1BY ;Put count in message
ENDIF.
ULOAD T2,LMSID,(LM) ;Get Software Id (Pointer) again
IBP T2 ;Bump pointer past count byte
CALL DNCU2M ;Copy from user buffer to message
ENDIF.
SETONE RBABT,(RB) ;Force interrupt level to release RB
CALL XMTRCM ;Transmit the request message
RETBAD ;If failed...
RETSKP ;Success - RETURN from RCRRBT
;END of Routine RCRRBT
SUBTTL Remote Console Protocol Requestor -- RCRRPY - Read Reply
;RCRRPY - Read Remote Console Requestor Reply Function
;
;Call: T1/ LLMOP% Function Code
; LM/ Argument Block Address
; SB/ SV Block address
; CALL RCRRPY
; Error Return
; Normal Return
;Changes
SWAPCD
RCRRPY: ULOAD T1,LMREQ,(LM) ;Get Request Number
MOVE T2,SB ;Pass address of SVB
CALL LPSSXQ ;Search RB queue
JSUERR (LLMX04,) ;Not found
MOVE RB,T2 ;Save RB address in RB
LOAD T1,RBSTT,(RB) ;Get state
CAIN T1,.RQCMP ;Complete?
IFSKP. ;No..., Dismiss user until reply arrives
IFN FTOPS20,<
LOAD T1,RBRNO,(RB) ;Get request number
HRL T1,T1 ;In left half
HRRI T1,RCRWAI ;Wait routine address in right half
MOVEM RB,FKSTA2(FX) ;Store RB address for use by SCHED test routine
MDISMS ;T1/ Request #,,Routine Addr
>; END IFN FTOPS20
IFN FTOPS10,<
CALL RBWAIT ;Wait for RB completion
>; END IFN FTOPS10
ENDIF.
CALL DEQMSD ;Dequeue an MSD
JSUERR (LLMX99,) ;None there...
CALL DNRPOS ;Get length of user data
ULOAD T2,LMMBL,(LM) ;Get User Max Buffer Length
CAMLE T1,T2 ;Will it fit in buffer?
MOVE T1,T2 ;No, truncate **** Or RETBAD? *****
USTOR T1,LMRML,(LM) ;Return received length to user
ULOAD T2,LMRBP,(LM) ;Pass users command response buffer pointer
CALL DNCM2U ;Move data to user
JSUERR (ATSX17,) ;Failed, Why?... BUG?
XMOVEI UN,MD.LEN(MS) ;Get address of 'shadow' UN block
LOAD T1,UNSAD,(UN) ;Get the source address
USTOR T1,LMSRC,(LM) ;Give to user
LOAD T1,UNSAD,+1(UN)
USTOR T1,LMSRC,+1(LM)
TMNN RBMSI,(RB) ;Is there another MSD available?
IFSKP. ;Yes...
SETO T1, ;Set the 'more replies flag'
USTOR T1,LMMRF,(LM) ; in users flags word
ELSE. ;No...
MOVE T1,RB ;Get address of RB
MOVE T2,SB ;Pass address of SVB
CALL LPSRMQ ;Remove it from queue
JFCL ;Failed...
MOVE T1,RB ;Get address of RB
CALL DNFWDS ;Release the RB
ENDIF.
MOVE T1,MS ;Get address of input MSD and receive buffer
CALL DNFWDS ;Release the MSD and buffer
MOVE T1,SB ;Pass SV block address
CALL PSTBUF ;Post a receive buffer
NOP ;Ignore failure
RETSKP ;Success - RETURN from RCRRPY
;Wait routine for scheduler, called with Request # in T1
; RB address in FKSTA2, FX with fork table index
RESCD
IFN FTOPS20,<
RCRWAI: MOVE T2,FKSTA2(FX) ;Get RB address
OPSTR <CAME T1,>,RBRNO,(T2) ;This the right request?
RET ;No...
LOAD T1,RBSTT,(T2) ;Get current request state
CAIE T1,.RQCMP ;Is Request Complete?
RET ;No, wait some more
RETSKP ;Yes, let it go
>; END IFN FTOPS20
;END of Routine RCRRPY
SUBTTL Remote Console Protocol Requestor -- RCRSTS - Check Request Status
;RCRSTS - Perform Check Request Status Remote Console Requestor Function
;
;Call: T1/ LLMOP% Function Code
; LM/ Argument Block Address
; SB/ SV Block address
; CALL RCRSTS
; Error Return
; Normal Return
;Changes
SWAPCD
RCRSTS: ULOAD T1,LMREQ,(LM) ;Get the Receipt Number of the request
MOVE T2,SB ;Pass address of SVB
CALL LPSSXQ ;Search queue for RB for this request
JSUERR (LLMX04,) ;Request does not exist
MOVE RB,T2 ;Get RB address
LOAD T1,RBFLG,(RB) ;Get flags
;Assume RB%FTI
TXNN T1,<RB%FRC!RB%FRF> ;Receive done?
IFSKP. ;And...
TXNN T1,<RB%FTC!RB%FTF> ;Transmit done?
ANSKP. ;Yes...
MOVX T1,.RQCMP ;Then request is complete to user
ELSE. ;No...
MOVX T1,.RQPND ;Then its pending to user
ENDIF.
USTOR T1,LMRTC,(LM) ;Store the new status and flags
RETSKP ;Success - RETURN from RCRSTS
;END of Routine RCRSTS
SUBTTL Remote Console Protocol Requestor -- RCRADR - Get Addresses
;RCRADR - Obtain KLNI Ethernet Local Addresses
;
;Call: T1/ LLMOP% Function Code
; LM/ Argument Block Address
; SB/ SV Block address
; CALL RCRADR
; Normal Return Always
;Changes
SWAPCD
RCRADR: XMOVEI UN,SV.IXB(SB) ;Get address of UN block
MOVX T1,NU.RCI ;Get Read Channel Info function code
MOVE T2,UN ;Pass address of UN Block
SETZRO UNBSZ,(UN) ;Indicate no aux buffer
CALL DLLUNI ;Call DLL User to NI Interface
NOP ;Ignore error
LOAD T1,UNHAD,(UN) ;Get hardware address
LOAD T2,UNHAD,+1(UN)
USTOR T1,LMHWA,(LM) ;Store the hardware address
USTOR T2,LMHWA,+1(LM)
LOAD T1,UNCAR,(UN) ;Get the current physical address
LOAD T2,UNCAR,+1(UN)
USTOR T1,LMPYA,(LM) ;Store the physical address
USTOR T2,LMPYA,+1(LM)
RETSKP ;Success - RETURN from RCRADR
;END of Routine RCRADR
SUBTTL Remote Console Protocol Requestor -- RCRRSV - Reserve Remote Console
;RCRRSV - Perform Reserve Remote Console Requestor Function
;
;Call: T1/ LLMOP% Function Code
; LM/ Argument Block Address
; SB/ SV Block address
; CALL RCRRSV
; Error Return
; Normal Return
;Changes
SWAPCD
RCRRSV: CALL CRQINI ;Initialize Remote Console ReQuest Block
RETBAD
MOVX T1,FCRSVC ;Get Reserve Console function code
CALL DNP1BY ;Store function code in message
ULOAD T1,LMPWD,(LM) ;Get Verification Password
CALL DNPHIO ;Use this also for password bytes 0,1,2,3
ULOAD T1,LMPWD,+1(LM) ;And bytes 4,5,6,7 also
CALL DNPHIO
SETONE RBABT,(RB) ;Force interrupt level to release RB
CALL XMTRCM ;Transmit the request message
RETBAD ;If failed...
RETSKP ;Success - RETURN from RCRRSV
;END of Routine RCRRSV
SUBTTL Remote Console Protocol Requestor -- RCRREL - Release Remote Console
;RCRREL - Perform Release Remote Console Requestor Function
;
;Call: T1/ LLMOP% Function Code
; LM/ Argument Block Address
; SB/ SV Block address
; CALL RCRREL
; Error Return
; Normal Return
;Changes
SWAPCD
RCRREL: CALL CRQINI ;Initialize Remote Console ReQuest Block
RETBAD
MOVX T1,FCRELC ;Get Release Console function code
CALL DNP1BY ;Store function code in message
SETONE RBABT,(RB) ;Force interrupt level to release RB
CALL XMTRCM ;Transmit the request message
RETBAD ;If failed...
RETSKP ;Success - RETURN from RCRREL
;END of Routine RCRREL
SUBTTL Remote Console Protocol Requestor -- RCRSND - Send Console Command
;RCRSND - Perform Send Console Command Remote Console Requestor Function
;
;Call: T1/ LLMOP% Function Code
; LM/ Argument Block Address
; SB/ SV Block address
; CALL RCRSND
; Error Return
; Normal Return
;Changes
SWAPCD ;Send Console Command
RCRSND: CALL CRQINI ;Initialize Remote Console ReQuest Block
RETBAD
CALL SCCINI ;Set up RB for Console Command data
RETBAD
XMOVEI T1,CH.MSD(RB) ;Get address of Console header MSD
CALL DNPINI ;Initialize for output
MOVX T1,FCCCAP ;Get Console Command and Poll function code
CALL DNP1BY ;Store function code in message
ULOAD T1,LMCCF,(LM) ;Get message number and command break flag
CALL DNP1BY ;Store Control Flags
CALL XMTREQ ;Transmit the request message
RETBAD ;If failed...
RETSKP ;Success - RETURN from RCRSND
;END of Routine RCRSND
SUBTTL Remote Console Protocol Requestor -- RCRPOL - Console Response Poll
;RCRPOL - Perform Console Response Poll Remote Console Requestor Function
;
;Call: T1/ LLMOP% Function Code
; LM/ Argument Block Address
; SB/ SV Block address
; CALL RCRPOL
; Error Return
; Normal Return
;Changes
SWAPCD
RCRPOL: ;Console Response Poll
ULOAD T1,LMREQ,(LM) ;Get Request Number
MOVE T2,SB ;Pass address of SVB
CALL LPSSXQ ;Search RB queue
JSUERR (LLMX04,) ;Not found
MOVE RB,T2 ;Save RB address in RB
LOAD T1,RBSTT,(RB) ;Get state
CAIN T1,.RQCMP ;Complete?
IFSKP. ;No..., Dismiss user until reply arrives
IFN FTOPS20,<
LOAD T1,RBRNO,(RB) ;Get request number
HRL T1,T1 ;In left half
HRRI T1,RCRWAI ;Wait routine address in right half
MOVEM RB,FKSTA2(FX) ;Store RB address for use by SCHED test routine
MDISMS ;T1/ Request #,,Routine Addr
>; END IFN FTOPS20
IFN FTOPS10,<
CALL RBWAIT ;Wait for RB completion
>; END IFN FTOPS10
ENDIF.
LOAD MS,RBMSI,(RB) ;Get address of input MSD
CALL DNG1BY ;Get control flags byte
MOVEI T1,0 ;If short message, set flags to zero
USTOR T1,LMRCF,(LM) ;Store Console Response Control Flags
CALL DNRPOS ;Get length of user data
CAIGE T1,0 ;If negative?
SETZI T1,0 ; Make it zero
ULOAD T2,LMMBL,(LM) ;Get User Max Buffer Length
CAMLE T1,T2 ;Will it fit in buffer?
MOVE T1,T2 ;No, truncate **** Or RETBAD? *****
USTOR T1,LMRML,(LM) ;Return received length to user
ULOAD T2,LMRBP,(LM) ;Pass users command response buffer pointer
CALL DNCM2U ;Move data to user
JSUERR (ATSX17,) ;Failed, Why?... BUG?
MOVE T1,RB ;Get address of RB
MOVE T2,SB ;Pass address of SVB
CALL LPSRMQ ;Remove it from queue
JFCL ;Failed...
LOAD T1,RBMSI,(RB) ;Get address of input MSD and receive buffer
CALL DNFWDS ;Release the MSD and buffer
MOVE T1,RB ;Get address of RB
CALL DNFWDS ;Release the RB
MOVE T1,SB ;Pass SV block address
CALL PSTBUF ;Post a receive buffer
NOP ;Ignore failure
RETSKP ;Success - RETURN from RCRPOL
;END of Routine RCRPOL
SUBTTL Remote Console Protocol Requestor -- RCRAIC - Assign Interrupt Channel
;RCRAIC - Assign Interrupt Channel Remote Console Requestor Function
;
;Call: T1/ LLMOP% Function Code
; LM/ Argument Block Address
; SB/ SV Block address
; CALL RCRAIC
; Error Return
; Normal Return
;Changes T1
SWAPCD
RCRAIC: ;Assign Interrupt Channel
IFN FTOPS20,<
ULOAD T1,LMAIC,(LM)
SKIPN T1 ;Assigning channel for unsolicited SID's?
IFSKP. ;Yes...
NOSKED ;Interlock the SVB
OPSTR <SKIPE>,SVCFN,(SB) ;Already assigned? If so, don't allow.
IFSKP. ;Not yet assigned, give it to this process
ULOAD T1,LMICH,(LM) ;Get the interrupt channel
CALL CHKCHL ;Verify it's validity
IFSKP. ;If it's OK...
STOR T1,SVICH,(SB) ;Store the Configurator Interrupt Channel
MOVE T1,FORKX
STOR T1,SVCFN,(SB) ;Store Configurator fork index
OKSKED
ELSE. ;If it's an invalid channel...
OKSKED
RETBAD ;Return error from CHKCHL
ENDIF.
ELSE. ;If it's already been assigned...
OKSKED
RETBAD (LLMX06) ;Give 'already assigned' error return
ENDIF.
ENDIF.
>; END IFN TOPS20
RETSKP ;Success - RETURN from RCRAIC
;END of Routine RCRAIC
SUBTTL Remote Console Protocol Requestor -- RCRABT - Abort Request
;RCRABT - Abort Remote Console Request Function
;
;Call: T1/ LLMOP% Function Code
; LM/ Argument Block Address
; SB/ SV Block address
; CALL RCRABT
; Error Return
; Normal Return
;Changes T1,T2
SWAPCD
RCRABT: ULOAD T1,LMREQ,(LM) ;Get the Receipt Number of the request
MOVE T2,SB ;Pass address of SVB
CALL LPSSXQ ;Search queue for RB for this request
JSUERR (LLMX04,) ;Request does not exist
MOVE RB,T2 ;Make RB Address safe
MOVE T1,RB ;Get address of RB
MOVE T2,SB ;Pass address of SVB
CALL LPSRMQ ;Remove it from queue
JFCL ;Failed...
ETHLOK ; Absolutely, positively, no interrupts
LOAD T1,RBSTT,(RB) ; Get state
CAIN T1,.RQCMP ; Did this request complete?
IFSKP. ; Nope, abort this function
SETONE RBABT,(RB) ; Abort when NISRV returns the buffer
ETHULK ; Enable interrupts
RETSKP ; Return success
ENDIF.
ETHULK ; Re-enable interrupts
LOAD T1,RBMSI,(RB) ;Get address of input MSD and buffer
CAIN T1,0 ;An MSD there?
IFSKP. ;Yes...
CALL DNFWDS ;Release the buffer
ENDIF.
MOVE T1,RB ;Get address of RB
CALL DNFWDS ;Release the RB
RETSKP ;Success - RETURN from RCRABT
;END of Routine RCRABT
SUBTTL Remote Console Protocol Requestor -- CRQINI - Request Block Initialization
;CRQINI - Perform Ethernet Protocol Requestor Request Block Initialization
;
;Call: LM/ Argument Block Address
; SB/ SV Block address
; CALL CRQINI
; Error Return
; Normal Return RB/ Request Block Address
;Changes T1,T2,RB
SWAPCD ;Request Block Initialization
CRQINI: MOVEI T1,RB.LEN ;Obtain and Initialize a Request Block (RB)
CALL DNGWDZ ;Get a clean block for RB
JSUERR (MONX07,) ;Failed... Return with Error Code
MOVE RB,T1 ;Save address of RB
;Initialize the state in RB
MOVX T1,.RQINV ;Set request state invalid
STOR T1,RBSTT,(RB)
IFN FTOPS20,<
MOVE T1,JOBNO ;Get Users Job Number
STOR T1,RBJOB,(RB) ;Store in RB
MOVE T1,FORKX ;Get Users Fork Number
STOR T1,RBFRK,(RB) ;Store in RB
>; END IFN FTOPS20
IFN FTOPS10,<
MOVE T1,.CPJCH## ;Get current JCH
STOR T1,RBJCH,(RB) ;Store in RB
>; END IFN FTOPS10
;Initialize MSD chain in RB
XMOVEI MS,CH.MSD(RB) ;Get address of Header MSD
SETZ T1, ;No Data MSD
MOVX T2,RCH.LN ;Length of CH buffer
XMOVEI T3,CH.DAT(RB) ;Get address of CH buffer
CALL MSDINI ;Initialize MSD
;Store a special ID for transmit complete
MOVX T1,'LLM' ;Identifier for LLMOP
STOR T1,CHIDD,(RB) ;Store special ID
;Copy info from users argument block to RB
ULOAD T2,LMCID,(LM) ;Get channel id
STOR T2,RBCID,(RB) ;Store in RB
IFN FTOPS20,<
ULOAD T1,LMAIC,(LM) ;Interrupt channel assigned?
STOR T1,RBAIC,(RB) ;Store interrupt assigned flag
ULOAD T1,LMICH,(LM) ;Get the interrupt channel
STOR T1,RBICH,(RB) ;Store Interrupt Channel number
>; END IFN FTOPS20
;Set up destination in RB
ULOAD T2,LMDST,(LM) ;Get 1st word of destination address
STOR T2,RBDST,(RB) ;Store in RB
ULOAD T2,LMDST,+1(LM) ;Get 2nd word of destination address
STOR T2,RBDST,+1(RB) ;Store in RB
RETSKP ;Success - RETURN from CRQINI
;END of Routine CRQINI
SUBTTL Remote Console Protocol Requestor -- MSDINI - MSD Request Block Initialization
;MSDINI - MSD Request Block Initialization
;
;Call: T1/ Address of Data MSD
; T2/ Length of Header MSD Data Buffer
; T3/ Address of Header MSD Data Buffer
; MS/ Address of (1st) Header MSD
; RB/ Request Block Address
; CALL MSDINI
; Normal Return Always
;Changes T1
MSDINI: SWAPCD ;Request Block MSD Initialization
STOR MS,RBMSO,(RB) ;Initialize MSD chain in RB
STOR T1,MDNXT,(MS) ;Link Data MSD to Header MSD
SETZRO MDNXT,(T1) ;Clear link field of Data MSD
;Initialize Header MSD
STOR T2,MDALL,(MS) ;Set allocated Header MSD Data Buffer size
STOR T3,MDALA,(MS) ;Set address of Header MSD Data Buffer
MOVX T1,VMC.XC ;Mark this as an EXEC context buffer
STOR T1,MDVMC,(MS) ;Store it in MSD
MOVE T1,MS ;Get address of Header MSD
CALL DNPINI ;Initialize for output
RET
SUBTTL Remote Console Protocol Requestor -- SETRNO - Set Request Receipt Number
;SETRNO - Set Request Receipt Number in RB and User's argument block
;
;Call: LM/ Argument Block Address
; SB/ SV Block address
; RB/ Request Block Address
; CALL SETRNO
; Normal Return Always
;Changes T2
SWAPCD ;Request Block Initialization
SETRNO: LOAD T2,SVNXR,(SB) ;Get next receipt number
STOR T2,RBRNO,(RB) ;Store in RB
;Store receipt number in user argument block
USTOR T2,LMREQ,(LM) ;Give to user as Request Number
;Calculate the Next Receipt Number
ADDI T2,1 ;Increment receipt number
TXNE T2,<1B<35-16>> ;Overflow 16 bits?
MOVEI T2,1 ;Yes..., Start over again at 1
STOR T2,SVNXR,(SB) ;Store updated receipt number
RET ;Success - RETURN from SETRNO
;END of Routine SETRNO
SUBTTL Remote Console Protocol Requestor -- SCCINI - ASCII Console Cxr Initialization
;SCCINI - Perform Initialization for Send Console Command
;
;Call: LM/ Argument Block Address
; SB/ SV Block address
; RB/ Request Block Address
; CALL SCCINI
; Error Return
; Normal Return
;Changes T1,T2
SWAPCD ;ASCII Console Carrier RB Initialization
SCCINI: XMOVEI MS,CD.MSD(RB) ;Point to Command Data MSD
STOR MS,MDNXT,+CH.MSD(RB) ;Link CD from CH
SETZRO MDNXT,(MS) ;Clear link field to make CD the last MSD
ULOAD T1,LMMBL,(LM) ;Get length of Command data
STOR T1,MDBYT,(MS) ;Store bytes written in Command data MSD
;*****
;
; Convert users data pointer to user virtual address.
; MAP User Virtual Address to Physical page number and LOCK
; the page down in resident memory. Store the Physical address
; in the MSD for use by the driver. The Transmit Callback
; routine will UNLOCK the page when Transmit is complete.
;
;*****
ULOAD T1,LMRBP,(LM) ;Get Users Command data pointer
STOR T1,MDPTR,(MS) ;Store User virtual pointer in MSD
CALL CNVPTR ;Convert User pointer to address
RET ;Illegal Ptr, Return with error
STOR T1,MDAUX,(MS) ;Store indexed pointer
STOR T2,MDALA,(MS) ;Store users virtual address
IFN FTOPS20,<
MOVE T1,T2 ;Make copy of virtual address
TXO T1,<1B0> ;Set bit 0 to indicate user virtual
CALL MLKMA ;Lock the page, returning core page number
LSH T1,WID(777) ;Convert page to physical address
LOAD T2,MDALA,(MS) ;Get users virtual address
TXZ T2,<777777,,777000> ;Get just the offset
IOR T1,T2 ;Set offset into physical page
STOR T1,MDALA,(MS) ;Store physical address
MOVX T1,VMC.NO ;Get code for Physical Address
STOR T1,MDVMC,(MS) ;Store it in MSD
>; END IFN FTOPS20
IFN FTOPS10,<
MOVE T1,MS ;Get address of MSD
CALL MAKMBF ;Create a monitor buffer
RET ;Error
>; END IFN FTOPS10
;
;Hack a request number here as a special case for CONSOLE RESPONSE POLL.
;We use the low order portion of the destination Ethernet address. We
;can do this safely, since, there can be only one host node reserving
;the console on the remote node. Note, that this code overides what
;has already been done in CRQINI.
;
LOAD T1,RBDST,+1(RB) ;Use low order bits of destination address
LSH T1,-<^D36-^D16>
STOR T1,RBRNO,(RB) ;Store in RB
USTOR T1,LMREQ,(LM)
RETSKP ;Success - RETURN from SCCINI
;END of Routine SCCINI
SUBTTL Loop Protocol Requestor -- XMTREQ - Transmit MOP Request Message
;XMTREQ - Transmit LLMOP Request Message
;
;Call: RB/ Request Block address
; SB/ SV Block address
; CALL XMTREQ
; Error Return
; Normal Return
;Changes T1,T2
;
SWAPCD
XMTREQ: MOVE T1,RB ;Pass address of RB
MOVE T2,SB ;Pass address of SVB
CALL LLMQUE ;Queue RB on protocol server request queue
MOVE T1,SB ;Pass SV Block address
CALL PSTBUF ;Try to have a receive buffer ready
NOP ;Ignore failure
CALL XMTRCM ;Transmit this MSD
IFNSK. ;Failed...
MOVE T1,RB ;Get address of RB
MOVE T2,SB ;Pass address of SVB
CALL LPSRMQ ;Remove RB from Queue
JFCL ;Failed...
RETBAD ;Error - Pass error up
ENDIF.
RETSKP ;Success - RETURN from XMTREQ
;END of Routine XMTREQ
SUBTTL Loop Protocol Requestor -- XMTRCM - Transmit MOP Remote Console Message
;XMTRCM - Transmit LLMOP Remote Console Message
;
; Send a Remote Console message when no response is expected.
;
;Call: RB/ Request Block address
; SB/ SV Block address
; CALL XMTRCM
; Error Return
; Normal Return
;Changes T1,T2
;
SWAPCD
XMTRCM: MOVX T1,UN.LEN ;Pass length of UN block
CALL DNGWDZ ;Allocate a UN block
JSUERR (MONX07,) ;Failed..., Say system resources exhausted
XMOVEI UN,SV.IXB(SB) ;Get address of protocol server UN block
LOAD T3,UNPID,(UN) ;Get Server's Portal-id
MOVE UN,T1 ;Get address of our UN Block
STOR T3,UNPID,(UN) ;Set our Portal-id
LOAD MS,RBMSO,(RB) ;Get head of output MSD chain
LOAD T1,RBDST,(RB) ;Get Destination Address
LOAD T2,RBDST,+1(RB)
SETONE RBFTI,(RB) ;Set Transmit Initiated flag
CALL XMTMSD ;Transmit this MSD
IFNSK. ;Failed...
MOVE T1,RB ;Get address of RB
CALL DNFWDS ;Release RB
MOVE T1,UN ;Get address of UN
CALL DNFWDS ;Release UN
RETBAD ;Error - Pass error up
ENDIF.
MOVE T1,UN ;Get address of UN block
CALL DNFWDS ;Release UN
RETSKP ;Success - RETURN from XMTRCM
;END of Routine XMTRCM
SUBTTL LLMOP Local Utility -- XMTMSD - Transmit MOP Message using MSD
;XMTMSD - Transmit LLMOP Message pointed to by MSD
;
;Call: MS/ MSD Address
; UN/ UN Block Address
; SB/ SV Block address
; T1,T2/ Ethernet Destination Address
; CALL XMTMSD
; Error Return
; Normal Return
;Changes T1,T2
;
RESCD
XMTMSD: STOR MS,UNBFA,(UN) ;Store MSD as buffer address
SETZRO UNBSZ,(UN) ;Must be zero for MSD buffer
STOR MS,UNRID,(UN) ;Store our Request ID
IFN FTOPS20,<
SETZRO UNPTR,(UN) ;Indicate UNDAD contains immediate address
>; END IFN FTOPS20
STOR T1,UNDAD,(UN) ;Set Destination Address in UN Block
STOR T2,UNDAD,+1(UN)
INCRF SVTTI,(SB) ;Bump count of transmits initiated
MOVEI T1,NU.XMT ;DLL Transmit Function code
MOVE T2,UN ;Pass address of UN Block
CALL DLLUNI ;Call DLL User to NI Interface Block
IFNSK. ;Failed...
INCRF SVTTF,(SB) ;Bump count of transmit failures
LOAD T2,UNSTA,(UN) ;Get Channel Status
LOAD T3,UNCHN,(UN) ;Get channel number
XCT LPRLXF ;Do the BUG.
JSUERR (LLMX01,) ;Error - Transmit Failed
ENDIF.
RETSKP ;Success - RETURN from XMTMSD
;END of Routine XMTMSD
SUBTTL LLMOP Global Utility -- LLMRSF/LLMRSJ - ReSet for Fork/Job
IFN FTOPS20,<
;LLMRSQ - Reset RB Queue for LLMOP Protocol Servers
;
; This routine is called, at entry point LLMRSF, from .KFORK (.KSELF?) in
; FORK to release any RB's that might have been created by the
; fork which is being killed. The fork can be killed as a result
; of a superior fork doing either a RESET% or a KFORK% JSYS.
;
; This routine is called, at entry point LLMRSF, from .RESET in
; JSYSA to release any RB's that might have been created by the
; fork doing the RESET% JSYS.
;
; This routine is called, at entry point LLMRSJ, from FLOGO in
; MEXEC to clean up whenever the top fork in a job is killed.
; The top fork in a job is killed as a result of itself or some
; other fork doing a LGOUT% JSYS. This entry point may be
; unnecessary.
;
;Call:
; CALL LLMRSJ to kill LLMOP resources for entire job
; CALL LLMRSF to kill LLMOP resources for current fork
; Normal Return always
;Changes T1,T2
RESCD
;Entry for call to reset for whole job
LLMRSQ::
LLMRSJ::MOVE T1,[LOAD T4,RBJOB,(T2)] ;Instruction to check job ownership
MOVE T2,JOBNO ;Get this Job's number
JRST LLMRS2
;Entry for call to reset for current fork
LLMRSF::MOVE T1,[LOAD T4,RBFRK,(T2)] ;Instruction to check fork ownership
MOVE T2,FORKX ;Get this fork's fork index
LLMRS2: SAVEAC <SB> ;Make SB safe
TRVAR <XID,TSTOWN> ;Place to store Job/Fork id and test instr
MOVEM T1,TSTOWN ;Store instruction for owner compare
MOVEM T2,XID ;Store Job/Fork ID
XMOVEI SB,LPSSVB ;Get address of SVB for Loop Server
CALL LLMRST ;Go do the work
XMOVEI SB,RCSSVB ;Get address of SVB for Remote Console Server
LOAD T1,SVCFN,(SB) ;Get fork number of configurator
CAMN T1,FORKX ;This one?...
SETZRO SVCFN,(SB) ;Yes, clear it
CALL LLMRST ;Go do the work
RET ;RETURN from LLMRSQ
;END of Routine LLMRSQ
SUBTTL LLMOP Local Utility -- LLMRST - Reset Request Queue
;LLMRST - Reset Request Queue
;
;Call: SB/ Address of SVB
; XID/ Job/Fork Id (in TRansient VARiable)
; TSTOWN/ Instruction to test XID against RB (in TRansient VARiable)
; CALL LLMRST
; Normal Return Always
;Changes T1,T2
;
LLMRST: SAVEAC <RB> ;Make RB safe
OPSTR <XMOVEI T1,>,SVRQH,(SB) ;Get address of RB queue head
LLMRS1: ;Top of Loop
CALL LLMGNQ ;Point to next RB in queue
IFSKP. ;Got next RB
MOVE RB,T2 ;Save RB
XCT TSTOWN ;Get owners ID (Fork or Job) in T4
CAME T4,XID ;Belong to this owner?
IFSKP. ;Yes...
ETHLOK ;Interlock the queue structure
MOVE T3,SB ;Get address of SVB
;T1 has previous RB address
;T2 has address of RB to unqueue
CALL LLMUNQ ;Unqueue this RB
NOP ;Failed, Probably BUG!?
LOAD T3,RBSTT,(RB) ; Get state
CAIN T3,.RQCMP ; Did this request complete?
IFSKP. ; Nope, abort this function
SETONE RBABT,(RB) ; Abort when NISRV returns the buffer
ETHULK ; Enable interrupts
JRST LLMRS1 ; Loop till done
ENDIF.
ETHULK ; Re-enable interrupts
LOAD MS,RBMSI,(RB) ;Get Loop Reply MSD address
SKIPN MS ;Buffer allocated?
IFSKP. ;Yes, release it
EXCH T1,MS ;Get address and save T1
CALL DNFWDS ;Release buffer
EXCH MS,T1 ;Get T1 back
ENDIF.
EXCH T1,RB ;Pass address of RB, save previous
CALL DNFWDS ;Release the RB
MOVE T1,RB ;Restore previous
JRST LLMRS1 ;Go check for next RB in queue until done
ENDIF.
ENDIF.
RET ;End of queue - RETURN from LLMRST
;END of Routine LLMRST
>; END IFN FTOPS20
SUBTTL LLMOP Local Utility -- PSVINI - Protocol Server Initialization
;PSVINI - Initialize an Ethernet Protocol Server
;
; This routine initializes a protocol server on a single
; channel. The SV block contains the channel number, protocol
; type, multicast address, and callback vector.
;
;Call: T1/ SV Block Address
; CALL PSVINI
; Error Return if not initialized
; Normal Return
;Changes T1
RESCD
PSVINI: SAVEAC <SB,UN> ;Allocate named AC variables for block pointers
STKVAR <LOOPCT>
MOVE SB,T1 ;Save Address of SV Block
SETZRO SVIFG,(SB) ;Clear initialize flag and ...
SETZRO SVRCT,(SB) ; Total Received Count
SETZRO SVSRC,(SB) ; Server Received Count
SETZRO SVRRC,(SB) ; Requestor Received Count
SETZRO SVTTI,(SB) ; Total Transmits Initiated
SETZRO SVTCT,(SB) ; Total Transmit Count (Completed)
SETZRO SVSTC,(SB) ; Server Transmit Count
SETZRO SVRTC,(SB) ; Requestor Transmit Count
SETZRO SVBPC,(SB) ; Buffer Posted Count
MOVX T1,1 ;Indicate we've tried to initialize
STOR T1,SVIFG,(SB)
XMOVEI UN,SV.IXB(SB) ;Get address of static UN Block
LOAD T1,UNCBA,(UN) ;Get callback address
XMOVEI T1,(T1) ;Make it extended address
STOR T1,UNCBA,(UN) ;Set extended callback address
;Initialize the Protocol Server Next Receipt Number
CALL NRANDM ;Get Non-Repeating Random Number
STOR T1,SVNXR,(SB) ;Store as next receipt number to use
;Open an NI DLL Portal for this Protocol Type
MOVEI T1,NU.OPN ;DLL Open Function code
MOVE T2,UN ;Pass address of UN Block
CALL DLLUNI ;Call DLL User to NI Interface
IFNSK. ;Failed
SETONE SVDLS,(SB) ;Set an invalid Data Link state
RET ;Return on this failure
ENDIF.
IFN FTOPS20,<
SETZRO UNRSP,(UN) ;Set no completion callback desired
SETZRO UNPTR,(UN) ;Indicate UNDAD is immediate address
>; END IFN FTOPS20
LOAD T1,SVMCA,(SB) ;Get Multicast Address Bytes 0-3
STOR T1,UNDAD,(UN) ;Set in UN Block
LOAD T1,SVMCA,+1(SB) ;Get Multicast Address Bytes 4,5
STOR T1,UNDAD,+1(UN) ;Set in UN Block
MOVEI T1,NU.EMA ;DLL Declare Multicast Address Function code
MOVE T2,UN ;Pass address of UN Block
CALL DLLUNI ;Call DLL User to NI Interface
IFNSK.
SETONE SVDLS,(SB) ;Set an invalid Data Link state
XCT LLMMCF ;Do the BUG.
RET ;Return on this failure
ENDIF.
;Post Initial Protocol Server Receive Buffers
MOVE T1,SB ;Pass SVB address
CALL PSTBUF ;Post buffers
NOP ;Ignore failure
SETONE SVIFG,(SB) ;Set Initialize flag
RETSKP ;Success - RETURN from PSVINI
;END of Routine PSVINI
SUBTTL LLMOP Local Utility -- PSTBUF - Post Receive Buffer for Protocol Server
;PSTBUF - Routine to allocate and post receive buffer to Data Link
;
;Call: T1/ SV Block address
; CALL PSTBUF
; Error Return - Failed BUGCHKS's
; Normal Return
;Changes T1,T2
;Updates SVBPC in SV Block
RESCD
PSTBUF: SAVEAC <SB,UN> ;Allocate named AC variables for block pointers
SAVEAC <MS> ;Save MS so we can use it here
MOVE SB,T1 ;Set up SB
TMNE SVDLS,(SB) ;Data Link State ON for this channel?
RETSKP ;No, just return
XMOVEI UN,+SV.IXB(SB) ;Set up UN
PSTBF1: LOAD T1,SVBPC,(SB) ;Get count of receive buffers posted
OPSTR <CAML T1,>,SVIBN,(SB) ;Need to post receive buffers?
RETSKP ;NO, just return
MOVEI T1,<MD.LEN+UN.LEN+BUFSIZ> ;Storage for MSD, UN and receive buffer
CALL DNGWDS ;Allocate a buffer
IFSKP. ;Got a buffer, post it for receive
MOVE MS,T1 ;MSD is prepended to buffer
STOR MS,UNRID,(UN) ;Save MSD address for receive completion
XMOVEI T2,MD.LEN+UN.LEN(MS) ;Get address of receive data buffer
STOR T2,UNBFA,+1(UN) ;Store as two word global address
MOVX T3,BUFLEN ;Get length of buffer in bytes
STOR T3,UNBSZ,(UN) ;Set in UN Block
CALL DNGMSI ;Initialize MSD for raw buffer
LOAD T1,MDPTR,(MS) ;Get standard pointer... Make it
TXO T1,1B12 ; 2 word global, non-zero section
TLZ T1,37 ; Clear indexing and indirection
STOR T1,UNBFA,(UN) ;Store pointer in UN Block
MOVX T1,UNA.EV ;Buffer is Exec Virtual
STOR T1,UNADS,(UN) ;Indicate to driver
MOVEI T1,NU.RCV ;DLL Receive Function code
XMOVEI T2,SV.IXB(SB) ;Pass address of UN Block
CALL DLLUNI ;Call DLL User to NI Interface Block
IFNSK. ;Failed to accept buffer, BUGCHK
OPSTRM <AOS>,SVLBC,(SB) ;Bump count of lost buffers
LOAD T1,UNRID,(UN) ;Get Buffer address in UN Block
CALLRET DNFWDS ;Release the buffer fail return
ELSE.
INCRF SVBPC,(SB) ;Bump count of buffers posted to the DLL
ENDIF.
ELSE. ;Failed to allocate buffer
OPSTRM <AOS>,SVLBC,(SB) ;Bump count of lost buffers
RET ;Fail return
ENDIF.
JRST PSTBF1 ;Loop back to post buffers
;END of Routine PSTBUF
SUBTTL LLMOP Local Utility -- NRANDM - Non-Repeating Random Number
;NRANDM - Initialize Ethernet Loopback Protocol Server
;
;Call:
; CALL NRANDM
; Normal Return T1/ 16 bit Value
;Changes T1
RESCD
NRANDM:
;Here we initialize the next receipt number to a pseudo-random number.
;This reduces the risk of a reloaded system continuing a maintenance
;operation from before the crash. We use the high-order 16 bits of
;the time to avoid any similarities in the number due to a similar
;number of seconds since startup. System time will always start on an
;even second.
IFN FTOPS20,<
CALL LGTAD ;Get time & date
>; END IFN FTOPS20
IFN FTOPS10,<
MOVE T1,DATE## ;Get date
>; END IFN FTOPS10
ANDI T1,177777 ;Pare it down to 16 bits
RET ;Success - RETURN from NRANDM
;END of Routine NRANDM
SUBTTL LLMOP Local Utility -- LLMQUE - LLMOP Protocol Server Queue Routine
;LLMQUE - Queue RB for an LLMOP Protocol Server
;
;Call: T1/ RB address
; T2/ SVB address
; CALL LLMQUE
; Normal Return
;Changes T3
RESCD
LLMQUE: ETHLOK ;Interlock the queue structure
LOAD T3,SVRQT,(T2) ;Get address of RB queue tail
STOR T1,RBFWD,(T3) ;Make old tail point to new tail
STOR T1,SVRQT,(T2) ;Make this RB new tail
SETZRO RBFWD,(T1) ;Ensure this is end of queue
ETHULK ;Allow access to queue again
RET ;Success - RETURN from LLMQUE
;END of Routine LLMQUE
SUBTTL LLMOP Local Utility -- LLMGNQ - LLMOP Protocol Server Get Next RB in Queue
;LLMGNQ - Get address of next RB in Protocol Server Request Queue
;
;Call: T1/ Address of current RB
; CALL LLMGNQ
; Abnormal return, at end of queue T2/ 0
; Normal Return T2/ Address of next RB in queue
;Changes T2
RESCD
LLMGNQ: ETHLOK ;Interlock the queue structure
LOAD T2,RBFWD,(T1) ;Get address of next RB in queue
ETHULK ;Allow access to queue again
SKIPN T2 ;Is this last RB in queue?
RET ;Yes, Abnormal return
RETSKP ;Success - RETURN from LLMGNQ
;END of Routine LLMGNQ
SUBTTL LLMOP Local Utility -- LLMUNQ - LLMOP Protocol Server Unqueue RB from Queue
;LLMUNQ - Unqueue an RB in Protocol Server Request Queue
;
;Call: T1/ Address of RB preceding one to be unqueued
; T2/ Address of RB to be unqueued
; T3/ SVB Address for this queue
; CALL LLMUNQ
; Error return
; Normal Return
;Changes T4
RESCD
LLMUNQ: SAVEAC <SB> ;Allocate named AC variables for block pointers
ETHLOK ;Interlock the queue structure
MOVE SB,T3 ;Point to SVB
OPSTR <CAMN T2,>,RBFWD,(T1) ;This the one to remove?
IFSKP. ;No..., Take error return
ETHULK
RET
ENDIF.
LOAD T4,RBFWD,(T2) ;Yes..., Get address of RB following
SKIPE T4 ;At end of queue?
IFSKP. ;Yes..., One being removed was last
STOR T1,SVRQT,(SB) ;Make previous new tail
ENDIF.
STOR T4,RBFWD,(T1) ;Link from previous
SETZRO RBFWD,(T2) ;Clear link field of unqueued RB
ETHULK ;Allow access to queue again
RETSKP ;Success - RETURN from LLMUNQ
;END of Routine LLMUNQ
SUBTTL LLMOP Local Utility -- LPSRMQ - Loopback Protocol Server Remove RB from Queue
;LPSRMQ - Remove RB from Queue for Loopback Protocol Server
;
;Call:
; T1/ RB address
; T2/ SVB address
; CALL LPSRMQ
; Error return, Queue Empty or RB not in queue
; Normal Return T1/ RB Address
;Changes T1,T2
;Note: BUGCHK's if queue empty or RB not in queue
RESCD
LPSRMQ: SAVEAC <SB> ;Allocate named AC variables for block pointers
ETHLOK ;Interlock the queue structure
MOVE SB,T2 ;Save SVB address
XMOVEI T2,SV.RQH(SB) ;Get address of queue head
LPSRM1: SKIPE T3,(T2) ;Get address of next RB in queue
IFSKP.
ETHULK ;Allow access to queue again
XCT LLMRQC ;Do the BUG.
RET ;Take error return
ENDIF.
CAME T1,T3 ;This the one to remove?
IFSKP. ;Yes...
LOAD T3,RBFWD,(T3) ;Get address of next
SKIPE T3 ;Is there another?
IFSKP. ;No..., One being removed was last
STOR T2,SVRQT,(SB) ;Make previous new tail
ENDIF.
STOR T3,RBFWD,(T2) ;Link from previous
SETZRO RBFWD,(T1) ;Clear link field
ETHULK ;Allow access to queue again
RETSKP ;Success - RETURN from LPSRMQ
ENDIF. ;No...
MOVE T2,T3 ;Look at next RB
JRST LPSRM1
;END of Routine LPSRMQ
SUBTTL LLMOP Local Utility -- LPSSXQ - Loopback Protocol Server Search Queue
;LPSSXQ - Search RB Queue for Loopback Protocol Server
;
;Call:
; T1/ Receipt Number
; T2/ SVB address
; CALL LPSSXQ
; Error return Queue Empty or not found
; Normal Return T2/ RB Address
;Changes T1,T2
RESCD
LPSSXQ: SAVEAC <SB> ;Allocate named AC variables for block pointers
ETHLOK ;Interlock the queue structure
MOVE SB,T2 ;Save SVB address
XMOVEI T2,SV.RQH(SB) ;Get address of queue head
SKIPE (T2) ;Queue Empty?
IFSKP. ;Yes..., Error return
ETHULK
RET
ENDIF.
LPSSX1: ;Top of Loop
LOAD T2,RBFWD,(T2) ;Get address of next RB in queue
CAME T1,RB.RNO(T2) ;Receipt Number match?
IFSKP.
ETHULK ;Allow access to queue again
RETSKP ;Yes..., return RB address
ENDIF.
CAME T2,SV.RQT(SB) ;Is this last RB in queue?
JRST LPSSX1 ;No..., Keep looking
ETHULK ;Allow access to queue again
SKIPE T2 ;Yes, verify by having null pointer
RET ;Whoops, BUG!. Tail doesn't have null pointer
RET ;End of queue - RETURN from LPSSXQ
;END of Routine LPSSXQ
SUBTTL LLMOP Local Utility -- CNVPTR - Convert User to MSD style pointer
;CNVPTR - Convert pointer in user context to one word local pointer
; indexed by T6
;
;Call:
; T1/ users byte pointer
; CALL CNVPTR
; Error return (illegal pointer)
; Normal Return T1/ Pointer indexed by T6
; T2/ Virtual Address
;Changes T1,T2,T3
SWAPCD
CNVPTR:
LDB T3,[POINT 6,T1,5] ;Get P field
CAIG T3,44 ;P less than 36?
IFSKP. ;Yes..., One word global byte pointer
JSUERR (LLMX03,) ;Illegal! For now, but could convert to local
ELSE. ;No..., Two word global or Local pointer
TLNN T1,40 ;Bit 12 = 1?
IFSKP. ;Yes..., 2 word global byte pointer
JSUERR (LLMX03,) ;Illegal!
ELSE. ;No..., One word local byte pointer
MOVE T2,T1 ;Make a copy of pointer
TLZ T1,000037 ;Clear I & X fields
TRZ T1,777777 ;Clear Y field
LDB T3,[POINT 6,T1,11] ;Get size field
CAIE T3,^D8 ;Eight bit?
RET ;No, error
LDB T3,[POINT 6,T1,5] ;Get position field
CAIE T3,04 ;Pointer to next word?
IFSKP.
HRLI T1,441000 ;Yes, update pointer
AOJ T2, ;...
ENDIF.
MOVEI T3,T6 ;Get value of T6
DPB T3,[POINT 4,T1,17] ;Make pointer indexed by T6 in T1
TLZ T2,777740 ;Clear P & S fields and Bit 12
TXO T2,<XMOVEI T2,> ;Build XMOVEI with users I, X & Y
XCTU T2 ;Obtain address in T2
ENDIF.
ENDIF.
RETSKP ;RETURN from CNVPTR
;END of Routine CNVPTR
SUBTTL LLMOP Local Utility -- CHKCHL - Check and Verify Interrupt Channel Number
;CHKCHL - Verify Interrupt Channel Number to be in range
;
;Call:
; T1/ Channel Number
; CALL CHKCHL
; Error return, Channel Invalid
; Normal Return, Channel Valid
;
;Changes T1
;
SWAPCD
CHKCHL: CAIG T1,^D36 ;Within Range? (0 to 36)
CAIGE T1,0
JRST CHKILL ;No
CAILE T1,^D5 ;Within Range 0-5?
CAIL T1,^D23 ;Or Within Range 23-35
AOSA T1 ;Yes. A Good Channel
JRST CHKILL ;No. Illegal
RETSKP ;Return Good Value
CHKILL: JSUERR (ARGX13,) ;Invalid Channel
;END of Routine CHKCHL
SUBTTL TOPS-10 Specifics
IFN FTOPS10,<
;Routine called to create a monitor buffer for transmit datagrams
;Call:
; T1/ MSD address
; MDBYT: User byte count
; MDAUX: User byte pointer (P&S portion)
; MDALA: User buffer address
;Returns:
; CPOPJ on error
; CPOPJ1 on success
MAKMBF: SAVEAC <P1,P2,J> ;Save P1, P2 and J
MOVE P1,T1 ;Save MSD address
LOAD T1,MDBYT,(P1) ;Get user byte count
JUMPE T1,[SETZRO MDALA,(P1) ;If no allocation, clear address
RETSKP] ;And return
LDB P2,[POINT 3,MD.AUX(P1),2] ;Pick up word alignment
MOVNS P2 ;Negate
ADDI P2,7(T1) ;Calculate word count
ASH P2,-2 ;...
MOVE T1,P2 ;Get size of monitor buffer
MOVE J,.CPJOB## ;Get our job number
CALL DNGWDZ ;Get core for monitor buffer
RET ;Error, return
LOAD T2,MDALA,(P1) ;Get user address of buffer
MOVE T3,T1 ;Get monitor buffer address
STOR T1,MDALA,(P1) ;Save address of buffer
MOVE T1,P2 ;Get size of buffer
XBLTUX <T1> ;Copy user buffer into monitor buffer
RETSKP ;And return
;Routine called to free up monitor buffer
;Call:
; T1/ MSD address
; CALL FREMBF
;Returns:
; CPOPJ Always
FREMBF: SAVEAC <P1> ;Save P1
MOVE P1,T1 ;Save MSD address
SKIPE T1,MD.ALA(P1) ;Get address of monitor buffer
CALL DNFWDS ;Release buffer and return
RET
>; END IFN FTOPS10
IFN FTOPS10,<
;Routine to wait in event wait for a request block to complete
;Call:
; RB/ Address of request block
; CALL RBWAIT
;Returns:
; CPOPJ when request completes
RBWAIT: SAVEAC <J> ;Save J
SETONE RBEVW,(RB) ;Mark event wait
RBWAI1: LOAD T1,RBSTT,(RB) ;Get request state
CAXN T1,.RQCMP ;Completed?
RET ;Yes, return
MOVEI T1,EV.LLM ;Get LLMOP event wait code
LOAD J,RBJCH,(RB) ;Get JCH
ANDI J,JOBMSK## ;Mask to job number
CALL FSLEEP## ;Wait for completion
JRST RBWAI1 ;Loop back till request completes
;Routine to wake up waiting job
;Call:
; RB/ Address of request block
; CALL RBWAKE
;Returns:
; CPOPJ Always
RBWAKE: SAVEAC <J> ;Save J
OPSTR <SKIPN>,RBEVW,(RB) ;Job in event wait for this request?
IFNSK.
LOAD J,RBJCH,(RB) ;No, get JCH of job
SIGNAL C$LLM ;Signal LLMOP event
JFCL ; ...
RET ;And return
ENDIF.
LOAD T1,RBJCH,(RB) ;Get JCH of job
CALL CTXEWK## ;Wake it up
JFCL ;...
RET ;Return
>; END IFN FTOPS10
SUBTTL Core manager -- Get Some Words
IFN FTOPS10,<
;DNGWDS - Get some words, not zeroed
;
; Call:
; T1/ Count of words we want
;
; Return:
; RET ;ON ALLOCATION FAILURE
; RETSKP ;WITH T1 POINTING TO WORDS
;
;
;Note: The count of words allocated is stored in the word before the
;returned pointer.
DNGWDS: SAVEAC <P1> ;SAVE P1
HRRZ P1,T1 ;SAVE THE COUNT
MOVEI T2,1(T1) ;T2 GETS NUMBER OF WORDS.
MCALL (RG,MSEC1,GETEWS##) ; Go allocate memory
RET ; Tell caller we failed to get memory
MOVEM P1,(T1) ;STORE COUNT IN RH OF OVERHEAD WORD
MOVSI T2,'LLM' ;MAKE A TEST THINGY
HLLM T2,(T1) ;STORE IN LEFT HALF OF FIRST WORD
AOJ T1, ;RETURN POINTER TO USER PART OF BLOCK
RETSKP ;RETURN SUCCESS
SUBTTL Core manager -- Get Some Zeroed Words
;DNGWDZ - Just like DNGWDS but the words are smeared to zero.
; Note that this is quite a lot more expensive than DNGWDS.
;
; Call:
; T1/ Count of words we want
;
; Return:
; RET ;ON ALLOCATION FAILURE
; RETSKP ;WITH T1 POINTING TO WORDS
;
; Uses: T1-T4
;
;Note: The count of words allocated is stored in the word before the
;returned pointer.
DNGWDZ: SAVEAC <P1> ;SAVE P1
HRRZ P1,T1 ;SAVE THE COUNT
MOVEI T2,1(T1) ;T2 GETS NUMBER OF WORDS.
MCALL (RG,MSEC1,GETEWZ##) ; Go allocate memory
RET ; Tell caller we failed to get memory
MOVEM P1,(T1) ;STORE COUNT IN RH OF OVERHEAD WORD
MOVSI T2,'LLM' ;MAKE A TEST THINGY
HLLM T2,(T1) ;STORE IN LEFT HALF OF FIRST WORD
AOJ T1, ;RETURN POINTER TO USER PART OF BLOCK
RETSKP ;RETURN SUCCESS
SUBTTL Core manager -- Free Some Words
;DNFWDS - Free what DNGWDS took away
;
; Call:
; T1/ Pointer to words allocated by DNGWDS
;
; Return:
; RET ;ALWAYS
;
; Uses: T1,T2
DNFWDS: SOJ T1, ;POINT T1 TO HEADER WORD
HRRZ T2,(T1) ;GET COUNT OF WORDS BEING RETURNED
AOJ T2, ;ADD IN CHECK WORD
EXCH T1,T2 ;CORE1 WANTS T1/COUNT, T2/ADDRESS
MCALL (RG,MSEC1,GIVEWS##) ;LET GO OF OUR CORE.
RET
SUBTTL MSDs -- Initialize MS for input
;DNGMSI - Initialize an MSD for a raw (empty) buffer
;
; Call:
; T1/ MSD address
; T2/ Buffer Address
; T3/ Buffer Length in bytes
;
; Return:
; RET ;ALWAYS
;
; Uses: T1,MS
;
DNGMSI: MOVE MS,T1 ;MAKE MS POINT TO MSD
SETZRO MDNXT,(MS) ;INPUT MSD's CAN'T BE CHAINED
MOVX T1,VGNPTR ;BUILD A VIRGIN BYTE POINTER
STOR T1,MDAUX,(MS) ;STORE THE BYTE POINTER FOR LATER PEOPLE
STOR T1,MDPTR,(MS) ; AND STORE THE DYNAMIC BYTE POINTER
STOR T2,MDALA,(MS) ;STORE BUFFER ADDRESS
SETZRO MDBYT,(MS) ;NOTHING RECEIVED YET
STOR T3,MDALL,(MS) ;SET BUFFER LENGTH
RET ; AND RETURN
SUBTTL MSDs -- Set up MSD for input on received buffer
;DNGMSS - Set up an initialized MSD to point to received data
;
; Call:
; T1/ MSD address
; T2-T3/ 2 word global pointer to data in receive buffer
; T4/ Receive data length in bytes
;
; Return:
; RET ;ALWAYS
;
; Uses: T1,MS
;
DNGMSS: MOVE MS,T1 ;MAKE MS POINT TO MSD
STOR T4,MDBYT,(MS) ;SET RECEIVED BYTE COUNT
LOAD T1,MDALA,(MS) ;GET RAW BUFFER ADDRESS
SUB T3,T1 ;GET WORD OFFSET TO RECEIVE DATA IN BUFFER
ADDI T2,(T3) ;ADD OFFSET IN E-field OF POINTER
TXZ T2,1B12 ;CLEAR 2 word global bit
TLO T2,T6 ;SET STANDARD INDEX FOR VGNPTR
STOR T2,MDPTR,(MS) ;STORE POINTER
RET ; AND RETURN
SUBTTL MSDs -- Initialize MSD for output
;DNPINI - Initialize MSD ptr and count for output (DNPxxx routines)
;
; Call:
; T1/ Pointer to MSD to initialize
;It is assumed that the byte pointer wanted starts at the allocated
;address of the MSD (MDALA).
;
; Return:
; RET ;ALWAYS, LEAVING T1 ALONE
;
; Uses: T1,T2,MS
;
;The DNPxxx routines will use the byte pointers and byte count in the
;MSD. There are two byte pointers, one which is updated all the time
;and one which is left alone for future people to use.
DNPINI: MOVE MS,T1 ;MAKE MS POINT TO MSD
MOVX T2,VGNPTR ;BUILD A VIRGIN BYTE POINTER
STOR T2,MDAUX,(MS) ;STORE THE BYTE POINTER FOR LATER PEOPLE
STOR T2,MDPTR,(MS) ; AND STORE THE DYNAMIC BYTE POINTER
SETZRO MDBYT,(MS) ;JUST IN CASE
RET ;ONLY RETURN
SUBTTL MSDs -- Byte routines -- Get a byte
;DNG1BY - Get one byte from message
;
; Call:
; MS/ Pointer to current MSD in use
;
; Return:
; RET ;RAN OUT OF BYTES
; RETSKP ;SUCCESS: T1 CONTAINING BYTE
;
; Uses: T1,MS
DNG1BY: LOAD T6,MDALA,(MS) ;;SET UP INDEX FOR MDPTR
OPSTRM <SOS T1,>,MDBYT,(MS) ;;UPDATE THE COUNT
JUMPL T1,RTN ;;RETURN IF WE RAN OUT
OPSTRM <ILDB T1,>,MDPTR,(MS) ;;GET THE NEXT BYTE
RETSKP ;TO SENDER
SUBTTL MSDs -- Byte routines -- Get two bytes
;DNG2BY - Get two bytes from message
;
; Call:
; MS/ Pointer to current input MSD
;
; Return:
; RET ;WHEN WE'RE OUT OF BYTES
; RETSKP ;SUCCESS: WITH T1 CONTAINING THE 16 BIT BYTE
;
; Uses: T1,T2,MS
DNG2BY: LOAD T6,MDALA,(MS) ;SET UP INDEX FOR MDPTR
MOVX T1,-2 ;WE NEED TWO BYTES
OPSTRM <ADDB T1,>,MDBYT,(MS) ;UPDATE STRING COUNT
JUMPL T1,RTN ;IF THERE ISN'T ENOUGH ROOM, LEAVE
OPSTRM <ILDB T1,>,MDPTR,(MS) ;GET THE LOW BYTE
OPSTRM <ILDB T2,>,MDPTR,(MS) ;GET THE NEXT BYTE
LSH T2,^D8 ;PLACE IT IN THE HIGH POSITION
IOR T1,T2 ;MAKE UP 16-BIT VALUE
RETSKP ; AND RETURN TO SENDER
SUBTTL MSDs -- Byte routines -- Get six byte Ethernet Address
;DNGENA - Get six byte Ethernet address from message
;
; Call:
; MS/ Pointer to current input MSD
;
; Return:
; RET ;WHEN WE'RE OUT OF BYTES
; RETSKP ;SUCCESS: WITH
; T1/ Ethernet Address, bytes 0,1,2,3 left justified
; T2/ Ethernet Address, bytes 4,5 left justified
;
; Uses: T1,T2,T3,MS
DNGENA: STKVAR <STG1,STG2>
SETZM STG1 ;MAKE FOR CLEAN RESULT
SETZM STG2
MOVX T2,<POINT 8,STG2> ;POINT TO 6 BYTE STRING
LOAD T6,MDALA,(MS) ;SET UP INDEX FOR MDPTR
HRLZI T3,<-6> ;SET UP LOOP COUNT
DNGEN1: OPSTRM <SOS T1,>,MDBYT,(MS) ;;UPDATE THE COUNT
JUMPL T1,RTN ;;RETURN IF WE RAN OUT
OPSTRM <ILDB T1,>,MDPTR,(MS) ;GET CURRENT BYTE
IDPB T1,T2 ;OUTPUT CURRENT BYTE
AOBJN T3,DNGEN1 ;DO ALL 6 BYTES
DMOVE T1,STG2 ;MAKE 6 BYTE STRING ON STACK
RETSKP ;AND GIVE HIM A GOOD RETURN
ENDSV.
SUBTTL MSDs -- Byte routines -- Put a byte into message
;DNP1BY - Place one byte into message
;
; Call:
; T1/ The byte
; MS/ Pointer to current output MSD
;
; Return:
; RET ;ALWAYS
;
; Uses: T1,MS
DNP1BY: LOAD T6,MDALA,(MS) ;SET UP INDEX FOR MDPTR
OPSTRM <IDPB T1,>,MDPTR,(MS) ;PUT BYTE IN MESSAGE
INCR MDBYT,(MS) ;INCREMENT THE COUNT
RET ;RETURN TO SENDER
SUBTTL MSDs -- Byte routines -- Put two bytes in message
;DNP2BY - Place two bytes into message stream
;
; Call:
; T1/ 2 bytes (a PDP-11 word)
; MS/ Pointer to current output MSD
;
; Return:
; RET ;ALWAYS
;
; Uses: T1,MS
DNP2BY: SAVEAC <T6> ;SAVE T6
LOAD T6,MDALA,(MS) ;SET UP INDEX FOR MDPTR
OPSTRM <IDPB T1,>,MDPTR,(MS) ;OUTPUT FIRST PART OF WORD
LSH T1,-^D8 ;SHIFT A BYTE
OPSTRM <IDPB T1,>,MDPTR,(MS) ;OUTPUT NEXT PART
MOVEI T1,2 ;WE DID TWO BYTES
OPSTRM <ADDM T1,>,MDBYT,(MS) ;INCREMENT THE COUNT
RET ;RETURN TO SENDER
SUBTTL MSDs -- Byte routines -- Put two bytes to specified position
;DNP2BS - Put two bytes in message at a specified position
;
; Call: T1/ Beginning byte position
; T2/ 2 bytes (a PDP-11 word)
; MS/ Pointer to current input MSD
;
; Return:
; RET ;WHEN WE'RE OUT OF BYTES
; RETSKP ;SUCCESS: WITH T1 CONTAINING THE 16 BIT BYTE
;
; Uses: T1,T2,T3,MS
DNP2BS: LOAD T6,MDALA,(MS) ;SET UP INDEX FOR MDPTR
; MOVEI T3,2(T1)
; OPSTRM <SUB T3,>,MDALL,(MS)
; JUMPG T3,RTN ;IF THERE ISN'T ENOUGH ROOM, LEAVE
OPSTRM <ADJBP T1,>,MDAUX,(MS) ;ADJUST TO SPECIFIED BYTE POSITION
IDPB T2,T1 ;PUT THE LOW BYTE
LSH T2,-^D8 ;SHIFT TO HI BYTE
IDPB T2,T1 ;PUT THE NEXT BYTE
RET ; AND RETURN TO SENDER
SUBTTL MSDs -- Byte routines -- Put four bytes in message
;DNP4BY - Place four byte value into message stream
;
; Call:
; T1/ 4 bytes (a PDP-11 double word)
; MS/ Pointer to current output MSD
;
; Return:
; RET ;ALWAYS
;
; Uses: T1,MS
DNP4BY: LOAD T6,MDALA,(MS) ;SET UP INDEX FOR MDPTR
HRLZI T2,<-4> ;SET UP LOOP COUNT
DNP4B1: OPSTRM <IDPB T1,>,MDPTR,(MS) ;OUTPUT FIRST BYTE OF WORD
LSH T1,-^D8 ;SHIFT TO NEXT BYTE
OPSTRM <AOS>,MDBYT,(MS) ;INCREMENT THE COUNT
AOBJN T2,DNP4B1 ;DO ALL BYTES IN WORD
RET ;RETURN TO SENDER
SUBTTL MSDs -- Byte routines -- Put HI-ORDER 4 bytes of Ethernet Addr
;DNPHIO - Put high order four bytes of Ethernet address in message
;
; Call:
; T1/ Ethernet Address, bytes 0,1,2,3 left justified
; MS/ Pointer to current output MSD
;
; Return:
; RET ;ALWAYS
;
; Uses: T1,T2,MS
DNPHIO: STKVAR <STG>
MOVEM T1,STG ;MAKE 4 BYTE STRING ON STACK
MOVX T2,<POINT 8,STG> ;POINT TO 4 BYTE STRING
LOAD T6,MDALA,(MS) ;SET UP INDEX FOR MDPTR
HRLZI T3,<-4> ;SET UP LOOP COUNT
DNPHI1: ILDB T1,T2 ;GET CURRENT BYTE
OPSTRM <IDPB T1,>,MDPTR,(MS) ;OUTPUT CURRENT BYTE
OPSTRM <AOS>,MDBYT,(MS) ;INCREMENT THE COUNT
AOBJN T3,DNPHI1 ;DO ALL 4 BYTES
RET ;AND GIVE HIM A GOOD RETURN
ENDSV.
SUBTTL MSDs -- Byte routines -- Put six byte Ethernet Address
;DNPENA - Put six byte Ethernet address in message
;
; Call:
; T1/ Ethernet Address, bytes 0,1,2,3 left justified
; T2/ Ethernet Address, bytes 4,5 left justified
; MS/ Pointer to current output MSD
;
; Return:
; RET ;ALWAYS
;
; Uses: T1,T2,MS
DNPENA: STKVAR <STG1,STG2>
DMOVEM T1,STG2 ;MAKE 6 BYTE STRING ON STACK
MOVX T2,<POINT 8,STG2> ;POINT TO 6 BYTE STRING
LOAD T6,MDALA,(MS) ;SET UP INDEX FOR MDPTR
HRLZI T3,<-6> ;SET UP LOOP COUNT
DNPEN1: ILDB T1,T2 ;GET CURRENT BYTE
OPSTRM <IDPB T1,>,MDPTR,(MS) ;OUTPUT CURRENT BYTE
OPSTRM <AOS>,MDBYT,(MS) ;INCREMENT THE COUNT
AOBJN T3,DNPEN1 ;DO ALL 6 BYTES
RET ;AND GIVE HIM A GOOD RETURN
ENDSV.
SUBTTL MSDs -- Byte routines -- Skip some bytes
;DNSKBY - Skip (T1) bytes in input message
;
; Call:
; MS/ Pointer to current input MSD
; T1/ Number of Bytes to Skip
;
; Return:
; RET ;WHEN WE RAN OUT OF BYTES
; RETSKP ;ON SUCCESS
;
; Uses: T1,T2,MS
DNSKBY: JUMPE T1,RSKP ;Success return if no bytes to skip
LOAD T6,MDALA,(MS) ;SET UP INDEX FOR MDPTR
MOVN T2,T1 ;GET THE NEGATIVE COUNT
OPSTRM <MOVNS>,MDBYT,(MS) ;NEGATE COUNT
OPSTRM <SUBB T2,>,MDBYT,(MS) ;SUBTRACT THE NUMBER OF BACKSPACES
JUMPL T2,RTN ;IF WE'RE OUT, GIVE ERROR RETURN
OPSTR <ADJBP T1,>,MDPTR,(MS) ;ADJUST THE BYTE POINTER
STOR T1,MDPTR,(MS) ;STORE THE POINTER BACK
RETSKP ;WE'RE OK
SUBTTL MSDs -- Byte routines -- Go Backwards some number of bytes
;DNBKBY - Go backwards (T1) bytes in input message
;
; Call:
; T1/ Number of bytes to go backwards over
; MS/ Pointer to input MSD
;
; Return:
; RET ;ALWAYS
;
; Uses: T1,MS
;
;Note: It is your responsiblity to make sure that you do not go
;backwards over an MSD boundary. If you do the program will not work.
DNBKBY: LOAD T6,MDALA,(MS) ;SET UP INDEX FOR MDPTR
OPSTRM <ADDM T1,>,MDBYT,(MS) ;ADJUST THE BYTE COUNT
MOVN T1,T1 ;GET NEGATIVE COUNT
OPSTR <ADJBP T1,>,MDPTR,(MS) ;ADJUST THE BYTE POINTER
FIXADJ T1 ;COMPENSATE FOR BUG IN BP EA CALC
STOR T1,MDPTR,(MS) ;STORE THE POINTER BACK
RET ;TO SENDER
SUBTTL MSDs -- Read and Goto Position
;DNRPOS - Read the current position in the input data
;
; Call:
; MS/ Pointer to input MSD
;
; Return:
; RET ;Always, T1 holds full-word of position
; ; which can be fed to DNGPOS
;
; Uses: T1
;
;Note that DNRPOS is called far more frequently than DNGPOS, so
;DNRPOS is simple, where DNGPOS is complicated.
DNRPOS: LOAD T1,MDBYT,(MS) ;LOAD UP 'BYTES TO GO'
RET ;THAT WAS EASY
SUBTTL Buffers -- Copy user buffer to a message segment
;DNCU2M - Copy user buffer to a message segment
;
; Call:
; T1/ User Byte Count
; T2/ User Byte Pointer
; T3/ Optional second word of byte pointer, not implemented yet
; for user mode
; MS/ Pointer to current message segment
;
; Return:
; RET ;ALWAYS, WITH T2 CONTAINING UPDATED BYTE PTR
; ; AND T1 CONTAINING UPDATED BYTE COUNT
;
; Uses: T1-T6
DNCU2M:
IFN FTOPS10,<
TXZ T2,1B12 ;DON'T ALLOW USER 2-WORD BPTs
LOAD T4,MDBYT,(MS) ;GET COUNT OF BYTES ALREADY IN MSG BLK
OPSTRM <ADDM T1,>,MDBYT,(MS) ;INCREMENT THE BYTE COUNT
JUMPG T4,DNCUM0 ;CAN'T BLT IF SOME ALREADY THERE
HLRZ T4,T2 ;GET P & S FIELDS OF USER BPT
CAIE T4,441000 ;IS IT A STANDARD 8-BIT PTR?
CAIN T4,341000 ;IN ANY OF THE 4 POSITIONS?
JRST DNCUMB ;YES, WE CAN BLT
CAIE T4,241000 ;TWO MORE
CAIN T4,141000 ; NORMAL ONES TO CHECK
JRST DNCUMB ;YES, WE CAN BLT
CAIN T4,041000 ;NO, STANDARD 'NEXT-WORD' BPT?
JRST [ TLO T2,400000 ;YES, MAKE IT 441000,,N+1
HRRI T2,1(T2) ; . . .
JRST DNCUMB] ;AND BLT THE DATA
DNCUM0:
>;END OF IFN FTOPS10
;Here if we must do a byte-wise copy
IFN FTOPS20,<OPSTRM <ADDM T1,>,MDBYT,(MS)> ;INCREMENT THE BYTE COUNT
LOAD T6,MDALA,(MS) ;SET UP INDEX FOR MDPTR
LOAD T5,MDPTR,(MS) ; AND THE DESTINATION BYTE POINTER
SKIPG T4,T1 ;SET UP THE DESTINATION BYTE COUNT
RET ;IF NON-POSITIVE, WE'RE DONE
DNCUM1: XCTBU [ILDB CX,T2] ;GET THE BYTE FROM USER BUFFER
IDPB CX,T5 ;PUT IT IN THE MESSAGE BLOCK
SOJG T1,DNCUM1 ;LOOP UNTIL DONE
STOR T5,MDPTR,(MS) ;STORE THE UPDATED BYTE POINTER
RET ;RETURN
IFN FTOPS10,<
;Here if we can BLT the user data
DNCUMB: HLLZ T4,T2 ;PICK UP ADJUSTED USER BPT'S P&S FIELDS
TLO T4,T6 ;MDAUX IS INDEXED BY T6
STOR T4,MDAUX,(MS) ;STORE NEW BEG-OF-MSG BYTE POINTER
MOVE T5,T1 ;GET BYTE LENGTH AGAIN
ADJBP T5,T4 ;FIGURE BYTE PTR AT END OF NEW DATA
STOR T5,MDPTR,(MS) ;STORE NEW END-OF-MSG BYTE POINTER
LDB T4,[POINT 3,T2,2] ;PICK UP WORD ALIGNMENT FROM BYTE POINTER
MOVNS T4 ;NEGATE
ADDI T4,7(T1) ;CALCULATE MESSAGE WORD COUNT
ASH T4,-2 ;...
IFN FTXMON,<
HRRZ T5,T2 ;SOURCE ADDR, USER ALWAYS IN SECTION 0
LOAD T6,MDALA,(MS) ;ALLOCATED ADDRESS OF MONITOR DATA BLK
XCT 2,[EXTEND T4,[XBLT]] ;COPY FROM USER TO MONITOR
>;END IFN FTXMON
IFE FTXMON,<
LOAD T5,MDALA,(MS) ;DESTINATION ADDR IN MONITOR SPACE
HRL T5,T2 ;SOURCE ADDR IN USER SPACE
ADDI T4,-1(T5) ;MAKE DEST END ADDRESS IN SECTION 0
XCT 1,[BLT T5,(T4)] ;COPY USER TO MONITOR
>;END IFE FTXMON
MOVE T4,T1 ;GET LENGTH (BYTES) AGAIN
ADJBP T4,T2 ;MAKE NEW USER BPT
MOVEM T4,T2 ;PUT BACK FOR CALLER
SETZM T1 ;UPDATED BYTE COUNT FOR CALLER
RET ;ONLY RETURN
>;END OF IFN FTOPS10
SUBTTL Buffers -- Copy message data to a user buffer
;DNCM2U - Copy message data to a user buffer
;
; Call:
; T1/ Count of bytes
; T2/ Pointer to data
; T3/ Optional second word of byte pointer
; MS/ Pointer to current message segment
;
; Return:
; RET ;IF LENGTH IS NOT CORRECT
; RETSKP ;ON SUCCESSFUL COPY WITH T1 AND T2 CONTAINING
; ; BYTE COUNT AND POINTER
;
; Uses: T1-T6
DNCM2U: SAVEAC <T5,T6> ;SAVE T5, T6
TXNE T2,1B12 ;2-WORD BYTE PTR?
HRR T2,T3 ;YES, MAKE LOCAL FOR OLD MACHINES
MOVE T4,T1 ;SET UP DESTINATION BYTE COUNT
DMOVE T5,T2 ;AND DESTINATION BYTE POINTER
OPSTR <CAMLE T1,>,MDBYT,(MS) ;MESSAGE BIG ENOUGH?
RET ;NO, LET CALLER DEAL WITH ERROR
MOVN T2,T1 ;SET UP NEGATIVE COUNT
OPSTRM <ADDM T2,>,MDBYT,(MS) ;UPDATE THE BYTE COUNT
LOAD T2,MDPTR,(MS) ;SET UP THE SOURCE BYTE POINTER
TLZE T2,17 ;IS MDPTR INDEXED?
TLO T2,T3 ;YES, USE T3, NOT T6
LOAD T3,MDALA,(MS) ;SET UP INDEX FOR MDPTR
JRST DNCMU2 ;START IN MIDDLE OF LOOP
DNCMU1: ILDB CX,T2 ;GET THE BYTE FROM MESSAGE BLOCK
XCTBU [IDPB CX,T5] ;PLACE BYTE IN USER BUFFER
DNCMU2: SOJGE T4,DNCMU1 ;DO UNTIL DONE
STOR T2,MDPTR,(MS) ;STOR THE UPDATED BP TO MESSAGE
MOVE T1,T4 ;UPDATE COUNT FOR CALLER
DMOVE T2,T5 ; ALSO POSSIBLY 2-WORD BYTE PTR
RETSKP ;RETURN SUCCESS
>; END IFN FTOPS10
SUBTTL End of Program
IFN FTOPS20,TNXEND
END