CREATE867

(George Source)

Macros used: BACKWAIT, BXGE, CHAIN, CLOSE, CLOSETOP, COMBRKIN, COMERR, CREATEB, DOWN, ENDCOM, ERROR, FNORM, FREEBAX, FREECORE, GETFCBN, HUNT, INCRECUBS, JFNZ, LOCKC, MENDAREA, MFREE, MHUNTW, MONOUT, NAME, NAMETOP, OPEND, PAIR, REPERR, SEG, SEGENTRY, SETMODE, SETNCORE, SETUPCORE, SPARANXT, STF, TESTREP, TESTRPN2, TRACE, TRANSFCB, TRAPADD, UP, USEROPEN, WHATBACK, WORKNUMB

CREATE867.txt
22FL ...      SEG   CREATE,83,PETE CAMPBELL,OLP 
22KH ...[   
22PD ...[ (C) COPYRIGHT INTERNATIONAL COMPUTERS LTD 1983
22T* ...[   
22^=          SEGENTRY K1CREATE,XENT1   
23DW          SEGENTRY K2CREATE,XENT2   
23YG          SEGENTRY K3CREATE,XBSCLEAR
24D6    #     THIS ROUTINE CREATES WORKFILES AND DIRECT ACCESS FILES FOR NORMAL 
24XQ    #     TEMPORARY USE.  A DIRECTORY ENTRY IS WRITTEN FOR NORMAL FILES.
25CB    #     AN FCB IS PUT AT THE FRONT OF THE WORKFILE RING FOR TEMPORARY 
25X2    #     FILES 
26BL    #   
26W=    WA    4HAAAA
27*W    WORK  12HWORKFILE   
27TG    WFLIMIT        101  
28*6    Z     4H000Z
28SQ    XENT1   
29#B          SMO      FX2  
29S2          STOZ     AWORK1   
2=?L          SPARAPASS 
2=R=          HUNT     1,CPB,CUNI   
2?=W          LDX   0  ANUM(1)  
2?QG          BNG   0  NPAR                [ERROR IF NO PARAMETER   
2#=6    #SKI        K6CREATE>599-599
2#PQ          TRACE    APARA(1),CREATE  
2*9B          NAMETOP  1,FILE,FNAME 
2*P2          FNORM    1
2B8L          TESTREP  NAMEFORM,XEND
2BN=          HUNT     1,FILE,FNAME 
2C7W          NAMETOP  1,CPB,CUNI          [RENAME CUNI BLOCK FOR ERROR MESSAGES
2CMG          TESTREP  OK,NOTR2            [ERROR IF NO ADJUNCTS
2D76          SPARANXT                     [PICK UP FIRST PART OF PARAMETER 
2D?3 ...      TESTRPN2 TOOMANY,NOTMANY  
2DBY ...      COMERR   JMAXPAR             [TOO MANY QUALIFIERS GIVEN   
2DGT ...NOTMANY 
2DLQ          HUNT     1,FILE,ADJUNCTS  
2F6B          LDX   0  A1+1(1)  
2FL2          SLL   0  1                   [X0 -VE IF TEMPORARY FILE
2G5L          BPZ   0  NOMULT              [J UNLESS TEMP.  
2GK=          SETMODE  4,SELF              [MEANS MULT  
2H4W          ANDX  4  A1+1(1)  
2HJG          BZE   4  NOMULT              [J IF NOT MULT   
2J46          MONOUT   JTEMXMULT
2JHQ          MFREE    CPB,CUNI 
2K3B          ERROR    ERNAMEFORM   
2KH2          BRN      XEND 
2L2L    NOMULT  
2LG=          LDX   4  A1(1)               [LENGTH OF ADJUNCTS BLOCK
2L^W          SBN   4  ADPAIR-A1
2MFG          BNZ   4  PERS                [MORE INFORMATION ABOUT DIRECT ACCESS
2M^6          LDX   2  A1+2(1)             [TEST FOR A DIRECT ACCESS MODE   
2NDQ          BNZ   2  UERR2               [IF THERE IS, THEN ERROR, AS NO KWORD
2NYB          BPZ   0  NOTR2               [ERROR IF NOT TEMPORARY  
2PD2          BRN      NADJ                [MINIMUM ADJUNCTS
2PXL    PERS  CREATEB                      [SET UP A CREATE BLOCK   
2QC=          HUNT     2,FILE,CREATE
2QWW          HUNT     1,FILE,ADJUNCTS  
2RBG          LDX   0  GSIGN
2RW6          STO   0  CETM(2)             [SET SIGN BIT
2S*Q          LDX   0  A1+2(1)             [DEVICE TYPE 
2STB          ORS   0  CETM(2)             [STORE IN CREATE BLOCK   
2T*2          SRL   0  15   
2TSL          SBN   0  6
2W#=          BZE   0  OKDA                [ED  
2WRW          SBN   0  3
2X?G          BZE   0  OKDA                [DR  
2XR6          SBN   0  4
2Y=Q          BZE   0  OKDA                [FD  
2YQB    NOTR2 COMERR   ERCREATE 
2^=2    OKDA  LDCH  0  A1+3(1)             [ORGANISATIONAL QUALIFIERS   
2^PL          BZE   0  MORG                [J IF NONE   
329=          DCH   0  CEORG(2) 
32NW          ANDN  0  4
338G          BZE   0  MORG                [J IF NOT SERIAL 
33N6          LDCT  0  #240 
347Q          ORS   0  CEORG(2)            [SERIAL  
34MB    MORG
3572          ADN   1  ADPAIR              [INCREASE POINTER
35LL          STOZ     3                   [ZEROISE MARKER  
366=    WFIND LDX   0  0(1)                [PICK UP FIRST WORD OF PAIR  
36KW          SBN   0  1
375G          BZE   0  WORDS               [TEST FOR KWORDS 
37K6          ADN   3  2                   [INCREASE MARKER 
384Q          ADN   1  2                   [INCREASE POINTER
38JB          SBN   4  2                   [DECREASE LENGTH MARKER  
3942          BNZ   4  WFIND               [LOOK AT NEXT PAIR   
39HL    UERR2 COMERR   ERCREAKW 
3=3=    WORDS LDX   0  1(1)                [FILE SIZE   
3=GW          SLL   0  10-GSBSLOG   
3?2G          STO   0  CEINF3(2)           [STORE SIZE IN CREATE BLOCK  
3?G6          STOZ     7                   [ZEROISE TYPE COUNT  
3?^Q    NXTP  ADX   4  3                   [RESTORE LENGTH MARKER   
3#FB          SBX   1  3                   [POINTER BACK TO FIRST PAIR  
3#^2          STOZ     3                   [ZEROISE MARKER  
3*DL          ADN   7  1                   [RAISE TYPE COUNT
3*Y=    PAIR  LDX   0  0(1)                [FIRST WORD OF PAIR  
3BCW          SBX   0  7
3BXG    #SKI  K6CREATE>599-599  
3CC6    (   
3CWQ          TRACE    0,CR ADJ 
3DBB          TRACE    7,CR TYPE
3DW2    )   
3F*L          BZE   0  XPAIR               [THE TYPE IN X7 HAS BEEN FOUND   
3FT=          LDX   6  7
3G#W          ADN   3  2                   [INCREASE MARKER 
3GSG          ADN   1  2                   [INCREASE POINTER
3H#6          SBN   4  2                   [REDUCE LENGTH COUNT 
3HRQ          BNZ   4  PAIR 
3J?B          SBN   6  2
3JR2          BNZ   6  NOTB                [J IF NOT BUCKET TYPE
3K=L          LDN   0  4
3KQ=          ORS   0  CEORG(2)            [SET BUCKET SIZE TO 4
3L9W          BRN      NXTP                [LOOK FOR INTEGRITY  
3LPG    NOTB  SBN   6  1
3M96          BNZ   6  NOTI                [J IF NOT INTEGRITY TYPE 
3MNQ          LDCT  0  #600 
3N8B          ORS   0  CEINF3(2)           [SET INTEGRITY TO 3  
3NN2          BRN      NXTP                [LOOK FOR RECORD 
3P7L    NOTI  SBN   6  1
3PM=          BNZ   6  NOTRC               [J IF NOT RECORD TYPE
3Q6W          LDX   0  CEORG(2) 
3QLG          LDCH  0  0
3R66          SLL   0  13   
3RKQ          ORS   0  CEORG(2)            [SET RECORD LENGTH EQUAL TO BUCKET SI
3S5B          BRN      NXTP                [LOOK FOR KEYLENGTH  
3SK2    NOTRC   
3T4L    #SKI  AHEADER   
3TJ=    (   
3W3W          SBN   6  9
3WHG          BNZ   6  NOTSEEK  
3X36          LDN   0  80   
3XGQ          STO   0  CESEEK(2)           [DEFAULT VALUE OF SEEKAREA   
3Y2B          BRN      NXTP 
3YG2    NOTSEEK 
3Y^L          SBN   6  3
3^F=          BNZ   6  NOTOV
3^YW          STOZ     CEFLOW(2)
42DG          BRN      NXTP 
42Y6    NOTOV SBN   6  3
43CQ          BNZ   6  NXTP 
43XB          LDN   5  0                   [NO WBHEAD - SET MARKER  
44C2          BRN      NEWF 
44WL    )   
45B=    #SKI  AHEADER<1$1   
45TW    (   
46*G          SBN   6  12                  [SEE IF ANY OVERFLOW(TYPE 16) ADJUNCT
46T6          BNZ   6  NOTOV
47#Q          STOZ     CEFLOW(2)           [IF NO OVERFLOW QUAL.,DEFAULT=0  
47SB          BRN      NEWF 
48#2    NOTOV ADN   6  8
48RL          BNZ   6  NXTP 
49?=          ADN   7  7
49QW          BRN      NXTP 
4==G    )   
4=Q6    XPAIR LDX   0  1(1)                [2ND WORD OF PAIR
4?9Q          LDX   6  7
4?PB          SBN   6  1
4#92          BZE   6  NXTP                [KWORDS ALREADY DEALT WITH   
4#NL          SBN   6  1
4*8=          BNZ   6  NBUCK               [J IF NOT BUCKET 
4*MW          ORS   0  CEORG(2)            [BUCKET SIZE 
4B7G          BRN      NXTP                [LOOK FOR INTEGRITY  
4BM6    NBUCK SBN   6  1
4C6Q          BNZ   6  NINT                [J IF NOT INTEGRITY  
4CLB          SRC   0  2
4D62          ORS   0  CEINF3(2)           [INTEGRITY   
4DKL          BRN      NXTP                [LOOK FOR RECORD 
4F5=    NINT  SBN   6  1
4FJW          BNZ   6  NREC                [J IF NOT RECORD 
4G4G          SLL   0  6
4GJ6          ORS   0  CEORG(2)            [RECORD LENGTH   
4H3Q          BRN      NXTP                [LOOK FOR KEYLENGTH  
4HHB    NREC  SBN   6  1
4J32          BNZ   6  NKL                 [J IF NOT KEYLENGTH  
4JGL          SRC   0  9
4K2=          ORS   0  CEKEY(2)            [KEY LENGTH  
4KFW          BRN      NXTP                [LOOK FOR KEYPLACE   
4K^G    NKL   SBN   6  1
4LF6          BNZ   6  NKP                 [J IF NOT KEYPLACE   
4LYQ          ORS   0  CEKEY(2)            [KEY POSITION
4MDB          BRN      NXTP                [LOOK FOR RECHEADLEN 
4MY2    NKP   SBN   6  1
4NCL          BNZ   6  NRHL                [J IF NOT RECHEAD LENGTH 
4NX=          SBN   0  2
4PBW          BZE   0  NXTP                [RECHEADLEN=2
4PWG          LDCT  0  #400 
4QB6          ORS   0  CEORG(2)            [RECHEADLEN=3
4QTQ          BRN      NXTP                [LOOK FOR ANY OTHER ADJUNCRTS
4R*B    NRHL  SBN   6  1
4RT2          BNZ   6  NODD                [J IF NOT ODDBITS
4S#L          SRC   0  6
4SS=          ORS   0  CEORG(2)            [B4AND B5 OF CEORG   
4T?W          BRN      NXTP 
4TRG    NODD
4W?6    #SKI  AHEADER   
4WQQ    (   
4X=B          SBN   6  5
4XQ2          BNZ   6  NSEEK               [J IF NOT SEEKAREA   
4Y9L          STO   0  CESEEK(2)           [PRESERVE SEEKAREA   
4YP=          BRN      NXTP 
4^8W    NSEEK   
4^NG          SBN   6  3
5286          BNZ   6  NOFLOW   
52MQ    )   
537B    #SKI  AHEADER<1$1   
53M2    (   
546L          SBN   6  8                   [J IF NO MORE ADJUNCTS   
54L=          BNZ   6  NEWF 
555W    )   
55KG          BZE   0  OUTRAN              [IF ZERO QUALIFIER,OUT OF RANGE  
5656          BNG   0  OUTRAN              [IF NEGATIVE QUALIFIER,OUT OF RANGE  
56JQ          CALL  6  SUM  
574B          BXGE  7  0,OKRANGE
57J2    OUTRAN  
583L          MONOUT   ADISQUIET
58H=          COMERR   ERNAMEFORM   
592W    OKRANGE 
59GG          STO   0  CEFLOW(2)
5=26    #SKI  AHEADER<1$1   
5=FQ          BRN      NEWF 
5=^B    #SKI  AHEADER   
5?F2    (   
5?YL          BRN      NXTP 
5#D=    NOFLOW  
5#XW          SBN   6  3
5*CG          BNZ   6  NXTP                [NOT WBHEAD  
5*X6          LDN   5  1                   [SET MARKER  
5BBQ          BRN      NEWF 
5BWB    )   
5CB2    #   
5CTL    #                          X7_KWORDS*8/BUCK 
5D*=    SUM 
5DSW          LDX   7  CEINF3(2)           [BITS9-23 = KWORDS*2^(10-GSBSLOG)
5F#G          ANDN  7  #7777
5FS6          SLL   7  3-10+GSBSLOG        [KWORDS*8
5G?Q          LDX   3  CEORG(2) 
5GRB          ANDN  3  #77                 [BUCK, IN BITS18-23, IS 1 2 4 OR 8   
5H?2    SUM1  SRL   3  1
5HQL          BZE   3  SUMEX
5J==          SRL   7  1
5JPW          BRN      SUM1 
5K9G    SUMEX   
5KP6          EXIT  6  0
5L8Q    NEWF
5LNB    #SKI  AHEADER   
5M82    (   
5MML          BZE   5  NOTHEAD  
5N7=          CALL  6  SUM  
5NLW          LDX   4  7
5P6G          DVS   3  CESEEK(2)           [(KWORDS*8/BUCK)/SEEKAREA
5PL6          BNZ   3  SK1                 [J IF X/SEEKAREA NOT INTEGER 
5Q5Q          LDX   3  CESEEK(2)
5QKB          LDCT  0  0(3) 
5R52          BRN      SK2  
5RJL    SK1   BZE   4  SK3                 [J IF X/SEEKAREA<1   
5S4=          LDX   3  CESEEK(2)
5SHW          LDCT  0  0(3) 
5T3G          ORX   0  GSIGN
5TH6          BRN      SK2  
5W2Q    SK3   LDX   1  7                   [X/SEEKAREA NOT AN INTEGER>1 
5WGB          LDCT  0  0(1) 
5X22          LDN   4  1
5XFL    SK2   ORX   0  4
5X^=          STO   0  CESEEK(2)
5YDW    NOTHEAD 
5YYG          LDX   1  2
5^D6    )   
5^XQ    #SKI  AHEADER<1$1   
62CB          HUNT     1,FILE,CREATE
62X2          HUNT     2,FILE,ADJUNCTS  
63BL          LDCT  0  #200 
63W=          ANDX  0  A1+1(2)             [TEST FOR A TEMPORARY FILE   
64*W          ORS   0  CEINF2(1)           [AND SET BIT IN EINF2 IF IT IS   
64TG          LDX   6  0
65*6          LDX   4  CEINF3(1)
65SQ          SLL   4  9
66#B          SRL   4  9                   [EXTRACT SIZE OF FILE IN BLOCKS  
66S2    #SKI  BSOL  
67?L    (   
67R=          BZE   6  NOTDAWF             [J IF NOT A DIRECT ACCESS WF 
68=W          INCRECUBS XBRK,NOTOPEN,4     [CAN WE HAVE THE BS? 
68QG          TESTREP  OK,NOTDAWF   
69=6          COMERR   EREXQUOTA
69PQ    NOTDAWF 
6=9B    )   
6=P2          LDN   7  1
6?8L          BNZ   6  XFCB                [J IF WORKFILE   
6?N=          WHATBACK 3,4                 [SET UP FULLB WITH THESE BLOCKS  
6#2M    [   
6#3* ...#SKI ARETRV 
6#43 ...(   
6#4P ...      HUNT     1,FILE,CREATE
6#5C ...      LDX   2  GMTNOW   
6#65 ...      SLL   2  8
6#6R ...      SRL   2  8                   [ CLEAR M S 8 BITS   
6#7F ...      STF      1,FCEGMTRV,2 
6#87 ...#     STORE L S 16 BITS OF GMT IN FCEGMTRV  
6#8T ...      JFNZ     NOTZERO,1,FCEGMTRV   
6#9H ...      LDN   2  1
6#=9 ...#     IF THE FIELD IS ZERO SET IT TO 1  
6#=X ...      STF      1,FCEGMTRV,2 
6#?K ...NOTZERO 
6##? ...)   
6#*4          SEGENTRY BSCLEARX            [UNIVERSAL FOR BSCLEAR MACRO 
6#MG          BRN      XOPEN
6*76          DOWN  CREATE,3
6*LQ    XOPEN   
6B6B    #     OPEN NEW FILE, LEAVING ENT BLOCK FOR BUCKHEAD 
6BL2          USEROPEN XBRK,WRITE,CREATE,LEAVE  
6C5L          TESTREPN ALREADY,USERED   
6CK=          ERROR    ERALREX  
6D4W          BRN      NOGO 
6DJG    USERED  
6F46          REPERR   OPEND               [TEST ERRORS 
6FHQ          BRN      NOGO 
6G3B    OPEND   
6GH2    #SKI  AHEADER   
6H2L    (   
6HG=          BZE   5  NOTWBH   
6H^W          DOWN     BUCKHEAD,1   
6JFG    NOTWBH  
6J^6    )   
6KDQ          BNZ   5  NOENT
6KYB          HUNT     1,FILE,ENT   
6LD2          BNG   1  NOENT
6LXL          FREECORE 1
6MC=    NOENT   
6MH7 ...#SKI ARETRV 
6MM4 ...      CLOSETOP  
6MQ^ ...#SKI ARETRV<1$1 
6MWW          CLOSE 
6NBG    QUIT
6NW6    #SKI  K6CREATE>599-599  
6P*Q          TRACE    CHCHCT,CREATED   
6PTB    NOGO
6Q*2          HUNT     1,BSTB,FULLB 
6QSL          BNG   1  XEND                [TEST FOR FULLB LEFT AROUND  
6R#=          FREEBAX                      [IF SO FREE IT AND ITS BLOCKS
6RRW          MFREE    BSTB,EMPTYB  
6S?G          BRN      XEND 
6SDN ...SKIPINB 
6SR6    [   
6T=Q    XENT2          [ENTRY FROM CREATEWF MACRO   
6TQB    [   
6W=2          SMO      FX2  
6WPL          STO   2  AWORK1              [SET NON-ZERO
6X9=    NADJ  LDN   7  0
6XNW          LDN   4  8
6Y8G    #   
6YN6    #     SET UP AN FCB AT THE FRONT OF THE WORKFILE RING   
6^7Q    #     AND A FEXTRA BLOCK AFTER THE FCB  
6^MB    #   
7272    XFCB
72LL          WORKNUMB 3
736=          SMO      FX2  
73KW          LDX   0  AWORK1   
745G          BNZ   0   ZWHAT   
74K6          TXL   3  WFLIMIT(1)   
754Q          BCC      XLIMIT              [J IF TOO MANY WORKFILES 
75GL    ZWHAT LDX   1  7
75YG          WHATBACK 8(1),4   
76BC    [   
76NS          SEGENTRY BSCLEARY            [UNIVERSAL FOR BSCLEAR MACRO 
773=          BRN      XEMPTY   
77GW          DOWN  CREATE,3
782G    XEMPTY  
78G6          LDX   0  AWFNAME(2)   
78^Q          BNZ   0  XFCB5
79FB          SMO      FX1  
79^2          LDX   0  WA                  [EMPTY - SET AWFNAME TO AAAA, FIRST  
7=DL          STO   0  AWFNAME(2)          [IN THE WORK NAME CYCLE  
7=Y=    XFCB5 LDX   6  4
7?CW          ADN   6  FBLKS-A1 
7?SB ...      SETUPCORE 6,3,FILE,FCB,,1 
7#8W ...      LDN   0   0   
7#KB ...      GETFCBN  3,0                   [GET UNIQUE FCB NO.
7#^W ...      TRANSFCB 3,ACT,WORK      [TRANSFER FCB TO WORKRING
7*BB          LDX   0  6
7*W2          BNZ   7  XF1  
7B*L          LDN   0  FBLKS-A1 
7BT=    XF1 
7C#W          STO   0  FBLMOD(3)
7CSG          SBN   0  1                   [CLEAR FWAITCOUNT - BSPRE
7D9G ...      STOZ     FBLMOD+1(3)  
7DLG ...      LDX   2  0
7F3H ...      LDN   0  FBLMOD+1(3)  
7FDJ ...      LDN   1  FBLMOD+2(3)  
7FTK ...      MOVE  0  FBLKS-FBLMOD-1                    [ CLEAR  FCB   
7G=L    #SKI  ACCMG65   
7GQ=          STO   6  FUSEBL(3)
7H9W          LDCT  0  #400 
7HPG          STO   0  CMOD(3)             [SET CMOD BIT 0  
7J96          SRL   0  5
7JNQ          BNZ   7  XFCB4
7K8B          LDCT  1  #20  
7KN2          ADX   0  1
7L7L    XFCB4 STO   0  FCOMM(3)            [SET BIT4 (IF SERIAL) AND BIT5   
7MBN          BNZ   7  NOTVIRG             [J IF ADJUNCTS GIVEN.
7MLG          LDN   0  #1000
7N66          ORS   0  FCOMM(3) 
7N*Y    NOTVIRG 
7NKQ    #SKI  BSOL  
7P5B    (   
7PK2          LDCT  0  #100 
7Q4L          ORS   0  FINFC(3)            [SET THE 'PUBLIC FILE' BIT   
7QJ=    )   
7R3W          HUNT     1,BSTB,FULLB 
7RHG          LDN   5  A1+1(1)             [ADDRESS OF LOGICAL BLCK NO. IN FULLB
7S36          LDN   6  BSPRE(3)            [ADDRESS OF BSPRE IN FCB 
7SGQ          LDX   2  4
7T2B          ADN   2  1
7TG2          MOVE  5  0(2)                [MOVE FULLB DATA TO FCB  
7T^L          MFREE    BSTB,FULLB          [FREE THE FULLB  
7WF=          BNZ   7  RAND                [BRANCH IF RANDOM FILE   
7WYW          LDN   4  FILESIZE 
7XDG          BRN      XFCB2
7XY6    RAND  HUNT     1,FILE,CREATE
7Y5# ...      LDX   0  CETM(1)             [ MOVE TYPE MODE FROM CREATE BLOCK   
7Y=G ...      STO   0  FETM(3)             [ TO FCB 
7YCQ          LDX   0  CEENDBUCK(1) 
7YXB          STO   0  FENDBUCK(3)  
7^C2          LDX   0  CEVERSION(1) 
7^WL          STO   0  FVERSION(3)  
82B=    XFCB2 STO   4  FSIZE(3)            [GSBS-FBLKS+A1(SERIAL) OR KWORDS 
82TW    #   
83*G    #     SET UP FEXTRA BLOCK AND CHAIN AFTER FCB   
83T6    #   
84#Q          LDN   5  8                   [SET FEXTRA LENGTH TO 8  
84SB          SETUPCORE 5,1,FILE,FEXTRA 
85#2          STO   5  A1(1)               [HEADER  
85RL          LDN   0  CALL 
86?=    XFCB6 STO   0  FWORKTRAP(1) 
86QW          LDX   0  EDATE
87=G          STO   0  FWRTD(1) 
87Q6          LDX   0  CLEANCT  
889Q          STO   0  FWRTT(1) 
88PB          STOZ     FTM(1)   
8992          BZE   7  XFCB3
89NL          HUNT     3,FILE,CREATE
8=8=          LDX   0  CETM(3)  
8=MW          STO   0  FTM(1)   
8?7G          LDN   4  CEFLOW(3)
8?M6          LDN   5  FFLOW(1) 
8#6Q          MOVE  4  3
8#LB    XFCB3 LDX   2  BWORKRING(2) 
8*62          CHAIN    1,2                 [CHAIN FEXTRA AFTER FCB  
8*KL          BZE   7  WNM1 
8B5=          MFREE    FILE,CREATE  
8BJW    #     GIVE THE WORKFILE A UNIQUE NAME  XXXXNNNNNNNN , WHERE XXXX IS ONE 
8C4G    #     OF THE CYCLE AAAA TO ZZZZ AND NN... IS THE JOB NUMBER IN OCTAL
8CJ6    #     DIGITS RIGHT JUSTIFIED
8D3Q    WNM1
8DHB          SMO      FX2  
8F32          LDX   2  BWORKRING           [FCB ADDRESS 
8FGL          SMO      FX1  
8G2=          LDN   6  WORK 
8GFW          LDN   7  FUSER1(2)
8G^G          MOVE  6  3                   [USER NAME IS WORKFILE   
8HF6          SMO      FX2  
8HYQ          LDX   0  AWFNAME  
8JDB          STO   0  FLOC1(2)            [ONE OF AAAA TO ZZZZ 
8JY2          STOZ     FLOC2(2) 
8KCL          SMO      FX2  
8KX=          LDX   4  JOBNO
8LBW          LDN   1  FLOC3(2) 
8LWG    WNM4  LDN   0  4
8MB6    WNM2  SRL   45 3
8MTQ          SRL   5  3
8N*B          BCT   0  WNM2 
8NT2          STO   5  0(1)                [4 OCTAL DIGITS IN X5 - RIGHT JUST.  
8P#L          BZE   4  WNM3                [BRANCH IF JOB NO. CONVERTED 
8PS=          SBN   1  1
8Q?W          BRN      WNM4 
8QRG    WNM3
8R?6          LDN   0  1                   [SET DETAILS FOR WORKFILE NAME   
8RQQ          STO   0  FREEL(2)            [REEL - 1
8S=B          STO   0  FGEN(2)             [GEN - 1 
8SQ2          LDX   0  ACES 
8T9L          STO   0  FLAN(2)             [LANG - '    '   
8TP=    #     RESET AWFNAME TO THE NEXT NAME IN THE CYCLE AAAA TO ZZZZ  
8W8W          LDN   7  1
8WNG          LDN   6  3
8X86    WNM9  LDX   2  6
8XMQ          SRC   2  2                   [CHARACTER POINTER   
8Y7B          ADX   2  FX2  
8YM2          LDCH  0  AWFNAME(2)          [NEXT CHARACTER  
8^6L          SMO      FX1  
8^L=          TXU   0  Z
925W          BCC      WNM5                [BRANCH IF Z 
92KG          ADS   7  AWFNAME(2)          [ADD 1 TO CURRENT CHARACTER  
9356          LDN   0  #41  
93JQ          LDN   1  4
944B          SBX   1  6
94J2    WNM7  BCT   1  WNM6 
953L          BRN      WFCR 
95H=    WNM6  BCHX  2  £
962W          DCH   0  AWFNAME(2)   
96GG          BRN      WNM7 
9726    WNM5  BZE   6  WNM8 
97FQ          SBN   6  1
97^B          SLL   7  6
98F2          BRN      WNM9 
98YL    WNM8  SMO      FX1  
99D=          LDX   0  WA   
99XW          STO   0  AWFNAME(2)   
9=CG    WFCR
9=X6          SETNCORE 10,1,FILE,FABSNB    [FOR CREATEWF MACRO  
9?BQ          SMO      FX2  
9?WB          LDX   2  BWORKRING           [FCB 
9#B2          LDN   4  FUSER1(2)
9#TL          LDN   5  A1+1(1)  
9**=          MOVE  4  9                   [MOVE IN WORKFILE NAME   
9*SW          LDN   0  #200 
9B#G          ORS   0  ATYPE(1)            [SET WORKFILE MARKER IN FABSNB   
9BS6          SMO      FX2  
9C?Q          LDX   0  AWORK1   
9CRB          BZE   0  XC                  [J IF COMMAND ENTRY  
9D?2          UP
9DQL    XC  
9F==          HUNT  1,FILE,FTRAP
9FPW          BNG   1  XEND                [J TO END IF NO TRAPADJ  
9G9G          NAME  1,FILE,FAPB 
9GP6          LDX   2  FX2                 [CHAIN BLOCK CONTAINING TRAPS AFTER  
9H8Q          CHAIN    1,2                 [ACT BLOCK IN PREPARATION FOR THE
9HNB          TRAPADD                      [TRAPADD 
9HQD ...SKIPINB2
9HWJ ...XEND
9JF6 ...      ENDCOM
9JML    NPAR  COMERR   JPARMIS  
9K7=    XLIMIT  
9KLW          COMERR   JWFLIMIT 
9KNH ...SKIPINB3
9KRT ...XBRK
9L=Q ...      COMBRKIN  
9LWL ...PHIND   
9LY? ...      MHUNTW   2,BSTB,BWRITE
9L^Y ...      EXIT  1  0
9M3K ...XBSCLEAR
9M5Q          SETUPCOR   BSBS,1,BSTB,BWRITE,1   
9MKB          LOCKC   1,PHIND   
9N52          MHUNTW   3,BSTB,BWRITE
9NJL          STOZ     A1(3)
9P4=          LDN   0  A1(3)
9PHW          LDN   1  A1+1(3)  
9Q3G          MOVE  0  GSBS-1   
9QH6          ADN   3  A1   
9R2Q          MHUNTW    1,BSTB,FULLB
9RGB          LDX   7  A1(1)
9S22          SBN   7  2
9SFL    SLOOP   
9S^=          BZE   7  WAIT 
9TDW          SBN   7  1
9TYG          MHUNTW 1,BSTB,FULLB   
9WD6          SMO      7
9WXQ          LDX   2  A1+2(1)  
9XCB          WRITEAUT   BSET+FAIL,BSBS,,A1+1(1),2,3
9XX2          BRN      SLOOP
9YBL    WAIT
9YW=          BACKWAIT  
9^*W          SBN   3  A1   
9^TG          FREECORE   3  
=2*6          UP
=2SQ          MENDAREA   AOLPGAP,K99CREATE  
=3#B    #END
^^^^ ...20444431000100000000
  • Last modified: 17/01/2024 11:55
  • by 127.0.0.1