(* Renamed for readability. Semantics unchanged. Original identifiers: see docs/compiler/ + src/compiler/RENAME-MAP.md. *) IMPLEMENTATION MODULE CodeGen; IMPORT Scanner, Files, Compiler; FROM ComLine IMPORT codepos, execute; FROM SYSTEM IMPORT ADR, MOVE; CONST OPINVALID = 0; OPRAISE = 1; OPLDPROC = 2; OPLDPARAM = 3; OPLLD = 8; OPLGD = 9; OPLSD = 0AH; OPLED = 0BH; OPLDEXT = 0CH; OPLXB = 0DH; OPLXW = 0EH; OPLXD = 0FH; OPLDIX = 10H; OPLDIXN = 11H; OPLONGREAL= 12H; OPSETPARM = 13H; OPSLD = 18H; OPSGD = 19H; OPSSD = 1AH; OPSED = 1BH; OPSTEXT = 1CH; OPXSB = 1DH; OPSXW = 1EH; OPSXD = 1FH; OPDUP = 20H; OPSWAP = 21H; OPLLW2 = 22H; OPLLWN = 2CH; OPLGWN = 2DH; OPLSWN = 2EH; OPLEWN = 2FH; OPMOVB = 30H; OPMOVS = 31H; OPSLW2 = 32H; OPSLWN = 3CH; OPSGWN = 3DH; OPSSWN = 3EH; OPSEWN = 3FH; OPEXTENDED= 40H; OPLSD0 = 41H; OPLGW2 = 42H; OPENDPROG = 50H; OPSSD0 = 51H; OPSGW2 = 52H; OPLSW0 = 60H; OPSSW0 = 70H; OPLLA = 80H; OPLGA = 81H; OPLSA = 82H; OPLEA = 83H; OPLEAVE = 84H; OPFLEAVE = 85H; OPLFLEAVE = 86H; OPASM = 87H; OPLEAVE0 = 88H; OPCALLREL = 8CH; OPLIB = 8DH; OPLIW = 8EH; OPLID = 8FH; OPLI0 = 90H; OPLI15 = 9FH; OPEQUAL = 0A0H; OPNEQ = 0A1H; OPLESS = 0A2H; OPGREATER = 0A3H; OPLESSEQ = 0A4H; OPGREATEQ = 0A5H; OPADD = 0A6H; OPSUB = 0A7H; OPMUL = 0A8H; OPDIV = 0A9H; OPMOD = 0AAH; OPEQ0 = 0ABH; OPINC = 0ACH; OPDEC = 0ADH; OPADDN = 0AEH; OPSUBN = 0AFH; OPSHL = 0B0H; OPSHR = 0B1H; OPILESS = 0B2H; OPIGREATER= 0B3H; OPILESSEQ = 0B4H; OPIGREATEQ= 0B5H; OPNOT = 0B6H; OPCOMPL = 0B7H; OPIMUL = 0B8H; OPIDIV = 0B9H; OPLG2CARD = 0BAH; OPLG2INT = 0BBH; OPABS = 0BCH; OPINT2LG = 0BDH; OPLG2FLOAT= 0BEH; OPFLOAT2LG= 0BFH; OPADDOV = 0C0H; OPSUBOV = 0C1H; OPMULOV = 0C2H; OPSYSTEM = 0C3H; OPSTRCOMP = 0C4H; OPDCOMP = 0C5H; OPDADD = 0C6H; OPDSUB = 0C7H; OPDDIV = 0C8H; OPDMOD = 0C9H; OPNEQ0 = 0CAH; OPDABS = 0CBH; OPCASE = 0CDH; OPRETURN = 0CEH; OPPUSHREL = 0CFH; OPIADDOV = 0D0H; OPISUBOV = 0D1H; OPSTKRES = 0D2H; OPSTRRES = 0D3H; OPENTER = 0D4H; OPREALCMP = 0D5H; OPREALADD = 0D6H; OPREALSUB = 0D7H; OPREALMUL = 0D8H; OPREALDIV = 0D9H; OPRANGE = 0DAH; OPIRANGE = 0DBH; OPLIMIT = 0DCH; OPPOSITIV = 0DDH; OPANDJP = 0DEH; OPORJP = 0DFH; OPJP = 0E0H; OPJPCOND = 0E1H; OPJPF = 0E2H; OPJPFCOND = 0E3H; OPJPB = 0E4H; OPJPBCOND = 0E5H; OPBITOR = 0E6H; OPBITIN = 0E7H; OPBITAND = 0E8H; OPBITXOR = 0E9H; OPPOWER2 = 0EAH; OPEXTCALLS= 0EBH; OPINTCALL = 0ECH; OPCALL = 0EDH; OPCALLFRM = 0EEH; OPEXTCALL2= 0EFH; OPEXTCALL1= 0F0H; OPCALL1 = 0F1H; TYPE Record = RECORD word0: CARDINAL; CASE : CARDINAL OF | 0: word1,word2: CARDINAL; | 1: ptr1: POINTER TO ARRAY [0..255] OF CHAR; | 2: long1: LONGINT; END; END; RecordPtr = POINTER TO Record; VAR (* 6 *) codeWindow : POINTER TO ARRAY [0..2047] OF BYTE; (* 7 *) pendMode : [0..9]; (* 8 *) pendSize : [0..5]; (* 9 *) pendDisp : CARDINAL; (* 10 *) pendOffset: CARDINAL; (* 11 *) fixupQueue: ARRAY [0..15] OF Record; (* 12 *) fixupCount: [0..16]; (* 13 *) spare13: WORD; (* 14 *) pendActive: BOOLEAN; (* 15 *) checkOverflow: BOOLEAN; (* 16 *) reservedBytes: ARRAY [0..11] OF BYTE; (* 17 *) reservedWord: WORD; EXCEPTION errorfound; (* $[+ remove procedure names *) PROCEDURE CodeAssert(cond: BOOLEAN); EXCEPTION CE; BEGIN IF NOT cond THEN RAISE CE END; END CodeAssert; PROCEDURE FlushCodeWindow; BEGIN Files.SetPos(Scanner.codeFile, LONG(windowBase)); Files.WriteBytes(Scanner.codeFile, ADDRESS(codeWindow), 2048); INC(windowBase, 2048); INC(windowLimit, 2048); MOVE(ADDRESS(codeWindow) + 2048, ADDRESS(codeWindow), nextEmitPos - windowBase); END FlushCodeWindow; PROCEDURE SeekCodeWindow; VAR baseSec : CARDINAL; alignedBase : CARDINAL; needBytes : CARDINAL; BEGIN baseSec := nextEmitPos DIV 512; alignedBase := (baseSec - ORD(baseSec <> 0)) * 512; IF alignedBase < windowBase THEN needBytes := windowBase - alignedBase; IF nextEmitPos > windowBase THEN MOVE(ADDRESS(codeWindow), ADDRESS(codeWindow)+needBytes, nextEmitPos-windowBase); END; Files.SetPos(Scanner.codeFile, LONG(alignedBase)); CodeAssert(Files.ReadBytes(Scanner.codeFile, ADDRESS(codeWindow), needBytes) = needBytes); windowBase := alignedBase; windowLimit := windowBase + 4096; END; END SeekCodeWindow; PROCEDURE PeekCodeByte(pos: CARDINAL): CARDINAL; VAR byte: BYTE; BEGIN IF pos >= windowBase THEN RETURN CARDINAL(codeWindow^[pos-windowBase]) END; Files.SetPos(Scanner.codeFile, LONG(pos)); Files.ReadByte(Scanner.codeFile, byte); RETURN CARDINAL(byte) END PeekCodeByte; PROCEDURE PokeCodeByte(value: BYTE; pos: CARDINAL); BEGIN IF pos >= windowBase THEN codeWindow^[pos-windowBase] := value; RETURN END; Files.SetPos(Scanner.codeFile, LONG(pos)); Files.WriteByte(Scanner.codeFile, value); END PokeCodeByte; PROCEDURE CheckCodeOverflow; BEGIN IF nextEmitPos >= codepos THEN RAISE errorfound END; END CheckCodeOverflow; PROCEDURE Emit1(op: BYTE); BEGIN IF nextEmitPos >= windowLimit THEN FlushCodeWindow END; codeWindow^[nextEmitPos-windowBase] := op; INC(nextEmitPos); IF checkOverflow THEN CheckCodeOverflow END; END Emit1; PROCEDURE Emit2(op2, op1: BYTE); BEGIN IF nextEmitPos + 1 >= windowLimit THEN FlushCodeWindow END; codeWindow^[nextEmitPos - windowBase] := op2; codeWindow^[nextEmitPos + 1 - windowBase] := op1; INC(nextEmitPos, 2); IF checkOverflow THEN CheckCodeOverflow END; END Emit2; PROCEDURE EmitWord(w: WORD); VAR ptr: ADDRESS; BEGIN IF nextEmitPos + 1 >= windowLimit THEN FlushCodeWindow END; ptr := ADDRESS(codeWindow) + (nextEmitPos - windowBase); ptr^ := w; INC(nextEmitPos, 2); IF checkOverflow THEN CheckCodeOverflow END; END EmitWord; PROCEDURE EmitString(s: ADDRESS); VAR ptr : POINTER TO ARRAY [0..1] OF BYTE; BEGIN ptr := s; REPEAT Emit1(ptr^[0]); ptr := ADDRESS(ptr) + 1; UNTIL ORD(ptr^[0]) = 0; IF checkOverflow THEN CheckCodeOverflow END; END EmitString; PROCEDURE FlushPendingOp; VAR base: CARDINAL; PROCEDURE BaseOpCode(mode: CARDINAL): CARDINAL; BEGIN CASE mode OF | 8 : RETURN 60H | 9 : RETURN 0ECH | 1, 5 : RETURN 2CH | 2, 6 : RETURN 08H | 3, 7 : RETURN 0 END; END BaseOpCode; BEGIN pendActive := FALSE; base := 0; IF pendMode <> 9 THEN pendOffset := pendOffset DIV 2; base := pendMode DIV 4 * (ORD((pendMode MOD 4) <> 3) * 12 + 4); END; IF pendSize = 4 THEN IF pendDisp = 1 THEN Emit1(OPLDIX) ELSE Emit2(OPLDIXN, pendDisp) END; IF pendOffset >= 128 THEN (* $T+ *) Emit2(OPSUBN, (256 - pendOffset) * 2); pendOffset := 0; (* $T- *) END; pendSize := 2; END; IF pendMode IN {3,7} THEN Emit1(OPLONGREAL) END; IF pendSize = 5 THEN IF pendMode IN {3,7} THEN Emit2(pendMode DIV 4 + 8, 0) ELSE Emit1(pendMode MOD 4 + base + 13) END; ELSE IF pendMode IN {0,4} THEN INC(pendMode) END; IF pendSize = 3 THEN IF (pendOffset <= 15) AND (pendDisp <= 15) AND (pendMode IN {1,5,9}) THEN IF pendMode = 9 THEN base := 0E4H END; Emit2(base + 12, pendDisp * 16 + pendOffset); RETURN END; Emit2(BaseOpCode(pendMode)+base+3, pendDisp); Emit1(pendOffset); ELSE CASE pendMode OF | 9: IF (pendSize = 1) AND (pendOffset IN {1,2,3,4,5,6,7,8,9,10,11,12,13,14,15}) THEN Emit1(pendOffset + OPEXTCALL1); RETURN END; | 8: IF (pendSize = 2) AND (pendOffset = 0) THEN RETURN END; | 1, 5: IF (pendSize <> 2) OR NOT Compiler.rangeCheckEnabled THEN IF pendSize = 0 THEN IF pendOffset <= 7 THEN Emit1(pendOffset + base); RETURN ELSIF pendOffset >= 245 THEN Emit1(base + 288 - pendOffset); RETURN END; ELSE IF (pendOffset >= (4 - pendSize * 2)) AND (pendOffset <= 15) THEN Emit1((pendSize + 1) * 32 + pendOffset + base); RETURN END; END; END; | 2, 6: IF (pendSize = 2) AND (pendOffset = 0) THEN Emit1(base + (OPLGW2 - 1)); RETURN END; END; Emit2(BaseOpCode(pendMode) + pendSize + base, pendOffset); IF Compiler.rangeCheckEnabled AND (pendMode = 8) AND (pendSize <= 1) THEN Emit1(pendDisp) END; END; END; END FlushPendingOp; PROCEDURE FlushConstQueue; VAR idx : CARDINAL; k : CARDINAL; w : CARDINAL; entry : POINTER TO Record; BEGIN IF pendActive THEN FlushPendingOp ELSE IF fixupCount <> 0 THEN idx := 0; WHILE idx < fixupCount DO entry := ADR(fixupQueue[idx]); CASE entry^.word0 OF | 0: (* 02EE *) IF entry^.word2 <> 0 THEN Emit2(2, entry^.word2) ELSE Emit2(OPCALLREL, Scanner.StrLen(entry^.word1, 128) (*FIXME: open-array HIGH passed explicitly*)); EmitString(entry^.word1); END; | 1: (* 0308 *) IF entry^.word1 <= 255 THEN IF entry^.word1 <= 15 THEN Emit1(entry^.word1 + OPLI0) ELSE Emit2(OPLIB, entry^.word1) END; ELSE (* 0323 *) Emit1(OPLIW); EmitWord(entry^.word1) END; (* 0329 *) | 2: (* 032A *) Emit1(OPLID); EmitWord(entry^.word1); EmitWord(entry^.word2); | 3: (* 0334 *) w := 8; REPEAT (* 0336 *) DEC(w, 4); Emit1(OPLID); k := 0; REPEAT (* 033F *) Emit1(entry^.ptr1^[w + k]); INC(k); UNTIL k > 3; UNTIL w = 0; IF Compiler.rangeCheckEnabled THEN Emit2(0, 22) END; | 4: (* 035B *) IF CARDINAL(ABS(INTEGER(entry^.word1))) <= 255 THEN IF entry^.word1 <> NIL THEN IF ABS(INTEGER(entry^.word1)) = 1 THEN Emit1(ORD(INTEGER(entry^.word1) < 0) + OPINC) ELSE (* 0378 *) Emit2(ORD(INTEGER(entry^.word1) < 0) + OPADDN, ABS(INTEGER(entry^.word1))); END; END; (* 0382 *) ELSE (* 0384 *) Emit1(OPLIW); EmitWord(entry^.word1); Emit1(OPADD); END; (* 038d *) (* $T+ generates ELSE RAISE CaseSelectError *) END; (* CASE *) INC(idx); END; (* 03A8 *) fixupCount := 0; END (* 03AA *) END (* 03aa *); END FlushConstQueue; PROCEDURE Reserved33(dummy: WORD); BEGIN (* commented contents ? *) END Reserved33; PROCEDURE Reserved34(a, b: WORD); VAR unused: WORD; BEGIN (* commented contents ? *) END Reserved34; PROCEDURE DiscardPending; VAR unused: WORD; BEGIN IF emitEnabled THEN fixupCount := fixupCount + ORD(pendActive) - 1; pendActive := FALSE; END; END DiscardPending; PROCEDURE SetPendingOp(mode, size, disp, off: CARDINAL); BEGIN IF emitEnabled THEN FlushConstQueue; pendMode := mode; pendSize := size; pendDisp := disp; pendOffset := off; pendActive := TRUE; IF mode IN {4,5,6,7,9} THEN FlushPendingOp END; END; END SetPendingOp; (* $T- *) PROCEDURE QueueConst(value: CARDINAL); VAR ptr : POINTER TO Record; BEGIN IF emitEnabled THEN IF pendActive THEN FlushPendingOp END; IF fixupCount >= 16 THEN Scanner.ScanErr(90) END; ptr := ADR(fixupQueue[fixupCount]); ptr^.word0 := 1; ptr^.word1 := value; INC(fixupCount); END; END QueueConst; PROCEDURE QueueLongConst(kind: CARDINAL; value: LONGINT); VAR ptr : POINTER TO Record; BEGIN IF emitEnabled THEN IF pendActive THEN FlushPendingOp END; IF fixupCount >= 16 THEN Scanner.ScanErr(90) END; ptr := ADR(fixupQueue[fixupCount]); ptr^.word0 := kind; ptr^.long1 := value; INC(fixupCount); END; END QueueLongConst; PROCEDURE EmitTypedOp(subOp, typeKind : CARDINAL); VAR lastEntry: POINTER TO Record; extBase : CARDINAL; prevEntry: POINTER TO Record; PROCEDURE IsPowerOfTwo(target: CARDINAL): BOOLEAN; VAR i: CARDINAL; j: CARDINAL; BEGIN j := 1; i := 0; REPEAT IF j = target THEN lastEntry := ADDRESS(i); RETURN TRUE END; j := j * 2; INC(i); UNTIL i > 14; RETURN FALSE END IsPowerOfTwo; PROCEDURE Reserved36(): CARDINAL; BEGIN (* commented contents ? *) END Reserved36; BEGIN IF emitEnabled THEN IF fixupCount <> 0 THEN prevEntry := ADR(fixupQueue[fixupCount - 1]); IF prevEntry^.word0 = 1 THEN IF (subOp IN {6,7}) AND (typeKind <= 1) THEN IF subOp = 7 THEN prevEntry^.word1 := -INTEGER(prevEntry^.word1) END; IF fixupCount > 1 THEN IF fixupQueue[fixupCount - 2].word0 IN {1,4} THEN INC(fixupQueue[fixupCount - 2].word1, prevEntry^.word1); DEC(fixupCount); END; (* 04A9 *) END; (* 04A9 *) prevEntry^.word0 := 4; RETURN; ELSE (* 04AF *) IF (subOp IN {8,9}) AND (typeKind = 0) AND IsPowerOfTwo(prevEntry^.word1) THEN DEC(fixupCount); FlushConstQueue; IF lastEntry <> NIL THEN Emit2(subOp + OPMUL, lastEntry) END; (* 04CE *) RETURN ELSE (* 04D1 *) IF (subOp = 10) AND (typeKind <= 1) AND IsPowerOfTwo(prevEntry^.word1) THEN DEC(prevEntry^.word1); FlushConstQueue; Emit1(OPBITAND); RETURN ELSE (* 04EE *) IF (NOT Compiler.rangeCheckEnabled) AND (prevEntry^.word1 = 0) AND (subOp IN {0,1,3}) AND (typeKind <= ORD(subOp <> 3)) THEN DEC(fixupCount); FlushConstQueue; Emit1(OPEQ0 + ORD(subOp <> 0) * 32); RETURN END; (* 0512 *) END; (* 0512 *) END; END; END; (* 0512 *) END; (* 0512 *) FlushConstQueue; IF (typeKind = 5) OR (subOp = 18) THEN extBase := Scanner.EnterMod("DOUBLES", 9567H) * 16; END; (* 0532 *) CASE typeKind OF | 0: (* 0536 *) IF subOp >= 15 THEN IF Compiler.rangeCheckEnabled THEN Emit1(125) ELSE Emit2(144,33) END; typeKind := 2; END; (* 054b *) | 1: (* 054c *) IF subOp >= 15 THEN Emit1(189); typeKind := 2; ELSE IF subOp IN {0,1,6,7,10} THEN typeKind := 0 ELSIF subOp = 11 THEN Emit2(OPCOMPL, OPINC); RETURN END; (* 056E *) END; (* 056E *) | 2: (* 056f *) IF subOp <= 5 THEN Emit1(OPDCOMP); EmitSystemCall(23); typeKind := 0 ELSIF subOp = 11 THEN Emit2(OPEXTENDED,3); RETURN END; (* 0589 *) | 3: (* 058a *) IF subOp <= 5 THEN Emit1(OPREALCMP); EmitSystemCall(23); typeKind := 0 ELSIF subOp IN {11,12} THEN IF Compiler.rangeCheckEnabled THEN Emit1(subOp + OPSSW0) ELSE Emit1(OPSWAP); IF subOp = 11 THEN Emit2(OPLI15, OPPOWER2); Emit1(OPBITXOR); ELSE (* 05BD *) Emit1(OPLIW); EmitWord(7FFFH); Emit1(OPBITAND); END; (* 05c7 *) Emit1(OPSWAP); END; (* 05ca *) RETURN ELSIF subOp IN {13,14,15} THEN Emit1(OPFLOAT2LG); typeKind := 2; END; (* 05d9 *) | 4: (* 05da *) IF subOp <= 5 THEN IF subOp = 5 THEN Emit1(OPSWAP); subOp := 4; END; (* 05E9 *) IF subOp = 4 THEN Emit2(OPCOMPL, OPBITAND); Emit1(OPLI0); subOp := 0 END; (* 05F8 *) typeKind := 0 ELSIF subOp = 7 THEN Emit1(OPCOMPL); subOp := 8 END; (* 0606 *) | 5: (* 0607 *) IF subOp <> 18 THEN Emit1(OPEXTCALL1); IF subOp <= 5 THEN Emit1(extBase+5); typeKind := 0 ELSIF subOp >= 13 THEN typeKind := ORD(subOp = 16) + 2; Emit1(extBase + typeKind - 1); ELSE Emit1(extBase + subOp) END; (* 0634*) IF Compiler.rangeCheckEnabled THEN Emit2(ORD(subOp <= 9)+1, (ORD(subOp IN {6,7,8,9,10,11,12})+1)*4); IF subOp <= 5 THEN EmitSystemCall(23) END; END; (* 064E *) IF typeKind = 5 THEN RETURN END; END; (* 0654 *) (* $T+ generate CaseSelectError exception *) END; (* 066c *) (* $T- *) IF subOp <= 12 THEN Emit1(subOp + typeKind * 16 + 160); ELSIF subOp - 13 <> typeKind THEN IF subOp <= 14 THEN IF typeKind <= 1 THEN Emit1(221) ELSE Emit1(subOp + 173) END; ELSIF subOp <= 16 THEN Emit1(typeKind + 188) ELSE (* 06A3 *) Emit2(OPEXTCALL1, extBase + typeKind + 1); IF Compiler.rangeCheckEnabled THEN Emit2(OPRAISE, 8) END; END; (* 06B1 *) END; (* 06B1 *) END; (* 06b1 *) END EmitTypedOp; PROCEDURE EmitExtendedOp(subOp, typeKind: CARDINAL); BEGIN IF emitEnabled THEN FlushConstQueue; Emit1(typeKind * 16 + subOp + 186) END; END EmitExtendedOp; PROCEDURE EmitStandardOp(stdNo: CARDINAL); VAR ptr: RecordPtr; kwTab: POINTER TO ARRAY [0..29] OF ARRAY [0..1] OF BYTE; (* overlay: keywordTable holds heap CARDINALs; [i][0] reads the low byte (proven shape: limit_check+shl1+LXB) *) BEGIN IF emitEnabled THEN IF (stdNo = 0) AND (fixupCount <> 0) THEN ptr := ADR(fixupQueue[fixupCount-1]); IF (ptr^.word0 = 1) AND (ptr^.word1 = 0) THEN DEC(fixupCount); FlushConstQueue; Emit1(OPLIMIT); RETURN END; (* 06EC *) END; (* 06EC *) FlushConstQueue; IF stdNo >= 23 THEN Emit1(OPEXTENDED); END; (* 06F7 *) (* $T+ *) kwTab := Compiler.keywordTable; Emit1( kwTab^[stdNo][0] ); (* $T- *) END; (* 0701 *) END EmitStandardOp; PROCEDURE EmitMiscOp(subOp, n: CARDINAL); VAR kwTab: POINTER TO ARRAY [0..29] OF ARRAY [0..1] OF BYTE; (* same overlay as EmitStandardOp *) BEGIN IF emitEnabled THEN FlushConstQueue; IF subOp = 5 THEN IF n >= 10 THEN Emit2(OPEXTENDED, n - 5) ELSIF n = 6 THEN IF Compiler.rangeCheckEnabled THEN Emit1(102) ELSE (* generates the bad CAP sequence *) Emit2(OPDUP, OPLIB); Emit2(040H, OPBITAND); Emit2(OPSHR, 1); Emit2(OPCOMPL, OPBITAND); END; (* 073D *) ELSE (* 073F *) (* $T+ *) kwTab := Compiler.keywordTable; Emit1(kwTab^[n+27][0]); (* $T- *) END; (* 074B *) ELSE (* 074D *) IF subOp = 4 THEN Emit2(OPLONGREAL, 10); Emit1(n); ELSIF (subOp = 0) AND (n - 128 <= 3) AND (NOT Compiler.rangeCheckEnabled) THEN Emit1(n + 8) ELSE Emit2(subOp + 132, n) END; (* 0775 *) END; (* 0775 *) END; (* 0775 *) END EmitMiscOp; PROCEDURE EmitSystemCall(sysNo: CARDINAL); BEGIN IF emitEnabled THEN FlushConstQueue; IF Compiler.rangeCheckEnabled AND (sysNo <> 20) THEN Emit2(0,sysNo) END; END; END EmitSystemCall; PROCEDURE EmitExtCall3(a, b, c: CARDINAL); BEGIN IF emitEnabled THEN FlushConstQueue; IF Compiler.rangeCheckEnabled THEN IF a <> 19 THEN Emit2(0, a) END; Emit1(b); IF a >= 3 THEN Emit1(c) END; END; (* 07aa *) END; END EmitExtCall3; PROCEDURE OpenFixup(VAR fixPos: CARDINAL; shortJump: BOOLEAN); VAR prevOp: CARDINAL; BEGIN IF emitEnabled THEN fixPos := nextEmitPos; IF shortJump THEN prevOp := PeekCodeByte(nextEmitPos - 1); IF prevOp - 224 <= 1 THEN PokeCodeByte(prevOp + 2, nextEmitPos - 1); END; Emit1(0) ELSE EmitWord(0) END; END; END OpenFixup; PROCEDURE CloseFixup(fixPos: CARDINAL; shortJump: BOOLEAN); BEGIN IF emitEnabled THEN IF shortJump AND (nextEmitPos < fixPos + 254) THEN PokeCodeByte(PeekCodeByte(nextEmitPos - 1) + 4, nextEmitPos - 1); Emit1(nextEmitPos + 1 - fixPos); ELSE EmitWord(fixPos - (nextEmitPos + 1)) END; END; END CloseFixup; PROCEDURE InsertFixup(fixPos: CARDINAL; shortJump: BOOLEAN): BOOLEAN; VAR holdByte: BYTE; prevByte: BYTE; gapPos: CARDINAL; moveSrc: ADDRESS; BEGIN IF emitEnabled THEN FlushConstQueue; gapPos := fixPos + 1; IF shortJump THEN IF nextEmitPos > gapPos + 254 THEN IF gapPos < windowBase THEN Files.SetPos(Scanner.codeFile, LONG(gapPos)); Files.ReadByte(Scanner.codeFile, holdByte); INC(gapPos); WHILE gapPos < windowBase DO prevByte := holdByte; Files.ReadByte(Scanner.codeFile, holdByte); Files.SetPos(Scanner.codeFile, LONG(gapPos)); Files.WriteByte(Scanner.codeFile, prevByte); INC(gapPos) END; (* 0842 *) MOVE(codeWindow, ADDRESS(codeWindow) + 1, nextEmitPos - windowBase); codeWindow^[0] := holdByte; ELSE (* 0850 *) moveSrc := ADDRESS(codeWindow) + gapPos - windowBase; MOVE(moveSrc, moveSrc + 1, nextEmitPos - gapPos); END; (* 085e *) INC(nextEmitPos); PokeCodeByte( PeekCodeByte(fixPos - 1) - 2, fixPos - 1); PokeCodeByte( (nextEmitPos - gapPos) MOD 256, fixPos); PokeCodeByte( (nextEmitPos - gapPos) DIV 256, gapPos); RETURN FALSE END; (* 087f *) PokeCodeByte(nextEmitPos - gapPos, fixPos); ELSE (* 0887 *) PokeCodeByte( (nextEmitPos - gapPos) MOD 256, fixPos); PokeCodeByte( (nextEmitPos - gapPos) DIV 256, gapPos); END; (* 0898 *) END; (* 0898 *) RETURN TRUE END InsertFixup; PROCEDURE AdjustFixup(fixPos: CARDINAL); VAR dist: CARDINAL; BEGIN IF emitEnabled THEN IF PeekCodeByte(fixPos - 1) <= 225 THEN dist := PeekCodeByte(fixPos) + PeekCodeByte(fixPos + 1) * 256; IF INTEGER(dist) > 0 THEN INC(dist) ELSE DEC(dist) END; PokeCodeByte( dist MOD 256, fixPos); PokeCodeByte( dist DIV 256, fixPos + 1); ELSE (* 08D2 *) PokeCodeByte( PeekCodeByte(fixPos) + 1, fixPos); END; (* 08D9 *) END; (* 08D9 *) END AdjustFixup; PROCEDURE MarkCodePos(n: CARDINAL): CARDINAL; BEGIN EmitSystemCall(n); RETURN nextEmitPos END MarkCodePos; PROCEDURE OpenEmitter; BEGIN emitEnabled := TRUE; pendActive := FALSE; fixupCount := 0; SeekCodeWindow; END OpenEmitter; PROCEDURE InitCodeGenerator; BEGIN checkOverflow := (execute = 4); codeWindow := ADDRESS(Scanner.codeBuf); windowBase := 0; windowLimit := 4096; nextEmitPos := 16; OpenEmitter; END InitCodeGenerator; END CodeGen.