(George Source)
Macros used: ALTLENG, BSXD, BXGE, CLOSE, DERING, DERINGD, DOWN, EMPTY, ENRING, FMOPG, FREECORE, GEOERR, HUNT2, HUNT2B, HUNT2OPT, HUNTW, IDFOPEN, IDFPER, INFORM, LFBITSET, MENDAREA, MFREEALL, MHUNTW, MXB, NAME, OUTNUM, PCTFIND, POINTACT, RERING, RING2CHK, RINGPURG, SEGENTRY, SETNCORE, TCLOSE, UP, UPPLUS, VFREEW
22FL ...#SEG IDFPER [LEN WAGSTAFF 22PD ...# COPYRIGHT INTERNATIONAL COMPUTERS 1982 22^= #OPT K0IDFPER=0 23DW #LIS K0IDFPER>K0PERI>K0ALLGEO 23YG 8HIDFPER 24D6 # 24XQ # THIS SEGMENT PERFORMS THE REQUIREMENTS OF ISPER AND GETPER IN THE 25CB # IDF. OOR GETPER ON ASLOW OUTPUT OUTPHERAL A GPERI,GPROPNOS 25X2 # BLOCK IS SET MP CONTAINIOG A COPY OF THE ATTRIBUTION CELL FOR 26BL # THE DEVICE ALLOCATED 26W= # 27*W # 27TG # ENTRY POINT 28*6 # 28SQ SEGENTRY K1IDFPER,X1IDFPER 29#B # 29LL ...# 29T9 ...XMASK1 #36650200 2=3S ...XMASK2 #30000000 2=6C ...#UNS FL7502 2=92 ...XMASK3 #34000000 2=?L # 2=QF ...# 2=R= SMHUNTW 2?=W # SUBROUTINE HUNTS THE APERI/APERIDF BLOCK ON X2 2?QG # LINK IN X1 2#=6 MHUNTW 2,APERI,APERIDF 2#PQ BRN (1) 2*9B # 2*P2 TCLOSE 2B8L # SUBROUTINE CLOSES THE IDF AND FREES THE FILE/FRRB BLOCKS. IF GETPER 2BN= # AND A DEVICE WAS ALLOCATED TO THE CURRENT ACTIVITY, THE APERIDF BLOCK 2C7W # IS CONVERTED INTO GOUT/GPROPNOS BLOCK AND THE FLAG G IS SET IN THE 2CMG # ACTLF; OTHERWISE THE APERIDF IS FREED. 2D76 # LINK IN X7 2DLQ SBX 7 FX1 2F6B LDX 2 FX2 2FL2 HUNTW 3,APERI,APERIDF [LOCATE APERIDF BLOCK 2G5L LDCH 0 ATYPE(2) 2GK= SBN 0 ACTLF/64 2H4W BNZ 0 NOTACTLF [BR IF NOT ACTLF 2HJG LDN 1 JOBRING(2) 2J46 POINTACT OUT,2 [ACTLF SCHEDULER 2JHQ ADN 2 JOBRING 2K3B RERING 1,2 [AND GET BACK ON I^'S JOBRING 2KH2 NOTACTLF 2L2L BNG 3 NOAPERIDF [BR IF NOT FOUND 2LG= LDXC 0 AWORK3(2) 2L^W BCS RISPER [BR IF ISPER.... 2MFG LDX 0 JSOURCE1(2) 2M^6 BZE 0 RISPER [...OR IF NO DEVICE ALLOCATED 2NDQ RINGPURG 3 [REMOVE RING ELEMENT 2NYB LDN 1 GPROPNUM(3) [CONVERT APERIDF INTO 2PD2 LDN 0 APERATTRIB(3) [A GOUT/GPROPNOS 2PXL MOVE 0 ATTMAX 2QC= LDN 4 ATTMAX 2QWW ALTLENG 3,4,SMHUNTW [SHORTEN BLOCK 2RBG CALL 1 SMHUNTW [RELOCATE IT 2RW6 NAME 2,GOUT,GPROPNOS [AND RENAME IT 2S*Q LFBITSET G,FX2 [SET FLAG G 2STB BRN NOAPERIDF 2T*2 RISPER 2TSL FREECORE 3 [FREE APERIDF BLOCK 2W#= NOAPERIDF 2WRW VFREEW ADATA,CSTORE 2X?G MFREEALL FILE,FRRB 2XR6 CLOSE 2Y=Q ADX 7 FX1 2YQB EXIT 7 0 2^=2 TYPE 4,5,1,2 [TR,TP,LP,CR 2^PL YREC BPZ 3 SAME [SEARCH FOR A RECORD 329= YREC1 SBX 7 FX1 [THIS ENTRY USED WHEN X2 NOT SET UP 32NW LDX 0 3 338G SRL 0 9 33N6 ANDN 0 #7777 347Q LDX 2 FX2 34MB STO 0 ACOMMUNE3(2) 3572 MXB 2,NOFX12 [MXB WITHOUT X1 SET TO FX1 UNLESS CO-ORD. 35LL ADX 7 FX1 366= SAME ANDN 3 #777 36KW ADX 3 2 [SO X3 IS ABSOLUTE PTR 375G EXIT 7 0 37K6 # ON ENTRY AWORK4 CONTAINS DEVICE TYPE:AWORK3 IS NEG.FOR ISPER 384Q # ENTRY AND POS.OR ZERO FOR GETPER ENTRY 38JB # 3942 X1IDFPER 39HL LDX 0 AWORK4(2) 3=3= SBN 0 4 3=GW BPZ 0 Q602 3?2G IDFOPEN XBRK [OPEN THE IDF 3?5L ...[ 3?8Q ...X7IDFPER 3??W ...[ RE-ENTRY POINT FOR SCAN OF MACHINE B DEVICES 3?G6 LDX 3 2 3?^Q LDX 2 FX2 3#FB LDCH 0 ATYPE(2) 3#^2 SBN 0 ACTLF/64 3*DL BNZ 0 XISNTACTLF [BR IF NOT ACTLF 3*Y= DERINGD JOBRING(2) [ESSE CLEAR OUT JOBRING 3BCW EMPTY JOBRING(2) 3BXG XISNTACTLF 3CC6 LDX 2 3 3CWQ MHUNTW 3,APERI,APROPNOS 3DBB SMO CPROPNO(3) [CONSOLE PROPERTY NUMBER &- 3DW2 LDN 4 0 [CLEAR OUT TOP 2 BITS 3F*L LDX 3 BEXOT(2) [BASE OF CONSOLE PROPERTY CHAIN 3FT= BZE 3 T13 [NOTHING TO DO:CLUSTER CANCELLED NOW 3G#W T1 SMO FX2 3GSG STO 3 AWORK1 [KEEP PTR IN CASE RIGHT CONSOLE PROP. 3H#6 CALL 7 YREC 3HRQ SMO BNO(3) [PICK OUT NUMBER OF CONSOLE PROP.&- 3J?B LDN 0 0 [CLEAR OUT TOP 2 BITS 3JR2 TXU 0 4 3K=L BCC T2 [J.IF SAME 3KQ= LDX 3 0(3) 3L9W BNZ 3 T1 [J.FOR NEXT CONSOLE PROP. 3LPG BRN T13 [NOTHING TO DO:CLUSTER CANCELLED NOW 3M96 T2 LDX 5 3(3) 3MNQ BNZ 5 T9 [J.IF THERE ARE SOME ATTRIBUTIONS &- 3N8B [START READING IDF INTO CORE 3NN2 T13 CALL 7 TCLOSE [OTHERWISE CLOSE IDF- 3P7L BRN Q602 [AND JUMP OUT. 3PM= # 3Q6W # 3QLG # THE FOLLOWING CODE READS ALL ALL THE RELEVANT PARTS OF THE IDF INTO 3R66 # CORE AND DOES A MINI-FIRST-PASS LOOKING FOR PERIPHERALS OF THE 3RKQ # REQUIRED TYPE.IF SOME ARE FOUND THE SECOND PASS,WITHOUT CO-ORDINATING, 3S5B # IS CARRIED OUT.(T9 IS ENTRANCE TO FIRST PASS LOOP.) 3SK2 # 3T4L # 3TJ= # PASS 1 3W3W # 3WHG # 3X36 TGEO GEOERR 1,CLUSTERC [FOR MAJOR ERRORS IN IDF 3XGQ T12 BCT 5 T14 [SEE IF WE MUST UPDATE X6:YES? JUMP! 3Y2B T15 LDX 3 6 3YG2 T16 ADN 5 1 [RESTORE COUNT IN X5 3Y^L LDX 4 3 [KEEP COPY IN CASE THIS DEVICE OKAY 3^F= ADN 6 1 [UPDATE X6(BUT WONT USE IF THIS IS- 3^YW CALL 7 YREC1 [LAST DEVICE 42DG LDX 0 BITS22LS [CLEAR OUT TOP TWO BITS IN POINTER- 42Y6 ANDS 0 0(3) [WILL SET B0=1 IF DEVICE OKAY 43CQ LDX 3 0(3) 43XB BNZ 3 T440 [J.TO FIND DEVICE 44C2 BRN TGEO [OR IF NOT A POINTER,ERROR 44WL T14 LDX 0 6 [UPDATE X6 TO BE NEW PTR TO ATTRIB- 45B= ADN 0 1 [UTION PTR 45TW ANDN 0 7 46*G BNZ 0 T15 [J.IF DON'T NEED TO FIND NEW SUBSID- 46T6 SMO FX2 [VARY CONSOLE PROPERTY CELL 47#Q LDX 3 AWORK2 [PICK UP PTR TO NEW SUBSID. CELL 47SB BZE 3 TGEO [IT SHOULD NOT BE ZERO! 48#2 CALL 7 YREC1 48RL LDX 2 FX2 49?= LDX 0 0(3) [PTR TO NEXT SUBSID CELL 49QW LDX 3 6 4==G LDX 6 AWORK2(2) 4=Q6 STO 0 AWORK2(2) 4?9Q BRN T16 [J.BACK TO GET PTR TO DEVICE 4?PB # 4#92 T9 LDX 7 BLINE(3) [PTR TO SUBSID CELL 4#NL SMO FX2 4*8= STO 7 AWORK2 [PRESERVE PTR 4*MW SMO FX2 4B7G LDX 6 AWORK1 [RESCUE PTR TO CONSOLE PROP.CELL 4BM6 SMO 6 4C6Q LDN 4 5 [X4 IS PTR TO CURRENT ATTRIB.PTR 4CLB ADN 6 6 [X6 IS PTR TO NEXT ATTRIBUTION PTR 4D62 LDX 0 BITS22LS [CLEAR OUT TOP TWO BITS IN POINTER- 4DKL ANDS 0 5(3) [WILL SET B0=1 IF DEVICE OKAY 4F5= LDX 3 5(3) 4FJW BZE 3 TGEO [ERROR ZERO POINTER 4G4G T440 CALL 7 YREC1 [FIND DEVICE CELL 4GJ6 LDCT 7 #700 4H3Q ANDX 7 BNUMB(3) 4HHB SLL 7 1 4J32 BZE 7 T11 [J.IF NOT ON 7020 OR 7900.NO GOOD 4JGL SLC 7 1 [OTHERWISE WORK OUT DEVICE TYPE- 4K2= SLL 7 1 [NUMBER EQUIVALENT TO NO.IN AWORK4. 4KFW SMO FX2 [THERE IS A DIFFERENCE OF TWO FOR 4K^G LDX 2 AWORK4 [DEVICE TYPE NOS FOR 7020 & 7900. 4LF6 BZE 7 TXA [J IF 7007 4LYQ LDX 0 BTYPE(3) 4MDB SLL 0 6 4MY2 BNG 0 T11 [J IF UNKNOWN DEVICE 4NCL TXA 4NX= SMO FX1 4PBW ADX 7 TYPE(2) [NOW X7 CONTAINS REQUIRED DEVICE TYPE 4PWG LDCH 0 BTYPE(3) 4Q6# ... ANDN 0 #37 [MASK OUT WRONGED AND PSEUDO BITS 4QB6 TXU 0 7 4QTQ BCS T11 [J.IF THIS DEVICE NOT RIGHT TYPE 4R*B ORX 5 GSIGN [MARK IN X5 THAT THERE IS A DEVICE 4RT2 [OF THE REQUIRED TYPE IN THE CLUSTER 4S#L LDX 3 BATT(3) 4SS= BZE 3 TGEO 4T?W CALL 7 YREC1 4TRG LDX 3 4 [PTR IN CONSOLE CELL TO DEVICE 4W?6 CALL 7 YREC1 [FIND IT 4WQQ ... LDCT 0 #200 [AND MAKE B1 AS A MARKER THAT 4X=B ORS 0 0(3) [THIS DEVICE IS A POSSIBILITY 4XQ2 T11 BCT 5 T12 [J.FOR NEXT DEVICE IN CLUSTER 4Y9L BPZ 5 T13 [J.TO EXIT NO RIGHT DEVICES FOUND 4YP= # 4^8W # 4^NG # PASS 2(X5 NEG MEANS THERE WAS AT LAST ONE DEVICE THAT LOOKED HOPEFULL) 5286 # 52MQ # 537B LDX 2 FX2 [IT SHOULD ALREADY BE ZERO,BUT THIS 53M2 STOZ AWORK2(2) [COULD GET CHANGED-SO BE SAFE! 546L LDXC 0 AWORK3(2) 54L= BCS T11A [BR IF ISPER 555W SETNCORE ATTMAX,1,ADATA,CSTORE 55KG T11A 5656 LDX 3 AWORK1(2) [PTR TO PROPERTY CONSOLE CELL 56JQ LDN 6 3 574B SETNCORE APERIDFLEN>ADCBULKLEN,1,APERI,APERIDF,,1 57J2 STOZ IDEVIC2+1(1) [INITIALIZE APERI/APERIDF BLOCK 583L CALL 7 YREC1 58H= LDX 7 BLINE(3) 592W STO 7 IDFWK+2(1) 59GG LDX 5 3(3) 5=26 LDX 0 5(3) 5=FQ ADN 3 5 5=^B BRN T18 [J.TO SEE IF THIS PTR IS TO A DEVICE 5?F2 [OF THE RIGHT TYPE 5?YL T3 BCT 6 T19 [J.IN NO NEW CELL NEEDED 5#D= LDN 6 7 5#XW LDX 3 IDFWK+2(1) 5*CG BZE 3 TGEO [POINTER SHOULD NOT BE ZERO 5*X6 CALL 7 YREC1 [FIND SUBSID.CELL 5BBQ LDX 0 0(3) [AND NOW UPDATE POINTERS 5BWB STO 0 IDFWK+2(1) 5CB2 T19 ADN 3 1 5CTL LDX 0 0(3) [PICK UP DECICE POINTER 5D83 ...T18 SLC 0 1 5DGD ... BNG 0 T7 [J.IF THIS IS A POSS.DEVICE 5DSW BCT 5 T3 [J.IF MORE DEVICES TO LOOK AT 5F#G LDX 2 FX2 [NO MORE DEVICES LEFT 5FS6 BRN Q610 [BE CODE:USE DEVICE WITH WRONG TEMP- 5G?Q [PROPS PERHAPS?? 5GL7 ...T7 SRC 0 1 5GYJ ... STO 3 IDFWK+3(1) [KEEP PTR IN APERIDF BLOCK 5H?2 STO 5 IDFWK(1) [KEEP ATTRIBUTIONS COUNT 5HQL STO 6 IDFWK+1(1) [KEEP CELL COUNT 5J== LDX 3 0 5J=P ...[ 5JPW CALL 7 YREC1 [FIND DEVICE CELL 5K9G SMO FX2 5KP6 LDX 7 AWORK4 [NORMAL DEVICE TYPE NO INTO X7 5L8Q LDX 6 BTYPE(3) [GEOG NO ETC.OR INTERFACE NO ETC. 5LNB LDX 5 BNO(3) [IDENT NO.OR TERMINAL IDENTIFIER ETC. 5M82 LDX 0 BLINE(3) [IN CASE 7900 KEEP MODE WORD 5MML LDX 4 2 [KEEP X2 FOR LATER USE 5N7= LDCT 2 #200 5NLW ANDX 2 BNUMB(3) [GET B1 OF BNUMB 5P6G BZE 2 T5 [J.IF B1 IS ZERO MEANING 7020 5PL6 ORX 7 GSIGN [SET B0 FOR 7900 5PNP ... LDX 2 BNUMB(3) [COPY 'SPOOLING' , 5PR# ... SLL 2 3 ['UNATTENDED' BITS 5PTX ... SMO FX1 5PYG ... ANDX 2 XMASK2 5Q35 ... ORX 7 2 5Q3C ...#UNS FL7502 5Q3P ...( 5Q43 ... BSXD 2,IDF7502LP 5Q4* ... ANDX 2 BNUMB+1(3) 5Q4M ... SRL 2 3-(IDF7502LP%) 5Q4^ ... ORX 7 2 5Q5? ...) 5Q5Q STO 0 IDEVMN(1) [STORE MODE 5QKB ANDN 6 #777 [MASK OUT GEOG.NO 5R52 SLL 6 12 [MOVE TO B0-11 5RJL ORX 5 6 [AND PUT GEOG.NO INTO X5(IDEVIC1+1) 5S4= T6 STO 7 IDEVIC1(1) [STORE UNIQUE WORDS IN APERIDF BLOCK 5SHW STO 5 IDEVIC1+1(1) 5T3G LDX 2 4 [RESCUE X2 5TH6 LDX 3 BATT(3) 5W2Q CALL 7 YREC [FIND ATTRIBUTION CELL 5WGB LDN 4 BTYPE(3) [GET READY TO MOVE ATTRIBUTIONS- 5X22 LDN 5 APERATTRIB(1) [INTO APERIDF BLOCK 5XFL MOVE 4 ATTMAX [ATTMAX MUST BE LESS THAN 6!! 5X^= LDX 2 FX2 5YDW BRN Q500 [J.TO TEST PROPERTIES ATTRIBUTED 5YYG T5 LDCT 2 #400 5^D6 DCH 6 7(2) [PUT INTERFACE NO IN CHAR2 OF X7 5^XQ LDX 0 BTYPE+2(3) 62CB ANDX 5 HALFTOP [KEEP 2 CHAR.IDENTIFIER 62X2 DCH 0 5 [DEPOSIT LINE NO. 63BL SRL 0 6 [GET RID OF LINE NO 63W= ANDN 0 #777 [MASK OUT GEOG.NO 64*W SLL 0 12 [MOVE TO B3-11 64TG ORX 7 0 [AND PUT IN X7 FOR IDEVIC1 65*6 BRN T6 [J.TO STORE "UNIQUE" WDS NOW MADE 65B7 ...T601 66?3 ... LDX 5 IDFWK(1) 66#B BCT 5 T20 66S2 BRN Q610 [ALL DONE:X2=FX2 ALREADY 67?L T20 LDX 6 IDFWK+1(1) [RESTORE X6 AND X3 67R= LDX 3 IDFWK+3(1) 67S* ...[ 68=W BRN T3 [AND JUMP TO LOOK FOR ANOTHER DEVICE 68QG # 69=6 # 69PQ # 6=9B V7900 [ JWK 6=P2 # THIS S/R GETS A 7900 IDENTIFIER FOR GETPER IF IT IS 6?8L # FREE TO BE USED. IT INDICATES FREENESS FOR ISPER 6?N= # 6#7W LDN 4 0 [INDICATE NORMAL ENTRY 6#MG VENT1 6*76 LDX 3 1 [X1 PTS TO APERI/APERIDF 6*LQ LDX 7 IDEVIC1+1(3) 6B6B LDX 6 IDEVIC1+1(3) 6BL2 ANDN 6 #7777 [KEEP IDENTIFIER NUMBER 6C5L SRL 7 12 6CY^ ... FMOPG 1,7,IPB [FIND AMOP/IPBIN 6D4W BPZ 1 VFND1 [J.IF AMOP FOUND 6DJG XBA 6F46 LDX 1 3 6FHQ BRN T601 [IPBIN NOT FOUND 6G3B XBAA [MOPPED OFF OR INOPERABLE 6GH2 BNZ 4 XBA 6H2L BRN VAB [NOT AVAILABLE 6HG= # 6H^W VFND1 6JFG STO 1 AWORK1(2) [RECORD ADDS OF IPBIN 6J^6 VFND2 6KDQ LDX 1 FPTR(1) [NOW SEEK ADEVS BLOCK 6KYB LDX 0 ATYPE(1) 6LD2 BXGE 0 CACT,XBAA [NO ADEVS BLOCK 6LXL SRL 0 12 6MC= SBN 0 AMXOR+ADEVS 6MWW BNZ 0 VFND2 6NBG # ADEVS FOUND 6NW6 LDCT 0 #420 6P*Q SMO AWORK1(2) 6PTB ANDX 0 IPBSW [J IF INOPERABLE OR 6Q*2 BNZ 0 XBAA [MOPPED OFF 6QSL LDX 7 IDEVIC1(3) [GET DEVICE TYPE 6R#= SLL 7 18 [PREPARE INFORMATION FOR JSOURCE1 6RRW ADX 7 6 [BEFORE X6 DESTROYED 6S?G # 6SR6 SBX 6 A1+FOURTHWD(1) [SUB LOWEST IDENTIFIER NO 6T=Q SLL 6 2 6TQB ADX 1 6 [ADEVS ENTRY FOR IDE NOW POINTED TO 6W=2 BNZ 4 VROUND [BR IF V900 ENTRY 6WPL # 6X9= SMO FX1 6XNW ... LDX 0 XMASK1 [LOADS #36650000 6Y8G ANDX 0 A1+FOURTHWD(1) 6YN6 BZE 0 VA [BR IF NOT WRONGED 6^7Q ORN 5 #10 [B20 SHOWS WRONGED 6^MB VA LDX 0 A1+BPTR(1) 7272 BZE 0 VB [BRANCH IF IDE FREE 72LL VAB 736= ORN 5 #20 [B19 SHOWS NOT FREE 738F ... SEGENTRY K20IDFPER [RESTORE TIME MACRO RMTLFUNAV 73=N ...VB BRN VB1 [OVERWRITES THIS WITH NULL 73#X ... LDX 0 AWORK3(2) 73C6 ... BNG 0 VB1 [JUMP IF DOING ISPER 73F* ... LDCT 0 #400 [BIT 0 73HJ ... ANDX 0 A1+FOURTHWD(1) [LOOK IF UNAVAILABLE 73KR ... BZE 0 VB1 [JUMP IF OK 73N2 ... ORN 5 #20 [SET B19 FOR NOTAV REPLY 73Q9 ... LDCT 0 #20 [SET BIT 4 IN APERIDF 73SD ... ORS 0 IDEVIC1(3) [CHECKED BEFORE LEAVING IDFPER 73WM ... SEGENTRY K21IDFPER 73YW ...VB1 7435 ... BZE 5 VC 745G LDX 1 3 [X1 TO POINT TO APERI/APERIDF 74K6 BRN Q565 [LABEL IF IDE CAN'T BE USED 754Q # 75JB VC LDX 0 AWORK3(2) 7642 BNG 0 VISPER [BRANCH IF ISPER,RATHER THAN GETPER 76HL # 773= VROUND 77GW STO 7 JSOURCE1(2) 782G LDX 0 IDEVIC1+1(3) 78G6 ANDX 0 HALFTOP 78^Q ORN 0 #6000 [B0=REMOTE, B1=7900 79FB SLC 0 12 79^2 STO 0 JSOURCE2(2) [JSOURCE2 HOLDS 7900 GEOG NO 7=DL MHUNTW 2,ADATA,CSTORE 7=Y= LDN 4 A1(2) 7?CW ADN 3 APERATTRIB [SET UP GOUT,GPROPNOS BLOCK 7?XG MOVE 3 ATTMAX [COPY IN ATTRIBUTION CELL 7#C6 SBN 3 APERATTRIB 7#WQ NAME 2,GOUT,GPROPNOS 7*BB LDX 2 FX2 [SET FLAG TO SAY "I HAVE A 7*W2 LFBITSET G,2 [GPROPNOS BLOCK" 7B*L NAME 3,AMXOR,ADCB [RENAME APERI/APERIDF BLOCK 7BT= ... RING2CHK A1+FPTR(1),A1+FPTR(3) 7C#W # RINGS ADCB BLOCK TO ADEVS ENTRY 7DDJ ... LDX 0 IDEVIC1(3) [COPY 'SPOOLING', 7DK2 ... SMO FX1 ['UNATTENDED' BITS 7DK* ...#UNS FL7502 7DKN ...( 7DL3 ... ANDX 0 XMASK3 7DLB ... SRL 0 20 7DLP ... STO 0 IBULK(3) 7DM4 ... ANDN 0 6 7DMC ... STO 0 IWAIT(3) 7DMQ ...) 7DN5 ...#UNS FL7502 7DND ...#SKI 7DNR ...( 7DPD ... ANDX 0 XMASK2 7DTW ... SRL 0 20 7F2# ... STO 0 IWAIT(3) 7F6Q ... STO 0 IBULK(3) 7F94 ...) 7F?B LDCT 0 #400 7FR2 ANDX 0 A1+FOURTHWD(1) 7G=L STO 0 ISTATUS(3) [COPY AVAILIBILITY BIT 7GQ= LDX 0 AWORK1(2) 7H9W STO 0 IADIN(3) [ADDS IPBIN 7HPG ANDN 7 #7777 7J96 STO 7 IDENTNO(3) 7JB# ... DOWN IPBSCAN,8 [COPY MODE/NPU SIZE TO ADCB 7JHG ... [(NOW KEPT IN IPBSCAN INSTEAD OF IDF) 7JNQ VLAST 7K5C ...# 7K6= ...X4IDFPER 7K75 ...# 7K8B CALL 7 TCLOSE 7KN2 BRN Q800 7L7L # 7LM= VISPER 7M6W FREECORE 3 [FREES APERIDF 7MLG BRN VLAST 7N66 V900 [LATER ENTRY TO V7900 7NKQ LDN 4 1 7P5B BRN VENT1 7PK2 # 7Q4L # 7QJ= # 7R3W PCTMSK1 #00770000 7RHG PCTFIND 7S36 STO 0 AWORK1(2) [SAVE LINK 7SGQ LDX 4 IDEVIC1(1) 7T2B SRL 4 12 [GET GEOG.NO IN BITS 15-23 OF X4 7TG2 ANDN 4 #777 7T^L FMOPG 3,4,MOP [FIND AMOP 7WF= BPZ 3 PCT2 [J IF FOUND 7WYW BRN T601 [AMOP NOT FOUND 7XDG PCT1A LDX 0 AWORK1(2) [ELSE MARK 'NOT FREE' 7XY6 PCT1B ORN 5 #20 7YCQ EXIT 0 1 [AND RETURN AT FAIL EXIT 7YXB # 7^C2 PCT2 [REQD AMOP FOUND 7^WL HUNT2OPT 3,AMXOR,ALINES [FIND THE ALINES BLOCK 82B= BNG 3 PCT1A [FAIL EXIT IF NOT FOUND 82TW LDX 4 IDEVIC1+1(1) 83*G ANDN 4 #77 [LINE NO.REQD 83T6 ADX 4 4 [4XLINO = RELATIVISED POINTER TO 84#Q ADX 4 4 [RECORD FOR REQD LINE 84SB ADX 3 4 [POINTER TO LINE ENTRY 85#2 LDCT 0 #720 85RL ANDX 0 A1+FOURTHWD(3) 86?= BNZ 0 PCT1A [J IF NOT SYSTEM USE 86QW LDX 3 A1+BPTR(3) [POINT TO LCB RING ELT FOR THIS LINE. 87=G BZE 3 PCT1A [J IF LCB NOT SET UP 87Q6 SBN 3 A1+FPTR [POINT TO START OF LCB 889Q HUNT2B 3,A7020,INFORM [HUNT BACK FOR INFORM BLOCK 88PB LDX 7 IDEVIC1+1(1) 8992 ANDX 7 HALFTOP [TERMINAL IDENT 89NL LDX 6 APCTNUM(3) [NO OF PCT'S ON THIS LINE 8=8= LDN 4 0 [PCT RECORD POINTER 8=MW PCT3 SMO 4 8?7G LDX 0 IDUNIQUE(3) [GET THIS PCT IDENT... 8?M6 ANDX 0 HALFTOP [FROM UNIQUE WORD 8#6Q TXU 0 7 8#LB BCC PCT4 [J IF THIS IS RECORD FOR REQD PCT 8*62 ADN 4 APCTRLEN [STEP TO NEXT RECORD 8*KL BCT 6 PCT3 [J UNLESS NO MORE PCT'S ON LINE 8B5= BRN PCT1A [J IF PCT NOT FOUND 8BJW PCT4 SMO 4 8C4G LDXC 6 APCTSTAT(3) 8CJ6 BCS PCT1A [J IF PCT IS INOP 8D3Q LDX 0 AWORK1(2) [RESET X0 - NO MORE MACROS BEFORE EXITING. 8DHB STO 3 AWORK1(2) [SAVE POINTER TO INFORM BLOCK 8F32 ADX 3 4 [X3 = POINTER TO REQD PCT RECORD 8FGL LDX 6 IDEVIC1(1) 8G2= ANDN 6 #7700 [REQD INTERFACE NO 8GFW SLL 6 6 8G^G LDN 7 12 [NOW FIND REQD INTERFACE 8HF6 PCT5 SMO 7 8HYQ LDX 4 APCTDEV-1(3) 8JDB SMO FX1 8JY2 ANDX 4 PCTMSK1 8KCL TXU 4 6 8KX= BCC PCT6 [J IF FOUND 8LBW SBN 7 2 8LWG BNZ 7 PCT5 [ELSE TRY NEXT INTERFACE 8MB6 BRN PCT1B [IF NOT FOUND,FAIL EXIT 8MTQ # 8N*B PCT6 [REQD INTERFACE FOUND 8NT2 SMO 7 8P#L LDX 4 APCTDEV-2(3) 8PS= SMO 7 8Q?W LDX 7 APCTDEV-1(3) 8QRG ANDN 7 #77 [7020 DEVICE CODE 8R?6 SMO FX1 8RQQ ANDX 4 PCTMSK1 [INTERFACE BIT POSN 8S=B EXIT 0 0 [RETURN OK 8SQ2 # 8T9L # 8TP= P7007 [ENTERED TO CHECK AVAILABILITY OF DEVICE 8W8W CALL 0 PCTFIND [LOCATE PCT RECORD IN X3,POINTER TO 8WNG [INFORM BLOCK IN AWORK1,X7=7020 TYPE 8X86 [CODE & X4=INTERFACE BIT POSITION 8XMQ BRN PCT10 [J IF OK 8Y7B BRN Q565 [ELSE J TO 'NOT AVAILABLE' PATH 8YM2 PCT10 [NOW FIND AVAILABILITY DETAILS 8^6L LDX 6 IDEVIC1(1) 8^L= ANDN 6 #77 [BASIC TYPE 925W ADX 6 FX1 [USE BASIC TYPE TO ACCESS 7020 TYPE- 92KG SMO 6 [CODE TABLE & TEST THAT THE TYPE NOW 9356 TXU 7 TYPE [RECORDED FOR THIS INTERFACE IN IDF 93JQ BCS T601 [MATCHES THAT SET IN CORE AT MOP-ON 944B [J IF THEY ARE DIFFERENT (IE USER HAS ALTERED IDF BY 94J2 [HARDWARE COMMAND WHILST PCT WAS MOPPED ON!) 953L STO 4 6 95H= SLL 4 6 962W ANDX 4 APCTD(3) [ISOLATE RIGHT/WRONG BIT. 96GG BNZ 4 PCT11 9726 ORN 5 #10 [MARK'DEVICE IS WRONGED' IN REPLY WD 97FQ PCT11 STO 6 4 97^B SRL 6 6 98F2 ANDX 6 APCTD(3) [ISOLATE FREE/USED BIT 98YL BNZ 6 PCT12 [J.IF FREE 99D= ORN 5 #20 [ELSE MARK'DEVICE NOT FREE' IN REPLY 99XW PCT12 BNZ 5 Q565 [J IF NOT AVAILABLE 9=CG LDX 0 AWORK3(2) [IF ENTRY WAS FROM GETPER NOT ISPER.. 9=X6 BPZ 0 PCT20 [...J TO ALLOCATE DEVICE TO THIS ACT. 9?BM ...PCT13 9?R^ ... CALL 7 TCLOSE [FREE FILE/FRRB & CLOSE IDF 9?WB BRN Q800 [RETURN TO MAIN BODY 9#B2 # 9#TL # 9**= PSTX #76227620,#76227635 [STX:NULL FOR TP. STX:C/R FOR LP. 9*SW PETX #76007623 [SPACE FOR INSERTING ETX OR DC3 :ETX. 9B#G # 9BS6 P900 [ENTERED TO ALOCATE DEVICE & SET UP BLKS & CHAINS 9C?Q CALL 0 PCTFIND 9CRB BRN PCT20 [J IF OK 9D?2 GEOERR 1,PCTLOST? 9DQL PCT20 LDX 5 3 9F== SBX 5 AWORK1(2) 9FPW ORX 5 4 [APCTID NOW SET UP READY FOR BUFFER 9G9G SRL 4 6 9GP6 ERS 4 APCTD(3) [CLEAR FREE/USED BIT = USED 9H8Q LDX 4 IDEVIC1(1) 9HNB LDX 6 IDEVIC1+1(1) 9J82 STO 6 7 9JML DSA 4 6 9K7= SRC 6 6 9KLW STO 6 JSOURCE1(2) 9L6G SRL 4 12 [GEOG NO IN B12-23 9LL6 ANDN 7 #77 [MASK OUT LINE NO 9M5Q SLL 7 9 [MOVE TO B9-15 9MKB DEX 4 7 [DEPOSIT GEOG.NO 9N52 LDCT 4 #500 [SET REMOTE+7020 9NJL ORX 4 7 9P4= STO 4 JSOURCE2(2) 9PHW LDX 4 APCTSTAT(3) 9PKN ... LDX 0 5 [INTERFACE MASK 9PMG ... SMO FX1 9PP# ... ANDX 0 PCTMSK1 9PR6 ... ANDX 0 4 9PSY ... STOZ 6 9PWQ ... BZE 0 PCT71 [J IF NOT SPOOLING 9PYJ ... LDN 6 4 [SET SPOOLING BIT 9Q2B ...PCT71 LDX 0 5 9Q48 ... SMO FX1 9Q62 ... ANDX 0 PCTMSK1 9Q7S ... SRL 0 6 9Q9L ... ANDX 0 4 9Q?D ... BZE 0 PCT72 [J IF ATTENDED 9Q*= ... ORN 6 2 [SET UNATTENDED BIT 9QC4 ...PCT72 ANDN 4 1 [1901A RJE BIT 9QDW ... ORX 4 6 [SET UP X4 FOR EWAIT 9QH6 LDX 3 AWORK1(2) [ADDR OF INFORM BLOCK 9R2Q HUNT2B 3,AMOP,APCT [FIND THE PCT ACTIVITY 9RGB ENRING JOBRING(2),JOBRING+1(3) [RING THIS ACT TO AMOP APCT 9S22 SETNCORE ALFBLOKLEN,3,A7020,ALIST,1,1,2 [GET BUFFER BLOCK 9SFL EMPTY FPTPCT(3) [CLEAR ITS PCT RING ELEMENTS 9S^= STO 5 APCTID(3) [INSERT SPECIAL WORD 9TDW STO 4 EWAIT(3) 9TYG STOZ EWAIT+1(3) 9WD6 LDN 0 EWAIT+1(3) 9WXQ LDN 1 EWAIT+2(3) 9XCB MOVE 0 ACTBUFF-EWAIT-1 [CLEAR STATUS REPLY & INTERLOCK AREAS 9XX2 PCT21 LDX 2 JOBRING+1(2) [NOW SEARCH 9YBL SBN 2 JOBRING [RING 9YW= LDCH 0 ATYPE(2) [FOR 9^*W SBN 0 AMOP/64 [THE AMOP/APCT 9^TG BNZ 0 PCT21 =2*6 HUNT2 2,A7020,INFORM [FIND THE INFORM BLOCK =2SQ ENRING FPTPCT(3),BPTPCT(2) [RING BUFFER TO END OF PCT RING =3#B LDN 1 JOBRING(2) =3S2 DERING 1 [FROM PCT'S FILERING =4?L EMPTY JOBRING(2) [CLEAR ITS JOB RING ELEMENTS =4R= LDCH 0 JSOURCE1(2) [GET THE DEVICE TYPE. =5=W SMO 0 =5QG LDX 4 PSTX-1(1) [LOAD STX:NULL OR STX:C/R. =6=6 LDX 5 PETX(1) =6PQ LDN 6 ALFBUFFNUM-1 =79B LDN 0 ALFBUFFNUM-1*32 =7P2 STO 4 ETXBUFF(3) [SET UP THE BUFFER FOR SENDING ETX. =88L STO 5 ETXBUFF+1(3) =8N= PCT22 SMO 6 [INITIALISE THE INTERLOCK WORDS. =97W STO 0 INTLK(3) =9MG SBN 0 32 ==76 BCT 6 PCT22 ==LQ BRN PCT13 =?6B # =?L2 # =#5L # =#K= # =*4W # =*JG # =B46 # =BHQ # THIS ROUTINE IS ENTERED TO COMPARE THE PROPERTIES ATTRIBUTED TO =C3B # THE DEVICE WITH THE PROPERTIES REQUIRED BY THE ACTIVITY SEEKING A =CH2 # DEVICE. THE ROUTINE IS VERY SIMILAR TO ONE IN SEGMENT GETFREE =D2L # WHICH DEALS WITH PLIST DEVICES. =DG= # =D^W SCHECKATT =FFG MHUNTW 3,APERI,APROPNOS [LOCATE PROPERTIES REQUIRED =F^6 LDN 5 0 [PRESET MARKER FOR THIS DEVICE =GDQ LDN 4 0 =GYB Q506 SMO 4 =HD2 LDX 0 APERATTRIB(1) [GET NEXT PROPERTY ATTRIBUTED TO DEV =HXL BZE 0 Q530 [J IF NO MORE =JC= SMO FX1 =JWW ANDX 0 QBITS23LS [REMOVE 'CLUSIVENESS' BIT =KBG LDX 6 BPROPCNT(3) [GET COUNT OF PROPERTIES REQUIRED =KW6 Q503 SMO 6 =L*Q TXU 0 BPROPS-1(3) =LTB BCC Q502 [J IF PROPERTY IS REQUIRED =M*2 BCT 6 Q503 =MSL SMO 4 =N#= LDX 0 APERATTRIB(1) [IS PROPERTY NOT REQUIRED INCLUSIVE? =NRW BPZ 0 Q504 [YES =P?G SLL 0 1 [NO, IS IT TEMPORARY? =PR6 BPZ 0 Q505 [YES =Q=Q ORN 5 4 [NO:SET P/E NOT REQUIRED MARKER =QQB BRN Q504 =R=2 Q505 ORN 5 32 [SET T/E NOT REQUIRED MARKER =RPL BRN Q504 =S9= Q502 LDCT 0 256 =SNW SMO 6 [MARK PROPERTY AS BEING ATTRIBUTED TO =T8G ORS 0 BPROPS-1(3) [THE DEVICE =TN6 Q504 ADN 4 1 [STEP POINTER TO NEXT ATTRIBUTION =W7Q LDN 0 ATTMAX [TEST IF CHECKED MAXIMUM POSSIBLE =WMB TXL 4 0 [NUMBER OF ATTRIBUTIONS =X72 BCS Q506 [NO =XLL Q530 LDX 4 BPROPCNT(3) [GET COUNT OF PROPERTIES REQUIRED =Y6= Q534 SMO 4 =YKW LDX 0 BPROPS-1(3) [IS PROPERTY ATTRIBUTED TO DEVICE? =^5G BNG 0 Q531 [YES =^K6 SLL 0 1 [NO, IS IT TEMPORARY ?24Q BPZ 0 Q532 [YES ?2JB ORN 5 2 [NO:SET PERM NOT GOT MARKER ?2N? ... SRL 0 1 [STORE MISSING PERMANENT PROPERTY ?2S8 ... ANDX 0 BITS22LS [IN ACOMMUNE8 ?2Y5 ... STO 0 ACOMMUNE8(2) ?342 BRN Q533 ?3HL Q532 ORN 5 32 [SET TEMP NOT GOT MARKER ?43= BRN Q533 ?4GW Q531 SMO FX1 ?52G LDX 0 QBITS23LS ?5G6 SMO 4 [CLEAR 'PROPERTY ATTRIBUTED' MARKER ?5^Q ANDS 0 BPROPS-1(3) ?6FB Q533 BCT 4 Q534 [CHECK ALL NAMES IN APROPNOS BLOCK ?6^2 EXIT 7 0 ?7DL Q500 [X1 POINTS TO APERI/APERIDF:X2=FX2 ?7Y= CALL 7 SCHECKATT [CHECK PROPERTY ATTRIBUTIONS ?8CW LDN 0 6 ?8XG ANDX 0 5 [TEST IF PERMANENT PROPERTIE ARE OK ?9C6 BNZ 0 Q563 [NO ?9CJ ...# ?9WQ LDX 0 IDEVIC1(1) ?=BB BNG 0 V7900 [ELSE BRANCH TO APPROPRIATE ROUTINE ?=W2 BRN P7007 [TO CHECK IF RIGHTED AND FREE ??*L [RE-ENTERED HERE FROM V7900/P7007 IF ??T= [DEVICE WRONGED OR ALREADY ALLOCATED ?##W [OR IF TEMP PROPS NO GOOD (I.E. VALUE ?#SG [IN X5 IS NON-ZERO) ?*#6 Q565 [X1 POINTS TO APERI/APERIDF:X2=FX2 ?*RQ Q563 NGN 0 1 ?B?B Q564 ADN 0 1 [SHIFT COUNT ?BR2 SRC 5 1 ?C=L BPZ 5 Q564 [FIND L.S. BIT SET IN STATE MARKER ?CQ= LDN 5 1 [FOR THIS DEVICE ?D9W SMO 0 ?DPG SLL 5 0 [AND SET BIT FOUND IN THE MASTER ?F96 ORS 5 AWORK2(2) [MARKER ?FNQ SBN 5 32 [TEST IF DEV OK EXCEPT FOR TEMP ?G8B BNZ 5 T601 [NO, GO FOR NEXT DEVICE ?GN2 NGX 0 AWORK3(2) [J UNLESS GETPER WITHOUT MESSAGE ?H7L BPZ 0 T601 [SUPPRESSION ?JLG LDN 4 IDEVIC1(1) ?K66 LDN 5 IDEVIC2(1) [REMEMBER THIS ONE ?KKQ ... MOVE 4 2+ATTMAX ?L5B BRN T601 [GO FOR NEXT DEVICE ?LK2 [ENTERED HERE WHEN NO MORE DEVICES ?M4L Q610 [X1 POINTS TO APERI/APERIDF:X2=FX2 ?MJ= LDX 0 IDEVIC2+1(1) [J IF NO DEVICE WITH WRONG TEMP PROPS ?N3W BZE 0 Q570 [HAS BEEN REMEMBERED ?NHG LDN 4 IDEVIC2(1) ?P36 LDN 5 IDEVIC1(1) [PUSH UP REMEMBERED DEVICE ?PGQ ... MOVE 4 2+ATTMAX ?Q2B LDX 4 1 ?QG2 LDX 1 4 ?Q^L LDCT 0 #400 [REMEMBER 'ALLOCATED' DEVICE HAS ?RF= ORS 0 AWORK2(2) [UNSUITABLE TEMP PROPS ?RYW LDX 0 IDEVIC1(1) ?SDG BNG 0 V900 [J TO APPROPRIATE ROUTINE TO ALLOCATE ?SY6 BRN P900 [THE DEVICE ?TCQ QBITS23LS #37777777 ?TXB [RE-ENTERED HERE AFTER DEVICE HAS ?WC2 [BEEN ALLOCATED ?WWL Q800 [X1=FX1:X2=FX2 ?XB= LDX 0 AWORK3(2) ?XTW BNG 0 Q572 [J IF ISPER ?Y*G MHUNTW 3,APERI,APROPNOS ?YT6 LDX 0 CPROPNO(3) ?^#Q ANDX 0 BITS22LS ?^SB STO 0 JSOURCE3(2) [STORE CONSOLE PROPERTY NUMBER #2#2 LDX 4 AWORK2(2) [J IF ALLOCATED DEVICE DOES NOT HAVE #2RL BNG 4 Q571 [CORRECT TEMP PROPS #3?= Q572 #3QW UPPLUS 1 #4=G Q570 #4?C ... LDCT 0 #20 #4## ... ANDX 0 IDEVIC1(1) [IS B4 SET FOR UNAVAILABLE? #4*9 ... BZE 0 Q570A [JUMP IF NOT #4B6 ... LDX 7 IDEVIC1+1(1) #4C3 ... LDX 6 7 #4CY ... ANDN 6 #7777 [GET IDE NO #4DT ... SRL 7 12 [AND UNIT NO #4FQ ... MHUNTW 3,APERI,APROPNOS #4GM ... LDX 0 CPROPNO(3) #4HJ ... ANDX 0 BITS22LS [CONSOLE PROPERTY NO #4JF ... STO 0 JSOURCE3(2) [NEEDED FOR INFORM OUTPUT #4KB ... OUTNUM 7,0 [UNIT NO #4L? ... OUTNUM 6,0 [IDE NO #4M8 ... INFORM 2,IDISENG,1 [WARN CLUSTER OP DEVICE DISENGAGED #4N5 ... STOZ JSOURCE3(2) #4P2 ...Q570A #4Q6 CALL 7 TCLOSE [CLOSE IDF #59Q [ENTERED HERE IF THERE WAS NO DEVICES #5PB Q602 [X1=FX1:X2=FX2 #5Q? ...Q571 #6LB ...Q571A #6M? ... LDEX 4 AWORK2(2) [COPY MASTER MARKER SO THAT GETFREE #6NL STO 4 ACOMMUNE9(2) [SEGMENT CAN PICK IT UP #78= UPPLUS 2 [EXIT TO GETFREE - DEVICE NOT FOUND #7MW XBRK #87G UP [BREAK IN WHILE OPENING THE IDF #8M6 #PAGE #96Q MENDAREA 50,K100IDFPER #9LB #END ^^^^ ...75776453000200000000