Subversion Repositories Kolibri OS

(*

    BSD 2-Clause License

    Copyright (c) 2018, 2019, Anton Krotov

    All rights reserved.

*)

MODULE STATEMENTS;

IMPORT

    PARS, PROG, SCAN, ARITH, STRINGS, LISTS, IL, X86, AMD64, MSP430,

    ERRORS, UTILS, AVL := AVLTREES, CONSOLE, C := COLLECTIONS, mConst := CONSTANTS;

CONST

    eCONST   =  PARS.eCONST;   eTYPE     =  PARS.eTYPE;     eVAR      =  PARS.eVAR;

    eEXPR    =  PARS.eEXPR;    eVREC     =  PARS.eVREC;     ePROC     =  PARS.ePROC;

    eVPAR    =  PARS.eVPAR;    ePARAM    =  PARS.ePARAM;    eSTPROC   =  PARS.eSTPROC;

    eSTFUNC  =  PARS.eSTFUNC;  eSYSFUNC  =  PARS.eSYSFUNC;  eSYSPROC  =  PARS.eSYSPROC;

    eIMP     =  PARS.eIMP;

    errASSERT = 1;  errPTR  =  2;  errDIV  =  3;  errPROC =  4;

    errGUARD  = 5;  errIDX  =  6;  errCASE =  7;  errCOPY =  8;

    errCHR    = 9;  errWCHR = 10;  errBYTE = 11;

    chkIDX* = 0; chkGUARD* = 1; chkPTR* = 2; chkCHR* = 3; chkWCHR* = 4; chkBYTE* = 5;

    chkALL* = {chkIDX, chkGUARD, chkPTR, chkCHR, chkWCHR, chkBYTE};

    cpuX86 = 1; cpuAMD64 = 2; cpuMSP430 = 3;

TYPE

    isXXX = PROCEDURE (e: PARS.EXPR): BOOLEAN;

    RANGE = RECORD

        a, b: INTEGER

    END;

    CASE_LABEL = POINTER TO rCASE_LABEL;

    rCASE_LABEL = RECORD (AVL.DATA)

        range: RANGE;

        variant, self: INTEGER;

        type: PROG.TYPE_;

        prev: CASE_LABEL

    END;

    CASE_VARIANT = POINTER TO RECORD (LISTS.ITEM)

        label:     INTEGER;

        cmd:       IL.COMMAND;

        processed: BOOLEAN

    END;

VAR

    Options: PROG.OPTIONS;

    begcall, endcall: IL.COMMAND;

    CaseLabels, CaseVar: C.COLLECTION;

    CaseVariants: LISTS.LIST;

    CPU: INTEGER;

    tINTEGER, tBYTE, tCHAR, tWCHAR, tSET, tBOOLEAN, tREAL: PROG.TYPE_;

PROCEDURE isExpr (e: PARS.EXPR): BOOLEAN;

    RETURN e.obj IN {eCONST, eVAR, eEXPR, eVPAR, ePARAM, eVREC}

END isExpr;

PROCEDURE isVar (e: PARS.EXPR): BOOLEAN;

    RETURN e.obj IN {eVAR, eVPAR, ePARAM, eVREC}

END isVar;

PROCEDURE isBoolean (e: PARS.EXPR): BOOLEAN;

    RETURN isExpr(e) & (e.type = tBOOLEAN)

END isBoolean;

PROCEDURE isInteger (e: PARS.EXPR): BOOLEAN;

    RETURN isExpr(e) & (e.type = tINTEGER)

END isInteger;

PROCEDURE isByte (e: PARS.EXPR): BOOLEAN;

    RETURN isExpr(e) & (e.type = tBYTE)

END isByte;

PROCEDURE isInt (e: PARS.EXPR): BOOLEAN;

    RETURN isByte(e) OR isInteger(e)

END isInt;

PROCEDURE isReal (e: PARS.EXPR): BOOLEAN;

    RETURN isExpr(e) & (e.type = tREAL)

END isReal;

PROCEDURE isSet (e: PARS.EXPR): BOOLEAN;

    RETURN isExpr(e) & (e.type = tSET)

END isSet;

PROCEDURE isString (e: PARS.EXPR): BOOLEAN;

    RETURN (e.obj = eCONST) & (e.type.typ IN {PROG.tSTRING, PROG.tCHAR})

END isString;

PROCEDURE isStringW (e: PARS.EXPR): BOOLEAN;

    RETURN (e.obj = eCONST) & (e.type.typ IN {PROG.tSTRING, PROG.tCHAR, PROG.tWCHAR})

END isStringW;

PROCEDURE isChar (e: PARS.EXPR): BOOLEAN;

    RETURN isExpr(e) & (e.type = tCHAR)

END isChar;

PROCEDURE isCharW (e: PARS.EXPR): BOOLEAN;

    RETURN isExpr(e) & (e.type = tWCHAR)

END isCharW;

PROCEDURE isPtr (e: PARS.EXPR): BOOLEAN;

    RETURN isExpr(e) & (e.type.typ = PROG.tPOINTER)

END isPtr;

PROCEDURE isRec (e: PARS.EXPR): BOOLEAN;

    RETURN isExpr(e) & (e.type.typ = PROG.tRECORD)

END isRec;

PROCEDURE isRecPtr (e: PARS.EXPR): BOOLEAN;

    RETURN isRec(e) OR isPtr(e)

END isRecPtr;

PROCEDURE isArr (e: PARS.EXPR): BOOLEAN;

    RETURN isExpr(e) & (e.type.typ = PROG.tARRAY)

END isArr;

PROCEDURE isProc (e: PARS.EXPR): BOOLEAN;

    RETURN isExpr(e) & (e.type.typ = PROG.tPROCEDURE) OR (e.obj IN {ePROC, eIMP})

END isProc;

PROCEDURE isNil (e: PARS.EXPR): BOOLEAN;

    RETURN e.type.typ = PROG.tNIL

END isNil;

PROCEDURE isCharArray (e: PARS.EXPR): BOOLEAN;

    RETURN isArr(e) & (e.type.base = tCHAR)

END isCharArray;

PROCEDURE isCharArrayW (e: PARS.EXPR): BOOLEAN;

    RETURN isArr(e) & (e.type.base = tWCHAR)

END isCharArrayW;

PROCEDURE isCharArrayX (e: PARS.EXPR): BOOLEAN;

    RETURN isCharArray(e) OR isCharArrayW(e)

END isCharArrayX;

PROCEDURE getpos (parser: PARS.PARSER; VAR pos: PARS.POSITION);

BEGIN

    pos.line   := parser.lex.pos.line;

    pos.col    := parser.lex.pos.col;

    pos.parser := parser

END getpos;

PROCEDURE NextPos (parser: PARS.PARSER; VAR pos: PARS.POSITION);

BEGIN

    PARS.Next(parser);

    getpos(parser, pos)

END NextPos;

PROCEDURE strlen (e: PARS.EXPR): INTEGER;

VAR

    res: INTEGER;

BEGIN

    ASSERT(isString(e));

    IF e.type = tCHAR THEN

        res := 1

    ELSE

        res := LENGTH(e.value.string(SCAN.IDENT).s)

    END

    RETURN res

END strlen;

PROCEDURE _length (s: ARRAY OF CHAR): INTEGER;

VAR

    i, res: INTEGER;

BEGIN

    i := 0;

    res := 0;

    WHILE (i < LEN(s)) & (s[i] # 0X) DO

        IF (s[i] <= CHR(127)) OR (s[i] >= CHR(192)) THEN

            INC(res)

        END;

        INC(i)

    END

    RETURN res

END _length;

PROCEDURE utf8strlen (e: PAR