HOWBIG867

(George Source)

Macros used: ABANDCOM, ADDINMODE, ALTLENG, BCONTEXT, BRUSEN, BS, CLOSETOP, ENDCOM, ERRORX, FCBFIND, FI, FINDWFN, FNORM, FREECORE, GEOERR, GETDIR, HUNT, HUNTW, IF, JANAL, JBC, JBCC, JBS, JBSC, JMBS, MFREE, MHUNT, MHUNTW, MONOUT, NAMETOP, OPENDIR, OUTNUM, OUTPARAM, PARALYSE, PARAPASS, PICKREP2, PUTREP2, REPALLER, REPERR2, SEG, SEGENTRY, SETNCORE, SETUPCORE, SETUPMODE, STEP, STEPAGAIN, TESTBRKIN, TESTREP2, TESTRPN2, THEN, UP, UPPLUS, USEROPEX, VFREE, ZERRORX

HOWBIG867.txt
22FL          SEG    HOWBIG,867,SECT.FILE,,G263 
22^=    #LIS K0HOWBIG   
23DW    #  FOR UGUG MEND M263 (HOWBIG COMMAND)  
23YG    #   
24D6    #     HOWBIG COMMAND - GIVES SIZE OF A FILE OR A DIRECTORY-FULL OF THEM.
24XQ    #     DESIGNED AND ORIGINALLY PRODUCED BY ASTON; REWRITTEN BY UIJPC TO  
25CB    #     IMPROVE HANDLING OF WORKFILES, MULTIFILES, ETC.   
25X2    #   
26BL    #     FORMAT 1  -  HB <FILE>
26W=    #     IF %A IS A TERMINAL FILE OR WORKFILE, ITS SIZE IS GIVEN IN THE
27*W    #     FORMAT  $6ZDX"BLOCKS"$ .  
27TG    #   
28*6    #     FORMAT 2  -  HB <ENTRANT>, <OPTION>   
28SQ    #     IF %A IS A DIRECTORY, GIVES TOTAL SIZE OF THE FOLLOWING FILES:
29#B    #        <OPTION>   
29S2    #     NULL OR OMITTED   ALL FILES IN THIS DIRECTORY AND INFERIOR
2=?L    #                           PSEUDO-USERS.   
2=R=    #         "ONLY"        ALL FILES IN THIS DIRECTORY ONLY.   
2?=W    #         "ALL"         ALL FILES IN THIS AND ALL INFERIORS.
2?QG    #         "FILE"        SIZE OF THE DIRECTORY FILE ITSELF.  
2#=6    #     IF %A IS NULL OR OMITTED, FORMAT 2 IS ASSUMED WITH %A = :%;CUR;.  
2#PQ    #   
2*9B    #     %A MUST NOT HAVE QUALIFIERS.  FORMAT 2 IS ONLY ALLOWED IN USER
2*P2    #     CONTEXT AND THE USER MUST HAVE A READ TRAP TO %A (BUT TRAPS ON
2B8L    #     INFERIOR DIRECTORIES ARE NOT CHECKED).  IF %A IS A MULTIFILE, THE 
2BN=    #     TOTAL SIZE WILL BE GIVEN; IF A MULTIFILE ELEMENT, ONLY THE SIZE OF
2C7W    #     THAT ELEMENT. 
2CMG    #   
2D76    #     IN FORMAT 2, FILES WHICH ARE (E) OR (T) ARE OMITTED; FILES WHICH  
2DLQ    #     ARE OPEN FOR WRITING COUNT AS WHATEVER SIZE IS IN THE DIRECTORY   
2F6B    #     ENTRY (ALWAYS (?) ZERO).  IN FORMAT 1, IF THE FILE IS OPEN FOR
2FL2    #     WRITING, A SNAPSHOT OF ITS CURRENT SIZE IS OBTAINED FROM THE FCB. 
2G5L    #   
2GK=    #     IF CALLED VIA ENTRY POINT K2HOWBIG, RETURN IS TO CALLING  
2H4W    #     CHAPTER BY  UPPLUS 2  WITH RESULT IN ACOMMUNE1.  FAILURE RETURNS :
2HJG    #     UP (COMMAND ERROR)   UPPLUS 1 (BREAKIN).  
2J46    #   
2JHQ          SEGENTRY K1HOWBIG,START   
2K3B          SEGENTRY K2HOWBIG,SPENT   
2KH2    #   
2L2L    #              ERRORS   
2LG=    MZERR LDN   3  GMINUS1             [ PRETEND ZERRORY
2LSM ...MZER2 JANAL    XERR 
2M74 ...      ERRORX   0(1),0(3)
2MFG          JBCC     NDING,2,G263SP   
2M^6 ...      UP
2NDQ    XUP   STO   6  ACOMMUNE1(2) 
2NYB          MFREE    CPB,CMULTI   
2PD2          UPPLUS   2                   [ O.K.   
2PXL    XBKUP UPPLUS   1                   [ BREAKIN
2QC=    #   
2QWW    UNMIS CALL  3  MISS 
2RBG                   +JUSNA   
2RW6    MISS  CALL  1  MZER2
2S*Q                   +AMISS   
2STB    NUDIR CALL  3  MISS 
2T*2                   +JLOCNA  
2TMC ...PFERR JANAL    XERR 
2T^S ...      ZERRORX  APFERR   
2W#=    QUILL CALL  3  ZGEN 
2WRW                   +ALQUAL  
2X?G    ZGEN  CALL  1  MZER2
2XR6                   +GENERR  
2Y5H ...TN    JANAL    XERR 
2YCY ...      ZERRORX  FNAPP
2YQ* ...VWRCL CLOSETOP  
2^4Q ...VRYWR JANAL    XERR 
2^C7 ...      ZERRORX  ERVRYWRONG   
2^PL    NTEMP CLOSETOP  
2^^D ...      JANAL    XERR 
329=          ZERRORX  ERTEMPDIR           [ TEMP FILES NOT ALLOWED 
32NW    YUKK  CLOSETOP  
32YN ...      JANAL    XERR 
338G          ZERRORX  HBYUK               [ TOO BIG/COMPLICATED
33N6    #   
347Q    WFNX  GEOERR   1,WKFNOFCB          [ WKFILE EXISTS BUT NO FCB ??
34MB    XGDIR GEOERR   1,MFGETDIR          [ IMPOSS DIR ENTRIES FOR MULT
3572    XFCB  GEOERR   1,UWBNOFCB          [ OPEN UNCLEANLY, BUT NO FCB 
35LL    #   
366=    XBRK  JBSC     XBKUP,FX2,G263SP 
36KW          ABANDCOM                     [ NO MESSING 
375G    #   
37K6    SONLY          4HONLY              [ POSSIBLE 2ND PARAMETER STRINGS 
384Q    SALL           4HALL
38JB    SFILE          4HFILE   
3942    PSTEP          +APARA.1 
39HL    #   
3=3=    SPENT BS       2,G263SP 
3=GW          LDN   1  1
3?2G          PARALYSE #34,,1   
3?G6          TESTRPN2 OK,PFERR 
3?^Q    #   
3#FB    START SPARAPASS                    [ %A 
3#^2          MHUNT    1,CPB,CUNI   
3*DL          NGX   0  ANUM(1)  
3*Y=          BPZ   0  USCUR               [ DEFAULT %A = CURRENT USER  
3BCW          NAMETOP  1,FILE,FNAME 
3BXG          BCONTEXT USER,2,USER  
3CC6          LDCH  0  APARA(1) 
3CWQ          ERN   0  #12                 [ NO USER - MUST BE ABSOLUTE NAME
3DBB          BNZ   0  UNMIS
3DW2    USER  FNORM    3
3F*L          MHUNT    3,FILE,FNAME 
3FT=          NAMETOP  3,CPB,CUNI          [ FOR ERRORS 
3G#W          TESTREP2 NAMEFORM,XERR       [ ERROR REPORTED BY FNORM
3GSG          HUNT     3,FILE,FABSNB
3H#6          BNG   3  PFERR
3HRQ          JBS      WKF,3,BFABWORK      [ WORKFILE - SPECIAL CASE
3J?B          TESTREP2 ADJUNCTS,QUILL   
3JR2          TESTRPN2 OK,TN
3K=L          JMBS     VRYWR,3,BFABTSN,BFABREEL [ MAG TAPE ETC. 
3KQ=    #   
3L9W    NOTWF SMO      A1(3)               [ IF LOCAL NAME WAS GIVEN, GET FGN   
3LPG          LDX   4  A1-2(3)             [  IF SUPPLIED BY USER   
3M96          NGN   0  #100 
3MNQ          ANDS  0  ATYPE(3)            [ REQUEST 'FILE ONLY'
3N8B          OPENDIR  XBRK,READ,QUERY  
3NN2          TESTREP2 OK,SUPOK            [ SUPERIOR DIRECTORY OPENED  
3NXS ...      JANAL    XERR 
3P7L          REPALLER  
3PM= ...XERR  JBCC     NDING,FX2,G263SP 
3Q6W ...      UP
3QLG    WKF   FINDWFN  ,3                  [ FIND FCB - 
3R66          TESTRPN2 OK,WFNX             [  SHOULD ALWAYS EXIST FOR W/F   
3RKQ          LDX   6  FBLMOD(3)           [  AND ALWAYS HOLDS CORRECT SIZE 
3S5B          SBN   6  FBLKS-A1            [  EVEN IF FILE OPEN 
3SK2          BRN      XFIN 
3T4L    #   
3TJ=    SZFCB FCBFIND  3,XFCB              [ FILE IS BEING WRITTEN, 
3W3W          LDX   6  FBLMOD(3)           [  SO FCB SHOULD EXIST AND   
3WHG          SBN   6  FBLKS-A1            [  CONTAIN CURRENT SIZE  
3X36          EXIT  5  0
3XGQ    #   
3Y2B    QSIZ  JBC      SIZ,1,BEUWB         [ DIR ENT OK IF NOT BEING WRITTEN
3YG2          CALL  5  SZFCB               [ ELSE GET CURRENT SIZE FROM FCB 
3Y^L          BRN      PCLOS
3^F=    OK    MHUNTW   1,FILE,ENT          [ GET SIZE FROM FILE/ENT 
3^YW    SIZ   LDX   6  ECOPS(1) 
42DG          FREECORE 1                   [ FILE/ENT   
42Y6          SRL   6  15   
43CQ    PCLOS CLOSETOP                     [ USUALLY A DIRECTORY
43XB    #   
44C2    XFIN  LDX   2  FX2  
44WL          JBSC     XUP,2,G263SP 
45B=          OUTNUM   6,7,1               [ THE ANSWER 
45TW          MONOUT   HBMESS   
46*G    NDING ENDCOM
46T6    #   
47#Q    SUPOK MHUNTW   1,FILE,ENT   
47SB ...      JMBS     VWRCL,1,BELIB,BEEXO  
48#2          JMBS     NTEMP,1,BETEMP      [ NOT QUITE SO WRONG 
48RL          LDXC  0  EUSE1(1) 
49?=          BCS      PDIR                [ DIRECTORY  
49QW          BNZ   4  QSIZ                [ FGN GIVEN - COULD BE M/F ELEMENT   
4==G          JBC      QSIZ,1,BEMDF        [ EASY IF NOT WHOLE MULTIFILE
4=Q6          LDX   5  ELAN(1)             [ LANG TO PICK OUT OTHER ELTS
4?9Q          LDX   7  ELOC1(1)            [ -VE INDICATES MULTIFILE
4?PB          LDX   4  ELOC2(1) 
4#92          LDX   6  ELOC3(1) 
4#NL          STO   6  AWORK3(2)
4*8=          FREECORE 1
4*MW          SETNCORE 6,1,FILE,FLOCNB  
4B7G          STO   7  A1(1)
4BM6          STO   4  A1+1(1)  
4C6Q          STO   6  A1+2(1)  
4CLB          STOZ     A1+3(1)  
4D62          STOZ     A1+4(1)  
4DKL          STO   5  A1+5(1)  
4F5=          LDN   6  0
4FJW          GETDIR   6                   [ BACK TO FIRST ENTRY IN M/F 
4G4G          TESTRPN2 OK,XGDIR            [ DIR IS A COMPLETE SHAMBLES 
4GJ6          MHUNTW   1,FILE,ENT   
4H3Q          JBC      NUWB,1,BEUWB        [ SIZE OK IN DIR ENT 
4HHB          LDX   2  1
4J32          CALL  5  SZFCB               [ CURRENT TOP ELT SIZE   
4JGL          LDX   5  ELAN(2)             [ REINSTATE X5 AND   
4K2=          LDX   1  2                   [  FILE/ENT POINTER  
4KFW          BRN      SIZMF               [ OTHERS SHOULD BE OK IN DIR 
4K^G    NUWB  LDX   6  ECOPS(1)            [ INITIALISE TOTAL   
4LF6          SRL   6  15   
4LYQ    SIZMF JBS      SIZ,1,BEMDF         [ STILL M.D.F. ! ?   
4MDB          FREECORE 1
4MY2          MFREE    FILE,FLOCNB  
4NCL          BRN      TROG                [ TO FIND OTHER ELEMENTS 
4NX=    #   
4PBW    USCUR BRUSEN   UNMIS,2             [ NO CURRENT USER IN NO-USER CONTEXT 
4PWG          LDN   4  CPREFIX(2)   
4QB6          LDN   5  AWORK2(2)
4QTQ          MOVE  4  3                   [ FOR COMMON CODE LATER  
4R*B          NGN   6  1                   [ IF 'FILE', NO FILE/ENT ON THIS PATH
4RT2          FREECORE 1                   [ CPB/CUNI   
4S#L          BRN      UPAR 
4SS=    #   
4T?W    PDIR  LDN   4  EUSE1(1)            [ USERNAME OF GIVEN DIRECTORY
4TRG          LDN   5  AWORK2(2)
4W?6          MOVE  4  3
4WQQ          LDX   6  ECOPS(1)            [ IN CASE 'FILE' PARAMETER   
4X=B          SRL   6  15   
4XQ2          FREECORE 1                   [ FREE FILE/ENT BEFORE CLOSETOP COOR 
4Y9L          CLOSETOP  
4YP=    #   
4^8W    UPAR  STOZ     AWORK1(2)           [ INDICATES QUEUED USERNAMES IF >= 0 
4^NG          BRUSEN   NUDIR,2             [ DIR NOT ALLOWED IN NO-USER 
5286          PARAPASS                     [ MAY BE OPTIONS WITH DIRECTORY  
52MQ          MHUNT    2,CPB,CUNI   
537B          SETUPMODE 3,4,READ,DIRONLY,FROZEN 
53M2          NGX   0  ANUM(2)  
546L          LDN   7  #40  
54L=          BPZ   0  X7SET
555W          LDX   5  APARA(2) 
55KG          LDN   7  0
5656          TXU   5  SONLY(1) 
56JQ          BCC      X7SET
574B          LDN   7  #240 
57J2          TXU   5  SALL(1)  
583L          BCC      X7SET
58H=          TXU   5  SFILE(1) 
592W          BCS      PFERR
59GG          BPZ   6  XFIN                [ 'FILE' - SIZE KNOWN
5=26          LDCT  7  #400                [ SPECIAL MARKER TO OPEN CUR DIR 
5=FQ          ADDINMODE 3,4,LEAVE          [  AND GET ITS FILE SIZE 
5=^B    #   
5?F2    X7SET LDCT  6  #400                [ -VE INDICATES FIRST TIME   
5?YL    #     ADDITIVE BITS IN X7 : #40 - INCLUDE INFERIOR DIRS 
5#D=    #                          #200 - INCLUDE REAL AS WELL AS PSEUDO
5#XW    #     SIGN BIT USUALLY INDICATES TOTTING UP A MULTIFILE.
5*CG    #   
5*X6    TBRK  IF       BC,FX2,G263SP       [ SEEMS UNSAFE TO TEST B-I IN %;..;  
5BBQ          THEN  
5BWB             TESTBRKIN XBRK               [ NOT TESTED IN USEROPEN OF DIR   
5CB2          FI
5CTL          LDXC  6  6                   [ TEST IF 1ST TIME AND CLEAR IF SO   
5D*=          BCS      NSMOD
5DSW          SETUPMODE 3,4,READ,DIRONLY,FROZEN,UNTRAP  
5F#G    NSMOD SETNCORE APARA-A1+4,1,CPB,CUNI
5FS6          LDN   0  1
5G?Q          STO   0  JPARNUM(1)          [  CPB/CUNI FOR ERROR IN OPEN
5GRB          LDN   5  13   
5H?2          STO   5  ANUM(1)  
5HQL          LDN   0  #12  
5J==          DCH   0  APARA(1) 
5JPW          LDX   0  ACES 
5K9G          STO   0  APARA+3(1)   
5KP6          SMO      FX1  
5L8Q          ADX   1  PSTEP
5LNB          LDN   0  AWORK2(2)
5M82          MVCH  0  12   
5MML          LDN   0  3
5N7=          SBS   0  AWORK1(2)
5NLW          SETNCORE 4,1,FILE,FABSNB  
5P6G          LDN   0  4
5PL6          STO   0  A1(1)
5Q5Q          LDN   0  AWORK2(2)
5QKB          ADN   1  A1+1 
5R52          MOVE  0  3
5RJL          USEROPEX XBRK,3,4 
5S4=          TESTREP2 OK,OPOK  
5SHW          PICKREP2 4
5T3G          OUTPARAM 5,APARA,CPB,CUNI 
5TH6          MONOUT   AWSNAME  
5W2Q          PUTREP2  4
5W=J ...      JANAL    XERR 
5WGB          REPERR2  OPOK 
5X22          BRN      XERR 
5XFL    #   
5X^=    OPOK  BNG   7  OK                  [ SPECIAL CASE  ' HB ,FILE ' 
5YDW          MFREE    CPB,CUNI 
5YYG    VF    VFREE    FILE                [ SCRUB USEROPEN JUNK
5^D6          BPZ   1  VF   
5^XQ          STOZ     AWORK2(2)           [ NO 'WAITING' DIRECTORY 
62CB          BRN      TROG 
62X2    #   
63BL    TOTUP LDX   0  ECOPSN(3)
63W=          SRL   0  15   
64*W          ADX   6  0
64TG          BVSR     YUKK                [ ABOUT 800 TAPES OR 80 EDS200'S 
65*6    #   
65SQ    TROG  STEP  
66#B          BZE   3  NDIR                [ END OF THIS DIRECTORY  
66S2          LDX   0  ERESN(3) 
67?L          BNZ   0  TROG                [ NOT NAME RECORD
67R=    #     FOR SUPER-FAST BREAK-IN RESPONSE, TESTBRKIN HERE, JUMPING TO  
68=W    #     A CLOSETOP FOLLOWED BY 'BRN XBRK'.  STANDARD CODE WAITS TILL  
68QG    #     END OF THE CURRENT INDIVIDUAL DIRECTORY.  
69=6          JMBS     TROG,3,BNTEMP,BNERASE,BNLIB,BNEXO
69PQ          BPZ   7  NMULT
6=9B          LDX   0  AWORK3(2)
6=P2          TXU   5  ELANN(3) 
6?8L          TXU   7  ELOC1N(3)
6?N=          TXU   4  ELOC2N(3)
6#7W          TXU   0  ELOC3N(3)
6#MG          BCS      TROG                [ NOT IN OUR MULTIFILE   
6*76          JBS      PCLOS,3,BNMDF       [ MDF IS LAST, AND SIZE ZERO 
6*LQ          BRN      TOTUP               [ ORDINARY M/F ELEMENT   
6B6B    NMULT LDCH  0  EUSE1N(3)
6BL2          ANDX  0  7
6C5L          BZE   0  TOTUP               [ NON-DIR, OR DIRS NOT WANTED
6CK=          TXU   0  7
6D4W          BCS      WALL                [ X0#X7 HERE INDICATES 'ALL' 
6DJG          JBC      TOTUP,3,BNPSEUDO 
6F46    WALL  LDN   0  3
6FHQ          ADS   0  AWORK1(2)           [ CONTENTS OF THIS DIR WANTED
6G3B          LDXC  0  AWORK2(2)           [ NAME TO AWK2-4 IF FREE 
6GH2          BCS      USEBL               [ ELSE HAVE TO USE ADATA/CSTORE  
6H2L          LDN   1  EUSE1N(3)
6HG=          LDN   2  AWORK2(2)
6H^W          MOVE  1  3
6JFG          BRN      TOTUP
6J^6    USEBL HUNTW    1,ADATA,CSTORE   
6KDQ          LDX   4  AWORK1(2)
6KYB          BPZ   1  OLDBL
6LD2          LDX   5  7
6LXL          SRL   5  3                   [ REASONABLE SIZE REQUEST
6MC=          ADN   5  IROUND-1+A1  
6MWW          ANDN  5  -IROUND  
6NBG          SBN   5  A1                  [ ASK FOR TIDY SIZE  
6NW6          SETUPCORE 5,1,ADATA,CSTORE
6P*Q          STEPAGAIN 
6PTB          MHUNTW   1,ADATA,CSTORE   
6Q*2    OLDBL LDX   5  ALOGLEN(1)   
6QSL          TXL   5  4
6R#=          BCC      WILGO
6RRW          ADN   5  IROUND*2            [ REASONABLE EXTENSION (5 NAMES) 
6S?G          ANDN  5  #7777
6SR6          TXL   5  4
6T=Q          BCS      YUKK                [ BLK WANTED > 4K - EUKK!
6TQB          ALTLENG  1,5,ROT  
6W=2          STEPAGAIN 
6WPL          MHUNTW   1,ADATA,CSTORE   
6X9=    WILGO SMO      4
6XNW          ADN   1  A1-3                [ POSITION IN CSTORE 
6Y8G          LDN   0  EUSE1N(3)
6YN6          MOVE  0  3
6^7Q          BRN      TOTUP
6^MB    #   
7272    ROT   MHUNTW   2,ADATA,CSTORE      [ ROUTINE REQUIRED BY ALTLENG FOR
72LL          EXIT  1  0                   [  REASONS BEST KNOWN TO ITSELF  
736=    #   
73KW    NDIR  CLOSETOP  
745G          LDXC  4  AWORK1(2)
74K6          BCS      XFIN                [ NO MORE DIRS TO DO 
754Q          LDXC  0  AWORK2(2)           [ IF NAME ALREADY IN 
75JB          BCS      TBRK                [  AWK2-4, CARRY ON  
7642          MHUNTW   3,ADATA,CSTORE   
76HL          ADN   4  A1(3)               [ LAST IN, FIRST OUT 
773=          LDN   5  AWORK2(2)
77GW          MOVE  4  3
782G          BRN      TBRK 
78G6    #END
78^Q
^^^^ ...371645250003
  • Last modified: 17/01/2024 11:55
  • by 127.0.0.1