MPL Bytecode Compiler Code

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

FUNCTION LOAD:BOOL; VAR F:FILE OF BYTE128; FN:STR127; I:SHORT; BEGIN
  LOAD:=FALSE; ARGV(FN,1); FN:=FN+MPXFEXT; ASSIGN(F,FN); RESET(F);
  IF IORESULT=0 THEN BEGIN
    I:=0; WHILE NOT EOF(F) DO BEGIN READ(F,GX.B[I]); I:=SUCC(I); END;
    CLOSE(F); LOAD:=GX.I[MPLNULL]=1234 END END;

PROCEDURE INIT; VAR O:OPER; BEGIN
  FOR O:=OSTOP TO OOO96 DO CASE O OF
    ODREF,OSU1A,OSUA1,OAD1A,OADA1,OSU2A,OSUA2,OAD2A,OADA2:GK[O]:=KDI;
    OAND3,OSET3,OSUB3,ODIV3,OADD3,OIOR3,OMOD3,OMUL3,OASL3,OASR3,OXOR3:GK[O]:=KX3;
    OAND4,OSET4,OSUB4,ODIV4,OADD4,OIOR4,OMOD4,OMUL4,OASL4,OASR4,OXOR4:GK[O]:=KX4;
    OSET2,OAND2,OIOR2,OXOR2,OTGE2,OTGT2,OTLE2,OTLT2,ODIV2,OMOD2,OMUL2,
    OTNE2,OTEQ2,OTAN2,OTOR2,OTXO2,OASL2,OASR2,OADD2,OSUB2,OLD21,
    OLD22:GK[O]:=KX2 ELSE GK[O]:=K00
  END;
  GX.I[MPLNULL]:=0;
  GR.SP:=SUCC(GX.I[MPLSIZE]) SHR 1; GR.PC:=GX.I[MPLCODE];
  GX.I[MPLSIZE]:=MPLMAXI SHL 1; GX.I[MPLMAXI]:=0;
END;

{$IFDEF FPC}
CONST XPOSE:SET OF PROC=[
  PARGC,PARGV,PCLWR,PCUPR,PFEND,PFNEW,PFOLD,PFRDC,PFRDS,PFWRC,PFWRS,PIABS,PIMAX,
  PIMIN,PISQR,PSOFI,PMCPY,PMREV,PMSET,PRABS,PRADD,PRATN,PRCMP,PRCOS,PRCPY,PRDIV,
  PREXP,PRFRA,PRINT,PRLOG,PRMAX,PRMIN,PRMUL,PRNEG,PRROU,PRSIN,PRSQR,PRSRT,PRSUB,
  PIOFR,PSOFR,PSADD,PSCPY,PSDEL,PSINS,PSMID,PSCHR,PSSTR,PIOFS,PROFS,PVCEL,PVILN,
  PVRDC,PVRDK,PVRDS,PVWRC,PVWRS,PVCSR,PVDLN,PVGXY,PVISK,PSFIX,PFEOF];

PROCEDURE LIBMPX(FN:STR127); VAR T:TEXT; P:PROC;
  PROCEDURE WRV(S:STR127; I:SHORT); BEGIN WRITELN(T,S+'.',':',I) END;
  PROCEDURE WRI(S:STR127; I:SHORT); BEGIN WRV('.'+S,I) END;
BEGIN
  IF FNEW(T,FN) THEN BEGIN WRITELN(T,'// AUTO GENERATED');
    FOR P:=LOW(PROC) TO HIGH(PROC) DO IF P IN XPOSE THEN BEGIN
      STR(P,FN); DELETE(FN,1,1); WRI(FN,-ORD(P));
    END;
    WRV('CODE',MPLCODE*2); WRV('SIZE',MPLSIZE*2);
    WRI('FINP',ORD(FINP)); WRI('FOUT',ORD(FOUT));
    WRI('FMIN',ORD(FMIN)); WRI('FMAX',ORD(FMAX));
    WRI('NIL',0); WRI('FALSE',0); WRI('TRUE',1); WRI('EOF',-1);
    WRI('INT',2); WRI('INT.MIN',LOW(SHORT)); WRI('INT.MAX',HIGH(SHORT));
    WRI('STR',128); WRI('REAL',8); WRI('LONG',4);
    FEND(T) END END;
{$ENDIF}