[go: up one dir, main page]
Menu ▾ ▴

[r256]: / mplscan.pas  Maximize  Restore  History

Download this file

47 lines (40 with data), 2.7 kB 

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
(* MPL - MICRO PROGRAMMING LANGUAGE / COPYRIGHT (C) 2017-2018 DEREK JOHN EVANS *)



PROCEDURE GETC; BEGIN IF EOF(GF^) THEN GC := CHR(0)

  ELSE BEGIN READ(GF^, GC); IF IORESULT <> 0 THEN GC := CHR(0) END END;



FUNCTION METC: CHAR; BEGIN IF GC = '*' THEN BEGIN GETC; CASE UPCASE(GC) OF

  '0':GC:=CHR(00);'A':GC:=CHR(07);'B':GC:=CHR(08);'T':GC:=CHR(09);

  'N':GC:=CHR(10);'V':GC:=CHR(11);'P':GC:=CHR(12);'F':GC:=CHR(12);

  'R':GC:=CHR(13);'C':GC:=CHR(13);'S':GC:=CHR(32) END END; METC := GC END;



PROCEDURE KO1(K: KIND; O: OPER); BEGIN GK := K; GO := O END;

PROCEDURE KO2(K: KIND; O: OPER); BEGIN GK := K; GO := O; GETC END;



PROCEDURE NEXT; LABEL 0; BEGIN

0:KO1(K1, OSTOP);WHILE GC IN [CHR(1)..CHR(32)] DO GETC;

  GC := UPCASE(GC); GS := GC;  IF GC IN ['.', 'A'..'Z'] THEN BEGIN

    GETC; GC := UPCASE(GC); WHILE GC IN ['.', 'A'..'Z', '0'..'9'] DO

    BEGIN GS := GS + GC; GETC; GC := UPCASE(GC) END; GO := OLIM1 END

  ELSE IF GC IN ['0'..'9'] THEN BEGIN GV := ORD(GC) - ORD('0'); GETC;

    WHILE GC IN ['0'..'9'] DO BEGIN GV := GV * 10 + ORD(GC) - ORD('0');

      GS := GS + GC; GETC END; GO := OLIM2 END ELSE BEGIN GETC; CASE GS[1] OF

    '''':BEGIN GV := ORD(METC); GETC; IF GC = '''' THEN KO2(K1, OLIM2) END;

    '"':BEGIN GS[0] := CHR(0); WHILE NOT (GC IN [CHR(0), '"']) DO BEGIN

          GS := GS + METC; GETC END; IF GC = '"' THEN KO2(K1, OLIM3) END;

    '(':GO:=OSET1;')':GO:=OSET2;'[':GO:=OINIT;']':GO:=ODONE;

    ';':GO:=OSTOP;',':GO:=OMORE;'%':GO:=OLD11;'!':GO:=OLD12;

    '?':GO:=OIFEQ;'@':GO:=OLOOP;'$':GO:=OLEA1;

    ':':CASE GC OF':':KO2(K1,OLD22)ELSE KO1(K1,OIFNE)END;

    '=':CASE GC OF'=':KO2(K6,OTEQ2)ELSE KO1(K2,OSET4)END;

    '*':CASE GC OF'=':KO2(K2,OMUL4)ELSE KO1(K3,OMUL2)END;

    '\':CASE GC OF'=':KO2(K2,OMOD4)ELSE KO1(K3,OMOD2)END;

    '/':CASE GC OF'=':KO2(K2,ODIV4);

        '*': BEGIN GETC; REPEAT WHILE NOT (GC IN [CHR(0), '*']) DO GETC;

        GETC UNTIL GC IN [CHR(0), '/']; GETC; GOTO 0 END;

        '/': BEGIN READLN(GF^, GS); GETC; GOTO 0 END ELSE KO1(K3,ODIV2)END;

    '#':CASE GC OF'#':KO2(K1,OGRAB);'=':KO2(K2,OEQV4)ELSE KO1(K7,OEQV2)END;

    '&':CASE GC OF'&':KO2(K8,OTAN2);'=':KO2(K2,OAND4)ELSE KO1(K7,OAND2)END;

    '+':CASE GC OF'+':KO2(K1,OAD2A);'=':KO2(K2,OADD4)ELSE KO1(K4,OADD2)END;

    '-':CASE GC OF'-':KO2(K1,OSU2A);'=':KO2(K2,OSUB4)ELSE KO1(K4,OSUB2)END;

    '|':CASE GC OF'|':KO2(K8,OTOR2);'=':KO2(K2,OIOR4)ELSE KO1(K7,OIOR2)END;

    '^':CASE GC OF'^':KO2(K8,OTXO2);'=':KO2(K2,OXOR4)ELSE KO1(K7,OXOR2)END;

    '>':CASE GC OF'>':KO2(K5,OASR2);'=':KO2(K6,OTGE2)ELSE KO1(K6,OTGT2)END;

    '<':CASE GC OF'<':KO2(K5,OASL2);'=':KO2(K6,OTLE2);'>':KO2(K6,OTNE2)ELSE KO1(K6,OTLT2)END

END END END;