MPL Bytecode Compiler Code

(* MPL - MICRO PROGRAMMING LANGUAGE / COPYRIGHT (C) 2017-2018 DEREK JOHN EVANS *)

USES CRT{$IFDEF HPC}, DOS{$ENDIF};

CONST VECMAX = 12288; (* 24K *)

TYPE

  PTRINT = LONGINT; {or INTEGER;}
  PTR = POINTER;

  PINTEGER = ^INTEGER;
  STR127 = STRING[127]; PSTR127 = ^STR127;

  TXOP = (
    XABORT, X1PADD, X1PAND, X1PDIV, X1PIOR, X1PMOD, X1PMUL, X1PSET, X1PSHL,
    X1PSHR, X1PSUB, X1PXOR, X2PADD, X2PAND, X2PDIV, X2PIOR, X2PMOD, X2PMUL,
    X2PSET, X2PSHL, X2PSHR, X2PSUB, X2PXOR, XAPDEC, XAPDEP, XAPGET, XAPINC,
    XAPINP, XBTAND, XBTIOR, XBTXOR, XCPGTE, XCPGTH, XCPLTE, XCPLTH, XDMDIV,
    XDMMOD, XDMMUL, XEQNOT, XEQYES, XFNBEG, XFNEND, XFNJMP, XIDADD, XIDSUB,
    XIFEQU, XIFNEQ, XIFNOW, XIMCHR, XIMINT, XIMSTR, XINCA1, XINCA2, XLDBYT,
    XLDINT, XLDNEG, XLEAD1, XLEAD2, XLGAND, XLGIOR, XLGXOR, XPEBYT, XPEINT,
    XPULLA, XPUSHA, XSHSHL, XSHSHR, XZEND);

  TVEC = PACKED RECORD CASE INTEGER OF
    1: (N, P: INTEGER);
    2: (S: STR127);
    3: (I: PACKED ARRAY[0..VECMAX] OF INTEGER);
    4: (C: PACKED ARRAY[0..0] OF CHAR);
  END;

{$IFDEF HPC}
TYPE SEX = SHORTINT;
{$ELSE}
FUNCTION SEX(A: INTEGER): INTEGER; BEGIN
  if (A AND $80) <> 0 then SEX := A or $FF00 else SEX := A and $00FF
END;
{$ENDIF}

FUNCTION ARGC: INTEGER; BEGIN ARGC := PARAMCOUNT END;
PROCEDURE ARGV(VAR D: STR127; I: INTEGER); BEGIN D := PARAMSTR(I) END;

FUNCTION FOLD(VAR F: TEXT; VAR FN: STR127): INTEGER;
BEGIN ASSIGN(F, FN); RESET(F); FOLD := IORESULT END;

FUNCTION FRDC(VAR F: TEXT): CHAR; VAR C: CHAR; BEGIN
  IF EOF(F) THEN C := CHR(0)
  ELSE BEGIN IF EOLN(F) THEN BEGIN READLN(F); C := CHR(10) END ELSE READ(F, C);
    IF IORESULT <> 0 THEN C := CHR(0)
  END; FRDC := C
END;