{{htmlmetatags>metatag-description:(ICL George 3 and George 4 source: BEXTRA83)}}
====== BEXTRA83 ======
(George Source)
**Macros used:** [[george:macro:ALTLEN|ALTLEN]], [[george:macro:BACKSPACE|BACKSPACE]], [[george:macro:BC|BC]], [[george:macro:BUDGINCX|BUDGINCX]], [[george:macro:BUDGUSE|BUDGUSE]], [[george:macro:BUDGUSEN|BUDGUSEN]], [[george:macro:BUDGWRITE|BUDGWRITE]], [[george:macro:BXE|BXE]], [[george:macro:BXGE|BXGE]], [[george:macro:BXU|BXU]], [[george:macro:CHECKEXT|CHECKEXT]], [[george:macro:DICTWELL|DICTWELL]], [[george:macro:FINMOVE|FINMOVE]], [[george:macro:FOUTMOVE|FOUTMOVE]], [[george:macro:FREECORE|FREECORE]], [[george:macro:HUNTW|HUNTW]], [[george:macro:ILLEGALX|ILLEGALX]], [[george:macro:JBC|JBC]], [[george:macro:LOCKCA|LOCKCA]], [[george:macro:MENDAREA|MENDAREA]], [[george:macro:MFREEW|MFREEW]], [[george:macro:MHUNTW|MHUNTW]], [[george:macro:NAME|NAME]], [[george:macro:NAMEX|NAMEX]], [[george:macro:OLPFIN1|OLPFIN1]], [[george:macro:PAIR|PAIR]], [[george:macro:PHOTO|PHOTO]], [[george:macro:READ|READ]], [[george:macro:READDICT|READDICT]], [[george:macro:REPLACE|REPLACE]], [[george:macro:SEGENTRY|SEGENTRY]], [[george:macro:SETNCORE|SETNCORE]], [[george:macro:STEP|STEP]], [[george:macro:STEPAGAIN|STEPAGAIN]], [[george:macro:TESTMOVE|TESTMOVE]], [[george:macro:TESTPRIV|TESTPRIV]], [[george:macro:TESTREP|TESTREP]], [[george:macro:TESTREPNOT|TESTREPNOT]], [[george:macro:TOPCA1|TOPCA1]], [[george:macro:TOPFCB2|TOPFCB2]], [[george:macro:TRACE|TRACE]], [[george:macro:UNPLUG|UNPLUG]]
22FL #SEG BEXTRA6 [M.B.KINGHAM
22^= #OPT K0BEXTRA=K0OLP>K0BUDGES
23DW #OPT K6BEXTRA=K6OLP
23YG #LIS K0BEXTRA
24D6 8HBEXTRA
24XQ SEGENTRY K1BEXTRA,QK1BEXTRA
25CB SEGENTRY K5BEXTRA,QK5BEXTRA
25X2 #
26BL # 1 THIS CHAPTER PROCESSES THE BUDGET EXTRACODES
26W= # THESE EXTRACODES ARE ALL OBEYED IN AN OFF-LINE PERI ACTIVITY
27*W # WHICH HAS BEEN SET UP BY THE COMMAND
27TG # "ASSIGN *CI0,:MASTER.DICTIONARY"
28*6 # THE ASSUMPTION IS MADE BY ALL THESE ROUTINES THAT THE FILE
28SQ # WHICH IS OPEN IS THE DICTIONARY,AND THAT IT IS A VALID ONE.
29#B ZUP 8H*UPDATE
29S2 NAMEB +10
2=?L 12HMASTER
2=R= 12HDICTIONARY
2?=W +0
2?QG +1
2#=6 +0
2#PQ XILL PAIR BEXTRA,5
2*9B PAIR BEXTRA,1
2*P2 ZILLINS +JYILLINS
2B8L ZRESVIOL +JYRESVIOL
2BN= ZMODE +JYMODE
2C7W NOCHEK +5
2CMG [ IN AWORK1 THE FOLLOWING BITS ARE SIGNIFICANT
2D76 #DEF ZENTRY=1 [ =0 UNLESS AN ENTRY IS OPEN
2DLQ #DEF ZCHANGED=4 [ =0 UNLESS ENTRY HAS BEEN CHANGED
2F6B #DEF ZREWOUND=16 [ =0 UNLESS FILE HAS JUST BEEN REWOUND
2FL2 MGTAND +GTAND
2G5L MGTOR +GTOR
2GK= MGCLASS +GCLASS
2H4W MGPOR +GPOR
2HJG MGMASK +GMASK
2J46 MGWORDS +GWORDS
2JHQ #
2K3B TADICTENT
2KH2 #HAL +FILE+ADICTENT,+0
2L2L TFWB
2LG= #HAL +FILE+FWB,+0
2L^W #
2MFG #DEF ZUSER=CUSER-A1
2M^6 #DEF ZPSEU=CPSEU-A1
2NDQ #
2NYB # OTHER STORAGE USED IS AS FOLLOWS:
2PD2 # IN O L P A
2PXL [ AWORK1=CORRENT STATUS OF FILE
2QC= [ AWORK2=NO OF WORDS TO FINMOVE
2QWW #
2RBG # DEFINITIONS FOR THE REPLY IN CA2
2RW6 #DEF REP1=1 [ERROR - THIS BUDGET IS A PRIVILEGE
2S*Q #DEF REP2=2 [ERROR - THIS IS A PSEUDO-USER
2STB #DEF REP3=3 [ERROR - ENTRY IS NOT OPEN
2T*2 #DEF REP4=4 [ERROR - NO SUCH USER EXISTS
2TSL #DEF REP5=5 [ERROR - NO SUCH BUDGET TYPE EXISTS
2W#= #DEF REP6=1 [* THIS USER HAS NO SUCH BUDGET RECORD
2WRW #DEF REP7=10 [ERROR - THIS PROG MAY NOT OPEN THE DICT.
2X?G #DEF REP8=6 [ERROR - ENTRY WOULD OVERFLOW
2XR6 #DEF REP9=2 [* THIS USER DOES NOT HOLD THIS PRIVILEGE
2Y=Q #DEF REP10=7 [ERROR -THIS IS NOT A PRIVILEGE
2YQB #DEF REP11=3 [* NO CHANGE - ENTRY NOT RE-WRITTEN
2^=2 #DEF REP12=8 [ERROR - TOO LARGE FOR A BUDGET RECORD
2^PL #DEF REP13=11 [ERROR - FILE POINTER DESTROYED
329= #DEF REP14=4 [* END OF FILE
32NW #DEF REP15=9 [DICTIONARY FORMAT ERROR
338G # THOSE LINES MARKED WITH AN ASTERISK * ARE NOT ERROR REPLIES
33N6 # AND THE REPLY WORD IN THESE CASES WILL BE POSITIVE
347Q # FOR ERRORS, REPLY WORD IS SET NEGATIVE .
34MB #
3572 # THIS TABLE CONTROLS THE VOLUME OF DATA TRANSFERRED
35LL # BETWEEN THE SUBJECT PROGRAM AND JBUDGET,JEXTRA BLOCK
366= # FIRST WORD :MODE
36KW # SECOND WORD :NO. OF WORDS OF CONTROL AREA (STARTING AT CA1)
375G # TO BE MOVED TO JBUDGET,JEXTRA (STARTING AT ZCA1).
37K6 # LAST WORD CONTAINS JUMP TO
384Q # THE RELEVANT ROUTINE
38JB #
3942 TABLE
39HL #
3=3= #40 [OPEN DICT. ENTRY OF SPECIFIED USER
3=GW +8
3?2G BRN R40
3?G6 #
3?^Q #41 [CLOSE DICTIONARY ENTRY
3#FB +2
3#^2 BRN R41
3*DL #
3*Y= #42 [OPEN THE NEXT USER DICT. ENTRY
3BCW +8
3BXG BRN R42
3CC6 #
3CWQ #50 [READ THE SPECIFIED BUDGET RECORD
3DBB +10
3DW2 BRN R50
3F*L #
3FT= #51 [REWRITE THE SPECIFIED BUDGET RECORD
3G#W +10
3GSG BRN R51
3H#6 #
3HRQ #54 [? TIME AVAILABLE TO THIS USER
3J?B +4
3JR2 BRN R54
3K=L #
3KQ= #55 [INCREMENT THE AMOUNT USED OF THIS BUDGET
3L9W +4
3LPG BRN R55
3M96 #
3MNQ #60 [READ BUDGET DESCR. LINE FOR THIS
3N8B +6
3NN2 BRN R60
3P7L #
3PM= #62 [READ BUDGET DESCR. LINE FOR THIS
3Q6W +6
3QLG BRN R62
3R66 #
3RKQ #70 [TEST THE SPECIFIED PRIVILEGE
3S5B +3
3SK2 BRN R70
3T4L #DEF TABLENG=0?-TABLE/3
3TJ= #
3W3W # THIS IS THE ENTRY ROUTINE
3WHG # INITIAL ENTRY POINT IS K1BEXTRA
3X36 # HERE THE DUMMY DICTIONARY ENTRY CONTAINING THE BUDGET DESCRIPTION
3XGQ # LIST IS READ AND STORED IN THE JBUDGET,JSTORE BLOCK (WHICH WAS
3Y2B QK1BEXTRA
45B= READ [READ BUDGET DESCRIPTION LIST
45TW MHUNTW 3,FILE,FRB
46*G NAME 3,JBUDGET,JSTORE
46T6 SETNCORE 128,3,FILE,ADICTENT
47#Q QK5BEXTRA
47SB # AFTER TNE INITIAL ENTRY , K5BEXTRA IS THE STANDARD ENTRY POINT
48#2 #
48RL # IN THIS ROUTINE, ANY ESSENTIAL DATA IN THE OBJECT PROGRAM AREA
49?= # IS MOVED TO THE OLPA
49QW # AND ANY OTHER SETTING UP WHICH IS RELEVANT TO ALL THE
4==G # EXTRACODES IS DONE.
4=Q6 # THEN CONTROL IS SWITCHED TO THE APPROPRIATE SPECIAL ROUTINE.
4=RT ...[ IS THE TOP FILE OPEN THE DICTIONARY
4=TJ ... TOPFCB2 3
4=X? ... LDN 6 6
4=^2 ...RA LDX 0 NAMEB+1(1)
4?2P ... BXU 0 FUSER1(3),RILL
4?4D ... ADN 1 1
4?67 ... ADN 3 1
4?7W ... BCT 6 RA
4?9Q LDX 3 APETADDR(2)
4?PB LOCKCA 3,ACAP(2),1
4#92 LDX 4 0(1) [GET TYPE/MODE WORD
4#NL LDX 1 FX1
4*8= ANDX 4 BSP16 [EXTRACT MODE
4*MW LDN 0 TABLENG
4B7G R001 TXU 4 TABLE(1) [SEEK MATCHING MODE IN TABLE
4BM6 BCC R002
4C6Q ADN 1 3
4CLB BCT 0 R001
4D62 LDX 1 FX1
4DKL LDX 3 ZMODE(1)
4F5= BRN RES2
4FJW R002 LDX 5 TABLE+1(1)
4G4G #SKI K6BEXTRA>599-599
4GJ6 TRACE 4,BXMODE
4H3Q STO 1 4
4HHB SBX 4 FX1
4J32 STO 5 AWORK2(2)
4JGL LDX 1 FX1
4K2= TXL 5 NOCHEK(1)
4KFW BCS R003 [J UNLESS WORDS TO BE MOVED>4
4K^G CHECKEXT ACAP(2),5,RESVIOL,APETADDR(2),,R003,HLOCK1
4LF6 R003
4LYQ LDX 6 ACAP(2)
4MDB LDN 7 ACA1(2)
4MY2 LDX 3 APETADDR(2)
4NCL FOUTMOVE 3,6,7,5,HLOCK1
4NX= SMO 4
4PBW BRN TABLE+2
4PWG RILL LDX 1 FX1
4QB6 LDX 3 ZILLINS(1)
4QTQ ... ADN 1 1
4R*B BRN RES2
4RT2 RESVIOL
4S#L LDX 3 ZRESVIOL(1)
4SS= RES2
4T?W TOPCA1 XILL(1)
4TRG UNPLUG
4W?6 ILLEGALX 3
4WQQ #
4X=B # END OF EXTRACODE - ZBEXTRA
4XQ2 # THIS ROUTINE (USED BY ALL EXTRACODES) COMPLETES THE TRANSFER OF
4Y9L # INFORMATION BACK TO THE OBJECT PROGRAM,AND THEN ASKS THAT O.P. BE RUN
4YP= Z01
4^8W LDN 0 2
4^NG STO 0 AWORK2(2)
5286 BRN Z02
52MQ # NORMAL ENTRY
537B ZBEXTRA
53M2 LDN 4 0 [REPLY WORD
546L Z02 STO 4 ACA2(2)
54L= LDX 1 APETADDR(2)
555W LDX 5 ACAP(2)
55KG LDN 4 ACA1(2)
5656 FINMOVE 1,5,4,AWORK2(2),HLOCK1
56JQ OLPFIN1
574B BRN K5BEXTRA
57J2 #
583L #
58H= #
592W #
59GG # MODE #40
5=26 # OPEN THE SPECIFIED USER'S DICTIONARY ENTRY
5=FQ # AND READ THE NAME OF HIS SUPERIOR
5=^B R40
5?F2 STOZ AWORK1(2)
5?YL LDX 0 ACA3(2) ['NO SUCH USER' IF USERNAME
5#D= NGN 4 REP4 [BEGINS 0000
5#XW BZE 0 Z01
5*CG BXE 0 ZUP(1),Z01 [IGNORE DUMMY UPDATE RECORD
5*X6 SETNCORE 3,6,FILE,ADICT
5BBQ LDN 5 ACA3(2)
5BWB ADN 6 A1
5CB2 MOVE 5 3
5CTL READDICT
5D*= TESTREPNOT OK,Z01 [OR IF USER CAN'T BE FOUND
5DSW MHUNTW 3,FILE,ADICTENT
5F#G STO 3 FX2
5FS6 MHUNTW 1,FILE,ADICTENT
5G?Q STO 2 FX2
5GRB FREECORE 1
5H?2 NGN 4 REP2 [FLAG APPROPRIATE ERROR IF THIS IS
5HQL LDX 0 CPSEU(3)
5J== BNG 0 Z01
5JPW M0502
5K9G LDN 0 ZENTRY [AND MARK ENTRY "OPEN"
5KP6 ORS 0 AWORK1(2)
5L8Q LDN 4 CUSER(3) [MOVE USERNAME OF THIS USER
5LNB LDN 5 ACA3(2) [AND HIS SUPERIOR
5M82 MOVE 4 6 [ TO OUTPUT AREA
5MML BRN ZBEXTRA
5N7= #
5NLW #
5P6G #
5PL6 #
5Q5Q # MODE #42
5QKB # OPEN THE NEXT USER DICTIONARY ENTRY
5R52 # AND READ THE USERNAME OF THE USER AND HIS SUPERIOR
5RJL R42
5S4= STEP
5SHW BZE 3 M0602 [J IF END OF FILE
5T3G LDX 0 ZUSER(3)
5TH6 BXE 0 ZUP(1),R42 [IGNORE DUMMY UPDATE RECORDS
5W2Q BZE 0 R42 [GO BACK TO READ NEXT ENTRY
5WGB LDX 0 ZPSEU(3) [IF THIS IS A PSEUDO-USER
5X22 BNG 0 R42 [GO BACK TO READ NEXT ENTRY
5XFL LDEX 5 FRH(3)
5X^= MHUNTW 1,FILE,ADICTENT
5YDW LDX 0 ALOGLEN(1)
5YYG BXGE 0 5,M0601
5^D6 ALTLEN 1,5,FILE,ADICTENT
5^XQ STEPAGAIN
62CB MHUNTW 1,FILE,ADICTENT
62X2 M0601
63BL LDN 4 A1(1)
63W= SMO 5
64*W MOVE 3 0
64TG LDX 3 1
65*6 BRN M0502
65SQ M0602 BACKSPACE
66#B STOZ AWORK1(2)
66S2 LDN 4 REP14
67?L BRN Z01
67R= #
68=W #
68QG #
69=6 #
69PQ # MODE #41
6=9B # CLOSE THE DICTIONARY ENTRY JUST OPENED
6=P2 R41
6?8L LDN 0 ZENTRY
6?N= ANDX 0 AWORK1(2)
6#7W NGN 4 REP3
6#MG BZE 0 Z01 [ERROR IF NO ENTRY IS OPEN
6*76 LDN 4 REP11 [POSSIBLE ERROR IF ENTRY UNCHANGED
6*LQ LDN 0 ZCHANGED
6B6B ANDX 0 AWORK1(2)
6BL2 BZE 0 Z01
6C5L LDN 0 ZREWOUND
6CK= ANDX 0 AWORK1(2)
6D4W NGN 4 REP13
6DJG BNZ 0 Z01 [ERROR IF FILE POINTER DESTROYED
6F46 MHUNTW 3,FILE,ADICTENT
6F57 ...#SKI JWPHASE2
6F68 ...(
6F79 ... JBC R41REP,3,BMONCS
6F8= ... BC 3,BMONCS
6F9? ... BUDGUSEN GMONEY
6F=# ... MHUNTW 3,JBUDGET,JBUDGUSER
6F?* ... MHUNTW 2,FILE,ADICTENT
6F#B ... LDX 7 JALLOWED(3)
6F*C ... SBX 7 JCONSUMED(3)
6FBD ... DICTWELL CUSER(2),MONEY,7
6FCF ... MFREEW JBUDGET,JBUDGUSER
6FDG ... MHUNTW 3,FILE,ADICTENT
6FFH ...R41REP
6FGJ ...)
6FHQ PHOTO 6
6G3B LDX 0 TFWB(1)
6GH2 NAMEX 3 [IT CAN BE REWRITTEN IN SITU
6H2L REPLACE
6HG= TESTMOVE 6,M0701
6H^W MHUNTW 3,FILE,FWB
6JFG M0701 LDX 0 TADICTENT(1)
6J^6 NAMEX 3
6KDQ STOZ AWORK1(2)
6KYB BRN ZBEXTRA
6LD2 #
6LXL #
6MC= #
6MWW #
6NBG # MODE #60
6NW6 # READ BUDGET DESCR, LINE
6P*Q # FOR THIS BIT PATTERN BUDGET TYPE
6PTB R60
6Q*2 MHUNTW 3,JBUDGET,JSTORE
6QSL LDX 6 ACA3(2)
6R#= CALL 4 SR0 [TRY TO MATCH BIT PATTERN
6RRW LDN 4 IZLIST+1(3)
6S?G LDN 5 ACA4(2)
6SR6 MOVE 4 3
6T=Q BRN ZBEXTRA
6TQB #
6W=2 #
6WPL #
6X9= # MODE #62
6XNW # READ BUDGET DESCRIPTION LINE
6Y8G # FOR THIS CHAR STRING BUDGET TYPE
6YN6 R62
6^7Q MHUNTW 3,JBUDGET,JSTORE
6^MB LDX 5 ACA4(2)
7272 LDX 6 ACA5(2)
72LL LDX 0 IZCOUNT(3)
736= M1402 TXU 5 IZLIST+1(3)
73KW TXU 6 IZLIST+2(3) [SEEK MATCHING CHARACTER STRING
745G BCC M1403
74K6 ADN 3 IZLINE
754Q BCT 0 M1402
75JB NGN 4 REP5
7642 BRN Z01 [REPLY "NO SUCH TYPE"
76HL M1403 LDX 5 IZLIST(3) [IF FOUND,STORE IN"CONTROL AREA"
773= LDX 6 IZLIST+3(3) [OF JBUDGET,JEXTRA,
77GW M1404 STO 5 ACA3(2) [THE BUDGET BIT PATTERN
782G STO 6 ACA6(2) [AND THE RATION COEFFICIENT
78G6 BRN ZBEXTRA
78^Q #
79FB #
79^2 #
7=DL # MODE #50
7=Y= # READ THE SPECIFIED BUDGET RECORD
7?CW R50
7?XG LDN 0 ZENTRY
7#C6 ANDX 0 AWORK1(2)
7#WQ NGN 4 REP3
7*BB BZE 0 Z01 [ERROR IF NO ENTRY IS OPEN
7*W2 NGN 4 REP1 [IF ERROR,"THIS BUDGET IS A PRIVILEGE"
7B*L LDX 0 ACA3(2)
7BT= ANDX 0 MGCLASS(1)
7C#W TXU 0 MGPOR(1)
7CSG BCC Z01
7D#6 BUDGUSE ACA3(2)
7DRQ LDN 4 REP6
7F?B TESTREPNOT OK,Z01
7FR2 MHUNTW 3,JBUDGET,JBUDGUSER
7G=L ADN 3 A1
7GQ= LDN 4 ACA3(2)
7H9W SMO 0(3)
7HPG MOVE 3 1
7J96 SBN 3 A1
7JNQ FREECORE 3
7K8B BRN ZBEXTRA
7KN2 #
7L7L #
7LM= #
7M6W # MODE #51
7MLG # WRITE THE SPECIFIED BUDGET RECORD
7N66 R51
7NKQ NGN 4 REP3
7P5B LDN 0 ZENTRY
7PK2 ANDX 0 AWORK1(2)
7Q4L BZE 0 Z01 [ERROR IF NO ENTRY IS OPEN
7QJ= LDX 0 ACA3(2)
7R3W SBN 0 GWORDS+1
7RHG NGN 4 REP12
7S36 BPZ 0 Z01
7SGQ LDX 6 ACA4(2) [SELECT BIT PATTERN OF BUDGET
7T2B MHUNTW 3,JBUDGET,JSTORE
7TG2 CALL 4 SR0 [AND CHECK ITS VALIDITY
7T^L HUNTW 3,JBUDGET,JBUDGUSER
7WF= BPZ 3 M1701
7WYW SETNCORE GWORDS+1,3,JBUDGET,JBUDGUSER
7XDG M1701 LDX 6 ACA3(2)
7XY6 LDX 0 ACA4(2) [SELECT BIT PATTERN & APPLY MASK
7YCQ ANDX 0 MGWORDS(1) [TO FIND MINIMUM NO. WORDS IN
7YXB TXL 6 0 [B.R. SUPPLIED.
7^C2 BCC M1700 [IF SIZE SUPPLIED IS TOO SMALL,
7^WL STO 0 6 [SUBSTITUTE THE STANDARD MINIMUM (FOR
82B= STO 0 ACA3(2) [ THIS BUDGET TYPE)
82TW M1700 ADN 2 ACA3 [MOVE RECORD WHICH IS TO BE WRITTEN
83*G ADN 3 A1 [INTO JBUDGET,JBUDGUSER
83T6 SMO 6
84#Q MOVE 2 1
84SB BUDGWRITE
85#2 TESTREPNOT TOOLONG,M1702
85RL NGN 4 REP8 [ERROR IF ENTRY WOULD OVERFLOW
86?= BRN Z01
86QW M1702 LDN 0 ZCHANGED
87=G ORS 0 AWORK1(2)
87Q6 BRN ZBEXTRA
889Q #
88PB #
8992 #
89NL # MODE #55
8=8= # INCREMENT THE AMOUNT USED OF THE SPECIFIED BUDGET TYPE
8=MW R55
8?7G NGN 4 REP3
8?M6 LDN 0 ZENTRY
8#6Q ANDX 0 AWORK1(2)
8#LB BZE 0 Z01 [ERROR IF NO ENTRY IS OPEN
8*62 LDX 6 ACA3(2) [SELECT BIT PATTERN
8*KL MHUNTW 3,JBUDGET,JSTORE
8B5= CALL 4 SR0 [CHECK VALIDITY OF BIT PATTERN
8BJW LDX 5 ACA4(2) [AMOUNT OF INCREMENT
8C4G BUDGINCX 6,5
8CJ6 NGN 4 REP8
8D3Q TESTREP OK,M2002
8DHB TESTREPN INCREASE,Z01
8F32 M2002
8FGL LDN 5 ZCHANGED
8G2= ORS 5 AWORK1(2)
8GFW BRN ZBEXTRA
8G^G #
8HF6 #
8HYQ #
8JDB # MODE #54
8JY2 R54
8KCL LDN 0 ZENTRY
8KX= NGN 4 REP3
8LBW ANDX 0 AWORK1(2)
8LWG BZE 0 Z01 [ERROR IF NO ENTRY OPEN
8MB6 LDN 6 #77
8MTQ ANDX 6 ACA3(2)
8N*B SLL 6 GSHIFT [CONCOCT BIT PATTERN FOR THIS URGENCY
8NT2 ANDX 6 MGTAND(1)
8P#L ORX 6 MGTOR(1)
8PS= LDN 5 0
8Q?W STO 6 ACA3(2)
8QRG BUDGUSE 6
8R?6 TESTREPNOT OK,M2101 [IF USER HAS NONE OF THIS BUDGET,
8RQQ MHUNTW 3,JBUDGET,JBUDGUSER
8S=B LDX 5 JALLOWED(3) [AMOUNT AVAILABLE =0
8SQ2 SBX 5 JCONSUMED(3)
8T9L M2101 STO 5 ACA4(2)
8TP= BRN ZBEXTRA
8W8W #
8WNG #
8X86 #
8XMQ # MODE #70
8Y7B # TEST THE SPECIFIED PRIVILEGE
8YM2 R70
8^6L NGN 4 REP3
8^L= LDN 0 ZENTRY
925W ANDX 0 AWORK1(2)
92KG BZE 0 Z01
9356 LDX 6 ACA3(2)
93JQ ANDX 6 MGCLASS(1)
944B NGN 4 REP10
94J2 TXU 6 MGPOR(1)
953L BCS Z01 [ERROR IF THIS IS NOT A PRIVILEGE
95H= LDX 6 ACA3(2)
962W MHUNTW 3,FILE,ADICTENT
96GG TESTPRIV 6,3 [X0=0 IF PRIVILEGE NOT HELD
9726 BNZ 0 ZBEXTRA
97FQ LDN 4 REP9 [SET UP APPROPRIATE REPLY WORD
97^B BRN Z01
98F2 #
98YL #
99D= # THIS SUBROUTINE MATCHES A BIT PATTERN AGAINST THOSE IN THE
99XW # BUDGET DESCRIPTION LIST
9=CG # ON ENTRY : X3 POINTS TO JBUDGET,JSTORE BLOCK
9=X6 # AND X6 = BIT PATTERN OF BUDGET
9?BQ # X4=LINK
9?WB # USES ALSO X5
9#B2 SR0 LDX 0 IZCOUNT(3)
9#TL ANDX 6 MGMASK(1)
9**= S001 LDX 5 IZLIST(3) [SEEK MATCHING BIT PATTERN IN
9*SW ANDX 5 MGMASK(1) [BUDGET DESCRIPTION LIST
9B#G TXU 5 6
9BS6 BCC S002
9C?Q ADN 3 IZLINE
9CRB BCT 0 S001
9D?2 NGN 4 REP5 [IF NO MATCH, ERROR: NO SUCH BUDGET
9DQL BRN Z01
9F== S002 EXIT 4 0 [EXIT IF MATCH FOUND
9FPW MENDAREA 50,K99BEXTRA
9G9G #END
^^^^ ...62700214000300000000