IDFENQS867
(George Source)
Macros used: ACROSS, BXE, CHAIN, CLOSE, FCAJO, GEOERR, HUNT2, HUNTW, IDFOPEN, INFORMX, JOBLOCK, LADDP, LFBITSET, MENDAREA, MFREEALL, MSEARCH, MXB, NAME, NOMCONS, OUTPER, P, POINTACT, PROPASSOCS, RERING, SAWCE, SEGENTRY, SETNCORE, SETUPCORE, TRACE, UNPACK, UP, UPPLUS, V, VFREEW
- IDFENQS867.txt
22FL ...#SEG IDFENQS [LEN WAGSTAFF 22PD ...# COPYRIGHT INTERNATIONAL COMPUTERS 1982 22^= #OPT K0IDFENQS=0 23DW #LIS K0IDFENQS>K0ALLGEO>K0GREATGEO>K0COMMAND>K0IDF 23YG 8HIDFENQS8 24D6 # ENTRY POINTS 24XQ SEGENTRY K1IDFENQS,Z1IDFENQS 25CB SEGENTRY K2IDFENQS,Z2IDFENQS 25X2 MENDAREA 50,K100IDFENQS 26BL # 26W= XNOMMES +JNOMCONS 27*W OPENS [OPEN IDF & FIND UNIT CELL 27TG SBX 7 FX1 28*6 P IDFANDPROP,XBRKN 28SQ ... IDFOPEN XBRKIN [UP IF BREAK-IN 29#B CALL 6 SEARCH 29S2 LDX 0 4 [SWAP X4 & X5 ROUND 2=?L LDX 4 5 2=R= LDX 5 0 2?=W LDN 3 BLINE(3) [SEARCH LINE/IDENTIFIER CHAIN 2?QG CALL 6 SEARCH 2#=6 ADX 7 FX1 2#PQ EXIT 7 0 2#WY ...XBRKIN 2*46 ... V IDFANDPROP 2*9B XBRKN UP [BREAK-IN 2*P2 # 2B8L ZCLOSE 2BN= SBX 7 FX1 2C7W MFREEALL FILE,FRRB 2CMG CLOSE 2D76 V IDFANDPROP 2DLQ ADX 7 FX1 2F6B EXIT 7 0 2FL2 # 2G5L SEARCH 2GK= SBX 6 FX1 2H4W MSEARCH 2,3,4 2HJG SMO FX2 2J46 LDX 0 ACOMMUNE1 2JHQ BNZ 0 S1 2K3B QGEO GEOERR 1,IDFENQS 2KH2 S1 ADX 6 FX1 2L2L EXIT 6 0 2LG= # 2L^W YREC BPZ 3 SAME [FIND CELL X3 POINTS TO 2MFG YREC1 SBX 7 FX1 2M^6 LDX 0 3 2NDQ SRL 0 9 2NYB ANDN 0 #7777 2PD2 LDX 2 FX2 2PXL STO 0 ACOMMUNE3(2) 2QC= MXB 2,NOFX12 2QWW ADX 7 FX1 2RBG SAME ANDN 3 #777 2RW6 ADX 3 2 2S*Q EXIT 7 0 2STB # 2T*2 # 2TSL Z1IDFENQS [ENTRY FROM JOBCONS MACRO 2TWT ...#SKI JSKI27 2T^4 ...( 2W3? ... VFREEW APERI,ASSOCS0 [THERE SINCE CNSOURCE IN DC 2W5G ... LDX 1 FX1 2W7P ... LDX 2 FX2 2W9Y ...) 2W#= BRN TRACE 2WRW XCOPAS [COPY ASSOCS AND JSE3 2X?G [IF JBNO=0 JUST COPY ASSOCS 2XR6 HUNTW 3,APERI,ASSOCS [IS THERE ALREADY AN ASSOCS BLOCK? 2Y=Q BNG 3 Q8 [GO COPY JSE3 2YQB BZE 4 ZEJN 2^=2 BXE 4 JOBNUM(2),YXY [DO NOT BOTHER IF SAME 2^PL ZEJN SETUPCORE ALOGLEN(3),2,APERI,0 [ELSE COPY OLD ONE 329= HUNTW 3,APERI,ASSOCS [REFIND OLD ASSOCS 32NW LDN 4 A1(3) 338G LDN 5 A1(2) 33N6 SMO ALOGLEN(2) 347Q MOVE 4 0 [COPY ACROSS DATA 34MB NAME 2,APERI,ASSOCS 3572 LDX 2 FX2 35LL BRN Q8 366= TRACE [UNPACK AND FIND RELEVANT DEVICE CELL 36KW STOZ AWORK3(2) [WILL BE SET LATER FOR LOCAL DEVICES 375G SAWCE CENTRAL,XUNPAC [J IF NOT REMOTE 37K6 CALL 7 XNCONS 384Q BRN XNOTITA [NO NOMINATION 38JB BRN XUNPAC [NOT A CONSOLE 3942 STO 0 JSOURCE3(2) [CONSOLE PROPERTY 39HL XUNPAC 3=3= UNPACK QLOC,MOP,Q7900,,5,4 3=GW LDN 3 BUNIT [7020 ON 7007 3?2G CALL 7 OPENS [OPEN IDF & FIND UNIT & LINE 3?G6 SMO 2 3?^Q LDX 3 BLINE(3) [POINTER TO 7020 3#FB BNZ 3 Q1 [J.IF 7020'S EXIST 3#^2 QERP 3*DL LDN 3 0 3*Y= BRN Q21 [J.IF IDFCONS MACRO 3BCW Q1 CALL 7 YREC 3BXG LDX 0 BNO(3) [2 CHAR IDENTIFIER/POLLING ADD 3CC6 ERX 0 4 [TO COMPARE IDENTIFIERS 3CWQ ANDX 0 HALFTOP 3DBB BZE 0 Q2 [J.IF SAME 3DW2 LDX 3 0(3) 3F*L BNZ 3 Q1 [J.TO LOOK FOR NEXT 7020 3FT= BRN QERP [J.AS 7020 NOT FOUND 3G#W Q2 LDN 1 0 3GSG LDCH 5 5(1) [REQUIRE INTERFACE 3H#6 BZE 5 QGEO [INTERFACE ZERO INVALID 3HRQ Q4 SMO 3 3J?B LDCH 0 BTYPE 3JR2 TXU 0 5 [IS THIS REQUIRED INTERFACE? 3K=L BCC QASS [J.IF YES 3KQ= SMO 3 3L9W LDCH 0 BTYPE+1 [IS THIS REQUIRED INTERFACE? 3LPG TXU 0 5 3M96 BCC QASS [J IF YES 3MNQ LDX 0 BTYPE+2(3) 3N8B BNG 0 QERP 3NN2 LDX 3 0(3) 3P7L BZE 3 QERP 3PM= CALL 7 YREC [FIND NEXT INTERFACE CELL 3Q6W BRN Q4 3QLG QLOC 3R66 LDCH 0 JSOURCE1(2) [JSOURCE3 SET IF CI 3RKQ SBN 0 60 3S5B BNZ 0 XNCI [J IF NOT CI 3SK2 BRN YXUPA 3T4L XNCI 3TJ= STOZ JSOURCE3(2) [LOCAL DEVICE - NOT CI 3W3W BRN XLOCCL [LOCAL CLUSTERS 3WHG YXUPA 3X36 UPPLUS 1 3XGQ XLOCCL [LOCAL CLUSTERS-ASSOCIATIONS ONLY 3Y2B LDN 0 1 3YG2 STO 0 AWORK3(2) [INDICATE LOCAL DEVICE 3Y^L LDCH 0 JSOURCE1(2) 3^F= BZE 0 XCRTR [J. IF TR-OK 3^YW SBN 0 3 42DG BNZ 0 YXUPA [J. IF NOT CR-NO ASSOCIATIONS 42Y6 [(NOTE THAT NO NEED TO LOOK FOR 43CQ [A CONSOLE PROP. TO PUT IN JSE3-YET) 43XB XCRTR [NOW TO FIND THE ASSOCIATIONS FOR 44C2 LDEX 4 JSOURCE1(2) [THIS DEVICE IN ITS APIA-GEOG. NO. 44WL BZE 4 YXUPA [MUST BE INTERNALLY ISSUED 45B= FINDPERE 3,APGEOG,4 [FIND DEVICE LIST 45TW BNG 3 QGEO [MUST EXIST 46*G LADDP 3,3 [FIND APIA 46T6 BNG 3 QGEO [MUST EXIST 47#Q LDN 6 0 [NUMBER OF ASSOCIATIONS 47SB STOZ 5 48#2 LDN 7 ASSMAX [MAXIMUM NO. OF ASSOCS.PERMITTED 48RL XAGAS SMO 6 49?= LDX 4 APERPROP(3) [TYPE OF COM-TYPE OF DEVICE 49QW BZE 4 XENDAS [FREE PAIR 4==G ADN 5 1 4=Q6 XENDAS 4?9Q BCT 7 YNEXAS [HAVE A LOOK AT THE NEXT PAIR 4?PB BRN XENDY [FINISHED FOR THE TIME BEING 4#92 YNEXAS 4#NL BDX 6 XAGAS 4*8= XENDY BZE 5 YXUPA [NOTHING TO DO 4*MW STO 5 7 4B7G BRN XGBLOCK [GO GET ASSOCS BLOCK 4BM6 MOP LDCH 0 JSOURCE1(2) 4C6Q SBN 0 #30 4CLB BZE 0 Q7900 4D62 LDN 3 BUNIT [SEARCH 7007 CHAIN 4DKL BRN Q3 4F5= Q7900 LDN 3 BIPB [SEARCH 7900 CHAIN 4FJW Q3 CALL 7 OPENS 4G4G ADX 3 2 4GJ6 QASS [NOW TEST AW1 TO SEE WHICH MACRO ITIS 4H3Q LDX 7 3 [SAVE POINTER 4HHB LDX 3 BASS(3) [ASSOCIATES POINTER 4J32 BNZ 3 QASSY [J IF ASSOCS EXIST 4JGL LDX 3 7 [RESTORE POINTER 4K2= BRN QONS [NO ASSOCIATIONS-FORM JSE3 4KFW QASSY 4K^G LDX 0 BRECNO(2) 4LF6 SBX 7 2 4LYQ SLL 0 12 [SAVE IDF POINTER TO THE DEVICE 4MDB ADX 0 7 [CELL SO THAT IT CAN BE FOUND LATER 4MY2 SMO FX2 4NCL STO 0 AWORK1 [B0-11 REC NO - B12-23 DIST OF CELL 4NX= LDX 6 3 [KEEP ASSOCIATES POINTER 4PBW CALL 7 YREC [FIND ASSOCIATES CELL 4PWG LDX 7 BNO(3) [FIND NO. OF ASSOCIATES 4QB6 BZE 7 QGEO [ERROR NO ASSOCIATES 4QTQ XGBLOCK 4R*B LDN 0 ASSOCSLEN 4RT2 MPY 0 7 4S#L LDN 7 1(1) [X7 NOW LENGTH OF ASSOCS BLOCK 4SS= SETUPCORE 7,1,APERI,ASSOCS 4T?W LDX 0 AWORK3(2) 4TRG BZE 0 XREMT [REMOTE DEVICE 4W?6 STO 5 A1(1) [NO. OF ASSOCIATIONS 4WQQ LDN 4 A1+1(1) [MOVE ASSOCIATION PAIRS INTO BLOCK 4X=B LDN 3 APERPROP(3) [LEAVING ROOM FOR THE PROP. NAME 4XQ2 XAS3 4Y9L LDX 0 0(3) 4YP= BZE 0 XAS1 [GO TO NEXT PAIR-NOTHING HERE 4^8W MOVE 3 2 4^NG ADN 4 ASSOCSLEN 5286 BCT 5 XAS1 52MQ BRN XAS2 [FINISHED 537B XAS1 BDX 3 XAS3 [GO TO COPY NEXT PAIR 53M2 XREMT 546L LDX 3 6 54L= CALL 7 YREC1 [FIND ASSOCIATES CELL AGAIN 555W LDX 7 BNO(3) 55KG STO 7 A1(1) 5656 ADN 3 BTYPE [FOR MOVE 56JQ LDN 4 A1+1(1) [FOR MOVE 574B Q6 LDX 0 0(3) 57J2 BZE 0 Q7 [J.IF THIS ASSOCIATION IS NULL 583L MOVE 3 2 58H= ADN 4 ASSOCSLEN [UPDATE X4 592W Q7 BCT 7 Q5 [J.FOR NEXT MOVE 59GG XAS2 59LC ...#SKI JSKI18<1$1 59Q# ... PROPASSOCS 59W9 ...#SKI JSKI18 5=26 ... PROPASSOCS XBRK [COMPLETE THE BLOCK 5=FQ LDX 0 AWORK3(2) [J IF LOCAL DEVICE 5=^B BNZ 0 YXUPA 5?F2 BRN QONSA [J TO SET JSE3 FROM THE IDF-REMOTE 5?YL Q8 5#D= LDX 0 AWORK2(2) 5#XW BZE 0 YXY 5*CG JOBLOCK AWORK2(2),3 [FIND NEW JOB BLOCK 5*X6 BPZ 3 Q1A 5BBQ GEOERR 1,NOJOBLOK 5BWB Q1A FCAJO 3 5CB2 HUNTW 1,APERI,ASSOCS [REFIND ASSOCS BLOCK 5CTL BNG 1 XJS 5D*= CHAIN 1,3 [CHAIN ASSFCS TO NEW CPA 5DSW XJS 5F#G LDX 0 JSOURCE3(2) 5FS6 STO 0 JSOURCE3(3) [STORE CONSOLE PROP IN NEW CPAT 5G?Q YXY UP [ALL FINISHED -JOBSOURCE MACRO 5GRB Q5 ADN 3 2 [UPDATE X3 5H?2 BRN Q6 5HB6 ...XBRK LDX 0 AWORK3(2) 5HF= ... BNZ 0 XBRKN [J IF IDF NOT OPEN 5HJB ... CALL 7 ZCLOSE 5HMG ... BRN XBRKN 5HQL # 5J== # 5JPW Z2IDFENQS [ENTRY FROM JOBSOURCE MACRO 5K9G LDX 4 ACOMMUNE1(2) [JOBSOURCE MACRO 5KP6 STO 4 AWORK2(2) [SAVE JOBNO 5L8Q BRN XCOPAS [COPY ASSOCIATIONS 5LNB QONSA LDX 6 AWORK1(2) 5M82 STOZ 3 5MML DSA 6 3 5N7= SRL 6 12 [RECORD NOMBER 5NLW XRECO [FIND RECORD AND DEVICE CELL AS 5P6G HUNT2 2,FILE,FRRB [INDICATED BY AWORK1(ALREADYINCORE) 5PL6 LDX 0 BRECNO+A1(2) 5Q5Q TXU 0 6 5QKB BCS XRECO [NOT THIS ONE 5R52 ADN 2 A1 5RJL ADX 3 2 [X3 ABS PTR TO DEVICE CELL 5S4= QONS [BACK HAVING FOUND DEVICE 5SHW LDX 3 BATT(3) 5T3G BZE 3 Q21A [NO CONSOLE PROP ATTRIBUTION 5TH6 CALL 7 YREC 5W2Q LDX 2 FX2 5WGB LDCH 0 ATYPE(2) 5X22 SBN 0 ACTLF/64 5XFL BNZ 0 NOTACTLF [BR IF NOT ACTLF 5X^= SMO FX2 5YDW LDN 0 ACOMMUNE1 [MOVE ATTRIBUTIONS INTO 5YYG LDN 7 BTYPE(3) [ACOMMUNE WORDS 5^D6 MOVE 7 6 [ACOMMUNE WORDS 5^XQ LDX 3 BTYPE(3) [LOAD CONSOLE PROPERTY NUMBER 62CB BZE 3 Q21A [NOT CLUSTERED 62X2 SETNCORE 6,1,GOUT,GPROPNOS [SET GPROPNOS BLOCK 63BL ADN 1 GPROPNUM 63W= LDN 0 ACOMMUNE1(2) [AND MOVE IN ATTRIBUTIONS 64*W MOVE 0 6 64TG LFBITSET G,2 [SET FLAG G ..... 65*6 LFBITSET F,2 [ ... AND F 65SQ POINTACT OUT,2 66#B LDX 1 FX2 66S2 LDN 2 JOBRING(2) 67?L RERING JOBRING(1),2 [AND RING IN TO JOBRING 67*3 ...SNORINGB 67R= BRN XACTLF 68=W NOTACTLF 68QG LDX 3 BTYPE(3) [LOAD CONSOLE PROPERTY NUMBER 69=6 XACTLF 69PQ BZE 3 Q21A [NO CONSOLE PROPERTY ATTRFBUTED 6=9B ANDX 3 BITS22LS 6=P2 CALL 7 XNCONS [CHECK THAT CONS PROP ATTRIBUTED IS 6?8L BRN XNOTIT [ALSO A NOMINATION FOR US-IF NOT 6?N= BRN Q21 6#7W XAGP BXE 0 3,Q21 [PUT NO OF A NOMINATION IN JSE3 6#MG STO 0 AWORK4(2) [(PROVIDED THAT JSE1-2 DESCRIBE A 6*76 CALL 7 XN3 [REMOTE CONSOLES) 6*LQ [REENTER NOMCONS-STILL ACHANCE 6B6B BRN XNOT [J IF PROP ATTR NOT A NOMINATION 6BL2 NULL 6C5L BRN XAGP [CHECK IF THIS IS THE ATTRIBUTION 6CK= XNOT LDX 3 AWORK4(2) [COPY A NOMINATION IN JSE3 6D4W BRN Q21 6DJG XNOTIT [NO NOMINATIONS FOR THIS CONSOLE 6F46 CALL 7 ZCLOSE [BUT PART OF ACLUSTER -ERROR 6FHQ XNOTITA 6G3B OUTPER [PERIPHERAL DESCRIPTION 6GH2 LDN 3 1 [TO CENTRAL CONSOLE 6H2L INFORMX 3,XNOMMES(1),1 [ERROR ON UNIT %A,THIS IS NOT 6HG= [A NOMINATED CONSOLE 6H^W [COMMANDS INPUT FROM REMOTE CONSOLES 6JFG ACROSS SUICIDE,1 [WHICH ARE NOT NOMINATED ARE 6J^6 Q21 SMO FX2 6KDQ STO 3 JSOURCE3 [SET OUR JSE3 6KYB XIT CALL 7 ZCLOSE 6LD2 UPPLUS 1 6LXL Q21B 6MC= STO 3 JSOURCE3(2) [SET MY JSE3 6MWW BRN YXUPA [UP 6NBG Q21A CALL 7 ZCLOSE [NO CONSOLE PROP ATTRIBUTRON-REMOTE 6NW6 # IF CONSOLE AND NOT PART OF A CLUSTER THEN CHECK IF NOMINATED 6P*Q # (IE ENTRY IN HUIDGE BLOCK) 6PTB LDCH 0 JSOURCE1(2) 6Q*2 SBN 0 #77 6QSL BZE 0 YXUPA [REM CONSOLE-JSCE3 SET 6R#= BRN Q21B [X3 ZERO 6RRW XNCONS 6S?G NOMCONS XN1,XN2,XN3 6SR6 EXIT 7 2 [SOME NOMINATION 6T=Q XN1 EXIT 7 0 [NO NOMINATION 6TQB XN2 EXIT 7 1 [NOT A CONSOLE 6W=2 #END ^^^^ ...50066142000100000000