MPL Bytecode Compiler Code

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

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

CONST

  MPLFEXT = '.MPL'; (* COCO = /MPL:1 *)
  MPXFEXT = '.MPX'; (* COCO = /MPX:1 *)
  MPLPATH = {$IFDEF HPC}'M:MPL\'{$ELSE}''{$ENDIF};
  MPLIMAX = 16382; (* ~32K *)
  MPLSIZE = 0;
  MPLBOOT = 1;
  MPLSTAT = 2;
  MPLHEAP = 3;
  MPLCODE = 4;

TYPE

  PTR = POINTER;
  PTRINT = {$IFDEF CPU16}INTEGER{$ENDIF}{$IFDEF CPU32}LONGINT{$ENDIF};

  PTEXT = ^TEXT;
  BOOL = BOOLEAN;
  INT = INTEGER; PINT = ^INT;
  STR127 = STRING[127]; PSTR127 = ^STR127;

  TXOP = (
    XABORT,X1PADD,X1PAND,X1PASL,X1PASR,X1PDIV,X1PIOR,X1PMOD,X1PMUL,X1PSET,
    X1PSUB,X1PXOR,X2PADD,X2PAND,X2PASL,X2PASR,X2PDIV,X2PIOR,X2PMOD,X2PMUL,
    X2PSET,X2PSUB,X2PXOR,XAPAD1,XAPAD2,XAPAI1,XAPAI2,XAPD1A,XAPD2A,XAPI1A,
    XAPI2A,XAPLDA,XASADD,XASSUB,XBTAND,XBTIOR,XBTXOR,XCPGTE,XCPGTH,XCPLTE,
    XCPLTH,XEQEQU,XEQNEQ,XFNBEG,XFNEND,XFNJMP,XIMCHR,XIMINT,XIMSTR,XINCA1,
    XINCA2,XJMPEQ,XJMPNE,XJMPTO,XLDBYT,XLDEQU,XLDGTE,XLDGTH,XLDINT,XLDINV,
    XLDLTE,XLDLTH,XLDNEG,XLDNEQ,XLEAD1,XLEAD2,XLGAND,XLGIOR,XLGXOR,XMDDIV,
    XMDMOD,XMDMUL,XPEBYT,XPEINT,XPULLA,XPUSHA,XSHASL,XSHASR,XZZEND);

  TBLK = PACKED ARRAY[0..63] OF INT;

  TVEC = PACKED RECORD CASE INT OF
    1: (I: PACKED ARRAY[0..MPLIMAX] OF INT);
    2: (C: PACKED ARRAY[0..0] OF CHAR);
    3: (B: PACKED ARRAY[0..0] OF TBLK);
  END;

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

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

FUNCTION FOLD(VAR F: TEXT; VAR FN: STR127): INT;
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;