BUDGONE83
(George Source)
Macros used: ALTLEN, BC, BS, BXE, BXGE, BXU, FREECORE, GEOERR, KEEPREP, MENDAREA, MHUNTW, PHOTO, PUTREP, SEGENTRY, SETNCORE, SETREP, SETREP2, STEP, TESTMOVE, TRACE, UP
- BUDGONE83.txt
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 5H?2 # IF BUDGET RECORD HAS INCREASED IN SIZE (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