RENAMEX867

(George Source)

Macros used: CAPCA, CHAIN, CHECKEXT, DOWN, EXCHOFE, FADDRESS, FIPPER, FOUTMOVE, FREECORE, GEOERR, GETWORD, HUNTW, ILLEGAL, ILLEGALX, MENDAREA, MFINDEXOF, MHUNTW, NAME, OLPFIN1, OUTPACK, PAIR, PLOCKSU, PROGBRKIN, RELST, REPMON, RUNPROG, SEG, SEGENTRY, SETNCORE, SMUSEST, STEPBACK, SUSEST, SXTEST, TESTMON, TESTREP, TESTREP2, TOPCA1, TRACE, TWAIT, UNLOCKSU, UNPLUG, WORDFIN

RENAMEX867.txt
22FL ...      SEG      RENAMEX,860,FRANK BLUNDELL,RENAMEX   
23YG    #   
245N ...#     COPYRIGHT INTERNATIONAL COMPUTERS LTD   1982  
24=W ...#   
24D6    #     THIS SEGMENT DEALS WITH MODE #700 PERI ORDER. 
24XQ    #     ON ENTRY THE CURRENT ACTIVITY IS AN AOLPT.
25CB    #   
25X2    #DEF   XCA=EVENT2   
26BL    #   
26W=          SEGENTRY K1RENAMEX,QK1RENAMEX 
27*W    #   
27TG    ZLINK PAIR     PERION,1 
28*6    RERR  GEOERR   1,RESVIOL           [SHOULD NOT BE ANY VIOLATION 
28GY ...XEWINS         +EWINS              [EXOFILE Z NO LONGER SECURE  
28JW ...XEWRAR         +EWRARC             [EXOFILE ENTRY DOES NOT EXIST
28LS ...XEWTRA         +EWTRAPC            [EXOFILE ENTRY TRAPS CLOSED  
28NQ ...XEXIS          +EWEXISA            [EXOFILE ALREADY EXISTS  
28SQ    #   
29#B    #     MONITORING FILE ILLEGALS  
29S2    #   
2=?L    NP1            +JYNOCA             [RESERVATION VIOLATION   
2=R=    NP2            +JYMODE             [MODE IN ERROR   
2?=W    NP3            +JYINVAL            [INVALID CONTROL AREA
2?QG    #   
2#=6    #     REPLIES TO PROG   
2#PQ    #   
2*9B    REP1           #40000005           [FILE NOT OPEN FOR WRITING   
2*P2    REP2           #40000006           [STORAGE UNIT NOT ONLINE 
2B8L    TEN            +10  
2BN=    #   
2C7W    #   
2CMG    QK1RENAMEX  
2D76          LDX   0  XCA(2)              [PROGS CONTROL AREA ADDRESS  
2DLQ          STO   0  AWORK1(2)           [REMEMBER
2F6B    #SKI  K6RENAMEX>99-99   
2FL2          TRACE    0,RENAMEX
2G5L          STO   6  AWORK2(2)           [REMEMBER ADDITIVE MODES 
2GK=          LDN   7  9                   [LENGTH OF CONTROL AREA  
2H4W          CHECKEXT AWORK1(2),7,OUT,APETADDR(2),W,X1,HLOCK1 [CHECK CA
2HJG    X1  
2J46    #SKI  BMONITOR  
2JHQ    (   
2K3B          LDN   5  BBRENAME            [RENAME MONITORING   
2PXL          LDCT  6  #6                  [DEVICE TYPE B0-B8   
2QC=          ORX   6  EWCHAN(2)           [CHANNEL B9-B23  
2RBG          TESTMON  APETADDR(2),5,6,ONIT [TEST IF MONITORING REQUIRED
2RW6    )   
2S*Q          LDX   0  EXMODE(2)           [OPENING MODE
2STB          SBN   0  #600 
2T*2          BNZ   0  X2                  [OK IF NOT OPENED AS SCRATCH FILE
2TSL          LDX   7  NP2(1)              [MODE IN ERROR IDENTIFIER
2W#=          BRN      X3   
2WRW    OUT   LDX   7  NP1(1)              [RESERVATION VIOLATION IDENTIFIER
2X?G    X3    TOPCA1   ZLINK(1)            [CHANGE TO PCA   
2XR6          UNPLUG                       [DISCONNET PROG FROM EXEC
2Y=Q          ILLEGALX  7                  [REPORT ILLEGAL  
2YQB    #SKI  BMONITOR  
2^=2    (   
2^PL    #   
329=    #     MONITORING REQUIRED   
32NW    #   
338G    ONIT  LDX   7  AWORK1(2)           [PERI CA ADDRESS 
33N6          TOPCA1   ZLINK(1)            [CHANGE TO PCA   
347Q          REPMON   1                   [DO MONITORING AND RETURN TO CP  
34MB    #   
3572    )   
35LL    #   
366=    X2    LDX   0  EXMODE(2)           [OPENING MODE
36KW          SBN   0  #200 
375G          BNZ   0  X4                  [J IF FILE OPEN FOR WRITING  
37K6          LDX   7  REP1(1)             [GET REPLY   
384Q          BRN      X5   
38JB    #   
3942    X4    SETNCORE GEXDLEN,3,EWDAS,GEXD [GET DATA BLOCK 
39HL          LDX   1  APETADDR(2)         [PCA ADDRESS 
3=3=          LDX   6  AWORK1(2)           [CA ADDRESS  
3=GW          LDN   7  ARNCON-2(3)         [ADDRESS IN GEXD 
3?2G          LDN   4  7                   [NO OF WDS TO MOVE   
3?G6          FOUTMOVE 1,6,7,4,HLOCK1      [MOVE CONTROL AREA TO GEXD   
3?^Q    #            CHECK FOR UDAS FILENAME
3#FB          STO   3  1                   [CHECK   
3#^2          LDCH  0  ARNCON(1)           [FIRST   
3*DL          SBN   0  #41                 [CHAR
3*Y=          BNG   0  XENA                [ACTER   
3BCW          SBN   0  #32                 [ALPHA   
3BXG          BPZ   0  XENA                [BETIC   
3CC6          LDN   2  11                  [COUNT OF REST OF CHARACTERS 
3CWQ          BCHX  1  £
3DBB    NCH   LDCH  0  ARNCON(1)           [NEXT CHARACTER  
3DW2          SBN   0  10   
3F*L          BNG   0  XOKFN               [OK IF NUMERIC   
3FT=          SBN   0  #23  
3G#W          BZE   0  XOKFN               [OK IF A -   
3GSG          ADN   0  #15  
3H#6          BZE   0  XOKFN               [OK IF A SPACE   
3HRQ          SBN   0  #21  
3J?B          BNG   0  XENA                [ERROR IF < A
3JR2          SBN   0  #32  
3K=L          BPZ   0  XENA                [ERROR IF > Z
3KQ=    XOKFN BCHX  1  £
3L9W          BCT   2  NCH  
3LPG          LDX   2  FX2  
3M96          BRN      XCONT
3MNQ    XENA  LDX   1  FX1  
3N8B          LDX   7  NP3(1)              [INVALID CA  
3NN2          FREECORE 3
3P7L          BRN      X3   
3PM=    XCONT   
3PX3 ...      LDX   0  EXTRAPS(2)          [EXOFILE ENTRY'S TRAPS RECORD
3P^L ...      STO   0  EXOTRAP(3)          [FROM OLPA TO GEXD   
3Q6W          LDX   0  EWCHAN(2)           [CHANNEL NO FROM AOLPT   
3QLG          STO   0  EXCHNL(3)
3R66          LDX   0  AWORK1(2)           [CONTROL AREA ADDRESS
3RKQ          STO   0  CNR(3)              [TO   GEXD   
3S5B          LDX   0  EXNUM(2)            [EXOFILE NUMBER  
3SK2          STO   0  CEFN(3)             [TO GEXD 
3T4L          MFINDEXOF 1,CEFN(3)          [FIND ASSOCIATED EWDAS/EXOF  
3TJ=          LDX   7  ASUSN(1)            [STORAGE UNIT NO 
3W3W          STO   7  ESERL(3)            [TO GEXD 
3WHG          LDX   4  FIP(1)              [GET OLD 
3X36    #SKI  K6RENAMEX>199-199 
3XGQ    (   
3Y2B          TRACE    4,OLD NAME   
3YG2          TRACE    ARNCON(3),NEW NAME   
3Y^L    )   
3^F=          LDX   5  FIP+1(1)            [FILE
3^YW          LDX   6  FIP+2(1)            [NAME
42DG          TXU   4  ARNCON(3)           [AND COMPARE 
42Y6          TXU   5  ARNCON+1(3)         [WITH NEW
43CQ          TXU   6  ARNCON+2(3)         [FILE NAME   
43XB          BCS      X6                  [J IF DIFFERENT  
44C2          LDX   4  FIP+4(1)            [OTHERWISE GET.  
44WL          SRL   4  12                  [OLD GENERATION NO.  
45B=          LDX   5  ARNCON+4(3)         [AND NEW 
45TW          SRL   5  12                  [GENERATION  
46*G          SBX   4  5
46T6          BNZ   4  X6                  [J IF GENERATION NOS DIFFER  
47#Q          LDN   7  0                   [REPLY TO PROG - OK  
47SB          FREECORE 3                   [FREE GEXD   
48#2    X5    LDX   1  APETADDR(2)         [PCA ADDRESS 
48RL          LDX   3  AWORK1(2)           [CONTROL AREA ADDRESS
49?=          ADN   3  1                   [ADDRESS OF REPLY WD 
49QW          FADDRESS 1,3,HLOCK1          [GET GEORGE ADDRESS OF REPLY WORD
4==G          STO   7  0(3)                [STORE REPLY IN PROG 
4=Q6          LDX   1  FX1  
4?9Q          OLPFIN1  ZLINK(1) 
4?PB    #   
4#92    #   
4#NL    X6    CHAIN    3,APETADDR(2)       [CHAIN GEXD AFTER PCA
4*8=          LDX   3  AWORK2(2)           [REMEMBER ADDITIVE MODES 
4*MW          LDX   4  AWORK1(2)           [CONTROL AREA ADDRESS
4B7G          LDX   5  EXNUM(2)            [EXOFILE NUMBER  
4BM6          LDX   6  EWCHAN(2)           [AND CHANNEL NUMBER  
4C6Q          TOPCA1   ZLINK(1)            [CHANGE TO PCA   
4CLB          UNPLUG                       [UNPLUG PROG FROM EXEC   
4D62          CAPCA    EWDAS,GEXD          [CHANGE TO CPA   
4DKL          SUSEST   7,NOTON             [SEE IF UNIT IS ONLINE   
4GJ6    X12   PLOCKSU  7,REAKINA,NONLA  
4H3Q          SETNCORE FDCELLS-A1,2,EWDAS,EXOF [GET NEW EXOF
4HHB          MFINDEXOF 3,5                [GET POINTER TO EXOF IN CCB  
4J32          LDN   1  A1(2)
4JGL          LDN   0  A1(3)
4K2=          MOVE  0  FDCELLS-A1          [MOVE OLD DETAILS TO NEW EXOF
4K2X ...      STO   5  BACK2(2)            [EXNUM TO EXOF   
4K36 ...      MHUNTW   3,EWDAS,GEXD 
4K3* ...      SXTEST   0,XES2   
4K3J ...      LDX   0  EXOTRAP(3)   
4K3R ...      BNG   0  XES2                [J IF INSECURE   
4K42 ...      ANDN  0  CERASET  
4K49 ...      BZE   0  XESER3              [J IF NO ERASE TRAPS 
4K4D ...XES2
4K4M ...      LDN   0  ARNCON(3)           [NEW FILE NAME   
4K4W ...      LDN   1  FIP(2)              [FROM GEXD TO EXOF   
4K55 ...      MOVE  0  3
4K5# ...      LDX   0  ARNCON+4(3)         [NOW GEN NO & VERSION NO 
4K5H ...      STO   0  FIP+4(2) 
4K5L ...      SEGENTRY K81RENAMEX              [USED BY RNXNOCHECK MACRO
4K5Q ...      LDN   0  BOPEN+BSERL+BSPEC+BLOCK [MARKERS FOR EXOPEN  
4K5^ ...      STO   0  EXMARK(2)
4K68 ...      DOWN     EXOPEN,1            [SEE IF NEW NAME IS UNIQUE   
4K6C ...      TESTREP2 OK,XESER1,EXFAIL,XES2A   
4K6L ...      BRN      XGEOR               [ELSE GEOERR 
4K6T ...XES2A   
4K74 ...      MHUNTW   3,EWDAS,GEXD 
4K7? ...      LDN   0  ANFOUND  
4K7G ...      ANDX  0  EMARK(3) 
4K7P ...      BZE   0  XESER2              [J IF FAILURE NOT DUE TO NOTFOUND
4K7Y ...XES2B   
4K83 ...      SEGENTRY K82RENAMEX   
4K87 ...      SXTEST   0,XES2F  
4K8B ...      LDX   3  EXOTRAP(3)   
4K8K ...      LDN   1  CWRITE   
4K8S ...      EXCHOFE  EXOF,,1,XES2F       [HAS NEW EXOF ENTRY GOT WRITE TRAPS  
4K93 ...      TESTREP2 OK,XES2G,NOFILE,XES2C,NOTRAP,XESER3  
4K9= ...      BRN      XGEOR
4K9? ...XES2G   
4K9# ...      EXCHOFE  EXOF,,,XES2F,AW     [D&T WRITTEN+ACCESSED FOR EXOF ENTRY 
4K9* ...      BRN      XES2D
4K9F ...XES2C   
4K9N ...      LDX   0  EDSQ 
4K9X ...      BNG   0  XESER4              [J IF FULL SECURITY IN USE   
4K=6 ...      BNG   3  XES2D               [J IF OLD EXOFILE INSECURE   
4K=* ...      LDX   6  XEWINS(1)
4K=J ...      DOWN     CHINERR,7
4K=R ...[              CHASE ROUND ACTRING TO FIND OUR  
4K?2 ...[              AOLPT AGAIN TO STORE NEW TRAPS   
4K?9 ...XES2D   
4K?D ...      LDX   2  ACTRING(2)          [NEXT IN ACTIVITY RING   
4K?M ...      SBN   2  ACTRING  
4K?W ...      TXU   2  FX2  
4K#5 ...      BCS      XES2E               [J IF NOT END OF RING
4K## ...      GEOERR   1,NOAOLPT           [AAAAAGH!
4K#H ...XES2E   
4K#Q ...      LDCH  0  ATYPE(2) 
4K#^ ...      SBN   0  AOLPT/64 
4K*8 ...      BNZ   0  XES2D               [J IF NOT AOLPT  
4K*C ...      LDX   0  ATMARK(2)
4K*L ...      SBN   0  1
4K*T ...      BNZ   0  XES2D               [J IF NOT EXOFILE AOLPT  
4KB4 ...      TXU   5  EXNUM(2) 
4KB? ...      BCS      XES2D
4KBG ...      MHUNTW   1,EWDAS,GEXD 
4KBP ...      LDX   0  EXOTRAP(1)          [PUT NEW TRAPS FROM GEXD 
4KBY ...      STO   0  EXTRAPS(2)          [BACK IN AOLPT   
4KC7 ...      LDX   6  EWCHAN(2)           [REINSTATE CHANNEL WHILST WE'RE HERE 
4KCB ...XES2F   
4KCK ...      MFINDEXOF 3,5 
4KCS ...      MHUNTW   2,EWDAS,EXOF 
4KD3 ...      LDN   0  A1(3)
4KD= ...      LDN   1  A1(2)
4KDF ...      MOVE  0  FDCELLS-A1          [REINSTATE EXOF IN ACTC  
4KFW          LDN   0  BRITE+BLOCK+BSERL+BSPEC  
4K^G ...      STO   0  EXMARK(2)           [OPERATION REQUIRED BY WRITEFIP  
4LYQ          HUNTW    1,EWDAS,GEXD 
4MDB          LDX   0  ARNCON(1)           [MOVE
4MY2          STO   0  FIP(3)              [NEW FILE
4NCL          LDX   0  ARNCON+1(1)         [NAME
4NX=          STO   0  FIP+1(3)            [TO EXOF 
4PBW          LDX   0  ARNCON+2(1)         [IN THE  
4PWG          STO   0  FIP+2(3)            [CCB 
4QB6          LDX   0  ARNCON+4(1)         [AND GENERATION AND VERSION  
4QTQ          STO   0  FIP+4(3)            [NUMBERS 
4R*B ...      DOWN     WRITEFIP,1            [WRITE NEW DETAILS AWAY
4RT2          TESTREP  OK,XN1   
4S#L          TESTREP  EXFAIL,TFAIL 
4SM2 ...XGEOR   
4T6L ...      GEOERR   1,WRONGREP          [UNKNOWN REPLY FROM WRITEFIP 
4X=B    XN1   MFINDEXOF 3,5 
4XQ2    NA    FIPPER   HOME(3),7,NA,NB,NB [TELL OTHER SIDE TO RE-READ   
4Y9L    NB    UNLOCKSU  7   
4^8W          RELST    7                   [RELEASE UNIT
4^NG          HUNTW    1,EWDAS,EXOF 
5286          FREECORE 1                   [FREE EWDAS/EXOF IN ACTIVITY CHAIN   
52MQ          LDN   7  0                   [INDICATE TRANSFER NOT FAILED
537B          LDN   6  0                   [REPLY TO PROG   
53M2    X11   HUNTW    1,EWDAS,GEXD 
546L          FREECORE 1                   [FREE EWDAS/GEXD 
555W          LDN   5  9                   [LENGTH OF CONTROL AREA  
5656    X8    ADN   4  1
56JQ ...      GETWORD  4,4,WRITE
574B          SMO      4
57J2          STO   6  0
57RS ...      WORDFIN   
583L          BNZ   7  X9                  [J IF TRANSFER FAILED
58H=          RUNPROG                      [RESTART PROG
592W    X9    ILLEGAL  PERFAIL  
59GG    #   
5=26    #     STORAGE UNIT NOT ONLINE   
5=FQ    #   
5=^B    NOTON ANDN  3  #2   
5?F2          BZE   3  X10                 [J IF ADDITIVE MODE #4000 NOT USED   
5?YL          LDX   1  FX1  
5#D=          LDX   6  REP2(1)             [UNIT NOT ONLINE REPLY   
5#XW          LDN   7  0                   [INDICATE TRANSFER NOT FAILED
5*CG          BRN      X11  
5*X6    X10   SMUSEST  7,NONL,REAKIN
5BBQ          BRN      X12                 [J IF SU NOW ONLILE  
5BWB    #   
5CB2    #     BREAKIN  OCCURS WHILE WAITING FOR STORAGE UNIT TO COME ONLINE 
5CTL    #   
5D72 ...#   
5D=6 ...#     IPB INOPERABLE
5D*= ...#   
5DDB ...NONLA NGNC  3  1
5DHG ...#   
5DLL ...#     BREAKIN  WHEN WAITING FOR IPB 
5DPQ ...#   
5DSW ...REAKINA 
5DY2 ...      LDN   3  0
5FS6          RELST    7
5GRB    REAKIN  
5H?2          HUNTW    1,EWDAS,GEXD 
5HQL          FREECORE 1                   [FREE EWDAS/GEXD 
5J==          STEPBACK                     [STEP PROGS ONR BACK 
5JBY ...      BZE   3  NIPB                [J IF BREAKIN
5JDG ...      TWAIT    7,NIPB              [..ELSE WAIT FOR IPB 
5JG4 ...      RUNPROG                      [TRY AGAIN   
5JHL ...NIPB  PROGBRKIN                    [REPORT BREAKIN  
5JRF ...[   
5JS2 ...[              FAILURE DURING EXOFILE SECURITY CHECKS   
5JSH ...[   
5JT4 ...XESER1  
5JTK ...      LDX   6  XEXIS(1)            [EXOFILE Z ALREADY EXISTS
5JW6 ...      BRN      XESER9   
5JWM ...XESER2  
5JX8 ...      LDX   0  EMARK(3) 
5JXP ...      ANDN  0  ARITE+AFAIL  
5JY= ...      BZE   0  XUNK 
5JYR ...      BRN      XESER10  
5J^# ...XESER3  
5J^T ...      SMO      FX1  
5K2B ...      LDX   6  XEWTRA              [EXOFILE ENTRY TRAPS CLOSED  
5K2X ...      BRN      XESER9   
5K3D ...XESER4  
5K3^ ...      LDX   6  XEWRAR(1)
5K4G ...XESER9  
5K53 ...      DOWN     CHINERR,7
5K5J ...      MHUNTW   3,EWDAS,GEXD 
5K5S ...XESER10 
5K65 ...      LDX   6  EXCHNL(3)
5K6L ...      UNLOCKSU 7
5K77 ...      RELST    7
5K7N ...      MHUNTW   1,EWDAS,EXOF 
5K89 ...      BRN      XFREX
5K9G    #   
5KP6    #     TRANSFER FAILURE OCCURS WHEN WRITING NEW DETAILS TO SU
5L8Q    #   
5LNB    TFAIL HUNTW    1,EWDAS,GEXD 
5M82          LDX   0  EMARK(1)            [GET REPLY FROM EXOPEN   
5MML          ANDN  0  ARITE+AFAIL+ANFOUND  
5N7=          BNZ   0  X13  
5NFL ...XUNK
5NLW          GEOERR   1,EXOPEN            [UNKNOWN REPLY FROM EXOPEN   
5P6G    X13   UNLOCKSU 7
5PL6          RELST    7                   [RELEASE UNIT
5Q5Q          HUNTW    1,EWDAS,EXOF        [FIND EXOF IN ACTIVITY CHAIN 
5QKB          MFINDEXOF 3,5                [FIND EXOF IN CCB CHAIN  
5R52          LDX   0  FIP(1)              [AND PUT OLD DETAILS BACK
5RJL          STO   0  FIP(3)              [IN EXOF IN CCB CHAIN
5S4=          LDX   0  FIP+1(1) 
5SHW          STO   0  FIP+1(3) 
5T3G          LDX   0  FIP+2(1) 
5TH6          STO   0  FIP+2(3) 
5W2Q          LDX   0  FIP+4(1) 
5WGB          STO   0  FIP+4(3) 
5WSQ ...XFREX   
5X22          FREECORE 1                   [FREE EXOF IN ACTIVITY CHAIN 
5XFL ...NONL  LDCT  7  6
5X^= ...      ADX   7  6                   [DEVICE AND CHANNEL  
5YDW ...      OUTPACK  7,1,PERINAME,NONL   [ONLINE *DA FAIL 
64*W          LDCT  6  #440                [REPLY WORD  
64TG          NGN   7  1                   [FAILED TRANSFER 
65*6          BRN      X11                 [J IF MAIN PATH  
68QG          MENDAREA 40,K99RENAMEX
69=6    #END
^^^^ ...45447453000200000000
  • Last modified: 17/01/2024 11:55
  • by 127.0.0.1