MPL Bytecode Compiler Code

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

{$IFDEF FPC}{$MODE TP}{$S-}{$ENDIF}
{$IFDEF HPC}{$M 8,48,48,16}{$F+}{$S-}{$ENDIF}
{$IFNDEF HPC}{$A-}{$ENDIF}
{$D-}{$I-}{$R-}{$V-}

PROGRAM MPL;

{$I MPL.INC}

VAR GMPL: ^TMPL;

FUNCTION ISOK(OK: BOOLEAN; ERR: TERR): BOOLEAN;
BEGIN
  IF NOT OK THEN BEGIN
    GMPL^.E := GMPL^.E + 1; WRITE('"', GMPL^.A.S, '" -> ');
    CASE ERR OF
      ESYNTAX   : WRITELN('SYNTAX');
      EDUPLICATE: WRITELN('DUPLICATE');
      EUNKNOWN  : WRITELN('UNKNOWN');
    END;
  END;
  ISOK := OK;
END;

FUNCTION SYMGET: INTEGER; VAR OUT: INTEGER; SYM: TSYM;
BEGIN
  IF ISOK(GMPL^.A.O = XLDANEG, ESYNTAX) THEN BEGIN
    OUT := GMPL^.S.N; SYM := GMPL^.S.S;
    WHILE LENGTH(SYM.S^) <> 0 DO BEGIN
      IF SYM.S^ = GMPL^.A.S THEN BEGIN SYMGET := OUT; EXIT; END;
      OUT := OUT - 1; SYM.I := SYM.I + LENGTH(SYM.S^) + 1;
    END;
  END;
  SYMGET := 0;
END;

FUNCTION SYMINC: INTEGER; VAR OUT: INTEGER;
BEGIN
  OUT := SYMGET;
  IF OUT <> 0 THEN SYMINC := OUT
  ELSE BEGIN
    GMPL^.S.S.I := GMPL^.S.S.I - LENGTH(GMPL^.A.S) - 1;
    GMPL^.S.S.S^ := GMPL^.A.S; GMPL^.S.N := GMPL^.S.N + 1;
    SYMINC := GMPL^.S.N;
  END;
END;

PROCEDURE GEN1(VAL: INTEGER);
BEGIN
  GMPL^.M.BYT[GMPL^.M.SIZ].U8 := VAL; GMPL^.M.SIZ := GMPL^.M.SIZ + 1;
END;

PROCEDURE GEN2(VAL: INTEGER);
BEGIN
  MOVE(VAL, GMPL^.M.BYT[GMPL^.M.SIZ], 2); GMPL^.M.SIZ := GMPL^.M.SIZ + 2;
END;

PROCEDURE GENOPR(OPR: TOPR);
BEGIN
  GMPL^.M.BYT[GMPL^.M.SIZ].U8 := ORD(OPR); GMPL^.M.SIZ := GMPL^.M.SIZ + 1;
END;

PROCEDURE GENOPR1(OPR: TOPR; VAL: INTEGER); BEGIN GENOPR(OPR); GEN1(VAL); END;
PROCEDURE GENOPR2(OPR: TOPR; VAL: INTEGER); BEGIN GENOPR(OPR); GEN2(VAL); END;

PROCEDURE GENOPR12(OP1, OP2: TOPR; VAL: INTEGER);
BEGIN
  IF VAL = SHORTINT(VAL) THEN GENOPR1(OP1, VAL) ELSE GENOPR2(OP2, VAL);
END;

PROCEDURE GENATOPR2(PC: INTEGER; OPR: TOPR; VAL: INTEGER); VAR TMP: INTEGER;
BEGIN
  TMP := GMPL^.M.SIZ; GMPL^.M.SIZ := PC; GENOPR2(OPR, VAL); GMPL^.M.SIZ := TMP;
END;

PROCEDURE GENLDI(VAL: INTEGER); VAR TMP: INTEGER;
BEGIN
  TMP := VAL + 128;
  IF (TMP >= ORD(XZZZ)) AND (TMP <= 255) THEN GEN1(TMP)
  ELSE GENOPR12(XLDICHR, XLDIINT, VAL);
END;

PROCEDURE GENSTR; VAR SYM: TSYM;
BEGIN
  SYM.A := ADDR(GMPL^.M.BYT[GMPL^.M.SIZ]); SYM.S^ := GMPL^.A.S;
  GMPL^.M.SIZ := GMPL^.M.SIZ + LENGTH(GMPL^.A.S) + 1;
END;

PROCEDURE GENSYM(STR: SHORTSTRING; VAL: INTEGER);
BEGIN
  GMPL^.A.S := STR; GMPL^.A.O := XLDANEG; GMPL^.S.T[SYMINC].I16 := VAL;
END;

PROCEDURE GENCMD(STR: SHORTSTRING; CMD: TCMD);
BEGIN
  GENSYM('STD.' + STR, GMPL^.M.SIZ); GEN2(-ORD(CMD));
END;

PROCEDURE GENLIB;
BEGIN
  IF GMPL^.S.N < 5 THEN BEGIN
    GENCMD('ABS', CABS);            GENCMD('PARAMCOUNT', CPARAMCOUNT);
    GENCMD('PARAMSTR', CPARAMSTR);  GENCMD('CGETC', CCGETC);
    GENCMD('CLOSE', CCLOSE);        GENCMD('CLREOL', CCLREOL);
    GENCMD('CLRSCR', CCLRSCR);      GENCMD('COPY', CCOPY);
    GENCMD('CPUTC', CCPUTC);        GENCMD('DELETE', CDELETE);
    GENCMD('DELLINE', CDELLINE);    GENCMD('FGETC', CFGETC);
    GENCMD('FILL', CFILL);          GENCMD('FPUTC', CFPUTC);
    GENCMD('GOTOXY', CGOTOXY);      GENCMD('INSERT', CINSERT);
    GENCMD('INSLINE', CINSLINE);    GENCMD('KEYPRESSED', CKEYPRESSED);
    GENCMD('MOVE', CMOVE);          GENCMD('POS', CPOS);
    GENCMD('READKEY', CREADKEY);    GENCMD('RESET', CRESET);
    GENCMD('REWRITE', CREWRITE);
    GENCMD('MIN', CMIN);            GENCMD('MAX', CMAX);
    GENSYM('TRUE', 1);              GENSYM('FALSE', 0);
    GENSYM('NULL', 0);
    GENSYM('SIZEOF.REAL', SIZEOF(REAL));
    GENSYM('SIZEOF.INT', SIZEOF(INTEGER));
  END;
END;

PROCEDURE GENINC; VAR TXT: TEXT; CUR: CHAR;

  PROCEDURE GETCHR; BEGIN IF CUR <> CHR(0) THEN CUR := FGETC(TXT); END;

  FUNCTION GETMETA: CHAR;
  BEGIN
    IF CUR = '*' THEN BEGIN
      GETCHR;
      CASE UPCASE(CUR) OF
        '0': CUR := CHR( 0); 'A': CUR := CHR( 7); 'B': CUR := CHR( 8);
        'T': CUR := CHR( 9); 'N': CUR := CHR(10); 'V': CUR := CHR(11);
        'P': CUR := CHR(12); 'C': CUR := CHR(13); 'S': CUR := CHR(32);
      END;
    END;
    GETMETA := CUR;
  END;

  PROCEDURE GO1(GRP: TGRP; OPR: TOPR);
  BEGIN GMPL^.A.G := GRP; GMPL^.A.O := OPR; END;

  PROCEDURE GO2(GRP: TGRP; OPR: TOPR);
  BEGIN GMPL^.A.G := GRP; GMPL^.A.O := OPR; GETCHR; END;

  PROCEDURE NEXT; LABEL LOOP;
  BEGIN
  LOOP:
    WHILE CUR IN [CHR(1)..CHR(32)] DO GETCHR;
    GMPL^.A.S := UPCASE(CUR); GETCHR; GO1(ISBRK, XFINISH);
    CASE GMPL^.A.S[1] OF
      '.', 'A'..'Z': BEGIN
        CUR := UPCASE(CUR);
        WHILE CUR IN ['.', 'A'..'Z', '0'..'9'] DO BEGIN
          GMPL^.A.S := GMPL^.A.S + CUR; GETCHR; CUR := UPCASE(CUR);
        END;
        GMPL^.A.O := XLDANEG;
      END;
      '0'..'9': BEGIN
        GMPL^.A.V := ORD(GMPL^.A.S[1]) - ORD('0');
        WHILE CUR IN ['0'..'9'] DO BEGIN
          GMPL^.A.V := GMPL^.A.V * 10 + ORD(CUR) - ORD('0'); GETCHR;
        END;
        GMPL^.A.O := XLDIINT;
      END;
      '"': BEGIN
        GMPL^.A.S[0] := CHR(0);
        WHILE NOT (CUR IN [CHR(0), '"']) DO BEGIN
          GMPL^.A.S := GMPL^.A.S + GETMETA; GETCHR;
        END;
        IF CUR = '"' THEN BEGIN GMPL^.A.O := XLDISTR; GETCHR; END;
      END;
      '''': BEGIN
        GMPL^.A.V := ORD(GETMETA); GETCHR;
        IF CUR = '''' THEN BEGIN GETCHR; GMPL^.A.O := XLDIINT; END;
      END;
      '?': GMPL^.A.O := XJMPEQU; '@': GMPL^.A.O := XJMPNEQ;
      ';': GMPL^.A.O := XJMPNOW; '$': GMPL^.A.O := XLEAINT;
      ',': GMPL^.A.O := XFUNJMP;
      '(': GMPL^.A.O := XFUNBEG; ')': GMPL^.A.O := XFUNEND;
      '[': GMPL^.A.O := XPSHACC; ']': GMPL^.A.O := XGETACC;
      '%': GMPL^.A.O := XLDACHR; '!': GMPL^.A.O := XLDAINT;
      '#': GO1(ISDMM, XDMMMOD);
      '/': CASE CUR OF
        '/': BEGIN
          WHILE NOT (CUR IN [CHR(0), CHR(10)]) DO GETCHR;
          GOTO LOOP;
        END;
        '*': BEGIN
          GETCHR;
          REPEAT
            WHILE NOT (CUR IN [CHR(0), '*']) DO GETCHR;
            GETCHR;
          UNTIL CUR IN [CHR(0), '/'];
          GETCHR; GOTO LOOP;
        END;
        '=': GO2(ISASN, X2ASDIV);
        ELSE GO1(ISDMM, XDMMDIV);
      END;
      '^': CASE CUR OF '=': GO2(ISASN, X2ASXOR) ELSE GO1(ISBIT, XBITXOR) END;
      '=': CASE CUR OF '=': GO2(ISEQU, XEQUYES) ELSE GO1(ISASN, X2ASSET) END;
      '+': CASE CUR OF
        '+': GO2(ISBRK, X2ADINC); '=': GO2(ISASN, X2ASADD);
        ELSE GO1(ISSUM, XSUMADD);
      END;
      '-': CASE CUR OF
        '-': GO2(ISBRK, X2ADDEC); '=': GO2(ISASN, X2ASSUB);
        ELSE GO1(ISSUM, XSUMSUB);
      END;
      '*': CASE CUR OF
          '=': GO2(ISASN, X2ASMUL);
          ELSE GO1(ISDMM, XDMMMUL);
        END;
      '<': CASE CUR OF
        '<': GO2(ISSHF, XSHFSHL); '>': GO2(ISEQU, XEQUNOT);
        '=': GO2(ISCMP, XCMPLTE); ELSE GO1(ISCMP, XCMPLTH);
      END;
      '>': CASE CUR OF
        '>': GO2(ISSHF, XSHFSHR); '=': GO2(ISCMP, XCMPGTE);
        ELSE GO1(ISCMP, XCMPGTH);
      END;
      ':': CASE CUR OF
        ':': GO2(ISLOG, XLOGIOR); '=': GO2(ISASN, X2ASIOR);
        ELSE GO1(ISBIT, XBITIOR);
      END;
      '&': CASE CUR OF
        '&': GO2(ISLOG, XLOGAND); '=': GO2(ISASN, X2ASAND);
        ELSE GO1(ISBIT, XBITAND);
      END;
    END;
  END;

  FUNCTION ISOPR(OPR: TOPR): BOOLEAN;
  BEGIN
    IF GMPL^.A.O <> OPR THEN ISOPR := FALSE
    ELSE BEGIN NEXT; ISOPR := TRUE; END;
  END;

  FUNCTION ISGRP(GRP: TGRP; VAR OPR: TOPR): BOOLEAN;
  BEGIN
    OPR := GMPL^.A.O;
    IF GMPL^.A.G <> GRP THEN ISGRP := FALSE
    ELSE BEGIN NEXT; ISGRP := TRUE; END;
  END;

  FUNCTION GETSGN: INTEGER; VAR OUT: INTEGER; OPR: TOPR;
  BEGIN
    OUT := 1; WHILE ISGRP(ISSUM, OPR) DO IF OPR = XSUMSUB THEN OUT := -OUT;
    GETSGN := OUT;
  END;

  FUNCTION GETINT: INTEGER; VAR OUT, SGN: INTEGER;
  BEGIN
    SGN := GETSGN;
    IF GMPL^.A.O = XLDIINT THEN BEGIN
      OUT := GMPL^.A.V; NEXT;
    END ELSE WITH GMPL^.S.T[SYMINC] DO BEGIN
      NEXT;
      IF GMPL^.A.O = XLEAINT THEN BEGIN OUT := I16; NEXT; END
      ELSE OUT := GMPL^.M.INT[I16 SHR 1].I16;
    END;
    GETINT := OUT * SGN;
  END;

  FUNCTION X2X1(OPR: TOPR): TOPR;
  BEGIN
    CASE OPR OF
      X2ASADD: OPR := X1ASADD; X2ASAND: OPR := X1ASAND;
      X2ASDIV: OPR := X1ASDIV; X2ASIOR: OPR := X1ASIOR;
      X2ASMUL: OPR := X1ASMUL; X2ASSET: OPR := X1ASSET;
      X2ASSHL: OPR := X1ASSHL; X2ASSHR: OPR := X1ASSHR;
      X2ASSUB: OPR := X1ASSUB; X2ASXOR: OPR := X1ASXOR;
    END;
    X2X1 := OPR;
  END;

  PROCEDURE GENEXP; FORWARD;

  PROCEDURE GENASN(CANASN: BOOLEAN);

    PROCEDURE GENVAR; VAR OPR: TOPR;
    BEGIN
      OPR := GMPL^.A.O; IF OPR IN [X2ADINC, X2ADDEC] THEN NEXT;
      WITH GMPL^.S.T[SYMINC] DO BEGIN
        NEXT;
        IF ISOK(I16 <> 0, EUNKNOWN) THEN CASE OPR OF
          X2ADINC: GENOPR12(X1ADINC, X2ADINC, I16);
          X2ADDEC: GENOPR12(X1ADDEC, X2ADDEC, I16);
          ELSE IF CANASN AND (GMPL^.A.G = ISASN) THEN BEGIN
            OPR := GMPL^.A.O; NEXT;
            GENOPR12(XPSHCHR, XPSHINT, I16); GENEXP; GENOPR(OPR);
          END ELSE CASE GMPL^.A.O OF
            XLEAINT: BEGIN GENOPR12(XLEACHR, XLEAINT, I16); NEXT; END;
            X2ADINC: BEGIN GENOPR12(X1ADINP, X2ADINP, I16); NEXT; END;
            X2ADDEC: BEGIN GENOPR12(X1ADDEP, X2ADDEP, I16); NEXT; END
            ELSE GENOPR12(X1ADGET, X2ADGET, I16);
          END;
        END;
      END;
    END;

    PROCEDURE GENADR(ISINT: BOOLEAN); VAR OPR: TOPR;
    BEGIN
      NEXT; GENASN(FALSE);
      IF CANASN AND (GMPL^.A.G = ISASN) THEN BEGIN
        IF ISINT THEN OPR := GMPL^.A.O ELSE OPR := X2X1(GMPL^.A.O);
        GENOPR(XPSHACC); NEXT; GENEXP; GENOPR(OPR);
      END ELSE IF ISINT THEN GENOPR(XLDAINT) ELSE GENOPR(XLDACHR);
    END;

    PROCEDURE GENIDX(ISINT: BOOLEAN); VAR OPR: TOPR;
    BEGIN
      NEXT; GENOPR(XPSHACC); GENASN(FALSE);
      IF CANASN AND (GMPL^.A.G = ISASN) THEN BEGIN
        IF ISINT THEN BEGIN
          OPR := GMPL^.A.O; NEXT; GENOPR(XIDXINT);
        END ELSE BEGIN
          OPR := X2X1(GMPL^.A.O); NEXT; GENOPR(XIDXCHR);
        END;
        GENEXP; GENOPR(OPR);
      END ELSE IF ISINT THEN GENOPR(XGETINT) ELSE GENOPR(XGETCHR);
    END;

  VAR I, SGN: INTEGER; LABEL LOOP;
  BEGIN
    SGN := GETSGN;
    CASE GMPL^.A.O OF
      XLDACHR, XLDAINT: GENADR(GMPL^.A.O = XLDAINT);
      XFUNBEG: BEGIN
        NEXT;
        IF NOT ISOPR(XFUNEND) THEN BEGIN
          GENEXP; IF NOT ISOK(ISOPR(XFUNEND), ESYNTAX) THEN EXIT;
        END;
      END;
      X2ASSET: BEGIN NEXT; GENEXP; GENOPR(XFUNEND); END;
      XLDIINT: BEGIN GENLDI(GMPL^.A.V * SGN); SGN := 1; NEXT; END;
      XLDISTR: BEGIN GENOPR(XLDISTR); GENSTR; NEXT; END;
      XJMPNEQ: BEGIN NEXT; I := GMPL^.M.SIZ; GENEXP; GENOPR2(XJMPNEQ, I); END
      ELSE GENVAR;
    END;
  LOOP:
    CASE GMPL^.A.O OF
      XLDACHR, XLDAINT: BEGIN GENIDX(GMPL^.A.O = XLDAINT); GOTO LOOP; END;
      XFUNBEG: BEGIN
        NEXT; GENOPR(XPSHACC); I := 1;
        IF GMPL^.A.O <> XFUNEND THEN REPEAT
          GENEXP; GENOPR(XPSHACC); I := I + 1;
        UNTIL NOT ISOPR(XFUNJMP);
        GENLDI(I); GENOPR(XFUNJMP);
        IF ISOK(ISOPR(XFUNEND), ESYNTAX) THEN GOTO LOOP;
      END;
    END;
    IF SGN < 0 THEN GENOPR(XLDANEG);
  END;

  PROCEDURE GENGRP(GRP: TGRP); VAR OPR: TOPR;
  BEGIN
    IF GRP = ISASN THEN GENASN(TRUE)
    ELSE BEGIN
      GENGRP(PRED(GRP));
      WHILE ISGRP(GRP, OPR) DO BEGIN
        GENOPR(XPSHACC); GENGRP(PRED(GRP)); GENOPR(OPR);
      END;
    END;
  END;

  PROCEDURE GENEXP; VAR PCEXP, PCJMPNOW, PCJMPEQU: INTEGER;
  BEGIN
    PCEXP := GMPL^.M.SIZ;
    IF GMPL^.A.O <> XPSHACC THEN GENGRP(ISLOG)
    ELSE BEGIN
      NEXT; REPEAT GENEXP; UNTIL NOT ISOPR(XJMPNOW);
      IF NOT ISOK(ISOPR(XGETACC), ESYNTAX) THEN EXIT;
    END;
    CASE GMPL^.A.O OF
      XJMPNEQ: BEGIN
        NEXT; PCJMPEQU := GMPL^.M.SIZ;
        GENOPR2(XJMPEQU, 0); GENEXP; GENOPR2(XJMPNOW, PCEXP);
        GENATOPR2(PCJMPEQU, XJMPEQU, GMPL^.M.SIZ);
      END;
      XJMPEQU: BEGIN
        NEXT; PCJMPEQU := GMPL^.M.SIZ; GENOPR2(XJMPEQU, 0); GENEXP;
        IF GMPL^.A.O <> XFUNJMP THEN GENATOPR2(PCJMPEQU, XJMPEQU, GMPL^.M.SIZ)
        ELSE BEGIN
          NEXT; PCJMPNOW := GMPL^.M.SIZ;
          GENOPR2(XJMPNOW, 0); GENATOPR2(PCJMPEQU, XJMPEQU, GMPL^.M.SIZ);
          GENEXP; GENATOPR2(PCJMPNOW, XJMPNOW, GMPL^.M.SIZ);
        END;
      END;
    END;
  END;

  PROCEDURE GENDEF; VAR CNT, I: INTEGER; SYM: TSYM;
  BEGIN
    WHILE GMPL^.A.O <> XFINISH DO IF GMPL^.A.O = XSUMADD THEN BEGIN
        NEXT; GENINC; NEXT;
      END ELSE BEGIN
        IF ODD(GMPL^.M.SIZ) THEN GMPL^.M.SIZ := GMPL^.M.SIZ + 1;
        WITH GMPL^.S.T[SYMINC] DO BEGIN
          WRITELN(GMPL^.M.SIZ: 5, ': ', GMPL^.A.S);
          NEXT;
          IF I16 <> 0 THEN IF ISOK(ISOPR(XLEAINT), EDUPLICATE) THEN
            GMPL^.M.INT[I16 SHR 1].I16 := GMPL^.M.SIZ;
          CASE GMPL^.A.O OF
            XBITIOR: BEGIN NEXT; I16 := GETINT; END;
            X2ASSET: BEGIN
              NEXT; IF I16 = 0 THEN I16 := GMPL^.M.SIZ;
              REPEAT
                IF GMPL^.A.O = XLDISTR THEN BEGIN GENSTR; NEXT; END
                ELSE IF ISOPR(XLDACHR) THEN GMPL^.M.SIZ := GMPL^.M.SIZ + GETINT
                ELSE IF ISOPR(XLDAINT) THEN GMPL^.M.SIZ := GMPL^.M.SIZ + GETINT * 2
                ELSE GEN2(GETINT);
              UNTIL NOT ISOPR(XFUNJMP);
            END;
            XFUNBEG: BEGIN
              NEXT; IF I16 = 0 THEN BEGIN I16 := GMPL^.M.SIZ; GEN2(I16 + 2); END;
              SYM := GMPL^.S.S; CNT := GMPL^.S.N; I := 1;
              IF GMPL^.A.O <> XFUNEND THEN REPEAT
                REPEAT
                  IF GMPL^.A.O <> XJMPNOW THEN WITH GMPL^.S.T[SYMINC] DO BEGIN
                    NEXT;
                    IF ISOK(I16 = 0, EDUPLICATE) THEN BEGIN
                      I16 := -I;
                      IF ISOPR(XLDAINT) THEN I := I + GETINT
                      ELSE IF ISOPR(XLDACHR) THEN I := I + GETINT DIV 2
                      ELSE I := I + 1;
                    END;
                  END;
                UNTIL NOT ISOPR(XFUNJMP);
              UNTIL NOT ISOPR(XJMPNOW);
              IF ISOK(ISOPR(XFUNEND), ESYNTAX) THEN BEGIN
                GENOPR1(XFUNBEG, I); GENEXP; GENOPR(XFUNEND);
              END;
              FOR I := CNT + 1 TO GMPL^.S.N DO GMPL^.S.T[I].I16 := 0;
              GMPL^.S.S := SYM; GMPL^.S.N := CNT;
            END;
          END;
        END;
      END;
  END;

BEGIN
  GMPL^.A.O := XLDANEG;
  WITH GMPL^.S.T[SYMINC] DO IF I16 = 0 THEN BEGIN
    WRITELN('INCLUDE: ', GMPL^.A.S);
    I16 := 1; GMPL^.A.S := INCDIR + GMPL^.A.S + '.MPL';
    IF FRESET(TXT, GMPL^.A.S) <> 0 THEN BEGIN
      DELETE(GMPL^.A.S, 1, LENGTH(INCDIR));
      IF NOT ISOK(FRESET(TXT, GMPL^.A.S) = 0, EUNKNOWN) THEN EXIT;
    END;
    CUR := CHR(32); GENLIB; NEXT; GENDEF;
    CLOSE(TXT); (* BUG: MUST REMOVE FOR AMIGA HSPASCAL (?) *)
  END;
END;

PROCEDURE GENMPL;
BEGIN
  GMPL^.S.S.A := ADDR(GMPL^.M.BYT[MPLMEM]);
  GMPL^.M.SIZ := 4;
  GMPL^.A.O := XLDANEG;
  GENINC;
  IF GMPL^.E = 0 THEN BEGIN
    GMPL^.A.S := '.'; GMPL^.A.O := XLDANEG;
    WITH GMPL^.S.T[SYMGET] DO IF ISOK(I16 <> 0, EUNKNOWN) THEN BEGIN
      GMPL^.M.ENT := GMPL^.M.SIZ;
      GENOPR2(X2ADGET, I16); GENOPR(XPSHACC); GENLDI(1);
      GENOPR(XFUNJMP); GENOPR(XFINISH);
    END;
  END;
END;

PROCEDURE START; VAR BIN: FILE;
BEGIN
  IF PARAMCOUNT < 1 THEN WRITELN('USAGE: MPL <FILE>')
  ELSE BEGIN
    NEW(GMPL); FILLCHAR(GMPL^, SIZEOF(GMPL^), 0);
    GMPL^.A.S := PARAMSTR(1);
    WRITELN; WRITELN('COMPILING'); WRITELN;
    GENMPL;
    WRITELN;
    WRITELN(GMPL^.E: 5, ' ERRORS');
    WRITELN(GMPL^.S.N: 5, ' SYMBOLS');
    WRITELN(GMPL^.M.SIZ: 5, ' BYTES');
    WRITELN;
    IF GMPL^.E = 0 THEN BEGIN
      ASSIGN(BIN, PARAMSTR(1) + '.MPX');
      REWRITE(BIN);
      IF IORESULT = 0 THEN BEGIN
        BLOCKWRITE(BIN, GMPL^.M.BYT, {$IFDEF HPC}GMPL^.M.SIZ{$ELSE}
          (GMPL^.M.SIZ + 127) DIV 128{$ENDIF});
        CLOSE(BIN);
        WRITE(CHR(13), 'COMPLETE'); CLREOL; WRITELN;
      END;
    END;
  END;
END;

BEGIN
  START;
  {$IFDEF FPC}READLN;{$ENDIF}
END.