(George Source)
Macros used: ACROSS, ADJUSTLK, ALTLEN, BC, BSOFF, BSON, BXE, BXGE, BXL, BXU, CHAIN, COBJUNUSE, COOR3, COOR3X, FINDCORE, FIXTRA, FON, FREZKICK, GEOERR, JBS, LABFIX, LONGON1, NAME, ON, SEGENTRY, SQOSS, SQUMP2, TRACE, TRACEDP, TRANSFIX
22FL ...#SEG COREALL [DEK BEASLEY : CENT 22^= #OPT K0COREALL=0 23DW #LIS K0COREALL>K0KERNEL>K0ALLGEO 23YG #OPT K6COREALL=K6KERNEL>K6ALLGEO 24D6 #DEF SPLITLEN=CSPLIT 24XQ #DEF NAFRA=CNAFRA 25CB #DEF NCHLI=CNCHLI 25X2 #DEF SPCHL=CSPCHL 26BL #DEF WAIT=CWAIT 26W= #DEF XJCHAPLOW=CJTHRESH3<#7777 27*W #DEF TRACE=K6COREALL 27TG [ 28*6 [CORE STORE ALLOCATION ROUTINES 28SQ [ 28TP ...#SKI K6COREALL 28WN ...( 28XM ...[THIS SUBROUTINE CHECKS THAT THE BLOCK SPECIFIED IN X1 IS CHAINED 28YL ...[CORRECTLY.IF NOT IT BRANCHES TO LABEL SILL TO GEOERR FREECORE. 28^5 ... LABFIX CHECKCHN 28^K ...XCHECKCHN 292J ... SMO FPTR(1) [ILLEGAL IF IMPROPERLY CHAINED 293H ... TXU 1 BPTR 294G ... BCS XBADCHAIN 295F ... SMO BPTR(1) 296D ... TXU 1 FPTR 297C ... BCS XBADCHAIN 298B ... EXIT 0 0 299* ...XBADCHAIN 29=# ... GEOERR 1,BADCHAIN 29?? ...) 29#B [ 29S2 [ 2=?L [THIS ROUTINE FREES THE BLOCK OF CORE SPECIFIED IN X1 RECHAINING IT IN 2=R= [ITS APPROPRIATE POSITION IN THE FREECORE CHAIN IF ANY ACTIVITIES ARE 2?=W [WAITING FOR CORE THEY ARE WOKEN UP THE TOTAL AMOUNT OF FREE CORE 2?QG [CURRENTLY AVAILABLE IS UPDATED 2#=6 [ 2#FY ... FIXTRA K1COREALL 2#PQ LABFIX HNFREE 2*9B NFREE STO 0 GL2 [REMEMBER LINK 2*P2 #SKI K6COREALL>699-699 2B8L TRACE 1,FREECORE 2BN= #SKI K6COREALL 2C7W ( 2CMG ... CALL 0 XCHECKCHN [CHECK BLOCK IN X1 CHAINED OK. 2GK= LDX 0 ATYPE(1) [FREED BLOCK TYPE 2H4W TXL 0 ACTY [TEST NOT ACTIVITY OR QBLOCK 2HJG BCS NJH1 2J46 LDX 0 BACKCHAN(1) [THAT IS STILL ON A LIST 2JHQ BZE 0 NJH1 2K3B ...SILL GEOERR 1,FREECORE 2KH2 NJH1 2L2L ) 2LG= STO 1 NAFRA [REMEMBER ADDRESS OF BLOCK TO FREE 2L^W LDX 0 WAIT [LOAD SWITCH SHOWING IF ANY ACTS ARE 2MFG ... BZE 0 NOWA1 [WAITING FOR CORE J IF NONE 2M^6 FON 1 [WAKE UP ALL ACTIVITIES WAITING CORE 2NDQ STOZ WAIT [SET SWITCH NONE NOW WAITING 2NG8 ...#SKI G4 2NHM ...NOWA1 2NLJ ...#UNS G4VOPA 2NPF ...( 2NSB ...#SKI G4 2NX? ...( 2P28 ... LDX 0 COBJFAIL 2P55 ... BZE 0 NOWA 2P82 ... LDX 0 COBJWAIT 2P=X ... BZE 0 NOWA [IF APPROPRIVATE 2P*S ... FON #105 [WAKE ACTS. WAITING FOR PROGRAM CORE 2PDP ... STOZ COBJWAIT [SET SWITCH NON NOW WAITING 2PHL ...) 2PLH ...) 2PPD ...NOWA LDX 1 NAFRA [RELOAD BLOCK S A 2Q2R ...#SKI G3 2Q#6 ...NOWA1 2QKF ... LDX 2 ARINGNO(1) 2QWW ANDX 2 BSP16 2RBG BZE 2 NRN [JUMP IF NONE 2RL# ... LDX 0 ATYPE(1) [J IF ADATA/FPSEUD BLOCK - MAY BE 8 2RW6 ... BXE 0 FPSEUTYP,NRN [ WDS ONLY 2S5Y ... LDX 0 ARINGNO(1) 2S*Q SRL 0 15 [ISOLATE NUMBER OF RINGS 2STB STO 0 ARINGLEN [REMEMBER NUMBER 2T*2 ADN 1 ARINGNO+1 2TSL NXT LDX 0 BPTR(1) 2W#= BZE 0 SNOOR 2WRW CALL 0 NDECH 2X?G SNOOR ADX 1 ARINGLEN [INCREMENT FOR NEXT RING 2XR6 BCT 2 NXT 2Y=Q LDX 1 NAFRA [RESTORE START ADDRESS 2YQB NRN CALL 0 NDECH [DECHAIN BLOCK 2^=2 N21X [ ENTRY FROM BCOPY AND LOCKC 2^PL STO 1 NAFRA 329= LDX 2 ASIZE(1) [ BLOCK SIZE 32NW LDN 0 2 [ MASK FOR BIT 22, THE 'FROZEN' BIT 338G ANDX 0 AFLAG(1) 347Q BNZ 0 XFROZ [ JUMP IF BLOCK IS FROZEN 34MB NFA [ ENTRY FOR FREED FAG-ENDS ( ALTLEN 3572 STOZ GENDP [ NO KNOWLEDGE OF POS'N IN F/C CHAIN 35LL NFE [ ENTRY FOR FREED FAG-ENDS ( RELFAG 366= LDN 0 1 [ OTHERWISE BLOCK WILL BE MADE 'FREE' 36KW STO 0 AFLAG(1) [ CLEAR FLAGS AND SET THE 'FREE' FLAG 375G ADS 2 CFREE [ UPDATE FREE CORE TOTAL 376X ...#UNS ISFCON 378# ...( 379P ... FIXTRA ISFCM1 37=M ... BRN XSFCM11 [IF ON TXL 1 CTOP 37?K ... BCC SLFC [J IF LL BLOCK 37#H ... BXU 2 CIROUND,SLFC [ONLY SMALLEST ON POOL 37*Y ... LDN 2 BF64 37C* ... STOZ ASFCFPTR+BPTR(1) [TO TELL FREEOUT 37DQ ... BRN NCH4 37G7 ... FIXTRA ISFCM11 37GT ...XSFCM11 37HJ ...) 37K6 ADX 2 1 [ GET NEXT CONTIGUOUS BLOCK 384Q ANDX 0 AFLAG(2) [ TEST BIT 23 38JB BZE 0 NAFT [ JUMP IF BLOCK NOT FREE 3942 #SKI K6COREALL>799-799 39HL TRACE ASIZE(2),AMALHIGH [TRACE SIZE & ADDR OF NEXT BLOCK UP 3=3= LDX 0 ASIZE(2) [ AMALGAMATE 3=GW ADS 0 ASIZE(1) [ SIZES 3=JY ...#UNS ISFCON 3=M2 ...( 3=P4 ... STO 1 NAFRA 3=R6 ... LDX 1 2 3=T8 ... CALL 0 NFROUT [REMOVE FROM SIZE RING 3=X= ... LDX 1 NAFRA 3=^# ...) 3?3B ...#UNS ISFCON 3?5D ...#SKI 3?7N ...[ FREEOUT 2 3?G6 LDX 0 FPTR(2) [THE FOLLOWING ROUTINE DECHAINS 3?^Q SMO BPTR(2) [THE BLOCK 3#FB STO 0 FPTR [IN ORDER TO COMPLETE 3#^2 LDX 0 BPTR(2) [THE AMALGAMATION 3*DL SMO FPTR(2) 3*Y= STO 0 BPTR 3BCW LDX 2 0 [X2 AND X0 BOTH NOW POINT TO THE 3BXG BRN NLOC [PRECEDING FREE BLOCK 3CC6 [ OTHERWISE IT IS NECESSARY TO LOCATE THE POSITION OF THE BLOCK 3CWQ [ IN THE FREECORE CHAIN 3DBB [ IF GENDP IS NON-ZERO IT HOLDS THE ADDRESS OF THE PRECEDING FREE BLOCK 3DW2 [ (AT PRESENT THIS ONLY APPLIES TO ENTRY FROM RELFAG FOR ORDINARY G/C 3F38 ... FIXTRA ISFCM10 3F8B ...SLFC 3F*L NAFT 3FT= LDX 2 GENDP 3G#W ... BNZ 2 NLNC [IF FAG END CANT BE PREVIOUS FREE ADJACENT 3GSG LDX 2 BFREE+1 [ TEST AND JUMP IF IT SHOULD 3H#6 TXL 1 2 [BE CHAINED AT END OF FREECORE CHAIN 3HRQ ... BCC NLOC1 3J?B LDN 2 BFREE [LOAD BASE 3J*5 ...#UNS ISFCON 3JBS ...( 3JDH ... BXL 1 FPTR(2),NLOC1 [J IF CAN GO AT FRONT 3JG= ... FIXTRA ISFCM100 3JH^ ... BRN XONFREE [LDN 2 BFTEMP IF ON 3JKN ... BRN NLNC 3JMC ...XONFREE 3JP6 ...) 3JR2 TXL 1 CMIDFREE 3K=L BCC NEND [JUMP IF AFTER MIDDLE OF CORE 3KQ= NTFR TXL 1 FPTR(2) [LOCATE CORRECT POSITION 3L9W BCS NLOC1 [STARTING AT FRONT 3LPG LDX 2 FPTR(2) 3M96 BRN NTFR 3MNQ NEND LDX 2 BPTR(2) [LOCATE CORRECT POSITION 3N8B TXL 1 2 [STARTING AT END 3NN2 BCS NEND 3P7L # 3PM= [ THE FINAL SECTION OF CODE DETERMINES WHETHER THE PRECEDING 3Q6W [ BLOCK IS FREE AND CAN THUS BE AMALGAMATED 3QLG # 3QW# ... FIXTRA ISFCM1100 3R66 NLOC1 LDX 0 2 3RKQ NLOC ADX 0 ASIZE(2) [ADDRESS BLOCK PHYSICALLY AFTER 3S5B [ PRECEDING FREE BLOCK 3SK2 TXU 0 1 [IF NOT OUR BLOCK - JUMP 3T4L BCS NLNC 3TJ= #SKI K6COREALL>799-799 3W3W TRACE ASIZE(2),AMALLOW [TRACE SIZE & ADDR OF NEXT BLOCK DOWN 3WHG LDX 0 ASIZE(1) [ OTHERWISE AMALGAMATE AND EXIT 3X36 ADS 0 ASIZE(2) 3X5F ...#UNS ISFCON 3X7S ...( 3X9B ... FIXTRA ISFCM1000 3X=Y ... BRN NZY [LDX 1 2 IF ON 3X#G ... CALL 0 NFROUT [REMOVE FROM SIZE RING (FREEOUT) 3XBT ...) 3XF8 ...#UNS ISFCON 3XHH ...#SKI 3XKW ...[ FREEOUT 2 3XPL ...#UNS ISFCON 3XTB ... TRANSFIX CALL 0 ,HZFRIN 3X^6 ...#UNS ISFCON 3Y4W ...#SKI 3Y8L ...[ FREEIN 2 3YG2 BRN NZY 3YPS ...NLNC 3YRH ...#UNS ISFCON 3YT= ...( 3YWB ... FIXTRA ISFCM110 3YXG ... BRN XSFCM110 [STO 2 BSOURCE WHEN ON 3YYN ... TRANSFIX CALL 0 ,HZFRIN 3^2C ... LDX 2 BSOURCE 3^3= ...XSFCM110 3^46 ...) 3^5T ...#UNS ISFCON 3^7J ...#SKI 3^9D ...[ FREEIN 1 [ LINK THE FREED BLOCK INTO SIZE RING 3^F= BRN NCH3 3^YW # 42DG XFROZ [ACTION WHEN A FROZEN BLOCK IS FREED 42N# ... STO 0 AFLAG(1) [FROZ BIT SET 42Y6 ADS 2 FREZFREE [UPDATE FROZEN FREE TOTAL 43CQ FREZKICK [AWAKEN ANY FREEZE ACTIVITIES 43XB LDX 1 NAFRA 44C2 XFR1 LDX 0 FPSEUTYP 44WL STO 0 ATYPE(1) [MARK BLOCK PSEUDO FREE 45B= LDN 2 BCAFREZ 45TW BRN NCH3 [J TO CHAIN IN FREEZE CHAIN 46*G # 46T6 [ RELFAG IS AN ENTRY BRANCH OF THE FREECORE ROUTINE. ALL CHECKS ARE 47#Q [ SKIPPED SINCE THEY DO NOT APPLY TO FAG-ENDS. THE LOWER SECURITY 47SB [ MEANS THAT THIS FACILITY SHOULD NOT BE AVAILABLE OUTSIDE COREALL. 48#2 RELFAG [ ASSUMES X1 POINTS TO FAG-END AND 48RL STO 0 GL2 [ ITS SIZE IS IN ITS ASIZE WORD 493D ... FIXTRA CHAPMOVE7 49?= LDX 2 ASIZE(1) 49QW #SKI TRACE>499-499 4==G TRACE 2,FAGEND 4=Q6 BRN NFE 4?9Q # 4?PB [ 4#92 [THIS ROUTINE RINGS THE ELEMENT POINTED TO BY X1 AFTER THE BLOCK 4#NL [POINTED TO BY X2 4*8= [ 4*MW LABFIX ERING 4B7G XRING STO 0 GL2 [SET LINK 4BM6 BRN NCH3 [JUMP TO ENRING 4C6Q [ 4CLB [THIS ROUTINE DERINGS THE ELEMENT POINTED TO BY X1, SETTING IT NULL 4D62 [ 4DKL LABFIX ARING 4F5= XDRIN STO 0 GL2 [STORE LINK 4FJW CALL 0 NDECH [DERING 4G4G STOZ BPTR(1) [SET NULL 4GJ6 BRN NZY [JUMP TO TERMINATE 4H3Q [ 4HHB [ THIS ROUTINE UNCHAINS THE BLOCK POINTED TO BY X1 AND RECHAINS IT AFTER 4J32 [ THE BLOCK POINTED TO BY X2, AFTER FIRST CHECKING X1 AND X2 FOR 4JGL [ REASONABLE VALUES 4K2= [ 4KFW LABFIX CHAN 4K^G XCHAN STO 0 GL2 [REMEMBER LINK 4LF6 #SKI K6COREALL>799-799 4LYQ ( 4MDB TRACE 1,CHAIN1 4MY2 TRACE 2,CHAIN2 4NCL ) 4S#L LABFIX ACH1 4SS= TXU 1 2 [TEST AND EXIT IF TRYING TO CHAIN 4T?W BCC NZY 4TRG NCH2 CALL 0 NDECH [DECHAIN THE BLOCK 4W?6 LABFIX ACH3 4WB= ...NCH3 4WFB ...#SKI K6COREALL 4WJG ...( 4WML ... STO 1 GL1 [SAVE X1 4WQQ ... LDX 1 2 [BLOCK TO BE CHAINED AFTER 4WTW ... CALL 0 XCHECKCHN [CHECK THAT IT IS CHAINED CORRECTLY 4W^2 ... LDX 1 GL1 [RESTORE X1 4X46 ...) 4X7= ...NCH4 CALL 0 NCHAIN [ CHAIN THE BLOCK 4X=B NZY LDX 1 FX1 [ RESET X1 4XQ2 LDX 2 FX2 [ AND X2 4Y9L BRN (GL2) [ EXIT 4YP= [ 4^8W [ THIS ROUTINE CHAINS THE BLOCK POINTED TO BY X1 AFTER THE BLOCK POINTED 4^NG [ TO BY X2 4^Y# ... LABFIX ACHAIN 5286 NCHAIN 52MQ STO 0 GL1 [ SAVE LINK 537B LDX 0 FPTR(2) [ LOAD FORWARD POINTER PRECEDING BLOK 53M2 STO 1 FPTR(2) [STORE NEW FORWARD PTR PRECEDING BLK 546L STO 0 FPTR(1) [STORE FORWARD PTR NEW BLOCK 54L= STO 2 BPTR(1) [STORE BACKWARD PTR NEW BLOCK 555W SMO 0 [STORE NEW BACKWARD POINTER IN 55KG STO 1 BPTR [FOLLOWING BLOCK 5656 BRN (GL1) [ EXIT 56JQ [ 574B [THIS ROUTINE DECHAINS THE BLOCK SPECIFIED IN X1 57J2 LABFIX ADECH 583L NDECH STO 0 GL1 [REMEMBER LINK 58H= #SKI K6COREALL>899-899 592W TRACE 1,NDECH 595F ...#SKI K6COREALL 5984 ...( 59=M ... CALL 0 XCHECKCHN [CHECK THAT BLOCK IS CHAINED OK. 59*= ... [GEOERR BADCHAIN IF NOT 59CT ...) 59GG LDX 0 FPTR(1) [LOAD S A OF NEXT BLOCK 5=26 SMO BPTR(1) [STORE AS NEW FORWARD POINTER IN 5=FQ STO 0 FPTR [PRECEDING BLOCK 5=^B LDX 0 BPTR(1) [LOAD S A PRECEDING BLOCK 5?F2 SMO FPTR(1) [STORE AS NEW BACKWARD POINTER IN 5?YL STO 0 BPTR [FOLLOWING BLOCK 5#D= BRN (GL1) [EXIT 5#XW [ 5*CG [ 5*X6 [THIS ROUTINE UNLOCKS A LOCKED BLOCK REMOVING ANY PLEASE MOVE MARKER 5BBQ [ 5BWB LABFIX GUNLOK 5CB2 NUNL 5CTL #SKI K6COREALL 5D*= ( 5DSW BXL 2 FCORES,SILL3 [GEORGE ERROR IF OUTSIDE VARIABLE 5F#G ... BXL 2 GFIXCHAP,NOTILL3 [ CORE 5FS6 SILL3 GEOERR 1,UNL HIGH 5G?Q NOTILL3 5GRB ) 5H?2 STO 0 GL2 [DUMP LINK 5HQL NGN 1 #11 [ MASK TO HIDE 'LOCKED' BIT 5J== ANDX 1 AFLAG(2) [ CLEAR LOCKED BIT 5JPW STO 1 AFLAG(2) 5K9G ANDN 1 2 [ CHECK 'FROZEN' BIT 5KP6 BNZ 1 NUNL1 [ JUMP IF BLOCK IS FROZEN 5L8Q LDX 1 WAIT 5LNB BZE 1 NZY [ IF NONE WAITING JUMP TO EXIT 5M82 FON 1 [WAKE UP ALL ACTIVITIES WAITING FORCO 5MML STOZ WAIT [SET SWITCH NONE NOW WAITING 5N7= BRN (GL2) 5NLW NUNL1 FREZKICK [AWAKEN ANY SLEEPING FREEZE ACTIVITIE 5P6G BRN NZY [ AND EXIT 5PL6 [ 5Q5Q [ 5QKB [THIS ROUTINE LOCKS THE BLOCK SPECIFIED IN X2 5R52 [ 5RJL LABFIX ALOCK 5S4= NLOCK 5SHW #SKI K6COREALL 5T3G ( 5TH6 BXL 2 FCORES,SILL4 [GEORGE ERROR IF OUTSIDE VARIABLE 5W2Q ... BXL 2 GFIXCHAP,NOTILL4 [ CORE 5WGB SILL4 GEOERR 1,LOCKHIGH 5X22 NOTILL4 5XFL ) 5X^= LDN 1 #10 5YDW ORS 1 AFLAG(2) [ SET 'LOCKED' BIT IN AFLAG 5YYG NLOC2 LDX 1 FX1 [RESET X1,X2 & EXIT 5^D6 LDX 2 FX2 5^XQ EXIT 0 0 62CB [ 62X2 [ THIS ROUTINE IS A COORDINATING VERSION OF LOCK 63BL [ 63W= LABFIX COLOCK 64*W NLOCKC 64TG STO 0 GL2 [DUMP LINK 65*6 STO 2 GEN0 [DUMP BLOCK ADDRESS 65SQ CALL 0 NLOCK [CHECK BLOCK ADDRESS & LOCK IT 66#B LDX 0 GL2 66S2 LDX 2 GEN0 67?L LDX 1 AFLAG(2) 67R= ANDN 1 #402 [ JUMP IF BLOCK IS MARKED AS 68=W BNZ 1 NLOK1 [ 'FROZEN' OR 'PLEASE MOVE UP' 68QG ADN 0 2 69=6 BRN NLOC2 69PQ NLOK1 LDX 1 ALOGLEN(2) [IF FROZEN,SET UP FOR GETCORE 6=9B STO 1 GLOGLEN [ LOGICAL LENGTH 6=P2 LDX 2 AFLAG(2) 6?8L ANDN 2 4 6?N= SRL 2 2 6#7W LDCT 2 HLOK(2) [ REQU TYPE-OPTIONAL,LONGLOCK IF 6#MG [ REQD,LOCK TYPE 6*76 LDN 1 0 [ RING CONFIGN-BLOCKCOPY WILL SET RNG 6*LQ [LINK ALREADY IN X0 6B6B BRN XTND [J TO DO GETCORE 6BL2 [ 6BL7 ...#UNS ISFCON 6BL# ...( 6BLF ...# 6BLL ...#UNS ICASSTATS 6BLR ...( 6BLS ...#UNS ICTON 6BLT ...( 6BLW ...SGETGMILL 6BLX ...# FOR ICT ADD OTHER G MEMBERS MILL 6BLY ... STO 1 BSOURCE 6BL^ ... LDCT 1 #001 6BM2 ... ANDX 1 ASWITCH1 6BM3 ... [J IF ICTSW OFF 6BM4 ... BZE 1 SGMEND 6BM5 ... LDX 1 ASFNO1 6BM6 ...SGM2 6BM7 ... SMO GMELRTAB+1(1) 6BM8 ... ADX 4 ATM 6BM9 ... BCT 1 SGM2 6BM= ...SGMEND 6BM? ... LDX 1 BSOURCE 6BM# ... EXIT 0 0 6BM* ...) 6BMB ...# FIND MILL SPENT IN ACAS 6BMC ...SCASMILL 6BMJ ... '167 0 0 6BML ... LDX 4 K7 6BMP ...#UNS ICTON 6BMW ... CALL 0 SGETGMILL 6BNS ... SBX 4 CASK7 6BN^ ... ADS 4 CASMILL [ADD TO TOTAL 6BP8 ...SCASEX 6BPD ... EXIT 7 0 6BPK ...) 6BPQ ...# 6BPX ...# IN THE STRUCTURED FREE CORE SYSTEM FREE BLOCKS ARE RINGED ON TO 6BQ4 ...# SIZE RINGS THROUGH THEIR SIZE RING POINTERS. THEY REMAIN ON THE 6BQ9 ...# FREE CORE CHAIN. EACH SIZE RING HOLDS A RANGE OF SIZES IN 6BQB ...# ASCENDING ORDER OF SIZE. THE SIZE RANGE FOR EACH RING IS 6BQH ...# DETERMINED BY A FIXED CORE TANBLE. 6BQN ...# 6BQT ...# THIS SUBROUTINE SEARCHES THE SIZE RINGS TO FIND A BLOCK BIG 6BR2 ...# ENOUGH TO SATISFY THE REQUEST. IT RETURNS TO THE CALLING ROUTINE 6BR7 ...# IF UNSUCCESSFUL. IF SUCCESSFUL IT BRANCHES TO PROCESS THE BLOCK. 6BR# ...# IT IS USED BY THE FREEIN MACRO, IN WHICH CASE ONLY THE APPROPRIAT 6BRF ...# SIZE RING IS SEARCHED, RETURNING THE ADDRESS OF THE BLOCK BEHIND 6BRL ...# WHICH THE FREED BLOCK SHOULD BE CHAINED. 6BRR ...# 6BSC ...# 6BSJ ...# THE CODE FOR THE SIZERINGS SUBROUTINE IS HELD IN 6BSP ...# SEGMENT CASCODE. 6BSW ...# 6BTG ...# 6BTM ...# ENTRY POINT FOR FREEIN MACRO. CHAINS BLOCK POINTED TO BY X1 6BTS ...# INTO ITS SIZE RING IN STRUCTURED FREE CORE SYSTEM. 6BT^ ...# X0, X2 OVERWRITTEN, X1 REMAINS POINTING TO THE BLOCK ON EXIT. 6BW6 ...# CODE FOR FREEIN ROUTINE HELD IN SEGMENT CASCODE. 6BW? ...# 6BWD ...) 6BWK ...#UNS ISFC 6BWQ ...( 6BWX ...# IF ONLY ISFC IS SET,AND NOT ISFCON, FREEIN AND FREEOUT 6BX4 ...# JUST EXIT. 6BX9 ... LABFIX HNFRIN 6BXB ...NFRIN 6BXH ...) 6BXN ...#UNS ISFCON 6BXT ...( 6BY3 ... FIXTRA ISFCM2 6BY9 ... EXIT 0 0 [STO 0 CASLNK IF ON 6BYC ... TRANSFIX BRN ,HZFRIN 6BYL ...# 6BYR ...# ENTRY POINT FOR FREEOUT MACRO. DECHAINS BLOCK POINTED TO BY X1 6BYY ...# FROM ITS SIZE RING IN STRUCTURED FREE CORE SYSTEM. 6B^5 ...# X0 OVERWRITTEN, X1 STILL POINTS TO BLOCK ON EXIT. 6B^= ...# 6B^C ...) 6B^J ...#UNS ISFC 6B^P ...( 6B^W ... LABFIX HNFROUT 6C23 ...NFROUT 6C2* ...) 6C2G ...#UNS ISFCON 6C2M ...( 6C2Q ... FIXTRA ISFCM3 6C2T ... EXIT 0 0 [STO 0 CASLNK IF ON 6C2Y ... LDX 0 ASFCFPTR+BPTR(1) 6C33 ... BZE 0 (CASLNK) [J IF NOT RINGED 6C36 ... SMO ASFCFPTR(1) 6C39 ... STO 0 BPTR 6C3# ... LDX 0 ASFCFPTR(1) 6C3C ... SMO ASFCFPTR+BPTR(1) 6C3G ... STO 0 FPTR 6C3K ...NFRINEND 6C3Q ...NFROUTEND 6C3S ... BRN (CASLNK) [EXIT 6C3X ...) 6C44 ...#UNS ISFC 6C49 ...( 6C4? ...#UNS ISFCON 6C4* ...#SKI 6C4C ... BRN (0) [EXIT 6C4H ...# 6C4N ...) 6C5L [ 6CK= [ 6D4W [THIS ROUTINE GETS A BLOCK OF CORE OF THE SIZE SPECIFIED IN X2 FOR AN 6DJG [OBJECT PROGRAM OR GEORGE'S OWN USE AS SPECIFIED IN X1 6F46 [ 6FHQ [ 6G3B [ENTRY POINT FOR GETTING BACKING STORE TRANSFER QUEUE BLOCKS 6GH2 [ 6H2L LABFIX BSTQSWAP 6HG= LDCT 1 HLINKB [GETQUEU - OPTIONAL IF FOR SWAP 6H^W BRN NQU1 6JFG LABFIX BSTQBLOK 6J^6 LDCT 1 HMANDAT+HLINKB [ ELSE MANDATORY 6KDQ NQU1 LDN 4 AQUE [QUEUE BLOCK LENGTH 6KYB LDX 2 AQTYPE 6LD2 BRN NEMS1 6LXL LABFIX EMSENT 6MC= NEMS LDCT 2 #2 [NO RINGS - DEFAULT LENGTH=2 6MWW LDCT 1 HMANDAT+HLINKB [MANDATORY 6NBG NEMS1 LDN 5 3 6NW6 STO 5 GLINKSTEP [NO STEPPING BACK FOR GETEMSCR/GETQUE 6P*Q BRN QCOM 6PTB LABFIX HGLINK 6Q*2 LDN 1 1 6QSL STO 1 GLINKSTEP [BACK 2 FOR GETLINK 6R#= LDX 2 ALINKTYPE 6RRW LDCT 1 HMANDAT+HLINKB [MANDATORY 6S?G QCOM STO 2 GRING [RINGS 6SR6 STO 0 NCHLI [LINK 6T=Q STO 1 GRTYPE 6TQB STO 4 GLOGLEN [REQUEST 6W=2 BRN NCHP [JOIN NORMAL G/C PATH 6WPL [ 6X9= [ NORMAL ENTRY POINTS 6XNW [ 6Y8G [ GETCORE WITHOUT RINGS, GETACT, GETCHAP 6YN6 LABFIX HNCORE 6^7Q NCORE STO 2 GLOGLEN [LENGTH REQUESTED 6^MB LDX 2 0 7272 LDN 0 0 [LINK STEP INCREMENT 72LL LDCT 1 2 [RING CONFIG.(IGNORED IF GETACT) 736= BRN NCO1 73KW [ GETCORE WITH RINGS 745G LABFIX HNCORE1 74K6 NCORE1 754Q STO 2 GLOGLEN [LENGTH REQUESTED 75JB LDX 2 0 7642 NGN 0 2 [LINK STEP INCREMENT 76HL NCO1 STO 0 GLINKSTEP 773= LDN 0 1(2) [RETURN ADDRESS 77GW LDX 2 0(2) [REQUEST TYPE 782G XTND STO 1 GRING 78G6 STO 2 GRTYPE 78^Q SQOSS [PROCESS THE LINK 79FB ... SQUMP2 [DUMP THE ACCUMULATORS 79^2 NB123 LDX 4 GLOGLEN [LOAD LENGTH REQUESTED 7=DL NCHP 7=ND ... STOZ GENDP 7=Q2 ...#UNS CA1D 7=RJ ... ADX 4 CIRNDB 7=T6 ...#UNS CA1D 7=WN ...#SKI 7=Y= ADN 4 A1+IROUND-1 7?CW ANDX 4 IROUNDNG 7?XG STO 4 GEN4 [STORE PHYSICAL AMOUNT REQUIRED 7?Y5 ...#UNS ADP21 7?^W ...( 7#2F ...# CODE FOR PERF. MEASUREMENT OF CORE ALLOCATION SYSTEM-MODULE 21 7#2K ... SMO ADPBUF 7#2P ... LDX 3 ADPTAB+3 7#2T ... BNG 3 XADP1 [J IF NOT SWITCHED ON 7#34 ... LDX 3 ADPPTR 7#3M ... BNG 3 XADP1 [J IF BUFFER NOT FREE 7#4= ... LDN 3 550 7#4T ... TXL 3 ADPPTR 7#5D ... BCS XADP1 [J IF NO ROOM IN BUFFER 7#63 ... LDN 3 450 7#6L ... TXU 3 ADPPTR 7#79 ... BCS XADP2 [IF BUFFER GETTING FULL 7#7S ... LDN 3 21 7#8C ... LONGON1 ADPSTYLE,3 [WAKE UP YOU LAZY PERF MOB 7#92 ...XADP2 LDX 3 ADPPTR 7#9K ... SRL 4 3 [DIVIDE LENGTH BY 8 7#=8 ... SRC 4 7 [LOAD INTO BITS 0-6 7#=R ... SMO ADPBUF 7#?B ... ORS 4 0(3) [STORE IN BUFFER 7#?^ ... LDN 3 1 7##J ... ADS 3 ADPPTR [UPDATE PTR. 7#*7 ... LDX 4 GEN4 [RELOAD X4 7#*Q ...XADP1 7#B* ...) 7#C6 #SKI K6COREALL>699-699 7#WQ ( 7*BB TRACE 4,GETCORE 7*W2 TRACE GRTYPE,GRTYPE 7B*L ) 7BT= #SKI K6COREALL 7C#W ( 7CSG TXL 4 AFREE [CHECK NOT ASKING FOR MORE THAN IS 7D#6 BCS NOTILL5 [AVAILABLE 7DRQ SILL5 GEOERR 1,COREREQU 7F?B NOTILL5 7FR2 ) 7G=L NBCK3 7GQ= LDCT 3 HLONGLOCK [ LOAD LONGLOCK-TYPE MASK 7H9W ANDX 3 GRTYPE [ CHECK IF REQUEST IS LONGLOCK TYPE 7H*2 ...#UNS ISFCON 7HD6 ... BZE 3 TESTSFC [J IF IT IS NOT 7HH= ...#UNS ISFCON 7HLB ...#SKI 7HPG BZE 3 NOR [ JUMP IF IT IS NOT 7J96 #SKI TRACE>499-499 7JNQ TRACE GRTYPE,LLTYPE 7JTY ...#UNS ISFCON 7K36 ... TRANSFIX CALL 0,LLQK [DO QUICK LLGC 7K8B LDX 1 GLLSEMA [ IS THERE A LONGLOCK GETCORE ALREADY 7KN2 BZE 1 RGC [ IN PROGRESS? JUMP IF NOT. 7L7L LDX 0 GRTYPE 7LM= SLC 0 1 [ IS REQUEST OPTIONAL? 7M6W BPZ 0 NOWAIT [ IF YES, EXIT VIA NOWAIT 7MLG #SKI TRACE>499-499 7N66 TRACE GLLSEMA,WAITING 7NKQ CALL 0 SETWAITING [ STEPS BACK LINK TO RE-ENTER GETCORE 7P5B COOR3X GLLWAIT [ AND WAIT FOR TURN 7PK2 RGC 7Q4L LDX 1 GFIXCHAP [ ALL LONGLOCK GETCORES SHOULD BE 7Q7Q ...#UNS ISFCON 7Q=W ... BNG 1 TESTSFC [ DELAYED UNTIL END OF EMS 7QB2 ...#UNS ISFCON 7QF6 ...#SKI 7QJ= BNG 1 NOR [ DELAYED UNTIL END OF EMS 7R3W STO 3 GLLSEMA 7RHG SMO FX2 [ SAVE THE 7S36 LDN 1 ACC3 [ LINK OF THE ACTIVITY 7SGQ LDN 2 GLLACCS [ REQUESTING THE GETCORE 7T2B MOVE 1 ALINK [ OVER THE COORDINATION 7TG2 LDN 1 GLINKSTEP [ SAVE THE OTHER REQUEST PARAMETERS, 7T^L LDN 2 GLLLINKS [ GLINKSTEP, GLOGLEN, GRING, GRTYPE 7WF= MOVE 1 5 [ OVER THE COORDINATION 7WP4 ... FIXTRA ISFCM30 7WYW ACROSS COREALLF,1 [ ENTER COREALLF FOR LONGLOCK REQUEST 7WYY ...#UNS ISFCON 7W^2 ...( 7W^4 ...TESTSFC 7W^5 ...#UNS ISFCON 7W^6 ...( 7W^7 ... FIXTRA ISFCM4 7W^8 ... BRN NOR [TXU 4 CIROUND IF ON 7W^9 ... BCS SLGC 7W^= ... LDX 1 BF64 7W^? ... BXE 1 CX64,SLGC [J IF POOL EMPTY 7W^# ... SBS 4 CFREE [KEEP FREEE TOTAL RIGHT 7W^* ... LDX 2 FX2 7W^B ...#SKI K6COREALL 7W^C ... CALL 0 XCHECKCHN 7W^D ... LDX 2 FPTR(1) 7W^F ... LDX 3 BPTR(1) 7W^G ... STO 2 FPTR(3) 7W^H ... STO 3 BPTR(2) 7W^J ... LDX 2 FX2 [NOW CHAIN IT 7W^K ... LDX 3 FPTR(2) 7W^L ... STO 1 FPTR(2) 7W^M ... STO 3 FPTR(1) 7W^N ... STO 2 BPTR(1) 7W^P ... STO 1 BPTR(3) 7W^Q ... STOZ AFLAG(1) [ORDINARY BLOCK 7W^R ... BRN Q64 7W^S ...SLGC 7W^T ...) 7W^W ...# 7W^X ...# CODE FOR ALTERNATIVE CORE ALLOCATION SYSTEM (STRUCTURED FREE CORE) 7W^Y ...# SOURCES OF CORE ARE LOOKED AT IN THE FOLLOWING 7W^^ ...# ORDER:- 7X22 ...# (1) SIZE RINGS 7X23 ...# (2) INVALID FREE PROGRAM BLOCKS,IF BIG ENOUGH 7X24 ...# (3) CHAPTERS IF BIG ENOUGH 7X25 ...# (4) AMALGAMATION PATH (OF STANDARD CAS) 7X26 ...# 7X27 ...#UNS ICASSTATS 7X28 ...( 7X29 ... '167 0 0 7X2= ... LDX 4 K7 7X2? ...#UNS ICTON 7X2# ... CALL 0 SGETGMILL 7X2F ... STO 4 CASK7 [STORE MILL TIME AT ENTRY TO ACAS 7X2G ... LDX 4 GEN4 7X2J ...) 7X2L ...# 7X2M ... TRANSFIX CALL 7,HZRNG 7X2N ... FIXTRA ARJP 7X2P ... TRANSFIX CALL 7,QAMALG 7X2Q ...# RETURN MADE ONLY IF UNSUCCESSFUL 7X2S ...# 7X2W ...# (2) TRY IFPBS 7X2Y ...# 7X34 ... BSON EMSBIT,SUSECHAP [J IF EMS 7X36 ...# FIRST SEE IF THERE IS FPB RIGHT SIZE 7X38 ... LDN 1 BOBJUNUSE [BASE OF FPB CHAIN 7X3# ...SUNV1 7X3B ... CALL 7 NEXTFPB [GET NEXT FPB (BACKWARDS) 7X3D ... BRN SUSECHAP [J IF END OF CHAIN 7X3G ... LDX 0 JOBNOWAS(1) 7X3J ... BNZ 0 SUNV1 [J IF VALID FPB 7X3L ... LDX 0 ASIZE(1) 7X3N ... SBX 0 GEN4 [ S - R 7X3Q ... BNG 0 SUNV1 [J IF NOT BIG ENOUGH 7X5# ...# GOT IFPB BIG ENOUGH 7X5B ...SGOTIFPB 7X5C ...#SKI TRACE>499-499 7X5D ... TRACE 1,IFPBFND 7X5G ...#UNS ICASSTATS 7X5J ...( 7X5L ... LDN 0 1 7X5N ... ADS 0 CASIFPB [ADD TO CAS IFPB COUNT 7X5Q ...) 7X5S ... LDX 0 ALOGL(1) 7X5W ... SBS 0 CINVFPB [REDUCE FPB COUNTS 7X5Y ...SSUB 7X62 ... SBS 0 COBJUNUSE 7X64 ... CALL 0 NDECH [DECHAIN FPB 7X65 ... ADN 1 APBRG 7X66 ... CALL 0 NDECH 7X67 ... SBN 1 APBRG [DECHAIN FROM FPBRG 7X68 ... BRN SPLITTEST 7X69 ...# 7X6= ...# (3) TRY CHAPTERS, USING ONLY THOSE 7X6# ...# OVER CHAPTERQUOTA UNLESS CHAPTER 7X6B ...# REQUEST OR COREJAM 7X6D ...# 7X6G ...# FIRST SEE IF THERE IS A CHAPTER BIG 7X6J ...# ENOUGH (BUT OMIT IF COREJAM) 7X6L ...# 7X6N ...SUSECHAP 7X6Q ... LDX 0 CJSUM 7X6W ... SBN 0 XJCHAPLOW 7X6^ ... BPZ 0 SCHR [J IF COREJAM 7X74 ...SUCH1 7X76 ... CALL 7 SCHAPCHK [DO CHECKS, RETURNING AS FOLLOWS 7X78 ... BRN SFINDCH1 [J SINCE ACHAP > CHAPTERQUOTA 7X7= ... BRN SRAMALG [J SINCE CHAPTER REQUEST 7X7# ... BRN SRAMALG [J TO AMALGAMATION PATH SINCE WE 7X7B ... [CAN'T JUSTIFY USING CHAPTERS 7X7D ...SCHR 7X7G ... LDCT 5 #677 [SET X5 ARTIFICIALLY HIGH 7X7J ... BRN SFINDCH2 7X7L ...SFINDCH1 7X7N ... LDX 5 ACHAP [X5 = ACHAP INITIALLY. DECREMENTED BY 7X7Q ...SFINDCH2 [SIZES OF UNAVAILABLE CHAPTERS 7X7S ... LDN 1 BCHAP [BASE OF CHAPTER CHAIN 7X7W ...SFINDCH 7X7Y ... TXL 5 CHAPQUOTA 7X7^ ... BCS SRAMALG [J SINCE CHAPTERQUOTA REACHED 7X83 ... CALL 7 SFCH1 7X84 ... [FIND USABLE CHAPTER 7X86 ... BRN SRAMALG [J SINCE END OF CHAIN 7X88 ... LDX 0 ASIZE(1) 7X8= ... TXL 0 GEN4 7X8# ... BCC SGOTCHP [J SINCE BLOCK BIG ENOUGH 7X8B ... SBX 5 0 [REDUCE X5 BY SIZE 7X8D ... BRN SFINDCH 7X8G ...# 7X8J ...# NOW TRY FREEING CHAPTERS 7X8L ...# 7X8P ...SCHAPFREE 7X8S ... CALL 7 SCHAPCHK [DO CHECKS, RETURNING AS FOLLOWS 7X8W ... BRN SCHFREE [J SINCE ACHAP > CHAPTERQUOTA 7X8Y ... BRN SCHFREE [J SINCE CHAPTER REQUEST 7X92 ... LDX 0 CJSUM 7X94 ... SBN 0 XJCHAPLOW 7X96 ... BNG 0 SRAMALG [J IF NOT COREJAM 7X98 ... FIXTRA CHAPLOW3 7X99 ...# CHECK WITH RTM CHAPLOW BEFORE ALTERING NEXT 3 INSTRS. 7X9= ... BRN SCHFREE 7X9# ... BRN SRAMALG 7X9B ...SCHFREE 7X9D ... LDN 1 BCHAP [BASE OF CHAPTER CHAIN 7X9G ... CALL 7 SFINDCHAP [FIND AVAILABLE CHAPTER 7X9K ... BRN SRAMALG [J SINCE END OF CHAIN 7X9N ... CALL 7 SCHAPTIDY [ADJUST COUNTS ETC. 7X9Q ... CALL 0 NFREE [FREE THE CHAPTER & AMAL 7X9S ...#UNS ICASSTATS 7X9W ...( 7X9Y ... LDN 0 1 7X=2 ... ADS 0 CASCHAPS [ADD TO COUNT OF CHAPTERS FREED 7X=4 ...) 7X=8 ... TRANSFIX CALL 7,QAMALG1 7X=# ... CALL 0 SAMALG [J TO TRY AMALGAMATIONSINCE WE KNOW N 7X=D ... BRN SCHAPFREE [J SINCE UNSUCCESSFUL 7X=G ...SGOTCHP 7X=H ...#SKI TRACE>499-499 7X=J ... TRACE 1,SGOTCHP 7X=L ... CALL 7 SCHAPTIDY [ADJUST COUNTS ETC. 7X=N ... CALL 0 NDECH [DECHAIN CHAPTER 7X=Q ...#UNS ICASSTATS 7X=S ...( 7X=W ... LDN 0 1 7X=Y ... ADS 0 CASCHAPS [ADD TO COUNT OF CHAPTERS FREED 7X?2 ...) 7X?4 ... BRN SPLITTEST 7X?6 ...# 7X?8 ...# (4) TRY NORMAL AMALGAMATION PATH 7X?9 ...SRAMALG 7X?# ...SAMALG 7X?* ...# ENTER AMALGAMATION PATH 7X?C ... LDX 4 GEN4 7X?D ...#UNS ICASSTATS 7X?F ...( 7X?G ... LDN 0 1 7X?H ... ADS 0 CASAMAL [ADD TO NO.TIMES AMALGAMATION ENTERED 7X?J ...) 7X?L ... BRN NOR 7X?N ...# 7X*Y ...# NOW TEST THE CHOSEN BLOCK TO SEE IF 7XB2 ...# IT IS WORTH SPLITTING. IF SO, THE 7XCH ... LABFIX HNTST 7XCJ ...SDECH 7XCL ... CALL 0 NDECH [REMOVE FROM FREE CHAIN 7XCN ... LDX 6 ASIZE(1) 7XCQ ... BRN SALL11 7XCS ...SPLITTEST [CHOSEN BLK NOT A FREE BLK 7XCW ... LDX 6 ASIZE(1) 7XCY ... BRN SALL2 7XD2 ...) 7XD= ... FIXTRA ISFCM41 7XDG NOR 7XY6 BXGE 4 CFREE,NONE [ JUMP IF NOT ENOUGH FREE CORE 7XY* ...#UNS ISFCON 7XYJ ...( 7XYR ...[ IN SFC WE MUST NEED TO AMALGAMATE BY MOVING 7X^2 ...[GET X2->1ST/FREE 7X^9 ... LDX 2 FCORES 7X^D ... BRN PHIRST 7X^M ...NOTFREE 7X^W ... NGX 4 GEN4 [FOR COREMOVE CHECK 7Y25 ... LDX 5 GEN4 [DITTO:-RUNNING TOTAL 7Y2# ... ADX 2 ASIZE(2) 7Y2H ... BXE 2 GFIXCHAP,NONE [J IF END REACHED 7Y2Q ...PHIRST 7Y2^ ... LDX 0 AFLAG(2) 7Y38 ... BCT 0 NOTFREE [J IF NOT FREE 7Y3C ...NOK LDX 1 2 [LOAD SIZE FIRST FREE BLOCK READY 7Y3L ... LDN 7 0 [ FOR NEW FREE COUNT 7Y3T ... BRN PHIRSTA 7Y44 ...SFREE ADX 1 ASIZE(1) [ GET ADDRESS OF NEXT BLOCK 7Y4? ... BXGE 1 GFIXCHAP,NONE [J IF END OF VAR CORE 7Y4G ...PHIRSTA 7Y4P ... LDX 6 ASIZE(1) [ LOAD ITS SIZE 7Y4Y ... FIXTRA CHAPMOVE1 7Y57 ... LDN 0 #217 [ PRESERVE BITS 16,20,21,22,23 TO SEE 7Y5B ... ANDX 0 AFLAG(1) [IF CHAPTER, LOCKED, LOCKED, FROZEN 7Y5K ... [OR FREE RESP. 7Y5S ... BZE 0 SALR [ JUMP IF NONE OF THOSE 7Y63 ... ANDN 0 #16 [ TEST IF LOCKED,FROZEN OR LONGLOCK 7Y6= ... BZE 0 WHAT [ & JUMP IF NOT (EG NOT LOKD CHAPBLOK 7Y6F ...#SKI K6COREALL>299-299 7Y6N ... TRACE ATYPE(1),BLOCKING 7Y6X ... ANDN 0 #12 7Y76 ... BNZ 0 SLOKD [J IF LOCKED OR FROZEN 7Y7* ... TXL 2 CTOP 7Y7J ... BCC SALR [J IF OUT OF LONGLOCK AREA 7Y7R ...SLOKD LDX 2 1 7Y82 ... BRN NOTFREE [RESET TO START AGAIN 7Y89 ...SALR ADX 5 6 [KEEP RUNNING TOTAL OF AMOUNT TO MOVE 7Y8D ... SBX 6 ALOGLEN(1) [CALC ANY EXCESS IN A USED BLOCK 7Y8M ... SBN 6 A1 7Y8W ... ANDX 6 IROUNDNG 7Y95 ... SBX 5 6 [KEEP ACCURATE TAKE EXCESS OFF 7Y9# ... LDX 0 CJSUM 7Y9H ... SBN 0 XJCHAPLOW 7Y9Q ... BPZ 0 WHAT [J IF MOVE ANYWAY COS OF COREJAM 7Y9^ ... LDX 0 5 [KEEP A COPY 7Y=8 ... SBX 5 4 [SUB EXCESS COVERED 7Y=C ... NULL 7Y=L ... FIXTRA CORESET 7Y=T ... SRL 5 1 7Y?4 ... BXGE 5 GEN4,SLOKD [J IF TOO MUCH TO MOVE 7Y?? ... LDX 5 0 [RESTORE RUNNING TOTAL 7Y?G ...WHAT ADX 7 6 [ADD INTO NEW FREE COUNT 7Y?P ... ADX 4 6 7Y?Y ... TXL 7 GEN4 [TEST AND J IF ENOUGH NOT YET FOUND 7Y#7 ... BCS SFREE 7Y#8 ... LABFIX ISFCONE 7Y#9 ...# PRECAUTION - SEE GETCORE IN QENTRY2 IN COREALLG 7Y#= ... LDN 0 1 7Y#? ... ADS 0 BCOUNT 7Y#B ... FIXTRA ISFCUNIT 7Y#K ... LABFIX UNIT 7Y#S ...UNIT LDX 1 BPTR(2) [LDN 1 0 IF OFF 7Y*3 ...) 7Y*= ...#UNS ISFCON 7Y*F ...#SKI 7Y*N ...( 7YCQ NGX 4 4 [ SET NEGATIVE AMOUNT REQUIRED IN X4 7YXB LDX 2 BFREE 7^C2 LDN 3 BFREE 7^WL [ 82B= [A SEARCH IS MADE FORWARDS ALONG THE FREE CHAIN UNTIL ENOUGH FREE BLKS 82TW [HAVE BEEN COVERED TO SATISFY THE REQUEST X2 IS KEPT AS A POINTER TO 83*G [THE FIRST FREE BLOCK INCLUDED AND X3 TO THE LAST FREE BLOCK INCLUDED 83T6 [ 84#Q NBCK1 TXU 3 BFREE+1 [TEST AND J NOT ENOUGH FOUND 84SB BCC NONE 85#2 LDX 3 FPTR(3) [LOAD ADDRESS NEXT FREE BLOCK 85RL ADX 4 ASIZE(3) [ ADD ITS SIZE 86?= BNG 4 NBCK1 [J NOT ENOUGH YET 86QW TXU 2 3 [TEST AND J IF ALL IN ONE BLOCK 87=G BCC UNIT 87Q6 BZE 4 NMOVE [J IF NO EXCESS COVERED 889Q [ 88PB [BLOCKS ARE NOW REMOVED FROM THE FRONT OF THE CHAIN IF POSSIBLE 8992 [ 89NL NTAKE SBX 4 ASIZE(2) [ SUBTRACT SIZE OF 1ST BLOCK INCLUDED 8=8= LDX 2 FPTR(2) [GET ADDRESS OF NEW FIRST BLOCK 8=MW BPZ 4 NTAKE [J IF STILL EXCESS COVERED 8?7G LDX 2 BPTR(2) [REINCLUDE LAST BLOCK REMOVED 8?M6 ADX 4 ASIZE(2) 8#6Q TXU 2 3 [J IF NOW ALL IN ONE BLOCK 8#LB BCC UNIT 8*62 [ 8*KL [A TEST IS MADE TO ENSURE THAT THE AMOUNT REQUIRED IS NOT LESS THAN THE 8B5= [AMOUNT WHICH MUST BE MOVED TO GET A CONSECUTIVE BLOCK OF FREE CORE 8BJW [ 8C4G NMOVE LDX 5 CJSUM [TEST AND J IF CORE JAM EXISTS SO 8CJ6 SBN 5 XJCHAPLOW [THAT BLOCKS ARE MOOVED REGARDLESS 8D3Q BPZ 5 NOK [OF THIER SIZE WHEN IN A JAM STATE 8DHB LDX 5 3 [LOAD ADDRESS OF END BLOCK 8F32 ADX 5 ASIZE(3) [ ADD ITS SIZE 8FGL SBX 5 2 [SUB ADDRESS OF FIRST BLOCK 8G2= SBX 5 4 [SUB EXCESS COVERED 8GFW FIXTRA CORESET 8G^G SRL 5 1 8HF6 TXL 5 GEN4 [TEST AND J IF AMOUNT TO BE MOVED 8HYQ BCS NOK [IS SMALL ENOUGH 8JDB SBX 4 ASIZE(2) [ OTHERWISE SET NEW START BLOCK 8JY2 LDX 2 FPTR(2) 8KCL BRN NBCK1 [J TO SEARCH AGAIN 8KX= [ 8LBW [A CHECK IS MADE FOR LOCKED BLOCKS, IF ANY ARE FOUND BLOCKING AMALGAM- 8LWG [ATION THEY ARE MARKED PLEASE MOVE AND THE SEARCH IS RESTARTED BEYOND 8MB6 [THE LOCKED BLOCK A NEW COUNT OF FREE CORE AVAILABLE IS SET UP WHICH 8MTQ [INCLUDES CHAPTER SPACE AND EXTRA WORDS IN USED BLOCKS 8N*B [ 8NT2 NOK LDX 1 2 [LOAD SIZE FIRST FREE BLOCK READY 8P#L LDX 7 ASIZE(1) [ FOR NEW FREE COUNT 8PS= SFREE ADX 1 ASIZE(1) [ GET ADDRESS OF NEXT BLOCK 8Q?W LDX 6 ASIZE(1) [ LOAD ITS SIZE 8QHN ... FIXTRA CHAPMOVE1 8QTD ... LDN 0 #217 [ PRESERVE BITS 16,20,21,22,23 TO SEE 8R78 ... ANDX 0 AFLAG(1) [IF CHAPTER, LOCKED, LOCKED, FROZEN 8RDY ... [OR FREE RESP. 8RQQ BZE 0 SALR [ JUMP IF NONE OF THOSE 8S=B ... ANDN 0 #16 [ TEST IF LOCKED,FROZEN OR LONGLOCK 8SQ2 BZE 0 WHAT [ & JUMP IF NOT (EG NOT LOKD CHAPBLOK 8T9L #SKI K6COREALL>299-299 8TP= TRACE ATYPE(1),BLOCKING 8TSB ... ANDN 0 #12 8TXG ... BNZ 0 SLOKD [J IF NOT LONGLOCK 8W2L ... TXL 2 CTOP 8W5Q ... BCC SALR [J IF OUT OF LONGLOCK AREA 8W8W SLOKD SBX 4 ASIZE(2) [STEP ALONG FREE BLOCKS TO FIRST FREE 8WNG LDX 2 FPTR(2) [BLOCK BEYOND LOCKED BLOCK 8X86 TXL 1 2 8XMQ BCC SLOKD 8Y7B BRN NBCK1 [J TO RESTART SEARCH 8YM2 SALR 8^6L SBX 6 ALOGLEN(1) [CALC ANY EXCESS IN A USED BLOCK 8^L= SBN 6 A1 925W ANDX 6 IROUNDNG 92KG WHAT ADX 7 6 [ADD INTO NEW FREE COUNT 9356 TXL 7 GEN4 [TEST AND J IF ENOUGH NOT YET FOUND 93JQ BCS SFREE 93SJ ...) 944B [ 94J2 [IF NO LOCKED BLOCKS ARE FOUND THE USED PARTS OF MOVABLE BLOCKS ARE 953L [MOVED DOWN THE STORE, CHAPTER BLOCKS ARE FREED AND FREE BLOCKS ARE 95H= [AMALGAMATED UNTIL A LARGE ENOUGH BLOCK IS OBTAINED 962W [ 9662 ...#UNS ISFCON 9696 ...#SKI 96#= ...( 96CB ... LABFIX UNIT 96GG UNIT 9726 LDX 1 BPTR(2) 979Y ...) 97FQ UNE STO 1 GENDP [REMEMBER ADDR FOR RECHAINING FRAGMEN 97^B STO 2 GFORP [REMEMBER ADDR OF FIRST BLOCK 98F2 LDX 1 2 98YL CALL 0 NDECH [ UNCHAIN THE BLOCK TO ALLOW MOVING 99?3 ...#UNS ISFCON 99KD ... CALL 0 NFROUT [REMOVE FREE BLOCK FROM SIZE RING 99XW SNEXT LDX 6 ASIZE(1) [ LOAD ITS SIZE 9=CG SNEX1 TXL 6 GEN4 [ TEST AND JUMP IF ENOUGH 9=X6 BCC SALL1 9?BQ ADX 1 ASIZE(1) [GET ADDRESS OF NEXT BLOCK 9?WB STAR LDX 6 ASIZE(1) [LOAD ITS SIZE 9#B2 LDX 0 AFLAG(1) 9#KS ... FIXTRA CHAPMOVE2 9#TL ANDN 0 #201 [ TEST IF FREE OR CHAPTER 9**= BZE 0 NOTFR [ AND JUMP IF NEITHER 9*SW SRC 0 1 [ IF NOT FREE, THEN A CHAPTER 9B#G BPZ 0 SCHP [ JUMP IF A CHAPTER 9BLX ...#UNS ISFCON 9B^# ... CALL 0 NFROUT [REMOVE FREE BLOCK FROM SIZE RING 9C?Q BRN SOFR 9CRB SCHP ADS 6 CFREE [ADD SIZE OF CHAPTER TO CURRENT FREE 9D?2 SBS 6 ACHAP [MAINTAIN SUM OF CHAPTER SIZES 9DQL LDX 3 BACK1(1) [SEGMENT NUMBER 9F== LDX 0 BACK2(1) [BS ADDRESS 9FPW STO 0 KTAB(3) [UPDATE TABLE 9FXP ... LDN 0 1 9G5J ... SEGENTRY ADPCA1 [ MEND POINT FOR DATAPASS 9G?C ...#UNS FCCHAPFREE 9GF= ... ADS 0 FCCHAPMID [ INCREMENT F-C COUNT 9GM5 ...#UNS FCCHAPFREE 9GSY ...#SKI 9H2R ... NULL 9H8Q SOFR CALL 0 NDECH [DECHAIN CHAPTER AND FREE BLOCKS 9HNB ADS 6 ASIZE(2) [ADD SIZE TO PRECEDING FREE 9J82 LDX 1 2 [RESET X1 9JML BRN SNEXT [J TO TEST NEXT BLOCK 9K7= NOTFR LDX 3 ALOGLEN(1) [LOAD LOGICAL LENGTH OF USED BLOCK 9K=B ...#UNS CA1D 9K*G ... ADX 3 CIRNDB 9KDL ...#UNS CA1D 9KHQ ...#SKI 9KLW ADN 3 A1+IROUND-1 9L6G ANDX 3 IROUNDNG 9LL6 SBX 6 3 [SUB FROM ACTUAL SIZE OF BLOCK 9M5Q ADS 6 CFREE [ADD EXCESS TO CURRENT FREE TOTAL 9MKB ADX 6 ASIZE(2) [NEW SIZE FREE BLOCK 9N52 STO 3 ASIZE(1) [RESET BLOCK SIZE 9NJL CALL 0 MOVE [MOVE USED BLOCK 9P4= LDX 1 BDESTN [NEW START ADDR FOR F/C BLOCK 9P9D ... FIXTRA CHAPMOVE3 9PBL ... NULL 9PHW ADX 1 GUSSIZE [IS CALCULATED 9Q3G LDX 2 1 9QH6 STO 6 ASIZE(1) [STORE NEW SIZE FREE BLOCK 9R2Q BRN SNEX1 [ JUMP TO LOOK AT NEXT BLOCK 9RGB [ 9S22 [ WHEN ENOUGH CORE IS OBTAINED IN ONE BLOCK, EXCESS CORE IS SPLIT OFF 9SFL [ IF NECESSARY 9S^= [ 9TDW LABFIX GOTENUF [ 'SUCCESS' ENTY FROM LONGLOCK G/C 9TL4 ...#UNS ICASSTATS 9TR= ... STOZ CASK7 9TYG SALL 9WD6 LDX 4 GLOGLEN 9WH= ...#UNS CA1D 9WLB ... ADX 4 CIRNDB 9WPG ...#UNS CA1D 9WSL ...#SKI 9WXQ ADN 4 A1+IROUND-1 9XCB ANDX 4 IROUNDNG 9XX2 STO 4 GEN4 9YBL STOZ GENDP 9YW= LDX 2 FX2 9^*W FINDCORE 1 9^TG LDX 6 ASIZE(1) =2*6 BRN SALT =2SQ SALL1 [ FROM ORDINARY GETCORE =2YM ...#UNS ISFCON =329 ...( =33R ...#SKI TRACE>499-499 =35* ... TRACE 1,AMALOK =36X ...) =38F ...SALL11 =3#B SBS 6 CFREE [ ADJUST FREE TOTAL =3J8 ...SALL2 =3S2 LDX 2 FX2 =4?L CALL 0 NCHAIN [ CHAIN AFTER ACTIVITY BLOCK =4R= SALT =5=W SBX 6 GEN4 [ FIND EXCESS COVERED =5QG BZE 6 TIDY [ NO SPLITTING AS NO EXCESS =6=6 TXL 6 SPLITLEN [TEST AND J IF WORTH BACK SPLITTING =6PQ BCC NDOSP =79B LDCT 0 HCHAP =7P2 ANDX 0 GRTYPE [SPLIT ANYWAY IF CHAP - ELSE ERROR IN =88L BZE 0 TIDY [ RUNNING SUM ACHAP =8N= NDOSP =97W LDX 0 GEN4 =9MG STO 0 ASIZE(1) ==76 ADX 1 GEN4 [ GET ADDRESS OF PORTION TO SPLIT ==LQ STO 6 ASIZE(1) [ PUT IN ITS SIZE =?6B CALL 0 RELFAG [ FREE THE FAG-END =?B8 ...TIDY1 =?L2 FINDCORE 1 [ GET BACK TO ORIGINAL BLOCK =#5L TIDY =#K= LDCT 0 HLONGLOCK =*4W ANDX 0 GRTYPE =*JG BZE 0 XNLL =B46 LDN 0 4 =BHQ XNLL STO 0 AFLAG(1) =BRJ ...Q64 [QUICK LSM LABEL =C3B STOZ ATYPE(1) [ ZERIOSE TYPE WORD =CH2 STOZ BACK1(1) [ ZERIOSE BACKING STORE ADDRESS WORDS =D2L STOZ BACK2(1) =DG= LDX 4 GLOGLEN =D^W STO 4 ALOGLEN(1) [ SET LOGICAL LENGTH =FFG LDX 3 GRING =F^6 STO 3 ARINGNO(1) [ SET UP RING WORD =GDQ [ THIS MAY BE AN OPTIONAL GETCORE CALLED BY A MANDATORY ONE. IF THE =GYB [ LATTER HAD FAILED, CLONG1 WOULD BE SET, SO THE 'REQUEST FAILED?' =JWW LDX 0 CLONG1(2) [TEST IF REQUEST EVER FAILED =KBG BPZ 0 WX2 [NO =KGC ... LDCT 0 HMANDAT [ TEST IS SKIPPED FOR ALL OPTIONAL =KL# ... ANDX 0 GRTYPE [ GETCORES =KQ9 ... BZE 0 WX2 [ JUMP IF OPTIONAL =KW6 LDCT 0 #400 [CLEARFAILED MARKER =L*Q ERS 0 CLONG1(2) =LTB LDN 0 1 [REDUCE COUNT OF OUTSTANDING REQUESTS =M*2 SBS 0 CFAIL =MSL WX2 =N4D ... LDCT 5 #116 =N#= ... ANDX 5 GRTYPE [GET LINK,ACT,ALTLEN&CHAP BITS =NJ4 ... BZE 5 XORDINARY [J IF NONE OF THESE =NRW SLC 5 2 =P?G BNG 5 NACTY [J IF ACTIVITY BLOCK REQUEST =PR6 SLC 5 4 =PY# ...#UNS ICASSTATS =Q5G ... CALL 7 SCASMILL =Q=Q BNG 5 SMOVE [J IF ALTLEN REQUEST =QQB SLC 5 1 =R=2 BNG 5 (NCHLI) [J IF LINK BLOCK TYPE OF REQUEST =R*X ... SRC 5 2 [CHAP BIT TO B0 =RFS ... BNG 5 XCHAP =RKP ...XORDINARY =RPL ANDX 3 BSP16 [NO RINGS - ZERO =RWS ...#UNS ISFCON =S42 ...#SKI =S98 ... TRANSFIX BZE 3,FLIST =SBB ...#UNS ISFCON =SHJ ... TRANSFIX BZE 3,TENT [EXIT IF NO RINGS =SNW LDX 0 ARINGNO(1) [ISOLATE LENGTH OF RING =T8G SRL 0 15 =TN6 SBC STOZ ARINGNO+2(1) [MAKE NULL =W7Q ADX 1 0 [UPDATE FOR NEXT RING =WMB BCT 3 SBC [IF THERE IS ONE =X72 SNRING =X*N ...#UNS ISFCON =XJB ...#SKI =XR4 ... TRANSFIX BRN ,FLIST =X^Q ...#UNS ISFCON =Y8D ... TRANSFIX BRN ,TENT =YC6 ...XCHAP =YKW LDN 0 #200 [ SET 'CHAPTER' BIT =^5G FINDCORE 1 [ IN GOT BLOCK'S =^K6 ORS 0 AFLAG(1) [ FLAG WORD ?24Q LDX 4 ASIZE(1) ?2JB ADS 4 ACHAP [MAINTAIN SUM OF CHAPTER SIZES ?342 TRANSFIX BRN,FZCO [ JUMP TO BSTS VIA CHAPTER CHANGER ?3HL NACTY LDN 7 ACTRINGNUM [NO OF RING ELEMENTS ?43= LDX 0 ACTYPE ?4GW STO 0 ARINGNO(1) [SET UP RING WORD ?52G NACT1 LDN 6 ARINGNO+1(1) ?5G6 STO 6 ARINGNO+1(1) [EMPTY ?5^Q STO 6 ARINGNO+2(1) ?6FB BDX 1 £ ?6^2 BCT 7 NACT1 ?7DL LDN 6 FILERING ?7Y= NGS 6 ARINGNO+1(1) ?8CW LDX 1 FPTR(2) ?8XG STOZ BACKCHAN(1) ?9C6 LDN 0 ACC3(1) [ZEROISE REST OF BLOCK ?9WQ STOZ ACC3(1) ?=BB LDN 1 ACC4(1) ?=W2 LDX 3 GLOGLEN ??*L MOVE 0 A1-1-ACC3(3) [ZEROISE BLOCK ??T= LDX 0 ACTCOUNT [SET UP ACT NUMBER ?##W STO 0 ACTNUM-ACC4(1) ?#SG ADN 0 1 [AND INCREMENT FOR NEXT ONE ?*#6 STO 0 ACTCOUNT ?**T ...#UNS ICASSTATS ?*CJ ... CALL 7 SCASMILL ?*F# ... FIXTRA FSHGETACT [FOR SHARED FILESTARE MEND - TO SET ?*LG ... [ 'MACHINE "B"' BIT IN B M/C GETACTS ?*RQ LDX 2 FX2 ?*WW ...#UNS ISFCON ?B22 ...#SKI ?B56 ... TRANSFIX BRN ,FLIST ?B8= ...#UNS ISFCON ?B?B ... TRANSFIX BRN,TENT [ JUMP TO COORDINATE ?BBL ...[ ?BFW ...[ AS CORE NOT IMMEDIATELY AVAILABLE,WE USE PROGRAM CORE IF POSSIBLE ?BK6 ...[ UNLESS CHAPTERQUOTA <OR= ACHAP & OBJECTQUOTA > AOBJFREE IN WHICH ?BNB ...[ CASE WE ATTEMPT TO FREE CHAPTERS ?BRL ...[ ?BWW ...NONE ?C26 ... BSON EMSBIT,USECHAP [J IF EMS ?C5B ...#SKI G4 ?C8L ...( ?C?W ... LDX 0 CFPCFREZ [J IF FREE PAGE CHAIN FROZEN AS WE ?CC6 ... BNZ 0 USECHAP [THEN CAN'T TAKE A PAGE FROM IT ?CGB ...) ?CKL ...USEPROG ?CNW ...#SKI G3 ?CS6 ...( ?CXB ...[ ?D2L ...[ WE ATTEMPT TO FREE ALL/PART OF AN INVALID FREE PROGRAM BLOCK(FPB). ?D5W ...[ IF NON-AVAILABLE,WE ATTEMPT TO USE A VALID FPB. ?D96 ...[ ?D#B ... LDN 1 BOBJUNUSE [BASE OF FPB CHAIN ?DCL ...UNVALFPB ?DGW ... CALL 7 NEXTFPB [GET NEXT FPB ON CHAIN(BACKWARDS) ?DL6 ... BRN VALFPB [J IF END OF CHAIN ?DPB ... LDX 0 JOBNOWAS(1) ?DSL ... BNZ 0 UNVALFPB [J IF A VALID FPB ?DXW ... BRN XGOTFPB [LETS USE THIS FPB THEN ?F36 ...[ ?F6B ...[ SUBROUTINE TO STEP TO NEXT UNFROZEN FPB (BACKWARDS) ON THE CHAIN ?F9L ...[ LINK - X7, EXIT 0 IF END OF CHAIN, EXIT 1 IF FPB FOUND ?F#W ...[ ?FD6 ...NEXTFPB ?FHB ... LDX 1 BPTR(1) [GET NEXT BLOCK ?FLL ... BXE 1 CXOBJUN,(7) [EXIT 0 IF END OF CHAIN ?FPW ... JBS NEXTFPB,1,AFFROZ [J IF BLOCK FROZEN ?FT6 ... EXIT 7 1 ?FYB ...[ ?FYK ...[ SUBROUTINE TO TIDY UP WHEN VALID FPB BEING FREED OR USED ?FYS ...[ LINK - X7, X1 POINTS TO FPB, X2 USED, X0 CONTAINS ALOGLEN ON EXIT ?F^3 ...[ ?F^= ...SCLEARFPB ?F^F ... LDX 0 JOBNOWAS(1) [NOW SET UP AS INVALID FPB ?F^N ... STOZ JOBNOWAS(1) [CLEAR JOB NO. ?F^X ... LDN 2 BJOBQ ?G26 ...XJOB LDX 2 FPTR(2) ?G2* ... BXU 0 JOBNUM(2),XJOB ?G2J ... BC 2,JBWASIN [CLEAR WAS FPB MARKER IN JOB BLOCK ?G2R ... LDX 0 ALOGL(1) ?G32 ... EXIT 7 0 ?G39 ...[ ?G3L ...VALFPB [HAVE TO GET VALID FPB THEN ?G6W ... LDN 1 BOBJUNUSE ?G=6 ... CALL 7 NEXTFPB [GET NEXT FPB ON CHAIN ?G*B ... BRN USECHAP [J TO USE CHAP. IF NO FPB ?GQB ... CALL 7 SCLEARFPB [CHANGE VFPB TO IFPB ?H7B ... ADS 0 CINVFPB [ ADD INTO TOTAL OF INVALID FPB'S ?H=L ...XGOTFPB ?H=R ...# ?H=Y ...# ACAS (DC8219) - USE FPB DIRECTLY IF BIG ENOUGH ?H?5 ...# ?H?= ... LDX 0 ASIZE(1) ?H?C ... SBX 0 GEN4 ?H?J ... BNG 0 XGOTFPB1 [J IF FPB NOT BIG ENOUGH ?H?M ...#SKI TRACE>499-499 ?H?Q ... TRACE 1,ACASFPB ?H?W ... LDX 0 ALOGL(1) ?H#3 ... SBS 0 CINVFPB ?H#8 ... SBS 0 COBJUNUSE ?H#* ... CALL 0 NDECH [DECHAIN THE FPB ?H#G ... ADN 1 APBRG ?H#M ... CALL 0 NDECH [DERING FROM FPBG ?H#S ... SBN 1 APBRG ?H#^ ... LDX 6 ASIZE(1) ?H*6 ... BRN SALL2 ?H*? ...# ?H*D ...XGOTFPB1 ?H*W ...[ IF AFTER REDUCING FPB BY CFREETARG FPB IS OF SIZE < 64,FREE ALL FP ?HF6 ...[ ?HJB ... LDN 0 CFREETARG+63 ?HML ... BXGE 0 ASIZE(1),XALLFPB [J IF ALL FPB REQ'D ?HQW ... LDN 0 CFREETARG ?HW6 ... SBS 0 ASIZE(1) [RESET SIZE OF REMAINING INVALID FPB ?H^B ... SBS 0 ALOGL(1) ?J4L ... ADX 1 ASIZE(1) [GET ADDR. OF PART TO FREE ?J7W ... STO 1 FPTR(1) [ AND SET UP ITS REDTAPE ?J?6 ... STO 1 BPTR(1) ?JBB ... STO 0 ASIZE(1) ?JFL ... SBN 0 A1 ?JJW ... STO 0 ALOGL(1) ?JN6 ... STOZ AFLAG(1) ?JRB ... STOZ ATYPE(1) ?JWL ... STOZ ARINGNO(1) ?J^W ... LDX 0 ASIZE(1) ?K56 ... BRN XFPB ?K8B ...XALLFPB ?K?L ... LDX 0 ALOGL(1) [REDUCE FPB COUNTS ?KBW ...XFPB ?KG6 ... SBS 0 CINVFPB ?KKB ... SBS 0 COBJUNUSE ?KNL ...#UNS ISTDPSTATS ?KRW ... TRACEDP ACORFPB,COBJUNUSE,0 ?KX6 ... BRN NONFREE [ & J TO FREE IT ?L2B ...) ?L5L ...#SKI G4 ?L8W ...( ?L#6 ...#SKI CFREETARG-1 ?LCB ... LDN 6 CFREETARG [NO. OF PAGES TO BE FREED ?LGL ...NEXTPAGE ?LKW ... LDX 0 APTURNPAGS ?LP6 ... SBX 0 CPAGETURNS ?LSB ... BPZ 0 TESTCOBJ [IF CPAGETURNS>APTURNPAGS ?LXL ... LDN 0 0 [ALL FREE PAGES AVAILABLE ?M2W ...TESTCOBJ ?M66 ... TXL 0 COBJFREE [J IF ONLY ENOUGH FREE PAGES FOR ?M9B ... BCC NOPAGS [ PAGETURNING ?M#L ... TRANSFIX CALL 0,ONEPAGE [OBTAIN LAST PAGE ON FREE PAGE CHAIN ?MCW ... LDN 0 1 [REDUCE NO. OF PAGES USED FOR ?MH6 ... SBS 0 AOBJFREE [ OBJECT PROGRAMS ?MLB ...[ ?MPL ...[ WE NOW SEARCH OBJECT PROGRAM CHAIN TO FIND THIS FREE PAGE AND ?MSW ...[ THEN REMOVE IT ?MY6 ...[ X2 = A - SCANNING POINTER ?N3B ...[ X1 = B - FOLLOWS X,ONE BLOCK BEHIND ?N6L ...[ X3 = ADDR. OF PAGE TO BE FREED ?N9W ... LDX 3 1 ?N*6 ... LDX 2 BOBJPROG [SET A=FIRST OBJECT PROGRAM BLOCK ?NDB ...#SKI K6COREALL>499-499 ?NHL ... TRACE 3,PAGEFOUN ?NLW ...NEXTOBJ ?NQ6 ... LDX 1 2 [SET B=A ?NTB ... LDX 2 FPTR(2) [SET A=NEXT BLOCK ON CHAIN ?NYL ... TXU 2 CXOBPR ?P3W ... BCC POBJ1 [J IF END OF CHAIN REACHED ?P76 ... TXL 2 3 [J IF WE STILL HAVE NOT LOCATED ?P=B ... BCS NEXTOBJ [BLOCK WITH THIS FREE PAGE IN ?P*L ...[ FREE PAGE IS IN BLOCK B ?PDW ...POBJ1 LDN 0 1024+A1D ?PJ6 ... TXU 0 ASIZE(1) ?PMB ... BCS POBJ2 [J IF NOT ONLY PAGE IN BLOCK ?PQL ... CALL 0 NDECH [DECHAIN BLOCK B ?PTW ... LDN 0 1024+A1D ?P^6 ... BRN POBJ3 ?Q4B ...POBJ2 [MORE THAN ONE PAGE IN BLOCK ?Q7L ... LDX 0 1 ?Q=W ... ADN 0 A1D ?QB6 ... TXU 0 3 [J IF FREE PAGE NOT THE FIRST PAGE ?QFB ... BCS NOTFIR [IN THE BLOCK ?QJL ... LDX 2 1 [STORE REDTAPE OF B INTO ?QMW ... ADN 2 1024 [REDTAPE OF B+1024 ?QR6 ... MOVE 1 9 ?QWB ... LDN 0 1024 [REDUCE LENGTHS OF NEW BLOCK B+1024 ?Q^L ... SBS 0 ASIZE(2) [BY 1024 ?R4W ... SBS 0 ALOGL(2) ?R86 ... SMO BPTR(2) ?R?B ... STO 2 FPTR [SET FPTR OF PREVIOUS AOBJPROG ?RBL ... SMO FPTR(2) ?RFW ... STO 2 BPTR [SET BPTR OF NEXT AOBJPROG ?RK6 ...POBJ3 ?RNB ... STO 1 FPTR(1) [SET UP REDTAPE OF FREED CORE ?RRL ... STO 1 BPTR(1) ?RWW ... STO 0 ASIZE(1) ?S26 ... STOZ AFLAG(1) ?S5B ... STOZ ATYPE(1) ?S8L ... STOZ ARINGNO(1) ?S?W ...#SKI CFREETARG-1 ?SC6 ...( ?SGB ... CALL 0 NFREE [FREE PAGE ?SKL ... BCT 6 NEXTPAGE [J IF MORE PAGES REQUIRED ?SNW ... BRN NRETRY ?SS6 ...) ?SXB ...#SKI CFREETARG-1 ?T2L ...#SKI ?T5W ... BRN NONFREE [J TO FREECORE THE CORE ?T96 ...NOTFIR ?T#B ... LDX 0 1 [IS PAGE TO FREE THE LAST ?TCL ... ADX 0 ASIZE(1) [PAGE IN THE BLOCK ?TGW ... SBN 0 1024 ?TL6 ... TXU 0 3 ?TPB ... BCS NOTFIR1 [J IF NOT ?TSL ... LDN 0 1024 [REDUCE SIZE OF B BY 1024 ?TXW ... SBS 0 ASIZE(1) ?W36 ... SBS 0 ALOGL(1) ?W6B ... LDX 1 3 [SET X1=ADDR. OF FREE PAGE ?W9L ... BRN POBJ3 [AND JUMP TO FREECORE PAGE ?W#W ...NOTFIR1 ?WD6 ... ADN 0 1024 [RESET X0 TO END ADDR. OF B-CALL D ?WHB ... LDX 7 3 [SET LENGTH OF B=ADDR.OF FREE PAGE ?WLL ... SBX 7 1 [ -ADDR.OF B ?WPW ... STO 7 ASIZE(1) ?WT6 ... SBN 7 A1 ?WYB ... STO 7 ALOGL(1) ?X3L ...[ CALL C THE NEW OBJECT PROGRAM BLOCK SPLIT OFF FROM B ?X6W ... LDX 2 3 [SET C=ADDR.OF FREE PAGE+1024-A1D ?X=6 ... ADN 2 1024-A1D [AND SET UP REDTAPE AS OBJ.PROG.BLOCK ?X*B ... SBX 0 2 [D-C ?XDL ... STO 0 ASIZE(2) ?XHW ... SBN 0 A1 [D-C-A1 ?XM6 ... STO 0 ALOGL(2) ?XQB ... LDN 0 #10 ?XTL ... STO 0 AFLAG(2) [SET LOCKED BIT ?XYW ... NAME 2,AOBJPROG ?Y46 ... STOZ BACK1(2) ?Y7B ... STOZ BACK2(2) ?Y=L ... LDX 0 1 [CHANGE SO THAT ?Y*W ... LDX 1 2 [X1=C ?YF6 ... LDX 2 0 [X2=B ?YJB ... CALL 0 NCHAIN [AND CHAIN C AFTER B ?YML ... LDX 1 3 [SET X1=ADDR OF FREE PAGE ?YQW ... LDN 0 1024-A1D [BUT WE CAN ONLY FREE 1024-REDTAPE ?YW6 ... [FOR NEXT OBJECT PROGRAM BLOCK ?Y^B ... BRN POBJ3 ?^4L ...NOPAGS ?^7W ...#SKI CFREETARG-1 ?^?6 ...( ?^BB ... SBN 6 CFREETARG ?^FL ... BNG 6 NRETRY ?^JW ...) ?^LG ... BRN USECHAP ?^N6 ...) ?^N8 ...# ?^N= ...# SUBROUTINE FOR A COUPLE OF CHECKS ABOUT CHAPTERS ?^N# ...# LINK X7, USES X0 ?^NB ...# ?^ND ...SCHAPCHK ?^NG ... LDX 0 CHAPQUOTA ?^NJ ... TXL 0 ACHAP ?^NL ... BCS (7) [EXIT IF ACHAP > CHAPTERQUOTA ?^NN ... ADN 7 1 ?^NQ ... LDCT 0 HCHAP ?^NS ... ANDX 0 GRTYPE ?^NW ... BNZ 0 (7) [EXIT 1 IF CHAPTER REQUEST ?^NY ... EXIT 7 1 [OTHERWISE EXIT 2 (ACTUALLY) ?^P2 ...# ?^P4 ...# ?^P6 ...# SUBROUTINE TO FIND NEXT USABLE CHAPTER, STARTING WITH LAST ?^P8 ...# LINK X7, X0 USED, EXIT 0 IF NONE, ELSE EXIT 1 WITH X1 = CHAP.ADDR. ?^P= ...# ?^P# ...SFINDCHAP ?^PB ... LDN 1 BCHAP ?^PD ...SFCH1 ?^PG ... TXU 1 BCHAP [J IF CHAPTER CHAIN EMPTY OR END ?^PJ ... BCC (7) ?^PL ... LDX 1 BPTR(1) [LOAD ADDRESS NEXT CHAPTER ?^PN ... TXL 1 GFIXCHAP ?^PQ ... BCC YES [J IF IN FIXED CHAPTER SPACE ?^PS ... LDX 0 AFLAG(1) ?^PW ... ANDN 0 #1002 ?^PY ... BNZ 0 SFCH1 [J IF CHAPTER FROZEN OR KEPT ?^Q2 ... EXIT 7 1 [EXIT IF CHAPTER FOUND ?^Q4 ...# ?^Q6 ...# SUBROUTINE TO ADJUST ACHAP AND CHAPTER TABLE WHEN CHAPTER FREED ?^Q8 ...# OR USED. X7 - LINK, X1 PTS TO CHAPTER, X0 AND X2 USED. ?^Q= ...# ?^Q# ...SCHAPTIDY ?^QB ... LDX 0 ASIZE(1) [MAINTAIN SUM OF CHAPTER SIZES ?^QD ... SBS 0 ACHAP [IN CORE ?^QG ...#UNS ISTDPSTATS ?^QJ ... TRACEDP ACORCHAP,ACHAP,CHAPQUOTA ?^QL ... LDX 2 BACK1(1) [SEGMENT NUMBER ?^QN ... LDX 0 BACK2(1) [BS ADDRESS ?^QQ ... STO 0 KTAB(2) [UPDATE TABLE ?^QS ... LDN 0 1 ?^QW ... SEGENTRY ADPCA2 ?^QY ...#UNS FCCHAPFREE ?^R2 ... ADS 0 FCCHAPEND [INCREMENT F-C COUNT ?^R4 ...#UNS FCCHAPFREE ?^R6 ...#SKI ?^R8 ... NULL ?^R= ... EXIT 7 0 ?^R# ...# ?^RB ...USECHAP ?^WL ...[ ?^^W ...[IF CORE NOT IMMEDIATELY AVAILABLE CHAPTER BLOCKS ARE FREED #256 ...[ #2=S ... CALL 7 SCHAPCHK [DO CHECKS, RETURNING AS FOLLOWS #2DG ... BRN NONE1 [J SINCE ACHAP > CHAPTERQUOTA #2L8 ... BRN NONE1 [J SINCE CHAPTER REQUEST #2RW ... LDX 0 CJSUM [OR IF CORE JAM EXISTS #2X6 ... SBN 0 XJCHAPLOW #32B ... BNG 0 TOOMU #35L ... FIXTRA CHAPLOW1 #36N ...# CHECK WITH RTM CHAPLOW BEFORE ALTERING NEXT 3 INSTRS. #37R ... BRN NONE1 #39Y ... BRN TOOMU #3#6 ...NONE1 #3K2 ... CALL 7 SFINDCHAP [FIND USABLE CHAPTER #3TW ... BRN TOOMU [J IF END OF CHAIN #46Q ... CALL 7 SCHAPTIDY [ADJUST CHAPTER TOTAL AND TABLE #4CL ...# #4NG ...# ACAS (DS8219) - USE CHAPTER DIRECTLY IF BIG ENOUGH #4^B ...# #5== ... LDX 0 ASIZE(1) #5H6 ... SBX 0 GEN4 #5S2 ... BNG 0 NONFREE [J IF NOT BIG ENOUGH #5^X ...#SKI TRACE>499-499 #67S ... TRACE 1,ACASCHAP #6*Q ... CALL 0 NDECH [DECHAIN CHAPTER #6LL ... LDX 6 ASIZE(1) #6XG ... BRN SALL2 #78B ...# #7FB ...NONFREE #7JL ... CALL 0 NFREE [FREE CHAPTER #7MW ...NRETRY #7R6 ... LDX 4 GEN4 [ RESTORE REQUEST SIZE #7WB ... BRN NOR [ AND JUMP TO TRY AGAIN #87G [ #8M6 [IF NO CORE CAN BE GIVEN THE LINK OF THE CALLING ACTIVITY IS SET BACK #96Q [AND GETCORE COORDINATES SETTING THE ACTIVITY WAITING FOR CORE UNLESS #9LB [IT WAS AN OPTIONAL REQUEST OR A REQUEST FOR CHAPTER SPACE #=62 [ #=KL LABFIX EXESIV [ 'FAIL' RE-ENTRY POINT FOR LONGLOCK #?5= [ GETCORES #?=D ...#UNS ICASSTATS #?CM ... BRN TOOMU1 #?JW TOOMU #?R? ...#UNS ICASSTATS #?SJ ...( #?TT ... LDN 0 1 #?X6 ... ADS 0 CASFAIL [ADD TO TOTAL NUMBER OF FAILS #?XQ ... CALL 7 SCASMILL [ADD TO CAS MILL #?YC ...) ##2^ ...TOOMU1 ##4G LDX 0 GRTYPE ##J6 SLC 0 1 #*3Q BPZ 0 NOWAIT [ JUMP IF REQUEST WAS OPTIONAL #*HB SLC 0 4 #B32 BNG 0 SCHREQ [J IF CHAPTER BLOCK REQUEST #BGL CALL 0 SETWAITING #C2= LDN 0 1 [ STEP ON COUNT OF QUEUED CORE #CFW ADS 0 CWAIT [ REQUESTS #C^G LDX 1 CLONG1(2) [ TEST IF REQUEST FAILED PREVIOUSLY #DF6 BNG 1 WX1 [ JUMP IF YES #DYQ ADS 0 CFAIL [STEP TOT OF OUTSTANDING CORE REQ'STS #FDB LDCT 0 #400 [ INDICATE FAILED REQUEST #FY2 ORS 0 CLONG1(2) #G4D ...WX1 #GQL ... COOR3X #1 [WAIT FOR CORE #GX= [ #HBW [ THIS ROUTINE STEPS BACK LINK SO THAT THE ACTIVITY WILL RE-ENTER THE #HWG [ CORE ROUTINE ON BEING RESTARTED #JB6 SETWAITING #JTQ STO 0 GL2 #K*B NGN 0 3 [DIFFERENT ENTRIES TO G/C CAUSE LINK #KT2 ADX 0 GLINKSTEP [ TO BE STEPPED BACK DIFFERENTLY #L#L LDX 2 FX2 #LS= ADJUSTLK 2 #M?W BRN (GL2) #MRG [ #N?6 [FOR OPTIONAL REQUEST THE LINK IS STEPPED FORWARD ONE THEN EXITS VIA #NQQ [THE COORDINATOR #P=B [ #PQ2 NOWAIT #Q9L LDX 2 FX2 [ X2 MUST EQUAL FX2 FOR EXIT TO FLIST #QP= SLC 0 6 [ HLINKB. EXIT WITHOUT STEPPING LINK #R8W TRANSFIX BNG 0,FLIST [ FOR OPTIONAL BSTS Q-BLOCK REQUEST #RNG SRC 0 2 [ HLOCK #S86 ANDN 0 1 #SMQ ADN 0 1 [STEP LINK 2 FOR LOCKC REQU ELSE 1 #T7B ADJUSTLK 2 [ BRANCH TO FLIST #TM2 TRANSFIX BRN,FLIST [ JUMP TO COOR2 #W6L YES LDCT 0 HCHAP [J IF NOT CHAPTER REQREST #WL= ANDX 0 GRTYPE #X5W ... BZE 0 SFCH1 #XKG [ #Y56 [IF CHAPTER SPACE REQUIRED THE FIXED CHAPTER SPACE IS GIVEN WHEN #YJQ [POSSIBLE #^4B [ #^J2 SCHREQ #^K8 ...#UNS JPSCF #^LB ...( #^MJ ...[ CHECK IF FIX CHAP FREE #^NQ ... BSOFF FXCHAPIN,XBWA #^PY ... LDX 2 FX2 #^RS ... COOR3 FCXWAIT,3 #^TN ... TRANSFIX BRN,BSTS10 #^XJ ...[ BSTS HAS ANOTHER TRY AT GETCHAP #^^4 ...XBWA ON FXCHAPIN *22= ...) *23L LDX 1 GFIXCHAP *2H= LDX 0 BACK2(1) *32W BZE 0 SCHN [ZERO IF FIXCHAP UNUSED *3GG LDX 2 BACK1(1) [SEGMENT NUMBER *426 STO 0 KTAB(2) [UPDATE TABLE *4FQ SCHN *4^B LDX 0 GLOGLEN *5F2 STO 0 ALOGLEN(1) [FOR BENEFIT OF P/M CHECKSUM *5YL LDX 2 FX2 *6D= CHAIN 1,2 [ CHAIN FIXCHAP AFTER ACTIVITY BLOCK *6XW TRANSFIX BRN,FZCO [ EXIT TO BSTS VIA CHAPTER CHANGER *7CG [ *7X6 [ *8BQ [ THIS ROUTINE COPIES THE BLOCK POINTED TO BY X2 TO THE FIRST BLOCK *8WB [ AFTER THE CURRENT ACTIVITY AND FREES THE OLD SITE *9B2 [ *9TL LABFIX HCOPY *=*= ZCOPY STO 0 GL2 *=SW ZCOPYA [ENTRY FROM ALTLENG-IMPLICIT BLOCKCPY *?#G STO 3 GEN2 *?S6 SMO FX2 *#?Q LDX 1 FPTR *#RB CALL 0 NDECH [DECHAIN THE NEW BLOCK **?2 LDX 0 1 **QL LDX 1 2 [SOURCE - OLD BLOCK *B== LDX 2 0 [DESTINATION - NEW BLOCK *BPW LDX 0 ASIZE(2) [REMEMBER SIZE/LOGLEN OF NEW BLOCK *C9G STO 0 GEN3 *CP6 LDX 0 AFLAG(2) *D8Q ANDX 0 FLAGPHYS *DNB STO 0 GEN5 [REMEMBER 'PHYSICAL' BITS OF AFLAG *F82 LDX 3 ALOGLEN(2) *FML STO 3 GEN4 *G7= ADN 3 A1 [LENGTH TO MOVE *GLW CALL 0 MOVE [MOVE BLOCK *H6G LDX 1 BDESTN *HL6 LDX 0 GEN3 *J5Q STO 0 ASIZE(1) [RESTORE SIZE (WITH LOCK BIT IF *JKB LDX 0 GEN4 [ NECESSARY, & LOGLEN OF NEW BLOCK *K52 STO 0 ALOGLEN(1) *KJL LDX 0 GEN5 [RESTORE 'PHYSICAL' AFLAG BITS TO *L4= ORS 0 AFLAG(1) [ NEW BLOCK *LHW LDX 3 GEN2 *M3G LDX 1 BSOURCE *MH6 BRN N21X [J TO FREE OLD SITE *N2Q [ *NGB [THIS SUBROUTINE MOVES THE NUMBER OF WORDS IN X3 FROM THE ADDRESS *P22 [POINTED TO BY X1 TO THE ADDRESS POINTED TO BY X2 *PFL [IT CATERS FOR *P^= [ 1. NULL ELEMENTS *QDW [ 2. EMPTY ELEMENTS *QYG [ 3. OVERLAP OF NEW AND OLD SITES -ONLY UPWARD MOVE *RD6 [ 4. TWO OR MORE ELEMENTS FOLLOWING EACH OTHER ,IMMEDIATELY OR *RXQ [ OTHERWISE IN SAME RING IN SAME BLOCK. *SCB [IT IS CALLED FROM WITHIN THE SEGMENT OR BY THE BLOCKMOVE MACRO *SX2 [ *TBL LABFIX BLKMOVE *TW= MOVE *W*W STO 0 GEN0 *WTG STO 3 GUSSIZE [LENGTH TO MOVE *X*6 STO 1 BSOURCE [ADDR TO MOVE FROM *XSQ STO 2 BDESTN [ADDR TO MOVE TO *Y#B #SKI K6COREALL *YS2 ( *^?L BXL 2 FCORES,MOV1 [ERROR IF DESTINATION NOT IN *^R= ... BXGE 2 GFIXCHAP,MOV1 [ VARIABLE CORE B2=W ) B2QG SMO FPTR(1) [THESE UPDATE STANDARD RING B3=6 STO 2 BPTR B3PQ SMO BPTR(1) B49B STO 2 FPTR B4P2 TXU 1 FX2 B58L BCS XXXX [J IF BLOCK NOT CURRENT ACT B5N= STO 2 FX2 [OTHERWISE RESET FX2 FOR NEW SITE B67W XXXX B6MG LDX 0 ARINGNO(1) B776 ANDX 0 BSP16 B7LQ BZE 0 SNORING [J IF NO RINGS B86B LDX 3 ARINGNO(1) B8L2 SRL 3 15 B95L STO 3 GEN1 [ISOLATE RING DIMENSION B9K= MOVE 1 A1 B=4W ADN 2 ARINGNO+1 B=JG ADN 1 ARINGNO+1 [POINT TO FIRST RING B?46 SMORE LDX 3 BPTR(1) [PRECEDING BLOCK B?HQ BZE 3 SNULL [UNLESS NULL ELEMENT B?JT ...#SKI K6COREALL B?KY ...( B?M3 ...[ CHECK CHAINING OF RING ELEMENT B?N6 ...[ B?P9 ... SMO FPTR(1) B?Q# ... TXU 1 BPTR B?RC ... BCS SRERR B?SG ... TXU 1 FPTR(3) B?TK ... BCC SMOK B?WN ...SRERR B?XR ... GEOERR 1,BADRING! B?YW ...SMOK B?^^ ...) B#3B SMO FPTR(1) [THESE INSTRUCTIONS UPDATE REFS. B#H2 STO 2 BPTR [TO RING CATERING B*2L STO 2 FPTR(3) [FOR EMPTY RING B*G= SNULL LDX 3 GEN1 B*^W MOVE 1 0(3) [MOVE ELEMENT BBFG ADX 1 GEN1 [UPDATE OLD AND NEW ELEMENT SITE BB^6 ADX 2 GEN1 [ POINTERS BCDQ BCT 0 SMORE BCYB LDX 3 GUSSIZE [CALCULATE BDD2 ADX 3 BSOURCE [REMAINDER BDXL SBX 3 1 [TO BE MOVED BFC= BZE 3 NMV1 BFWW SNORING BGBG TXL 3 B513 [JUMP IF SIZE<512 BGW6 BCS NMV BH*Q #SKI K6COREALL BHTB ( BJ*2 BPZ 3 MOV2 [ERROR IF NEGATIVE BJSL MOV1 GEOERR 1,COREMOVE BK#= MOV2 BKRW ) BL?G MOVE 1 512 [OTHERWISE MOVE 512 WORDS BLR6 ADN 1 512 [AND UPDATE BM=Q ADN 2 512 [POINTERS BMQB SBN 3 512 [AND AMOUNT TO BE MOVED BN=2 BRN SNORING BNPL NMV MOVE 1 0(3) [MOVE RESIDUE BP9= NMV1 BPNW LDN 3 1 BQ8G ADS 3 BCOUNT [INDICATE BLOCK MOVED BQN6 LDX 0 FLAGLOG BR7Q SMO BDESTN BRMB ANDS 0 AFLAG [ERASE ALL BUT LOGICAL BITS OF AFLAG BS72 BRN (GEN0) BSLL [ BT6= [THIS ROUTINE ALTERS THE LOGICAL LENGTH OF THE BLOCK SPECIFIED IN X1 BTKW [TO THE LENGTH SPECIFIED IN X2 BW5G [ THE ALTLENG ENTRY IS BY THE REPLACER CHANGEG. IF X1'NE'FX1 & X2'NE'FX2 BWK6 [ THEN ITS THE FIRST ENTRY. IF X1=FX1 BUT X2'NE'FX2, THIS IMPLIES THE BX4Q [ LINK HAS BEEN STEPPED BACK 2 - A RE-ENTRY AFTER WAITING FOR CORE. IF BXJB [ X1=FX1 & X2=FX2, THIS IMPLIES LINK STEPPED BACK 1 - SUCCESS RE-ENTRY BY42 [ AFTER GETTING CORE BYHL [ B^3= LABFIX ALTLEN B^GW NALT STO 0 GL2 [REMEMBER LINK C22G STOZ GLINKSTEP [ZERO FOR ALTLEN ENTRY C2G6 BRN PATH C2^Q LABFIX ALTG C3FB NALTG STO 0 GL2 [DUMP LINK C3^2 LDN 0 2 C4DL STO 0 GLINKSTEP [LINK STEPPER INCREMENT / FLAG C4Y= BXU 1 FX1,PATH [J IF FIRST ENTRY C5CW STO 2 GEN1 [ ELSE RE-FIND SOURCE BLOCK C5XG LDX 2 FX2 C6C6 SMO GL2 C6WQ LDX 0 0 C7BB BZE 0 YCURA [J IF %C WAS £ - CURRENT ACTIVITY C7W2 ADX 0 FX1 C8*L CALL 1 (0) C8T= YCURA LDX 0 GEN1 C9#W BXU 0 FX2,TRYAG [J IF RE-ENTRY AFTER CORE WAIT C9SG LDN 0 1 [ ELSE SET LINK TO INSTR AFTER MACRO C=#6 ADS 0 GL2 [ & J TO DO IMPLICIT BLOCKCOPY C=RQ BRN ZCOPYA C??B TRYAG LDX 1 2 C?R2 LDX 2 0 C#=L PATH C#Q= #SKI K6COREALL C*9W ( C*PG BXL 1 FCORES,SILL2 [ERROR IF BLOCK NOT IN VARIABLE CORE CB96 ... BXGE 1 GFIXCHAP,SILL2 CBNQ TXL 2 AFREE [AND NOT ASKING FOR MORE THAN IS CC8B BCS NOTILL6 [AVAILABLE CCN2 SILL2 GEOERR 1,ALTLEN CD7L NOTILL6 CDM= ) CF6W LDX 0 GLINKSTEP CFLG SRL 0 1 CG66 ADS 0 GL2 CGKQ #SKI K6COREALL>799-799 CH5B ( CHK2 TRACE 1,EXTBLOCK CJ4L TRACE 2,EXTSIZE CJJ= ) CK3W LDX 0 AFLAG(1) CKHG ANDN 0 6 CL36 ERN 0 6 CLGQ BNZ 0 NLLCK [J IF NOT LL AND FROZEN CM2B LDX 0 ALOGLEN(1) CMG2 SBX 0 2 CM^L BNG 0 NEXTEND [DON'T LET FROZEN LLB EAT FAG-END CNF= NLLCK CNYW LDX 0 ASIZE(1) [ LOAD SIZE OF BLOCK CPDG SBN 0 A1 [SUB RED TAPE WORDS CPFY ...# CPHB ...# ACAS (DS8219) - IF BLOCK FOLLOWING THE BLOCK TO BE LENGTHENED CPJS ...# IS FREE AND LARGE ENOUGH, USE DIRECTLY CPL= ...# CPMN ... BXGE 0 2,YZ12 [J IF ENOUGH CPP6 ... LDX 0 AFLAG(1) CPQJ ... ANDN 0 2 CPS2 ... BNZ 0 NEXTEND [J IF FROZEN CPSF ... LDX 0 GFIXCHAP [J IF EMS CPSY ... BNG 0 NEXTEND CPTD ... STO 2 GEN4 [REQD SIZE -> GEN4 CPWW ... LDX 2 1 [X2 NOW PTS TO OROGINAL BLK CPY# ... ADX 1 ASIZE(2) [ADDRESS NEXT BLK IN CORE CP^Q ... LDX 0 AFLAG(1) CQ38 ... ANDN 0 1 CQ4L ... BZE 0 NALTRST [J IF NOT FREE CQ64 ... LDX 0 ASIZE(2) [ADD SIZES CQ7G ... SBN 0 A1 [SUB RED TAPE WORDS CQ8Y ... ADX 0 ASIZE(1) CQ=B ... SBX 0 GEN4 CQ?S ... BNG 0 NALTRST [J IF TOTAL NOT ENOUGH CQ#Q ...#SKI TRACE>499-499 CQ*N ... TRACE 1,ACASALTL CQBN ... CALL 0 NDECH [DECHAIN FREE BLK FROM FREE CHAIN CQD6 ...#UNS ISFCON CQFJ ... CALL 0 NFROUT [DECHAIN FROM SIZE RING CQH2 ... LDX 0 ASIZE(1) CQJD ... SBS 0 CFREE CQKW ... ADS 0 ASIZE(2) [ADD SIZE TO THAT OF ORIGINAL BLK CQL7 ... LDX 0 GL2 CQLD ... STO 0 GEN5 CQLP ... STO 2 GBL CQM2 ... CALL 0 NUNL CQM? ...# THIS MAY BE RE-ENTRY SO NEED UNLOCK CQMJ ... LDX 1 GBL [X1 PTS TO ORIGINAL BLK AGAIN CQMT ... LDX 0 GEN5 CQN6 ... STO 0 GL2 CQNC ... [RESTORE LINK CQNQ ... LDX 2 GEN4 [X2 PTS TO REQD SIZE AGAIN CQQ8 ... LDX 0 ASIZE(1) CQRL ... SBN 0 A1 CQT4 ...# CQXB YZ12 SBX 0 2 [GET EXCESS CRC2 STO 2 ALOGLEN(1) [RESET LOGICAL LENGTH CRWL TXL 0 SPLITLEN [J IF SOME SHOULD NOW BE SPLIT CSB= BCS NZY [JUMP IF NOT WORTH SPLITTING CSTW LDX 2 AFLAG(1) CT*G ANDN 2 2 CTT6 BNZ 2 NZY [DONT SPLIT A FROZEN BLOCK CW#Q ANDX 0 IROUNDNG CWSB SBS 0 ASIZE(1) [SUB FROM SIZE OF BLOCK CX#2 ADX 1 ASIZE(1) [ GET ADDRESS OF SPLIT PORTION CXRL STO 0 ASIZE(1) [SET ITS SIZE WORD CY?= STO 0 2 CYQW #SKI TRACE>499-499 C^=G TRACE 0,ALTLNFAG C^Q6 BRN NFA [ JUMP TO FREE FAG-END C^W3 ...NALTRST C^^Y ... LDX 1 2 D25T ... LDX 2 GEN4 D29Q NEXTEND D2PB STO 1 GBL [STORE ADDRESS OF BLOCK TO BE ALTD D392 STO 2 GLOGLEN [STORE NEW LENGTH REQUIRED D3NL [ D48= [IF ENOUGH FREE CORE CANNOT BE ADDED DIRECTLY, A NEW BLOCK OF CORE IS D4MW [OBTAINED AND THE BLOCK IS COPIED TO IT D57G [ D5M6 LDX 2 AFLAG(1) D66Q ANDN 2 4 [ PUT LONGLOCK BIT D6LB SRL 2 2 [ INTO BIT 23 OF X2 D762 LDCT 2 HMANDAT(2) [REQUEST TYPE-MANDATORY,LL IF NEC. D7KL LDX 0 GLINKSTEP [FOR ALTLENG ENTRY ONLY, STEP LINK D85= SBS 0 GL2 [ BACK 1 & J TO AVOID LOCK D8JW BNZ 0 TYPEG D94G LDN 0 #10 D9J6 ORS 0 AFLAG(1) [ SET 'LOCKED' BIT D=3Q LDCT 0 HALTLEN D=HB ORX 2 0 [MODIFY REQUEST TYPE FROM ORDINARY D?32 [ TO ALTLEN TYPE D?GL TYPEG [BOTH ALTLEN & ALTLENG D#2= LDN 1 0 [RING CONFIG - SET WHEN BLOCK COPIED D#FW LDX 0 GL2 [LINK D#^G BRN XTND [J TO PERFORM GETCORE D*F6 SMOVE LDX 2 GBL [ALTLEN RE-ENTRY AFTER GETTING CORE D*YQ CALL 0 NUNL [UNLOCK OLD BLOCK DBDB LDX 2 GBL DBY2 CALL 0 ZCOPY [COPY CONTENTS TO NEW SITE, FREE OLD DCCL TRANSFIX BRN,FLIST [ SITE & EXIT VIA THE COORDINATOR DCX= # DDBW #END ^^^^ ...13135550006800000000