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

[r263]: / mplscan.pas  Maximize  Restore  History

Download this file

45 lines (39 with data), 2.5 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
(* MPL - MICRO PROGRAMMING LANGUAGE / COPYRIGHT (C) 2017-2018 DEREK JOHN EVANS *)



FUNCTION METC:CHAR; BEGIN IF GC='*' THEN BEGIN RDCH; 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; RDCH END;



PROCEDURE NEXT; LABEL 0; BEGIN

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

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

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

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

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

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

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

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

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

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

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

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

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

        '/':BEGIN READLN(GT^,GS); RDCH; GOTO 0 END ELSE KO1(K3,ODIV2)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(K1,ODREF);'=':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;