{{htmlmetatags>metatag-description:(ICL George 3 and George 4 source: BUDGONE83)}}
====== BUDGONE83 ======
(George Source)
**Macros used:** [[george:macro:ALTLEN|ALTLEN]], [[george:macro:BC|BC]], [[george:macro:BS|BS]], [[george:macro:BXE|BXE]], [[george:macro:BXGE|BXGE]], [[george:macro:BXU|BXU]], [[george:macro:FREECORE|FREECORE]], [[george:macro:GEOERR|GEOERR]], [[george:macro:KEEPREP|KEEPREP]], [[george:macro:MENDAREA|MENDAREA]], [[george:macro:MHUNTW|MHUNTW]], [[george:macro:PHOTO|PHOTO]], [[george:macro:PUTREP|PUTREP]], [[george:macro:SEGENTRY|SEGENTRY]], [[george:macro:SETNCORE|SETNCORE]], [[george:macro:SETREP|SETREP]], [[george:macro:SETREP2|SETREP2]], [[george:macro:STEP|STEP]], [[george:macro:TESTMOVE|TESTMOVE]], [[george:macro:TRACE|TRACE]], [[george:macro:UP|UP]]
22FL #LIS K0BMACROS>K0BUDGES>K0ALLGEO>K0GREATGEO
22^= ...#SEG BUDGONE83 [HUGH SIMMONS
23DW ... 8HBUDGONE8
23YG SEGENTRY K1BUDGONE,QK1BUDGONE
24D6 SEGENTRY K2BUDGONE,QK2BUDGONE
24XQ SEGENTRY K3BUDGONE,QK3BUDGONE
25CB SEGENTRY K4BUDGONE,QK4BUDGONE
25X2 SEGENTRY K5BUDGONE,QK5BUDGONE
26BL #
26W= # THIS CHAPTER CONTAINS THE SUBROUTINES USED BY THE
27*W # FOLLOWING BUDGET MACROS:
27TG # BUDGUSE,BUDGUSEN,BUDGBITS,BUDGBITX,BUDGINCR,BUDGINCX AND BUDGDEL
28*6 #
28SQ #DEF TCOUNT=IZCOUNT-A1 [NO. OF BUDGETS IN LIST
29#B #DEF TLIST=IZLIST-A1 [START OF LIST
29S2 #DEF TRANS=JCONSUMED-A1-1 [AMOUNT CONSUMED FOR TRANSIENT BUDGETS
2=?L #DEF STABL=JALLOWED-A1-1 [AMOUNT BEING USED FOR STABLE BUDGETS
2=R= # MASKS FOR BUDGET BIT PATTERN BREAK-DOWN
2?34 ...MGMONEY +GMONEY&GMASK
2?=W MGCLASS +GCLASS [BUDGET CLASSIFICATION
2?QG MGMASK +GMASK [UNIQUE PART OF BIT PATTERN
2#=6 MGWORDS +GWORDS [NO OF INFORMATION WORDS REQUIRED
2#PQ MGPOR +GPOR [PRIVILEGE IDENTIFICATION
2*9B MGTOR +GTOR [TRANSIENT BUDGET IDENTIFICATION
2*P2 MGSOR +GSOR [STABLE BUDGET IDENTIFICATION
2B8L #
2BN= # BUDGUSE AND BUDGUSEN
2C7W # THE FOLLOWING ROUTINE READS A USER'S BUDGET RECORD AND STORES IT
2CMG # IN A JBUDGET,JBUDGUSER BLOCK
2D76 QK1BUDGONE
2DLQ LDX 6 EXEC1(2) [BUDGET TYPE BIT PATTERN
2F6B #SKI K6BMACROS>99-99
2FL2 TRACE EXEC1(2),BUDGONE
2G5L SETNCORE GWORDS+1,3,JBUDGET,JBUDGUSER
2GK= STOZ A1(3) [ SET UP AND
2H4W LDN 4 A1(3) [CLEAR JBUDGET,JBUDGUSER BLOCK
2HJG LDN 5 A1+1(3) [OF MAXIMUM NECESSARY SIZE
2J46 MOVE 4 GWORDS
2JHQ STO 6 JBITS(3)
2K3B MHUNTW 2,FILE,ADICTENT
2KH2 #SKI K6BMACROS>10-10
2L2L (
2LG= R01 LDX 4 MGCLASS(1) [BUDGET CLASSIFICATION
2L^W ANDX 4 6 [ & BUDGET TYPE BITS GIVE CLASSIFICATION
2MFG TXU 4 MGPOR(1) [OF BUDGET TYPE.IF IT IS A PRIVILEGE,
2M^6 BCS R02 [THE JBUDGET BLOCK WILL BE FREED
2NDQ GEOERR 1,PRIVILEG
2NYB R02
2PD2 )
2PXL STO 2 4 [KEEP POINTER TO FILE ADICTENT BLOCK
2QC= #SKI K6BMACROS>999-999
2QWW TRACE 6,BONER02
2RBG CALL 7 SR0A [FIND BUDGET RECORD VIA SR0
2RW6 BRN RENC [IF NO SUCH B R,GO TO RELEASE JBUDGET BL.
2S*Q R05 LDX 7 CQUANT(2)
2STB ANDX 7 MGWORDS(1) [NO OF INFORMATION WORDS
2T*2 LDN 4 CQUANT(2)
2TSL LDN 5 JBITS(3)
2W#= SMO 7
2WRW MOVE 4 0
2X?G STO 7 A1(3)
2XR6 #SKI K6BMACROS>999-999
2Y=Q TRACE A1+1(3),BUDGEND1
2YQB SETREP OK
2^=2 UP
2^PL RENC KEEPREP 7,NOTYPE
329= REND
32NW #SKI K6BMACROS>999-999
338G TRACE CQUANT-4(2),BONEREND
33N6 FREECORE 3
347Q PUTREP 7
34MB UP
3572 #
35LL # BUDBITS AND BUDBITX
366= # BUDGET CONVERSION:THIS SECTION SETS UP A JBUDGET,JLINE BLOCK TO MATCH
36KW # THE BIT PATTERN HELD IN EXEC1
375G QK2BUDGONE
37K6 LDX 4 EXEC1(2) [BIT PATTERN OF BUDGET TYPE
384Q #SKI K6BMACROS>999-999
38JB TRACE 4,BONE K2
3942 SETNCORE IZLINE,5,JBUDGET,JLINE
39HL PHOTO 6
3=3= STEP
3=GW LDX 2 5
3?2G TESTMOVE 6,S0
3?G6 MHUNTW 2,JBUDGET,JLINE
3?^Q S0
3#FB LDX 7 4
3#^2 ANDX 7 MGCLASS(1)
3*DL SBX 7 MGPOR(1)
3*Y= BZE 7 S00
3BCW # (PRIVILEGES DO NOT HAVE A WORD COUNT )
3BXG ANDX 4 MGMASK(1) [SELECT UNIQUE BIT PATTERN
3CC6 S00 LDX 5 TCOUNT(3) [UNLESS BUDGET IS A PRIVILEGE
3CWQ S01 LDX 6 TLIST(3) [BUDGET TYPE FROM DESCRIPTION LIST
3DBB BZE 7 S010
3DW2 ANDX 6 MGMASK(1)
3F*L S010
3FT= BXE 4 6,S02
3G#W ADN 3 IZLINE [SET POINTER TO NEXT BUDGET LINE
3GSG BCT 5 S01
3H#6 FREECORE 2
3HRQ SETREP2 NOSUCH
3J?B #SKI K6BMACROS>999-999
3JR2 TRACE 4,MBNOTYPE
3K=L UP
3KQ= S02 LDN 5 A1(2)
3L9W LDN 4 TLIST(3)
3LPG MOVE 4 IZLINE
3M96 SETREP OK
3MNQ #SKI K6BMACROS>999-999
3N8B TRACE A1(2),BFOUND
3NN2 UP
3P7L #
3PM= # BUDGET RECORD INCREMENTING (BUDGINCX & BUDGINCR)
3Q6W # EXEC1 CONTAINS THE BUDGET TYPE
3QLG # EXEC2 CONTAINS THE INCREMENT
3R66 QK3BUDGONE
3RKQ LDX 7 EXEC1(2)
3S5B ANDX 7 MGCLASS(1) [SELECT BUDGET CLASSIFICATION
3SK2 #SKI K6BMACROS
3T4L (
3TJ= #SKI K6BMACROS>99-99
3W3W TRACE EXEC1(2),BUDGINC
3WHG BXU 7 MGPOR(1),T01 [MUST NOT BE A PRIVILEGE
3X36 GEOERR 1,BINCPRIV
3XGQ T01
3Y2B )
3YG2 LDN 3 TRANS [SET POINTER FOR TRANSIENT INCREMENTS
3Y^L BXE 7 MGTOR(1),T010 [OR, IF NECESSARY, FOR STABLE BUDGETS
3^F= LDN 3 STABL
3^YW T010 LDX 6 EXEC1(2) [SELECT BUDGET TYPE
42DG LDX 4 EXEC2(2) [KEEP INCREMENT IN X4
42Y6 MHUNTW 2,FILE,ADICTENT
43CQ SMO FX2
43XB STO 2 EXEC3
44C2 #SKI K6BMACROS>999-999
44WL TRACE 6,BONET011
45B= CALL 7 SR0A [GO TO FIND THE BUDGET RECORD
45TW BRN T03 [IF ABSENT,GO TO MAKE NEW ENTRY
45WH ... LDN 0 STABL
45X8 ... SBX 0 3
45XT ... BZE 0 NOTRAN [J IF STABLE BUDGET
45YG ... SMO FX2
45^7 ... LDX 0 EXEC1 [BUDGET TYPE
45^K ... ANDX 0 MGMASK(1)
4623 ... TXU 0 MGMONEY(1)
462F ... BCS NOTMON [J IF NOT MONEY BUDGET
4636 ...[ THIS IS A MONEY BUDGET UPDATE
463R ...[ CHECKS ARE NOW MADE TO SEE IF
464D ...[ THE SIGN OF THE MONEY CHANGES
4655 ... MHUNTW 3,FILE,ADICTENT
465Q ... BC 3,BMONCS [CLEAR 'MONEY CHANGED SIGN' BIT
4668 ... LDX 0 CQUANT-1+TRANS(2) [JALLOWED
466L ... SBX 0 CQUANT+TRANS(2) [-JCONSUMED=LEFT
4674 ... BNG 0 NGI [J IF INITIALLY -VE
467P ... ADX 0 4
468B ... BNG 0 SETBC [J IF CHANGED FROM +VE TO -VE
4693 ...NGI ADX 0 4
469N ... BNG 0 NOTMON [J IF STILL -VE
46=* ...SETBC BS 3,BMONCS [SET 'MONEY CHANGED SIGN' BIT
46?2 ...NOTMON
46?M ... LDN 3 TRANS
46## ...NOTRAN
46*G ADX 2 3 [ADD REQUIRED INCREMENT TO
46T6 ADS 4 CQUANT(2) [JALLOWED OR JCONSUMED
47#Q KEEPREP 7,OK
47SB LDX 6 CQUANT-1(2) [CALCULATE RESULTANT AMT.AVAILABLE , AN
48#2 SBX 6 CQUANT(2) [SET REPLY 'OVERDRAWN','NOMORE',OR 'OK'
48RL # FOR STABLE BUDGETS ANT AVAILABLE = RATION - AMT USED
49?= # FOR TRANSIENT BUDGETS, AMT AVAILABLE = ALLOWANCE - AMT CONSUMED
49QW #SKI K6BMACROS>999-999
4==G TRACE 6,BONT011A
4=Q6 BPZ 6 TZ01
4?9Q KEEPREP 7,ODRAWN
4?PB BRN TZZ
4#92 TZ01 BNZ 6 TZZ
4#NL KEEPREP 7,NOMORE
4*8= TZZ PUTREP 7
4*MW #SKI K6BMACROS>999-999
4B7G TRACE 7,BONETZZ
4BM6 SMO FX2
4C6Q STO 6 ACOMMUNE3 [PASS UP AMT AVALABLE
4CLB UP
4D62 # IF THE USER HAS NONE OF THIS BUDGET TYPE, A NEW BUDGET RECORD
4DKL # IS APPENDED TO HIS FILE,ADICTENT BLOCK
4F5= T03 SMO FX2
4FJW LDX 7 EXEC1 [SELECT BUDGET TYPE BIT PATTERN
4G4G SMO FX2
4GJ6 SBX 2 EXEC3 [KEEP DISTANCE OF NEW RECORD
4H3Q STO 2 5 [FROM START OF BLOCK
4HHB #SKI K6BMACROS>999-999
4J32 TRACE 5,BONET03
4JGL LDX 6 7
4K2= ANDX 6 MGWORDS(1)
4KFW SMO FX2
4K^G LDX 3 EXEC3 [RESTORE POINTER TO FILE,ADICTENT BLOCK
4LF6 ADX 6 A1(3) [SET NO OF WORDS REQ'D IN NEW BLOCK
4LYQ STO 6 A1(3)
4MDB STO 3 2
4MY2 LDX 0 ALOGLEN(3)
4NCL BXGE 0 6,T03A
4NX= ALTLEN 3,6,FILE,ADICTENT [INCREASE BLOCK SIZE
4PBW MHUNTW 2,FILE,ADICTENT
4PWG T03A
4QB6 LDX 6 7 [BUDGET TYPE TO X6
4QTQ #SKI K6BMACROS>999-999
4R*B TRACE 6,BINCRTYP
4RT2 ANDX 6 MGWORDS(1) [SELECT NO. OF INFORMATION WORDS REQD.
4S#L SBN 6 1 [COUNT OF WORDS TO BE CLEARED
4SS= #SKI K6BMACROS>99-99
4T?W (
4TRG BNG 6 ZONK
4W?6 BNZ 6 ZOK
4WQQ ZONK GEOERR 1,BUDGINC
4X=B ZOK
4XQ2 )
4Y9L LDN 0 1
4YP= ADS 0 CNUMQ(2) [INCREMENT QUANTITATIVE BUDGET COUNT
4^8W #SKI K6BMACROS>999-999
4^NG TRACE CNUMQ(2),BONET03A
5286 ADX 2 5 [RESTORE POINTER TO NEW BUDGET RECORD
52MQ STO 7 CQUANT(2)
537B T030 SMO 6
53M2 STOZ CQUANT(2) [CLEAR BUDGET RECORD AREA
546L BCT 6 T030
54L= ANDX 7 MGCLASS(1)
555W LDN 3 TRANS
55KG BXE 7 MGTOR(1),T031
5656 LDN 3 STABL
56JQ T031 ADX 2 3
574B STO 4 CQUANT(2) [JALLOWED OR JCONSUMED
57J2 #SKI K6BMACROS>999-999
583L TRACE CQUANT(2),BINCT031
58H= KEEPREP 7,INCREASE
592W NGX 6 4 [AMT AVAILABLE IN X6
594S ... SMO FX2
596Q ... LDX 0 EXEC1
598N ... ANDX 0 MGMASK(1)
59=L ... BXU 0 MGMONEY(1),TZZ [J IF NOT MONEY
59#J ... BPZ 6 TZZ [J IF "LEFT" NOT GOING -VE.
59BG ... MHUNTW 2,FILE,ADICTENT
59DD ... BS 2,BMONCS [DO DICTWELL LATER
59GG BRN TZZ
5=26 #
5=FQ #
5=^B # BUDGWRITE
5?F2 # WRITES THE BUDGET RECORD SUPPLIED IN A JBUDGET,JBUDGUSER BLOCK
5?YL # TO THE FILE,ADICTENT BLOCK
5#D= QK4BUDGONE
5#XW MHUNTW 3,JBUDGET,JBUDGUSER
5*CG MHUNTW 2,FILE,ADICTENT
5*X6 LDX 6 JBITS(3) [BIT PATTERN BUDGET TYPE TO X6
5BBQ STO 2 4 [KEEP POINTER TO FILE,ADICTENT BLOCK
5BWB #SKI K6BMACROS>999-999
5CB2 TRACE 6,BONEQ002
5CTL CALL 7 SR0A [FIND BUDGET RECORD IN FILE,ADICTENT
5D*= BRN Q4 [GO TO Q4 IF NONE FOUND
5DSW LDX 6 CQUANT(2) [OTHERWISE TEST FOR ALTERATION IN SIXE
5F#G ANDX 6 MGWORDS(1) [OF BUDGET RECORD
5FS6 SBX 6 A1(3)
5G?Q BZE 6 Q300 [GO TO Q300 IF NO CHANGE IN SIZE
5GRB BPZ 6 Q2 [ Q2 IF NEW OLD) :
5HQL Q1 NGX 6 6
5J== STO 6 7 [AMOUNT OF INCREASE TO X6 AND X7
5JPW STO 4 3
5K9G SBX 2 4 [SET POINTER IN X3 TO FILE,ADICTENT,AND
5KP6 STO 2 4 [POINTER TO BUDGET RECORD IN X4(REL CPRIV
5L8Q ADX 6 A1(3) [REQUIRED SIZE OF NEW BLOCK IN X6
5LNB TXL 6 BSBS [RECORD MAY OVERFLOW : IF THIS OCCURS,
5M82 BCC QLONG [THERE IS AN ERROR
5MML LDX 0 ALOGLEN(3)
5N7= BXGE 0 6,Q101
5NLW PHOTO 5
5P6G ALTLEN 3,6,FILE,ADICTENT [LENGTHEN BLOCK
5PL6 TESTMOVE 5,Q101
5Q5Q MHUNTW 3,FILE,ADICTENT
5QKB Q101 LDX 5 6
5R52 CALL 0 QA [SET UP STEERING INFORMATION OOR MOVE
5RJL STO 5 A1(3) [STORE NEW NO. OF WORDS IN FILE,ADICTENT
5S4= #SKI K6BMACROS>999-999
5SHW (
5T3G TRACE 2,BONEQ101
5TH6 TRACE 6,BONEQ101
5W2Q TRACE 7,BONEQ101
5WGB )
5X22 BZE 2 Q3
5XFL SBN 6 1
5X^= ADX 7 6 [STARTING FROM THE RIGHTMOST END,
5YDW Q102 SMO 6 [MOVE OLD INFORMATION UP
5YYG LDX 0 0(2) [ (TO MAKE ROOM FOR NEW RECORD)
5^D6 SMO 7
5^XQ STO 0 0(2)
62CB BCT 2 Q102
62X2 BRN Q3
63BL # IF BUDGET RECORD HAS DECREASED IN SIZE (NEW < OLD)
63W= Q2 STO 6 7 [AMOUNT OF INCREASE TO X7
64*W STO 4 3 [SET POINTER IN X3 TO FILE,ADICTENT
64TG SBX 2 4
65*6 STO 2 4 [POINTER TO BUDGET RECORD IN X4 (REL CPRI
65SQ CALL 0 QA [SET UP STEERING INFORMATION FOR "MOVE"
66#B #SKI K6BMACROS>999-999
66S2 (
67?L TRACE 2,BONEQ2
67R= TRACE 6,BONEQ2
68=W TRACE 7,BONEQ2
68QG )
69=6 LDX 5 6
69PQ SBX 6 7 [MOVE OLD INFORMATION BACK TO FILL GAP
6=9B BZE 2 Q201
6=P2 SMO 2 [LEFT BY CONTRACTED BUDGET RECORD
6?8L MOVE 5 0
6?N= Q201
6#7W SBS 7 A1(3)
6#MG LDX 7 A1(3)
6*76 LDX 0 ALOGLEN(3)
6*LQ BXE 0 BSBS,Q3
6B6B PHOTO 5
6BL2 ALTLEN 3,7,FILE,ADICTENT
6C5L TESTMOVE 5,Q3
6CK= MHUNTW 3,FILE,ADICTENT
6D4W # IF THE FILE,ADICTENT BLOCK HAS BEEN ALTERED IN SIZE :
6DJG Q3 STO 3 2
6F46 ADX 2 4
6FHQ MHUNTW 3,JBUDGET,JBUDGUSER
6G3B LDX 0 JBITS(3)
6GH2 ANDX 0 MGMASK(1)
6H2L ORX 0 A1(3)
6HG= STO 0 JBITS(3)
6H^W Q300
6J2^ ... LDX 0 JBITS(3)
6J44 ... ANDX 0 MGMASK(1)
6J57 ... SBX 0 MGMONEY(1)
6J6= ... BNZ 0 Q3NM [J IF NOT MONEY
6J7* ... LDX 0 JALLOWED(3)
6J8D ... SBX 0 JCONSUMED(3) [WHAT'S LEFT NOW
6J9H ... LDX 1 CQUANT+TRANS-1(2)
6J=L ... SBX 1 CQUANT+TRANS(2) [WHAT WAS LEFT
6J?P ... ERX 0 1
6J#S ... BPZ 0 Q3NM [J IF NO CHANGE OF SIGN
6J*X ... MHUNTW 1,FILE,ADICTENT
6JC2 ... BS 1,BMONCS
6JD5 ...Q3NM
6JFG LDN 1 JBITS(3)
6J^6 ADN 2 CQUANT
6KDQ SMO A1(3)
6KYB MOVE 1 0
6LD2 #SKI K6BMACROS>999-999
6LXL (
6MC= TRACE 0(2),BONEQ300
6MWW TRACE 1(2),BONEQ300
6NBG TRACE 7,BONEQ300
6NW6 TRACE 4,BONEQ300
6P*Q )
6PTB Q302
6Q*2 SETREP OK
6QSL UP
6R#= # IF NO SUCH BUDGET RECORD HAS BEEN FOUND
6RRW Q4 LDX 6 A1(3) [SELECT NO OF WORDS IN NEW RECORD
6S?G STO 4 3 [SET POINTER IN X3 TO FILE,ADICTENT
6SR6 SBX 2 4 [KEEP DISTANCE OF BUDGET RECORD AREA
6T=Q STO 2 4 [FROM START OF BLOCK IN X4
6TQB ADX 6 A1(3)
6W=2 LDX 0 BSBS
6WPL TXL 0 6
6X9= BCS QLONG
6XNW STO 6 A1(3)
6Y8G TXU 0 ALOGLEN(3)
6YN6 BCC Q401
6^7Q PHOTO 5
6^MB ALTLEN 3,6,FILE,ADICTENT
7272 TESTMOVE 5,Q401
72LL MHUNTW 3,FILE,ADICTENT
736= Q401 LDN 0 1
73KW ADS 0 CNUMQ(3)
745G #SKI K6BMACROS>999-999
74K6 TRACE CNUMQ(3)
754Q BRN Q3
75JB QLONG
7642 SETREP TOOLONG
76HL UP
773= # THIS SUBROUTINE SETS UP POINTERS FOR Q1 AND Q2
77GW # ON ENTRY: X0=LINK ACCUMULATOR X1=FX1
782G # X3 POINTS TO FILE,ADICTENT BLOCK
78G6 # X7=NO. OF WORDS BY WHICH BLOCK SIZE HAS INCREASED
78^Q # ( OR WILL DECREASE)
79FB # AND CQUANT(X4+X3) IS THE START OF THE BUDGET RECORD
79^2 # IN THE FILE,ADICTENT BLOCK.
7=DL # ON EXIT: X2=NO. OF WORDS TO BE MOVED
7=Y= # X6=LOC'N FROM WHICH WORDS ARE TO BE MOVED
7?CW QA SMO 4
7?XG LDX 2 CQUANT(3) [BIT PATTERN OF BUDGET TYPE
7#C6 ANDX 2 MGWORDS(1) [NO. OF INFORMATION WORDS
7#WQ STO 2 6
7*BB ADN 2 CQUANT-A1 [ADD DISTANCE OF THIS BUDGET RECORD
7*W2 ADX 2 4 [FROM A1
7B*L SBX 2 A1(3) [AND SUBTRACT THIS AMOUNT FROM THE
7BT= NGX 2 2 [TOTAL NO. OF WORDS IN THE FILE,ADICTENT
7C#W SMO 4 [ADD THIS RECORD ADDRESS TO THE
7CSG ADN 6 CQUANT(3) [NO. WF WORDS IN THIS CURRENT RECORD
7D#6 #SKI K6BMACROS>99999-99999
7DRQ TRACE 2,BUDG QA
7F?B EXIT 0 0
7FR2 #
7G=L # SUBROUTINE TO SET A POINTER TO A SPECIFIED BUDGET RECORD
7GQ= # FROM THE FIRST FILE,ADICTENT BLOCK
7H9W # ON ENTRY : X6=BUDGET TYPE BIT PATTERN
7HPG # X7=LINK ACCUMULATOR
7J96 # ON EXIT : CQUANT(2) IS THE FIRST WORD OF THE BUDGET RECORD,IF FOUND
7JNQ # OTHERWISE,IT IS THE FIRST UNUSED WORD AFTER THE Q.B. LIST
7K8B # X1=FX1 THROUGHOUT SUBROUTINE
7KN2 # X3 AND X4 ARE NOT USED
7L7L SR0 MHUNTW 2,FILE,ADICTENT
7LM= SR0A ANDX 6 MGMASK(1) [SELECT UNIQUE BIT PATTERN
7M6W LDX 0 CNUMQ(2) [NO. OF QUANTITATIVE BUDGETS
7MLG BNZ 0 R001
7N66 EXIT 7 0
7NKQ R001 LDX 5 CQUANT(2) [SEEK MATCHING BUDGET BIT PATTERN
7P5B ANDX 5 MGMASK(1)
7PK2 TXU 5 6
7Q4L BCS R002
7QJ= EXIT 7 1 [EXIT - BUDGET FOUND
7R3W R002 LDX 5 CQUANT(2) [SET POINTER PO NEXT BUDGET RECORD
7RHG ANDX 5 MGWORDS(1)
7S36 ADX 2 5
7SGQ BCT 0 R001
7T2B EXIT 7 0 [ SUCH BUDGET RECORD
7TG2 #
7T^L # SUBROUTINE TO DEAL WITH THE "BUDGDEL" MACRO
7WF= # DELETES THE BUDGET RECORD IN A JBUDGET,JBUDGUSER BLOCK
7WYW # FROM THE FILE,ADICTENT
7XDG QK5BUDGONE
7XY6 MHUNTW 3,JBUDGET,JBUDGUSER
7YCQ MHUNTW 2,FILE,ADICTENT
7YXB #SKI K6BMACROS>99-99
7^C2 TRACE JBITS(3),BUDGDEL
7^WL STO 2 4 [KEEP POINTER TO FILE,ADICTENT IN X4
82B= LDX 6 JBITS(3) [BUDGET TYPE BIT PATTERN TO X6
82TW CALL 7 SR0A [SEEK BUDGET RECORD IN FILE ADICTENT
83*G BRN V5 [IF NOT FOUND,SET REPLY NO TYPE
83T6 # IF THE BUDGET RECORD IS PRESENT IN THE FILE,ADICTENT#
84#Q # CHECK THAT IT IS UNCHANGED.
84SB LDX 5 JBITS(3)
85#2 ANDX 5 MGWORDS(1)
85RL TXU 5 A1(3)
86?= BCS V4
86QW LDX 7 5
87=G V1 SBN 7 1
87Q6 SMO 7
889Q LDX 6 JBITS(3)
88PB SMO 7
8992 TXU 6 CQUANT(2)
89NL BCS V4 [DO NOT DELETE IF CHANGED
8=8= BCT 5 V1
8=MW NGX 5 A1(3) [NEGATIVE COUNT OF WORDS IN BUDGET RECORD
8?7G STO 4 3 [KEEP IN X3 POINTER TO FILE,ADICTENT
8?M6 LDN 7 CQUANT(2) [AND IN X7 A POINTER TO THE BUDGET RECORD
8#6Q SBX 2 4
8#LB STO 2 4
8*62 CALL 0 QA [SET UP PARAMETERS,AND MOVE
8*KL BZE 2 V3 [ANY SUBSEQUEBT
8B5= SMO 2 [BUDGET RECORDS BACK,OVERWRITING THE
8BJW MOVE 6 0 [RECORD WHICH IS BEING DELETED
8C4G V3
8CJ6 ADX 5 A1(3) [DECREMENT NO.OF WORDS IN THIS RECORD
8D3Q STO 5 A1(3)
8DHB LDN 0 1
8F32 SBS 0 CNUMQ(3) [AND NO. OF QUANTITATIVE BUDGETS
8FGL LDX 0 ALOGLEN(3)
8G2= TXU 0 BSBS
8GFW BCC V501
8G^G ALTLEN 3,5 [SHORTEN DICTIONARY ENTRY
8HF6 KEEPREP 7,OK
8HYQ BRN V501
8JDB V4 KEEPREP 7,CHANGED
8JY2 BRN V501
8KCL V5 KEEPREP 7,NOTYPE
8KX= V501 PUTREP 7
8LBW UP
8LWG MENDAREA 50,K99BUDGONE
8MB6 #END
^^^^ ...41024710000600000000