(George Source)
Macros used: ACROSS, BC, BLOCKCOPY, BLOCKMOVE, BS, BXE, BXGE, BXL, BXU, CHAIN, CHAIND, COBJUNUSE, COBJUSE, COOR1, COOR2, COOR3, COREFREEZE, COREQUST, COREWAKE, DERING, ENDPAXES, ENRING, ENRINGD, FINDCORE, FINDJOBQ, FJOCA, FON, FPCACA, FPCAJO, FPUT, FREECORE, FREEOUT, FREZWAIT, GEOERR, GETCORE, HUNT2, ICT, JBC, JBS, JMBAC, LOCK, MENDAREA, MHUNTW, NAME, PROGAXES, SEGENTRY, SWAP, TEST, TESTAXES, TRACE, UP, UPPLUS
22FL ...#SEG COREALLF [ DEK BEASLEY : CENT 22KH ...[ 22PD ...[ (C) COPYRIGHT INTERNATIONAL COMPUTERS LTD 1983 22T* ...[ 22^= #OPT K0COREALLF=0 23DW #LIS K0COREALLF>K0KERNEL>K0ALLGEO 23YG #OPT K6COREALLF=K6KERNEL>K6ALLGEO 24D6 #DEF TRACE=K6COREALLF 24XQ # 25CB [ THIS IS THE PART OF THE CORE ALLOCATOR IMPLEMENTED OUT OF FIXED CORE 25X2 [ IT HAS THE FOLLOWING ENTRY POINTS 26BL [ 1. ENTRY FOR THE LONGLOCK GETCORE 26W= [ 2. ENTRY FROM THE GEORGE 3 STARTSTRAT PACRO VIA DOWN 27*W [ 3. ENTRY FROM THE GEORGE 3 EXTRACOR MACRO VIA DOWN 27TG [ 4. ENTRY FOR THE NOISY CORE SYSTEM 28SQ [ 41. ENTRY FROM THE GEORGE 4 COREFLUSH MACRO VIA DOWN 294J ...[ 5. ENTRY FROM GETPROGCORE TO OBTAIN PROGRAM CORE(G4 ONLY) 29#B [ 29S2 8HCOREALLF 2=?L [ THE ENTRY POINTS 2=R= [ THESE ENTRY POINTS MUST BE KEPT FIXED WITHIN THE SEGMENT 2?=W SEGENTRY K1COREALLF,QENTRY1 2?QG SEGENTRY K2COREALLF,QENTRY2 2#=6 SEGENTRY K3COREALLF,QENTRY3 2#PQ SEGENTRY K4COREALLF,QENTRY4 2#SW ... SEGENTRY K5COREALLF,QENTRY5 2#Y2 ...[ 2*36 ...[ TABLE OF COREFREEZE ABORT CONDITION SUBROUTINES 2*6= ...[ FIRST ENTRY IS SUBROUTINE NO. 1 2*9B ...XABANSUB 2*#G ... +UTEST 2*CL ... +SWAPTEST 2*GQ ... +STRATEST 2*KW ...XABANEND 2*P2 [ 2B8L [ THIS PART OF THE SEGMENT IMPLEMENTS THE COREFREEZE MACRO,VIA WHICH IT 2BN= [ IS ENTERED BY S/R CALL. VARIABLES ARE USED AS FOLLOWS: 2C7W [ WORD MNEMONIC IN USED FOR 2CMG [ GIM 2D76 [ X2 - ALWAYS HOLDS FX2 2DLQ [ X3 X SCANNING POINTER 2F6B [ X4 P' START OF EXTENDED FREEZE 2FL2 [ X5 Y FOLLOWS X, ONE BLOCK BEHIND 2G5L [X0,1,6,7 - WORK WORDS 2GK= [ 2H4W [ AWORK1 B0-12 RELATIVISED S/R LINK 2HJG [ B13-17 UNUSED 2J46 [ B18-19 A FIELD TO HOLD THE VALUE OF %E 2JHQ [ B20 LOCKED BLOCK FOUND THIS PASS 2K3B [ B21 FREE CHAPTERS THIS PASS 2KH2 [ B22 COORDN SINCE FINDING LOCKED BLOCK 2L2L [ B23 UNUSED 2LG= [ AWORK2 P START OF REQUESTED FREEZE 2L^W [ AWORK3 Q END OF REQUESTED FREEZE 2MFG [ AWORK4 T VALUE OF APROCTIME WHEN WE TIME OUT 2M^6 [ (BEFORE 1ST WAIT = -(MAX(%F,0)) ) 2NDQ [ 2NYB [ WORDS FOLLOWING S/R CALL 2PD2 #DEF RFAIL=0 [BRANCH TO FAIL EXIT %C 2PXL #DEF RTABORT=RFAIL+1 [ABORT S/R LABEL %D ( 0 IF NOT SPECD) 2QC= #DEF RLLBLK=RTABORT+1 [ACTION ON LONGLOCK BLOCKS %E 2QWW #DEF RTIMOUT=RLLBLK+1 [TIME OUT INTERVAL %F 2RBG #DEF RSUCCESS=RTIMOUT+1 [SUCCESS EXIT 2RW6 [ 2S*Q [ FIRST WE SEE IF THERES ENOUGH FREE/CHAP CORE TO IMPLEMENT THE FREEZE 2STB [ 2T*2 RCORFREZ 2TSL LDX 2 FX2 2W#= ANDX 6 IROUNDNG 2WCB ...#UNS CA1D 2WGG ... ADX 7 CIRNDA 2WKL ...#UNS CA1D 2WNQ ...#SKI 2WRW ADN 7 IROUND-1 2X?G ANDX 7 IROUNDNG 2XR6 ADX 7 6 2Y=Q STO 6 AWORK2(2) [STORE P 2YQB STO 7 AWORK3(2) [STORE Q 2^28 ... LDX 1 0 2^=2 SBX 0 FX1 2^PL SLL 0 12 329= STO 0 AWORK1(2) [STORE LINK / INITIALISE FLAGS 32#B ... LDX 0 RLLBLK(1) [LOAD %E 32CG ... STO 0 GEN2 [TEMPORARY COPY OF %E 32GL ... SLL 0 4 32KQ ... ORS 0 AWORK1(2) [SET B18-19 TO HOLD %E 32NW SBX 7 6 [SIZE OF FREEZE 32T6 ...#SKI G4 32^B ...( 335L ... LDX 0 GEN2 [LOAD %E 339W ... SBN 0 3 33B6 ... BNZ 0 RNE31 [J IF NOT %E=3 33GB ... STOZ GEN3 33LL ... BRN RNE32 33QW ...RNE31 33X6 ...) 343B ... LDX 0 ACHAP 347Q SBX 0 CHAPQUOTA [ UNFROZEN FREEABLE (SOME NEEDED FOR 34=W ... BPZ 0 RLESSCQ [IF ACHAP<CHAPTERQUOTA 34B2 ... LDN 0 0 [ASSUME RESULT ZERO 34F6 ...RLESSCQ 34FJ ... ADX 0 COBJUNUSE [CAN USE FPB'S 34J= ... ADX 0 CFREE 34MB SBX 0 FREZTOT [ FROZEN UNFREEABLE) MINUS 3572 ADX 0 FREZFREE [ FROZEN UNFREEABLE 35LL ADX 0 FREZCHAP 366= SBX 7 0 36KW #SKI TRACE>599-599 375G TRACE 7,SPARECOR 37K6 BPZ 7 RABAN3 [ABANDON FREEZE IF NOT ENOUGH CORE 384Q ...RNE32 CALL 7 RABORTIO 38JB BRN RABAN9 [J IF ABORT REQUEST ALREADY OCCURED 3942 [ 39HL [ NOW WE SET P' TO THE START OF THE BLOCK WHICH CONTAINS P 3=3= [ 3=GW LDX 7 AWORK2(2) [X7=P 3?2G LDN 1 BFREE 3?G6 ROUN1 LDX 1 BPTR(1) [ STEP DOWN FREE CHAIN UNTIL 3?^Q BXL 7 1,ROUN1 [ X1 </= P , TO GET SUITABLE START 3#FB BXU 1 CXFR,ROUN3 [ IF AT CHAIN BASE, USE LOWEST BLOCK 3#^2 LDX 1 FCORES 3*DL ROUN3 LDX 0 1 [X1:= LOWEST BLOCK (OF ANY KIND) > P 3*Y= ADX 1 ASIZE(1) 3BCW BXGE 7 1,ROUN3 3BXG #SKI TRACE>599-599 3CC6 TRACE 0,ROUN P' 3CWQ LDX 4 0 [P'=X0, HIGHEST BLOCK </= P 3DBB [ 3DW2 [ NOW WE SCAN THE FREEZE AREA MARKING ALL BLOCKS FROZEN , AND MAKING 3F*L [ FREE BLOCKS PSEUDO FREE. ALSO CHECK FOR %E OR %F ABANDON CONDITIONS 3FT= [ 3G#W ...ROUN4 LDX 1 AWORK1(2) 3GSG SRL 1 12 3H#6 ... ADX 1 FX1 [X1 POINTS TO RETURN LINK OF S/R CALL 3L9W NGX 0 RTIMOUT(1) 3M96 BNG 0 RPOS [J IF %F NOT 0 OR -1 3MNQ LDN 0 0 3N8B RPOS STO 0 AWORK4(2) [REMEMBER -(MAX(%F,0) 3P7L LDX 3 4 [X=P' 3PM= NGN 5 1 [Y=-1 3Q6W RSCAN 3QLG #SKI TRACE>599-599 3R66 ( 3RKQ TRACE ATYPE(3),RSCAN TP 3S5B TRACE AFLAG(3),RSCAN FG 3SK2 ) 3T4L ... JMBAC RSCA2,3,AFLONG,AFFROZ [J IF BLOCK NOT LL NOR FROZEN 3TJ= ... JBS RABAN7,3,AFFROZ [ABANDON FREEZE IF FROZEN 3XGQ LDX 0 GEN2 3Y2B TXL 3 CTOP [ CHECK BLOCK NOT 3YG2 BCC RSCAA [ 'ESCAPED' FROM LL AREA 3Y^L STO 3 CTOP 3^F= STOZ BLLCLOCK [ FORCE IN REDUCELL 3^YW SBN 0 2 42DG BNG 0 RABAN2 42Y6 GEOERR 1,CTOP! 43CQ RSCAA BZE 0 RABAN2 [ - ELSE LONGLOCK:ABANDON IF %E=0 43XB [ THIS SECTION DEALS WITH NON-PSEUD BLOCKS 44C2 RSCA2 LDX 7 ASIZE(3) [ BLOCK SIZE 44WL ... JMBAC RSCA4,3,AFLOCK,AFFREE [J IF BLOCK NOT LOCKED NOR FREE 45B= ... JBS RSCA3,3,AFFREE [J IF FREE 47PL ... NGX 0 AWORK4(2) 47SB BNG 0 RABAN8 [ - OTHERWISE LOCKED:ABANDON IF %F<0 48#2 BRN RSCA4 [ ELSE CHECK IF ITS A CHAPTER BLOCK 48RL RSCA3 SBS 7 CFREE [ UPDATE FREE TOTAL 49?= ADS 7 FREZFREE [MAKE FREE BLK PSEUDO FREE AND CHAIN 49QW LDX 0 FPSEUTYP [ IN FREEZE CHAIN 4==G STO 0 ATYPE(3) 4=Q6 STOZ AFLAG(3) [ CLEAR THE 'FREE BLOCK' BIT 4?9Q CHAIND 3,BCAFREZ 4?#* ...#UNS ISFC 4?BY ...( 4?FH ... FREEOUT 3 [REMOVE BLK FROM SIZE RING 4?J6 ... LDX 1 FX1 [RESTORE X1 4?LP ...) 4?PB BRN RSCA1 4#92 RSCA4 LDX 0 ATYPE(3) 4#NL BXU 0 GCHTY,RSCA1 [J IF NOT CHAPTER 4*8= SBS 7 ACHAP 4*MW ADS 7 FREZCHAP 4B7G ...RSCA1 BS 3,AFFROZ [SET FROZEN BIT 4BM6 ...RSCA5 LDX 5 3 [SEY Y=X 4C6Q ADX 3 7 [STEP X TO NEXT BLOCK 4C=9 ... TXL 3 AWORK3(2) 4C*N ... BCS RSCAN [J IF X<Q 4CF7 ... SBX 3 4 [OBTAIN LENGTH OF EXTENDED FREEZE 4D^P ... ADS 3 FREZTOT [INCR.FREZTOT BY EXTENDED FREEZE SIZE 4F22 ... LDX 3 5 4F25 ... JBC NOTFPB,3,AFFPB [J IF NOT FPB 4F28 ... SMO ASIZE(3) 4F2? ... LDN 0 0(3) [END OF FPB 4F2B ... BXE 0 AWORK3(2),NOTFPB1 [J IF EQUALS END OF FREEZE 4F2F ...[ 4F2J ...[ WE HAVE FPB OVERSPILL.SO SPLIT FPB AT END OF FREEZE LEAVING 4F2M ...[ AS 2 INVALID FPB'S,THE 2ND BEING UNFROZEN 4F2Q ...[ 4F2T ... CALL 7 RINVFPB [INVALIDATE FPB IF VALID 4F2Y ... LDX 1 AWORK3(2) 4F33 ... LDX 0 3 4F34 ...#UNS CA1D 4F35 ...( 4F36 ... LDX 2 CA1D 4F37 ... MOVE 0 0(2) [COPY REDTAPE 4F38 ... LDX 2 FX2 4F39 ...) 4F3= ...#UNS CA1D 4F3? ...#SKI 4F3# ... MOVE 0 A1D [COPY REDTAPE 4F3* ... ADX 0 ASIZE(3) 4F3B ... SBX 0 1 [SIZE OF OVERSPILL 4F3C ... SBS 0 FREZTOT [REDUCE FREEZE TOTAL 4F3G ... SBS 0 ASIZE(3) [REDUCE SIZE OF ORIG. FPB 4F3K ... SBS 0 ALOGL(3) 4F3N ... STO 0 ASIZE(1) 4F3R ... SBN 0 A1 4F3W ... STO 0 ALOGL(1) 4F3^ ... BC 1,AFFROZ 4F44 ... STO 1 FPTR(1) 4F47 ... STO 1 BPTR(1) 4F4= ... LDN 0 A1 4F4* ... SBS 0 CINVFPB [CINVFPB IS TOTAL OF ALOGL'S 4F4D ... SBS 0 COBJUNUSE 4F4H ... CHAIN 1,3 [CHAIN NEW FPB ON FPB CHAIN 4F4L ... LDX 1 AWORK3(2) 4F4P ... ENRINGD APBRG(1),APBRG(3) 4F4S ...NOTFPB 4F5= LDX 1 5 [ATTEMPT TO DISECT TOP BLOCK TO 4FJW CALL 7 SURGERYT [ REDUCE EXTENDED FREEZE 4FSN ...NOTFPB1 4G4G [ 4GJ6 [ NOW ITS FREEZE PROCESSING PHASE. FIRST,IN 'KEEP CHAPTERS' MODE WE 4H3Q ...[ CLEAR OUT EVERYTHING EXCEPT CHAPTERS & FPB'S(G3 ONLY); THEN, IF THAT 4HHB ...[ WORKED ,WE CLEAR THEM OUT TOO 4J32 [ 4JGL NGN 0 5 4K2= ANDS 0 AWORK1(2) [CLEAR FREE CHAPTERS SWITCH 4KFW RSTART 4K^G LDX 1 4 [ATTEMPT TO DISECT BOTTOM BLOCK TO 4LF6 RSTARTA 4LYQ CALL 7 SURGERYB [ REDUCE EXTENDED FREEZE 4MDB NGN 0 #13 [CLEAR 'LOCKED BLOCK'&'COORDINATION' 4MY2 ANDS 0 AWORK1(2) [ SWITCHES 4NCL #SKI TRACE>599-599 4NX= TRACE AWORK1(2),RSTART 4PBW LDX 3 4 [SET X=P',START OF EXTENDED FREEZE 4PCT ...[ 4PDS ...[ X6 IS USED FROM HERE ONWARDS TO CONTAIN THE ADDRESS OF THE NEXT 4PFR ...[ K BOUNDARY.THIS IS ONLY USED FOR A GETPROGCORE REQUEST(%E=3) IN 4PGQ ...[ G4.MNEMONIC IN GIM IS K 4PHP ...[ 4PWG NGN 5 1 4QB6 RNEXT 4QTQ #SKI TRACE>599-599 4R*B ( 4RT2 TRACE ATYPE(3),RNEXT TP 4S#L TRACE AFLAG(3),RNEXT FG 4SS= ) 4T?W LDX 7 ATYPE(3) 4TRG BXU 7 FPSEUTYP,RLOCD [J IF NOT A PSEUD BLOCK 4W?6 RPSEU BNG 5 RPSE1 [J IF PREVIOUS BLOCK NOT A PSEUD BLK 4WQQ #SKI TRACE>599-599 4X=B TRACE 5,AMALGAMT 4XQ2 LDX 0 ASIZE(3) [ ELSE AMALGAMATE PSEUD BLOCKS 4Y9L SMO 5 4YP= ADS 0 ASIZE 4^8W DERING 3 4^NG LDX 3 5 [SET X=Y 5286 RPSE1 LDX 5 3 [SET Y=X 52MQ RSTEP ADX 3 ASIZE(3) [ ADVANCE X BY ONE BLOCK 537B BXL 3 AWORK3(2),RNEXT [ & J BACK IF X<Q :BLK STILL IN FREEZ 53C8 ...RPASSEND 53M2 LDXC 1 5 [OTHEWISE ATTEMPT TO DISSECT TOP BLOC 546L CALL 7 SURGERYT [ TO REDUCE EXTENDED FREEZE 54L= LDX 0 AWORK1(2) 555W SRC 0 4 55KG BPZ 0 RCHAPMODE [J IF NO LOCKED BLOCKS FND THIS PASS 5656 SLC 0 2 56JQ BNG 0 RSTART [J IF LOCKED BLK FND BUT COORDN SINCE 574B NGX 0 AWORK4(2) 57J2 BNG 0 RWAIT [J IF AWORK4 CONTAINS T-OUT DEADLINE 583L BZE 0 RABAN5 [ ELSE T-OUT NOW IF %F WAS 0 OR -1 58H= ADX 0 APROCTIME 592W STO 0 AWORK4(2) [ ELSE SET AWORK4 TO T-OUT DEADLINE 59GG RWAIT 5=26 #SKI TRACE>599-599 5=FQ TRACE APROCTIME,FREZWAIT 5=PJ ... BXE 2 CXAC,RABAN5 [BLANKET CANNOT DO FREZWAIT 5=^B FREZWAIT [WAIT FOR UNLOCK OR SPRING CLEAN 5?F2 CALL 7 RABORT [CHECK FOR ABORT CONDITION 5?YL BRN RABAN6 5#D= BRN RSTART [ & IF NONE TRY ANOTHER SCAN 5#WJ ...RLOCD 5*R8 ... JBS RFPB,3,AFFPB [J IF FREE PROGRAM BLOCK 5B9G ... JBS RLOKD,3,AFLOCK [J IF BLOCK LOCKED 5BMS ... JBS RCHAP,3,AFCHAP [J IF CHAPTER TO COPY AND PSEUD 5C68 ... SEGENTRY CHAPMOVE4 5CB2 LDX 7 ALOGLEN(3) 5CTL ... JBC RUSE1,3,AFLONG [J IF NOT LONGLOCK 5DSW LDX 0 AWORK1(2) [ IF %E=2, LEAVE IN AS A NON-PSEUD 5F8K ... ANDN 0 #60 [ BLOCK, OTHERWISE COPY OUT AS 5FJ# ... SBN 0 #40 [WITH ORDINARY BLOCKS 5FY3 ... BZE 0 RCHLO 5G?Q LDX 0 GLLSEMA [ TEST FOR DEADLY EMBRACE 5GRB BZE 0 RNDE [ ( AFTER TESTING SEGMENT, CHANGE 5H?2 GEOERR 0,DEADLY [ TO AN ABANDON ) 5HQL RNDE 5J== GETCORE 7,0,1 5JPW BRN RUSE2 5K9G BRN RABAN4 5KP6 RUSE1 5L8Q GETCORE 7,0 [ ORDINARY, OPTIONAL 5LNB BRN RUSE2 [J IF GETCORE SUCCESSFUL 5M82 BRN RABAN4 [ ELSE ABANDON FREEZE 5MML RUSE2 5N7= LDX 0 ATYPE(3) 5NLW BXE 0 FPSEUTYP,RUSE3 [J IF BLOCK FREED AT LAST COORDINATN 5P6G ... JBS RUSE3,3,AFLOCK [OR LOCKED 5QKB BXU 7 ALOGLEN(3),RUSE3 [ OR ALTLEN-ED 5R52 #SKI TRACE>599-599 5RJL ( 5S4= TRACE 3,SOURCE 5SHW TRACE FPTR(2),DESTN 5T3G ) 5TH6 LDX 2 3 5W2Q BLOCKCOPY [TRANSFER BLOCK TO NEW SITE, FREE 5WGB [ OLD SITE 5WMJ ... SEGENTRY CHAPMOVE6 5WSQ ... NULL 5X22 CALL 7 RABORT [CHECK IF WE NEED TO ABORT 5XFL BRN RABAN6 5X^= BRN RPSEU [ ELSE TRY PSEUD BLOCK AMALGAMATION 5YDW RUSE3 FREECORE FPTR(2) [IF SOMETHING HAPPENED TO MOVE CAND- 5YYG BRN RNEXT [ IDATE OVER GETCORE,J TO TRY AGAIN 5^D6 [ 5^XQ RLOKD [ACTION ON FINDING A LOCKED BLOCK 62CB LDN 0 #10 62X2 ORS 0 AWORK1(2) [SET 'LOCKED BLOCK FOUND' SWITCH 62XP ...#SKI G3 62YD ...( 62^7 ... LDX 0 AWORK1(2) 62^W ... ANDN 0 #60 [TEST IF %E=2 632K ... SBN 0 #40 633# ... BZE 0 RLOKD1 [J IF LL GETCORE 6348 ... LDX 0 ATYPE(3) 639B ... STO 0 ACOMMUNE9(2) [KEEP FOR COREALLH 63=N ...) 63#2 ...RLOKD1 63BL BRN RCHLO 63W= [ 63XT ...RFPB [ACTION ON FINDING FPB 63YB ... LDN 0 4 63YX ... ANDX 0 AWORK1(2) 63^D ... BZE 0 RCHLO [J IF FREE CHAPS.SWITCH UNSET 63^^ ... CALL 7 RINVFPB [INVALIDATE FPB IF VALID 642G ... LDX 0 ALOGL(3) 6433 ... SBS 0 CINVFPB 643J ... SBS 0 COBJUNUSE 6445 ... FREECORE 3 644L ... BRN RPSEU 6464 ... SEGENTRY CHAPMOVE5 64*W RCHAP [ACTION ON FINDING CHAPTER 64TG LDN 0 4 65*6 ANDX 0 AWORK1(2) 65SQ BNZ 0 RCHA1 [J IF 'FREE CHAPTERS' SWITCH SET 66#B RCHLO LDX 5 3 66S2 ORX 5 GSIGN [ ELSE INDICATE NON-PSEUD BLOCK 67?L BRN RSTEP [ &STEP TO NEXT BLOCK 67R= RCHA1 [FREE THIS CHAPTER 68=W #SKI TRACE>599-599 68QG TRACE BACK1(3),FREECHAP 69=6 LDX 1 BACK1(3) 69PQ LDX 0 BACK2(3) 6=9B STO 0 KTAB(1) [UPDATE CHAPTER TABLE 6=P2 LDX 0 ASIZE(3) 6?8L SBS 0 FREZCHAP [DECREMENT FROZEN CHAPTER TOTAL 6?DD ... LDN 0 1 6?N= SEGENTRY ADPCAF1 6?RB ...#UNS FCCHAPFREE 6?WG ... ADS 0 FCCHAPFREE [ INCREMENT F-C COUNT 6?^L ...#UNS FCCHAPFREE 6#4Q ...#SKI 6#7W NULL 6#MG FREECORE 3 6*76 SBN 1 A1(3) 6*LQ BNZ 1 RPSEU [IF NOT CURRENT CHAP,J TO AMAL PSEUDS 6B6B FPUT [ ELSE GET CURRENT CHAP BACK FIRST 6BL2 COOR1 [ (COOR2 WONT DO IT IF K8,K3 EMPTY!) 6C5L BRN RPSEU 6C5Q ...[ 6CK= [ 6D4W RCHAPMODE [REACH HERE AFTER A SUCCESSFUL SCAN WITHOUT LOCKED BLOCKS 6DJG LDX 1 4 6F46 LDN 0 4 6F?Y ... SEGENTRY CHAPMOVE8 6FHQ ANDX 0 AWORK1(2) [IF 'FREE CHAPTERS' SWITCH SET, J 6G3B BNZ 0 RCHP1 6GH2 LDN 0 4 6H2L ORS 0 AWORK1(2) [OTHERWISE SET IT AND GO BACK FOR A 6HG= BRN RSTARTA [ CHAPTER FREEING PASS 6H^W RCHP1 6JFG ... JBC RLA,1,AFLONG [J IF FIRST BLOCK NOT LONGLOCK 6KYB LDX 0 AWORK1(2) [ HERE FIRST BLOCK IS LONGLOCK TYPE 6L#5 ... ANDN 0 #60 [ IS %E=2? 6LMS ... SBN 0 #40 6M3H ... BNZ 0 RERROR [ JUMP IF NO. INCONSISTENCY 6MC= LDX 0 AWORK2(2) [ EXTENDED FREEZE BOUNDARY WILL NOT 6MWW SBX 0 4 [ BE MOVED UP TO P, YET, BUT DECRE 6NBG SBS 0 FREZTOT [ MENT FREZTOT IN ANTICIPATION. 6NW6 BRN WT 6P*Q RERROR 6PTB GEOERR 1,WRONG %E 6Q*2 RLA [ IF EXTENDED FREEZE STILL TO BE 6QSL BXU 4 AWORK2(2),RSTARTA [ CONTRACTED 6R#= LDX 0 AWORK1(2) 6RM^ ... ANDN 0 #60 6S3N ... SBN 0 #40 6SCC ... BNZ 0 RTERM 6SR6 [ IF %E=2, A FINAL PASS IS MADE OVER THE REGION (WHICH NOW CONSISTS ONLY 6T=Q [ OF ALTERNATING PSEUD AND LONLOCK BLOCKS) TO SHIFT THE LONGLOCK 6TQB [ BLOCKS TO THE BOTTOM OF THE REGION 6W=2 WT [ DEAL WITH FIRST BLOCK 6WPL #SKI TRACE>499-499 6X9= ( 6XNW TRACE 1,LLAREA 6Y8G TRACE AFLAG(1),LLAREA 6YN6 ) 6^7Q ... JBC WT1,1,AFLONG [J IF PSEUD - NOT LONGLOCK 6^MB ... BC 1,AFFROZ [UNSET FROZEN BIT 73KW LDX 6 ASIZE(1) 745G SBX 6 ALOGLEN(1) [ CHOP OFF THE FAG-END (IF IT EXISTS) 74K6 SBN 6 A1 [ TO MAKE THE FIRST PSEUD BLOCK, OR 754Q ANDX 6 IROUNDNG [ IF NO FAG-END, DELETE THIS 75JB BNZ 6 WTA [ LONGLOCK BLOCK FROM THE FREEZE 7642 ADX 1 ASIZE(1) [ AREA AND START WITH THE NEXT 76HL STO 1 4 [ BLOCK UP 773= BRN WT [ IN BOTH CASES, 77GW WTA 782G SBS 6 ASIZE(1) [ MOVE LOWER FREEZE BOUNDARY UP 78G6 ADX 1 ASIZE(1) [ ACCORDINGLY. 78^Q STO 1 4 79FB ADS 6 FREZFREE [ ADD NEW PSEUD SPACE TO PSEUD TOTAL 79^2 STO 6 ASIZE(1) [ RUDIMENTARY, UNCHAINED PSEUD BLOCK 7=DL BRN WT1A [ SKIP SINCE BLOCK NOT ON PSEUD CHAIN 7=Y= WT1 DERING 1 [ UNCHAIN THIS PSEUD BLOCK 7?CW LDX 1 4 [ RESTORE X1 AFTER DERING 7?XG WT1A ADX 1 ASIZE(1) [ LOOK AT NEXT 7#C6 TXL 1 AWORK3(2) [ CONTINUE IF BLOCK STILL IN FREEZE 7#WQ BCC WT4 [ REGION, OTHERWISE EXIT 7*BB LDX 6 ASIZE(1) 7*W2 ... JMBAC WT3,1,AFLONG,AFLOCK [J IF PSEUD-NEITHER LL NOR LOCKED 7B*L ... JBC WT2,1,AFLOCK [J IF NOT LOCKED 7CW9 ... LDX 1 4 [ADDR. OF CORE FOR FREE 7CYR ... BS 1,AFFROZ [SET FROZEN BIT 7D3B ... LDX 0 FPSEUTYP 7D55 ... STO 0 ATYPE(1) [SET TYPE FOR FROZEN FREE 7D6S ... LDN 2 BCAFREZ 7D8H ... ENRING 1,2 [ & CHAIN ON FROZEN FREE CHAIN 7D== ... LDX 4 AWORK2(2) [SET X4=START OF FREEZE AREA 7D#6 ... BRN RABAN5 [ABANDON IF LOCKED 7DRQ [ 7F?B [ MOVE THE LONGLOCK BLOCK DOWN TO THE BOTTOM OF THE FREEZE AREA, 7FR2 [ ADJUSTING THE POINTERS IN ITS CHAIN AND RING NEIGHBOURS IN THE 7G=L [ PROCESS, DELETE ITS 'FROZEN' MARKER AND MOVE THE LOWER FREEZE 7GQ= [ AREA BOUNDARY UP SUFFICIENT TO LEAVE BEHIND THE FAG END. 7H9W WT2 7HPG LDX 2 4 [ SET X2 FOR BLOCKMOVE 7J96 SBX 6 ALOGLEN(1) 7JNQ SBN 6 A1 7K8B ANDX 6 IROUNDNG [ THE FAG END (MAY BE ZERO) 7KN2 SBS 6 ASIZE(1) [ TRIM LONGLOCK BLOCK 7L7L ADS 6 FREZFREE [ AND ADD TO TOTAL PSEUD 7LM= ADX 6 ASIZE(2) [ SAVE THE INCREASED SIZE OF PSEUD 7M6W ADX 4 ASIZE(1) [ MOVE UP POINTER 7MLG LDX 3 ASIZE(1) [ X3 FOR BLOCKMOVE 7N66 BLOCKMOVE [ ALSO CLEARS PHYSICAL BITS OF AFLAG 7NKQ LDX 2 FX2 [ RESTORE X2 7P5B LDX 1 4 [ SET UP LOWEST PSEUD BLOCK AGAIN, 7PK2 STO 6 ASIZE(1) [ SKIPPING RED TAPE THAT ISN'T REQU'D 7Q4L BRN WT1A 7QJ= [ AMALGAMATE PSEUD BLOCK WITH LOWEST BLOCK 7R3W WT3 7RHG SMO 4 7S36 ADS 6 ASIZE 7SGQ BRN WT1 [ BRANCH TO UNCHAIN THE FUSED BLOCK 7T2B [ PUT 'EMPTY CHAIN' CHAIN WORDS IN THE PSEUD BLOCK TO ALLOW DECHAINING 7TG2 WT4 [ IN THE 'CHAIN' MACRO 7T^L LDX 1 4 7WF= STO 1 FPTR(1) 7WYW STO 1 BPTR(1) 7XDG [ 7XY6 [ SUCCESSFUL TERMINATION - REACH HERE WITH ONE PSEUD BLOCK OCCUPYING THE 7YCQ [ REQUESTED FREEZE AREA 7YXB [ 7^C2 RTERM 7^WL #SKI TRACE>599-599 82B= TRACE FREZFREE,RTERM 82TW STOZ ATYPE(1) [ SET UP BLOCK'S RED TAPE 83*G STOZ AFLAG(1) 83T6 STOZ BACK1(1) 84#Q STOZ BACK2(1) 84SB LDX 0 ASIZE(1) 85#2 SBN 0 A1 85RL STO 0 ALOGLEN(1) 86?= STOZ ARINGNO(1) 86QW CHAIN 4,2 [ CHAIN BLOCK AFTER CURRENT ACTIVITY 87=G LDX 0 AWORK3(2) 87Q6 SBX 0 AWORK2(2) [X0=SIZE OF FREEZE AREA (Q-P) 889Q SBS 0 FREZTOT [REDUCE TOTAL FROZEN 88PB LDX 0 AWORK3(2) 8992 SBX 0 4 89NL SBS 0 FREZFREE [REDUCE TOTAL OF FROZEN FREE 89YD ...RTER4 8=8= LDN 6 RSUCCESS [PREPARE FOR SUCCESS EXIT 8=MW RTER2 8?7G #SKI TRACE 8?M6 ( 8#6Q LDX 0 FREZFREE 8#LB ORX 0 FREZTOT 8*62 ORX 0 FREZCHAP 8*KL BNG 0 RUGH [ERROR IF ANY NEGATIVE 8B5= NGX 0 FREZFREE 8BJW LDN 1 BCAFREZ 8C4G BRN RUGH2 8CJ6 RUGH1 ADX 0 ASIZE(1) 8D3Q RUGH2 LDX 1 FPTR(1) 8DHB BXU 1 CXCA,RUGH1 8F32 BNZ 0 RUGH [ERROR IF FREEZE CHN TOT NOT FREZFREE 8FGL LDX 0 FREZTOT 8G2= SBX 0 FREZCHAP 8GFW SBX 0 FREZFREE 8G^G BPZ 0 RTER1 [ERROR IF FROZEN FREE + CHAPS EXCEEDS 8HF6 RUGH GEOERR 1,COREFREZ [ TOTAL 8HYQ ) 8JDB RTER1 LDX 0 CWAIT 8JY2 BZE 0 RTER3 8KCL COREWAKE [AWAKEN ACTYS WAITING FOR CORE 8KX= RTER3 LDX 7 AWORK1(2) 8LBW SRL 7 12 8LWG ADX 7 FX1 8MB6 ADX 7 6 [INCREMENT LINK FOR SUCCESS/FAILURE 8MTQ LDX 1 FX1 8N*B EXIT 7 0 8NT2 [ 8P#L [ UNSUCCESSFUL TERMINATION . Y=,OR IS SET TO, HIGHEST BLOCK PROCESSED SO 8PS= [ FAR 8Q?W [ 8QRG RABAN9 [ABORT BY REQUEST B22 (ENTRY) 8R?6 LDN 0 2 8RQQ BRN RABA3 8S=B RABAN3 [INSUFFICIENT CORE B23 (ENTRY) 8SQ2 LDN 0 1 8T9L STO 7 AWORK2(2) [SHORTFALL 8TP= RABA3 DSA 0 AWORK1(2) 8W8W BRN RFAI7 8WNG RABAN4 [INSUFFICIENT CORE B23 (OPT G/C FAIL) 8X86 LDX 0 FREZTOT 8XMQ SBX 0 FREZFREE 8Y7B SBX 0 FREZCHAP 8YM2 STO 0 AWORK2(2) 8^6L LDN 0 1 8^L= BRN RFAI1 8^W4 ...RABAN5 [TIMED OUT B21 OR LOCKED BLOCK FOUND 925W ... [IN LL GETCORE FREEZE ON FINAL PASS 92*N ... [WHICH MOVES EXISTING LL BLOCKS 92KG LDN 0 4 9356 BRN RFAI1 93JQ RABAN6 [ABORT BY REQUEST B22 944B LDN 0 2 94J2 BRN RFAI1 94L9 ...#SKI G4 94ND ...( 94QM ...RABAN10 [ABORT AS ENOUGH PAGES NOW AVAILABLE 94SW ... LDN 0 0 [ZEROISE BITS 12-23 OF REPLY WORD 94X5 ... BRN RFAI1 94^# ...) 953L RABAN2 [LL BLOCK FOUND & %E=0 B18 95H= LDN 0 #40 962W BRN RFAI2 96GG RABAN8 [LOCKED BLOCK FOUND & %F=0 B21 9726 LDN 0 4 97FQ BRN RFAI2 97^B RABAN7 [OVERLAPPING FREEZES B20 98F2 LDN 0 #10 98YL RFAI2 99D= #SKI TRACE>599-599 99XW TRACE 0,RFAI2 FG 9=CG LDX 5 3 [SET X:=Y (BLOCK ABOVE LAST PROCESSD) 9=X6 BRN RFAI8 9?BQ RFAI1 9?WB #SKI TRACE>599-599 9#B2 TRACE 0,RFAI1 FG 9#TL LDX 5 AWORK3(2) [ SET Y=Q 9**= RFAI8 DSA 0 AWORK1(2) [SET EXIT CONDITION 9*SW BXE 5 4,RFAI3 [J IF NO BLOCKS PROCESSED SO FAR 9B#G [ 9BS6 [WE ERASE THE FROZEN MARKER FROM ALL BLOCKS ALREADY PROCESSED, AND 9C?Q [UPDATE FREEZE TOTALS. ALL BLOCKS ALREADY PROCESSED ARE < Y 9CRB [ 9D?2 LDX 3 4 [X=P' 9F== RFAI4 9FPW #SKI TRACE>599-599 9G9G ( 9GP6 TRACE ATYPE(3),RFAI4 TP 9H8Q TRACE AFLAG(3),RFAI4 FG 9HNB ) 9J45 ... BC 3,AFFROZ [ERASE FROZEN BIT 9JCS ... LDX 7 ASIZE(3) [LOAD SIZE IN CASE ADATA/FPSEUD GETS 9JML ... [MERGED WITH FREE BLOCK AT FREEZE 9JXD ... [BOUNDARY 9K7= LDX 0 ATYPE(3) 9KLW BXU 0 GCHTY,RFAI5 [J IF NOT CHAPTER 9L3B ... LDX 0 ASIZE(3) [BLOCK SIZE 9LCW ... SBS 0 FREZCHAP [ ELSE UPDATE CHAPTER TOTALS 9LSB ... ADS 0 ACHAP 9M8W ... BRN RFAI9 9MKB RFAI5 BXU 0 FPSEUTYP,RFAI6 [J IF NOT PSEUDO FREE 9MXR ... LDX 0 ASIZE(3) [BLOCK SIZE 9N=8 ... SBS 0 FREZFREE [ ELSE DECREMENT FROZEN FREE TOTAL & 9NJL FREECORE 3 [ MAKE TRULY FREE-THIS UPDATES CFREE 9NM4 ... BRN RFAI9 9NPG ...RFAI6 9PP8 ...RFAI9 9PRL ... ADX 3 7 [STEP X TO NEXT BLOCK 9PW4 ... TXL 3 5 9PYG ... BCS RFAI4 [J IF X<Y 9Q3G RFAI3 BXU 5 AWORK3(2),RFAI7 [J NOT ENTERED AT RABAN4,5,6 9QH6 SBX 3 4 9R2Q SBS 3 FREZTOT [ELSE DECREMENT TOTAL FROZEN CORE 9R69 ...RFAI7 9RWG ... LDN 6 RFAIL [SET UP FOR FAILURE EXIT 9S22 #SKI TRACE>599-599 9SFL TRACE AWORK1(2),RFAI7 FG 9S^= BRN RTER2 [ & J TO EXIT 9TDW [ 9TYG [ THERE NOW FOLLOW THE SUBROUTINES USED BY COREFREEZE 9WD6 [ 9WXQ [ SURGERY SUBROUTINES. ATTEMPT TO DISECT A BLOCK AT P (SURGERYB) OR Q 9XCB [ (SURGERYT).BOTH HANDLE PSEUD BLOCKS,SURGERYB USED BLOCKS TOO. THE 9XX2 [ SUPERFLUOUS FRAGMENT IS FREED IF PSEUD ELSE MARKED NON FROZEN, AND 9YBL [ FREZFREE ETC UPDATED 9YLD ...[ SURGERYK IS USED DURING A GETPROGCORE REQUEST TO DISECT BLOCK AT 9YW= ...[ A 'K' BOUNDARY CHAINING OVERSPILL IN (FROZEN OR) FREE CORE CHAIN. 9^64 ...[ ENTER X1-> BLOCK X2=FX2 LINK X7 ;EXIT X0,X1,GEN2,3 DESTRD X2=FX2 9^*W [ =8=J ...SURGERYT =8?H ...#SKI TRACE>599-599 =8#G ...( =8*F ... TRACE ASIZE(1),SURGT SZ =8BD ... TRACE ATYPE(1),SURGT TP =8CC ...) =8DB ... SMO ASIZE(1) =8F* ... LDN 0 0(1) =8G# ... BXE 0 AWORK3(2),SURG1 [EXIT IF NOTHING TO SPLIT-LIM(X1)=Q =8H? ... LDX 0 ATYPE(1) =8J= ... BXU 0 FPSEUTYP,SURG1 [EXIT IF BLOCK NOT PSEUDO FREE =8K9 ... LDX 2 AWORK3(2) [ Q =8L8 ... STO 2 GEN2 [ADDRESS OF FRAGMENT TO BE DISCARDED =8M7 ... BRN SURG2 =8N= SURGERYB =97W #SKI TRACE>599-599 =9MG ( ==76 TRACE ASIZE(1),SURGB SZ ==LQ TRACE ATYPE(1),SURGB TP =?6B ) =?L2 BXE 1 AWORK2(2),SURG1 [EXIT IF NOTHING TO SPLIT - X1=P =#5L LDX 2 AWORK2(2) [ P =#K= LDX 0 ATYPE(1) =*4W BXE 0 FPSEUTYP,SURG3 [J IF BLOCK IS PSEUDO FREE =*JG LDX 0 ALOGLEN(1) [ ELSE CHECK LENGTH OF USED PART =*LD ...#UNS CA1D =*NB ...( =*Q# ... ADX 0 CIRNDB =*S= ... ADN 0 0(1) =*W8 ...) =*Y6 ...#UNS CA1D =B24 ...#SKI =B46 ADN 0 A1+IROUND-1(1) =BHQ ANDX 0 IROUNDNG =C3B SBX 0 2 =CH2 BPZ 0 SURG1 [ J IF IT IS TOO LONG =D2L SMO ASIZE(1) [ ELSE INCR FREZFREE BY SPARE =DG= LDN 0 0(1) =D^W SBX 0 2 =FFG ADS 0 FREZFREE =F^6 SURG3 STO 1 GEN2 [ADDRESS OF FRAGMENT TO BE DISCARDED =GDQ LDX 4 2 [UPDATE P' =GYB SURG2 SMO ASIZE(1) =HD2 LDN 0 0(1) =HXL SBX 0 2 [SIZE OF FRAGMENT =JC= SBS 0 ASIZE(1) [DECREMENT SIZE OF PARENT BLOCK =JWW STO 0 ASIZE(2) [SET UP SIZE OF NEW FRAGMENT =KBG ... STOZ AFLAG(2) =KW6 ... BS 2,AFFROZ [SET FROZEN BIT =L*Q LDX 0 FPSEUTYP =LTB STO 0 ATYPE(2) [SET TYPE - ADATA/FPSEUD =M*2 LDX 1 2 =MSL LDN 2 BCAFREZ =N#= ENRING 1,2 [CHAIN FRAGMENT IN FROZEN FREE CHAIN =NRW LDX 2 GEN2 [ADDR OF FRAGMENT TO BE DISCARDED =P?G ... BC 2,AFFROZ [MARK DISCARD NON FROZEN =Q=Q LDX 1 ASIZE(2) =QQB SBS 1 FREZTOT [DECREMENT TOTAL OF FROZEN CORE =R=2 LDX 0 ATYPE(2) =RPL BXU 0 FPSEUTYP,SURG1 [EXIT IF DISCARD NOT PSEUD =S9= SBS 1 FREZFREE [ ELSE DECREMENT TOTAL OF FROZEN FREE =SNW FREECORE 2 [RENDER BLOCK TRULY FREE =T8G SURG1 LDX 2 FX2 =TN6 EXIT 7 0 =TNN ...[ =TP= ...[ RABORT SUBROUTINE TO TEST WHETHER THE FREEZE IS STILL SUFFICIENT =TPS ...[ AFTER A COORDINATION.ONLY USED IN G4 =TQB ...[ EXIT - CALL+1 IF FREEZE NOT SUFFICINT =TQY ...[ CQLL+2 IF OKAY =TRG ...[ X0 & X1 CORRUPTED =TS4 ...[ =W7Q [ =WMB [ RABORT SUBROUTINE - CHECKS FOR AN ABORT CONDITION =X72 [ RABORTIO IS THE VERSION USED WHEN COREFREZ HAS JUST BEEN ENTERED =XLL [ =Y6= RABORT =YKW LDX 0 AWORK1(2) [SINCE S/R ONLY CALLED AFTER A =^5G ANDN 0 #10 [ COORDINATION, IF'LOCKED BLOCK FND' =^K6 SRL 0 2 [ SWITCH SET, SET'COORDINATION' ?24Q ORS 0 AWORK1(2) [ SWITCH ?2JB LDX 0 AWORK4(2) ?342 BXL 0 APROCTIME,RABAN5 [J IF TIME UP ?3HL RABORTIO ?43= LDX 1 AWORK1(2) ?4GW SRL 1 12 ?52G ADX 1 FX1 ?5G6 ... OBEY RTABORT(1) [GET ABORT SUBROUTINE NUMBER ?5^Q BZE 0 RABO1 [J IF NONE SPECIFIED ?659 ... LDN 1 XABANEND ?68N ... SBN 1 XABANSUB ?6#7 ... SBX 1 0 ?6CL ... BPZ 1 RABO2 [J IF SUBROUTINE NUMBER VALID ?6H5 ... GEOERR 1,ABORTSUB [OTHERWISE CORRUPTION OR ERROR? ?6LJ ...RABO2 LDX 1 FX1 ?6Q3 ... SMO 0 ?6TG ... LDX 0 XABANSUB-1(1) [LOAD SUBROUTINE ADDR. ?6^2 ADX 0 1 ?7DL STO 0 GEN0 [CALL SPECIFIED ABORT S/R ?7Y= CALL 0 (GEN0) [CALL 0 (0) FAILS ON STEV'GE PROCSSRS ?8CW LDX 2 FX2 ?8XG ... BNZ 0 (7) [J IF ABORT REQUESTED ?9C6 RABO1 EXIT 7 1 ?9WQ [ ?9^F ...[ SUBROUTINE TO INVALIDATE FPB IN X3 IF VALID ?=2B ...[ ENTRY X3=FPB ADDR., X7=LINK ?=3? ...[ EXIT X3=FPB ADDR. ?=48 ...[ ?=55 ...RINVFPB ?=62 ... LDX 0 JOBNOWAS(3) ?=6X ... BZE 0 (7) [J IF INVALID FPB ?=7S ... STOZ JOBNOWAS(3) ?=8P ... FINDJOBQ 1,0,(GEOERR) ?=9L ... BC 1,JBWASIN [CLEAR VALID FPB MARKER ?==H ... LDX 0 ALOGL(3) ?=?D ... ADS 0 CINVFPB [ADD SIZE INTO INVALID FPB SIZE ?=#* ... EXIT 7 0 ?=BB [ ?=W2 [ ??*L [ THIS SECTION SERVICES LONGLOCK REQUESTS. BLOCKS ARE EXAMINED ??T= [ PROGRESSIVELY FROM THE HIGHEST ADDRESS IN MOVEABLE CORE DOWN, ?##W [ AND A COUNT OF AVAILABLE SPACE (I.E. CORE WHICH IS EITHER FREE ?#SG [ OR OCCUPIED BY A NON-LONGLOCK BLOCK OR IS THE 'FAG-END' OF A ?*#6 [ LONGLOCK BLOCK) IS KEPT. IF A LOCKED LONGLOCK BLOCK IS ENCOUNTERED, ?*RQ [ THE SEARCH IS RESTARTED FROM THE NEXT BLOCK DOWN. ?B?B [ WHEN THE REQUEST IS SATISFIED, A CHECK IS MADE THAT THE REGION ?BR2 [ INVOLVED DOES NOT EXTEND BELOW THE HIGHEST PROGRAM BLOCK. ?C=L [ SINCE PROGRAM BLOCKS ARE USUALLY LARGE, MEETING ONE WILL ALMOST ?CQ= [ ALWAYS CAUSE IMMEDIATE SATISFACTION OF THE REQUEST SO THAT THIS ?D9W [ TEST IS NOT NEEDED ELSEWHERE IN THE CODE. ?DPG [ ?F96 QENTRY1 ?FNQ #SKI TRACE>499-499 ?G8B TRACE GLLSEMA,LLCORE ?GN2 STARTLL #?K* ... SEGENTRY K50COREALLF #?KS ...MTFREE #?L? ...#UNS ISFC #?LQ ...( #?M9 ... BRN THEND [STAN EXCLUDE THIS #?MN ... LDX 0 0 #?N7 ... BXE 0 0,SFAIL [IF NOTHING ON TEMP ALREADY MERGED #?NL ...[NOW MERGE TEMP FREE CHAIN WITH REAL #?P5 ...ROUND LDX 1 1 #?PC ... BXE 1 1,THEND1 #?PP ...[ HALFWAY POINT #?Q3 ... LDX 2 BFREE+1 [ TEST AND JUMP IF IT SHOULD #?QG ... TXL 1 2 [BE CHAINED AT END OF FREECORE CHAIN #?Q^ ... BCC NLOC1 #?RD ... LDN 2 BFREE [LOAD BASE #?RX ... TXL 1 CMIDFREE #?SB ... BCC NEND [JUMP IF AFTER MIDDLE OF CORE #?ST ...NTFR TXL 1 FPTR(2) [LOCATE CORRECT POSITION #?T# ... BCS NLOC1 [STARTING AT FRONT #?TR ... LDX 2 FPTR(2) #?W= ... BRN NTFR #?WP ...NEND LDX 2 BPTR(2) [LOCATE CORRECT POSITION #?X8 ... TXL 1 2 [STARTING AT END #?XM ... BCS NEND #?Y6 ...NLOC1 CHAIN 1,2 #?YK ... BRN ROUND #?YN ...THEND1 #?YR ... LDN 3 2048 #?YW ... BXL 3 GLLLOG,THEND [ENSURE WITH LSM THAT WORTH #?Y^ ... BRN THEND2 [DOING FULL PALAVER #?^4 ...THEND #?^H ... SEGENTRY K51COREALLF #?^J ...) #?^K ... LDX 3 GLLLOG #?^L ...THEND2 #?^M ...#UNS CA1D #?^N ... ADX 3 CIRNDB #?^P ...#UNS CA1D #?^Q ...#SKI #?^R ... ADN 3 A1+IROUND-1 #?^S ... ANDX 3 IROUNDNG #?^T ... STO 3 GEN4 [ RESTORE SIZE PARAMETER #?^W ... BXGE 3 CFREE,SFAIL #?^X ...#SKI TRACE>499-499 #?^Y ... TRACE GEN4,LLREQ #?^^ ... LDX 1 BFREE+BPTR ##22 ...#UNS ISFC ##23 ... BXE 1 CXFR,MTFREE [J IF NOTHING ON FREE CHAIN ##24 ... LDX 2 GFIXCHAP ##25 ...PREV1 ##26 ... NGX 4 GEN4 ##27 ... LDX 7 2 [ MARK TOP OF AREA ##28 ... LDX 3 1 ##29 ... LDX 0 2 ##2= ...XXX LDX 2 3 ##2? ... ADX 3 ASIZE(3) ##2# ... TXU 3 0 ##2* ... BCS XXX ##2B ... LDN 5 4 ##2C ... ANDX 5 AFLAG(2) [ IS TOPMOST BLOCK A 'LONGLOCK' ##2D ... BNZ 5 PREV1 [ JUMP IF YES TO RESTART ##2F ... BRN STT [ CONTINUE IF NO ##2G ...PREV ##2H ... LDX 3 1 [ TO FIND ##2J ... LDX 0 2 [ NEXT ##2K ...XX LDX 2 3 [ BLOCK ##2L ... ADX 3 ASIZE(3) [ BELOW ##2M ... TXU 3 0 [ PRESENT ##2N ... BCS XX [ ONE ##2P ...STT LDX 6 ASIZE(2) ##2Q ... LDX 5 AFLAG(2) [ ##2R ... ANDN 5 #15 [ PRESERVE BITS 20,21,23 ##2S ... BZE 5 XFR [ JUMP IF 'ORDINARY' ##2T ... SRC 5 1 [ 'FREE' BIT INTO SIGN BIT ##2W ... BPZ 5 XNFR [ JUMP IF NOT FREE ##2X ... TXU 1 BFREE [ IS THIS THE LOWEST FREE BLOCK? ##2Y ... BCC XFR [ JUMP IF YES. TRY TO SATISFY ##2^ ... [ REQUEST. IF NOT X5 NEG. => FAIL ##32 ... STOZ 5 [ ##34 ... SEGENTRY K52COREALLF ##36 ... LDN 0 1 [IF SFC ON: LDX 0 ASFCFPTR+BPTR(2) ##38 ... BZE 0 XFR [J IF FAST FREE ##3? ... LDX 1 BPTR(1) [ POINT TO NEXT FREE BLOCK DOWN ##3B ... BRN XFR ##3F ...XNFR SRC 5 2 [ 'LONGLOCK' BIT INTO SIGN BIT ##3J ... BPZ 5 XFR [ JUMP IF ORDINARY LOCKED BLOCK ##3M ... SRC 5 1 [ X5<0 IF LOCKED LONGLOCK BLOCK ##3Q ... BNG 5 PREV1 [CANNOT HAVE LOCKED LL IN FREEZE AREA ##3T ... SBX 6 ALOGLEN(2) [ DETACH LONGLOCK BLOCK'S ##3Y ... SBN 6 A1 [ FAG END, ##43 ... ANDX 6 IROUNDNG [ IF ANY ##46 ...XFR ADX 4 6 [ ADD IN POTENTIAL FREE CORE TO SUM ##49 ... BPZ 4 SOFAR [ JUMP IF REQUEST NOW SATISFIED ##4# ... BPZ 5 PREV [ GET ANOTHER BLOCK ##4G ... BRN SFAIL [ X5 NEG => THIS WAS LOWEST FREE BLOK ##J6 SOFAR #*JQ ... LDX 3 BPBRG+BPTR [IS THE TOPMOST PROGRAM BLOCK #*T= ...NEXTPROG [ABOVE THE START OF THE EXTENDED #B5Q ... SBN 3 APBRG [FREEZE(X2).OK IF IT IS NOT #BB= ... BXL 3 2,NOPROGABOVE [SO J TO CONTINUE.ALSO OK IF IT #BLQ ... JBC SFAIL,3,AFFPB [IS AN FPB BUT FAIL IF NOT. #BX= ... LDX 3 APBRG+BPTR(3) [GET NEXT PROGRAM BLOCK #C7Q ... BRN NEXTPROG [AND LOOK AGAIN. #CD= ...NOPROGABOVE #C^G STO 2 6 #DF6 ... JBS XTND,2,AFLONG [J IF BOTTOM BLOCK IS LL #DYQ ... [ REGION NOT SHORTENED #FY2 ADS 4 6 [ MOVE POINTER UP BY EXCESS #GCL XTND TXL 6 CTOP [DOES X6 POINT BELOW CTOP? #GX= BCC SUCCESS [ NO #HBW STO 6 CTOP [ YES. ADJUST CTOP #HWG SUCCESS #JB6 SBX 7 6 [ X7 HOLDS REGION'S SIZE #JTQ COREFREEZE 6,7,TFAIL,,2,5 #K*B CALL 0 RESTORE #KT2 #SKI TRACE>499-499 #L#L TRACE CTOP,LLSUCCES #LS= COREQUST Y #M?W SFAIL #MRG #SKI TRACE>499-499 #N?6 TRACE CTOP,LLFAIL #NQQ CALL 0 RESTORE #P=B COREQUST N #PQ2 [ #Q9L [ THIS ROUTINE RESTORES ACTIVITY LINKS AND GETCORE PARAMATERS READY FOR #QP= [ AN EXIT, SUCCESSFUL OR UNSUCCESSFUL, VIA COREALL. IT ALSO UNSETS THE #R8W [ LONGLOCK FLAG AND RELEASES ANOTHER ACTIVITY WAITING FOR PERMISSION TO #RNG [ ENTER COREALLF, IF ONE EXISTS. #S86 RESTORE #SMQ STO 0 GL1 #T7B LDN 1 GLLACCS [ RESTORE THE ALEVEN WORD #TM2 SMO FX2 [ LINK OF THE ACTIVITY #W6L LDN 2 ACC3 [ REQUESTING THE NEW BLOCK #WL= MOVE 1 ALINK #X5W LDN 1 GLLLINKS #XKG LDN 2 GLINKSTEP #Y56 MOVE 1 5 #YJQ STOZ GLLSEMA #^4B FON GLLWAIT #^J2 BRN (GL1) *23L [ *2H= [ THE 'FAIL' RETURN FROM THE LONGLOCK COREFREEZE *32W TFAIL *3GG LDX 7 AWORK1(2) [ AWORK1 HOLDS REASON FOR FAILURE *426 SRC 7 3 *4FQ BPZ 7 TFAI1 *4H3 ...#UNS ICT *4J# ...( *4KK ... JBC OFFICT,,ICTSW *4LW ... LDCH 0 ATYPE(2) *4N7 ... SBN 0 BAT/64 [IF BLANKET COOR2 WONT WORK *4PD ... BZE 0 SFAIL [IF ICT ON,SO FAIL INSTEAD *4QP ... COOR3 #41 [VIZ WAIT FOR NEXT SPRING CLEAN *4S2 ... BRN STARTLL *4T? ...[ .....JUST LIKE COOR3 #41 *4WJ ...OFFICT *4XT ...) *4^B COOR2 *5F2 BRN STARTLL *5YL TFAI1 SRC 7 3 *6D= BPZ 7 SFAIL *6XW GEOERR 0,NOTLLERR *8BQ [ *8WB [ THIS PART IMPLEMENTS THE STARTSTRAT MACRO *9B2 [ FIRST THE AREA INDICATED BY THE ADATA/ASTRAT BLOCK IS CLEARED OUT,AND *9TL [ THEN THE PROGRAM IS MOVED OR SWAPPED IN *=*= [ WORDS USED AS FOLLOWS: *=SW [ ACOM1 SWITCHES B23 SET IF FREEZE IS FOR SWAP IN *?#G [ B22 SET IF SWAP FOR REALTIME PROGRAM *?S6 [ B21 SET IF BLOCK OVERLAP IN PROGRAM MOVE *#?Q [ ACOM2 ADDRESS OF OLD PROGRAM SITE *#RB ...[ ACOM4 DISTANCE PROGRAM TO BE MOVED **?2 [ **QL QENTRY2 *B== MHUNTW 3,ADATA,ASTRAT *BPW LDX 0 GPCNT(3) [NUMBER OF ASTRAT ENTRIES *C9G BCT 0 UMOVE [J IF NOT 1 - PROGRAM MOVE *CP6 [ ELSE SWAP IN *D8Q LDX 0 GPROG+1(3) *DNB SLC 0 3 *F82 ANDN 0 2 *FML ORN 0 1 [SET FLAGS - B23 FOR SWAP *G7= STO 0 ACOMMUNE1(2) [ B22 IF FOR REALTIME PROG *GLW LDX 6 GPROG+1(3) *H6G ANDX 6 BITS22LS [START OF PROSPECTIVE PROGRAM BLOCK *HL6 LDX 3 GPROG(3) [JOB NUMBER OF SWAP IN CANDIDATE *J5Q CALL 7 UFIND [X3-> JOBS PCA *JKB HUNT2 3,BSTB,BSCB *K52 LDX 7 ACORSZ(3) *K86 ...#UNS CA1D *K?= ... ADX 7 CA1D [SIZE OF REQUIRED PROGRAM BLOCK *KBB ...#UNS CA1D *KFG ...#SKI *KJL ADN 7 A1D [SIZE OF REQUIRED PROGRAM BLOCK *L4= BRN UFREZ [J TO GET PROGRAM BLOCK *LHW UMOVE *M3G STOZ ACOMMUNE1(2) [CLEAR FLAGS *MH6 LDX 6 GPROG+GPREN+1(3) *N2Q ANDX 6 BITS22LS [DESTINATION ADDRESS *NGB LDX 3 GPROG+GPREN(3) [JOB NUMBER OF THE MOVED *P22 CALL 7 UFIND [X3-> JOBS PCA *PFL LDX 1 3 *P^= HUNT2 3,AOBJPROG,0 *QDW STO 3 ACOMMUNE2(2) [REMEMBER PROGRAM SITE *QYG LDX 7 ASIZE(3) *RD6 SBX 3 6 *RXQ BXL 7 3,UNOLP [J IF NO OVERLAP OF OLD & NEW SITES *SCB LDX 7 3 [ ELSE SET FREEZE SIZE TO (SOURCE - *SX2 [ DESTINATION) *TBL LDN 0 4 *TW= ORS 0 ACOMMUNE1(2) [SET OVERLAP SWITCH *W*W ...UNOLP STO 3 ACOMMUNE4(2) [DUMP DISTANCE PROGRAM BEING MOVED *WTG UFREZ [BEFORE FREEZING WE MUST CHECK WHETHER A PROGRAM HAS *X*6 [EXTRACOR-ED ITSELF INTO FREEZE AREA. IF SO, %C EXIT *XSQ LDN 1 BPBRG-APBRG *Y#B ...UCHK1 CALL 5 XSTEP [X1 -> NEXT PROGRAM OR CTOP *YS2 BXL 6 1,UCHK2 [J IF START OF PROG > FREEZE START *^?L SMO ASIZE(1) [ ELSE MUST BE < OR = FREEZE START *^R= LDN 0 0(1) [IF END OF PROG ALSO < FREEZE START, B2=W BXGE 6 0,UCHK1 [ J BACK TO CHECK NEXT PROGRAM B2QG BRN UFAI3 [ ELSE TAKE ABORT EXIT B3=6 ...UCHK2 COREFREEZE 6,7,UFAIL,1,1,25 B3PQ FINDCORE 1 B49B STOZ ATYPE(1) B4P2 STOZ AFLAG(1) B58L STOZ BACK1(1) B5N= STOZ BACK2(1) B67W LDX 0 ASIZE(1) B6MG SBN 0 A1 B776 STO 0 ALOGLEN(1) [ SET LOGICAL LENGTH TO MAXIMUM B7LQ LDX 0 ACOMMUNE1(2) B86B ANDN 0 1 B8L2 BZE 0 UMOV [J IF PROGRAM MOVING B95L LDX 3 1 B9K= NAME 1,AOBJPROG [NAME BLOCK B=4W LDCT 0 2 B=JG ORN 0 1 B?46 STO 0 ARINGNO(1) [SET ITS RING WORD B?HQ STOZ JRETI(1) [SWITCH WD(B0 SET IF RE WHEN PLUGGED) B#3B ADN 1 APBRG B#H2 LDN 2 BPBRG B*2L ULCT2 LDX 2 FPTR(2) [ESTABLISH BLOCK IN PROGRAM BLOCK CHN B*G= BXL 2 FCORES,ULCT1 [J IF BACK AT BASE B*^W BXL 2 1,ULCT2 [ ELSE STEP BACK TO NEXT PROGRAM BBFG ULCT1 ENRING 1,BPTR(2) BB^6 LOCK 3 [LOCK PROGRAM BLOCK BCDQ SWAP IN [SWAP PROGRAM IN, RETURN TO MACRO BCYB [ SUCCESS EXIT BDD2 UMOV BDXL ... LOCK 1 [DONT LOSE BLOCK BFC= ... ACROSS COREALLJ,1 [DO PROGRAM MOVE CH5B USUCX CHK2 UP [SUCCESS EXIT CJ4L [ CJJ= UFAIL CK3W LDX 7 AWORK1(2) CKHG SRC 7 1 CL36 BPZ 7 UFAI1 CLGQ LDX 0 AWORK2(2) [IF INSUFFICIENT CORE (B23) CM2B STO 0 ACOMMUNE1(2) [ SET SHORTFALL CMG2 UPPLUS 1 [ & TAKE %A EXIT CM^L UFAI1 SRC 7 2 CNF= BPZ 7 UFAI3 CNYW ACROSS COREALLH,1 [IF TIMED OUT (B21) TAKE %B CPDG UFAI3 UPPLUS 3 [ ELSE TAKE ABORT EXIT (%C).THIS EXIT CPY6 [ ALSO IF PROG FOUND IN THE WAY CQCQ [ CQXB [ NOW THE SUBROUTINES USED IN THE STARTSTRAT CODE CRC2 [ CRWL [UFIND ENTERED WITH X3=JOB NUMBER,EXIT WITH X3-> PCA ,X1=FX1 X2=FX2 CSB= [ X0 DESTROYED LINK X7 CSTW [ CT8? ...UFIND CTGN ... FINDJOBQ 3,3,(GEOERR) CTT6 FPCAJO 3 CW#Q EXIT 7 0 CWSB [ CX#2 [UTEST USED BY THE COREFREEZE CALL TO TEST ABORT CONDITIONS & HAS CXRL [ COMMON SPEC OF ALL COREFREEZE ABORT SUBROUTINES CY?= [ CYQW UTEST STO 0 GEN0 C^=G LDX 0 ACOMMUNE1(2) C^Q6 ANDN 0 1 D29Q BZE 0 UTES1 [J IF FREEZE IS FOR PROGRAM MOVING D2PB TEST 0,CJAMAB [ ELSE SWAP IN - JUST TEST C/J SWITCH D392 BRN (GEN0) D3NL UTES1 TEST 0,CJAMAB,CSWAPAB,CDELAB [TEST FOR C/J,SWAPOUT,DELETE D48= BRN (GEN0) D4MW [ D57G [UCOPY COPIES [X5] WORDS FROM X3 TO X4, COOR2-ING EVERY 2K D5M6 [ ENTERED X1=FX1,X2=FX2,X3,4,5 AS ABOVE , LINK X7 D66Q [ EXIT X1=FX1,X2=FX2, NEXT WORD WOULD HAVE BEEN TRANSFERED FROM X3+X5 TO D6LB [ X4+X5 D762 [ D7KL UCOPY SBX 7 FX1 D85= UCOP1 LDN 0 4 D8JW UCOP2 BXL 5 B513,UCOP3 [J IF < 513 WORDS STILL TO TRANSFER D94G MOVE 3 0 [ELSE MOVE 512 WORDS D9J6 ADN 3 512 D=3Q ADN 4 512 D=HB SBN 5 512 D?32 BCT 0 UCOP2 D?GL COOR2 [TAKE A BREATHER EVERY 2K D#2= BRN UCOP1 D#FW UCOP3 SMO 5 [MOVE RESIDUE D#^G MOVE 3 0 D*F6 ADX 7 FX1 D*YQ EXIT 7 0 DBDB [ DBY2 [ THIS SECTION IMPLEMENTS THE EXTRACOR MACRO. ENTRY IS IN THE CPA OF DCCL [ THE JOB TRYING TO EXTEND ITS CORE IMAGE, WITH ACOMMUNE1 THE NEW DCX= [ PROGRAM SIZE REQUIRED (NOT INCLUDING AOBJPROG BLOCK RED TAPE) DDBW [ DDWG [ DFB6 QENTRY3 DFTQ #SKI TRACE>99-99 DG*B TRACE ACOMMUNE1(2),EXTRACOR DGT2 FJOCA 3,2 DH#L LDX 0 JMISC(3) DHS= ANDX 0 BITS910 [TEST BITS 9 & 10 DJ?W BZE 0 XFAI1 [J IF PROGRAM NO LONGER SWAPPED IN DJRG TESTAXES 3,XFAI1 [J IF PROGRAM IS BEING ACCESSED DK?6 PROGAXES 3,(GEOERR) [ ELSE CLAIM IT FOR OUR OWN DKQQ CALL 7 XFPRO [X3-> PROGRAM BLOCK DL=B LDX 4 ACOMMUNE1(2) [NEW SIZE DLQ2 #SKI TRACE>99-99 DM9L ( DMP= LDX 0 ALOGLEN(3) DMR8 ...#UNS CA1D DMT6 ...( DMX4 ... SBX 0 CA1D DM^2 ... ADN 0 A1 DN2Y ...) DN4W ...#UNS CA1D DN6S ...#SKI DN8W SBN 0 A1D-A1 DNNG BXL 0 4,XNOUG DP86 GEOERR 1,EXTRACOR [ERROR IF REQUEST< CURRENT SIZE DPMQ XNOUG DQ7B ) DQ9# ...#UNS CA1D DQ?= ...( DQ*8 ... LDX 7 CA1D DQC6 ... ADN 7 0(3) DQF4 ...) DQH2 ...#UNS CA1D DQJY ...#SKI DQM2 LDN 7 A1D(3) DR6L ADX 7 4 [X7 WOULD BE NEW LIMIT DRL= LDX 1 3 DS5W ... CALL 5 XSTEP [GET ADDR OF NEXT PROG OR TOP OF CORE DSKG BXGE 7 1,XFAI2 [NO CHANCE IF ANOTHER PROGRAM IN WAY DT56 SMO ASIZE(3) DTJQ LDN 6 0(3) [CURRENT LIMIT OF PROGRAM DW4B SBX 7 6 [EXTRA CORE NEEDED DWJ2 COREFREEZE 6,7,XFAI2,,1,5 DX3L CALL 7 XFPRO [X3-> PROGRAM BLOCK DXH= FINDCORE 1 [GET THE NEW EXTENSION DY2W LDX 5 ASIZE(1) [ AMALGAMATE THE EXTENSION WITH THE DYGG [ OLD PROGRAM BLOCK D^26 ADS 5 ASIZE(3) D^FQ ADS 5 ALOGLEN(3) D^PJ ... ADS 5 COBJUSE D^^B #SKI TRACE>99-99 F2F2 TRACE ASIZE(3),EXTRAGOT F2YL LDX 3 1 F3D= DERING 1 [DERING THE EXTENSION F3XW LDN 4 2(3) F4CG SBN 5 2 F4X6 STOZ 1(3) [ZEROISE THE EXTENSION - 2 WORD O/LAP F5BQ STOZ 0(3) F5WB CALL 7 UCOPY [ FOR CORE INTERLEAVED MACHINES F6B2 ... CALL 7 XAXES [SIGNAL END OF PROGRAM ACCESS F7*= UP [BACK FOR SUCCESS EXIT F7SW [ F8#G [ NOW THE FAILURE LABELS F8S6 [ F9?Q XFAI2 [COREFREEZE FAILS TO GET THE CORE F9RB #SKI TRACE>99-99 F=?2 TRACE AWORK1(2),EXTRAFAI F=QL ... CALL 7 XAXES [SIGNAL END OF PROGRAM ACCESS F?PW XFAI1 [BACK UP TO THE SWAPOUT MACRO F#9G UPPLUS 4 F#P6 [ F*8Q [ NOW THE SUBROUTINES USED IN THIS SECTION F*=N ...[ F*#L ...[ XAXES FINDS JOB BLOCK AND INDICATES END OF PROGRAM ACCESS F*BJ ...[ X7= LINK F*DG ...XAXES F*GD ... FJOCA 3,FX2 F*JB ... ENDPAXES 3 F*L# ... EXIT 7 0 F*NB [ FB82 [ XFPRO FINDS THE OBJECT PROGRAM BLOCK . ENTER X2-> CPA LINK X7 FBML [ EXIT X0 DESTROYED,X3-> PROGRAM BLOCK FC7= [ FCLW XFPRO FPCACA 3,2 FD6G HUNT2 3,AOBJPROG,0 FDL6 EXIT 7 0 FF5Q [ FFKB [ XSTEP STEPS X1 TO THE START OF THE NEXT PROGRAM BLOCK OR TO THE FG52 [ START OF THE LONGLOCK AREA. LINK X0 FGJL [ FH4= XSTEP LDX 1 APBRG(1) FHHW SBN 1 APBRG FJ3G ... BXGE 1 FCORES,XSTEP1 [EXIT IF X1-> VARIABLE CORE FJH6 LDX 1 CTOP [ ELSE OVER TOP - SET X1 TO LL BNDY FJPB ... EXIT 5 0 FJXL ...XSTEP1 FK5W ... JBS XSTEP,1,AFFPB [IF FPB,J TO GET NEXT AOBJPROG FK#6 ... EXIT 5 0 FL22 [ FLFL [ THIS ENTRY IMPLEMENTS THE NOISY CORE SYSTEM FL^= [ FMDW QENTRY4 FMYG #SKI FNOISE FND6 ( FNXQ NOISE CALL 4 (GNCCODE) FPCB COREFREEZE 6,7,NFAIL,,1,0 FPX2 NGNC 5 1 FQBL NFAIL NGN 5 0 FQW= BRN NOISE FR*W ) FRTG #SKI FNOISE<1$1 FS*6 GEOERR 1,NOT YET! FSSQ # G5B8 ...STRATEST G5L2 ...SWAPTEST G5TS ...QENTRY5 G65L GEOERR 0,G4ENTRY! G6K= MENDAREA 100,K99COREALLF G74W #END ^^^^ ...54740463000100000000