Final.mesa
Copyright © 1985 by Xerox Corporation. All rights reserved.
Sweet, September 8, 1980 10:08 AM
Satterthwaite, May 27, 1986 3:10:58 pm PDT
Maxwell, July 28, 1983 3:28 pm
Russ Atkinson (RRA) March 6, 1985 11:18:06 pm PST
DIRECTORY
Alloc USING [Notifier],
Code USING [CodePassInconsistency, codeptr, reentryLabel, tailJumpOK],
CodeDefs USING [Base, Byte, CCIndex, CCInfoType, CCNull, codeType, JumpCCIndex, JumpCCNull, JumpType, LabelCCIndex, LabelCCNull, RelativePC],
ComData USING [switches],
FOpCodes USING [qLFC, qPOP, qRET],
OpCodeParams USING [MaxBBJumps, MaxFBJumps, MaxFIAJumps, MaxFICJumps, zJEQn, zJn, zJNEn],
OpTableDefs USING [--InstAligned,-- InstLength],
P5 USING [C0, C1, C1W, PeepHole],
P5F USING [CPass5],
P5U USING [DeleteCell, OutJump],
PeepholeDefs USING [NextInteresting, PrevInteresting, RemoveThisPop, SetRealInst],
PrincOps
USING [zJB, zJEQ4, zJEQB, zJGB, zJGEB, zJLB, zJLEB, zJNE4, zJNEB, zJUGB, zJUGEB, zJULB, zJULEB, zJW, zJZEQB, zJZNEB];
Final:
PROGRAM
IMPORTS CPtr: Code, MPtr: ComData, OpTableDefs, P5U, P5, P5F, PeepholeDefs
EXPORTS CodeDefs, P5, P5F = BEGIN OPEN PeepholeDefs, CodeDefs;
cb: CodeDefs.Base; -- code base (local copy)
CJump:
ARRAY JumpType[JumpE..ZJumpN]
OF JumpType = [
JumpN, JumpE, JumpGE, JumpL, JumpLE, JumpG,
UJumpGE, UJumpL, UJumpLE, UJumpG, ZJumpN, ZJumpE];
FinalNotify:
PUBLIC Alloc.Notifier =
BEGIN -- called by allocator whenever table area is repacked
cb ← base[codeType];
END;
DidSomething: PUBLIC BOOL;
StartIndex: PUBLIC LabelCCIndex;
EndIndex: PUBLIC CCIndex;
SeenSwitch: BOOL;
JumpCellCount: CARDINAL;
ccInfo: PUBLIC CCInfoType ← generating;
CCInfoMeaning:
PUBLIC
PROC
RETURNS [CCInfoType] =
BEGIN
RETURN [ccInfo]
END;
Fixup:
PUBLIC
PROC [start: LabelCCIndex, ownEntry:
CARDINAL] =
BEGIN -- a final pass over the code to fix up jumps
jumpsBefore, jumpsAfter, totalJumps: CARDINAL;
crossJump: BOOL = MPtr.switches['j];
ccInfo ← generating;
DidSomething ← TRUE;
SeenSwitch ← TRUE;
StartIndex ← start;
PeepholeDefs.SetRealInst[FALSE];
IF crossJump AND CPtr.tailJumpOK THEN TailJump[ownEntry];
CPtr.reentryLabel ← LabelCCNull; -- avoid dangling ref if deleted
DO
pass 0: distinguish forward and backward jumps
CPass0[];
IF ~DidSomething THEN EXIT;
DidSomething ← FALSE;
SeenSwitch ← ~SeenSwitch;
pass 1: eliminate multiple labels
CPass1[];
pass 2: eliminate jump to jumps
CPass2[];
pass 3: eliminate unreachable code
CPass3[];
pass 4: replace cj-j seq. with ccj
CPass4[];
pass 5: cross jumping
IF crossJump THEN P5F.CPass5[];
ENDLOOP; -- end of the meta-pass consisting of passes 0-5
pass 6: do some peephole optimization: load-store, EXCH-commutative op.
P5.PeepHole[StartIndex];
jump threads are now pc's, debug output take note
ccInfo ← binding;
pass 7: set length and alignment, count jumps
totalJumps ← jumpsAfter ← CPass7[];
jumpsBefore ← jumpsAfter+1;
pass 8: resolve (most) jump instructions
THROUGH [1..3]
WHILE jumpsAfter # 0
AND jumpsAfter < jumpsBefore
DO
jumpsBefore ← jumpsAfter;
jumpsAfter ← CPass8[];
ENDLOOP;
pass 9: resolve (remaining) jump instructions
IF jumpsAfter # 0 THEN CPass9[];
pass 11: code jumps
ccInfo ← coding;
IF totalJumps # 0 THEN CPass11[];
END;
TailJump:
PROC [ownEntry:
CARDINAL] =
BEGIN -- remove simple tail recursion
next: CCIndex;
FOR c: CCIndex ← cb[StartIndex].flink, next
WHILE c # CCNull
DO
next ← cb[c].flink;
WITH cb[c]
SELECT
FROM
code =>
IF ~realinst
AND inst = FOpCodes.qLFC
AND parameters[1] = ownEntry
AND UCreturn[next]
THEN
BEGIN
CPtr.codeptr ← cb[c].blink;
P5U.OutJump[Jump, CPtr.reentryLabel];
P5U.DeleteCell[c]
END
ENDCASE;
ENDLOOP;
END;
UCreturn:
PROC [start: CCIndex]
RETURNS [
BOOL] =
BEGIN -- find (unconditional) path to RET
next: CCIndex;
FOR c: CCIndex ← start, next
WHILE c # CCNull
DO
WITH cc: cb[c]
SELECT
FROM
code => RETURN [~cc.realinst AND cc.inst = FOpCodes.qRET];
label => next ← cc.flink;
jump =>
BEGIN
IF ~UCjump[c] THEN EXIT;
next ← cc.destlabel;
END;
other =>
WITH cc
SELECT
FROM
table => EXIT;
ENDCASE => next ← cc.flink;
ENDCASE => EXIT;
ENDLOOP;
RETURN [FALSE]
END;
CPass0:
PROC =
BEGIN -- pass 0: distinguish forward and backward jumps
JumpCellCount ← 0;
FOR c: CCIndex ← StartIndex, cb[c].flink
WHILE c # CCNull
DO
EndIndex ← c;
WITH cb[c]
SELECT
FROM
label => labelseen ← SeenSwitch;
jump =>
BEGIN
forward ←
IF destlabel = LabelCCNull THEN TRUE
ELSE ~(cb[destlabel].labelseen = SeenSwitch);
JumpCellCount ← JumpCellCount + 1;
END;
ENDCASE;
ENDLOOP;
END;
CPass1:
PROC =
BEGIN
-- pass 1: eliminate multiple labels, unreferenced labels,
and jumps to .+1
nextC, c: CCIndex;
FOR c ← cb[StartIndex].flink, nextC
WHILE c # CCNull
DO
nextC ← NextInteresting[c];
WITH cc:cb[c]
SELECT
FROM
jump =>
IF DotPlusOneJump[
LOOPHOLE[c], nextC]
AND
(UCjump[c]
OR cc.jtype
IN [JumpE..UJumpLE])
THEN
DeleteJump[LOOPHOLE[c]];
label =>
IF cc.jumplist = JumpCCNull
THEN
{DidSomething ← TRUE; P5U.DeleteCell[LOOPHOLE[c, LabelCCIndex]]}
ELSE
IF nextC # CCNull
THEN
WITH cb[nextC]
SELECT
FROM
label =>
BEGIN
DidSomething ← TRUE;
DeleteLabel[LOOPHOLE[c, LabelCCIndex], LOOPHOLE[nextC, LabelCCIndex]];
END;
ENDCASE;
ENDCASE;
ENDLOOP;
END;
DotPlusOneJump:
PROC [jc: JumpCCIndex, next: CCIndex]
RETURNS [
BOOL] =
INLINE
BEGIN
RETURN [
IF next = CCNull
THEN
FALSE
-- RRA fix
ELSE
WITH cb[next]
SELECT
FROM
label => next = cb[jc].destlabel,
ENDCASE => FALSE]
END;
DeleteJump:
PROC [jc: JumpCCIndex] =
BEGIN
IF cb[jc].jtype
IN [JumpE..UJumpLE]
THEN
THROUGH [0..2)
DO
CPtr.codeptr ← cb[jc].blink;
P5.C0[FOpCodes.qPOP];
[] ← PeepholeDefs.RemoveThisPop[CPtr.codeptr];
ENDLOOP;
UnthreadJump[jc];
DidSomething ← TRUE; P5U.DeleteCell[jc];
END;
CPass2:
PROC =
BEGIN -- pass 2: eliminate jump to jumps
FOR c: CCIndex ← cb[StartIndex].flink, cb[c].flink
WHILE c # CCNull
DO
WITH jj: cb[c]
SELECT
FROM
jump =>
IF jj.destlabel # LabelCCNull
THEN
BEGIN
jtojExists: BOOL ← FALSE;
jcCount: CARDINAL ← 0;
jc: JumpCCIndex ← LOOPHOLE[c, JumpCCIndex];
jcLabel: LabelCCIndex;
cc: CCIndex;
DO
jcLabel ← cb[jc].destlabel;
IF (cc ← NextInteresting[jcLabel]) = CCNull THEN EXIT;
IF ~UCjump[cc] THEN EXIT;
jc ← LOOPHOLE[cc, JumpCCIndex];
IF jc = c THEN {jtojExists ← FALSE; EXIT};
jcCount ← jcCount +1;
IF jcCount > JumpCellCount THEN {jtojExists ← FALSE; EXIT};
jtojExists ← TRUE;
ENDLOOP;
IF jtojExists
THEN
BEGIN
DidSomething ← TRUE;
UnthreadJump[LOOPHOLE[c, JumpCCIndex]];
jj.thread ← cb[jcLabel].jumplist;
cb[jcLabel].jumplist ← LOOPHOLE[c, JumpCCIndex];
jj.destlabel ← jcLabel;
END;
END;
ENDCASE
ENDLOOP;
END;
CPass3:
PROC =
BEGIN -- pass 3: eliminate unreachable code
FOR c: CCIndex ← cb[StartIndex].flink, cb[c].flink
WHILE c # CCNull
DO
WITH cb[c]
SELECT
FROM
jump =>
IF UCjump[c]
OR jtype = JumpRet
OR jtype = JumpCA
THEN
BEGIN
cc: CCIndex ← flink;
oldc: CCIndex;
DO {
IF (oldc ← cc) = CCNull THEN RETURN;
cc ← cb[cc].flink;
WITH cb[oldc]
SELECT
FROM
label => IF jumplist # JumpCCNull THEN EXIT;
jump => UnthreadJump[LOOPHOLE[oldc, JumpCCIndex]];
other => IF otag # table THEN GOTO skip; --body start/stop, source
ENDCASE;
P5U.DeleteCell[oldc];
DidSomething ← TRUE;
}
ENDLOOP;
END;
ENDCASE;
ENDLOOP;
END;
CPass4:
PROC =
BEGIN -- pass 4: replace cj-j seq. with ccj
c, nextC: CCIndex;
FOR c ← cb[StartIndex].flink, nextC
WHILE c # CCNull
DO
WITH oldC: cb[c]
SELECT
FROM
jump =>
BEGIN
nextC ←
IF MPtr.switches['j]
THEN NextInteresting[c]
ELSE cb[c].flink; -- don't ignore source chunks here
IF oldC.jtype
IN [JumpE..ZJumpN]
AND nextC # CCNull
THEN
WITH nc: cb[nextC]
SELECT
FROM
jump =>
IF oldC.destlabel = nc.destlabel
AND
(UCjump[c]
OR oldC.jtype
IN [JumpE..UJumpLE])
THEN
DeleteJump[LOOPHOLE[c]]
ELSE
IF UCjump[nextC]
AND
(PrevInteresting[oldC.destlabel] = nextC)
THEN
BEGIN
newLbl: LabelCCIndex = nc.destlabel;
nxt: CCIndex;
UnthreadJump[LOOPHOLE[nextC, JumpCCIndex]];
UnthreadJump[LOOPHOLE[c, JumpCCIndex]];
oldC.destlabel ← newLbl;
oldC.thread ← cb[newLbl].jumplist;
cb[newLbl].jumplist ← LOOPHOLE[c, JumpCCIndex];
oldC.jtype ← CJump[oldC.jtype];
oldC.forward ← nc.forward;
nxt ← nc.flink;
P5U.DeleteCell[nextC];
nextC ← nxt;
END;
ENDCASE;
END;
ENDCASE => nextC ← cb[c].flink;
ENDLOOP;
END;
CPass7:
PROC
RETURNS [unboundJumps:
CARDINAL ← 0] =
BEGIN -- pass 7: set length and alignment, count jumps
c, next: CCIndex;
look for body starting with a loop
IF ~MPtr.switches['j]
THEN
BEGIN
c ← NextInteresting[cb[StartIndex].flink];
IF c # CCNull
THEN
-- RRA fix
WITH cb[c]
SELECT
FROM
label =>
IF jumplist # JumpCCNull
THEN
BEGIN
CPtr.codeptr ← cb[c].blink;
P5U.OutJump[Jump, LOOPHOLE[c]];
cb[LOOPHOLE[CPtr.codeptr, JumpCCIndex]].forward ← TRUE;
END;
ENDCASE;
END;
FOR c ← cb[StartIndex].flink, next
WHILE c # CCNull
DO
next ← cb[c].flink;
WITH cb[c]
SELECT
FROM
code =>
BEGIN
IF isize = 0 THEN isize ← OpTableDefs.InstLength[inst];
aligned ← isize = 3 OR inst = PrincOps.zCATCH OR
(isize # 2 AND OpTableDefs.InstAligned[inst]);
END;
jump =>
IF jtype = JumpRet THEN P5U.DeleteCell[c]
ELSE unboundJumps ← unboundJumps+1;
ENDCASE;
ENDLOOP;
RETURN
END;
CPass8:
PROC
RETURNS [unboundJumps:
CARDINAL ← 0] =
BEGIN -- pass 8: resolve easy jumps
FillInPCEstimates[];
FOR c: CCIndex ← cb[StartIndex].flink, cb[c].flink
WHILE c # CCNull
DO
WITH cb[c]
SELECT
FROM
jump =>
IF ~fixedup
THEN
BEGIN
min, max: CARDINAL;
target: LabelCCIndex = destlabel;
IF forward
THEN
BEGIN
min ← cb[target].minPC - minPC;
max ← cb[target].maxPC - maxPC;
END
ELSE
BEGIN
min ← minPC - cb[target].minPC;
max ← maxPC - cb[target].maxPC;
END;
IF ~BindJump[min, max,
LOOPHOLE[c, JumpCCIndex]]
THEN unboundJumps ← unboundJumps+1;
END;
ENDCASE;
ENDLOOP;
RETURN
END;
CPass9:
PROC =
BEGIN -- pass 9: resolve (remaining) jump instructions
FillInPCEstimates[];
FOR c: CCIndex ← cb[StartIndex].flink, cb[c].flink
WHILE c # CCNull
DO
WITH cb[c]
SELECT
FROM
jump =>
IF ~fixedup
THEN
BEGIN
nBytes:
CARDINAL =
IF forward
THEN cb[destlabel].maxPC - maxPC
ELSE maxPC - cb[destlabel].maxPC;
[] ← BindJump[nBytes, nBytes, LOOPHOLE[c, JumpCCIndex]];
END;
ENDCASE;
ENDLOOP;
END;
CPass11:
PROC =
BEGIN -- pass 11: code jumps
FillInPC[];
FOR c: CCIndex ← cb[StartIndex].flink, cb[c].flink
WHILE c # CCNull
DO
WITH cb[c]
SELECT
FROM
jump =>
BEGIN
IF ~fixedup THEN SIGNAL CPtr.CodePassInconsistency
ELSE CodeJump[(
IF forward
THEN cb[destlabel].pc - pc
ELSE pc - cb[destlabel].pc), LOOPHOLE[c, JumpCCIndex]];
END;
ENDCASE;
ENDLOOP;
END;
DeleteLabel:
PROC [oldc, c: LabelCCIndex] =
BEGIN -- removes extra label from code stream
lq, q: JumpCCIndex;
IF cb[c].jumplist = JumpCCNull THEN cb[c].jumplist ← cb[oldc].jumplist
ELSE
BEGIN
q ← cb[c].jumplist;
UNTIL q = JumpCCNull DO lq ← q; q ← cb[q].thread ENDLOOP;
cb[lq].thread ← cb[oldc].jumplist;
END;
FOR q ← cb[oldc].jumplist, cb[q].thread
UNTIL q = JumpCCNull
DO cb[q].destlabel ← c ENDLOOP;
P5U.DeleteCell[oldc];
END;
UnthreadJump:
PUBLIC
PROC [c: JumpCCIndex] =
BEGIN -- pull jump cell out of thread from label
l: LabelCCIndex = cb[c].destlabel;
jc: JumpCCIndex;
IF l = LabelCCNull THEN RETURN;
jc ← cb[l].jumplist;
IF jc = c THEN cb[l].jumplist ← cb[jc].thread
ELSE
BEGIN
UNTIL cb[jc].thread = c DO jc ← cb[jc].thread ENDLOOP;
cb[jc].thread ← cb[c].thread;
END;
END;
UCjump:
PUBLIC
PROC [c: CCIndex]
RETURNS [
BOOL] =
BEGIN -- predicate testing if c is an unconditonal jump
RETURN [
WITH cb[c]
SELECT
FROM
jump => jtype = Jump,
ENDCASE => FALSE]
END;
Removeablejump:
PROC [c: CCIndex]
RETURNS [
BOOL] =
BEGIN -- predicate testing if c is an unconditonal jump
RETURN [
WITH cb[c]
SELECT
FROM
jump => (jtype = Jump OR jtype = JumpA OR jtype = JumpCA),
ENDCASE => FALSE]
END;
FillInPC:
PROC =
BEGIN -- fills in relative PC of all labels and jumps.
all jump lengths have been resolved and pad values set
PC of forward jump is end of instruction
PC of backward jump is start of pad (if any)
rpc: RelativePC ← 0;
nbytes: CARDINAL;
FOR k: CCIndex ← StartIndex, cb[k].flink
UNTIL k = CCNull
DO {
nbytes ← (
WITH cc:cb[k]
SELECT
FROM
code => cc.isize,
jump => IF cc.completed THEN 0 ELSE cc.jsize,
other => (
WITH cc
SELECT
FROM
table => tablecodebytes,
ENDCASE => 0),
ENDCASE => 0);
WITH cc:cb[k]
SELECT
FROM
jump =>
IF cc.forward THEN {rpc ← rpc+nbytes; cc.pc ← rpc; GOTO skip}
ELSE cc.pc ← rpc;
label => cc.pc ← rpc;
ENDCASE;
rpc ← rpc+nbytes;
}
ENDLOOP;
END;
CodeJumpDist:
PROC [jDist:
INTEGER, l: [0..7], c: JumpCCIndex] =
BEGIN -- code all jump instruction(s)
OPEN PrincOps, OpCodeParams;
t: JumpType;
RelJumpOps:
ARRAY JumpType[JumpL..ZJumpN]
OF Byte = [
zJLB, zJGEB, zJGB, zJLEB, zJULB, zJUGEB, zJUGB, zJULEB,
zJZEQB, zJZNEB];
t ← cb[c].jtype;
SELECT t
FROM
Jump, JumpA, JumpCA =>
SELECT l
FROM
1 =>
BEGIN
IF jDist NOT IN [2..9] THEN SIGNAL CPtr.CodePassInconsistency;
P5.C0[zJn+jDist-2];
END;
2 =>
BEGIN
IF jDist NOT IN [-128..128) THEN SIGNAL CPtr.CodePassInconsistency;
P5.C1[zJB, jDist];
END;
ENDCASE =>
BEGIN
P5.C1W[zJW, jDist];
END;
JumpE, JumpN =>
SELECT l
FROM
1 =>
BEGIN
IF jDist NOT IN [2..9] THEN SIGNAL CPtr.CodePassInconsistency;
P5.C0[(IF t=JumpE THEN zJEQn ELSE zJNEn)+jDist-2];
END;
2 =>
BEGIN
IF jDist NOT IN [-128..128) THEN SIGNAL CPtr.CodePassInconsistency;
P5.C1[(IF t = JumpE THEN zJEQB ELSE zJNEB), jDist];
END;
ENDCASE =>
BEGIN
P5.C0[(IF t = JumpE THEN zJNE4 ELSE zJEQ4)];
P5.C1W[zJW, jDist];
END;
JumpC => NULL;
ENDCASE =>
SELECT l
FROM
2 =>
BEGIN
IF jDist NOT IN [-128..128) THEN SIGNAL CPtr.CodePassInconsistency;
P5.C1[RelJumpOps[t], jDist];
END;
ENDCASE =>
BEGIN
P5.C1[RelJumpOps[CJump[t]], 5];
P5.C1W[zJW, jDist];
END;
cb[c].completed ← TRUE;
cb[c].jsize ← 0; -- so it doesn't have to be ignored in ComputeJumpDistance
END;
formerly in module DJumps
BindJump:
PROC [min, max:
INTEGER, c: JumpCCIndex]
RETURNS [bindable: BOOL ← TRUE] =
BEGIN -- compute size of jump instruction(s)
OPEN OpCodeParams;
max and min are counts of the number of bytes between the
jump and the label.
t: JumpType = cb[c].jtype;
js: [0..7];
IF t = JumpC
THEN
BEGIN -- "bound" by OutBinary
cb[c].fixedup ← TRUE;
cb[c].completed ← TRUE;
RETURN
END;
IF ~cb[c].forward THEN BEGIN max ← -max; min ← -min END;
SELECT t
FROM
Jump, JumpA =>
IF max IN [1..MaxFIAJumps] THEN js ← 1
ELSE IF max IN (MaxFIAJumps..MaxFBJumps-2] AND min > MaxFIAJumps THEN js ← 2
ELSE IF max IN [-MaxBBJumps..0] THEN js ← 2
ELSE IF min NOT IN [-MaxBBJumps..MaxFBJumps-2] THEN js ← 3
ELSE bindable ← FALSE;
JumpE, JumpN =>
IF max IN [1..MaxFICJumps] THEN js ← 1
ELSE IF max IN (MaxFICJumps..MaxFBJumps-2] AND min > MaxFICJumps THEN js ← 2
ELSE IF max IN [-MaxBBJumps..0] THEN js ← 2
ELSE IF min NOT IN [-MaxBBJumps..MaxFBJumps-2] THEN js ← 4
ELSE bindable ← FALSE;
JumpCA =>
IF max IN [-MaxBBJumps..MaxFBJumps-2] THEN js ← 2
ELSE IF min NOT IN [-MaxBBJumps..MaxFBJumps-2] THEN js ← 3
ELSE bindable ← FALSE;
ENDCASE =>
IF max IN [-MaxBBJumps..MaxFBJumps-2] THEN js ← 2
ELSE IF min NOT IN [-MaxBBJumps..MaxFBJumps-2] THEN js ← 5
ELSE bindable ← FALSE;
IF bindable THEN {cb[c].fixedup ← TRUE; cb[c].jsize ← js};
RETURN
END;
CodeJump:
PROC [nbytes:
INTEGER, c: JumpCCIndex] =
BEGIN -- code all jump instruction(s)
l: [0..7] = cb[c].jsize;
forward: BOOL = cb[c].forward;
dist: INTEGER ← IF ~forward THEN -nbytes ELSE nbytes+l;
IF l > 3 THEN dist ← dist + 3 - l;
Computing dist copes with the fact that the parameter to a jump
instruction is added to the byte pc of the first byte of the instruction
nbytes is the number of bytes between the jump and its label
CPtr.codeptr ← c;
CodeJumpDist[dist, l, c];
END;
dMinMax:
ARRAY {unconditional, equal, relational}
OF
PACKED
ARRAY
BOOL
OF
RECORD [min,max: [0..15]] ← [
[[2,3], [1,3]], -- unconditional, (backward, forward)
[[2,4], [1,4]], -- equal, (backward, forward)
[[2,5], [2,5]]]; -- relational, (backward, forward)
FillInPCEstimates:
PROC =
BEGIN
min, max: RelativePC ← 0;
FOR k: CCIndex ← StartIndex, cb[k].flink
UNTIL k = CCNull
DO
WITH cc:cb[k]
SELECT
FROM
code =>
BEGIN
t: CARDINAL = cc.isize;
min ← min + t;
max ← max + t;
END;
jump =>
IF cc.jtype # JumpC
THEN
BEGIN
IF ~cc.fixedup
THEN
BEGIN
dMin, dMax: [0..15];
[dMin,dMax] ← dMinMax[(
SELECT cc.jtype
FROM
Jump, JumpA, JumpCA => unconditional,
JumpE, JumpN => equal,
ENDCASE => relational)][cc.forward];
IF ~cc.forward THEN {cc.minPC ← min; cc.maxPC ← max};
min ← min+dMin; max ← max+dMax;
IF cc.forward THEN {cc.minPC ← min; cc.maxPC ← max};
END
ELSE
IF ~cc.completed
THEN
BEGIN
t: CARDINAL = cc.jsize;
IF ~cc.forward THEN {cc.minPC ← min; cc.maxPC ← max};
min ← min + t;
max ← max + t;
IF cc.forward THEN {cc.minPC ← min; cc.maxPC ← max};
END;
END;
label => {cc.minPC ← min; cc.maxPC ← max};
other =>
WITH cc
SELECT
FROM
table =>
BEGIN
min ← min + tablecodebytes;
max ← max + tablecodebytes;
END;
ENDCASE;
ENDCASE;
ENDLOOP;
END;
END.