MPL Bytecode Compiler Code

VAR GREF1, GREF2: REF; {$IFNDEF HASEXITCODE}EXITCODE: SHORT;{$ENDIF}

{$IFNDEF HASLOWERCASE}
FUNCTION LOWERCASE(A: CHAR): CHAR; BEGIN
  IF A IN [CHR(65)..CHR(90)] THEN LOWERCASE:=CHR(ORD(A)+32) ELSE LOWERCASE:=A;
END;
{$ENDIF}

{$IFNDEF HASREADKEY}
FUNCTION READKEY: CHAR; VAR C: CHAR; BEGIN
  READ(KBD, C); READKEY:=C;
END;
{$ENDIF}

{$IFNDEF HASUPCASE}
FUNCTION UPCASE(C: CHAR): CHAR; BEGIN
  IF C IN [CHR(97)..CHR(122)] THEN UPCASE := CHR(ORD(C) - 32) ELSE UPCASE := C;
END;
{$ENDIF}

FUNCTION ARGC: SHORT; BEGIN ARGC := PARAMCOUNT END;

PROCEDURE ARGV(VAR S: STR127; I: SHORT); BEGIN
  S := PARAMSTR(I); FOR I:=1 TO LENGTH(S) DO S[I] := UPCASE(S[I])
END;

PROCEDURE MSET(A: POINTER; C: CHAR; L: SHORT);
BEGIN
  GREF1.P:= A;
  WHILE L>0 DO BEGIN
    GREF1.B^.A:=C; GREF1.A:=SUCC(GREF1.A);
    L:=PRED(L);
  END
END;

PROCEDURE MREV(A: POINTER; L: SHORT); VAR T: BYTE;
BEGIN GREF1.P:=A;GREF2.P:=A;GREF2.A:=PRED(GREF2.A+L);
  WHILE (GREF1.A-GREF2.A)<0 DO BEGIN
    T:=GREF1.B^;GREF1.B^:=GREF2.B^;GREF2.B^:=T;
    GREF1.A:=SUCC(GREF1.A);GREF2.A:=PRED(GREF2.A);
  END;
END;

PROCEDURE _MMOV(A, B: POINTER; L: SHORT);
BEGIN GREF1.P:= A; GREF2.P:= B;
  IF (GREF1.A - GREF2.A) < 0 THEN BEGIN
    GREF1.A:=GREF1.A+L;
    GREF2.A:=GREF2.A+L;
    WHILE L > 0 DO BEGIN
      GREF1.A:=PRED(GREF1.A); GREF2.A:=PRED(GREF2.A); GREF1.B^:=GREF2.B^;
      L:=PRED(L);
    END END
  ELSE WHILE L > 0 DO BEGIN
    GREF1.B^:=GREF2.B^; GREF1.A:=SUCC(GREF1.A); GREF2.A:=SUCC(GREF2.A);
    L:=PRED(L)
  END
END;

{$IFDEF HASSHORTINT}
TYPE IEXT = SHORTINT;
{$ELSE}
FUNCTION IEXT(A: SHORT): SHORT; BEGIN
  IF (A AND $80)=0 THEN IEXT:=A AND $00FF ELSE IEXT:=A OR $FF00
END;
{$ENDIF}

FUNCTION IMIN(A, B: SHORT): SHORT; BEGIN IF A<B THEN IMIN:=A ELSE IMIN:=B END;
FUNCTION IMAX(A, B: SHORT): SHORT; BEGIN IF A>B THEN IMAX:=A ELSE IMAX:=B END;

FUNCTION ISQRT(A: SHORT): SHORT; VAR N0, N1: SHORT;
BEGIN IF A > 0 THEN BEGIN N0:=SUCC(A DIV 2); N1:=(N0 + (A DIV N0)) DIV 2;
  WHILE N1 < N0  DO BEGIN N0:=N1; N1:=(N0 + (A DIV N0)) DIV 2
  END; ISQRT:=N0 END ELSE ISQRT:=0 END;

FUNCTION IPOW(A, B: SHORT): SHORT; VAR OUT: SHORT;
BEGIN OUT:=1; WHILE B > 0 DO BEGIN
    IF (B AND 1) <> 0 THEN BEGIN OUT:=OUT * A END;
    B:=B SHR 1; A:=A * A
  END; IPOW:=OUT END;

PROCEDURE IOFS(VAR A: SHORT; VAR B: STR127); BEGIN VAL(B,A,EXITCODE) END;

FUNCTION RABS(A: REAL): REAL; BEGIN IF A<0 THEN RABS:=-A ELSE RABS:=A END;
FUNCTION RMIN(A, B: REAL): REAL; BEGIN IF A<B THEN RMIN:=A ELSE RMIN:=B END;
FUNCTION RMAX(A, B: REAL): REAL; BEGIN IF A>B THEN RMAX:=A ELSE RMAX:=B END;
FUNCTION RCMP(A, B: REAL): SHORT; BEGIN IF A<B THEN RCMP:=-1 ELSE IF A>B THEN RCMP:=1 ELSE RCMP:=0 END;
PROCEDURE ROFS(VAR A: REAL; VAR B: STR127); BEGIN VAL(B,A,EXITCODE) END;

PROCEDURE SDEL(VAR A: STR127; I, L: CHAR); BEGIN DELETE(A,ORD(I),ORD(L)) END;
PROCEDURE SINS(VAR A, B: STR127; I: CHAR); BEGIN INSERT(B,A,ORD(I)) END;
PROCEDURE SMID(VAR A, B: STR127; I, L: CHAR); BEGIN A:=COPY(B,ORD(I),ORD(L)) END;
PROCEDURE SCPY(VAR A, B: STR127); BEGIN A:=B END;
PROCEDURE SADD(VAR A, B, C: STR127); BEGIN A:=B+C END;

PROCEDURE SFIX(VAR A: STR127; L: SHORT);
BEGIN IF L < 0 THEN L:=0 ELSE IF L > 127 THEN L:=127; A[0]:=CHR(L) END;

PROCEDURE SOFI(VAR A: STR127; B: SHORT; W: SHORT); BEGIN STR(B:W,A) END;
PROCEDURE SOFR(VAR A: STR127; B: REAL; W, D: SHORT); BEGIN STR(B:W:D,A) END;

FUNCTION FRES(VAR A: TEXT): BOOL;
BEGIN FRES := IORESULT = 0 END;

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

FUNCTION FNEW(VAR F: TEXT; VAR FN: STR127): BOOL; BEGIN
  {$IFDEF HPC}ERASE(FN);{$ENDIF}
  ASSIGN(F, FN); REWRITE(F); FNEW:=FRES(F) END;

FUNCTION FEND(VAR F: TEXT): BOOL; BEGIN CLOSE(F); FEND:=FRES(F) END;

FUNCTION FRDC(VAR F: TEXT; VAR C: CHAR): BOOL; BEGIN
  IF EOF(F) THEN FRDC:= FALSE ELSE BEGIN
    IF EOLN(F) THEN BEGIN READLN(F); C:=CHR(10) END ELSE READ(F, C);
    FRDC:=FRES(F)
  END
END;

FUNCTION FWRC(VAR F: TEXT; C: CHAR): BOOL;
BEGIN IF C = CHR(10) THEN WRITELN(F) ELSE WRITE(F, C); FWRC:=FRES(F) END;

FUNCTION FRDS(VAR F: TEXT; VAR S: STR127): BOOL;
BEGIN READLN(F, S); FRDS:=FRES(F) END;

FUNCTION FWRS(VAR F: TEXT; VAR S: STR127): BOOL; VAR I: SHORT;
BEGIN FWRS:=FALSE;
  FOR I:=1 TO LENGTH(S) DO IF NOT FWRC(F, S[I]) THEN EXIT;
  FWRS:=TRUE END;