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}

CONST INCDIR = {$IFDEF HPC}'M:\MPL\'{$ELSE}''{$ENDIF};

TYPE

  TERR = (ESYNTAX, EDUPLICATE, EUNKNOWN);
  TGRP = (ISNUL, ISASN, ISDMM, ISSUM, ISSHF, ISCMP, ISEQU, ISBIT, ISLOG, ISFUN);

  TGLOBAL = PACKED RECORD
    M: TPRG; E: INTEGER;
    A: PACKED RECORD STR: STR127; OPR: TOPR; GRP: TGRP; VAL: INTEGER END;
    S: PACKED RECORD TOP: TSYM; CNT: INTEGER; TAB: PACKED ARRAY[BYTE] OF VINTEGER END;
  END;

VAR G: ^TGLOBAL;

FUNCTION ISOK(OK: BOOLEAN; ERR: TERR): BOOLEAN; BEGIN
  IF NOT OK THEN BEGIN
    G^.E := G^.E + 1; WRITE('"', G^.A.STR, '" -> ');
    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(G^.A.OPR = XLDANEG, ESYNTAX) THEN BEGIN
    OUT := G^.S.CNT; SYM := G^.S.TOP;
    WHILE LENGTH(SYM.S^) <> 0 DO BEGIN
      IF SYM.S^ = G^.A.STR 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
    G^.S.TOP.I := G^.S.TOP.I - LENGTH(G^.A.STR) - 1;
    G^.S.TOP.S^ := G^.A.STR; G^.S.CNT := G^.S.CNT + 1;
    SYMINC := G^.S.CNT;
  END;
END;

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

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

PROCEDURE GENOPR(OPR: TOPR); BEGIN
  G^.M.BYT[G^.M.SIZ].V := ORD(OPR); G^.M.SIZ := G^.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 = SEX(VAL) THEN GENOPR1(OP1, VAL) ELSE GENOPR2(OP2, VAL);
END;

PROCEDURE GENATOPR2(PC: INTEGER; OPR: TOPR; VAL: INTEGER);
VAR TMP: INTEGER; BEGIN
  TMP := G^.M.SIZ; G^.M.SIZ := PC; GENOPR2(OPR, VAL); G^.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 GENLEA(ADR: INTEGER); BEGIN
  IF ADR >= 0 THEN GENLDI(ADR) ELSE GENOPR12(XLEACHR, XLEAINT, -ADR);
END;

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

PROCEDURE GENLIB;
  PROCEDURE CST(STR: STR127; VAL: INTEGER); BEGIN
    G^.A.STR := '.' + STR; G^.A.OPR := XLDANEG; G^.S.TAB[SYMINC].V := VAL;
  END;
  PROCEDURE CMD(STR: STR127; CMD: TCMD); BEGIN CST(STR, -ORD(CMD)); END;
BEGIN
  IF G^.S.CNT < 5 THEN BEGIN
    CMD('ABS', CIABS);        CMD('MIN', CIMIN);
    CMD('MAX', CIMAX);        CMD('SQR', CISQR);
    CMD('ARGC', CARGC);       CMD('ARGV', CARGV);
    CMD('CLOSE', CCLOSE);     CMD('CGETC', CCGETC);
    CMD('RESET', CRESET);     CMD('REWRITE', CREWRITE);
    CMD('CLRSCR', CCLRSCR);   CMD('CLREOL', CCLREOL);
    CMD('CPUTC', CCPUTC);     CMD('STRINGDELETE', CSTRINGDELETE);
    CMD('FGETC', CFGETC);     CMD('FPUTC', CFPUTC);
    CMD('FILL', CFILL);       CMD('KEYPRESSED', CKEYPRESSED);
    CMD('MOVE', CMOVE);       CMD('READKEY', CREADKEY);
    CMD('GOTOXY', CGOTOXY);   CMD('STRINGINSERT', CSTRINGINSERT);
    CMD('INSLINE', CINSLINE); CMD('STRINGCOPY', CSTRINGCOPY);
    CMD('DELLINE', CDELLINE); CMD('STRINGPOS', CSTRINGPOS);
    CST('FALSE', 0);          CST('TRUE', 1);
    CST('INT', 2);            CST('REAL', 6);
    CST('LONG', 4);           CST('NULL', 0);
    CST('NEXT', 0);           CST('PREV', 1);
    CST('STRING', 128);
  END;
END;

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

  PROCEDURE GETCHR; BEGIN 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 NEXT; LABEL LOOP;
    PROCEDURE G1(GRP: TGRP; OPR: TOPR); BEGIN G^.A.GRP := GRP; G^.A.OPR := OPR; END;
    PROCEDURE G2(GRP: TGRP; OPR: TOPR); BEGIN G^.A.GRP := GRP; G^.A.OPR := OPR; GETCHR; END;
  BEGIN
    LOOP: WHILE CUR IN [CHR(1)..CHR(32)] DO GETCHR;
    G^.A.STR := UPCASE(CUR); GETCHR; G1(ISNUL, XFINISH);
    CASE G^.A.STR[1] OF
      '.', 'A'..'Z': BEGIN
        CUR := UPCASE(CUR);
        WHILE CUR IN ['.', 'A'..'Z', '0'..'9'] DO BEGIN
          G^.A.STR := G^.A.STR + CUR; GETCHR; CUR := UPCASE(CUR);
        END;
        G^.A.OPR := XLDANEG;
      END;
      '0'..'9': BEGIN
        G^.A.VAL := ORD(G^.A.STR[1]) - ORD('0');
        WHILE CUR IN ['0'..'9'] DO BEGIN
          G^.A.VAL := G^.A.VAL * 10 + ORD(CUR) - ORD('0'); GETCHR;
        END;
        G^.A.OPR := XLDIINT;
      END;
      '''': BEGIN
        G^.A.VAL := ORD(GETMETA); GETCHR;
        IF CUR = '''' THEN BEGIN GETCHR; G^.A.OPR := XLDIINT; END;
      END;
      '"': BEGIN
        G^.A.STR[0] := CHR(0);
        WHILE NOT (CUR IN [CHR(0), '"']) DO BEGIN
          G^.A.STR := G^.A.STR + GETMETA; GETCHR;
        END;
        IF CUR = '"' THEN BEGIN G^.A.OPR := XLDISTR; GETCHR; END;
      END;
      '/': 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;
        '=': G2(ISASN, X2ASDIV);
        ELSE G1(ISDMM, XDMMDIV);
      END;
      '?': G^.A.OPR := XJMPEQU; '@': G^.A.OPR := XJMPNEQ;
      ';': G^.A.OPR := XJMPNOW; '$': G^.A.OPR := XLEAINT;
      '(': G^.A.OPR := XFUNBEG; ')': G^.A.OPR := XFUNEND;
      '[': G^.A.OPR := XPSHACC; ']': G^.A.OPR := XGETACC;
      '%': G^.A.OPR := XLDABYT;
      ',': G^.A.OPR := XFUNJMP; '#': G1(ISDMM, XDMMMOD);
      '!': IF CUR = '=' THEN G2(ISEQU, XEQUNOT) ELSE G^.A.OPR := XLDAINT;
      '^': IF CUR = '=' THEN G2(ISASN, X2ASXOR) ELSE G1(ISBIT, XBITXOR);
      '*': IF CUR = '=' THEN G2(ISASN, X2ASMUL) ELSE G1(ISDMM, XDMMMUL);
      '=': CASE CUR OF '=': G2(ISEQU, XEQUYES); '>': G2(ISFUN, XFUNMAX);
        '<': G2(ISFUN, XFUNMIN); ELSE G1(ISASN, X2ASSET); END;
      '+': CASE CUR OF '+': G2(ISNUL, X2ADINC); '=': G2(ISASN, X2ASADD);
        ELSE G1(ISSUM, XSUMADD); END;
      '-': CASE CUR OF '-': G2(ISNUL, X2ADDEC); '=': G2(ISASN, X2ASSUB);
        ELSE G1(ISSUM, XSUMSUB); END;
      '<': CASE CUR OF '<': G2(ISSHF, XSHFSHL); '>': G2(ISEQU, XEQUNOT);
        '=': G2(ISCMP, XCMPLTE); ELSE G1(ISCMP, XCMPLTH); END;
      '>': CASE CUR OF '>': G2(ISSHF, XSHFSHR); '=': G2(ISCMP, XCMPGTE);
        ELSE G1(ISCMP, XCMPGTH); END;
      ':': CASE CUR OF ':': G2(ISLOG, XLOGIOR); '=': G2(ISASN, X2ASIOR);
        ELSE G1(ISBIT, XBITIOR); END;
      '&': CASE CUR OF '&': G2(ISLOG, XLOGAND); '=': G2(ISASN, X2ASAND);
        ELSE G1(ISBIT, XBITAND); END;
    END;
  END;

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

  FUNCTION ISGRP(GRP: TGRP; VAR OPR: TOPR): BOOLEAN; BEGIN
    OPR := G^.A.OPR;
    IF G^.A.GRP <> 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 G^.A.OPR = XLDIINT THEN BEGIN
      OUT := G^.A.VAL; NEXT;
    END ELSE WITH G^.S.TAB[SYMINC] DO BEGIN
      if G^.A.STR[1] = '.' THEN BEGIN NEXT; OUT := V; END
      ELSE BEGIN
        NEXT; IF ISOPR(XLEAINT) THEN OUT := V
        ELSE OUT := G^.M.INT[V SHR 1].V;
      END;
    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 := G^.A.OPR; IF OPR IN [X2ADINC, X2ADDEC] THEN NEXT;
      WITH G^.S.TAB[SYMINC] DO IF ISOK(V <> 0, EUNKNOWN) THEN BEGIN
        IF G^.A.STR[1] = '.' THEN BEGIN
          GENLDI(V); NEXT; (* TODO: ERROR IF ++/-- IE: X2ADINC OR X2ADDEC *)
        END ELSE BEGIN
          GENLEA(V); NEXT;
          IF OPR IN [X2ADINC, X2ADDEC] THEN GENOPR(OPR)
          ELSE IF CANASN AND (G^.A.GRP = ISASN) THEN BEGIN
            OPR := G^.A.OPR; NEXT; GENOPR(XPSHACC); GENEXP; GENOPR(OPR);
          END ELSE CASE G^.A.OPR OF
            X2ADINC: BEGIN GENOPR(X2ADINP); NEXT; END;
            X2ADDEC: BEGIN GENOPR(X2ADDEP); NEXT; END;
            XLEAINT: NEXT; ELSE GENOPR(X2ADGET);
          END;
        END;
      END;
    END;

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

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

  VAR I, SGN: INTEGER; LABEL LOOP;
  BEGIN
    SGN := GETSGN;
    CASE G^.A.OPR OF
      XLDABYT, XLDAINT: GENADR(G^.A.OPR = 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(G^.A.VAL * SGN); SGN := 1; NEXT; END;
      XLDISTR: BEGIN GENOPR(XLDISTR); GENSTR; NEXT; END;
      XJMPNEQ: BEGIN NEXT; I := G^.M.SIZ; GENEXP; GENOPR2(XJMPNEQ, I);
      END ELSE GENVAR;
    END;
  LOOP:
    CASE G^.A.OPR OF
      XLDABYT, XLDAINT: BEGIN GENIDX(G^.A.OPR = XLDAINT); GOTO LOOP; END;
      XFUNBEG: BEGIN
        NEXT; GENOPR(XPSHACC); I := 1;
        IF G^.A.OPR <> 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 := G^.M.SIZ;
    IF G^.A.OPR <> XPSHACC THEN GENGRP(ISFUN)
    ELSE BEGIN
      NEXT; REPEAT GENEXP; UNTIL NOT ISOPR(XJMPNOW);
      IF NOT ISOK(ISOPR(XGETACC), ESYNTAX) THEN EXIT;
    END;
    CASE G^.A.OPR OF
      XJMPNEQ: BEGIN
        NEXT; PCJMPEQU := G^.M.SIZ;
        GENOPR2(XJMPEQU, 0); GENEXP; GENOPR2(XJMPNOW, PCEXP);
        GENATOPR2(PCJMPEQU, XJMPEQU, G^.M.SIZ);
      END;
      XJMPEQU: BEGIN
        NEXT; PCJMPEQU := G^.M.SIZ; GENOPR2(XJMPEQU, 0); GENEXP;
        IF G^.A.OPR <> XFUNJMP THEN GENATOPR2(PCJMPEQU, XJMPEQU, G^.M.SIZ)
        ELSE BEGIN
          NEXT; PCJMPNOW := G^.M.SIZ;
          GENOPR2(XJMPNOW, 0); GENATOPR2(PCJMPEQU, XJMPEQU, G^.M.SIZ);
          GENEXP; GENATOPR2(PCJMPNOW, XJMPNOW, G^.M.SIZ);
        END;
      END;
    END;
  END;

  PROCEDURE GENDEF; VAR CNT, I: INTEGER; SYM: TSYM; BEGIN
    WHILE G^.A.OPR <> XFINISH DO IF G^.A.OPR = XSUMADD THEN BEGIN
      NEXT; GENINC; NEXT;
    END ELSE BEGIN
      IF ODD(G^.M.SIZ) THEN G^.M.SIZ := G^.M.SIZ + 1;
      WITH G^.S.TAB[SYMINC] DO BEGIN
        WRITELN(G^.M.SIZ: 5, ': ', G^.A.STR);
        NEXT;
        IF V <> 0 THEN IF ISOK(ISOPR(XLEAINT), EDUPLICATE) THEN
          G^.M.INT[V SHR 1].V := G^.M.SIZ;
        CASE G^.A.OPR OF
          XBITIOR: BEGIN NEXT; V := GETINT; END;
          X2ASSET: BEGIN
            NEXT; IF V = 0 THEN V := G^.M.SIZ;
            REPEAT
              IF G^.A.OPR = XLDISTR THEN BEGIN GENSTR; NEXT; END
              ELSE IF ISOPR(XLDABYT) THEN G^.M.SIZ := G^.M.SIZ + GETINT
              ELSE IF ISOPR(XLDAINT) THEN G^.M.SIZ := G^.M.SIZ + GETINT * 2
              ELSE GEN2(GETINT);
            UNTIL NOT ISOPR(XFUNJMP);
          END;
          XFUNBEG: BEGIN
            NEXT; IF V = 0 THEN BEGIN V := G^.M.SIZ; GEN2(V + 2); END;
            SYM := G^.S.TOP; CNT := G^.S.CNT; I := 1;
            IF G^.A.OPR <> XFUNEND THEN REPEAT
              REPEAT
                IF G^.A.OPR <> XJMPNOW THEN WITH G^.S.TAB[SYMINC] DO BEGIN
                  IF ISOK(G^.A.STR[1] <> '.', ESYNTAX) THEN BEGIN
                    NEXT;
                    IF ISOK(V = 0, EDUPLICATE) THEN BEGIN
                      V := -I;
                      IF ISOPR(XLDAINT) THEN I := I + GETINT
                      ELSE IF ISOPR(XLDABYT) THEN I := I + GETINT DIV 2
                      ELSE I := I + 1;
                    END;
                  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 G^.S.CNT DO G^.S.TAB[I].V := 0;
            G^.S.TOP := SYM; G^.S.CNT := CNT;
          END;
        END;
      END;
    END;
  END;

BEGIN
  G^.A.OPR := XLDANEG;
  WITH G^.S.TAB[SYMINC] DO IF V = 0 THEN BEGIN
    WRITELN('+FILE: ', G^.A.STR);
    V := 1; G^.A.STR := INCDIR + G^.A.STR + '.MPL';
    IF FRESET(TXT, G^.A.STR) <> 0 THEN BEGIN
      STRINGDELETE(G^.A.STR, 1, LENGTH(INCDIR));
      IF NOT ISOK(FRESET(TXT, G^.A.STR) = 0, EUNKNOWN) THEN EXIT;
    END;
    GENLIB; GETCHR; NEXT; GENDEF; CLOSE(TXT); (* BUG: MUST REMOVE CLOSE() FOR AMIGA HSPASCAL (?) *)
  END;
END;

PROCEDURE GENMPL; BEGIN
  G^.S.TOP.A := ADDR(G^.M.BYT[MPLMEM]);
  G^.M.SIZ := 4;
  G^.A.OPR := XLDANEG;
  GENINC;
  IF G^.E = 0 THEN BEGIN
    G^.A.STR := 'MAIN'; G^.A.OPR := XLDANEG;
    WITH G^.S.TAB[SYMGET] DO IF ISOK(V <> 0, EUNKNOWN) THEN BEGIN
      G^.M.ENT := G^.M.SIZ;
      GENLEA(V);
      GENOPR(X2ADGET); GENOPR(XPSHACC); GENLDI(1);
      GENOPR(XFUNJMP); GENOPR(XFINISH);
    END;
  END;
END;

PROCEDURE START; VAR BIN: FILE; BEGIN
  IF ARGC < 1 THEN WRITELN('USAGE: MPL <FILE>')
  ELSE BEGIN
    NEW(G); FILLCHAR(G^, SIZEOF(G^), 0); ARGV(G^.A.STR, 1);
    WRITELN; WRITELN('COMPILING');
    WRITELN; GENMPL; WRITELN;
    WRITELN(G^.E: 5, ' ERRORS');
    WRITELN(G^.S.CNT: 5, ' SYMBOLS');
    WRITELN(G^.M.SIZ: 5, ' BYTES');
    WRITELN;
    IF G^.E = 0 THEN BEGIN
      ARGV(G^.A.STR, 1); ASSIGN(BIN, G^.A.STR + '.MPX'); REWRITE(BIN);
      IF IORESULT = 0 THEN BEGIN
        BLOCKWRITE(BIN, G^.M.BYT, {$IFDEF HPC}G^.M.SIZ{$ELSE}
          (G^.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.