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