{{htmlmetatags>metatag-description:(ICL George 3 and George 4 source: DRUM852)}}
====== DRUM852 ======
(George Source)
**Macros used:** [[george:macro:CHECKA|CHECKA]], [[george:macro:CHECKEXT|CHECKEXT]], [[george:macro:CLALLOC|CLALLOC]], [[george:macro:COMBRKIN|COMBRKIN]], [[george:macro:COMERRX|COMERRX]], [[george:macro:COOR1|COOR1]], [[george:macro:DCA|DCA]], [[george:macro:ENDCOM|ENDCOM]], [[george:macro:FADDRESS|FADDRESS]], [[george:macro:FOUTMOVE|FOUTMOVE]], [[george:macro:FREECORE|FREECORE]], [[george:macro:FREEPER|FREEPER]], [[george:macro:GEOERR|GEOERR]], [[george:macro:GETACTX|GETACTX]], [[george:macro:GETPER7|GETPER7]], [[george:macro:GPERI|GPERI]], [[george:macro:ILLEGALX|ILLEGALX]], [[george:macro:INFORM|INFORM]], [[george:macro:ISPERG|ISPERG]], [[george:macro:LGEOG|LGEOG]], [[george:macro:LINKSET|LINKSET]], [[george:macro:LOCKC|LOCKC]], [[george:macro:LOCKCA|LOCKCA]], [[george:macro:LPROP|LPROP]], [[george:macro:LTYPE|LTYPE]], [[george:macro:MENDAREA|MENDAREA]], [[george:macro:MHUNT|MHUNT]], [[george:macro:MHUNTW|MHUNTW]], [[george:macro:MURDER|MURDER]], [[george:macro:OLPFIN1|OLPFIN1]], [[george:macro:OUTBLOCK|OUTBLOCK]], [[george:macro:OUTNUM|OUTNUM]], [[george:macro:OUTPARAM|OUTPARAM]], [[george:macro:PAIR|PAIR]], [[george:macro:PEROFF|PEROFF]], [[george:macro:PERON|PERON]], [[george:macro:PMODES|PMODES]], [[george:macro:PROPERTY|PROPERTY]], [[george:macro:PUTPERENT|PUTPERENT]], [[george:macro:RG|RG]], [[george:macro:ROLPA|ROLPA]], [[george:macro:SEGENTRY|SEGENTRY]], [[george:macro:SETALLOC|SETALLOC]], [[george:macro:SETNCORE|SETNCORE]], [[george:macro:TESTREP2|TESTREP2]], [[george:macro:TOPCA1|TOPCA1]], [[george:macro:TRACE|TRACE]], [[george:macro:UNLOCK|UNLOCK]], [[george:macro:UNPLUG|UNPLUG]], [[george:macro:UP|UP]]
22FL ...#SEG DRUM852 [FRANK BLUNDELL
22^= #DEF XA1=A1
23DW #LIS K0DRUM
23YG 8HDRUM
24D6 #
24XQ SEGENTRY K2DRUM,QK2DRUM
25CB SEGENTRY K3DRUM,QK3DRUM
25X2 SEGENTRY K4DRUM,QK4DRUM
26BL #
26W= # PROPERTY
27*W # STORED IN A CPAR/GPERCON BLOCK.PARAMETER 2 IS THE
27TG # ON ENTRY,PARAMETER 1 HAS BEEN ANALYSED AND THE RESULT
28*6 # THIS SEGMENT DEALS WITH THE ONLINE COMMAND FOR DRUM.
28SQ XER GEOERR 1,TYPWRONG
29#B XLINK PAIR DRUM,2
29J8 ...XGHSD 4HGHSD
29S2 #
2=?L XCOM COMERRX 3
2=R= XBRKIN COMBRKIN
2?=W XWRNG +ERWRONGED [UNIT WRONGED
2?QG XDALA +JDALLA [DRUM ALLOCATED
2#=6 XDOSN +JDOESN [DRUM DOES NOT EXIST
2#PQ XPER1 +JPERR1 [CONSOLE PROPERTY SPECIFIED
2*9B XPER2 +JPERR2 [TOO MANY PROPERTIES SPECIFIED
2*P2 XPERX +JPERMX [PROP NOT ATTRIBUTED
2B8L XPROP +JPROPM [PROP PARAM MISSING
2BN= ...XPRNA +JPROPSNA1 [PROPERTY UNAVAILABLE
2C7W XPRUN +JPROPUNK [PROPERTY UNKNOWN
2CMG XCNT +JYCOUNT [ILL:COUNT OUT OF RANGE
2D76 XMODE +JYMODE [ILLEGAL:MODE IN ERROR
2DLQ XNOBF +JYNOBUF [ILL:BUFFER OUT OF RES
2F6B XNOCA +JYNOCA [ILL:C.A.OUT OF RESERVATIONS
2FL2 XRGE +JYRANGE [ILL:DEVICE ADDRESS OUT OF RANGE
2G5L #
2GK= QK4DRUM
2H4W #SKI K6DRUM>99-99
2HJG TRACE 1,DRUM ONL
2J46 MHUNTW 1,CPAR,GPERCON
2JHQ LDX 0 XA1(1)
2K3B STO 0 7
2KH2 SRL 0 15
2L2L SBN 0 9 [TEST FOR DRUM
2LG= BNZ 0 XER [J TO GEOERR IF NOT
2L^W FREECORE 1 [FREE GPERCON
2MFG LDX 3 XPROP(1)
2M^6 PROPERTY XCOM,1
2NDQ LDCT 4 #200 [ONLINE BIT SET
2NYB ADN 4 9
2PD2 STOZ 6
2PXL STOZ CPPTR(2)
2QC= ISPERG 4,XBRK,NOPR
2QWW TESTREP2 OK,OKAY,NOPER,RC,PERMEXCL,RA,NOPROP,RB,NOTAV,RD
2RBG TESTREP2 XCPROP,XC,MAXATT,XT,XPROP,XPRO,WRNG,RE
2RW6 RA LDN 6 1
2S*Q BRN RC
2STB RB LDN 6 2
2T*2 BRN RC
2TSL RD LDN 6 3
2W#= BRN RC
2WRW RE LDN 6 4
2X?G RC LDCT 4 16
2XR6 ADS 4 7
2Y=Q LDCT 4 #310
2YQB GETPER7 4,XBRK,NOPR
2^=2 TESTREP2 OK,OKAY,NOPER,RJ,PERMEXCL,RK,NOPROP,RF
2^PL TESTREP2 NOTAV,RG,WRNG,RH
329= RJ BZE 6 NOPER
32NW SBN 6 1
338G BZE 6 PEXC
33N6 SBN 6 1
347Q BZE 6 NOPROP [DEVICE OF SPECIFIED TYPE EXISTS BUT
34MB SBN 6 1 [DOES NOT HAVE THE REQ.PERM.PROP.
3572 BZE 6 NOTAV
35LL BRN WRNG
366= RK BZE 6 PEXC
36KW SBN 6 1
375G BZE 6 PEXC
37K6 SBN 6 1
384Q BZE 6 NOPROP
38JB BRN PEXC
3942 RF BRN NOPROP
39HL RG BZE 6 NOTAV
3=3= SBN 6 1
3=GW BZE 6 PEXC
3?2G SBN 6 1
3?G6 BZE 6 NOPROP
3?^Q SBN 6 1
3#FB BZE 6 NOTAV
3#^2 BRN WRNG
3*DL RH BZE 6 WRNG
3*Y= SBN 6 1
3BCW BZE 6 PEXC
3BXG SBN 6 1
3CC6 BZE 6 NOPROP
3CWQ BRN WRNG
3DBB NOPER LDX 3 XDOSN(1) [DRUM DOES NOT EXIST
3DW2 BRN XCOM
3F*L PEXC LDX 3 XPERX(1)
3FT= BRN XCOM
3G#W XT LDX 3 XPER2(1)
3GSG BRN XCOM
3H#6 XC LDX 3 XPER1(1)
3HRQ BRN XCOM
3J?B XBRK LDX 3 CPPTR(2)
3JR2 BZE 3 XBRKIN
3K=L FREEPER
3KQ= BRN XBRKIN
3L9W NOPR LDX 3 CPPTR(2)
3LPG BZE 3 NOPROP
3M96 FREEPER
3MNQ NOPROP
3N8B LDX 3 XPRNA(1)
3NN2 BRN XCOM
3P7L XPRO MHUNTW 1,APERI,APROPS
3PM= MHUNT 3,CPB,CUNI
3Q6W ADX 1 ACOMMUNE1(2)
3QLG LDN 2 ANUM(3)
3R66 LDX 5 0(1) [NO OF CHARS IN PROP
3RKQ ADN 5 4 [ADD 4 FOR COUNT
3S5B SMO 5
3SK2 MVCH 1 0
3T4L SMO FX1
3TJ= LDX 3 XPRUN
3W3W BRN XCOM
3WHG NOTAV LDX 3 XDALA(1)
3X36 BRN XCOM
3XGQ WRNG LDN 0 0
3Y2B OUTPARAM 0,APARA
3YG2 LDX 3 XWRNG(1)
3Y^L BRN XCOM
3^F= OKAY SETALLOC
3^YW PERON
42DG LGEOG ,5
42Y6 LDN 0 4 [NUMBER OF PARAMETERS FOR
43CQ OUTBLOCK 0 [SETTING UP GMON/ASET
43XB OUTNUM 5,0
44C2 OUTNUM JOBNO(2),0
44WL INFORM 1,JDONL,1 [MESSAGE:'DRUM ONLINE'
45B= LDCT 4 AOLPT/8 [LOAD TYPE OF BLOCK
45TW LDN 5 EXAOLPT [LENGTH REQUIRED
46*G GETACTX 4,5,1 [AOLPT SET UP
46T6 LDX 1 BPTR(2) [PTR TO AOLPT
47#Q LDX 6 CPPTR(2)
47SB STO 6 CPPTR(1) [STORE ADDR OF D.L.
48#2 LDCT 6 #400
48RL STO 6 FRECHADD(1) [SET UP FRECHADD
49?= LDX 6 JOBNO(2)
49QW STO 6 JOBNO(1) [JOB NUMBER
4==G LDX 6 7
4=Q6 ANDN 6 #7777 [OBTAIN UNIT NO.
4?9Q STO 6 EWCHAN(1)
4?PB LDN 6 8
4#92 STO 6 ATMARK(1)
4#NL STOZ GIVE(1)
4*8= STOZ AWORK1(1)
4*MW LDX 3 FX1
4B7G LINKSET 1,XLINK(3)
4BM6 LDCT 6 #400 [INDICATES PERIPHERAL IS OFFLINE
4C6Q PUTPERENT 7,6 [ENTRY IN PERIPHERAL RES BLOCK
4CLB ROLPA [CHAIN AOLPT IN PCA CHAIN
4D62 MHUNT 3,CPB,CUNI
4DKL FREECORE 3 [FREE CUNI
4F5= ENDCOM [ACROSS TO COMPROB
4FJW #
4G4G # ENTRY POINT FOR DRUM TRANSFERS
4GJ6 #
4H3Q QK2DRUM
4HHB #SKI K6DRUM>199-199
4J32 TRACE 1,DRUMPERI
4JGL LDX 0 APETADDR(2)
4K2= LDX 5 EVENT2(2) [OBJ PROG ADDR OF C.A.
4KFW LOCKCA 0,5
4K^G LDN 4 5 [LENGTH OF C.A.
4LF6 LDX 3 XNOCA(1)
4LYQ CHECKEXT 5,4,STP,APETADDR(2),W,SA,HLOCK1
4MDB SA
4MY2 #SKI K6DRUM>199-199
4NCL (
4NX= LDX 3 EVENT4(2) [LOAD 1ST WORD OF C.A.
4PBW SRL 3 15
4PLN ... ANDN 3 #377
4PWG SBN 3 9 [TEST FOR DRUM
4QB6 BZE 3 SB
4QTQ SBN 3 16 [TEST FOR HS DRUM
4R*B BNZ 3 XER [XER=GEOERR TYPWRONG
4RT2 SB LDX 3 EVENT3(2) [OBTAIN CHANNEL NO
4S#L LDX 0 EWCHAN(2)
4SS= SBX 3 0 [CHECK CHAN NO. CORRECT
4T?W BZE 3 SC
4TRG GEOERR 1,CHANRONG
4W?6 SC
4WQQ )
4X=B LDX 0 EVENT4(2) [LOAD TYPE/MODE
4XQ2 ANDN 0 #7777 [ISOLATE MODE
4Y9L BZE 0 MODE [J IF READ
4YP= SBN 0 1
4^8W BZE 0 MODE [J IF WRITE
4^NG SBN 0 #577
5286 BZE 0 MODE6 [J IF WORKFILE OPEN MODE
52MQ SBN 0 #200
537B BZE 0 MODEX [J IF CLOSE FILE MODE
53M2 SLD LDX 3 XMODE(1) [LOAD MESSAGE IDENTIFIER
546L STP TOPCA1 XLINK(1)
54L= UNPLUG
555W ILLEGALX 3
55KG #
5656 # ROUTINE FOR MODES 0 AND 1
56JQ #
574B MODE LDCT 4 #400 [CHECK PERI OPEN HAS
57J2 ANDX 4 GIVE(2) [ALREADY BEEN RECEIVED
583L BZE 4 SLD [J IF NOT
58H= LDX 3 APETADDR(2)
592W LDX 4 EVENT2(2) [ADDR OF AREA TO
59GG ADN 4 2 [BE MOVED
5=26 LDN 5 AWORK2(2) [AREA INTO WHICH C.A. WILL BE MOVED
5=FQ LDN 6 3 [LENGTH OF C.A.
5=^B FOUTMOVE 3,4,5,6,HLOCK1 [MOVE C.A. INTO AWORK WORDS
5?F2 PMODES 4,3 [OBTAIN BRANCH AND STORE MODES
5?YL ANDN 4 #10 [SEE IF EXTENDED STORE MODE
5#D= BNZ 4 TA [AND J IF IT IS
5#XW LDX 5 BSP16 [MASK FOR 15AM
5*CG BRN TB
5*X6 TA LDX 5 BITS22LS [MASK FOR 22AM
5BBQ TB ANDX 5 AWORK3(2) [MASK IN BUFFER ADDRESS
5BWB LDX 3 XNOBF(1) [MESSAGE IDENTIFIER
5CB2 CHECKA 5,AWORK2(2),STP,APETADDR(2),W,TC
5CTL TC LDX 3 APETADDR(2)
5D*= #SKI G3
5DSW FADDRESS 3,5,HLOCK2 [DATUMISE ADDRESS
5F#G DCA ,STO,5,CTSA [STORE BUFF ADDR IN D.L.
5FS6 LDEX 0 EVENT4(2) [LOAD MODE
5G?Q DCA ,DLA,0,MODE [STORE MODE IN D.L.
5GRB #SKI G4
5H?2 (
5HQL SMO APETADDR(2)
5J== LDX 0 ASEGTAB
5JPW DCA ,STO,0,SEGTAB
5K9G LDX 0 BIT9
5KP6 DCA ,ORS,0,MODE
5L8Q )
5LNB LDX 0 AWORK2(2) [LOAD COUNT
5M82 LDX 3 XCNT(1) [MESS IDENTIFIER
5MML BZE 0 STP
5N7= LDX 4 BSP16
5NLW TXL 4 0 [IS COUNT < #77777
5P6G BCS STP [J IF SO
5PL6 DCA ,STO,0,COUNT [STORE COUNT IN D.L.
5Q5Q LDX 0 AWORK4(2) [LOAD DRUM ADDRESS
5QKB LDX 3 XRGE(1) [MESS IDENTIFIER
5QMK ... LDX 1 EVENT4(2)
5QPS ... SRL 1 15 [ TYPE. -- 9 OR 25
5QS3 ... SBN 1 9 [ * FOR *DR, BS ADDRESS IS IN WORDS
5QW= ... BZE 1 TYPE9 [ * FOR HSD, BS ADDRESS IS IN BLOCKS
5QYF ... SLL 0 7 [ GET DRUM ADDRESS IN WORDS
5R2N ...TYPE9 LDX 1 FX1
5R52 TXL 0 AWORK1(2) [IS ADDRESS VALID
5RJL BCC STP [J IF NOT
5SHW ADX 0 AWORK2(2) [ADD COUNT
5T3G SBN 0 1
5TH6 LDX 3 XCNT(1) [MESS IDENTIFIER
5W2Q TXL 0 AWORK1(2) [IS ADDRESS VALID
5WGB BCC STP [J IF NOT
5WMJ ... LDX 0 AWORK4(2) [ DRUM ADDRESS ....
5WSQ ... DCA ,STO,0,DTSA [ ... TO DEVICE LIST.
5X22 LDEX 0 EVENT4(2) [LOAD MODE
5XFL ORS 0 GIVE(2)
5X^= GPERI ,2 [INITIATES TRANSFER
5YDW COOR1
5YYG LDX 5 CPRW1(2) [LOAD REPLY WORD
5^D6 #SKI G3
5^XQ (
62CB LDX 3 APETADDR(2)
62X2 LDCT 6 #770
63BL ANDX 6 5 [ISOLATE ERROR BITS
63W= SLL 5 6
64*W SRL 5 6
64TG BZE 5 TE
65*6 SBX 5 ADATUM(3)
65SQ TE ORX 5 6
66#B )
66S2 BRN UF
67?L #
67R= # ROUTINE FOR MODE #600
68=W #
68QG MODE6 LDCT 0 #400 [HAS A PERI OPEN ALREADY
69=6 ANDX 0 GIVE(2) [BEEN DONE
69PQ BNZ 0 SLD [J IF SO
6=9B LDCT 0 #400
6=P2 ERS 0 GIVE(2)
6?8L LDX 0 EVENT4(2)
6?N= SRL 0 15 [TEST FOR HIGH
6#7W SBN 0 25 [SPEED DRUM AND
6#MG BNZ 0 UB [J IF NOT
6*76 LDCT 5 #20 [SET 512K BIT
6*LQ STO 5 AWORK1(2) [REMEMBER SIZE OF DRUM
6B6B BRN UF
6BL2 UB LPROP ,3 [LOAD PHYSICAL PROPS INTO X3
6C5L SRL 34 3
6CK= SRL 4 21 [DRUM TYPE 0,1 OR 2
6D4W ANDN 3 #17 [TOTAL NO OF DRUMS
6DJG BNZ 4 UC [J IF TYPE 1 OR 2
6F46 LDCT 0 1 [SET 32K BIT
6FHQ BRN UE
6G3B UC SBN 4 1
6GH2 BNZ 4 UD [J IF TYPE 2
6H2L LDCT 0 4 [SET 128K BIT
6HG= BRN UE
6H^W UD LDCT 0 #20 [SET 512K BIT
6JFG UE ADS 0 AWORK1(2)
6J^6 BCT 3 UE
6KDQ LDX 5 AWORK1(2) [LO SYST SIZE AS REPLY
6KYB BRN UF
6LD2 UG STOZ 5
6LXL UF LDX 3 APETADDR(2)
6MC= LDX 1 EVENT2(2) [OBJECT PROGRAM REPLY
6MWW ADN 1 1 [WORD ADDRESS TO
6NBG FADDRESS 3,1,HLOCK1 [BE CONVERTED RELATIVE TO G'S DATUM
6NW6 STO 5 0(1) [SET REPLY
6P*Q LDX 1 FX1
6PTB OLPFIN1 XLINK(1)
6Q*2 #
6QSL # ROUTINE FOR CLOSE MODE #1000
6R#= #
6RRW MODEX LDCT 0 #400 [CHECK PERI OPEN HAS
6S?G ANDX 0 GIVE(2) [ALREADY BEEN RECEIVED
6SR6 BZE 0 SLD [J IF NOT
6T=Q ERS 0 GIVE(2) [REMOVE BIT
6TQB STOZ AWORK1(2)
6W=2 BRN UG
6WPL #
6X9= #
6XNW # RELPERENT ENTERS HERE
6Y8G # X3 POINTS TO AOLPT
6YN6 #
6^7Q XDRUM #44626555
6^MB XFREE #46624545
7272 XAREA #41624541
72LL #
736= QK3DRUM
73KW #SKI K6DRUM>99-99
745G TRACE 3,DRUMFREE
74K6 LDX 5 CPPTR(3)
754Q CLALLOC 5
75JB PEROFF 5 [CLEAR ONLINE BIT
7642 LDX 7 AWORK1(3)
76HL LDEX 6 GIVE(3)
773= LGEOG 5,4
77GW OUTNUM 4,0 [SET UP GEOG NO.
782G MURDER 3 [MURDER AOLPT
78G6 BNZ 6 VA
78^Q INFORM 1,JDFREE,1 [DRUM OK
79FB BRN VE
79^2 VA SETNCORE 8,3,ADATA,AWPER,1
7=DL ADN 3 XA1 [ADJUST POINTER TO BLOCK
7=Y= LTYPE 5,0
7?CW SBN 0 25 [TEST FOR H.S.DRUM
7?XG BNZ 0 VB
7#C6 STOZ 0(3)
7#WQ LDN 4 1(3)
7*BB MOVE 3 7 [ZEROISE DATA WORDS
7*W2 ... LDX 0 XGHSD(1)
7B*L STO 0 0(3)
7BT= LDN 0 8
7C#W STO 0 2(3) [STORE 8 IN THIRD WORD
7CSG LDN 4 0 [DEVICE ADDRESS,I.E.-BLOCK 0
7D#6 BRN VC
7DRQ VB LDN 0 1033 [PNTR TO NEXT FREE WORD IN DIR
7F?B STO 0 0(3)
7FR2 SRL 7 10 [SYSTEM SIZE CONVERTED
7G=L SBN 7 2
7GQ= LDN 0 #4000
7H9W SLL 0 1 [ABS ADDR OF UNUSED AREA-BITS 2-12
7HPG ORS 0 7
7J96 STO 7 1(3) [STO IN DATA BLOCK
7JNQ LDX 0 XDRUM(1)
7K8B STO 0 2(3)
7KN2 LDX 0 XFREE(1)
7L7L STO 0 3(3)
7LM= LDX 0 XAREA(1)
7M6W STO 0 4(3)
7MLG LDN 0 #2001
7N66 STO 0 5(3)
7NKQ LDN 0 6 [NO. OF WORDS TO BE TRANSFERRED
7P5B LDN 4 1024 [DEVICE ADDRESS
7PK2 VC DCA 5,STO,0,COUNT
7Q4L DCA 5,STO,4,DTSA
7QJ= LDN 0 1
7R3W DCA 5,DLA,0,MODE
7RHG LOCKC 2,£
7S36 SBN 3 XA1
7SGQ LOCKC 3,ZR
7T2B MHUNTW 3,ADATA,AWPER
7TG2 ADN 3 XA1 [GET TSA
7T^L DCA 5,STO,3,CTSA [AND STORE IN DEVICE LIST
7WF= LDX 2 FX2
7WYW SBN 3 XA1 [RESTORE PTR TO ADATA AWPER
7XDG GPERI 5,2
7XY6 COOR1
7YCQ UNLOCK 2
7YXB UNLOCK 3
7^C2 FREECORE 3
7^WL LDX 0 CPRW1(2) [LOAD REPLY
82B= SRL 0 18 [TEST FOR ERROR
82TW BNZ 0 VD
83*G INFORM 1,JALLF,1 [FILES NEED ALLOCATING
83T6 BRN VE
84#Q VD INFORM 1,JDCORR,1 [DRUM NEEDS INITIALIZING
84SB VE UP
85#2 ZR MHUNTW 2,ADATA,AWPER
85RL EXIT 1 0
86?= MENDAREA 50,K99DRUM
86QW #END
^^^^ ...54443560000300000000