-- file: MFMemoryImpl.mesa
-- Pascal-to-Mesa translator output, translated at October 31, 1985 4:28:01 pm PST
DIRECTORY
PascalBasic,
PascalWizardFiles,
MFTypes,
MFProcArray,
MFInteraction,
MFSymbols,
MFMemory;
MFMemoryImpl: PROGRAM IMPORTS PascalBasic, MFProcArray, MFInteraction, MFSymbols EXPORTS MFMemory = PUBLIC
BEGIN OPEN PascalBasic, PascalWizardFiles, MFTypes, MFProcArray, MFInteraction, MFSymbols, MFMemory;
--:148----158:
TempPtr: Halfword;
LoMemMax: Halfword;
HiMemMin: Halfword;
--:159----160:
VarUsed: PascalInteger;
DynUsed: PascalInteger;
--:160----161:--
Avail: Halfword;
MemEnd: Halfword;
--:161----166:--
Rover: Halfword;
--:664----:162----163:-- GetAvail: PROCEDURE RETURNS[GetAvailResult: Halfword] =
BEGIN P:Halfword;
P←Avail;
IF P#0 THEN Avail←Mem[Avail]↑.Hh.Rh ELSE IF INT[MemEnd]<MemMax THEN BEGIN
MemEnd← INT[MemEnd]+1;P←MemEnd; END ELSE BEGIN HiMemMin← INT[HiMemMin]-1;
P←HiMemMin;IF INT[HiMemMin]<=LoMemMax THEN BEGIN Runaway[];
Overflow[188,MemMax+1]; END; END;Mem[P]↑.Hh.Rh←0;DynUsed←DynUsed+1;
GetAvailResult←P; END;--:163----167:-- GetNode: PROCEDURE[S: PascalInteger] RETURNS[GetNodeResult: Halfword]
=
BEGIN P:Halfword;Q:Halfword;R:PascalInteger;T, Tt:PascalInteger;
DO {--Label20:--P←Rover;{{DO--169:--Q← INT[P]+Mem[P]↑.Hh.Lh;
WHILE(Mem[Q]↑.Hh.Rh=65535)DO BEGIN T←Mem[ INT[Q]+1]↑.Hh.Rh;Tt←Mem[ INT[Q]+1]↑.Hh.Lh;
IF Q=Rover THEN Rover←T;Mem[T+1]↑.Hh.Lh←Tt;Mem[Tt+1]↑.Hh.Rh←T;
Q← INT[Q]+Mem[Q]↑.Hh.Lh; END ENDLOOP ;R←Q-S;IF R> INT[P]+1 THEN--170:--BEGIN Mem[P]↑.Hh.Lh←R-P;
Rover←P; GOTO Label40; END--:170--;
IF R=P THEN IF((Mem[ INT[P]+1]↑.Hh.Rh#Rover)OR (Mem[ INT[P]+1]↑.Hh.Lh#Rover)) THEN--171
-- :--BEGIN Rover←Mem[ INT[P]+1]↑.Hh.Rh;T←Mem[ INT[P]+1]↑.Hh.Lh;Mem[ INT[Rover]+1]↑.Hh.Lh←T;
Mem[T+1]↑.Hh.Rh←Rover; GOTO Label40; END--:171--;Mem[P]↑.Hh.Lh← INT[Q]-P--:169--;
P←Mem[ INT[P]+1]↑.Hh.Rh; IF P=Rover THEN EXIT; ENDLOOP;
IF S=1073741824 THEN BEGIN GetNodeResult←65535; GOTO Label10; END;
IF INT[LoMemMax]+2<HiMemMin THEN IF INT[LoMemMax]+2<=65535 THEN--168:
BEGIN IF INT[LoMemMax]+1000<HiMemMin THEN T← INT[LoMemMax]+1000 ELSE T← PascalDIVPower2[(
INT[LoMemMax]+HiMemMin+2),1];IF T>65535 THEN T←65535;
P←Mem[ INT[Rover]+1]↑.Hh.Lh;Q←LoMemMax;Mem[ INT[P]+1]↑.Hh.Rh←Q;
Mem[ INT[Rover]+1]↑.Hh.Lh←Q;Mem[ INT[Q]+1]↑.Hh.Rh←Rover;Mem[ INT[Q]+1]↑.Hh.Lh←P;
Mem[Q]↑.Hh.Rh←65535;Mem[Q]↑.Hh.Lh←T-LoMemMax;LoMemMax←T;
Mem[LoMemMax]↑.Hh.Rh←0;Mem[LoMemMax]↑.Hh.Lh←0;Rover←Q; GOTO Label20;
END--:168--;Overflow[188,MemMax+1];EXITS Label40 => NULL};Mem[R]↑.Hh.Rh←0;
VarUsed←VarUsed+S;GetNodeResult←R;EXITS Label10 => NULL};EXIT; EXITS Label20 => NULL} ENDLOOP; END;--:167----172:
FreeNode: PROCEDURE[P: Halfword,S: Halfword] =
BEGIN Q:Halfword;
Mem[P]↑.Hh.Lh←S;Mem[P]↑.Hh.Rh←65535;Q←Mem[ INT[Rover]+1]↑.Hh.Lh;
Mem[ INT[P]+1]↑.Hh.Lh←Q;Mem[ INT[P]+1]↑.Hh.Rh←Rover;Mem[ INT[Rover]+1]↑.Hh.Lh←P;
Mem[ INT[Q]+1]↑.Hh.Rh←P;VarUsed←VarUsed-S; END;--:172----173:
SortAvail: PROCEDURE =
BEGIN P, Q, R:Halfword;OldRover:Halfword;
P←GetNode[1073741824];P←Mem[ INT[Rover]+1]↑.Hh.Rh;
Mem[ INT[Rover]+1]↑.Hh.Rh←65535;OldRover←Rover;WHILE P#OldRover DO--174:
IF INT[P]<Rover THEN BEGIN Q←P;P←Mem[ INT[Q]+1]↑.Hh.Rh;Mem[ INT[Q]+1]↑.Hh.Rh←Rover;
Rover←Q; END ELSE BEGIN Q←Rover;
WHILE INT[Mem[ INT[Q]+1]↑.Hh.Rh]<P DO Q←Mem[ INT[Q]+1]↑.Hh.Rh ENDLOOP ;R←Mem[ INT[P]+1]↑.Hh.Rh;
Mem[ INT[P]+1]↑.Hh.Rh←Mem[ INT[Q]+1]↑.Hh.Rh;Mem[ INT[Q]+1]↑.Hh.Rh←P;P←R; END--:174-- ENDLOOP ;
P←Rover;
WHILE Mem[ INT[P]+1]↑.Hh.Rh#65535 DO BEGIN Mem[ INT[Mem[ INT[P]+1]↑.Hh.Rh]+1]↑.Hh.Lh←P;
P←Mem[ INT[P]+1]↑.Hh.Rh; END ENDLOOP ;Mem[ INT[P]+1]↑.Hh.Rh←Rover;Mem[ INT[Rover]+1]↑.Hh.Lh←P; END;
--:173----177:-- FlushList: PROCEDURE[P: Halfword] =
BEGIN Q, R:Halfword;
IF INT[P]>=HiMemMin THEN IF P#50000 THEN BEGIN R←P;{DO Q←R;
R←Mem[R]↑.Hh.Rh;DynUsed←DynUsed-1;IF INT[R]<HiMemMin THEN GOTO Label30;
IF R=50000 THEN EXIT; ENDLOOP;EXITS Label30 => NULL};Mem[Q]↑.Hh.Rh←Avail;Avail←P; END; END;
FlushNodeList: PROCEDURE[P: Halfword] =
BEGIN Q:Halfword;
WHILE P#0 DO BEGIN Q←P;P←Mem[P]↑.Hh.Rh;
IF INT[Q]<HiMemMin THEN FreeNode[Q,2] ELSE BEGIN Mem[Q]↑.Hh.Rh←Avail;
Avail←Q;DynUsed←DynUsed-1; END; END ENDLOOP ; END;--:177----180:
END.