(George Source)
Macros used: COOR1, COOR3, FPUT, FREECORE, HUNT2B, HUNT7020, MENDAREA, PCTHUNT, SEGENTRY, TEST, UP
22FL #SEG PCTDIS8 [G CONSTANTINIDES 22^= #LIS K0PCTDIS>K0PCT>K0ALLGEO>K0GREATGEO 23DW 8HPCTDIS8 23YG # ENTRY POINTS 24D6 SEGENTRY K1PCTDIS,Z1PCTDIS 24XQ MENDAREA APCTGAP,K100PCTDIS 25CB [ 25X2 [ THIS SEGMENT IS ENTERED FROM LOGOUT WHEN A 7020 CPA IS ABOUT 26BL [ TO COMMIT SUICIDE 26W= [ 27*W # 27TG # THIS SUBR LOCATES THE BUFFER BLOCK IN X1 AND THE INFORM BLOCK IN 28*6 # X3. 28SQ # 29#B XHUNT LDX 1 FX2 [SET START PT = CURRENT ACT 29S2 HUNT7020 1 [FIND BUFFER BLOCK 2=?L LDX 6 APCTID(1) [GET STEP 2=R= ANDN 6 #7777 [FROM SPECIAL WD 2?=W LDX 3 1 [SET START PT = BUFFER BLOCK 2?QG PCTHUNT 3 [SEARCH PCT RING FOR INFORM BLOCK 2#=6 EXIT 7 0 [RETURN 2#PQ # 2*9B # 2*P2 Z1PCTDIS [ENTRY FROM FREEPER 2B8L # FREE THE BUFFER BLOCK AND EXIT. IF DEVICE WAS WAITING TO BE 2BN= # WRONGED MARK IT WRONGED AND SET ACOMMUNE2 NON-ZERO, ELS& ZERO. 2C7W # IF IT WAS AN I/P DEVICE SET ACOMMUNE1 NON-ZERO,ELSE ZERO. 2CMG # 2D76 CALL 7 XHUNT [GET BLOCK POINTERS 2DLQ LDCT 0 4 2F6B ANDX 0 EWAIT(1) [GET 'WAITING TO BE WRONGED' BIT. 2FL2 STO 0 ACOMMUNE2(2) [STORE IT FOR FREEPER 2G5L LDX 5 APCTID(1) 2GK= LDX 7 3 2H4W ANDX 5 HALFTOP ['WRONGED' BIT POSN 2HJG ADX 3 6 [POINTER TO PCT RECORD. 2J46 SLL 5 6 2JHQ BZE 0 NWRNG [J. IF NO WRONGING REQUIRED. 2K3B ERS 5 APCTD(3) [MARK DEVICE WRONGED 2KH2 ERS 0 EWAIT(1) [CLEAR WAITING BIT. 2L2L NWRNG LDX 4 5 [INTERFACE BIT POSN. TO CHAR. 3. 2LG= SLC 4 6 2L^W LDCT 0 #40 [J. UNLESS "PLEASE ENGAGE" 2MFG ANDX 0 EWAIT(1) [BIT WAS SET. 2M^6 SRL 5 6 2NDQ BZE 0 XREQ 2NYB ERS 0 EWAIT(1) [REMOVE THE "PLEASE ENGAGE" MARKERS. 2PD2 LDX 2 3 2PXL NXWD LDX 0 APCTDEV(2) 2QC= ANDX 0 5 2QWW BNZ 0 REMB 2RBG BDX 2 NXWD 2RW6 REMB NGN 0 #101 [#77777677 2S*Q ANDS 0 APCTDEV+1(2) 2STB LDX 2 FX2 2T*2 XREQ SLL 4 6 [TEST THE "INTERFACE ACTIVE" MARKER. 2TSL TEST ANDX 4 APCTX(3) 2W4D ... ANDN 4 #2500 2W#= BNZ 4 WAIT1 [J. IF SET. 2WRW SRL 5 6 [SET THE "NO ACTIVITY" BIT. 2X?G ORS 5 APCTD(3) 2XR6 SRL 5 6 [UNSET FLIP MARKERS 2Y=Q ORS 5 APCTD(3) 2YQB ORS 5 APCTX(3) 2^=2 ERS 5 APCTD(3) 2^PL ERS 5 APCTX(3) 329= FREECORE 1 [FREE THE BUFFER BLOCK. 32NW LDN 4 1 [I/P DEVICE HAS ODD 338G ANDX 4 JSOURCE1(2) [INTERFACE NUMBER 33N6 STO 4 ACOMMUNE1(2) [X4=1 IF I/P DEVICE,ELSE ZERO. 347Q UP 34MB # 3572 WAIT1 LDXC 0 EWAIT(1) [SHOULD ONLY ENTER HERE FOR INPUT DEV 35LL BCC WAIT3 [J. IF AMOP/APCT NOT WAITING. 366= LDX 7 BUFFNUM(1) [MARK ALL BUFFERS AS EMPTY. 36KW STO 7 FREBUFF(1) 375G NXT SMO 7 37K6 STOZ COMMON2-1(1) 384Q BCT 7 NXT 38JB LDCT 6 #200 [SET THE "SINGLE SHOT" MARKER. 38PJ ... LDEX 0 APCTID(1) 38WQ ... SBX 3 0 [POINT TO TOP OF INFORM 3942 HUNT2B 2,AMOP,APCT,3 [AND WAKE UP THE AMOP/APCT 39HL ORS 6 EWAIT(1) 3=3= FPUT 3=GW COOR1 [GO TO SLEEP OURSELVES. 3?2G WAIT2 CALL 7 XHUNT 3?7N ... ADX 3 6 3?#W ... [POINT TO CORRECT ENTRY 3?G6 BRN TEST 3?^Q WAIT3 COOR3 #41 [WAIT FOR AMOP/APCT TO DO SOMETHING. 3#FB BRN WAIT2 3#^2 # 3*DL # 3*Y= # 3BCW #END ^^^^ ...11406250000600000000