{{htmlmetatags>metatag-description:(ICL George 3 and George 4 source: CREATE867)}}
====== CREATE867 ======
(George Source)
**Macros used:** [[george:macro:BACKWAIT|BACKWAIT]], [[george:macro:BXGE|BXGE]], [[george:macro:CHAIN|CHAIN]], [[george:macro:CLOSE|CLOSE]], [[george:macro:CLOSETOP|CLOSETOP]], [[george:macro:COMBRKIN|COMBRKIN]], [[george:macro:COMERR|COMERR]], [[george:macro:CREATEB|CREATEB]], [[george:macro:DOWN|DOWN]], [[george:macro:ENDCOM|ENDCOM]], [[george:macro:ERROR|ERROR]], [[george:macro:FNORM|FNORM]], [[george:macro:FREEBAX|FREEBAX]], [[george:macro:FREECORE|FREECORE]], [[george:macro:GETFCBN|GETFCBN]], [[george:macro:HUNT|HUNT]], [[george:macro:INCRECUBS|INCRECUBS]], [[george:macro:JFNZ|JFNZ]], [[george:macro:LOCKC|LOCKC]], [[george:macro:MENDAREA|MENDAREA]], [[george:macro:MFREE|MFREE]], [[george:macro:MHUNTW|MHUNTW]], [[george:macro:MONOUT|MONOUT]], [[george:macro:NAME|NAME]], [[george:macro:NAMETOP|NAMETOP]], [[george:macro:OPEND|OPEND]], [[george:macro:PAIR|PAIR]], [[george:macro:REPERR|REPERR]], [[george:macro:SEG|SEG]], [[george:macro:SEGENTRY|SEGENTRY]], [[george:macro:SETMODE|SETMODE]], [[george:macro:SETNCORE|SETNCORE]], [[george:macro:SETUPCORE|SETUPCORE]], [[george:macro:SPARANXT|SPARANXT]], [[george:macro:STF|STF]], [[george:macro:TESTREP|TESTREP]], [[george:macro:TESTRPN2|TESTRPN2]], [[george:macro:TRACE|TRACE]], [[george:macro:TRANSFCB|TRANSFCB]], [[george:macro:TRAPADD|TRAPADD]], [[george:macro:UP|UP]], [[george:macro:USEROPEN|USEROPEN]], [[george:macro:WHATBACK|WHATBACK]], [[george:macro:WORKNUMB|WORKNUMB]]
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