{{htmlmetatags>metatag-description:(ICL George 3 and George 4 source: GETBAX865)}}
====== GETBAX865 ======
(George Source)
**Macros used:** [[george:macro:ACROSS|ACROSS]], [[george:macro:BACKREAD|BACKREAD]], [[george:macro:BACKWRITE|BACKWRITE]], [[george:macro:BSOFF|BSOFF]], [[george:macro:BSON|BSON]], [[george:macro:BXGE|BXGE]], [[george:macro:BXU|BXU]], [[george:macro:COOR3|COOR3]], [[george:macro:FIXTRA|FIXTRA]], [[george:macro:FON|FON]], [[george:macro:FREECORE|FREECORE]], [[george:macro:FSHCODE|FSHCODE]], [[george:macro:FSHSKIP|FSHSKIP]], [[george:macro:FSHTEST|FSHTEST]], [[george:macro:GEOERR|GEOERR]], [[george:macro:GETBACK|GETBACK]], [[george:macro:GETBSLIS|GETBSLIS]], [[george:macro:GETCORE|GETCORE]], [[george:macro:HUNT|HUNT]], [[george:macro:JAMQUERY|JAMQUERY]], [[george:macro:LONGON|LONGON]], [[george:macro:LONGSET|LONGSET]], [[george:macro:LOSBSBIT|LOSBSBIT]], [[george:macro:MENDAREA|MENDAREA]], [[george:macro:MHUNT|MHUNT]], [[george:macro:MHUNTW|MHUNTW]], [[george:macro:NAME|NAME]], [[george:macro:RIGHT|RIGHT]], [[george:macro:SEGENTRY|SEGENTRY]], [[george:macro:SETNCORE|SETNCORE]], [[george:macro:TRACE|TRACE]], [[george:macro:TRANSBEG|TRANSBEG]], [[george:macro:UP|UP]], [[george:macro:UPPLUS|UPPLUS]], [[george:macro:WAITPRIV|WAITPRIV]], [[george:macro:WRONG|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