(George Source)
Macros used: APSETTAB, BXE, BXGE, BXL, BXU, CHANBASE, FIXTRA, JBC, LABFIX, TRACEIF, TRANSFIX
22FL #SEG CASCODE 22LS ...#OPT K0CASCODE=0 22S2 ...#LIS K0CASCODE 22^= # 23DW # 23YG # THIS SEGMENT CONTAINS DATA THAT IS USED BY FIXED CORE ROUTINES 24D6 # ONLY.THE ADDRESSES OF DATA MAY CHANGE WHEN FIXED IS RECOMPILED 24XQ # SO NO REFERENCE SHOULD BE MADE TO THESE ITEMS BY NON-FIXED CORE 25CB # OVERLAY CHAPTERS 25X2 # 26BL # THIS IS A FIXED CORE SEGMENT.IT CONTAINS FIXED CORE 26W= # WORDS AND CODE FOR THE ALTERNATIVE CORE ALLOCATION SYSTEM 27*W # (STRUCTURED FREE CORE). 27TG # THE CODE CONSISTS OF ROUTINES ENTERED FROM SEGMENT COREALL 28*6 # WHICH WOULD OTHERWISE BE TOO LONG. 28SQ # 29#B FIXTRA K1CASCODE 29S2 # 2=?L #UNS ISFCON 2=R= ( 2?=W ...# THE FOLLOWING WORDS UP TO AND INCLUDING CASTAB ARE 2?QG ...# REQUIRED IN THIS ORDER BY SEGMENT PERFCAS 2#=6 CASFOUND 2#PQ #REP 16 2*9B +0 2*P2 CASSPLIT 2B8L #REP 16 2BN= +0 2C7W CASCHAPS +0 2CMG CASIFPB +0 2D76 CASVFPB +0 2DLQ CASAMAL +0 2F6B CASFAIL +0 2FL2 CASK7 +0 2G5L CASMILL +0 2GK= BFRING1 CHANBASE 2H4W BFRING02 CHANBASE 2HJG BFRING03 CHANBASE 2J46 BFRING04 CHANBASE 2JHQ BFRING05 CHANBASE 2K3B BFRING06 CHANBASE 2KH2 BFRING07 CHANBASE 2L2L BFRING08 CHANBASE 2LG= BFRING09 CHANBASE 2L^W BFRING10 CHANBASE 2MFG BFRING11 CHANBASE 2M^6 BFRING12 CHANBASE 2NDQ BFRING13 CHANBASE 2NYB BFRING14 CHANBASE 2PD2 BFRING15 CHANBASE 2PXL BFRING16 CHANBASE 2QC= CASTAB 2QWW #REP 16 2RBG +0 2RW6 CASMID 2S*Q #REP 16 2STB +0 2T*2 #DEF CMIDSIZE1=CASMID 2TJS ...CASLNK +0 2TNP ...CAS1024 +1024 2TP5 ...BFTEMP CHANBASE 2TPF ...BF64 CHANBASE 2TPT ...CXFT +BFTEMP 2TQ9 ...CX64 +BF64 2TQK ...CASQUICK +128 2TQ^ ...CASQAM +0 2TR* ...CASQAME +0 2TRP ...CASPOOLGC +0 2TS5 ...CASGC +0 2TS= ...CASST1 +0 2TSC ...CASST7 +0 2TSL # 2W#= # IN THE STRUCTURED FREE CORE SYSTEM FREE BLOCKS ARE RINGED ON TO 2WRW # SIZE RINGS THROUGH THEIR SIZE RING POINTERS. THEY REMAIN ON THE 2X?G # FREE CORE CHAIN. EACH SIZE RING HOLDS A RANGE OF SIZES IN 2XR6 # ASCENDING ORDER OF SIZE. THE SIZE RANGE FOR EACH RING IS 2Y=Q # DETERMINED BY A FIXED CORE TABLE. 2YQB # 2^=2 # THIS SUBROUTINE SEARCHES THE SIZE RINGS TO FIND A BLOCK BIG 2^PL # ENOUGH TO SATISFY THE REQUEST. IT RETURNS TO THE CALLING ROUTINE 329= # IF UNSUCCESSFUL. IF SUCCESSFUL IT BRANCHES TO PROCESS THE BLOCK. 32NW # IT IS USED BY THE FREEIN MACRO, IN WHICH CASE ONLY THE APPROPRIAT 338G # SIZE RING IS SEARCHED, RETURNING THE ADDRESS OF THE BLOCK BEHIND 33N6 # WHICH THE FREED BLOCK SHOULD BE CHAINED. 347Q # 34MB # GEN4 CONTAINS THE 'REQUIRED' AMOUNT. 3572 # X7 NEG. IF ENTRY FROM FREEIN ROUTINE, LINK ADDRESS OTHERWISE. 35LL # ON EXIT,X0 X1 X2 OVERWRITTEN - FOR FREEIN X1 CONTAINS ADDRESS. 366= # 36KW # S = BLOCK SIZE, R = REQUIRED SIZE 375G # 37K6 LABFIX HZRNG 37SY ... LDX 2 GEN4 384Q SRINGBEG 38JB ... BXL 2 CAS1024,SMALL 3942 ... LDCH 2 CASTAB+15 [GET LAST RING NO 39HL ... BRN SRG 3=3= SMALL 3=GW SRL 2 4 [DIVIDE R BY 16 3?2G SBN 2 1 [ADJUST SO THAT 1 = POSITION 0, ETC. 3?G6 SRC 2 2 [X2 NOW A CHAR. POINTER 3?^Q LDCH 2 CASTAB(2) [PICK UP RING NUMBER - X2 NOW RINGNO 3#FB SRG 3#^2 SLL 2 1 [MPY BY 2 -EACH ENTRY IS 2 WORDS 3*=B ... LDX 1 BFRING1(2) 3*HQ ... BXL 1 FVARST,NEXTRING [J IF EMPTY 3*T6 ... LDX 0 ASFCSIZE(1) 3B6G ... BXGE 0 GEN4,SFCYES [GO DIRECT IF BIG ENUF 3BCW LDX 1 BFRING1+BPTR(2) 3BXG LDX 0 ASFCSIZE(1) [SIZE OF LAST BLK IN RING IS LARGEST 3CC6 SBX 0 GEN4 3CWQ BNG 0 NEXTRING [J IF NONE BIG ENOUGH 3DBB SRL 2 1 [RESTORE ORIGINAL RING NO. 3DW2 LDX 0 CMIDSIZE1(2) [FIND MIDPOINT SIZE 3F*L SLL 2 1 3FT= BXL 0 GEN4,SRCHRINGB [J IF MIDSIZE < R TO BACKWARDS SEARCH 3G#W LDX 1 BFRING1(2) 3YG2 # THIS ROUTINE SEARCHES A SIZE RING FORWARDS UNTIL BIG ENOUGH 3Y^L # BLOCK FOUND 3^F= # 3^YW SRCHRINGF 42DG LDX 0 ASFCSIZE(1) 42Y6 ... BXGE 0 GEN4,SFCYES [I IF S>R 44WL LDX 1 FPTR(1) 45B= BRN SRCHRINGF 45BW ...NEXTRING 45CG ... BZE 7 SFRADDR [J IF ENTRY FROM FREEIN ROUTINE 45D6 ... SRL 2 1 [RESTORE ORIGINAL RING NUMBER 45DQ ... ADN 2 1 [MOVE TO NEXT RING NO. 45FB ... LDCH 0 CASTAB+15 [GET LARGEST RING NO IN USE 45G2 ... BXGE 0 2,SRG [J IF STILL MORE TO TRY 45GL ... EXIT 7 0 [ELSE EXIT 45H= ...# 45HW ...# 45JG ...# RING SEARCH ROUTINES. ENTERED KNOWING BIG ENOUGH BLOCK THERE 45K6 ...# 45KQ ...# THIS ROUTINE SEARCHES A SIZE RING BACKWARDS UNTIL EITHER 45LB ...# FIRST BLK OF RING - SO 1ST BLOCK SMALLEST TO SATISFY R 45M2 ...# OR BLOCK FOUND SMALLER THAN R - SO TAKE THE NEXT ONE FORWARD 45ML ...# 45N= ...# 45NW ...SRCHRINGB 45PG ... LDX 1 BPTR(1) 45Q6 ... LDX 0 ASFCSIZE(1) 45QQ ... SBX 0 GEN4 [S - R 45RB ... BNG 0 SPTNXT [J IF R > S 45S2 ... BZE 0 SFCYES [J IF MATCH 45SL ... BRN SRCHRINGB 45T= ...# 45TW # 46*G SPTNXT 46T6 LDX 1 FPTR(1) 47#Q SFCYES 47KT ... BZE 7 NFRIN1 [J IF ENTRY FROM FREEIN ROUTINE 47W^ ... LDX 3 FPTR(1) 47^J ... LDX 0 BPTR(1) 4847 ... SMO 0 486Q ... STO 3 FPTR 489* ... STO 0 BPTR(3) [DERING BLOCK 48#2 SBN 1 ASFCFPTR [PT TO START OF SELECTED BLK 48RL SRL 2 1 [RESTORE ORIGINAL RING NUMBER 49?= TRACEIF ARNGTR,99,199,1,SFCSIZE 49QW TRACEIF ARNGTR,99,199,2,RINGNO 4==G #UNS ICASSTATS 4=Q6 ( 4?9Q LDN 7 1 4?PB ADS 7 CASFOUND(2) [ADD TO COUNT OF FOUND IN THIS RING 4#92 ) 4#NL TRANSFIX BRN,HNTST 4B7G # 4BM6 # 4C6Q # ENTRY FROM FREEIN ROUTINE IN COREALL. FOR FREEIN MACRO. 4CLB # CHAINS BLOCK POINTED TO BY X1 INTO ITS SIZE RING IN 4D62 # STRUCTURED FREE CORE SYSTEM. 4DKL # X0, X2 OVERWRITTEN. X1 REMAINS POINTING TO THE BLOCK ON EXIT. 4F5= # 4F*4 ... FIXTRA ISFCM0 4FJW LABFIX HZFRIN 4FKG ...[IF LL AREA BLK BUNG ON LAST RING TO STOP TOO EARLY USE 4FL6 ... STO 0 CASLNK 4FLQ ... BXL 1 CTOP,NOTLL [J IF NOT IN LL AREA 4FMB ... LDCH 2 CASTAB+15 [LAST RING NO 4FN2 ... STO 1 CASST1 4FNL ... STO 7 CASST7 4FP= ... LDN 7 0 4FPW ... LDX 0 GEN4 4FQG ... STO 0 ASFCSIZE+ASFCFPTR(1) 4FR6 ... LDX 0 ASIZE(1) 4FRQ ... STO 0 GEN4 4FSB ... BRN SRG 4FT2 ...NOTLL 4FTL ...[ DO QUICK CHECK FOR FAST CASE OF SMALLEST BLOCK... 4FW= ...[MUST BE ON FRONT OF FIRST SIZE RING 4FWW ... LDX 2 ASIZE(1) 4FXG ... BXU 2 CASQUICK,NFR2 [DROP THRU IF SMALLEST 4FY6 ... ADN 1 ASFCFPTR 4FYQ ... STO 2 ASFCSIZE(1) [SET SIZE WORD 4F^B ... LDN 2 BFRING1 [BASE OF RING 1 4G22 ... TRANSFIX CALL 0,ACHAIN 4G2L ... SBN 1 ASFCFPTR [BACK TO THE FRONT 4G3= ... BRN (CASLNK) [ALL DONE 4G3W ...NFR2 4G?J ... STO 1 CASST1 [STR BLOCK ADDRESS 4GH= ... STO 7 CASST7 [AND X7 4GQY ... LDN 7 0 [SET MARKER 4G^Q ... LDX 0 GEN4 4H8J ... STO 0 ASFCSIZE+ASFCFPTR(1) 4HCF ... [SAVE GEN4 TEMP IN SIZE WORD 4J32 STO 2 GEN4 [X2 & GEN4 CONTAIN 'REQUIRD' SIZE (R) 4JGL BRN SRINGBEG [FIND SIZE RING AND POSITION IN IT 4JMS ...SFRADDR 4JT2 ... LDN 1 BFRING1(2) [GET RING BASE 4K2= NFRIN1 4KFW # X1 = ADDR OF SIZE RING PTR OF NEXT BIGGEST BLK IN RING, 4K^G # OR THE RING BASE (I.E. THIS BLOCK BIGGEST IN RING) 4L39 ...#SKI K6COREALL 4L4Y ...( 4L6M ... LDX 1 BPTR(1) 4L8B ... TRANSFIX CALL 0 ,CHECKCHN 4L=5 ... LDX 2 1 [ADDRESS PREVIOUS BLK, FOR CHAINING 4L?S ...) 4L*H ...#SKI K6COREALL 4LC= ...#SKI 4LF6 LDX 2 BPTR(1) [ADDRESS PREVIOUS BLK, FOR CHAINING 4LYQ ... LDX 1 CASST1 [POINT TO OUR BLOCK 4MDB ADN 1 ASFCFPTR [POINT TO SIZE RING POINTER 4MY2 TRANSFIX CALL 0,ACHAIN [CHAIN BLK IN SIZE RING 4N7S ... LDX 7 ASFCSIZE(1) [GET OLD GEN4 4NCL LDX 0 GEN4 4NX= STO 0 ASFCSIZE(1) [DUPLICATE OF SIZE AFTER RING PTRS 4P4D ... STO 7 GEN4 4P9L ...[ RESTORE GEN4 4PBW SBN 1 ASFCFPTR [POINT TO START OF BLOCK AGAIN 4PWG ... LDX 7 CASST7 [RESTORE X7 4QB6 ... BRN (CASLNK) [EXIT 4QBD ... FIXTRA ISFCMLL 4QBQ ... LABFIX LLQK 4QC4 ... STO 0 CASLNK 4QCB ... LDCH 2 CASTAB+15 [RING FOR POSSIBLE LLBLOCKS 4QCN ... SLL 2 1 4QD2 ... LDX 1 BFRING1(2) 4QD# ...R2 BXL 1 FVARST,(CASLNK) [J IF NOTHING THERE 4QDL ... BXL 1 CTOP,R1 [ J IF NOT IN LL AREA 4QDY ... LDX 0 ASFCSIZE(1) 4QF= ... BXGE 0 GEN4,XLL [J IF BIG ENUF 4QFJ ...R1 LDX 1 FPTR(1) 4QFW ... BRN R2 4QG8 ...XLL SBS 0 CFREE [ADJUST AMOUNT OF FREE LEFT 4QGG ... TRANSFIX CALL 0,ADECH [DERING FROM STRUCTURE 4QGS ... LDX 2 FX2 4QH6 ... SBN 1 ASFCFPTR [X1->START OF BLOCK 4QHD ... TRANSFIX CALL 0,CHAN [CHAIN AFTER CUUR ACT 4QHQ ... TRANSFIX BRN ,GOTENUF 4QJ4 ...[ 4QJB ...[IF RING SEARCH FAILS,TRY QUICK AMAL HERE BY LOOK UP FREE CORE CHAIN 4QJN ...[TO SEE IF CAN AMAL ENUF ON ADJACENT BLOX.IF SO,GO TO UNIT IN COREALL 4QK2 ...[OTHERWISE EXIT.UNIT EXPECTS X2->FREE BLOCK TO START FROM 4QK# ...[ 4QKL ... LABFIX QAMALG 4QKY ... LDX 2 BFTEMP 4QL= ...QAM BXE 2 CXFT,(7) [GIVE UP 4QLJ ... LDX 3 2 [WHERE TO GO FROM NEXT 4QLW ...QAM2 4QM8 ... LDX 1 ASIZE(2) [RUNNING TOTAL 4QMG ...QAM1 ADX 2 ASIZE(2) [X2->NEXT 4QMS ... BXGE 1 GEN4,UNIT [J IF ENUF 4QN6 ... JBC NOTF,2,AFFREE [J IF NOT FREE 4QND ... ADX 1 ASIZE(2) [UPDATE RUNNING TOTAL 4QNQ ... BXU 3 BPTR(2),QAM1 [J IF THIS BLOCK NOT NEXT ON FREE CHAIN 4QP4 ... LDX 3 2 [MORE EFFICIENT TO GO ON FROM THIS NEXT TIME 4QPB ... BRN QAM1 4QPF ...UNIT 4QPJ ... LDX 0 2 4QPM ... ADX 0 ASIZE(2) 4QPQ ... SBX 2 1 [X2 -> 1ST BLOCK NOW 4QPT ... TXL 0 CTOP 4QPY ... TRANSFIX BCS,UNIT 4QQ3 ... TRANSFIX BRN,ISFCONE 4QQ# ...NOTF LDX 2 FPTR(3) [GET NEXT TO INSPECT 4QQL ... BRN QAM 4QQY ...[ 4QR= ...[ 4QRJ ...[FOR QUICK AMALG AFTER FREECORE 4QRW ...[ 4QS8 ... LABFIX QAMALG1 4QSG ... LDX 2 CNAFRA [X1->BLOCK FREED 4QSS ... LDX 3 BFTEMP+BPTR [ONLY LOOK AT 1,SO SET END CONDITION 4QT6 ... BRN QAM2 4QTQ # 4R*B ) 4RT2 [ 4S#L [ 4SS= [ ICT DATA 4T?W [ 4TRG #UNS ICTON 4W?6 ( 4WQQ [ 4X=B [ DEFINED BY OVERLAY IDENTIFIERS COS COULD CHANGE DEPENDING 4XQ2 [ ON WHETHER SFC ON OR NOT.STILL NEED UNIVERSALS FOR RES TIME MACS 4Y9L [ 4YP= #DEF GMEL0=GMEL 4^6= ...OASFDUMP +0 [WORK WORD FOR ASF 4^8W OACTLIS +OACTLIST0,+OACTLIST1,+OACTLIST2,+OACTLIST3 4^NG OGMEL1 5286 +OGMEL2,+GMEL,#20000000,#01000000,+GPDA,0 52MQ OGMEL2 537B +OGMEL3,+OGMEL1,#20000000,#02000000,+GPDA,0 53M2 OGMEL3 546L +BPROG,+OGMEL2,#20000000,#03000000,+GPDA,0 54BD ...OGAMREXEC -1,#37777777,60*64,30*64 54L= OACTLIST0 +OACTLIST0,+OACTLIST0 555W OACTLIST1 +OACTLIST1,+OACTLIST1 55KG OACTLIST2 +OACTLIST2,+OACTLIST2 5656 OACTLIST3 +OACTLIST3,+OACTLIST3 56JQ OAPTYPETAB 574B APSETTAB GENERAL 57J2 APSETTAB IPCA 583L APSETTAB AMSCAN 58H= +2 [ACTCDT 592W APSETTAB ACTDOC 59GG +1 [ACTUNJAM 5=26 +1 [AEWIND 5=FQ APSETTAB ACTLF 5=^B APSETTAB CONSA 5?F2 +1 [ASWINT 5?YL APSETTAB AMOP 5#D= APSETTAB BSA 5#XW #20000000 [APET 5*CG #20000000 [AOLPT 5*X6 +2 [CPAT 5BBQ OAPSUBTYPE 5BWB #32332333 5CB2 #REP 5 5CTL #33333333 5D*= #33333323 5DSW #33333333 5F#G #31111113 [IPCA 5FS6 #11333333 [AMSCAN 5G?Q ... #11313333 [ACTDOC 5GRB #31212333 [ACTLF 5H?2 ... #33121033 [CONSA 5HQL ... #11000333 [AMOP 5J== #03333333 5JPW #13333333 5K9G #03001023 [BSA 5KP6 #REP 5 5L8Q #33333333 5LNB #33333331 5M82 #33311330 5MML -1 5N7= [ 5NLW [ NOW ALTER UNIVERSALS 5P6G [ 5PHG ...#ALT ASFDUMP=OASFDUMP 5PL6 #ALT ACTLIS=OACTLIS 5Q5Q #ALT ACTLIST0=OACTLIST0 5QKB #ALT ACTLIST1=OACTLIST1 5R52 #ALT ACTLIST2=OACTLIST2 5RJL #ALT ACTLIST3=OACTLIST3 5S4= #ALT GMEL1=OGMEL1 5SHW #ALT GMEL2=OGMEL2 5T3G #ALT GMEL3=OGMEL3 5T?# ...#ALT GAMREXEC=OGAMREXEC 5TH6 #ALT APTYPETAB=OAPTYPETAB 5W2Q #ALT APSUBTYPE=OAPSUBTYPE 5WGB ) 5WQ8 ... FIXTRA CASCODEND [FOR USE BY PM 5X22 #END ^^^^ ...056321210063