(George Source)
Macros used: ACROSS, BACKREAD, BACKWRITE, BSOFF, BSON, BXGE, BXU, COOR3, FIXTRA, FON, FREECORE, FSHCODE, FSHSKIP, FSHTEST, GEOERR, GETBACK, GETBSLIS, GETCORE, HUNT, JAMQUERY, LONGON, LONGSET, LOSBSBIT, MENDAREA, MHUNT, MHUNTW, NAME, RIGHT, SEGENTRY, SETNCORE, TRACE, TRANSBEG, UP, UPPLUS, WAITPRIV, WRONG
22FL #OPT K0GETBAX=0 22^= #OPT K6WHATBACK=K6ALLGEO 23DW #LIS K0GETBAX>K0ALLGEO 23YG ...#SEG GETBAX83 [ANDY TRAVELL 24D6 8HGETBAX 24XQ SEGENTRY K1GETBAX,QK1GET 25CB SEGENTRY K2GETBAX,QK2GET 25X2 SEGENTRY K3GETBAX,QK3GET 26BL SEGENTRY K5GETBAX,QK5GET 26W= SEGENTRY K7GETBAX,QK7GET 27*W SEGENTRY K8GETBAX,QK8GET 27TG SEGENTRY K9GETBAX,QK9GET 28*6 SEGENTRY K10GETBAX,QK10GET 28SQ SEGENTRY K11GETBAX,QK11GET 29#B SEGENTRY K12GETBAX,QK12GET 2=R= # 2=S3 ...# SUBROUTINE TO CHECK IF ACTIVITY IS PRIVILEGED 2=SS ...# 2=TK ...SWAITPRIV 2=WB ... STO 0 GEN1 [ SAVE THE LINK 2=X7 ... WAITPRIV NOTPRACT [ SEE IF PRIVILEGED 2=XY ... LDX 0 GEN1 [ RECOVER LINK 2=YP ... EXIT 0 1 [ IF PRIVILEGED 2=^G ...NOTPRACT 2?2? ... LDX 0 GEN1 [ RECOVER LINK 2?34 ... EXIT 0 0 [ IF NOT 2?3T ...# 2?4L ...# 2?5C ...# SUBROUTINE TO REMOVE ENTRY FROM FAILED BLOCKS LIST 2?68 ...# EXPECTS BLOCK NO. IN GEN0 AND RES. NO. IN GEN1 2?6^ ...# 2?7Q ...SLOSBSBIT 2?8H ... LOSBSBIT GEN0,GEN1 [ REMOVE BIT REQUIRED 2?9# ... EXIT 7 0 2?=5 ...# 2?=W # 2#PQ T52 LDXC 0 A1+4(2) 2*9B BCS T52A 2*P2 COOR3 2 2B8L ... BRN T52B 2BN= T52A COOR3 #14 2C7W ...T52B MHUNTW 3,BSTB,EMPTYB 2CMG LDX 7 A1+1(3) 2D76 GETBSLIS 2DLQ BRN T4 2F6B T1 COOR3 3 [WAIT FOR END OF BS TRANSFER 2FL2 QK1GET 2G5L T9 LDX 5 ACOMMUNE9(2) 2GK= BZE 5 T9A [JUMP IF NOT OPTIONAL REQUEST 2H4W MHUNTW 3,BSTB,EMPTYB 2HJG LDX 7 A1+1(3) 2J46 GETBSLIS 2JHQ LDX 6 A1+1(2) 2K3B BNG 6 T9CA 2KH2 LDX 6 A1(3) 2L2L SBN 6 3 2LG= BNG 6 T3 [J IF NO BLOCKS REQUIRED 2L^W SBX 6 A1+1(2) 2MFG BZE 6 T9B [J IF ENOUGH BLOCKS AVAILABLE 2M^6 BNG 6 T9B 2NDQ NGX 6 6 2NYB T9CA LDXC 0 A1+4(2) 2PD2 BCC T9D 2PXL LONGSET #14,TALS 2QC= BRN T9C 2QWW T9D JAMQUERY 6 [START UNJAMMER 2RBG T9C 2RW6 FREECORE 3 [OTHERWISE FREE BLOCK 2S*Q UP 2STB TALS GEOERR 1,LONGSET 2T*2 T9A MHUNTW 3,BSTB,EMPTYB 2TSL LDX 7 A1+1(3) [LOGICAL FILE NUMBER 2W#= GETBSLIS [FIND BLIST BLOCK X2 2W*5 ... FSHCODE B,XGETXA [ OMIT IF NOT IN MACHINE B 2W*Y ...( 2WBR ... LDXC 0 A1+4(2) 2WCL ... BCS XGETXA [ OMIT IF FOR SWAPFILE 2WDF ... LDX 6 A1(3) 2WF# ... SBN 6 3 [ NUMBER OF BLOCKS REQUESTED 2WG7 ... LDX 0 A1(2) [ NUMBER OF BLKS LEFT IN THIS LIST 2WH2 ... BNG 0 NOTNUFF [ J. TO SEE IF PRIV'D IF NEED TO WAIT 2WHT ... SBX 6 0 [ COMPARE WITH NO. OF BLKS LEFT 2WJN ... BNG 6 T9B [ J. IF ENOUGH LEFT ELSE 2WKH ...NOTNUFF 2WLB ... CALL 0 SWAITPRIV [ SEE IF PRIVILEGED 2WM9 ... BRN T9B [ IF NOT CAN GO 2WN4 ... TRANSBEG FSHBSID,FSHBSAL,3,BSTB,EMPTYB,ACOMMUNE3 [ ELSE MUST 2WNX ... UP [ GET REQUIRED BLOCKS FROM 'A' 2WPQ ...XGETXA 2WQK ...) 2WRW T9B LDN 6 2 2X?G T4 BXGE 6 A1(3),T3 [J WHEN ENOUGH BLOCKS OBTAINED 2XR6 LDX 4 A1(2) [POINTER IN BLIST 2Y=Q #SKI K6DRUMALL>449-449 2YQB TRACE 4,GLSTPTRG 2^=2 BNG 4 T1 [WAIT IF TRANSFER IN PROGRESS 2^PL SMO FX2 329= LDX 5 ACOMMUNE9 32NW LDX 0 A1+1(2) 338G BPZ 0 OKAY [OK IF SOME BLOCKS LEFT 33N6 LDXC 0 A1+4(2) 347Q BCS T52 [JUMP IF SWAP FILE 34G7 ... CALL 0 SWAITPRIV [ TEST FOR PRIVILEGED ACTIVITY 34SJ ... BRN T52 [ J. IF IT ISN'T 3572 OKAY BNZ 4 T2 [GET A BLOCK IF SOME FREE ONES LEFT 358C ... FSHCODE B,NOTINB1 [ OMIT IF NOT IN MACHINE 'B' 359S ...( 35?9 ... LDXC 0 A1+4(2) 35#L ... BCS NOTINB1 [ OMIT IF FOR SWAPFILE 35B3 ... CALL 1 XGET64BLKS [ GET 'FSHBSBLOCKS' BLOCKS FROM 'A' 35CD ... LDN 4 FSHBSBLOCKS [ RESET LIST POINTER 35DT ... HUNT 3,BSTB,EMPTYB [ RELOCATE /EMPTYB 35G= ... BRN T2 [ TO CONTINUE ALLOCATING BLOCKS 35HM ...NOTINB1 35K4 ...) 35LL LDX 4 BACK2(2) 366= BZE 4 T5 [J IF LAST BLOCKET 36KW BPZ 4 T6 [GET BLOCK IF SOME FREE ONES LEFT 375G T5 LDX 4 BSRLEN(2) 37K6 BPZ 4 T7 [ J IF MORE BS ELSEWHERE 384Q LDXC 0 A1+4(2) 38JB BCS T52 [JUMP IF SWAP FILE 3942 LDCT 0 #200 39HL SMO FX2 3=3= ANDX 0 CLONG1 [TEST FOR A PRIVILEGED ACTIVITY 3=GW BZE 0 T52 3?2G BSON EMSBIT,T53 3?#X ... MHUNTW 3,BSTB,EMPTYB [ 3?M# ... LDX 7 A1+1(3) [X7 => RESIDENCE NUMBER 3?^P ... TRACE 7,NO STORE [THESE FOUR SOURCE LINES 3##6 ... BRN T52 [REPLACE GEOERR NO STORE. 3#LH ...T53 GEOERR 1,FSRESFUL [REPLACES A GEOSTOP! 3#^2 T6 SBN 4 1 3*DL T7 STO 4 BACK2(2) [NEW BLOCKLET NUMBER 3*Y= NGN 4 1 3BCW STO 4 A1(2) [SET PTR -VE TO LOCK OUT EVERYTHING E 3BXG RT62 3CC6 LDX 3 2 [KEEP POINTER TO BLIST 3CWQ LDN 7 BSRLEN(2) 3DBB BACKREAD BSET,BSBS4,RT60,BACK1(3),BACK2(3),EX7 3DW2 STO 5 ACOMMUNE9(2) 3F*L FON 3 [WAKE UP ANYONE WAITING FOR THIS LIST 3FT= LDX 2 3 [RESTORE BLIST POINTER 3G#W HUNT 3,BSTB,EMPTYB 3GSG LDX 4 BSBS4 [SET POINTER FOR BLIST 3H#6 T2 SMO 4 3HRQ LDX 1 BSRLEN-1(2) [GET NEXT FREE BLOCK NUMBER 3J?B SMO 6 3JR2 STO 1 A1(3) [ADD TO EMPTYB 3JY8 ... FSHSKIP 3K5B ...( 3K=L BSOFF BSBITS,T41B 3KQ= STO 1 BSP4 3L9W CALL 0 Q1 3LFN ...) 3LPG T41B 3M96 #SKI K6DRUMALL>449-449 3MNQ TRACE 1,GBLKNOG 3N8B SBN 4 1 [REDUCE BLIST POINTER 3NN2 ADN 6 1 [INCREASE EMPTYB POINTER 3P7L STO 4 A1(2) [UPDATE BLIST POINTER 3P9T ... FSHCODE B,NOTCHEKA [ OMIT CHECK IF IN 'A' 3P#4 ...( 3PB? ... LDXC 0 A1+4(2) [ ELSE SEE IF THIS IS NOT A SWAPFILE 3PDG ... BCC NODECRINB [ DONT REDUCE BSFREE IF F/S RES 3PGP ...NOTCHEKA 3PJY ...) 3PM= LDN 0 1 3Q6W SBS 0 A1+1(2) [UPDATE NUMBER OF FREE BLOCKS 3QBN ...NODECRINB 3QLG BXU 1 BACK2(2),T41 [J IF NOT FREEING THIS BLOCK 3R66 STOZ A1(2) [ZEROISE POINTER AND BLOCKLET NUMBER 3RKQ NGS 0 BACK2(2) 3S5B T41 LDXC 0 A1+4(2) 3SK2 BCS T4 3T4L JAMQUERY [START UNJAMMER IF GETTING IN A JAM 3TJ= BRN T4 3W3W T3 NAME 3,BSTB,FULLB [RENAME EMPTYB 3WHG SMO FX2 3X36 LDX 5 ACOMMUNE9 3XGQ BZE 5 T35 [J IF %C OF WHATDOC NOT SPECIFIED 3Y2B UPPLUS 1 [MISS OUT BRN %C 3YG2 T35 3Y^L UP 3^F= # 3^YW QK12GET 423F ... FSHCODE B,NSHFSB [ CHECK IF MACHINE 'B' 4264 ...( 428M ... GEOERR 1,FREECOPY [ IF SO GEOERR AS COPYFILE ONLY 42?= ...NSHFSB [ ALLOWED IN MACHINE 'A' 42*T ...) 42DG MHUNTW 3,BSTB,FULLB 42Y6 LDX 7 A1+1(3) 43CQ GETBSLIS 43XB LDX 0 A1(3) 44C2 SBN 0 2 44WL SBS 0 BSCOPY(2) 45B= #SKI K6DRUMALL>199-199 45TW ( 46*G LDX 0 BSCOPY(2) 46T6 BPZ 0 T14B 47#Q GEOERR 1,BSCOPNEG 47SB T14B 48#2 ) 48RL BRN T14A 49?= T11 COOR3 3 49QW QK2GET [ENTRY FOR FREEBAX 4==G HUNT 3,BSTB,FULLB [FIND FULLB 4=Q6 LDX 7 A1+1(3) [LOGICAL FILE NUMBER 4?9Q GETBSLIS [FIND BLIST 4??F ... FSHCODE B,NMACHB [ OMIT IF NOT IN 'B' 4?*8 ...( 4?BX ... LDXC 0 A1+4(2) 4?DL ... BCS NMACHB [ OMIT IF FOR SWAPFILE 4?G* ... TRANSBEG FSHBSID,FSHBSAL,7,BSTB,FULLB,ACOMMUNE3 [ ELSE 4?J4 ... UP [ DO FREEBAX IN MACHINE 'A' 4?KR ...NMACHB 4?MG ...) 4?PB T14A LDN 6 2 4#92 T14 BXGE 6 A1(3),T13 [J WHEN ALL BLOCKS FREED 4#NL LDX 4 A1(2) [POINTER IN BLIST 4*8= #SKI K6DRUMALL>449-449 4*MW TRACE 4,FLSTPTRF 4B7G BNG 4 T11 [WAIT IF TRANSFER IN PROGRESS 4BM6 BZE 4 T12 [J IF BLIST EMPTY 4C6Q ADN 4 1 [INCREASE BLIST POINTER 4CLB BXU 4 BSBS41,T18 [J IF BLIST NOT YET FULL 4D62 NGN 4 1 4DKL STO 4 A1(2) [SET PTR -VE TO LOCK OUT EVERYTHING 4F5= LDX 3 2 [KEEP POINTER TO BLIST 4FJW LDN 7 BSRLEN(2) 4G4G BACKWRITE BSET,BSBS4,RT50,BACK1(3),,EX7 4GJ6 FON 3 [WAKE UP ANYONE WAITING FOR THIS LIST 4H3Q LDX 2 3 [RESTORE POINTER 4HHB HUNT 3,BSTB,FULLB 4J32 LDX 0 BACK2(2) 4JGL STO 0 BSRLEN(2) [KEEP BLOCKLET NUMBER OF BLIST 4K2= ADN 0 1 [INCREASE TO NEXT BLOCKLET 4KFW STO 0 BACK2(2) [CHANGE BLIST BLK NUMBER 4K^G LDX 5 0 [TEST IF RUNNING OVER BLOCK/SHEET 4LF6 LDX 4 BSSS 4LYQ LDXC 0 A1+4(2) 4MDB BCS S1 4MY2 LDX 4 BSBS 4NCL S1 SRL 4 7 4NX= DVS 4 4 4PBW LDX 0 4 4PWG LDN 4 1 4QB6 SMO 6 4QTQ LDX 5 A1(3) [BLOCK NO. OF BLOCK BEING FREED 4R*B BNZ 0 T15 [JUMP IF NOT OVER RUNNING 4RT2 T16 STO 5 BACK2(2) [MAKE BLIST BLK BLOCK TO BE FREED 4S#L ADN 4 1 [INCREASE POINTER 4SS= BRN T15 4T?W T12 SMO 6 4TRG LDX 5 A1(3) [BLOCK NUMBER 4W?6 LDN 4 1 4WQQ LDX 0 BACK2(2) 4X=B BNG 0 T16 [NEW HOME 4XQ2 BRN T15 4Y9L T18 SMO 6 4YP= LDX 5 A1(3) [BLOCK NUMBER 4YRT ...T15 BNG 5 (GEOERR) [GEOERR IF BLOCK NUMBER NEGATIVE 4YWD ... ANDN 5 3 [ 4Y^3 ... BNZ 5 (GEOERR) [BLOCKNUMBER MUST BE MULTIPLE OF 4 4^3L ... SMO 6 [ 4^69 ... LDX 5 A1(3) [ 4^C* ... SMO 4 4^NG STO 5 BSRLEN-1(2) [ADD FREED BLOCK NUMBER TO BLIST 5286 #SKI K6DRUMALL>449-449 52MQ TRACE 5,FBLKNOF 537B BSOFF BSBITS,T15B 53M2 STO 1 BSP4 546L LDX 1 5 [BLOCK NUMBER IN X5 54L= SLC 1 1 [B1=1 MARKS BLOCK AS FAILED 555W BPZ 1 T50AB [JUMP ROUND MACRO IF NOT SET 55KG STO 2 BSP5 [SAVE X2 55RQ ... STO 5 GEN0 [ SAVE BLOCK NO. FOR S/ROUTINE 5622 ... LDX 0 A1+1(3) 568= ... STO 0 GEN1 [ SAVE RES. NO. FOR S/ROUTINE 56BG ... CALL 7 SLOSBSBIT [ TO REMOVE FAILED ENTRY FROM /BFAIL 56JQ LDX 2 BSP5 [RESTORE X2 574B T50AB 579J ... FSHSKIP 57BQ ...( 57J2 LDX 1 5 [BLOCK NO 583L ORX 1 GSIGN [SET B0 TO MARK FREE 58H= CALL 0 Q1 58R4 ...) 592W T15B ADN 6 1 59GG STO 4 A1(2) [UPDATE BLIST POINTER 5=26 LDN 0 1 5=FQ ADS 0 A1+1(2) [UPDATE NUMBER OF FREE BLOCKS 5=^B BRN T14 5?F2 T13 LDXC 0 A1+4(2) 5?YL BCS T13A 5#D= FON 2 5#XW BRN T13B 5*CG T13A LONGON #14 5*X6 T13B NAME 3,BSTB,EMPTYB 5BBQ UP 5BWB QK3GET [WHATBACK : %A %B %C SPECIFIED 5CB2 STO 1 ACOMMUNE9(2) [SET AC9 -%C SPECIFIED 5CTL BRN T135 5D*= QK9GET [WHATBACK : %A %C SPECIFIED 5DSW STOZ ACOMMUNE9(2) [ZEROISE-%C NOT SPECIFIED 5F#G BRN T135 5FS6 QK7GET [WHATBACK : %B NOT SPEC 5G?Q STOZ ACOMMUNE8(2) [%B NOT SPECIFIED 5GRB STO 1 ACOMMUNE9(2) 5H?2 BRN T135 5HQL QK8GET [WHATBACK : %A ONLY 5J== STOZ ACOMMUNE8(2) 5JPW STOZ ACOMMUNE9(2) 5K9G T135 5K?9 ... FSHCODE B,NOTSHFSB [ OMIT IF NOT IN 'B' 5K#Y ...( 5KBM ... LDX 6 ACOMMUNE6(2) [ CHECK IF FOR SWAPFILE 5KDB ... BNG 6 SWAPFILE [ J. IF IT IS ELSE 5KG5 ... GEOERR 1,WHATBK ! [ GEOERR AS WHATBACK FORBIDDEN FOR 5KHS ...SWAPFILE [ F/S RESIDENCES 5KKH ...NOTSHFSB 5KM= ...) 5KP6 LDX 7 ACOMMUNE8(2) 5L8Q LDX 6 ACOMMUNE7(2) 5LNB NGN 4 1 5M82 STO 4 ACOMMUNE7(2) 5MML #SKI K6WHATBACK>6-6 5N7= ( 5NLW #SKI K6WHATBACK>499-499 5P2T ... TRACE 7,WHATBACK 5PBS ... BNG 7 WRONG [CHECK PARAMETERS POSITIVE OR ZERO 5PQR ... BNG 6 WRONG 5Q6Q ... SBN 6 10 5QGP ... SBN 7 512 5QWN ... BPZ 6 WRONG [CHECK PARAMETERS SMALL 5R=M ... BNG 7 RIGHT 5RLL ...WRONG 5S2K ... GEOERR BRIEFPM,WHATBACK 5SBJ ...RIGHT 5SQH ... ADN 7 512 [RESTORE PARAMETERS 5T6G ... ADN 6 10 5TGF ...) 5TWD ... LDX 3 7 5W=C ... SETNCORE 2(3),2,BSTB,EMPTYB [GETCORE FOR BSTB,FULLB 5W=Q ...#UNS FSHTEST [ OMIT STANDARD ALGORITHM CALL IN 5W?5 ...#SKI 5W?D ...( [ TESTING ENVIRONMENT 5W?W ...#UNS JPABSA3 5W** ...( 5WBS ... SEGENTRY K80GETBAX [ ABSA MACRO MENDS HERE 5WD? ... CALL 5 QK82GETBAX [STANDARD BS ALLOCATOR 5WFQ ...) 5WH9 ...#UNS JPABSA3 5WJN ...#SKI 5WLB ... CALL 5 RUM [FILE ALLOCATOR 5WP* ...) 5WS# ...#UNS FSHTEST [ ALWAYS USE ABSA IN 5WX? ... CALL 5 RUM [ TESTING ENVIRONMENT 5X2* ... MHUNT 1,BSTB,EMPTYB 5XB# ... LDX 3 ALOGLEN(1) 5XQ? ... STO 3 A1(1) [RECORD HEADER 5Y6= ... LDX 3 BACK1(2) 5YG9 ... STO 3 A1+1(1) [LOGICAL FILE NUMBER 5YW8 ... BZE 7 NOBACK [NO BLOCKS REQUIRED 5^=7 ... LDX 2 FX2 5^L6 ... BRN T9 [GET SOME BLOCKS 6225 ...NOBACK 62B4 ... LDX 3 1 62Q3 ... BRN T3 62R9 ...#UNS JPABSA3 62SC ... SEGENTRY K83GETBAX [ ABSA IP 62TK ... NULL 62WR ... NULL 62X^ ... BRN RUM 62^7 ... SEGENTRY K81GETBAX [ ABSA ON 632* ... LDN 0 165 633H ... LDN 1 3 634P ...) 6362 ...RUM 637F ...#UNS JPABSA3 638Y ...( 63=C ... STO 0 GEN0 63?W ... STO 1 GEN1 63#K ... STOZ GEN2 [ INDICATE FIRST PASS 63** ...) 63BS ...#UNS JPABSA3 63D? ...#SKI 63F^ ...#SKI JPABSA 63TY ...( 649X ...# THIS OPTION IMPLEMENTS THE FOLLOWING FILESTORE ALLOCATION ALGORITH 64KW ...# IDEAL LETHARGY := IF *DA ! THEN 0 ELSE IF SERIAL ! THE 2 ELSE 4 64^T ...# SUITABLITY := FRACTION OF RESIDENCE FILED AFTER ALLOC 65*S ...# +MISMATCH OF LETHARY WITH IDEAL 65PR ... SBN 6 7 665Q ... LDX 1 FX2 66FP ... BPZ 6 WRK [NEG FOR NON ! WHATBACK 66TN ... LDXC 6 ACOMMUNE6(1) [19SEPT 679M ... LDN 6 0 [SO SET TO ZERO 67KL ... SLL 6 1 67^K ...WRK SBN 6 2 68*J ... SLL 6 1 [X6 := IDEAL LETHARGY 68PH ... LDN 4 0 [INITIAL POINTER TO BEST RESIDENCE 695G ... NGS 6 A1+1(2) [GOES IN BSTS,EMPTYB 69FF ...XTRY LDN 3 BMISC [FOR TJ3 SUBROUTINE 69TD ... LDX 1 FX2 6=9C ...WLOOP CALL 0 TJ3 [FIND A RESIDENCE OF RIGHT SORT 6=FB ... BRN XFUL [ICL'S TFIN 6=P* ... SMO GEN2 6=^* ... LDX 0 A1+1(3) [FREESPACE IN RESIDENCE 6?*# ... SBX 0 ACOMMUNE8(1) [AMOUNT REQUIRED 6?P? ... BNG 0 WLOOP [WON'T FIT IN THIS RESIDENCE 6#5= ... LDX 0 A1+3(3) [SIZE OF RESIDENCE 6#F9 ... ADX 0 ACOMMUNE8(1) [ADD AMOUNT REQUIRED 6#T8 ... SBX 0 A1+1(3) [SUBTRACT FREE, X0 := NEW TOTAL OCCUP 6*97 ... LDN 7 0 6*K6 ... SLA 70 9 [CONV TO DOUBLE AND * 2^9 6*^5 ... DVR 7 A1+3(3) [DIVIDE BY SIZE TO GET NEW FRACTION O 6B*4 ...# THIS CAN BE UP TO 2 IN MAGNITUDE BECAUSE RESIDENCE MAY BECOME OVER 6BP3 ... LDEX 7 A1+4(3) [LETHARGE - LOSE TOP BIT (SWAP) 6C52 ... LDX 6 0 [CLEAR C KEEP X0 6CD^ ... BNZ 7 NOTED60 6CGY ...#UNS JPABSA3 6CJX ... LDX 7 GEN1 6CLW ...#UNS JPABSA3 6CNT ...#SKI 6CQS ...( 6CSY ... SMO FX1 6D8X ... LDX 7 FACTORLDS+1 6DBW ...) 6DJW ...NOTED60 6DYT ... SBX 7 A1+1(2) [SUBTRACT IDEAL LETHARGY 6F#S ... SLL 7 9 [JUSTIFY WITH FRACTION OCCUPIED ALG 6FNR ...# THERE IS SCOPE FOR CHANGING THE VALUE OF THIS SHIFT 6G4Q ...# IT DEFINES THE RELATIVE PENALTIES OF OVERFULL RESIDENCE 6GDP ...# AND NON-IDEAL LETHARGY 6GSN ... BPZ 7 XABS 6H8M ... NGX 7 7 [MAKE POSITIVE 6HJL ...XABS ADX 0 7 [X0 := LETHARGE MISMATCH + FRACTION O 6HLK ...#UNS JPABSA3 6HNJ ... MPY 6 GEN0 6HQH ...#UNS JPABSA3 6HSG ...#SKI 6HWF ...( 6HYK ... SMO FX1 6J#J ... MPY 6 FACTORLDS 6JGH ...) 6JNH ... SRA 67 9 [DIV BACK THE 2^9 6K4G ... SBX 7 BSJAM [COMPARE WITH BACKJAM 6KDF ... NGX 7 7 6KSD ... SRL 7 13 [X7:=3 IF BSJAM DUE 6L8C ... ADX 7 0 [ADD 3 TO SUITABILITY IF SO 6LJB ... [WILL ENSUE 6LY* ... TXL 7 ACOMMUNE7(1) 6M## ... BCC WLOOP [J IF NOT BEST SO FAR 6MN? ... STO 7 ACOMMUNE7(1) 6N4= ... LDX 4 3 [POINTER OF RES 6ND9 ... BRN WLOOP 6NDH ...XFUL LDX 7 ACOMMUNE8(1) 6NDT ... BNZ 4 TFIN [ SUITABLE FILE FOUND 6NF7 ... LDX 0 GEN2 [ WHICH PASS? 6NFF ... BZE 0 RETRY [ JUMP IF FIRST 6NFR ... GEOERR BRIEFPM,ABSAFAIL 6NG5 ...RETRY LDN 0 2 [ INDICATE SECOND PASS 6NGC ... STO 0 GEN2 6NGP ... BRN XTRY [ GO FOR SECUND PASS 6NH8 ...#UNS JPABSA3 6NL7 ...#SKI 6NP6 ...( 6NS8 ... SEGENTRY FACTORLDS 6P87 ... 165,3 6PB6 ...) 6PJ6 ...) 6PN5 ...#UNS JPABSA3 6PS4 ...#SKI 6PY5 ...#SKI JPABSA<1$1 6Q#4 ...( 6QD3 ...#UNS JPABSA3 6QGN ... SEGENTRY K82GETBAX [ ABSA OFF 6QK* ...QK82GETBAX 6QL2 ...#UNS FSHTEST [LEAVE OUT STANDARD ALGORITHM IN SHARED 6QLM ...#SKI [FILESTORE TESTING ENVIRON TO MAKE ROOM 6QM# ...( [FOR BOTH M/C CODE I.E.MUST USE 'ABSA' 6QN3 ... LDN 1 0 6R42 ... STOZ A1+1(2) 6RC^ ... LDN 3 BMISC 6RRY ...TJ14 CALL 0 TJ3 [LOOK FOR A BSTB/BSLIST BLOCK 6S7X ... BRN TNOM [BRANCH IF NO MORE 6SHW ... ADX 1 A1+3(3) [TOTAL AVAILABLE SPACE 6SXT ... LDX 0 A1+1(3) 6T?S ... ADS 0 A1+1(2) [AMOUNT OF FREESPACE LEFT 6TMR ... LDX 4 3 6W3Q ... BRN TJ14 6WCP ...TNOM 6WRN ...#SKIP K6WHATBACK>3-3 6X7M ...( 6XHL ... BNZ 1 TJ8 6XXK ... GEOERR 1,NO BLIST [NO BSTB/BSLIST BLOCKS 6Y?J ...) 6YMH ...# THE FOLLOWING LOCATION CONTAINS THE OPTIMUM NUMBER OF FILES 6^3G ...# PER LOGICAL FILE. THIS VALUE MAY BE CHANGED AT THE INSTALLATION 6^CF ...# MANAGERS DISCRETION AT RESTORE TIME WITH THE MACRO NOFILES. 6^RD ...# 727C ... SEGENTRY INOF 72HB ... +200 72X* ... SEGENTRY INOFA 73?# ... +10 73M? ...# 743= ...# THE FOLLOWING LOCATION CONTAINS A ROUNDING FACTOR USED IN THE 74C9 ...# ALGORITHM THAT DECIDES WHICH IS THE MOST SUITABLE LOGICAL FILE 74R8 ...# FOR A FILE TO GO ON.THIS VALUE MAY BE CHANGED AT RESTORE TIME 7577 ...# BY THE MACRO NOFILES.THE CURRENT VALUE WILL WORK ON ALL 75H6 ...# INSTALLATIONS WHERE THE MAXIMUM LOGICAL FILE SIZE IS LESS THAN 75X5 ...# 32 MILLION WORDS.ON AN INSTALLATION WHERE THE MAXIMUM LOGICAL 76?4 ...# FILE SIZE IS LARGER,THE ROUNDING FACTOR MUST BE ROUNDED DOWN 76M3 ...# BY THE NUMBER OF TIMES THAT THE LARGEST LOGICAL FILE IS GREATER 7732 ...# THAN 32 MILLION WORDS,ROUNDED UP 77B^ ...# 77QY ... SEGENTRY FACTOR 786X ... +128 78GW ...# 78WT ...TJ8 STO 1 A1(2) 79=S ... LDN 4 0 [INITIALISE POINTER TO MOST SUITABLE 79LR ... [BSLIST BLOCK 7=2Q ...TJ4 CALL 0 TJ3 [FIND NEXT BSLIST BLOCK 7=BP ... BRN TNMO [JUMP IF NO MORE BSLIST BLOCKS 7=QN ... LDX 0 A1+1(3) [LOAD FREE SPACE LEFT ON LOGICAL FILE 7?6M ... SBX 0 7 [SUBTRACT FILE SIZE REQUIRED 7?GL ... BNG 0 TJ4 [JUMP IF NO ROOM ON THIS LOGICAL FILE 7?WK ... LDX 1 FX1 7#=J ... MPY 7 FACTOR(1) [MULTIPLY BY ROUNDING FACTOR 7#LH ... LDX 7 0 7*2G ... LDXC 6 A1+4(3) 7*BF ... BCS R8 7*QD ... MPY 7 INOF(1) [MULTIPLY BY OPTIMUM NO OF FILES 7B6C ... BRN R9 7BGB ...R8 MPY 7 INOFA(1) 7BW* ...R9 7C=# ... DVD 7 A1+3(3) [DIVIDE BY LOGICAL FILE SIZE 7CL? ... SBX 0 FACTOR(1) [SUBTRACT ROUNDING FACTOR 7D2= ... BPZ 0 R7 [JUMP IF RESULT POSITIVE 7DB9 ... NGX 0 0 [MAKE POSITIVE 7DQ8 ...R7 LDX 6 A1+3(3) [LOAD LOGICAL FILE SIZE 7F67 ... MPY 6 FACTOR(1) [MULTIPLY BY ROUNDING FACTOR 7FG6 ... LDX 6 7 7FW5 ... MPY 6 A1+1(2) [MULTIPLY BY TOTAL FREE SPACE 7G=4 ... DVD 6 A1(2) [DIVIDE BY TOTAL AVAILABLE SPACE 7GL3 ... DVS 6 A1+1(3) [DIVIDE BY FREE SPACE ON LOG FILE 7H22 ... ADX 7 0 [ADD TWO PARTS OF ALGORITHM 7H*^ ... LDX 1 FX2 7HPY ... TXL 7 ACOMMUNE7(1) [JUMP IF THIS LOGICAL FILE IS NOT 7J5X ... BCC TJ5 [MORE SUITABLE 7JFW ... STO 7 ACOMMUNE7(1) [STORE SUITABILITY 7JTT ... LDX 4 3 [SET POINTER TO BSLIST BLOCK 7K9S ...TJ5 LDX 7 ACOMMUNE8(1) [RESET REQUIRED FILE SIZE 7KKR ... BRN TJ4 7K^Q ...TNMO BNZ 4 TFIN [JUMP IF A SUITABLE IF HAS BEEN FOUND 7L*P ... LDX 1 FX2 7LPN ...R3 CALL 0 TJ3 [FIND NEXT BSLIST BLOCK 7M5M ... BRN TNMORE [JUMP IF THERE ARE NO MORE 7MFL ... LDX 0 A1+3(3) [LOAD LOGICAL FILE SIZE 7MTK ... SBX 0 7 [SUBTRACT REQUIRED SIZE 7N9J ... BNG 0 R3 [JUMP IF FILE BIGGER THAN LF 7NKH ... LDX 7 A1+3(3) [LOAD LOGICAL FILE SIZE 7N^G ... DVS 6 ACOMMUNE8(1) [DIVIDE BY REQUIRED FILE SIZE 7P*F ... LDXC 0 A1+4(3) 7PPD ... BCS R10 7Q5C ... SMO FX1 [SUBTRACT OPTIMUM NO OF FILES PER 7QFB ... SBX 7 INOF [LOGICAL FILE 7QT* ... BRN R11 7R9# ...R10 SMO FX1 7RK? ... SBX 7 INOFA 7R^= ...R11 7S*9 ... BPZ 7 R4 [JUMP IF POSITIVE RESULT 7SP8 ... NGX 7 7 7T57 ...R4 TXL 7 ACOMMUNE7(1) [STORE SUITABILITY 7TF6 ... BCC R3 [MORE SUITABLE 7TT5 ... STO 7 ACOMMUNE7(1) [STORE SUITABILITY 7W94 ... LDX 4 3 [POINTER TO MOST SUITABLE BSLIST 7WK3 ... BRN R3 7W^2 ...) 7X#^ ...TNMORE LDX 7 ACOMMUNE8(1) 7XNY ... BNZ 4 TFIN [JUMP IF SUITABLE LOGICAL FILE FOUND 7Y4X ... GEOERR BRIEFPM,WON'TFIT [THIS FILE IS BIGGER THAN ALL LF'S 7Y7W ...) 7Y=T ...# THIS CODE IS COMMON TO BOTH ALLOCATION ALGORITHMS 7Y*S ...# 7YDW ...TFIN LDX 2 4 7YST ...# 7^8S ...#SKIP K6WHATBACK>599-599 7^JR ... TRACE BACK1(2),THISBACK 7^YQ ... NGX 1 ACOMMUNE8(1) 82#P ... ADX 1 A1+1(2) [X1=FREE SPACE LEFT AFTER ALLOCATION 82NN ... LDX 6 5 [REMEMBER LINK 834M ... LDXC 0 A1+4(2) 83DL ... BCS TJ30 83SK ... JAMQUERY 1 [START UNJAMMER IF REQUIRED 848J ...TJ30 EXIT 6 0 84JH ...TJ6 84YG ...TJ3 LDX 3 0(3) [FIND BSTB/BSLIST BLOCK SUBROUTINE 85#F ... TXU 3 CXMI 85ND ... BCC TJ9 864C ... LDX 6 ATYPE(3) 86DB ... SRL 6 12 86S* ... SBN 6 BSTB+BSLIST 878# ... BNZ 6 TJ3 87J? ... LDCT 6 #400 [CHECK IF RIGHT TYPE OF FILE 1J.E 87Y= ... ANDX 6 A1+4(3) [SWAP OR FILESTORE 88#9 ... SMO FX2 88N8 ... ERX 6 ACOMMUNE6 8947 ... BNZ 6 TJ3 89D6 ... LDX 6 BACK1(3) [CHECK IF RESERVED LF 89S5 ... SMO FX1 8=84 ... TXL 6 XAL 8=J3 ... BCC TJ3 [IGNORE IF IT IS 8=JP ...#UNS ANOTALLOC 8=KC ...( 8=L5 ...# 8=LR ... FIXTRA K100GETBAX 8=MF ... BRN TJ9A 8=N7 ...# 8=NT ... LDCT 6 #200 [IGNORE BSLIST BLOCK IF %E (ACOMMUNES 8=PH ... ANDX 6 A1+4(3) [PRESENT AND BIT 1 OF BSLETH (BSMARK) 8=Q9 ... BZE 6 TJ9A 8=QX ... SMO FX2 [SET 8=RK ... ERX 6 ACOMMUNE5 8=S? ... BZE 6 TJ3 8=S^ ...TJ9A 8=TM ...# 8=W* ... FIXTRA K101GETBAX 8=X3 ...) 8=Y2 ... EXIT 0 1 [X3=ADDRESS OF BSTB/BSLIST 8??^ ...TJ9 EXIT 0 0 [NO MORE? 8?MY ...XAL +48 [LFN OF FIRST RESERVED FILE 8#3X ...QK5GET 8#CW ... LDX 7 ACOMMUNE7(2) [PICK UP SIZE REQUIRED 8#RT ...#SKIP K6WHATBACK>3-3 8*7S ...( 8*HR ... SBX 7 BSBS 8*XQ ... SBN 7 1 8B?P ... BNG 7 TJ12 8BMN ... GEOERR 1,SIZE2BIG [GREATER THAN ONE BSBS 8C3M ...TJ12 LDX 7 ACOMMUNE7(2) 8CCL ...) 8CRK ... GETCORE 7,1 [GET A CORE BLOCK 8D7J ... LDN 7 0 [INITIALIZE SIZE 8DHH ... STOZ ACOMMUNE6(2) [MARKER FOR FILESTORE 8DXG ... LDN 3 BMISC 8F?F ...TJ12B CALL 0 TJ3 [FIND A LIST 8FMD ... BRN TJ12A [NO MORE LISTS 8G3C ... LDX 0 BSFREE(3) 8GCB ... ADX 0 BSRESERVE(3) 8GR* ... TXL 7 0 8H7# ... BCC TJ12B [JUMP IF SMALLER THAN ONE REMEMERED 8HH? ... LDX 7 0 8HX= ... LDX 4 BACK1(3) [L.F.N 8J?9 ... BRN TJ12B 8JM8 ...TJ12A BNZ 7 TJ12C 8K37 ... GEOERR 1,NOFILE 8KC6 ...TJ12C GETBACK 4 8KR5 ... LDX 7 ACOMMUNE7(2) 8L74 ... HUNT 2,GCB [X2-> CORE BLOCK 8LH3 ... STO 4 BACK1(2) [L.F.N. 8LX2 ... STO 7 BACK2(2) [STORE NUMBER 8M=^ ... UP 8MLY ...# 8N2X ...# BACKREAD FAILURE 8NBW ...RT60 LDX 7 BACK1(3) 8NQT ... STO 7 ACOMMUNE1(2) [L.F.N 8P6S ... STO 6 ACOMMUNE3(2) 8PGR ... STO 5 ACOMMUNE2(2) 8PWQ ... ACROSS BSALFAIL,1 8Q=P ...# 8QLN ...# BACKWRITE FAILURE 8R2M ...RT50 8RBL ... LDX 7 BACK1(3) 8RQK ... STO 7 ACOMMUNE1(2) 8S6J ... NGN 5 1 8SGH ... STO 5 ACOMMUNE3(2) 8SWG ... MHUNT 3,BSTB,FULLB 8T=F ... SMO 6 8TLD ... LDX 0 A1(3) 8W2C ... STO 0 ACOMMUNE2(2) 8WBB ... ADN 6 1 8WQ* ... STO 6 ACOMMUNE4(2) 8X6# ... ACROSS BSALFAIL,3 8XMQ QK10GET 8Y7B LDX 6 ACOMMUNE4(2) 8YM2 MHUNT 3,BSTB,FULLB 8^6L LDX 7 A1+1(3) 8^L= GETBSLIS 925W BRN T14 92KG QK11GET 9356 LDX 6 ACOMMUNE3(2) [RETURN FROM READ FAILURE 93JQ LDX 0 ACOMMUNE2(2) 944B STO 0 ACOMMUNE9(2) 94J2 MHUNT 3,BSTB,EMPTYB 953L LDX 7 A1+1(3) 95H= GETBSLIS 962W BRN T4 ?P8# ... FSHSKIP ?P*G ...( ?PGQ # THIS ROUTINE IS A TESTING AID FOR THE BS ALLOCATION SYSTEM WHICH ?Q2B # WILL SET A BIT IF A BLOCK IS FREED, CHECKING THAT IT IS NOT ?QG2 # ALREADY SET, AND UNSETTING IT IF A BLOCK IS GIVEN AWAY, SIMILARLY ?Q^L # CHECKING THAT IT IS NOT ALREADY UNSET. THE BITS CONCERNED WILL ?RF= # BE SITUATED IN THE WORDS FOLLOWING THE LIST OF FREE BLOCK NOS. ?RYW # THERE WILL BE ONE BIT FOR EACH GEORGE BLOCK WITHIN EACH LOGICAL ?SDG # FILE, THE BITS REFERRING TO THE BLOCK NO. CORRESPONDING TO THE ?SY6 # POSITION OF THE BIT RELATIVE TO THE BEGINNING OF THIS AREA. ?TCQ # E.G. BLOCK NO. 50 WILL BE REPRESENTED BY B2 OF WORD 2 OF THE AREA ?TXB Q1 STO 2 BSP5 [BSLIST PTR ?WC2 STO 3 BSP6 ?WWL LDX 3 1 [X1=BLOCK NO. ?XB= BPZ 3 Q2 ?XTW ERX 3 GSIGN [DROP SIGN BIT ?Y*G Q2 LDX 2 A1+4(2) ?YT6 BPZ 2 Q2A [JUMP IF NOT A SWAP FILE ?^#Q LDX 2 BSSS ?^SB BRN Q2B #2#2 Q2A LDX 2 BSBS #2RL Q2B SRL 2 7 #3?= DVS 2 2 [X3 CONTAINS ACTUAL BLOCK/SHIFT NO. #3QW SMO BSP5 #4=G TXL 3 A1+3 [TEST IF VALID BLOCK NUMBER #4Q6 BCS Q4 #59Q GEOERR 1,BLKTOB1G #5PB Q4 LDN 2 24 #692 DVS 2 2 [CONVERT TO WORD/BIT MODIFIER #6NL STO 1 BSL1 #78= LDX 1 GSIGN [B0 ONLY #7MW SRL 1 0(2) [SET BIT IN CORRECT POSITION #87G STO 2 BSL2 #8M6 LDX 2 BSL1 #96Q BNG 2 Q3 [ J IF BIT IS TO BE SET #9LB NGN 2 1 #=62 ERX 1 2 [INVERT BIT PATTERN TO UNSET BIT #=KL # NOW X1=111...11011...11 IE ONLY ONE BIT IS UNSET #?5= SMO BSP5 #?JW LDX 2 BSCHLEN(3) ##4G SMO BSL2 ##J6 SLL 2 0 #*3Q BNG 2 Q5 [J IF BLOCK IS FREE IE ALLOCATABLE #*HB GEOERR 1,GIVEGIVE [ATTEMPT TO GIVE BLOCK TWICE #B32 Q5 SMO BSP5 #BGL ANDS 1 BSCHLEN(3) [UNSET BIT TO MARK BLOCK ISED #C2= BRN Q7 #CFW Q3 SMO BSP5 #C^G LDX 2 BSCHLEN(3) #DF6 SMO BSL2 #DYQ SLL 2 0 #FDB BPZ 2 Q6 [J IF BLOCK NOT FREE ALREADY #FY2 GEOERR 1,FREEFREE [ATTEMPT TO FREE AN ALREADY FREED BLK #GCL Q6 SMO BSP5 #GX= ORS 1 BSCHLEN(3) [SET BIT TO MARK BLOCK FREE #HBW Q7 LDX 1 BSP4 #HWG LDX 2 BSP5 #JB6 LDX 3 BSP6 #JTQ EXIT 0 0 #JW6 ...) #JWG ... FSHCODE AORB #JWW ...( #JX= ...[ #JXL ...[ SUBROUTINE TO GET 'FSHBSBLOCKS' BLOCKS FROM MACHINE 'A' #JY2 ...[ #JYB ...XGET64BLKS #JYQ ... SBX 1 FX1 [ RELATIVISE LINK #J^6 ... SMO FX2 #J^G ... STO 1 AWORK2 [ PRESERVE LINK #J^W ... SMO FX2 #K2= ... STO 6 AWORK3 [ PRESERVE X6 (PTR. DOWN EMPTYB) #K2L ... LDX 4 BACK1(2) [ GET RESIDENCE NO. #K32 ... NGS 2 A1(2) [ SET 'BSPOI' -VE TO LOCK OUT OTH #K3B ... LDX 2 FX2 [ STORE RES. NO. FOR USE IN "A" #K3Q ... STO 4 ACOMMUNE8(2) [ AND GET 'FSHBSBLOCKS' BLOCKS FROM A #K46 ... TRANSBEG FSHBSID,FSHBSAL,4,NOBLOCKS,,ACOMMUNE3 #K4G ... GETBSLIS [ BLOCKS FROM MACHIONE 'A' #K4W ... MHUNT 3,BSTB,FULLB [ FIND LIST OF BLOCKS OBTAINED #K5= ... LDN 7 FSHBSBLOCKS [ NO OF NUMBERS TO BE 'MOVED' #K5L ...PUTNXTIN #K62 ... LDX 0 A1+2(3) [ NXT BLOCK NO FROM /FULLB #K6B ... SMO 7 #K6Q ... STO 0 BSRLEN-1(2) [ STORE BLOCK NO IN /BSLIST #K76 ... ADN 3 1 [ INCREMENT /FULLB POINTER #K7G ... BCT 7 PUTNXTIN [ DECR. /BSLIST POINTER #K7W ... MHUNTW 3,BSTB,FULLB [ RE-LOCATE /FULLB #K8= ... LDX 7 A1+1(3) [ GET RES. NO. FOR 'GETBSLIS' #K8L ... FREECORE 3 [ FREE /FULLB OBTAINED FROM 'A' #K92 ... FON 3 [ WAKE UP WAITERS #K9B ... LDX 6 AWORK3(2) [ RECOVER POINTER DOWN /EMPTYB #K9Q ... GETBSLIS [ RECOVER POINTER TO /BSLIST BLOCK #K=6 ... SMO FX2 #K=G ... LDX 1 AWORK2 [ RECOVER LINK #K=W ... ADX 1 FX1 #K?= ... EXIT 1 0 #K?L ...) #K#2 ...[ #K#B ... #PQ2 MENDAREA 50,K99GETBAX #Q9L # #QP= #END ^^^^ ...444547360003