MPL Bytecode Compiler Code

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

{$IFDEF HPC}{$M 8,48,48,16}{$F+}{$ENDIF}
{$A-}{$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].V := 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].V := 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].V := 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('WHEREX', CWHEREX);
      GENCMD('WHEREY', CWHEREY);
      GENCMD('MIN', CMIN);
      GENCMD('MAX', CMAX);
      GENSYM('FALSE', 0);
      GENSYM('SIZEOF.REAL', SIZEOF(REAL));
      GENSYM('SIZEOF.INT', SIZEOF(INTEGER));
      GENSYM('NULL', 0);
      GENSYM('TRUE', 1);
    END;
  END;

  PROCEDURE GENINC;
  VAR
    F: PACKED RECORD
      TEX: TEXT;
      CHR: CHAR;
    END;

    PROCEDURE GETCHR;
    BEGIN
      F.CHR := FGETC(F.TEX);
    END;

    FUNCTION GETMETA: CHAR;
    BEGIN
      IF F.CHR = '*' THEN BEGIN
        GETCHR;
        CASE UPCASE(F.CHR) OF
          '0': F.CHR := CHR(0);
          'B': F.CHR := CHR(8);
          'T': F.CHR := CHR(9);
          'N': F.CHR := CHR(10);
          'P': F.CHR := CHR(12);
          'C': F.CHR := CHR(13);
          'S': F.CHR := CHR(32);
        END;
      END;
      GETMETA := F.CHR;
    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 F.CHR IN [CHR(1)..CHR(32)] DO GETCHR;
      GMPL^.A.S := UPCASE(F.CHR);
      GETCHR;
      GO1(ISBRK, XFINISH);
      CASE GMPL^.A.S[1] OF
        '.', 'A'..'Z': BEGIN
          F.CHR := UPCASE(F.CHR);
          WHILE F.CHR IN ['.', 'A'..'Z', '0'..'9'] DO BEGIN
            GMPL^.A.S := GMPL^.A.S + F.CHR;
            GETCHR;
            F.CHR := UPCASE(F.CHR);
          END;
          GMPL^.A.O := XLDANEG;
        END;
        '0'..'9': BEGIN
          GMPL^.A.V := ORD(GMPL^.A.S[1]) - ORD('0');
          WHILE F.CHR IN ['0'..'9'] DO BEGIN
            GMPL^.A.V := GMPL^.A.V * 10 + ORD(F.CHR) - ORD('0');
            GETCHR;
          END;
          GMPL^.A.O := XLDIINT;
        END;
        '"': BEGIN
          GMPL^.A.S[0] := CHR(0);
          WHILE NOT (F.CHR IN [CHR(0), '"']) DO BEGIN
            GMPL^.A.S := GMPL^.A.S + GETMETA;
            GETCHR;
          END;
          IF F.CHR = '"' THEN BEGIN
            GMPL^.A.O := XLDISTR;
            GETCHR;
          END;
        END;
        '''': BEGIN
          GMPL^.A.V := ORD(GETMETA);
          GETCHR;
          IF F.CHR = '''' 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 F.CHR OF
            '/': BEGIN
              WHILE NOT (F.CHR IN [CHR(0), CHR(10)]) DO GETCHR;
              GOTO LOOP;
            END;
            '*': BEGIN
              GETCHR;
              REPEAT
                WHILE NOT (F.CHR IN [CHR(0), '*']) DO GETCHR;
                GETCHR;
              UNTIL F.CHR IN [CHR(0), '/'];
              GETCHR;
              GOTO LOOP;
            END;
            '=': GO2(ISASN, X2ASDIV);
            ELSE GO1(ISDMM, XDMMDIV);
          END;
        '^': CASE F.CHR OF
            '=': GO2(ISASN, X2ASXOR);
            ELSE GO1(ISBIT, XBITXOR);
          END;
        '=': CASE F.CHR OF
            '=': GO2(ISEQU, XEQUYES);
            ELSE GO1(ISASN, X2ASSET);
          END;
        '+': CASE F.CHR OF
            '+': GO2(ISBRK, X2ADINC);
            '=': GO2(ISASN, X2ASADD);
            ELSE GO1(ISSUM, XSUMADD);
          END;
        '-': CASE F.CHR OF
            '-': GO2(ISBRK, X2ADDEC);
            '=': GO2(ISASN, X2ASSUB);
            ELSE GO1(ISSUM, XSUMSUB);
          END;
        '*': CASE F.CHR OF
            '=': GO2(ISASN, X2ASMUL);
            ELSE GO1(ISDMM, XDMMMUL);
          END;
        '<': CASE F.CHR OF
            '<': GO2(ISSHF, XSHFSHL);
            '>': GO2(ISEQU, XEQUNOT);
            '=': GO2(ISCMP, XCMPLTE);
            ELSE GO1(ISCMP, XCMPLTH);
          END;
        '>': CASE F.CHR OF
            '>': GO2(ISSHF, XSHFSHR);
            '=': GO2(ISCMP, XCMPGTE);
            ELSE GO1(ISCMP, XCMPGTH);
          END;
        ':': CASE F.CHR OF
            ':': GO2(ISLOG, XLOGIOR);
            '=': GO2(ISASN, X2ASIOR);
            ELSE GO1(ISBIT, XBITIOR);
          END;
        '&': CASE F.CHR 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 := V;
            NEXT;
          END ELSE
            OUT := GMPL^.M.INT[V SHR 1].V;
        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(V <> 0, EUNKNOWN) THEN CASE OPR OF
              X2ADINC: GENOPR12(X1ADINC, X2ADINC, V);
              X2ADDEC: GENOPR12(X1ADDEC, X2ADDEC, V);
              ELSE IF CANASN AND (GMPL^.A.G = ISASN) THEN BEGIN
                  OPR := GMPL^.A.O;
                  NEXT;
                  GENOPR12(XPSHCHR, XPSHINT, V);
                  GENEXP;
                  GENOPR(OPR);
                END ELSE
                  CASE GMPL^.A.O OF
                    XLEAINT: BEGIN
                      GENOPR12(XLEACHR, XLEAINT, V);
                      NEXT;
                    END;
                    X2ADINC: BEGIN
                      GENOPR12(X1ADINP, X2ADINP, V);
                      NEXT;
                    END;
                    X2ADDEC: BEGIN
                      GENOPR12(X1ADDEP, X2ADDEP, V);
                      NEXT;
                    END ELSE GENOPR12(X1ADGET, X2ADGET, V);
                  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;

    LABEL
      LOOP;
    VAR
      I, SGN: INTEGER;
    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
      GENLIB;
      GETCHR;
      NEXT;
      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
            WRITE(CHR(13), GMPL^.M.SIZ: 5, ': ', GMPL^.A.S);
            CLREOL;
            NEXT;
            IF V <> 0 THEN IF ISOK(ISOPR(XLEAINT), EDUPLICATE) THEN
                GMPL^.M.INT[V SHR 1].V := GMPL^.M.SIZ;
            CASE GMPL^.A.O OF
              XBITIOR: BEGIN
                NEXT;
                V := GETINT;
              END;
              X2ASSET: BEGIN
                NEXT;
                IF V = 0 THEN V := 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 V = 0 THEN BEGIN
                  V := GMPL^.M.SIZ;
                  GEN2(V + 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(V = 0, EDUPLICATE) THEN BEGIN
                            V := -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].V := 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 V = 0 THEN BEGIN
        V := 1;
        GMPL^.A.S := INCDIR + GMPL^.A.S + '.MPL';
        IF FRESET(F.TEX, GMPL^.A.S) <> 0 THEN BEGIN
          DELETE(GMPL^.A.S, 1, LENGTH(INCDIR));
          IF NOT ISOK(FRESET(F.TEX, GMPL^.A.S) = 0, EUNKNOWN) THEN EXIT;
        END;
        GENDEF;
        CLOSE(F.TEX);
      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(V <> 0, EUNKNOWN) THEN BEGIN
          GMPL^.M.ENT := GMPL^.M.SIZ;
          GENOPR2(X2ADGET, V);
          GENOPR(XPSHACC);
          GENLDI(1);
          GENOPR(XFUNJMP);
          GENOPR(XFINISH);
        END;
    END;
  END;

  PROCEDURE START;
  VAR
    F: 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;
      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(F, PARAMSTR(1) + '.MPX');
        REWRITE(F);
        IF IORESULT = 0 THEN BEGIN
          BLOCKWRITE(F, GMPL^.M.BYT, (GMPL^.M.SIZ + 127) DIV 128);
          CLOSE(F);
          WRITE(CHR(13), 'COMPLETE');
          CLREOL;
          WRITELN;
        END;
      END;
    END;
  END;

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