DRUM852

(George Source)

Macros used: CHECKA, CHECKEXT, CLALLOC, COMBRKIN, COMERRX, COOR1, DCA, ENDCOM, FADDRESS, FOUTMOVE, FREECORE, FREEPER, GEOERR, GETACTX, GETPER7, GPERI, ILLEGALX, INFORM, ISPERG, LGEOG, LINKSET, LOCKC, LOCKCA, LPROP, LTYPE, MENDAREA, MHUNT, MHUNTW, MURDER, OLPFIN1, OUTBLOCK, OUTNUM, OUTPARAM, PAIR, PEROFF, PERON, PMODES, PROPERTY, PUTPERENT, RG, ROLPA, SEGENTRY, SETALLOC, SETNCORE, TESTREP2, TOPCA1, TRACE, UNLOCK, UNPLUG, UP

DRUM852.txt
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