{{htmlmetatags>metatag-description:(ICL George 3 and George 4 source: IDFPER867)}}
====== IDFPER867 ======
(George Source)
**Macros used:** [[george:macro:ALTLENG|ALTLENG]], [[george:macro:BSXD|BSXD]], [[george:macro:BXGE|BXGE]], [[george:macro:CLOSE|CLOSE]], [[george:macro:DERING|DERING]], [[george:macro:DERINGD|DERINGD]], [[george:macro:DOWN|DOWN]], [[george:macro:EMPTY|EMPTY]], [[george:macro:ENRING|ENRING]], [[george:macro:FMOPG|FMOPG]], [[george:macro:FREECORE|FREECORE]], [[george:macro:GEOERR|GEOERR]], [[george:macro:HUNT2|HUNT2]], [[george:macro:HUNT2B|HUNT2B]], [[george:macro:HUNT2OPT|HUNT2OPT]], [[george:macro:HUNTW|HUNTW]], [[george:macro:IDFOPEN|IDFOPEN]], [[george:macro:IDFPER|IDFPER]], [[george:macro:INFORM|INFORM]], [[george:macro:LFBITSET|LFBITSET]], [[george:macro:MENDAREA|MENDAREA]], [[george:macro:MFREEALL|MFREEALL]], [[george:macro:MHUNTW|MHUNTW]], [[george:macro:MXB|MXB]], [[george:macro:NAME|NAME]], [[george:macro:OUTNUM|OUTNUM]], [[george:macro:PCTFIND|PCTFIND]], [[george:macro:POINTACT|POINTACT]], [[george:macro:RERING|RERING]], [[george:macro:RING2CHK|RING2CHK]], [[george:macro:RINGPURG|RINGPURG]], [[george:macro:SEGENTRY|SEGENTRY]], [[george:macro:SETNCORE|SETNCORE]], [[george:macro:TCLOSE|TCLOSE]], [[george:macro:UP|UP]], [[george:macro:UPPLUS|UPPLUS]], [[george:macro:VFREEW|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