TurboModula2/src/compiler/CODEGEN.MOD

(* 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.StrLenHelper(entry^.word1, 128));
                 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.ScannerError(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.ScannerError(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.EnterModuleSymbol("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;
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+ *)
    Emit1( Compiler.keywordTable[stdNo][0] );
(* $T- *)
  END; (* 0701 *)
END EmitStandardOp;

PROCEDURE EmitMiscOp(subOp, n: CARDINAL);
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+ *)
        Emit1(Compiler.keywordTable[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.codeBuffer);
  windowBase  := 0;
  windowLimit  := 4096;
  nextEmitPos  := 16;
  OpenEmitter;
END InitCodeGenerator;

END CodeGen.