{{htmlmetatags>metatag-description:(ICL George 3 and George 4 source: COREALLF867)}}
====== COREALLF867 ======
(George Source)
**Macros used:** [[george:macro:ACROSS|ACROSS]], [[george:macro:BC|BC]], [[george:macro:BLOCKCOPY|BLOCKCOPY]], [[george:macro:BLOCKMOVE|BLOCKMOVE]], [[george:macro:BS|BS]], [[george:macro:BXE|BXE]], [[george:macro:BXGE|BXGE]], [[george:macro:BXL|BXL]], [[george:macro:BXU|BXU]], [[george:macro:CHAIN|CHAIN]], [[george:macro:CHAIND|CHAIND]], [[george:macro:COBJUNUSE|COBJUNUSE]], [[george:macro:COBJUSE|COBJUSE]], [[george:macro:COOR1|COOR1]], [[george:macro:COOR2|COOR2]], [[george:macro:COOR3|COOR3]], [[george:macro:COREFREEZE|COREFREEZE]], [[george:macro:COREQUST|COREQUST]], [[george:macro:COREWAKE|COREWAKE]], [[george:macro:DERING|DERING]], [[george:macro:ENDPAXES|ENDPAXES]], [[george:macro:ENRING|ENRING]], [[george:macro:ENRINGD|ENRINGD]], [[george:macro:FINDCORE|FINDCORE]], [[george:macro:FINDJOBQ|FINDJOBQ]], [[george:macro:FJOCA|FJOCA]], [[george:macro:FON|FON]], [[george:macro:FPCACA|FPCACA]], [[george:macro:FPCAJO|FPCAJO]], [[george:macro:FPUT|FPUT]], [[george:macro:FREECORE|FREECORE]], [[george:macro:FREEOUT|FREEOUT]], [[george:macro:FREZWAIT|FREZWAIT]], [[george:macro:GEOERR|GEOERR]], [[george:macro:GETCORE|GETCORE]], [[george:macro:HUNT2|HUNT2]], [[george:macro:ICT|ICT]], [[george:macro:JBC|JBC]], [[george:macro:JBS|JBS]], [[george:macro:JMBAC|JMBAC]], [[george:macro:LOCK|LOCK]], [[george:macro:MENDAREA|MENDAREA]], [[george:macro:MHUNTW|MHUNTW]], [[george:macro:NAME|NAME]], [[george:macro:PROGAXES|PROGAXES]], [[george:macro:SEGENTRY|SEGENTRY]], [[george:macro:SWAP|SWAP]], [[george:macro:TEST|TEST]], [[george:macro:TESTAXES|TESTAXES]], [[george:macro:TRACE|TRACE]], [[george:macro:UP|UP]], [[george:macro:UPPLUS|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 ACHAP599-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
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 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 X599-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 X599-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 X599-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