; UPD ID= 2083, SNARK:<6.1.MONITOR>IMPDV.MAC.7, 3-Jun-85 14:42:48 by MCCOLLUM ;TCO 6.1.1406 - Update copyright notice. ; UPD ID= 1600, SNARK:<6.1.MONITOR>IMPDV.MAC.6, 7-Mar-85 15:50:20 by PAETZOLD ;Document BUGxxx's ; UPD ID= 1575, SNARK:<6.1.MONITOR>IMPDV.MAC.5, 26-Feb-85 17:19:25 by PAETZOLD ;Document BUGxxx's ; UPD ID= 1033, SNARK:<6.1.MONITOR>IMPDV.MAC.4, 12-Nov-84 15:23:47 by PAETZOLD ;TCO 6.1041 - Move ARPANET to XCDSEC ; UPD ID= 314, SNARK:IMPDV.MAC.11, 18-Oct-84 15:41:59 by PAETZOLD ;Fix up IMPULK for BF18SZ changes. ; UPD ID= 284, SNARK:IMPDV.MAC.10, 24-Sep-84 13:53:54 by PURRETTA ;Update copyright notice. ; UPD ID= 261, SNARK:IMPDV.MAC.9, 30-Aug-84 16:35:52 by PAETZOLD ;Fix serious brain damage in IMINRB to fix ILULK2s and IOPGFs. ; UPD ID= 220, SNARK:IMPDV.MAC.8, 19-Jul-84 14:13:11 by PAETZOLD ;Fix immense brain damage from previous edit ; UPD ID= 208, SNARK:IMPDV.MAC.7, 10-Jul-84 12:20:53 by PAETZOLD ;IMPEC9 needs the buffer offset. ; UPD ID= 196, SNARK:IMPDV.MAC.6, 17-Jun-84 14:38:53 by PAETZOLD ;MAXWPM in STG now. ; UPD ID= 170, SNARK:IMPDV.MAC.5, 9-Jun-84 11:29:30 by PAETZOLD ;No more LLINK. ; UPD ID= 158, SNARK:IMPDV.MAC.4, 1-Jun-84 11:31:07 by PAETZOLD ;Missed an RSKP in IMPUP2. ; UPD ID= 152, SNARK:IMPDV.MAC.3, 31-May-84 10:58:10 by PAETZOLD ;No more IMPSTT. Fix up IMPSTS. ; UPD ID= 28, SNARK:IMPDV.MAC.2, 5-Apr-84 20:52:45 by PAETZOLD ;Reduce MAXWPM by LCLPKT. ; 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. ;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. ;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 1976, 1985. ;ALL RIGHTS RESERVED. SEARCH ANAUNV,PROLOG TTITLE (IMPDV,IMPDV,< - ARPANET 1822 Host IMP Communication>) IFNDEF REL6, SIQTM0==^D30000 ;SPECIAL QUEUE TIME-OUT INTERVAL 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 IFE REL6, IFN REL6, CHKI7:: STKVAR <> HRROI T1,CHKIBF ;BUFFER ON PDL HRROI T2,[ASCIZ/ [From SYSTEM: ARPANET IMP 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 IFE REL6, ; THIS CODE IS RESIDENT IFN REL6, ; THIS CODE IS RESIDENT 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 IFE REL6,<.DBGIM::> IFN REL6, 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 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 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 IFE REL6, IFN REL6, IMPCHK:: 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,,,< Cause: The irregular message buffer has overflowed and the monitor has had to discard an irregular message (message type non zero) from the IMP. This tends to indicate a possible hardware with the AN20 or a problem with the IMP. Analysis of other BUGxxx information should shed light on the real problem. >) 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: TRVAR 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 MOVEM T3,IMP8BA ;SAVE THE BUFFER OFFSET 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: CALL IMPECB ;REGULAR MESSAGE (ERROR) CALL IMPEC1 ;ERROR IN LEADER CALL IMPDN2 ;IMP GOING DOWN XX ;FORMERLY BLOCKED LINK CALL IMPEC4 ;NOP. CHECK HOST ADDRESS. CALL IMPEC5 ;RFNM 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 IMPECB: BUG.(CHK,IMPRMI,IMPDV,SOFT,,,< Cause: The monitor has detected a type zero message on the irregular message queue. This is not supposed to happen and indicates a software problem in the monitor. >) RET 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,,,< Cause: The monitor has received a NOP message from the IMP with an address that disagrees with our known address. The IMP has been known to send corrupted NOP message in the past but the problem is probably that the SYSTEM:INTERNET.ADDRESS file has the wrong address for the AN20 interface. >) RET ;DONE WITH THE NOP IMPEC5: RET ;RFNM RECEIVED ;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: ;ERROR IN DATA BUG.(INF,IMPERN,IMPDV,HARD,,<,,,>,< Cause: The IMP has detected an error in the last message transmitted to it. The error is after the leader but before the end of the message. This may indicate possible hardware problems in the AN20. >) RET IMPEC9: ;INCOMPLETE TRANSMISSION BUG.(INF,IMPINC,IMPDV,SOFT,,<,,,>,< Cause: The IMP has declared that the last message transmitted to it was incomplete. This may indicate possible hardware problems with the AN20 or the following conditions (subtypes): 0. The destination host did not respond quickly enough to the message. 1. The message was too long. 2. The AN20 took more than 15 seconds to transmit the message to the IMP. 3. The message was lost in the network due to an IMP or circuit failure. 4. The IMP could not accept the message within 15 seconds due to a unavailable resources. 5. The IMP had an IO failure during the receipt of this message. >) RET IMP8XX: BUG.(INF,IMPXUT,IMPDV,SOFT,,<,,,>,< Cause: The monitor received an irregular message that either could not be identified or is not supported by the monitor. >) 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,_-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 , MOVX T3,> ; Bit in split word TXNE T4,<4B10> ; High priority? STOR T3,IHHT2,(T2) ; Yes, set bit TXNE T4, ; Unless request "low delay" TXNE T4, ; 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) ; get the message type. JUMPN T3,IMPEI4 ; Put 1822 Irregular messages on the 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,,,< Cause: The monitor has detected an illegal size in the NBBSZ field of an internet buffer. This indicates the buffer is probably smashed. This is probably a software problem. >) 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,,,< Cause: The monitor has either attempted to unlock a buffer on the free buffer list or the buffer is smashed. This probably indicates a software problem. >) 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 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,,,< Cause: The monitor has tried to assign an 1822 buffer and has failed or an illegal size for the buffer was requested. This probably indicates a software problem. >) 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,,,< Cause: The monitor has attempted to release an 1822 buffer and has determined that the buffer is already released or has been smashed. This probably indicates a software problem. >) 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 ; common routine STKVAR 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] ; Does this buffer look ok? CAML T1,[INTSEC,,BF1822+] ; ? 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: ; unlock a buffer IFE REL6, ; unlock the first part of the buffer IFN REL6, ; 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 IFE REL6, ; unlock the last part of the buffer IFN REL6, ; 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 LOAD T1,NBBSZ,(T2) ; GET SIZE FIELD CAMLE T1,MAXWPM ; MAKE SURE NOT ON FREELIST BUG.(HLT,IMPLKF,IMPDV,SOFT,,,< Cause: The monitor has attempted to lock a buffer into memory in preparation for IO and has determined that the buffer is not assigned or has been smashed. This probably indicates a software problem. >) ADD T1,T2 ; determine the last word of the buffer SUBI T1,1 ; off by one CALL INTLKW ; Lock the end MOVE T1,T2 ; get the beginning address CALL INTLKW ; Lock the beginning RET ; and return to caller SUBTTL 1822 Interface State Handling ;IMPSTS - Check status of AN 1822 interface ;P1/ NCT address ;CALL IMPSTS 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. RET IMPUP2: ; Shut down IMP & NCP for a net SKIPLE NTSTCH(P1) ; Unreported state change left? RET ; 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 RET ; 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) ; .. RET ; If not, then wait. SKIPLE NTOB(P1) ; If last message not completely sent RET ; 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 1822 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 ; 1822? 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, ; 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 IFE REL6, IFN REL6, IFE REL6,<.ASNSQ::> IFN REL6, 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 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, ; 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 IFE REL6,<.RELSQ::> IFN REL6, 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 IFN REL6,< SWAPCD .RCVIM::XCALLRET (XCDSEC,RCVIMM) XSWAPCD RCVIMM:> ; END OF IFN REL6 IFE REL6,<.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 IFE REL6, ; THIS CODE IS RESIDENT IFN REL6, ; THIS CODE IS RESIDENT 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 IFE REL6, IFN REL6,< SWAPCD .SNDIM::XCALLRET (XCDSEC,SNDIMM) XSWAPCD SNDIMM:> ; END OF IFN REL6 IFE REL6,<.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, ; 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, ; 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 CAIE T3,.IHREG ; is this a regular message? 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 MOVEI T1,SQLTST ; Scheduler test MDISMS ; Wait for it RET ; And return ; The Sched test itself, must be resident RESCD SQLTST: AOSE SQLCK ; Try to get the lock JRST 0(T4) ; Didn't get it JRST 1(T4) ; Have the lock. Run the fork IFE REL6, IFN REL6, IFE REL6, IFN REL6, 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 HRRZ T1,T2 CALL REL1S1 ; release all messages on this queue RET TNXEND END