SCEXEND867

(George Source)

Macros used: ACROSS, CHAREA, CHUCK, CLOSEST, EXMESS, FREECORE, GEOERR, GETWORD, HUNTW, MENDAREA, MFINDEXOF, MFINDSU, MHUNTW, OPENST, OPTMESS, READSAVE, RUNPROG, SAVEST, SEGENTRY, TESTREP, TESTREPNOT, TRACE, UNLOCKSU, WORDFIN

SCEXEND867.txt
228= ...#SEG  SCEXEND867
22BG ...#   
22JQ ...#     COPYRIGHT INTERNATIONAL COMPUTERS LTD   1982  
22R2 ...#   
22^=    #LIS  K0SCEXEND 
23DW          8HSCEXEND 
23YG    #              THIS SEGMENT CONTINUES AND COMPLETES EXTEND OR SCRATCH,  
24D6    #              FROM THE POINT WHERE THE AREA UNIT IS GOT
24XQ    #              ENTRY IS FROM NEXT-UNIT  
25CB    #                  AREA UNIT IS ONLINE AND LOCKED   
25X2    #   
26BL          SEGENTRY K1SCEXEND,QK1SCEXEND 
26W=          SEGENTRY K2SCEXEND,QK2SCEXEND 
27*W          SEGENTRY K3SCEXEND,QK3SCEXEND 
27TG          SEGENTRY K4SCEXEND,QK4SCEXEND 
28*6    #   
28SQ    QK1SCEXEND  
29#B    UGOT
29S2          MHUNTW   3,EWDAS,GEXD 
2=?L    #SKI  K6SCEX>199-199
2=R=          TRACE    ARUNIT(3),AREAUNIT   
2?=W    #SKI  K6SCEX>299-299
2?QG    (   
2#=6          LDX   0  ARUNIT(3)
2#PQ          BZE   0  UG1  
2*9B          SRL   0  18   
2*P2          BZE   0  UG2  
2B8L    UG1   GEOERR   1,ARUNIT 
2BN=    UG2 
2C7W    )   
2CMG          MFINDEXOF 2,CEFN(3)   
2D76          NGS   3  EOFCYL(3)           [SET EOFCYL -VE,EOF AREA IS NOT ON   
2DLQ          STOZ     CELLD(3)            [CLEAR CELLD    /THIS UNIT   
2F6B          LDX   0  ARUNIT(3)
2FL2          TXU   0  EOFUNIT(3)   
2G5L          BCS      START               [J IF NOT EOF UNIT   
2GK=          LDEX  0  FIP+5(2) 
2H4W          SBN   0  2
2HJG          BNG   0  START               [J IF NO EOF AREA
2HS# ...      ADN   0  2
2J46          SLL   0  1
2JHQ          LDX   1  0
2K3B          SLL   1  1
2KH2          ADX   1  0
2L2L          ADN   2  FDCELLS(1)          [POINTER TO EOF CELL 
2LG=          LDX   0  3(2)                [NR OF CYLINDERS 
2L^W          BPZ   0  WFD                 [J IF FULL DEPTH,TAKE END CYLINDER+1,
2MFG          SLL   0  1
2M^6          SBN   0  2
2NDQ          BNZ   0  START               [J IF MORE THAN 1 CYLINDER WIDE, 
2NYB    WFD   ADX   0  1(2)                [ELSE TAKE START CYLINDER,   
2PD2          STO   0  EOFCYL(3)           [AS EOF CYLINDER 
2PXL    #SKI  K6SCEX>299-299
2QC=          TRACE    0,EOFCYL 
2QWW          LDX   0  2(2) 
2RBG          STO   0  EOFBLOCK(3)         [START BLOCK=EOF BLOCK   
2RW6    #   
2S*Q    START                              [START SEARCH FOR AREA   
2STB    #                  OPEN AREA UNIT,READ CONTROL HEADER AND FIRST UNAL CEL
2T*2          MHUNTW   3,EWDAS,GEXD 
2TSL          OPENST   ARUNIT(3)           [OPEN AREA UNIT FOR TRANSFERS
2W#=          LDN   7  128  
2WRW          READSAVE 7,SC1               [READ & SAVE CONTROL HEADER  
2X?G          TESTREPNOT OK,XN15           [J IF FAIL   
2XR6          LDX   1  ECOR(3)  
2Y=Q    SC1   SMO      FX2  
2YQB          STO   1  AWORK4              [CORE ADDRESS OF CH IN AWORK4 (FOR JB
2^=2          LDN   1  10(1)
2^PL          STO   1  CELLA+5(3)          [COREAD OF HEAD OF UNALLOCATED CHAIN 
329=          STOZ     CELLB+5(3)          [CLEAR CELL(B)   
32NW          SAVEST   C,CELLA+5(3)        [SAVE CELL(A)= HEAD OF CHAIN 
338G          BRN      SC2  
33N6    #   
347Q    #                  NEW CELL REQUIRED FROM UNALLOCATED CHAIN 
34MB    NCELL   
3572          MHUNTW   3,EWDAS,GEXD 
35LL          CHUCK    C,CELLP(3)          [CHUCK OLD PREVIOUS CELL (P) 
366=    SC2   LDX   1  CELLA+5(3)          [CORE ADDRESS CELL(A)
36KW          LDX   6  0(1)                [WORD ADDRESS OF NEXT CELL   
375G          BZE   6  NOCELL              [J IF NO MORE IN CHAIN   
37K6          STO   1  CELLP(3)            [SET CELL(P)= OLD CELL(A)
384Q          LDX   0  CELLB+5(3)   
38JB          BZE   0  SC3                 [J IF CELL(B)NOT READ
3942    #SKI  K6SCEX>399-399
39HL    (   
3=3=          TXU   6  CELLB+4(3)   
3=GW          BCC      SC2A 
3?2G          GEOERR   1,CELLB? 
3?G6    SC2A
3?^Q    )   
3#FB          LDN   4  CELLB(3)            [ELSE COPY DETAILS OF CELLB TO   
3#^2          LDN   5  CELLA(3)            [CELLA   
3*DL          MOVE  4  6
3*Y=          STOZ     CELLB+5(3)          [CLEAR CELLB 
3BCW          BRN      SC4  
3BXG    SC3   READSAVE 6,SC5               [READ NEXT CELL & SAVE   
3CC6          TESTREPNOT OK,XN15           [J IF FAIL   
3CWQ          LDX   1  ECOR(3)  
3DBB    SC5   CALL  7  SETC                [SET UP NEW CELL AS CELL(A)  
3DW2    SC4   CALL  6  SCRX                [CHECK IF IN USE BY SCRATCH FILE 
3F*L    #                  ELSE WE HAVE A NEW CELL(A)   
3FT=    #                  FENCE BREAK INTO AREA(A) 
3G#W          ACROSS   EXINTWO,2          [COMES BACK TO K2SCEXEND  
3GSG    #   
3H#6    #                  S/R TO SET UP CELLA FROM BS COPY OF CELL 
3HRQ    SETC
3J?B          STO   1  CELLA+5(3)          [STORE CORE ADDRESS, 
3JR2          STO   6  CELLA+4(3)          [BS WORD ADDRESS,
3K=L          LDX   5  1(1)                [(START BLOCK)   
3KQ=          DVS   4  EDEPF(3) 
3L9W          STO   5  CELLA(3)            [START CYLINDER, 
3LPG          STO   4  CELLA+2(3)          [START BLOCK,
3M96          LDXC  5  2(1) 
3MNQ          BCS      £
3N8B          SBN   5  1                   [(END BLOCK) 
3NN2          DVS   4  EDEPF(3) 
3P7L          STO   5  CELLA+1(3)          [END CYLINDER,   
3PM=          STO   4  CELLA+3(3)          [END BLOCK   
3Q6W          EXIT  7  0
3QLG    #   
3R66    #                  RE-ENTRY AFTER FENCE BREAKER,
3RKQ    QK2SCEXEND  
3S5B    #   
3SK2          MHUNTW   3,EWDAS,GEXD 
3T4L    #SKI  K6SCEX>199-199
3TJ=          TRACE    CELLA+4(3),CELLA 
3W3W    #SKI  K6SCEX>399-399
3WHG    (   
3X36          LDN   0  4
3XGQ    STT1  TRACE    CELLA(3) 
3Y2B          ADN   3  1
3YG2          BCT   0  STT1 
3Y^L          SBN   3  4
3^F=    )   
3^YW          LDX   0  CELLD(3) 
42DG          BNZ   0  SH1                 [J IF WE HAVE AN AREA SAVED  
42Y6          CALL  7  SUIT                [CHECK AREA IS SUITABLE  
43CQ          LDX   0  EOFCYL(3)
43XB          BNG   0  XGOT                [TAKE THIS AREA IF NOT EOF AREA,ELSE 
44C2          TXL   0  CELLA(3) 
44WL          BCS      XGOT                [TAKE IT IF WE HAVE PASSED EOF AREA  
45B=          TXU   0  CELLA(3)            [J IF NOT EOF CYLINDER,  
45TW          BCS      SH2  
46*G          LDX   4  CELLA+2(3)   
46T6          TXL   4  EOFBLOCK(3)         [ELSE TAKE THIS AREA IF  
47#Q          BCC      XGOT                [WE HAVE PASSED EOF BLOCK
47SB    SH2   LDN   4  CELLP(3)            [EOF CYLINDER/BLOCK NOT YET FOUND,   
48#2          LDN   5  CELLD(3)            [SAVE THIS SUITABLE AREA 
48RL          MOVE  4  7                   [IN CELLD
49?=    #SKI  K6SCEX>399-399
49QW          TRACE    CELLD(3),SAVECELL
4==G          SAVEST   C,CELLP(3)          [SAVE CELLS A AND P  
4=Q6          SAVEST   C,CELLA+5(3) 
4?9Q          BRN      NCELL
4?PB    SH1   LDX   0  EOFCYL(3)           [LOOKING FOR EOF AREA
4#92          TXL   0  CELLA(3) 
4#NL          BCS      SH3                 [J IF PAST EOF CYLINDER  
4*8=          LDX   4  CELLA+2(3)   
4*MW          TXL   4  EOFBLOCK(3)  
4B7G          TXU   0  CELLA(3)            [GET NEXT AREA IF
4BM6          BCS      NCELL               [NOT YET UP TO EOF AREA, 
4C6Q          CALL  7  SUIT                [ELSE CHECK AREA IS SUITABLE 
4CLB          CHUCK    C,CELLD(3)          [IF SO,CHUCK SAVED AREA  
4D62          CHUCK    C,CELLD+6(3) 
4DKL          BRN      XGOT                [AND USE THIS AREA (NEXT TO EOF AREA)
4F5=    #   
4FJW    NOCELL         [=D7,NO MORE CELLS IN UNALLOCATED CHAIN  
4G4G          MHUNTW   3,EWDAS,GEXD 
4GJ6          LDX   0  CELLD(3) 
4H3Q          BZE   0  XN14                [J IF NO SAVED AREA,NO ROOM ON THIS  
4HHB          BRN      SH4                 [UNIT,ELSE,  
4J32    #   
4JGL    SH3   CHUCK    C,CELLP(3)          [NO AREA NEXT TO EOF,SO CHUCK
4K2=    SH4   CHUCK    C,CELLA+5(3)        [CURRENT CELLS AND   
4KFW          LDN   4  CELLD(3)            [RESTORE SAVED AREA  
4K^G          LDN   5  CELLP(3) 
4LF6          MOVE  4  7
4LYQ    #SKI  K6SCEX>399-399
4MDB          TRACE    CELLA+5(3),RESRCELL  
4MY2    #   
4NCL    XGOT                               [WE HAVE AN AREA:-IS IT TO BE SPLIT? 
4NX=    #SKI  K6SCEX>299-299
4PBW          TRACE    CELLA(3),GOTAREA 
4PWG          LDX   4  CELLB+5(3)   
4QB6          BZE   4  XG1                 [J IF NO CELL B  
4QTQ          CHUCK    C,4                 [ELSE CHUCK IT   
4R*B    XG1   LDX   1  CELLA+5(3)   
4RT2          LDX   0  1(1) 
4S#L          STO   0  ARQS(3)             [SAVE START BLOCK OF AREA
4SS=          LDN   4  CELLA(3)            [MOVE DETAILS OF AREA
4T?W          LDN   5  AREQT(3)            [TO AREQT
4TRG          MOVE  4  4
4W?6          LDX   4  CELLA+1(3)          [SET UP SOME VALUES IN CELLB:-   
4WQQ          ADN   4  1
4X=B          SBX   4  CELLA(3) 
4XQ2          STO   4  CELLB+1(3)          [CELLB+1=WIDTH OF AREA   
4Y9L          LDX   0  CELLA+3(3)   
4YP=          ADN   0  1
4^8W          SBX   0  CELLA+2(3)   
4^NG          STO   0  CELLB+2(3)          [CELLB+2=DEPTH OF AREA   
5286          MPY   4  0
52MQ          STO   5  CELLB(3)            [CELLB=SIZE OF AREA  
537B          MFINDSU  2,ARUNIT(3)         [FIND AREA ASTUC 
53M2          LDX   4  HCYL(2)  
546L    #SKI  K6SCEX>399-399
54L=    (   
555W          TXL   4  CELLB+1(3)   
55KG          BCC      XG2  
5656    XG3   GEOERR   1,CELLA? 
56JQ    XG2   LDX   5  EDEPF(3) 
574B          TXU   5  HBLOCK(2)
57J2          BCS      XG3  
583L    )   
58H=          MPY   4  HBLOCK(2)           [DEPTH*WIDTH 
592W          SRL   5  4                   [/16 
59GG          STO   5  CELLB+3(3)          [CELLB+3=SIZE OF AREA UNIT/16
5=26          LDX   7  HCYL(2)             [X7=WIDTH OF AREA UNIT   
5=FQ          LDN   6  0                   [SET COUNT AND MARKER=0  
5=^B          LDX   0  AREQT(3)            [DO WE SPLIT OFF CYLINDERS?  
5?F2          TXU   0  AREQT+1(3)   
5?YL          BCC      SP1                 [J IF AREA 1 CYLINDER WIDE   
5#D=          LDX   5  BREQ(3)  
5#XW          SBN   5  1                   [REQUEST SIZE/DEPTH (ROUND-  
5*CG          DVS   4  CELLB+2(3)          [ED UP) TO GET MIN NR OF 
5*X6          ADN   5  1                   [CYLINDERS NEEDED (X5)   
5BBQ          TXU   5  CELLB+1(3)   
5BWB          BCC      TAKE                [J IF NO CYLINDERS TO BE SPLIT OFF   
5CB2    #SKI  K6SCEX>399-399
5CTL    (   
5D*=          TXL   5  CELLB+1(3)   
5DSW          BCC      XG3  
5F#G    )   
5FS6          LDX   4  CELLB+1(3)   
5G?Q          SBX   4  5                   [NR OF CYLINDERS TO SPLIT OFF
5GRB          TXL   4  5
5H?2          BCC      SP2                 [SPLIT IF AREA TAKEN<OR= REMAINDER   
5HQL          SRL   7  4                   [ELSE
5J==          TXL   7  4                   [DONT SPLIT UNLESS   
5JPW          BCC      TAKE                [REMAINING AREA>1/16 OF UNIT 
5K9G    SP2   SBS   4  AREQT+1(3)          [RESET END CYLINDER TO SHOW SPLIT
5KP6          LDCT  6  #200                [SET CYLINDER-SPLIT MARKER   
5L8Q          ADN   6  1                   [AND COUNT OF 1  
5LNB          SBN   5  1
5M82          BNZ   5  TAKE                [J UNLESS AREA NOW 1 CYLINDER WIDE   
5MML    #SKI  K6SCEX>399-399
5N7=    (   
5NLW          LDX   5  AREQT(3) 
5P6G          TXU   5  AREQT+1(3)   
5PL6          BCS      XG3  
5Q5Q    )   
5QKB    SP1   LDX   5  CELLB+2(3)          [WIDTH   
5R52          SBX   5  BREQ(3)             [BLOCKS TO BE SPLIT OFF  
5RJL          BZE   5  TAKE                [J IF AREA EXACTLY RIGHT SIZE
5S4=    #SKI  K6SCEX>399-399
5SHW          BNG   5  XG3  
5T3G          TXL   5  BREQ(3)             [SPLIT IF AREA SPLIT OFF IS  
5TH6          BCC      SP3                 [NOT < AREA LEFT 
5W2Q          LDX   0  CELLB+3(3)          [ELSE
5WGB          TXL   0  5                   [TAKE WHOLE AREA UNLESS  
5X22          BCC      TAKE                [AREA SPLIT OFF>OR=1/16 OF UNIT  
5XFL    SP3   SBS   5  AREQT+3(3)          [ADJUST END BLOCK TO SHOW SPLIT  
5X^=          LDCT  0  #400 
5YDW          ORX   6  0                   [SET BLOCK-SPLIT MARKER  
5YYG          ADN   6  1                   [ADD 1 TO COUNT OF SPLITS
5^D6    #   
5^XQ    TAKE                   [SPLIT IF NECESSARY,RECHAIN CELLS,ETC,ETC,   
62CB    #SKI  K6SCEX>99-99  
62X2          TRACE    AREQT(3),AREAUSED
63BL    #SKI  K6SCEX>299-299
63W=    (   
64*W          LDN   0  3
64TG    TK1   TRACE    AREQT+1(3)   
65*6          ADN   3  1
65SQ          BCT   0  TK1  
66#B          SBN   3  3
66S2          TRACE    6
67?L    )   
67R=    #                  AS FOR MODE *1500
68=W          ACROSS   EXINTO,3            [RETURNS TO...   
68QG    #   
69=6    #   
69PQ    QK4SCEXEND  
6=9B    #                  CONNECTED TO FILE,EXOF IS UPDATED
6=P2    #   
6?8L          EXMESS                       [OUTPUT ANY MESSAGES 
6?N=          MHUNTW   3,EWDAS,GEXD 
6#7W          LDCT  0  #40  
6#MG          ANDX  0  EMARK(3) 
6*76          BZE   0  NOPE                [J UNLESS OPENING SCRATCH FILE   
6*#Y ...      HUNTW    3,EWDAS,ASCOL       [SET UP IF IPB DOWN FOR OL SCRATCH   
6*BW ...      BNG   3  NTH  
6*DS ...      FREECORE 3                   [FREE IF PRESENT 
6*GQ ...NTH 
6*LQ          ACROSS   ANTIC,1             [GO TO CONNECT   
6B6B    #   
6BL2    NOPE                               [SET REPLIES TO SUCCESFUL EXTEND 
6C5L          MFINDEXOF 1,CEFN(3)   
6CK=          LDEX  2  FIP+5(1) 
6D4W          SBN   2  1
6DJG    #SKI  K6SCEX>399-399
6F46    (   
6FHQ          BPZ   2  WK1  
6G3B    WK2   GEOERR   1,NEWAREA
6GH2    WK1 
6H2L    )   
6HG=          SLL   2  1                   [GET REPLIES FROM EXOF   
6H^W          LDX   5  2
6JFG          SLL   2  1
6J^6          ADX   2  5
6KDQ          ADN   2  FBUK(1)             [POINTER TO LAST WORD OF 2ND-TO-LAST 
6KYB          LDX   5  0(2)                [FD CELL. GET LAST LBN BEFORE (+1)   
6LD2          LDX   6  6(2) 
6LXL          SBX   6  5                   [NUMBER OF BUCKETS EXTENDED BY   
6MC=          SBN   5  1                   [LAST LBN BEFORE 
6MWW          LDX   0  EOPMODE(3)   
6NBG          SBN   0  #400 
6NW6          BNZ   0  WK3                 [J UNLESS OPEN IN EOF MODE   
6P*Q          SBX   5  FIP+10(1)           [ELSE SET LBN RELATIVE   
6PTB          ADN   5  1                   [TO END OF FILE, 
6Q*2          BPZ   5  WK3  
6QSL          LDN   5  0                   [OR ZERO IF OUT OF RANGE 
6R#=    WK3 
6RRW          LDX   7  1(2)                [SERIAL NR FOR NEW AREA  
6S?G    #SKI  K6SCEX>399-399
6SR6    (   
6T=Q          TXU   7  ARUNIT(3)
6TQB          BCS      WK2  
6W=2    )   
6WPL          LDX   4  CNR(3)              [CA ADDRESS  
6X9=          FREECORE 3                   [FREE /GEXD  
6XNW          CALL  3  WORD 
6Y8G          STO   5  0(2)                [SET REPLY WORD 1  (LAST LBN BEFORE) 
6YN6          CALL  3  WORD 
6^7Q          STO   6  0(2)                [SET REPLY WORD 2  (NR OF BUCKETS)   
6^MB          ADN   4  1
7272          CALL  3  WORD 
72LL          STO   7  0(2)                [SET REPLY WORD 4  (SERIAL NR NEWAR) 
736=          WORDFIN   
73KW          RUNPROG                      [RESTART PROGRAM 
745G    #                                  [****
74K6    #   
754Q    WORD                               [S/R TO GET ADDRESS OF OBJECT PROGRAM
75JB          SBX   3  FX1                 [WORD([X4]+1),IN X2,USING GETWORD
7642          ADN   4  1
76HL          GETWORD  4,2,WRITE
773=    #SKI  K6SCEX>399-399
77GW    (   
782G          TESTREP  OK,WOK   
78G6          GEOERR   1,SCEXPROG          [REPLY RESVIOL OR NOCORE 
78^Q    WOK 
79FB    )   
79^2          ADX   3  FX1  
7=DL          EXIT  3  0
7=Y=    #   
7?CW    #   
7?XG    #   
7#C6    #   
7#WQ    #                  S/R TO CHECK IF AREA(A) USED BY SCRATCH FILE 
7*BB    SCRX
7BT=          SMO      CELLA+5(3)   
7C#W          LDX   4  1                   [GET START BLOCK OF CELL A   
7CSG          MFINDSU  1,ARUNIT(3)         [FIND  ASTUC 
7D#6          LDX   0  CSCRATCH(1)         [CHECK AREA A NOT SCRATCH
7DRQ    #SKI  K6SCEX>299-299
7F?B    (   
7FR2          BPZ   0  SU2  
7G=L          GEOERR   1,SCRTCHCT   
7GQ=    )   
7H9W    SU2   BZE   0  SU1                 [J NO MORE SCRATCH AREAS 
7HPG          SBN   0  1
7J96          SMO      0
7JNQ          TXU   4  HSCRATCH(1)  
7K8B          BCC      NCELL               [J IF SAME START BLOCK,AREA A IS 
7KN2          BRN      SU2                 [SCRATCH AND NO GOOD 
7LG2 ...SU1   CHAREA   ARUNIT(3),4,NCELL   [CHECK IF FILE IN USE IN OTHER PROCES
7QJ=          EXIT  6  0                   [AREA OK 
7RHG    #   
7S36    #                  S/R TO CHECK IF AREA(A SUITABLE FOR EXTEND   
7SGQ    SUIT
7T^L          CALL  6  SCRX                [CHECK NOT USED BY SCRATCH FILE, 
7WF=          LDX   0  CELLA+1(3)          [ELSE,   
7WYW          TXU   0  CELLA(3) 
7XDG          BCC      SU3                 [J IF ONLY 1 CYLINDER,   
7XY6          SMO      CELLA+5(3)   
7YCQ          LDX   4  2                   [ELSE CHECK THAT IT IS FULL-DEPTH,   
7YXB          BNG   4  NCELL               [NO GOOD IF NOT  
7^C2    SU3   SBX   0  CELLA(3)            [AREA IS SUITABLE,   
7^WL          ADN   0  1
82B=          LDX   4  CELLA+3(3)          [IS IT BIG ENOUGH?   
82TW          SBX   4  CELLA+2(3)   
83*G          ADN   4  1
83T6          MPY   0  4                   [TOTAL SIZE OF AREA  
84#Q          TXL   1  BREQ(3)  
84SB          BCS      SU4                 [J IF TOO SMALL  
86?=          EXIT  7  0                   [ELSE EXIT,AREA OK   
86QW    SU4   TXL   1  BAVAIL(3)
87=G          BCS      NCELL               [J IF SMALLER THAN REPLY AREA
87Q6          STO   1  BAVAIL(3)           [ELSE REMEMBER AS BIGGEST AREA   
889Q          BRN      NCELL               [FOUND SO FAR AND GO FOR NEXT.   
88PB    #   
8992    #   
89NL    #   
8=8=    #                  AREA NOT FOUND ON CURRENT UNIT   
8=MW    XN14
8?7G          LDN   6  #40                 [REPLYBIT=NO 
8?M6          LDN   5  XNM1                [MESSAGE=AREA NOT FOUND  
8#6Q    XN18  MHUNTW   3,EWDAS,GEXD 
8#LB          CLOSEST  XN19                [CLOSE CURRENT UNIT  
8*62          TESTREPNOT OK,XN15           [J IF FAIL   
8*KL    XN19  MHUNTW   3,EWDAS,GEXD 
8B5=          ORS   6  EMARK(3)            [SET REPBIT  
8BJW    #SKI  K6SCEX>299-299
8C4G          TRACE    EMARK(3),NOGOOD  
8CJ6          LDX   7  ARUNIT(3)
8D3Q          UNLOCKSU 7                   [UNLOCK AREA UNIT
8DHB          LDX   1  FX1  
8F32          ADX   1  5
8FGL          OPTMESS  0(1),7              [OPTIONALLY STORE MESSAGE
8G2=    NUNIT   
8GFW          ACROSS   NEXTUNIT,2          [TRY NEXT UNIT   
8G^G    #   
8HF6    XNM1           +EWNAREA            [MESSAGE,NO AREA 
8HYQ    #                  TRANSFER FAIL ON AREA UNIT   
8JDB    XN15
8JY2          MHUNTW   3,EWDAS,GEXD 
8KCL          LDN   0  #10  
8KX=          ORS   0  EMARK(3)            [SET REPBIT=FAIL 
8LBW          LDX   6  HMUNIT(3)
8LWG          LDX   7  ARUNIT(3)
8MB6          UNLOCKSU 7                   [UNLOCK AREA UNIT
8MTQ          TXU   6  7                   [GO FOR NEXT UNIT IF FAIL
8N*B          BCS      NUNIT               [NOT ON HOME UNIT
8NT2          BRN      XEND                [AND END 
8P#L    #   
8PS=    #                  ENTRY FROM EXINTO IF ERROR,MARKER IN X7  
8Q?W    QK3SCEXEND  
8QRG          BPZ   7  XN16                [J IF NOT SCAFULL
8R?6          LDN   5  XNM2                [GET MESSAGE 
8RQQ          LDN   6  #20                 [AND REPBIT  
8S=B          BRN      XN19                [
8SQ2    #   
8T9L    XNM2           +EWFULS             [MESSAGE SCAFULL 
8TP=    #   
8W8W    XN16  BNZ   7  XN15                [J IF FAIL ON AREA UNIT  
8WNG          MHUNTW   3,EWDAS,GEXD        [ELSE FAIL ON HOME UNIT  
8X86          LDN   0  #10  
8XMQ          SMO      3
8Y7B          DCH   0  EMARK               [SET REPBIT FAIL (ONLY)  
8YM2          UNLOCKSU HMUNIT(3)           [UNLOCK HOME UNIT
8^6L    XEND
8^L=          ACROSS   NEXTUNIT,3          [TO GENERAL ERROR ROUTINE
925W    #   
92KG    #   
9356    #   
93JQ          MENDAREA 30,K99SCEXEND
944B    #END
^^^^ ...71770513000100000000
  • Last modified: 17/01/2024 11:55
  • by 127.0.0.1