Trailing-Edge
-
PDP-10 Archives
-
BB-H311D-RM
-
arpanet-sources/impdv.mac
There are 16 other files named impdv.mac in the archive. Click here to see a list.
; UPD ID= 4848, SNARK:<6.MONITOR>IMPDV.MAC.16, 17-Sep-84 11:49:44 by PURRETTA
;Update copyright notice
; UPD ID= 4783, SNARK:<6.MONITOR>IMPDV.MAC.15, 31-Aug-84 09:05:25 by PAETZOLD
;Fix serious brain damage in IMINRB to fix ILULK2s and IOPGFs.
; UPD ID= 4027, SNARK:<6.MONITOR>IMPDV.MAC.14, 31-Mar-84 18:29:32 by PAETZOLD
;More TCO 6.2019 - Fix typo in edit 3988.
; UPD ID= 4018, SNARK:<6.MONITOR>IMPDV.MAC.13, 31-Mar-84 16:19:49 by PAETZOLD
;TCO 6.2019 - Use ADJSPs
; UPD ID= 4003, SNARK:<6.MONITOR>IMPDV.MAC.12, 28-Mar-84 20:54:57 by PAETZOLD
;More TCO 6.1733 - Move GET18B and RET18B to IPFREE
; UPD ID= 3988, SNARK:<6.MONITOR>IMPDV.MAC.11, 27-Mar-84 17:12:16 by PAETZOLD
;More TCO 6.1733 - Make RET18B more defensive. Save correct size in ASNTBF.
; UPD ID= 3897, SNARK:<6.MONITOR>IMPDV.MAC.10, 11-Mar-84 10:37:44 by PAETZOLD
;More TCO 6.1733 - Rewrite CHKI7 for a better message which users will
;understand. Remove hairy host dead code at IMPEC6. Don't drop into
;HSTDED from IMPEC6. Fix performance bug in IMPHDR. In IMPEIN, give the
;host valid and up status in HSTSTS. Remove IMPSTD.
; UPD ID= 3829, SNARK:<6.MONITOR>IMPDV.MAC.9, 29-Feb-84 18:17:55 by PAETZOLD
;More TCO 6.1733 - ANBSEC and MNTSEC removal. Bug Fixes. Cleanup.
;<TCPIP.5.3.MONITOR>IMPDV.MAC.5, 6-Dec-83 23:51:12, Edit by PAETZOLD
;Use IPPDSW and not FT.DBI for .DBGIM control
;Remove IMPFLB and IMPNIT from this module. Cosmetic changes.
;TCO 6.1796 - Handle TTMSG failures in CHKI7
;More TCO 6.1733 - NCPFRK has gone away
;TCO 6.1630 - MONBK/PSIMB fix.
;<TCPIP.5.1.MONITOR>IMPDV.MAC.55, 5-Jul-83 08:25:03, Edit by PAETZOLD
;TCP Changes for 5.1
;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 1978, 1984.
;ALL RIGHTS RESERVED.
SEARCH ANAUNV,PROLOG
TTITLE (IMPDV,IMPDV,< - ARPANET 1822 Host IMP Communication>)
IFNDEF REL6,<REL6==1>
SIQTM0==^D30000 ;SPECIAL QUEUE TIME-OUT INTERVAL
MAXWPM::EXP 400 ;EXACTLY HOLDS WORST CASE 32 BIT MSG
SUBTTL IMP Going Down Message Notification Handling
;Broadcast imp going down message
;There are two potential weaknesses here right now
;a) only one buffer for storing reason
;b) nowhere to store which imp it is ( though could get that from the NCT)
;These don't seem all that critical since imps don't go down all
;that often, and its unlikely for more than one to go down at once
SWAPCD
CHKI7::
STKVAR <<CHKIBF,40>>
HRROI T1,CHKIBF ;BUFFER ON PDL
HRROI T2,[ASCIZ/
[From SYSTEM: ARPANET going down for /]
SETZ T3,
SOUT
LDB T2,[POINT 10,IMPGDM,31]
IMULI T2,5 ;NUMBER OF MINUTES IT WILL BE DOWN
MOVEI T3,^D10
NOUT
NOP
HRROI T2,[ASCIZ / min in /]
SETZ T3,
SOUT
LDB T2,[POINT 4,IMPGDM,21]
MOVEI T3,^D10
IMULI T2,5 ;HOW LONG TILL IT HAPPENS
NOUT
NOP
HRROI T2,[ASCIZ / min due to /]
SETZ T3,
SOUT
LDB T2,[POINT 2,IMPGDM,17] ;GET CODE FOR REASON
HRRO T2,[[ASCIZ /Panic]
/]
[ASCIZ /Scheduled Hardware PM]
/]
[ASCIZ /Software Reload]
/]
[ASCIZ /Emergency Restart]
/]](T2)
SOUT
HRROI T2,CHKIBF ;POINT TO THE TEXT
SETO T1, ;TELL EVERYONE
TTMSG
ERJMP .+1 ;IGNORE ERRORS
SETZM IMPGDM ;DON'T SAY IT AGAIN
RET
SUBTTL DBGIM JSYS
RESCD
IFN IPPDSW,<
; Routines to make footprints for debugging
; Take imp footprints jsys
; Call: 1 ; Jfn of output file
; 2 ; Word count (stops at first opportunity past this)
; 3 ; B0: Re-init and look at B1,2,3
; ; B1: Report 1822 bugs
; ; B2: Report normal 1822 events
; ; B3: Report Internet stuff
.DBGIM::MCENT
HRRZS T1 ; DON'T ALLOW BYTE POINTERS
MOVEI T4,SC%WHL!SC%NWZ
TDNN T4,CAPENB
EMRETN (NTWZX1)
JUMPG T3,DBGIM0 ;SKIP INIT STUFF
NOSKED
SETZM DBGNWD
SETZM DBGSP
SETZM DBGFAC
SETZM DBGERR
TLNE T3,(1B1)
SETOM DBGERR
SETZM DBGNCP
TLNE T3,(1B2)
SETOM DBGNCP
SETZM DBGINT
TLNE T3,(1B3)
SETOM DBGINT
OKSKED
SETZM DBGRP
AOS DBGRP ;POINT AT FIRST WORD
DBGIM0: PUSH P,T2 ;SAVE COUNT ON STACK
PUSH P,T1 ;AND JFN
DBGDBL: SKIPG T3,DBGNWD ;ANYTHING IN BUFFER?
JRST DBGDBW ;NO. WAIT.
MOVEI T4,DBGNBF ;GET SIZE OF BUFFER
SUB T4,DBGRP ;SPACE TO END OF BUFFER
CAMGE T3,T4
MOVEM T3,T4 ;KEEP MIN COUNT OF HOW MUCH TO WRITE
MOVN T3,T4 ;GET NEG COUNT OF WORDS USED
MOVE T2,DBGRP ;GET POINTER FOR REMOVING FROM BFR
ADD T2,[POINT 36,DBGBUF] ;MAKE IT POINT TO BUFFER
SOUT ;WRITE TO FILE
MOVN T3,T4 ;GET NEG OF AMOUNT WRITTEN
ADDM T3,DBGNWD ;UPDATE NUMBER OF WORDS USED IN BFR
ADDB T4,DBGRP ;AND REMOVAL POINTER
CAIL T4,DBGNBF ;AT END OF BUFFER?
SETZB T4,DBGRP ;YES, RESET REMOVAL POINTER
ADDB T3,-1(P) ;COUNT WORDS WRITTEN
JUMPG T3,DBGDBL ;CONTINUE IF STILL .GR. 0
UMOVEM T3,3 ;ELSE RETURN UPDATED COUNT
ADJSP P,-2 ;CLEAR STACK
SMRETN ;SKIP RETURN
DBGDBW: MOVEI T1,DBGNWD ;SCHEDULER TEST FOR WAIT
CALL DISG ;WAIT FOR SOME WORDS
MOVE T1,0(P) ;GET JFN BACK
JRST DBGDBL ;GO WRITE THEM TO FILE
; DBGIIM - Stash input irregular msg
DBGIIM: SKIPN DBGNCP ;WANT NCP FORMAT MESSAGES?
RET ;IF NOT, RETURN.
PUSH P,T2 ;YES. SAVE AN AC
MOVEI T2,3 ;THREE WORDS OF LEADER
CALL DBGCKS ;CHECK FOR SPACE
JRST DBGXIT ;NOT AVAILABLE
CALL DBGS2B ;OK, STORE COUNT AND TIMESTAMP
HRLI T1,-3 ;COUNT THREE WORDS OF LEADER
DBGIIL: MOVE T2,0(T1) ;GET A WORD FROM IRREG MSG BUFFER
CALL DBGS1B ;PUT IT IN DEBUG BUFFER
AOBJN T1,DBGIIL ;DO WHOLE LEADER
DBGXIT: OKSKED
POP P,T2
RET
DBGINM: SKIPN DBGNCP ;WANT NCP FORMAT MESSAGES?
RET ;NO.
PUSH P,T2 ;YES. SAVE AN AC
LOAD T2,IHLNK,(T1) ;LINK NUMBER OF THIS MSG
SKIPE T2 ;CONTROL LINK?
SKIPA T2,[5] ;NO. ASSUME LENGTH 5
LOAD T2,NBBSZ,(T1) ;YES, GET ITS LENGTH.
DBGSM: SOS T2 ;ONE LESS FOR BUFFER HEADER
CALL DBGCKS ;GO RESERVE SPACE
JRST DBGXIT ;NOT AVAILABLE
PUSH P,T1 ;SAVE BUFFER ADDRESS
CALL DBGS2B ;WRITE HEADER AND TIMESTAMP
HRRZS T2 ;GET COUNT OF WORDS
MOVE T1,0(P) ;POINT INTO BUFFER
PUSH P,T2 ;SAVE COUNT ON STACK
DBGSLP: SOSGE 0(P) ;COUNT THE WORDS
JRST DBGSL1 ;FINISHED. QUIT.
MOVE T2,1(T1) ;GET A WORD FROM MESSAGE
CALL DBGS1B ;PUT IT IN DEBUG BUFFER
AOJA T1,DBGSLP ;GO DO NEXT WORD
DBGSL1: POP P,T2 ;REMOVE COUNT FROM STACK
POP P,T1 ;RESTORE CALLER'S T1
JRST DBGXIT
DBGOM: SKIPN DBGNCP ;WANT NCP FORM MESSAGES?
RET ;NO.
PUSH P,T2 ;YES, SAVE CALLER'S AC
LOAD T2,IHMTY,(T1) ;WHAT TYPE MSG IS THIS?
JUMPN T2,[ HRROI T2,2
JRST DBGSM]
LOAD T2,IHLNK,(T1) ;WHICH LINK?
JUMPE T2,DBGOM1
HRROI T2,5 ;NOT CONTROL LINK
JRST DBGSM
DBGOM1: LOAD T2,NBBSZ,(T1) ;MESSAGE SIZE
HRROS T2 ;SET LH TO SHOW OUTPUT SIDE.
JRST DBGSM
DBGIN:: SKIPN DBGINT ;WANT INTERNET MESSAGES?
RET ;NO.
PUSH P,T2 ;YES, SAVE AC2 OF CALLER
LOAD T2,NBBSZ,(T1) ;GET MSG SIZE
HRLI T2,-2 ;FLAG FOR INTERNET
JRST DBGSM ;GO STORE MESSAGE
; Store header word (in T2) and time stamp
DBGS2B: CALL DBGS1B ;STORE ENTRY HEADER WORD
SAVEAC <T2>
EXCH T1,T2 ;AND SAVE T1
GTAD ;GET TIMESTAMP
EXCH T1,T2 ;RESTORE T1, TIME TO T2
CALL DBGS1B ;STASH THE TIMESTAMP
RET
; Store 1 word (in T2) in debug buffer
DBGS1B: SAVEAC <T1>
AOS T1,DBGSP ;STEP THE STORE POINTER
CAIL T1,DBGNBF ;TO THE END OF BUFFER?
SETZB T1,DBGSP ;YES, WRAP AROUND
MOVEM T2,DBGBUF(T1) ;STORE THE DATUM
AOS DBGNWD ;COUNT IT
RET
; Check for sufficient space to make new entry
DBGCKS: SKIPE DBGFAC ;ANY INTERVENING FAILURES?
AOJA T2,DBGCK2 ;YES
DBGCK1: PUSH P,T1 ;PRESERVE T1
NOSKED ;MAKE SURE SPACE STAYS FOR CALLER
MOVE T1,DBGNWD ;CHECK THE SPACE AVAILABLE
ADDI T1,2(T2) ;NEED HEADER SPACE, TOO
CAIG T1,DBGNBF ;IS THERE THIS MUCH?
AOSA -1(P) ;YES, SKIP RETURN
AOS DBGFAC ;NO, LOG FAILURE.
POP P,T1
DBGCK3: RET
DBGCK2: CALL DBGCK1 ;GO AHEAD AND DO CURRENT ENTRY + 1
SOJA T2,DBGCK3 ;DID NOT HAVE SPACE
EXCH T2,DBGFAC ;GET COUNT OF LOST ENTRIES
HRLI T2,T1 ;INDICATE TYPE OF ENTRY FOR LOSSES
CALL DBGS1B ;LOG THE LOSSES
SOS T2,DBGFAC ;RESTORE T2
SETZM DBGFAC ;ZERO COUNTER OF LOSSES
RET
> ;END OF IFN IPPDSW
IFE IPPDSW,< ;THESE ARE SUBSTITUTE ROUTINES
;TO REPLACE THE CALLS
DGBOM: ;OUTPUT MESSAGE
DBGINM: ;REGULAR MESSAGE
DBGIIM: ;IRREGULAR MESSAGE
DBGIN:: ;INTERNET
RET ;NULL ROUTINES
> ;END OF IFE IPPDSW
SUBTTL 1822 Input Processing
;IMICHK
;Input processing, maintaining routines, called from INTBP1 and
;occaisionally from CHKR to keep things moving
IMICHK::SKIPN INTON ;INTERNET INITIALIZED YET?
RET ;NO SO WE CAN NOT DO THIS YET
CALL IMPGIB ;GET INPUT BUFFERS IF NEEDED
CALL IMPIST ;START INPUT IF NEEDED
SKIPE IMP8XC ;IRREG MSGS FOR PROCESSING?
CALL IMP8XM ;YES
RET ;AND RETURN
SUBTTL Irregular 1822 IMP to Host Message Handling
;Here at PI level to queue an irreg Imp-to-Host message. The input
;buffer address is in T1
IMP8XQ: AOS T3,IMP8XI ;INCREMENT INPUT INDEX
CAIL T3,IMP8XS
SETZB T3,IMP8XI ;WRAPAROUND
CAMN T3,IMP8XO ;OVERFLOW?
BUG.(INF,IMPXBO,IMPDV,SOFT,<IMPDV: Irreg msg buffer overflow>)
MOVE T2,T1 ;POINT TO THE BUFFER
ADDI T2,.NBLD0 ;STARTING AT THE LEADER
IMULI T3,.NBLD2 ;THIS MANY WORDS PER IRREG MSG
HRLI T3,-.NBLD2 ;NUMBER TO COPY
I8XQL1: MOVE T4,0(T2) ;READ A WORD
MOVEM T4,IMP8XB(T3) ;PUT IT IN THE BUFFER
ADDI T2,1 ;TO NEXT WORD
AOBJN T3,I8XQL1 ;DO THE WHOLE LEADER
AOS IMP8XC ;COUNT THIS MESSAGE
RET
;Routine to get irreg messages from above buffering, and act on them.
;Called from INTFRK when IMP8XC says there is stuff to do.
IMP8XM: STKVAR <IMP8CT>
SETZ T3, ;CLEAR
EXCH T3,IMP8XC ;THE COUNTER
MOVEM T3,IMP8CT ;SAVE THE OLD COUNTER
IMP8X1: SOSGE IMP8CT ;DECREMENT COUNTER
RET ;DONE
AOS T3,IMP8XO ;RETRIEVE STUFF FROM QUEUE
CAIL T3,IMP8XS
SETZB T3,IMP8XO ;WRAPAROUND
IMULI T3,.NBLD2 ;WORDS PER MESSAGE
MOVEI P1,IMP8XB-1(T3) ;POINT RIGHT FOR DEFSTRS
LOAD T1,IHADR,(P1) ;GET ADDRESS
LOAD T2,IHNET,(P1) ;AND NET
LSH T2,^D24 ;SHIFT OVER AND
IOR T1,T2 ;MERGE THEM
LOAD T2,IHLNK,(P1) ;GET THE LINK NUMBER
LOAD T4,IHSTY,(P1) ;GET THE SUBTYPE, WHILE WE'RE HERE.
LOAD T3,IHMTY,(P1) ;PREPARE TO DISPATCH ON MSG TYPE
CAIL T3,NIMPMT ;MAKE SURE IT'S NOT GARBAGE
JRST IMP8XX ;IF SO, GIVE ERROR
XCT IMPMTT(T3) ;DISPATCH TO APPROPRIATE ROUTINE
JRST IMP8X1 ;LOOP UNTIL NO MORE
XX==CALL IMP8XX ;UNIMPLEMENTED CODE
IMPMTT: BUG.(INF,IMPRMI,IMPDV,SOFT,<IMPDV: Regular message on irreg queue>)
CALL IMPEC1 ;ERROR IN LEADER
CALL IMPDN2 ;IMP GOING DOWN
XX ;FORMERLY BLOCKED LINK
CALL IMPEC4 ;NOP. CHECK HOST ADDRESS.
XX
CALL IMPEC6 ;DEAD HOST STATUS
CALL HSTDED ;DECLARE HOST DEAD
CALL IMPEC8 ;ERROR IN DATA
CALL IMPEC9 ;INCOMPLETE TRANSMISSION
NOP ;INTERFACE RESET MESSAGE
NIMPMT==.-IMPMTT ;RANGE CHECK FOR DISPATCH
SUBTTL Irregular 1822 Message Processors
;P1 points to message in buffer.
;T1 contains host number
;T2 contains link number
;T3 contains the message type, which caused the dispatch
;T4 contains subtype of this msg
;Error in leader (type 1)
IMPEC1: TXNN T1,77777777 ;IS HOST FIELD ZERO?
RET ;SOME PHONY ONES COME FROM SITE ZERO
JUMPE T4,IMPEC8 ;IF SUBTYPE ZERO, RETRANSMIT
JRST IMP8XX ;ANYTHING ELSE SHOULD GET PRINTED
;Imp going down (type 2)
IMPDN2: MOVE T2,.NBLD1(P1) ;GET 16 BITS OF DATA
MOVE T3,.NBLD2(P1) ;DESCRIBING THE OUTAGE
LSHC T2,^D12 ;BUILD IN ONE WORD
ANDX T2,<177777B31>
MOVEM T2,IMPGDM ;SAVE IT FOR PRINTING
;Only one cell for all nets at present
AOS JB0FLG ;HAVE JOB ZERO WORRY ABOUT IT
RET
;Nop from imp. Contains my net address. Check to make sure I agree.
IMPEC4: CALL LCLHST ;SEE IF ITS ONE OF ME
BUG.(INF,IMPHNW,IMPDV,SOFT,<IMPDV: LHOSTN disagrees with the IMP>)
RET ;DONE WITH THE NOP
;Dead host status (type 6)
IMPEC6: CALL HSTHSH ;GET TABLE INDEX FOR HOST NUMBER
JUMPL T2,R ;NO ROOM, IF JUMP. ELSE NEW.
MOVEM T1,HOSTNN(T2) ;PUT HOST NUMBER IN HASH TABLE, IF NEW
MOVE T3,.NBLD1(P1) ;COLLECT REASON AND TIMES FROM IMP
MOVE T4,.NBLD2(P1)
LSHC T3,-^D<36-8>
ANDI T4,177777 ;KEEP 16 BITS
IORI T4,(HS%VAL) ;MARK AS VALID
HRLM T4,HSTSTS(T2) ;ALL STATS INTO LH
RET ;AND RETURN
;Destination dead (type 7)
;Host Dead, Host number in T1
HSTDED: CALL HSTHSH ;FIND HASH INDEX FOR HOST IN T1
JUMPL T2,HSTDD1 ;IF NO ROOM, JUMP AROUND
MOVEM T1,HOSTNN(T2) ;UPDATE HOST NUMBER, IN CASE NEW.
MOVX Q1,HS%UP ;CLEAR THE UP/DOWN FLAG FOR HOST
ANDCAM Q1,HSTSTS(T2) ;MARK HIM DOWN
HSTDD1: RET
;Error in data & incomplete transmission (types 8 & 9)
IMPEC8:
IMPEC9: CALL IMPQOA ;PUT IT BACK ON OUTPUT QUEUE
RET
IMP8XX: BUG.(INF,IMPXUT,IMPDV,SOFT,<IMPDV: Received irreg msg with unknown link or type>,<<T1,HOST>,<T2,LINK>,<T3,TYPE>,<T4,SUBTYP>>)
RET
SUBTTL Output Done Handling - Queue for Retransmission
;Here on PI level from device routine after sending out last word of
;a buffer. Put it on retransmission queue if regular link, and rfnm
;still outstanding. else put it on free list.
; P1 - Contains pointer to NCT
IMODUN::MOVE T1,NTOB(P1) ; Get buffer location
HRRE T2,NTBFFL(P1) ; Find out who owns IMPOB
JUMPL T2,IMODN3 ; Jump if Internet
MOVE T2,NTOB(P1) ; GET BUFFER ADDRESS
JRST IMPRBF ; RELEASE OR PUT ON FREE LIST
IMODN3: MOVE T2,T1 ; Copy for indexing
PIOFF
EXCH T1,INTNFB ; Put on free list
STOR T1,NBQUE,(T2) ; Hang old list off of this new head
PION
AOS INTFLG ; Get Internet gateway to notice it
RET
;IMPQOA - Queue host-imp messages on 1822 type nets
;Buffer addr in T2
IMPQOA: SAVET ; Save some scratch
CALL IMPLKB ; Lock bfr for pi service routine
LOAD T1,IHHT2,(T2) ; Check msg's priority
XMOVEI T3,NTLSND ; Low priority Q routine
TRNE T1,<HTY%HP>_-4 ; Is priority bit set in message
XMOVEI T3,NTHSND ; High priority q routine
LOAD T1,IHADR,(T2) ; get address
LOAD T4,IHNET,(T2) ; And net
LSH T4,^D24 ; Put in right position
IOR T1,T4 ; put in net field
CALL @T3 ; Put on proper Q
SKIPA ; error
RET ; And return
MOVE T1,T2 ; Put buffer into right reg
CALLRET IMPRBF ; RELEASE OR PUT ON FREE LIST
SUBTTL IMPHDR - Create Arpanet local leader from Internet V4 leader
; called w/ T1 - Local address to send to
; T2 - Pointing MAXLDR (defined in INPAR) words above
; an Internet buffer,
; returns with T2 pointing to the local leader
; (actually the link,,size word just before it)
; P1 - NCT address
IMPHDR::
MOVE T4,MAXLDR+.IPKVR(T2) ; Get IP header word containing TOS
IFL MAXLDR-.NBHHL,<
PRINTX ?ERROR MAXLDR is less than the IMP header
>
IFN MAXLDR-.NBHHL,< ; If we aren't the maximimum leader
LOAD T3,NBBSZ,(T2) ; Get size word
SUBI T3,MAXLDR-.NBHHL ; adjust for our header size
ADDI T2,MAXLDR-.NBHHL ; Point to actual start of our header
STOR T3,NBBSZ,(T2) ; Store it here
>
SETZM .NBLD0(T2) ; Clear 1st word of leader
SETZM .NBLD1(T2) ; Clear other words
SETZM .NBLD2(T2) ; ..
TDZ T1,NTNLHM(P1) ; Clear logical host bits from destination
STOR T1,IHADR,(T2) ; Store destination address
;NOTE:
;we don't set the network part of the leader since it should go
;directly from here to the interface Note T1 now free
MOVX T3,INTLNK ; Get link
STOR T3,IHLNK,(T2) ; Set it in leader
MOVX T3,ITY%LL ; New format flag
STOR T3,IHFTY,(T2) ; Set it in leader
IFN <PIPRC-7B10>,<PRINTX ? Fix PIPRC mask>
MOVX T3,<HTY%HP_<-4>> ; Bit in split word
TXNE T4,<4B10> ; High priority?
STOR T3,IHHT2,(T2) ; Yes, set bit
TXNE T4,<PILDY> ; Unless request "low delay"
TXNE T4,<PIHRL> ; and "low reliability"
TDZA T1,T1 ; Message sub-type 0
MOVX T1,3 ; If both, message sub-type 3
LOAD T3,NBBSZ,(T2) ; Get size, bytes
SUBI T3,.NBHHL ; (Pseudo and real) header words
ASH T3,2+3 ; Make into bits
CAILE T3,^D1008-1 ; Uncontrolled flow must be single packet
MOVX T1,STY%FC ; Too big, must use Normal flow-controlled
RET ; And return
SUBTTL IMPEIN - End of Input Handling
;Here from input driver after device specific operations done, and
;packet has been recieved called with P1 pointing to NCT for device
;This is a common END OF INPUT routine for 1822 ARPANet Type
;networks, It is entered both from the IMP10 and the AN10/20 device
;drivers with P1 Pointing to the active NCT
IMPEIN::
SKIPG T1,NTIB(P1) ; Bfr address
JRST IMPEI2 ; Wasn't one
MNTCALL NTSCHK ; Check status
JRST IMPEI3 ; error occured, drop it
AOSG NTFLS(P1) ; Flushing msgs?
JRST IMPEI3 ; Yes, return to free list
HRRZ T2,NTINP(P1) ; How much was read?
CAIGE T2,.NBLD2(T1) ; A full leader?
JRST IMPEI3 ; No, Discard it as useless
MOVE T2,NTNET(P1) ; get network number from NCT
STOR T2,IHNET,(T1) ; Stick it into buffer header
LOAD T3,IHFTY,(T1) ; Is this a long leader msg?
CAIE T3,ITY%LL ; ..
JRST IMPEI3 ; No. Just throw it away.
LOAD T3,IHMTY,(T1) ; Yes. Get message type.
CAIE T3,.IHIGD ; One of the ones that has no msg ID?
CAIN T3,.IHDHS ; ..
JRST IMPEI4 ; Yes. Give it to 1822 stuff
CAIN T3,.IHNOP ; You also can't believe link on NOPs
JRST IMPEI4 ; Give them to 1822 anyhow
LOAD T2,IHHST,(T1) ; GET HOST
LOAD T4,IHLNK,(T1) ; GET LINK
CAIGE T2,FKHOST ; FAKE HOST?
CAILE T4,LLINK ; NON NCP LINK?
TRNA
JUMPN T3,IMPEI4 ; 1822 Irregular msg queue
SKIPL NTBFFL(P1) ; Skip if Internet owns IMIB
JRST IMPEI3 ; not internet so drop on the floor
LOAD T3,NBBSZ,(T1) ; Get size of buffer
CAMLE T3,MAXWPM ; Check size field
BUG.(HLT,IMPIWW,IMPDV,SOFT,<IMPDV: Internet bfr word size wrong>)
SUBI T1,MAXLDR-.NBHHL ; Correct for different leader lengths
STOR T3,NBBSZ,(T1) ; Put size in right place
MOVE T3,INTIBI ; Queue for Internet gateway
JUMPN T3,IMPE00
MOVEM T1,INTIBO ; ...
SKIPA ; ...
IMPE00:
STOR T1,NBQUE,(T3)
MOVEM T1,INTIBI
AOS INTFLG ; Cause Internet process to notice it
LOAD T3,NBBSZ,(T1) ; Make sure not a released buffer
CAMLE T3,MAXWPM ; by checking size field for a PC
CALL IMPAFB ; Bughlt if so
LOAD T3,EXPCBT,+NTINP(P1) ; Get last loc with data +1
SUB T3,NTIB(P1) ; Less base of the buffer
STOR T3,NBBSZ,(T1) ; RECORD ACTUAL COUNT IN BUFFER HEADER
REPEAT 1,< ; MAY NOT WANT THIS CODE
LOAD T2,IHNET,(T1) ; GET NET
LSH T2,^D24 ; SHIFT OVER WHERE IT SHOULD BE
LOAD T1,IHADR,(T1) ; AND ADDRESS
IOR T1,T2 ; MERGE THEM
CALL HSTHSH ; FIND HASH INDEX FOR HOST IN T1
NOP ; NON-SKIP IF NEW OR NO ROOM
IFGE. T2 ; DON'T TRY TO DO IT UNLESS WE HAVE A SLOT
MOVEM T1,HOSTNN(T2) ; UPDATE HOST NUMBER, IN CASE NEW
MOVX T1,HS%UP!HS%VAL ; SET UP AND VALID FLAGS FOR HOST
IORM T1,HSTSTS(T2)
ENDIF.
>
IMPEI2: SETZM NTIB(P1)
MNTCALL NTISRT ; Start new input
RET ; And done
IMPAFB: BUG.(HLT,IMPULF,IMPDV,SOFT,<IMPDV: attempt to unlock buffer on freelist>)
RET ; If comes back
IMPEI4: CALL IMP8XQ ; Put on irreg msg Q for 1822 stuff
AOS INTFLG ; Awaken INTFRK
IMPEI3: MOVE T2,T1 ; Copy for indexing below
SKIPL NTBFFL(P1) ; NTIB owned by 1822 stuff?
JRST IMPEI6 ; Yes. Release to normal area
EXCH T1,INTFRI ; Release to Internet
STOR T1,NBQUE,(T2)
AOS INTNFI ; Count another free buffer
JRST IMPEI2
IMPEI6:
CALL IMPRBF ; Release buffer
JRST IMPEI2
SUBTTL 1822 Buffer Handling Routines
RELBUF: SAVET ; Release an 1822 buffer
MOVE T3,T2 ; Get the Buffer address
XMOVEI T1,FRELCK ; The lock address
XMOVEI T2,RET18B ; The Release routine
CALL LCKCAL ; Lock the lock and call the routine
RET ; Return to caller
ASNTBF: ;ASSIGN 1822 BUFFERS
STKVAR <ATBSZ>
MOVEM T2,ATBSZ ;SAVE THE SIZE
CAMLE T2,MAXWPM ;BE SURE REQUEST NOT LARGER THAN WHAT WE HAVE
JRST ASNTBX ;REFUSE, TOO LARGE
XMOVEI T1,FRELCK ;USE FRELCK FOR THIS
XMOVEI T2,GET18B ;GET AN 1822 BUFFER
CALL LCKCAL ;LOCK THE LOCK AND CALL THE FUNCTION
JUMPE T1,ASNTBX ;ZERO ADDRESS, NONE AVAILABLE
MOVE T2,ATBSZ ;GET THE SIZE
STOR T2,NBBSZ,(T1) ;STASH REQUESTED SIZE
RETSKP ;SKIP RETURN FOR SUCCESS
ASNTBX: BUG.(INF,NETABF,IMPDV,SOFT,<IMPDV: Assign of buffer failed>)
RET ;FAILURE RETURN
IMPGIB: ;GET 1822 INPUT BUFFERS
SKIPG T2,IMPNFI ;ARE THERE ANY BUFFERS NOW?
SETOM NOIBFS ;NO FLAG THAT COUNT HIT ZERO
CAML T2,IMPNIB ;DO WE NEED SOME?
RET ;NO SO RETURN
MOVE T2,MAXWPM ;GET THE SIZE OF A BUFFER
CALL ASNTBF ;YES SO GET A BUFFER
JRST IMPGB2 ;FAILED
MOVE T2,T1 ;GOT ONE. PUT THE ADDRESS INTO T2
CALL IMPLKB ;LOCK DOWN THE BUFFER
PIOFF ;SIEZE THE MACHINE
EXCH T2,IMPFRI ;PUT BFR ON INPUT FREE LIST
STOR T2,NBQUE,(T1) ;PUT OLD TOP OF LIST IN NEW BUFFER
AOS IMPNFI ;COUNT THE FREE BUFFERS
PION ;GIVE BACK THE MACHINE
JRST IMPGIB ;SEE IF WE NEED MORE
IMPGB2: ;HERE WHENWE FAILED TO GET A BUFFER
SKIPN IMINFB ;ANY BUFFERS RELEASE BY PI ROUTINES?
RET ;NO SO WE ARE DONE
SAVET ;YES SO SAVE SOME ACS
CALL IMINRB ;AND RELEASE THE BUFFERS
RET ;AND RETURN TO CALLER
SUBTTL More 1822 Buffer Handling Routines
RLNTBF: SAVET ;RELEASE 1822 BUFFER (Address in T2)
SETSEC T2,INTSEC ;THIS IS IN INTSEC
LOAD T3,NBBSZ,(T2) ;GET COUNT FIELD
CAMLE T3,MAXWPM ;MAKE SURE NOT ALREADY ON FREELIST
BUG.(INF,NETRBF,IMPDV,SOFT,<IMPDV: Release of 1822 buffer failed>)
CALL RELBUF ;RELEASE THE BUFFER
RET ;AND RETURN TO CALLER
IMINRB::SETZ T1, ;RELEASE BUFFERS LEFT BY PI ROUTINES
EXCH T1,IMINFB ;GET ALL GARBAGE BUFFERS
IMINR1: TRNN T1,777777 ;ALL RELEASED?
RET ;YES SO ALL DONE
SETSEC T1,INTSEC ;IN THE RIGHT SECTION
LOAD T2,NBQUE,(T1) ;FOLLOW DOWN ANY CHAIN
CALL IMPULK ;UNLOCK AND RELEASE THE BUFFER
MOVE T1,T2 ;GET THE NEXT BUFFER ADDRESS
JRST IMINR1 ;SEE IF ANY MORE ON CHAIN
IMPRBF: ;PUT BUFFER ON RELEASED QUEUE OR FREELIST
PIOFF ;SIEZE THE MACHINE
MOVE T1,IMPNFI ;GET NUMBER OF FREE BUFFERS
CAML T1,IMPNIB ;DO WE HAVE ENOUGH?
JRST IMPRB1 ;YES
MOVE T1,MAXWPM ;NO. THIS IS A FULL SIZE BUFFER
STOR T1,NBBSZ,(T2) ;MARK THE BUFFER AS FREE
MOVE T1,T2 ;COPY ADDRESS
EXCH T1,IMPFRI ;PUT ON THE FREE LIST
STOR T1,NBQUE,(T2) ;FIX UP THE TAIL POINTER
AOS IMPNFI ;KEEP COUNT OF THEM
PION ;GIVE BACK THE MACHINE
RET ;AND RETURN TO CALLER
IMPRB1: ;HERE WHEN WE ALLREADY HAVE ENOUGH ON FREELIST
MOVE T1,T2 ;COPY ADDRESS
EXCH T1,IMINFB ;TO BE GARBAGE COLLECTED
STOR T1,NBQUE,(T2) ;FIXUP THE TAIL POINTER
PION ;GIVE BACK THE MACHINE
AOS INTFLG ;CAUSE INTERNET FORK TO RELEASE THESE
RET ;AND RETURN TO CALLER
SUBTTL IMPCLQ - Clear IMP Queues
;Called with P1 pointing to an NCT for an 1822 type net
IMPCLQ:
NOSKED ;PREVENT CONFUSION
PIOFF ;GRAB ENTIRE MACHINE
SETZB T2,NTHOBI(P1) ;ZERO THE TAIL POINTER
EXCH T2,NTHOBO(P1) ;DISCARD EVERYTHING ON OUTPUT QUEUES
PION ;LET IT GO AGAIN NO THAT Q IS SAFE
CALL IMPMUL ;DEQUEUE EVERYTHING ON HIGH Q
PIOFF ;GRAB ENTIRE MACHINE
SETZB T2,NTLOBI(P1) ;ZERO THE TAIL POINTER
EXCH T2,NTLOBO(P1) ;GRAB THE LOW PRIORITY OUTPUT Q
PION ;GIVE BACK THE MACHINE
CALL IMPMUL ;DISCARD THESE
PIOFF ;TAKE THE MACHINE AGAIN
SETZB T2,NTIOBI(P1) ;CLEAR INTERNET Q INPUT TAIL POINTER
EXCH T2,NTIOBO(P1) ;GET THINGS ON INPUT QUEUE
PION ;GIVE IT BACK
CALL IMPMUL ;CLEAR 1 LOCKED THINGS (INTERNET)
SKIPLE T1,NTOB(P1) ;ANYTHING HERE?
CALL IMPULK ;UNLOCK AND RELEASE
SETZM NTOB(P1) ;NOW NO OUTPUT IN PROGRESS
SKIPE T1,NTIB(P1) ;ANYTHING IN INPUT PI SLOT??
CALL IMPULK ;YES, CLEAR IT
SETZB NTIB(P1) ;NOTHING THERE NOW
OKSKED ;LET THE SCHEDULER RUN
RET ;AND RETURN TO CALLER
SUBTTL 1822 Buffer Unlocking and Locking
;N.B.
;These routines assume that MAXWPM will never be greater than a page.
;IMPMUL Same as IMPULK, but for a whole list
IMPMUL: TRNN T2,-1 ;ANY MORE ON LIST?
RET ;NO.
MOVE T1,T2 ;YES, GET CURRENT ONE
LOAD T2,NBQUE,(T1) ;GET ITS SUCCESSOR, IF ANY
SETSEC T2,INTSEC ;IN THE RIGHT SECTION
CALL IMPULK ;RELEASE IT.
JRST IMPMUL ;TRUCK ON DOWN THE CHAIN
; Unlock and Release individual buffers
IMPULK: SAVEAC <T2,T3> ; common routine
STKVAR <IULKB,IULIM>
MOVEM T1,IULKB
LOAD T1,NBBSZ,(T1) ; Get count field
CAMLE T1,MAXWPM ; Make sure not on freelist
CALL IMPAFB ; Attempt to unlock buffer on freelist
MOVEM T1,IULIM ; save the limit
MOVE T1,IULKB ; get the buffer address again
CAML T1,[INTSEC,,BF1822] ; is this an 1822 Buffer?
CAML T1,[INTSEC,,BF1822+BF18SZ] ; ?
SKIPA ; nope.
JRST IMPULN ; handle 1822 buffers differently
MOVE T2,IULKB ; Pointer to IMP part of packet
CALL INTRBF ; Release to Internet area
RET
IMPULN: CALL MULKSP ; unlock the first part of the buffer
MOVE T1,IULKB ; get the buffer address
ADD T1,IULIM ; add in the length
SUBI T1,1 ; determine last word of the buffer
CALL MULKSP ; unlock the last part of the buffer
MOVE T2,IULKB ; Get back buffer address
CALL RLNTBF ; And release the buffer
RET
IMPLKB: ; lock an 1822 buffer
SAVEAC <T1,T2>
LOAD T1,NBBSZ,(T2) ; GET SIZE FIELD
CAMLE T1,MAXWPM ; MAKE SURE NOT ON FREELIST
BUG.(HLT,IMPLKF,IMPDV,SOFT,<IMPDV: Attempt to lock buffer on freelist>)
ADD T1,T2 ; determine the last word of the buffer
SUBI T1,1 ; off by one
CALL IMPLKW ; Lock the end
MOVE T1,T2 ; get the beginning address
CALL IMPLKW ; Lock the beginning
RET ; and return to caller
IMPLKW: ; worker routine for below
SAVEAC <T1,T2> ; save some acs
CALL MLKMA ; lock the page
RET ; and return to caller
SUBTTL IMPSTT - IMP and NCP Status Checking Routines
;Ret+1 No NCP interface is up
;Ret+2 One or more NCP interfaces are up
IMPSTT::PUSH P,BHC ; Save a flag
SKIPA P1,NCTVT ; Get first entry
IMPST0: LOAD P1,NTLNK,(P1) ; Get link
JUMPE P1,IMPST1 ; If done
LOAD T1,NTTYP,(P1) ; Get type
CAIN T1,NT.NCP ; 1822?
CALL IMPSTS ; Yes, check on status
TRNA ; Down
SETOM 0(P) ; Set flag if up
JRST IMPST0 ; Loop through all
IMPST1: POP P,T1 ; Get flag
JUMPE T1,R ; If none are up
RETSKP ; Else return
;IMPSTS - Check status of AN 1822 interface
;P1/ NCT address
;CALL IMPSTS
;Ret+1 This interface is down
;Ret+2 This interface is up
IMPSTS: AOSE NTERRF(P1) ; Was error flop noticed set?
MNTCALL NTSCHK ; No, Is ready line up?
JRST IMPSTA ; Error flop set or we are now down.
SKIPGE NTXDNT(P1) ; Was it down before?
JRST IMPSTB ; No, so continue
SETOM NTXDNT(P1) ; Was down before. Not down now.
GTAD ; Get the time
MOVEM T1,NTXUPP(P1) ; Record time back up
JRST IMPSTB ; Continue
IMPSTA: ; Here when Imp had an error or is or was down.
SKIPN NTRDY(P1) ; Do we think its supposed to be up?
JRST IMPSTB ; we think it is down. Don't record it.
SKIPL T1,NTXDNT(P1) ; Was it down?
JRST IMPSTC ; Yes so cycle NCP
GTAD ; no so get get time now
MOVEM T1,NTXDNT(P1) ; record when in went off
JRST IMPSTB ; Continue
; Bring state of NCP into agreement with state of IMP and NETON/IMPDRQ
IMPSTC: HRRZS NETON(P1) ; declare IMP down, cycle 1822
IMPSTB: SKIPLE T1,NTRDY(P1) ; Down cycle in progress?
JRST IMPDWN ; Yes. Complete it.
JUMPL T1,IMPUP ; Jump if we think IMP is up
SKIPE NETON(P1) ; IMP is off. Do we want it off?
SKIPLE NTSTCH(P1) ; No. But wait if state change unreported
RET ; Off and we want it off. Do nothing.
MNTCALL NTRSRT ; Off and we want it on. Restart it.
RET ; return
IMPUP: ; Here when IMP is up
SKIPLE NTNOP(P1) ; Should we be sending any NOPs?
MNTCALL NTOSRT ; Yes so start up output.
SKIPL NETON(P1) ; Do we want it down?
JRST IMPUP2 ; Yes go make it down
SETZM HSTGDM(P1) ; Else it's up. Cancel going down message.
RETSKP
IMPUP2: ; Shut down IMP & NCP for a net
SKIPLE NTSTCH(P1) ; Unreported state change left?
JRST RSKP ; If so, wait for that to type out
MOVX T1,^D15000 ; Begin down sequence
ADD T1,TODCLK
MOVEM T1,NTRDY(P1) ; When to give up and turn NCP off.
SETZM IMPTIM ; Now
AOS NTSTCH(P1) ; Note state change.
AOS JB0FLG ; Get JOB0 to print it.
RET
SUBTTL IMPDWN - Down Sequence in Progress
;T1/ NTRDY .ge. 0 is time to abort
IMPDWN: CAMLE T1,TODCLK ; Has time run out?
MNTCALL NTSCHK ; No. Check Hardware status
JRST IMPDW2 ; Yes. IMP is down. Just pull the plug.
SKIPG NTSTCH(P1) ; Else if change unreported
SKIPL IMPCCH(P1) ; or RST's not all sent
RETSKP ; then wait.
SETZM NTORDY(P1) ; Shut off output (No more output queued)
SKIPN NTHOBO(P1) ; Check if both output queues are empty.
SKIPE NTLOBO(P1) ; ..
RETSKP ; If not, then wait.
SKIPLE NTOB(P1) ; If last message not completely sent
RETSKP ; then wait.
SETZM HSTGDM(P1) ; Now stop sending host going down.
IMPDW2: SETZM NTRDY(P1) ; Now say totally down
SETO T1, ; Entry to abort
MNTCALL NTKILL ; Disable hardware completely
AOS NTSTCH(P1) ; Report final state change
AOS JB0FLG
CALL IMPCLQ ; Clear queues
RET
SUBTTL Start input and Initialization
IMPIST: SKIPN NOIBFS ; Did we ever run out of input buffers?
RET ; No, must be running
SETZM NOIBFS ; Clear flag
SKIPA P1,NCTVT ; Get first address
IMPIS1: LOAD P1,NTLNK,(P1) ; Get link to next
JUMPE P1,R ; If done
LOAD T1,NTTYP,(P1) ; Get type
CAIN T1,NT.NCP ; NCP?
MNTCALL NTISRT ; Yes, start input if needed
JRST IMPIS1 ; Loop through all
; Initialization - Called at process level by INTFRK
; Initializes all common variables and each NCP type network
IMPIN0::
MOVEI T1,NIMPIB ; REDUCED NUMBER OF INPUT BUFFER
MOVEM T1,IMPNIB ; SAVE NUMBER OF NCP BUFFERS TO KEEP AROUND
MOVSI T2,-NSQ ; EMPTY AND FREE ALL SPECIAL QUEUES
IMPIN2: SETOM SQJOB(T2) ; Free special queue
AOBJN T2,IMPIN2 ; if not done continue
SETOM SQLCK ; reset the special queue lock
CALL IMPRSN ; Reset variables
SKIPA P1,NCTVT ; Point to first NCT
IMPIN1: LOAD P1,NTLNK,(P1) ; Get next on list
JUMPE P1,R ; If done
LOAD T1,NTTYP,(P1) ; Get type
CAIE T1,NT.NCP ; NCP?
JRST IMPIN1 ; No, try next
SETZM HSTGDM(P1) ; Cancel any residual host going down
GTAD ; get time now
MOVEM T1,NTXDNT(P1) ; Store as last time net went off
JRST IMPIN1 ; And loop
IMPRSN: SETZM IMP8XI ; Clear irreg msg q variables
SETZM IMP8XO
SETZM IMP8XC
MOVEI T1,^D1000 ; Start probeing hosts
ADD T1,TODCLK ; After NOPs etc ave had a chance to settle
MOVEM T1,IMPTIM ; ...
RET
SUBTTL IMPHLT - Take network down
; Accepts in
; T1/ ; Reason for going down (a la 1822)
; T2/ ; Time when back up (GTAD standard form)
; P1/ ; Pointer to NCT
IMPHLT::
SKIPN NETON(P1) ; Is it on?
RET ; No. Do nothing
ANDI T1,17 ; Isolate 4-bit reason for going down
PUSH P,T1 ; Save it
GTAD ; Get now
CAMG T2,T1 ; Is time back up later than now?
JRST [ MOVEI T1,177776 ; No
JRST IMPHL1] ; Time back up not known
ADD T1,[6,,0]
CAMG T1,T2 ; More than 6 days away?
JRST [ MOVEI T1,177777 ; Yes
JRST IMPHL1]
MOVX T4,<IC%DSA!IC%UTZ> ; Use GMT standard time
ODCNV ; Separate into day, second etc
HRRZ T1,T3 ; Day of week
HRRZ T2,T4 ; Seconds since midnight
IDIVI T2,^D300 ; Convert seconds to 5 min
IDIVI T2,^D12 ; Separate into hour and 5 min
LSH T1,5
IORI T1,(T2) ; Insert hour of day
LSH T1,4
IORI T1,(T3) ; And 5 min part of hour
IMPHL1: LSH T1,4 ; Room for reason
IOR T1,0(P)
PIOFF
SETZM NETON(P1) ; Start net down
MOVEM T1,HSTGDM(P1)
PION
MNTCALL NTOSRT ; Go start output
ADJSP P,-1 ; FIX UP THE STACK
RET
SUBTTL IMP Special Queue Stuff - ASNSQ% JSYS
SWAPCD
.ASNSQ::MCENT ; Assign a special message queue
SKIPN NETSUP ; Things initialized yet?
RETERR(ASNSX1) ; No, cannot have a queue
CALL CKNTWZ
RETERR
CALL ASNSQ0 ; Work routine
RETERR ; Fail, return error code
XCTU [HRRZM P3,1] ; Success, return a queue number
SMRETN ; Return to user
ASNSQ0: STKVAR <ASMSK0,ASVAL0,ASMSK1,ASVAL1,ASMSK2,ASVAL2,ASIVAL>
UMOVE Q3,1 ; Mask
UMOVE Q2,2 ; Value
TLNE Q3,-1 ; 96 bit format?
JRST ASNS32 ; No. Convert old format.
UMOVE T1,0(Q3) ; Get user's mask in 32 bit per word
UMOVE T2,1(Q3)
LSH T1,-4 ; Butt the 64 bits together
LSHC T1,4
MOVEM T1,ASMSK0
LSH T2,-^D8
UMOVE T3,2(Q3) ; Third 32 bits
TRZ T3,17 ; Make sure no junk from user
LSHC T2,^D8
MOVEM T2,ASMSK1
MOVEM T3,ASMSK2
UMOVE T1,4(Q3) ; Get user's value in 32 bit per word
UMOVE T2,5(Q3)
LSH T1,-4 ; Butt the 64 bits together
LSHC T1,4
MOVEM T1,ASVAL0
LSH T2,-^D8
UMOVE T3,6(Q3) ; Third 32 bits
TRZ T3,17 ; Make sure no junk from user
LSHC T2,^D8
MOVEM T2,ASVAL1
MOVEM T3,ASVAL2
UMOVE T1,3(Q3) ; Get last two args for internet byte
UMOVE T3,7(Q3) ; ..
LSH T1,^D8 ; Compress for now into one arg
IOR T1,T3 ; Matching old AC3
MOVEM T1,ASIVAL ; Save in local block
JRST ASNS9X ; Join 32-bit code
ASNS32: ; Here for old style mask and value arguments
TRZN Q3,1 ; Want internet compare?
TDZA T2,T2 ; No, assume zero
UMOVE T2,3 ; Yes, get mask and value
ANDI T2,177777 ; Just two 8-bit fields
MOVEM T2,ASIVAL ; Save internet temp
;Long sequence of code to convert 32 to 96 bit leader mask and value
MOVE T1,Q3 ; Build first mask and value words
MOVE T2,Q2 ; ..
LSH T1,^D<7-31> ; Message type field
LSH T2,^D<7-31>
ANDI T1,17B31 ; Just four bits of message type
ANDI T2,17B31 ; ..
MOVEM T1,ASMSK0
MOVEM T2,ASVAL0
MOVE T1,Q3 ; Now second word of leader
MOVE T2,Q2
LSH T1,-^D12 ; Align link and imp numbers
LSH T2,-^D12
ANDI T1,77B27+377
ANDI T2,77B27+377 ; Link and 6 bits of Imp
TXNE Q3,<FRMIMP+377B15> ; If looking for some real site(s),
TXO T1,<374B11+177700B27> ; Make mask be full width on addresses
LDB T3,[POINT 2,Q3,9] ; Move host bits over
DPB T3,[POINT 2,T1,11] ; in mask
LDB T3,[POINT 2,Q2,9] ; and value
TXNE Q2,FRMIMP ; Talking about a fake host?
ADDI T3,FKHOST ; Yes. Convert the host number
DPB T3,[POINT 8,T2,11] ; Store in value word
MOVEM T1,ASMSK1 ; Save converted mask, second word
MOVEM T2,ASVAL1 ; and corresponding value
MOVE T1,Q3 ; Now build the third word
MOVE T2,Q2
ANDI T1,377B31
ANDI T2,377B31
LSH T1,^D<31-7> ; Position for 96 bit leader
LSH T2,^D<31-7>
MOVEM T1,ASMSK2
MOVEM T2,ASVAL2 ; Save for comparisons
; Fall thru
; Falls thru from above
; Now have converted masks from 32 to 96 bit format if needed
ASNS9X: NOINT ; Protect lock
AOSE SQLCK
CALL SQLWAT
MOVSI P2,-NSQ ; Search thru special Q tables
SETZ P3, ; Remember a free slot when found
ASNSQL: SKIPGE SQJOB(P2) ; Assigned?
JRST [ JUMPL P3,ASNSQN
MOVE P3,P2 ; First free one. Remember it.
JRST ASNSQN]
HRLZ T3,ASIVAL ; Check internet byte
AND T3,SQJOB(P2) ; GET JOINT MASK
LSH T3,-^D26 ; RIGHT JUSTIFY
ANDI T3,377 ; FLUSH EXTRANEOUS BITS
MOVE T2,ASIVAL ; Get value
TSC T2,SQJOB(P2) ; COMPARE VALUES
AND T2,T3 ; ONLY WHERE IT COUNTS
JUMPN T2,ASNSQN ; DIFFERENT IS OK
MOVE T1,ASMSK0 ; User's mask
AND T1,SQMSK1(P2) ; This queue's mask
MOVE T2,ASVAL0 ; User's value
XOR T2,SQVAL1(P2) ; This queue's value
TDNE T1,T2 ; Must be different in joint mask bits
JRST ASNSQN ; They are different. Ok.
MOVE T1,ASMSK1 ; User's mask
AND T1,SQMSK2(P2) ; This queue's mask
MOVE T2,ASVAL1 ; User's value
XOR T2,SQVAL2(P2) ; This queue's value
TDNE T1,T2 ; Must be different in joint mask bits
JRST ASNSQN ; They are different. Ok.
MOVE T1,ASMSK2 ; User's mask
AND T1,SQMSK3(P2) ; This queue's mask
MOVE T2,ASVAL2 ; User's value
XOR T2,SQVAL3(P2) ; This queue's value
TDNN T1,T2 ; Must be different in joint mask bits
JRST ASNSQF ; Else fail
ASNSQN: AOBJN P2,ASNSQL ; Test all possibilities
; Fall thru
;Falls thru. All possible queues have been scanned for conflict or free.
MOVEI T1,ASNSX1 ; In case no free slots
JUMPGE P3,ASNSF1 ; Jump if none free
MOVE T1,ASMSK0 ; Store the newly assigned masks, vals.
MOVEM T1,SQMSK1(P3) ; Store mask in table
MOVE T1,ASVAL0
AND T1,ASMSK0 ; Just meaningful bits
MOVEM T1,SQVAL1(P3) ; Store value field
MOVE T1,ASMSK1 ; Store the newly assigned masks, vals.
MOVEM T1,SQMSK2(P3) ; Store mask in table
MOVE T1,ASVAL1
AND T1,ASMSK1 ; Just meaningful bits
MOVEM T1,SQVAL2(P3) ; Store value field
MOVE T1,ASMSK2 ; Store the newly assigned masks, vals.
AND T1,[377B7] ; Only 80 bits are ckecked.
MOVEM T1,SQMSK3(P3) ; Store mask in table
MOVE T1,ASVAL2
AND T1,ASMSK2 ; Just meaningful bits
MOVEM T1,SQVAL3(P3) ; Store value field
MOVE T2,ASIVAL ; Internet bytes
HRL T2,JOBNO
MOVSM T2,SQJOB(P3)
SETOM SQLCK
RETSKP ; Good return to jacket routine
ASNSQF: MOVEI T1,ASNSX2
ASNSF1: SETOM SQLCK
RET ; Fail return to jacket routine
SUBTTL RELSQ% JSYS - Release Special Q
;T1/ SPECIAL QUEUE HANDLE, OR -1 FOR ALL
.RELSQ::MCENT ; Enter monitor context
; Need following to keep LOGOUT from hanging on SQLCK
SKIPN NETSUP ; Things initialized yet?
MRETNG ; No, cannot have queue to release
NOINT ; Cover the use of SQLCK
AOSE SQLCK ; Try to get it
CALL SQLWAT ; Failed. Wait.
CAMN T1,[-1] ; User want to release all Q's?
JRST RELASQ ; Yes.
CAIL T1,0 ; No. Legal Q number?
CAIL T1,NSQ ; ..
JRST RELSQ1 ; No. Just ignore the call
CALL REL1SQ ; Release just one.
RELSQ1: SETOM SQLCK ; Free the lock
MRETNG
RELASQ: MOVSI T4,-NSQ ; Here to release all Q's for this job
RELAS1: HRRZ T1,T4 ; Try to release this one
CALL REL1SQ ; ..
AOBJN T4,RELAS1 ; Now try the rest
JRST RELSQ1 ; Release lock and return good.
REL1SQ: HRRZ T2,SQJOB(T1) ; Who owns this queue?
CAME T2,JOBNO ; Is it me?
RET ; No, so just forget it
SETOM SQJOB(T1) ; Yes. Release it
REL1S1: CALL SIQGET ; Better discard any messages
RET ; No more.
CALL RLNTBF ; Release this one
JRST REL1S1 ; Keep on till all released
SUBTTL RCVIM% JSYS - Receive Raw Message
;B0 off for 32-bit leader format
;in user area, and B0 on for 96-bit leader format in user area.
;B1 on for 32 bit data in user area, off for 36 bit data packing.
;Called by
; MOVEI 1,SQH
; TLO 1,(1B0) ; If want 96 bit leader
; TLO 1,(1B1) ; If want data as 32-bit form in user area
; MOVEI 2,BUFFER
; RCVIM
; error
; OK
.RCVIM::MCENT ; Standard JSYS entry
SKIPN NETSUP ; Things initialized yet?
RETERR(SQX2) ; No, cannot have a queue to read
RCVIM1: NOINT ; Cover lock of SQLCK
UMOVE P1,1 ; Get user's arguments
HRRZ T1,P1 ; Verify the queue handle
CALL CHKSQ ; Check for accessibility to special Q
JRST MRETNE ; No access
CALL SIQGET ; Get the message, full addr in T2
JRST [ OKINT ; None there
MDISMS ; Wait for one to arrive
JRST RCVIM1] ; Try again
JUMPGE P1,RCVIM0 ; Jump if 32 bit leader
DMOVE T3,.NBLD1(T2) ; If 96 bits, make 3 32 bit words
LSHC T3,-^D8 ; Last 32 bits of leader
MOVE T3,.NBLD2(T2) ; Possible 4 bits of data in B32-35
DPB T3,[POINT 4,T4,35] ; ..
MOVEM T4,.NBLD2(T2) ; Pretty third leader word
DMOVE T3,.NBLD0(T2) ; First 72 bits of leader
LSHC T3,-4 ; Put bits 32-35 in second word
LSH T3,4 ; Restore bits 0-31
ANDCMI T4,17 ; Turn off four junk bits in second word
DMOVEM T3,.NBLD0(T2) ; Restore 64 bits to buffer
RCVIM0: TLNE P1,(1B1) ; User want data in 32 bit form?
JRST RCVI1X ; Yes. Don't need to convert it
MOVE P2,T2 ; Need to convert back to 36 bit form
ADDI P2,.NBLD2+1 ; Point to second word of data
MOVE Q2,T2 ; And make writer pointer, too
ADDI Q2,.NBLD2 ; But points to first word of data
LOAD Q3,NBBSZ,(T2) ; How many words in buffer
ADD Q3,T2 ; Word after last one to read
MOVSI T1,-10 ; State counter
RCVIL1: DMOVE T3,-1(P2) ; Get some IMP bits
CAML P2,Q3 ; Beyond real end of data?
MOVEI T4,0 ; If so, make zeros for padding
LSH T3,-4 ; Crunch out the 4 bits of junk
LSHC T3,@RCVIT1(T1) ; Shift together 36 good bits
MOVEM T3,0(Q2) ; Put them back in buffer
AOBJN T1,RCVIN1 ; Step the state counter
MOVSI T1,-10 ; Restart it
ADDI P2,1 ; Move up 1 of each 9 words
; ...
; ...
RCVIN1: ADDI Q2,1 ; Step the writer,
CAMG P2,Q3 ; Read them all?
AOJA P2,RCVIL1 ; No, loop some more.
SUB Q2,T2 ; When done, find new length, for user.
SKIPA ; End of converter to 36 bit form
RCVI1X: LOAD Q2,NBBSZ,(T2) ; For 32 bits, believe interrupt service
UMOVE T1,2 ; Get user's buffer
HRRZ T3,Q2 ; Size of buffer in monitor
SKIPL P1 ; User want short leaders?
SUBI T3,2 ; Yes, he will get only this length.
UMOVEM T3,.NBHDR(T1) ; Give user the size he will see
PUSH P,T2 ; Don't clobber buffer address
MOVEI T3,1(T1) ; Word after user's header
AOS T2 ; Word after monitor bfr header
MOVEI T1,0(Q2) ; Count to move to user space
JUMPL P1,RCVI1Y ; No corrections if user gets long ldr
ADDI T2,2 ; Start two words later in buffer
SUBI T1,2 ; And xfer two fewer, if old style leader
RCVI1Y: CALL BLTMU ; Give words to user
POP P,T2 ; Get back pointer to buffer
JUMPL P1,RCVIM2 ; If wants long ldr, go give it to user
; Here to convert leader to look like old 32-bit leader format
MOVE T4,.NBLD2(T2) ; Get the low 4 bits
LSH T4,^D32 ; Rest of word shifts in from left
LOAD T3,IHSTY,(T2) ; And build the remaining 32 bits
LSHC T3,-4 ; ..
LOAD T3,IHMI2,(T2) ; Do all 12 bits of msg ID
LSHC T3,-4
LOAD T3,IHLNK,(T2) ; Rest of link
LSHC T3,-^D8
LOAD T3,IHIMP,(T2) ; IMP number
LSHC T3,-6
LOAD T3,IHHST,(T2) ; Host portion of address
LSHC T3,-2
LOAD T3,IHMTY,(T2) ; Message type
LSHC T3,-^D8
LOAD T3,IHHST,(T2) ; Check again on host number
CAIL T3,FKHOST ; Fake host?
TXO T4,FRMIMP ; Yes, set "From IMP" bit
UMOVE T1,2 ; User's buffer address again
UMOVE T3,.NBLD0(T1) ; Preserve 4 data bits, if 36 bit
ANDI T3,17 ; That's these
TRO T4,(T3) ; Put them with leader
UMOVEM T4,.NBLD0(T1) ; Give user this leader
RCVIM2: CALL RLNTBF ; Release the buffer
SMRETN ; Return
;Table for shifting 32 bit words back into 36 bits, for RCVIM
RCVIT1: IFIW!4 ; Shifts done indirect thru this table
IFIW!10
IFIW!14
IFIW!20
IFIW!24
IFIW!30
IFIW!34
IFIW!40
RESCD
SIQGET: MOVE T2,TODCLK ; Update time to discard msgs
ADDI T2,SIQTM0 ; Since this user has been active
MOVEM T2,SIQTIM(T1) ; Reset time
NOSKED ; Protect these queues from MLCFRK
MOVE T2,SIQIBO(T1) ; Get buffer address for this Q
JUMPE T2,SIQEMT ; Jump if none there
LOAD T3,NBQUE,(T2) ; There is one. Get it's successor.
JUMPN T3,SIQGT1 ; Jump if there is a successor too
SETZM SIQIBI(T1) ; No successor. Clear tail pointer
SKIPA ; Don't put in section number
SIQGT1: SETSEC T3,INTSEC ; Section goes with address
MOVEM T3,SIQIBO(T1) ; New next-out
SOS SIQSPC(T1) ; Credit space used
OKSKED ; Queues may be touched now
RETSKP ; Success return from SIQGET
; Return with buffer addr in T2
SIQEMT: OKSKED ; None on queue.
HRLZI T1,SIQIBO(T1) ; Cell which will become non-zero
HRRI T1,DISNT ; When a message arrives
RET ; For caller to do MDISMS with
SUBTTL SNDIM% JSYS - Send Special Message
;T1/ RH = SQH, B0 = User wants 96 bit leader, B1 = User wants
; data left as 32 bits per word
SWAPCD
.SNDIM::MCENT
SKIPN NETSUP ; Things initialized yet?
RETERR(SQX2) ; No, cannot have a queue to write
UMOVE P1,1 ; User's SQH in RH, bits in LH
UMOVE P2,2 ; User's buffer address
UMOVE P3,.NBHDR(P2) ; Size word of that buffer
HRRZ T1,P1
CALL CHKSQ ; Check access to special q
RETERR
NOINT
MOVEI T2,0(P3) ; User's buffer size
SKIPL P1 ; If converting from 32bit in user space,
ADDI T2,2 ; Less two for leader expansion
CAILE T2,.NBLD2 ; At least a full leader?
CAML T2,MAXWPM ; And not too much?
RETERR (SNDIX1) ; Bad size
CALL ASNTBF ; Get a buffer
RETERR (SNDIX2) ; No buffers available
PUSH P,T1 ; Save buffer address
MOVEI T2,1(P2) ; Source in user area, after header
MOVE T3,T1 ; Destination in monitor space,
ADDI T3,1 ; Skip the header here, too
SKIPL P1 ; But if have to convert leader from 32bit
ADDI T3,2 ; Leave room for more leader
LOAD T1,NBBSZ,(T1) ; Number of words to transfer,
SUBI T1,1 ; Less the header
SKIPL P1 ; And if converting leader,
SUBI T1,2 ; Two less for that
CALL BLTUM ; Move from user space
POP P,T2 ; The buffer addr again
LOAD T1,NBBSZ,(T2) ; Check size
MOVEI T3,1(T1) ; Point just after data
ADD T1,T2 ; Address the buffer
CAMGE T3,MAXWPM ; Is buffer full?
SETZM 0(T1) ; No, so clear any possible pad bits
JUMPGE P1,SNDIM1 ; If need to convert leader fm 32 bit
DMOVE T3,.NBLD0(T2) ; Change from pretty to packed 96 bit ldr
LSH T3,-4 ; Crunch out 4 unused bits
LSHC T3,4 ; ..
MOVEM T3,.NBLD0(T2) ; First 36 bits of leader
MOVE T3,T4 ; Second word coming up
MOVE T4,.NBLD2(T2) ; And third
LSH T3,-^D8 ; Remove unused bits
LSHC T3,^D8 ; Compress, making 8 bits of fill
MOVEM T3,.NBLD1(T2) ; Put back in buffer
MOVEM T4,.NBLD2(T2) ; And stash last 36 (24) bits
JRST SNDIM2 ; Now go consider the data portion
;Here if user is giving us a 32 bit leader. Must make a 96 bit one.
SNDIM1: MOVE T4,.NBLD2(T2) ; Get 32 bit form leader from user
SETZM .NBLD0(T2) ; Clear space for the 96 bit leader
SETZM .NBLD1(T2)
MOVEI T3,17 ; Four bits of data after leader
ANDM T3,.NBLD2(T2)
MOVEI T3,0 ; Select priority bit
TXNE T4,IMPHIP ; Old form prio bit
MOVEI T3,<HTY%HP_-4> ; New form of it
STOR T3,IHHT2,(T2) ; Put it in new leader
LDB T3,[POINT 2,T4,3] ; Two low IMP flags
LSH T3,2 ; Room for two new ones
STOR T3,IHLDF,(T2) ; In leader flags half-byte
LDB T1,[POINT 4,T4,7] ; Message type
LDB T3,[POINT 4,T4,31] ; Message subtype
CAIN T1,3 ; Old uncontrolled message?
JRST [ MOVEI T1,.IHREG ; Becomes regular message
MOVEI T3,3 ; Of subtype three
JRST .+1]
STOR T1,IHMTY,(T2) ; Message type in buffer
STOR T3,IHSTY,(T2) ; Subtype in buffer
LSH T4,-^D8 ; Now deal with 12 bits of msg ID
MOVEI T3,(T4) ; Copy it
STOR T3,IHMI2,(T2) ; The four bits in word LD2
LSH T4,-4 ; The link (top 8 bits)
STOR T4,IHLNK,(T2) ; Copy link
LSH T4,-^D8 ; Next is the Imp and Host number
MOVEI T3,(T4) ; Imp number
ANDI T3,77 ; Six bits only
STOR T3,IHIMP,(T2) ; ..
LSH T4,-6 ; High two bits are host on imp
MOVEI T3,(T4)
ANDI T3,3 ; Just two bits
TXNE T4,<FRMIMP_-^D26> ; Was it for a fake host?
ADDI T3,FKHOST ; Convert to high host number
STOR T3,IHHST,(T2) ; Put it in leader
SNDIM2:
; Now have message in IMP buffer, converted to compressed
; 96 bit leader format. Now check for legality of addresses.
MOVE T3,SQJOB(P1) ; GET INTERNET DISPATCH MASK AND VAL
TLNN P1,(1B1) ; IF USER DATA IS 36-BIT LAYOUT,
JRST SNDIMO ; handle differently
MOVE T3,.NBHHL+2(T2) ; Get word with protocol field from pkt
LSH T3,-2 ; Align with byte of queue spec
JRST SNDIMQ ; Go check it
SNDIMO: DMOVE T3,.NBHHL+1(T2) ; Get words with protocol field
LSHC T3,^D22 ; Align with byte of mask
SNDIMQ: XOR T3,SQJOB(P1) ; Compare with queue spec
LSH T3,8 ; Align with mask
AND T3,SQJOB(P1) ; Only look at these bits
TLNE T3,177400 ; AND ONLY THESE TOO
JRST SNDIXR ; NOT RIGHT
MOVE T3,.NBLD0(T2) ; And header
XOR T3,SQVAL1(P1) ; Difference with value
TDNE T3,SQMSK1(P1) ; Must be equal in masked bits
SNDIXR: JRST [ MOVEI T1,SNDIX4
JRST SNDIXX]
MOVE T3,.NBLD1(T2) ; All three leader words must be OK
XOR T3,SQVAL2(P1) ; ..
TDNE T3,SQMSK2(P1) ; ..
JRST SNDIXR ; Not right.
MOVE T3,.NBLD2(T2) ; All three leader words must be OK
XOR T3,SQVAL3(P1) ; ..
TDNE T3,SQMSK3(P1) ; ..
JRST SNDIXR ; Not right.
MOVEI T3,ITY%LL ; Now tell IMP this is 96-bit msg
STOR T3,IHFTY,(T2) ; ..
LOAD T3,IHMTY,(T2) ; Only allow sending regular messages
LOAD T1,IHLNK,(T2) ; And on non-NCP links
CAIN T3,.IHREG ; ..
CAIG T1,LLINK ; ..
JRST [ MOVEI T1,SNDIX3
JRST SNDIXX] ; Invalid destination or type
;Now may need to convert 36 bit data to 32 bits.
TLNE P1,(1B1) ; User gave us 32 bit data form?
JRST SNDIM5 ; Yes. Go send it.
LOAD P2,NBBSZ,(T2) ; Get number of supplied words
SUBI P2,.NBHHL ; First word to work on
MOVEI Q2,0(P2) ; For reading in loop
IMULI Q2,^D9 ; Convert to needed words in 32 bit
IDIVI Q2,^D8 ; ..
MOVEI P3,.NBLD2(Q2) ; Where to write into
MOVEI T1,.NBHHL(Q2) ; Figure length to write
SKIPE Q3 ; Partial word?
ADDI T1,1 ; One more in destination
CAML T1,MAXWPM ; Will this fit in buffer?
JRST [ MOVEI T1,SNDIX1 ; No
JRST SNDIXX]
STOR T1,NBBSZ,(T2) ; Update for interrupt routine
MOVEI Q2,.NBLD2(P2) ; Length to read from
ADD P3,T2 ; Point into the buffer
ADD Q2,T2 ; For these pointers
TRC Q3,7 ; make aobjn pointer
HRLI Q3,-10(Q3) ; ..
SETZM 1(P3) ; Make sure any padding is 0.
; ...
; ...
SNDIL2: MOVE T1,0(Q2) ; Get 36 bits to shuffle
DPB T1,SNDIT2(Q3) ; Store right part of word
LSH T1,@SNDIT1(Q3) ; Shift left part down
MOVEM T1,0(P3) ; And store it (B32-B35 are junk)
AOBJN Q3,SNDIN2 ; Step the state counter
MOVSI Q3,-10 ; Restart it
SUBI P3,1 ; Skip a word in destination
SNDIN2: SUBI P3,1 ; Back up through the buffer
SUBI Q2,1 ; ..
SOJGE P2,SNDIL2 ; Count the words
SNDIM5: MOVE T4,NETFLD ; Get default network
LSH T4,-4 ; put in proper field
MOVE T1,.NBLD0(T2) ; get first word
TXNN T1,<377B15> ; Is the net specified?
IOR T1,T4 ; No, put one in
MOVEM T1,.NBLD0(T2) ; Replace word
NOSKED
CALL IMPQOA ; Put onto output q
OKSKED
JRST SKMRTN
SNDIXX: CALL RLNTBF ; Release the buffer, don't send it.
JRST MRETNE ; Fail return from SNDIM jsys
; Tables for converting 36 to 32 bit buffer
SNDIT1: IFIW!<0,,-34> ;Table used for shifting bits right
IFIW!<0,,-30>
IFIW!<0,,-24>
IFIW!<0,,-20>
IFIW!<0,,-14>
IFIW!<0,,-10>
IFIW!<0,,-4>
IFIW!<0,,0>
SNDIT2: POINT 32,1(P3),31 ;Table for storing right-hand part of word
POINT 28,1(P3),27
POINT 24,1(P3),23
POINT 20,1(P3),19
POINT 16,1(P3),15
POINT 12,1(P3),11
POINT 08,1(P3),07
POINT 04,1(P3),03
SUBTTL Special Queues Random Routines
; ACCEPTS:
; T1/ SPECIAL QUEUE HANDLE
; RETURNS
; +1 FAILURE
; T1/ ERROR CODE
; +2 SUCCESS
; CLOBBERS T2
CHKSQ: HRRZ T2,T1 ; Check RH only
CAIL T2,NSQ ; Is it in range?
JRST [ MOVEI T1,SQX1 ; No, give error code
RET] ; And fail return
HRRZ T2,SQJOB(T1) ; It's a legal number. Who owns it?
CAMN T2,JOBNO ; Is it me?
JRST RSKP ; Yes, give success return
MOVEI T1,SQX2 ; No, give error code
RET ; And fail return
; CKNTWZ - Check for net wizardry
; RETURNS:
; +1 Not Net Wizard. Error code in T1
; +2 Net Wizard
CKNTWZ: MOVEI T2,SC%NWZ ; Required capability bit2,SC%NWZ
TDNE T2,CAPENB ; Do we have it?
JRST RSKP ; Yes. Success return
MOVEI T1,NTWZX1 ; No, give failure code
RET ; And non-skip return
; SQLWAT - Wait for SQ Lock to clear
SQLWAT: SAVEAC <T1>
MOVEI T1,SQLTST ; Scheduler test
MDISMS ; Wait for it
RET ; And return
RESCD
; The Sched test itself, must be resident
SQLTST: AOSE SQLCK ; Try to get the lock
JRST 0(T4) ; Didn't get it
JRST 1(T4) ; Have the lock. Run the fork
SWAPCD
NETLGO::SETO T1,0 ;RELEASE ALL SPECIAL QUEUES
RELSQ
RET ; THAT'S ALL
SUBTTL SIQCHK - SIQCHK - check for unclaimed messages
; Called from NCPFRK with TODCLK in T1
; Returns T1/ Time to come back here again
SIQCHK::MOVX T3,^D31000 ; Check back in 31 seconds if none
ADD T3,T1 ; ..
MOVSI T2,-NSQ
SIQCKL: SKIPGE SQJOB(T2) ; Is this Q in use?
JRST SIQCKE
CAMG T1,SIQTIM(T2) ; Yes, time to flush stuff?
JRST SIQCKX ; No
CALL SIQWRK ; call worker routine
SIQCKX: CAML T3,SIQTIM(T2) ; This next one to expire?
MOVE T3,SIQTIM(T2) ; T3 := next one which will expire
SIQCKE: AOBJN T2,SIQCKL ; Check all queues
MOVE T1,T3 ; When to call back
RET
SIQWRK: SAVEAC <T1,T2,T3>
HRRZ T1,T2
CALL REL1S1 ; release all messages on this queue
RET
TNXEND
END