{{htmlmetatags>metatag-description:(ICL George 3 and George 4 source: CASCODE)}}
====== CASCODE ======
(George Source)
**Macros used:** [[george:macro:APSETTAB|APSETTAB]], [[george:macro:BXE|BXE]], [[george:macro:BXGE|BXGE]], [[george:macro:BXL|BXL]], [[george:macro:BXU|BXU]], [[george:macro:CHANBASE|CHANBASE]], [[george:macro:FIXTRA|FIXTRA]], [[george:macro:JBC|JBC]], [[george:macro:LABFIX|LABFIX]], [[george:macro:TRACEIF|TRACEIF]], [[george:macro:TRANSFIX|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