home *** CD-ROM | disk | FTP | other *** search
/ RISC DISC 2 / RISC_DISC_2.iso / pd_share / program / language / oberon / potsrc / src / mod / coce < prev    next >
Encoding:
Text File  |  1995-01-22  |  31.5 KB  |  962 lines
  1. MODULE COCE;  (*NW 7.6.87 / 5.3.91*) (*DT 27 12 1993 23:50*)
  2.   IMPORT SYSTEM, COCS, COCT, COCQ, COCN, COCJ, COCX;
  3.     
  4.   CONST
  5.    (*object and item modes*)  
  6.     Var = 1; Ind = 3; Con = 8; Reg = 11; Fld = 12; Typ = 13;  
  7.     
  8.    (*structure forms*)
  9.     Undef = 0; Byte = 1; Bool = 2; Char = 3; SInt = 4; Int = 5; LInt = 6;  
  10.     Real = 7; LReal = 8; Set = 9; String = 10; NilTyp = 11; NoTyp = 12;  
  11.     Pointer = 13; ProcTyp = 14; Array = 15; DynArr = 16; Record = 17;  
  12.  
  13.     intSet = {SInt .. LInt}; realSet = {Real .. LReal};
  14.     numSet = intSet + realSet;
  15.  
  16.   VAR
  17.     inxchk*, rngchk*, nilchk*: BOOLEAN;
  18.  
  19.    (*SYSTEM Dependant*)
  20.     MinChar, MaxChar,
  21.     MinBool, MaxBool,
  22.     MinSInt, MaxSInt,
  23.     MinInt, MaxInt,
  24.     MinLInt, MaxLInt,
  25.     MinSet, MaxSet: LONGINT;
  26.     MinReal, MaxReal,
  27.     MinLReal, MaxLReal: LONGREAL;
  28.  
  29.   PROCEDURE SetIntType*(VAR x: COCT.Item);
  30.     VAR v: LONGINT;  
  31.   BEGIN v := x.intval;  
  32.     IF (MinSInt <= v) & (v <= MaxSInt) THEN x.typ := COCT.sinttyp  
  33.     ELSIF (MinInt <= v) & (v <= MaxInt) THEN x.typ := COCT.inttyp  
  34.     ELSE x.typ := COCT.linttyp  
  35.     END  
  36.   END SetIntType;  
  37.     
  38.   PROCEDURE StartObj*(VAR x: COCT.Item): INTEGER;    
  39.     VAR qoffs, np: INTEGER; 
  40.   BEGIN qoffs := x.qoffs;
  41.     COCQ.Link(x); COCN.CObjName(x, x.qoffs, np); 
  42.     RETURN qoffs  
  43.   END StartObj;  
  44.  
  45.   PROCEDURE StopObj*(VAR x: COCT.Item; qoffs: INTEGER);
  46.   BEGIN IF x.mode = Ind THEN COCJ.DeRef(x); x.mode := Var END;
  47.     COCQ.Unlink(x);
  48.     x.qoffs := qoffs
  49.   END StopObj;  
  50.   
  51.   PROCEDURE StartExpr*(VAR x: COCT.Item): INTEGER;  
  52.     VAR qoffs: INTEGER;
  53.   BEGIN qoffs := x.qoffs;
  54.     COCQ.Link(x); IF x.qoffs = 0 THEN COCQ.Dummy END; 
  55.     RETURN qoffs  
  56.   END StartExpr;  
  57.  
  58.   PROCEDURE StopExpr*(VAR x: COCT.Item; qoffs: INTEGER);     
  59.     VAR np: INTEGER;
  60.   BEGIN
  61.     IF (x.mode = Con) & (x.typ # COCT.notyp) THEN COCQ.Drop(x);
  62.        COCQ.Link(x); COCJ.CConstValue(x, x.qoffs, np)
  63.     END;
  64.     COCQ.Unlink(x);
  65.     x.qoffs := qoffs  
  66.   END StopExpr;  
  67.   
  68.   PROCEDURE StopConstExpr*(VAR x: COCT.Item; qoffs: INTEGER);  
  69.   BEGIN COCQ.Drop(x); x.qoffs := qoffs  
  70.   END StopConstExpr;    
  71.   
  72.   PROCEDURE StopStringExpr*(VAR x: COCT.Item; qoffs: INTEGER; typ: COCT.Struct);    
  73.     VAR np: INTEGER;
  74.   BEGIN    
  75.     IF x.typ = COCT.stringtyp THEN
  76.       IF x.intval MOD 100H = 1 THEN COCQ.Drop(x); 
  77.         COCQ.Link(x); COCJ.CConstValue(x, x.qoffs, np)
  78.       END;  
  79.       COCJ.SetStrTD(x, typ);
  80.       COCJ.DeRef(x)
  81.     END;
  82.     COCQ.Unlink(x); x.qoffs := qoffs
  83.   END StopStringExpr;  
  84.  
  85.   PROCEDURE SubExprPrefix*;
  86.   BEGIN COCX.SubExprPrefix
  87.   END SubExprPrefix;
  88.  
  89.   PROCEDURE SubExprSuffix*;
  90.   BEGIN COCX.SubExprSuffix
  91.   END SubExprSuffix;
  92.  
  93.   PROCEDURE HookExpr*(VAR x: COCT.Item): INTEGER;  
  94.     VAR qoffs: INTEGER;
  95.   BEGIN qoffs := x.qoffs; COCQ.Link(x); RETURN qoffs  
  96.   END HookExpr;  
  97.  
  98.   PROCEDURE IndexPrefix*(VAR x: COCT.Item);
  99.   BEGIN
  100.         IF x.mode >= Con THEN COCS.Mark(127) END;
  101.     IF x.typ.form = Array THEN
  102.       IF x.mode = Ind THEN COCJ.DeRef(x); x.mode := Var END;
  103.       COCJ.ArrInxPfx(x, inxchk)
  104.     ELSIF x.typ.form = DynArr THEN  
  105.       IF (x.intval=0) & (x.typ.BaseTyp.form=Byte) THEN 
  106.         COCJ.BytArrInxPfx(x, inxchk)
  107.       ELSE COCJ.DynArrInxPfx(x, inxchk)
  108.       END
  109.     ELSE COCS.Mark(82)  
  110.     END
  111.   END IndexPrefix;
  112.  
  113.   PROCEDURE Index*(VAR x, y: COCT.Item);
  114.     VAR  f, n: INTEGER; 
  115.   BEGIN f := y.typ.form;  
  116.     IF ~(y.typ.form IN intSet) THEN COCS.Mark(80); y.typ := COCT.inttyp END ;  
  117.         IF y.mode > Reg THEN COCS.Mark(126) END;
  118.     IF x.typ.form = Array THEN  
  119.       COCJ.ArrInxSfx;
  120.       IF (y.mode = Con) & ((0 > y.intval) OR (y.intval >= x.typ.n)) THEN COCS.Mark(81) END;
  121.       x.typ := x.typ.BaseTyp;
  122.       x.obj := NIL;
  123.     ELSIF x.typ.form = DynArr THEN  
  124.       IF (x.intval=0) & (x.typ.BaseTyp.form=Byte) THEN 
  125.         COCJ.BytArrInxSfx(); x.typ := x.typ.BaseTyp; x.obj := NIL
  126.       ELSE COCJ.DynArrInxSfx();
  127.         x.typ := x.typ.BaseTyp;
  128.         IF x.typ.form = DynArr THEN INC(x.intval) 
  129.         ELSE COCJ.Cast(x); COCJ.DeRef(x); x.mode := Var; x.obj := NIL
  130.         END
  131.       END
  132.     END
  133.   END Index;  
  134.     
  135.   PROCEDURE Field*(VAR x: COCT.Item; y: COCT.Object);
  136.   BEGIN (*x.typ.form = Record*)  
  137.     IF (y # NIL) & (y.mode = Fld) THEN  
  138.       IF x.mode = Ind THEN COCJ.DeRef(x); x.mode := Var 
  139.             ELSIF x.mode # Var THEN COCS.Mark(127)
  140.             END;
  141.       COCJ.Field(x,y);
  142.       x.typ := y.typ
  143.     ELSE COCS.Mark(83); x.typ := COCT.undftyp
  144.     END;
  145.     x.obj := NIL
  146.   END Field;  
  147.     
  148.   PROCEDURE DeRef*(VAR x: COCT.Item);
  149.   BEGIN IF x.mode >= Con THEN COCS.Mark(127) END;
  150.     IF x.typ.form = Pointer THEN  
  151.       IF x.mode = Var THEN x.mode := Ind  
  152.       ELSE COCJ.DeRef(x)
  153.       END ;  
  154.       IF nilchk THEN COCJ.NilPtr(x) END;
  155.       x.typ := x.typ.BaseTyp; x.obj := COCT.wasderef  
  156.     ELSE COCS.Mark(84)  
  157.     END 
  158.   END DeRef;
  159.  
  160.   PROCEDURE GTT(t0, t1: COCT.Struct);  
  161.     VAR t: COCT.Struct;   
  162.   BEGIN    
  163.     IF t0 # t1 THEN t := t1;    
  164.       REPEAT t := t.BaseTyp UNTIL (t = NIL) OR (t = t0);    
  165.       IF t = NIL THEN COCS.Mark(85) END  
  166.     END    
  167.   END GTT;    
  168.     
  169.   PROCEDURE TypGuard*(VAR x, y: COCT.Item);
  170.   BEGIN
  171.     IF x.typ.form = Pointer THEN  
  172.       IF x.mode = Ind THEN COCJ.DeRef(x); x.mode := Var END;
  173.       IF y.typ.form = Pointer THEN  
  174.         GTT(x.typ.BaseTyp, y.typ.BaseTyp);
  175.         COCJ.TypGuard(x, y, COCT.typchk) 
  176.       ELSE COCS.Mark(86)  
  177.       END  
  178.     ELSIF (x.typ.form = Record) & 
  179.           (x.obj # NIL) & (x.obj # COCT.wasderef) & (x.obj.mode = Ind) &
  180.           (y.typ.form = Record) THEN  
  181.       GTT(x.typ, y.typ);  
  182.       COCJ.TypGuard(x, y, COCT.typchk)
  183.     ELSE COCS.Mark(87)  
  184.     END;
  185.     x.typ := y.typ
  186.   END TypGuard;  
  187.  
  188.   PROCEDURE TypTest*(VAR x,y: COCT.Item);
  189.   BEGIN
  190.     IF x.typ.form = Pointer THEN  
  191.       IF y.typ.form = Pointer THEN  
  192.         GTT(x.typ.BaseTyp, y.typ.BaseTyp);
  193.         COCX.TypTest(x, y)
  194.       ELSE COCS.Mark(86)  
  195.       END  
  196.     ELSIF (x.typ.form = Record) & 
  197.           (x.obj # NIL) & (x.obj # COCT.wasderef) & (x.obj.mode = Ind) &
  198.           (y.typ.form = Record) THEN  
  199.       GTT(x.typ, y.typ);  
  200.       COCX.TypTest(x, y)
  201.     ELSE COCS.Mark(87)  
  202.     END;
  203.     x.typ := COCT.booltyp
  204.   END TypTest;
  205.  
  206.   PROCEDURE Const*(VAR x: COCT.Item);
  207.     VAR np: INTEGER;
  208.   BEGIN COCJ.CConstValue(x, COCQ.cslen, np)
  209.   END Const;
  210.  
  211.   PROCEDURE Set00*(VAR x, y: COCT.Item); (*(1<<(y))*)
  212.     VAR one: LONGINT;  
  213.   BEGIN x.mode := Reg; x.intval := 0; x.typ := COCT.settyp;  
  214.     IF y.typ.form IN intSet THEN  
  215.       IF y.mode = Con THEN x.mode := Con;  
  216.         IF (MinSet <= y.intval) & (y.intval <= MaxSet) THEN 
  217.           one := 1; x.intval := SYSTEM.LSH(one, y.intval)  
  218.         ELSE COCS.Mark(202)  
  219.         END  
  220.       END;
  221.       COCX.Set00(x,rngchk)
  222.     ELSE COCS.Mark(93)  
  223.     END  
  224.   END Set00;  
  225.     
  226.   PROCEDURE Set10*(VAR x, y: COCT.Item); (*((~0UL<<(y))&(~0UL>>(31-(z))))*)
  227.     VAR all: LONGINT;
  228.   BEGIN x.mode :=  Reg; x.intval := 0; x.typ := COCT.settyp;
  229.     IF y.typ.form IN intSet THEN
  230.       IF y.mode = Con THEN x.mode := Con;
  231.         IF (MinSet <= y.intval) & (y.intval <= MaxSet) THEN 
  232.           all := -1; x.intval := SYSTEM.LSH(all, y.intval)  
  233.         ELSE COCS.Mark(202)  
  234.         END  
  235.       END;
  236.       COCX.Set10(x,rngchk)
  237.     ELSE COCS.Mark(93)  
  238.     END  
  239.   END Set10;
  240.     
  241.   PROCEDURE Set11*(VAR x, y, z: COCT.Item);
  242.     VAR s: LONGINT;
  243.   BEGIN   
  244.     IF z.typ.form IN intSet THEN  
  245.       IF x.mode = Con THEN  
  246.         IF z.mode = Con THEN  
  247.           IF (z.intval > MaxSet) OR (z.intval < 0) THEN COCS.Mark(202); x.intval := 0
  248.           ELSIF y.intval <= z.intval THEN
  249.             s := -2; x.intval := x.intval - SYSTEM.LSH(s, z.intval)
  250.           ELSE x.intval := 0 (*ok*)
  251.           END
  252.         ELSE x.mode := Reg
  253.         END  
  254.       ELSIF (z.mode = Con) & ((0 > z.intval) OR (z.intval > MaxSet)) THEN 
  255.         COCS.Mark(202)
  256.       END;
  257.       COCX.Set11(x, rngchk)
  258.     ELSE COCS.Mark(93)  
  259.     END
  260.   END Set11; 
  261.  
  262.   PROCEDURE InPrefix*(VAR x: COCT.Item);
  263.   BEGIN 
  264.         IF x.mode > Reg THEN COCS.Mark(126) END;
  265.     IF x.typ.form IN intSet THEN
  266.       IF x.mode = Con THEN COCX.InPfx(x, FALSE);
  267.         IF (0 > x.intval) OR (x.intval > MaxSet) THEN COCS.Mark(202) END
  268.       ELSE COCX.InPfx(x, rngchk); x.mode := Reg
  269.       END
  270.     ELSE COCS.Mark(92); x.mode := Reg
  271.     END
  272.   END InPrefix;
  273.  
  274.   PROCEDURE In*(VAR x, y: COCT.Item);
  275.   BEGIN 
  276.         IF y.mode > Reg THEN COCS.Mark(126) END;
  277.     IF (x.typ.form IN intSet) & (y.typ.form = Set) THEN  
  278.       COCX.InSfx;
  279.       IF (x.mode = Con) & (y.mode = Con) THEN 
  280.         IF x.intval IN SYSTEM.VAL(SET, y.intval) THEN x.intval := 1
  281.         ELSE x.intval := 0
  282.         END
  283.       ELSE x.mode := Reg
  284.       END
  285.     ELSE COCS.Mark(92); x.mode := Reg  
  286.     END ;  
  287.     x.typ := COCT.booltyp  
  288.   END In;  
  289.  
  290.   PROCEDURE MOp*(op: INTEGER; VAR x: COCT.Item); (* monadic plus, minus and negation *)
  291.     VAR f: INTEGER; a: LONGINT;
  292.   BEGIN 
  293.         f := x.typ.form;  
  294.         IF x.mode > Reg THEN COCS.Mark(126) END;
  295.     CASE op OF 
  296.       5 (*&*): 
  297.       IF f # Bool THEN
  298.         COCS.Mark(94); x.mode := Con; x.intval := 0; x.typ := COCT.booltyp
  299.       END;
  300.     | 6 (*+*): 
  301.       IF f IN numSet THEN COCX.MOp(op, x, rngchk)
  302.       ELSE COCS.Mark(96); x.mode := Reg
  303.       END  
  304.     | 7 (*-*): 
  305.       IF f IN numSet THEN  
  306.         COCX.MOp(op, x, rngchk);
  307.         IF x.mode = Con THEN 
  308.           IF f IN intSet THEN x.intval := -x.intval; SetIntType(x)  
  309.           ELSE x.fltval := -x.fltval
  310.           END
  311.         ELSE x.mode := Reg
  312.         END
  313.       ELSIF f = Set  THEN 
  314.         COCX.MOp(op, x, rngchk);
  315.         IF x.mode = Con THEN a := -1; x.intval := a - x.intval
  316.         ELSE x.mode := Reg
  317.         END
  318.       ELSE COCS.Mark(97); x.mode := Reg
  319.       END  
  320.     | 8 (*OR*): 
  321.       IF f # Bool THEN
  322.         COCS.Mark(95); x.mode := Con; x.typ := COCT.booltyp; x.intval := 1
  323.       END
  324.     | 32: (*~*)  
  325.       IF f = Bool THEN  
  326.         COCX.MOp(op, x, rngchk);
  327.         IF x.mode = Con THEN x.intval := 1 - x.intval  
  328.         ELSE x.mode := Reg
  329.         END
  330.       ELSE COCS.Mark(98); x.mode := Reg
  331.       END  
  332.     END  
  333.   END MOp;  
  334.  
  335.   PROCEDURE convertII(VAR x: COCT.Item; typ: COCT.Struct);
  336.   BEGIN IF x.mode < Con THEN x.mode := Reg END; x.typ := typ
  337.   END convertII;  
  338.     
  339.   PROCEDURE convertRI(VAR x: COCT.Item; typ: COCT.Struct);
  340.   BEGIN IF x.mode < Con THEN x.mode := Reg END;
  341.     IF x.mode = Con THEN x.fltval := x.intval END; x.typ := typ
  342.   END convertRI;  
  343.     
  344.   PROCEDURE convertRR(VAR x: COCT.Item);
  345.   BEGIN IF x.mode < Con THEN x.mode := Reg END; x.typ := COCT.lrltyp
  346.   END convertRR;  
  347.       
  348.   PROCEDURE Op*(op: INTEGER; VAR x, y: COCT.Item);
  349.     VAR f, g: INTEGER; p, q, r: COCT.Struct; consts: BOOLEAN;
  350.       convert: SET; (*0 - first, 1 - second*)
  351.     
  352.     PROCEDURE strings(): BOOLEAN;
  353.       VAR first, second: BOOLEAN;
  354.     BEGIN 
  355.       first := ((((f=Array) OR (f=DynArr)) & (x.typ.BaseTyp.form=Char)) OR (f=String));
  356.       second := ((((g=Array) OR (g=DynArr)) & (y.typ.BaseTyp.form=Char)) OR (g=String));
  357.       RETURN 
  358.         first & second OR 
  359.         first & (y.mode = Con) & (y.typ.form = Char) OR
  360.         (x.mode = Con) & (x.typ.form = Char) & second
  361.     END strings;  
  362.     
  363.   BEGIN 
  364.         IF x.mode > Reg THEN COCS.Mark(126) END; 
  365.         IF y.mode > Reg THEN COCS.Mark(126) END; 
  366.         convert := {};
  367.     IF x.typ # y.typ THEN (* conversions *)
  368.       f := x.typ.form; g := y.typ.form;  
  369.       CASE f OF  
  370.         Undef:  
  371.       | SInt: 
  372.         IF g = Int THEN convertII(x, y.typ)  
  373.         ELSIF g = LInt THEN convertII(x, y.typ)  
  374.         ELSIF g = Real THEN convertRI(x, y.typ)  
  375.         ELSIF g = LReal THEN convertRI(x, y.typ)  
  376.         ELSE COCS.Mark(100)  
  377.         END  
  378.       | Int:  
  379.         IF g = SInt THEN convertII(y, x.typ)  
  380.         ELSIF g = LInt THEN convertII(x, y.typ)  
  381.         ELSIF g = Real THEN convertRI(x, y.typ)  
  382.         ELSIF g = LReal THEN convertRI(x, y.typ)  
  383.         ELSE COCS.Mark(100)  
  384.         END  
  385.       | LInt: 
  386.         IF g = SInt THEN convertII(y, x.typ)  
  387.         ELSIF g = Int THEN convertII(y, x.typ)  
  388.         ELSIF g = Real THEN convertRI(x, y.typ)  
  389.         ELSIF g = LReal THEN convertRI(x, y.typ)  
  390.         ELSE COCS.Mark(100)  
  391.         END  
  392.       | Real: 
  393.         IF g = SInt THEN convertRI(y, x.typ)  
  394.         ELSIF g = Int THEN convertRI(y, x.typ)  
  395.         ELSIF g = LInt THEN convertRI(y, x.typ)  
  396.         ELSIF g = LReal THEN convertRR(x)  
  397.         ELSE COCS.Mark(100)  
  398.         END  
  399.       | LReal: 
  400.         IF g = SInt THEN convertRI(y, x.typ)  
  401.         ELSIF g = Int THEN convertRI(y, x.typ)  
  402.         ELSIF g = LInt THEN convertRI(y, x.typ)  
  403.         ELSIF g = Real THEN convertRR(y)  
  404.         ELSE COCS.Mark(100)  
  405.         END  
  406.       | NilTyp: IF g # Pointer THEN COCS.Mark(100) END  
  407.       | Pointer: 
  408.         IF g = Pointer THEN  
  409.           p := x.typ.BaseTyp; q := y.typ.BaseTyp;  
  410.           IF (p.form = Record) & (q.form = Record) THEN  
  411.             IF p.n < q.n THEN r := p; p := q; q := r; 
  412.                             INCL(convert,1); y.typ := x.typ
  413.                         ELSE INCL(convert,0); x.typ := y.typ
  414.                         END;  
  415.             WHILE (p # q) & (p # NIL) DO p := p.BaseTyp END;  
  416.             IF p = NIL THEN COCS.Mark(100) END  
  417.           ELSE COCS.Mark(100)  
  418.           END  
  419.         ELSIF g # NilTyp THEN COCS.Mark(100)
  420.         END  
  421.       | ProcTyp: IF g # NilTyp THEN COCS.Mark(100) END  
  422.       | Array, DynArr, Char, String:  
  423.       | Byte, Bool, Set, NoTyp, Record: COCS.Mark(100)
  424.       END;
  425.       IF f IN numSet THEN 
  426.         IF f = x.typ.form THEN INCL(convert,1)
  427.         ELSE INCL(convert,0)
  428.         END
  429.       END
  430.     END;  
  431.     f := x.typ.form; g := y.typ.form; consts := (x.mode = Con) & (y.mode = Con);
  432.     CASE op OF 
  433.      (*multiplication*) 
  434.       1 (***):  
  435.       IF f IN numSet THEN
  436.         COCX.NumOp(op,convert,x,y,rngchk);
  437.         IF (f IN intSet) & consts THEN (*ovfl test missing*)  
  438.           x.intval := x.intval * y.intval; SetIntType(x)  
  439.         ELSE x.mode := Reg
  440.         END
  441.       ELSIF f = Set THEN  
  442.         COCX.SetOp(op,x,y);
  443.         IF consts THEN 
  444.           x.intval := SYSTEM.VAL(LONGINT,SYSTEM.VAL(SET,x.intval)*SYSTEM.VAL(SET,y.intval))
  445.         ELSE x.mode := Reg
  446.         END
  447.       ELSIF f # Undef THEN COCS.Mark(101); x.mode := Reg
  448.       END  
  449.     
  450.     | 2 (*/*):  
  451.       IF f IN numSet THEN
  452.         IF x.typ.form IN intSet THEN convert := convert + {0,1}; 
  453.           convertRI(x, COCT.realtyp); convertRI(y, COCT.realtyp)
  454.         END;
  455.         COCX.NumOp(op,convert,x,y,rngchk); x.mode := Reg
  456.       ELSIF f = Set THEN
  457.         COCX.SetOp(op,x,y);
  458.         IF consts THEN 
  459.           x.intval := SYSTEM.VAL(LONGINT,SYSTEM.VAL(SET,x.intval)/SYSTEM.VAL(SET,y.intval))
  460.         ELSE x.mode := Reg 
  461.         END 
  462.       ELSIF f # Undef THEN COCS.Mark(102); x.mode := Reg
  463.       END  
  464.     
  465.     | 3 (*DIV*):  
  466.       IF f IN intSet THEN  
  467.         COCX.NumOp(op,convert,x,y,rngchk);
  468.         IF consts THEN  
  469.           IF y.intval # 0 THEN x.intval := x.intval DIV y.intval; SetIntType(x)  
  470.           ELSE COCS.Mark(205)  
  471.           END  
  472.         ELSE x.mode := Reg
  473.         END
  474.       ELSIF f # Undef THEN COCS.Mark(103); x.mode := Reg
  475.       END  
  476.     
  477.     | 4 (*MOD*):  
  478.       IF f IN intSet THEN  (*MOD*)
  479.         COCX.NumOp(op,convert,x,y,rngchk);
  480.         IF consts THEN  
  481.           IF y.intval # 0 THEN x.intval := x.intval MOD y.intval; x.typ := y.typ  
  482.           ELSE COCS.Mark(205)  
  483.           END  
  484.         ELSE x.mode := Reg
  485.         END
  486.       ELSIF f # Undef THEN COCS.Mark(104); x.mode := Reg
  487.       END  
  488.     
  489.     | 5 (*&*):  
  490.       COCX.BoolOp(op,x,y);
  491.       IF consts THEN x.intval := x.intval*y.intval ELSE x.mode := Reg END
  492.  
  493.    (* addition *)
  494.     | 6 (*+*):  
  495.       IF f IN numSet THEN
  496.         COCX.NumOp(op,convert,x,y,rngchk);
  497.         IF (f IN intSet) & consts THEN
  498.           INC(x.intval, y.intval); SetIntType(x)  (*ovfl test missing*)  
  499.         ELSE x.mode := Reg
  500.         END
  501.       ELSIF f = Set THEN
  502.         COCX.SetOp(op,x,y);
  503.         IF consts THEN
  504.           x.intval := SYSTEM.VAL(LONGINT,SYSTEM.VAL(SET,x.intval)+SYSTEM.VAL(SET,y.intval))  
  505.         ELSE x.mode := Reg
  506.         END
  507.       ELSIF f # Undef THEN COCS.Mark(105); x.mode := Reg
  508.       END  
  509.     
  510.     | 7 (*-*): 
  511.       IF f IN numSet THEN
  512.         COCX.NumOp(op,convert,x,y,rngchk);
  513.         IF (f IN intSet) & consts THEN
  514.           DEC(x.intval, y.intval); SetIntType(x)  (*ovfl test missing*)  
  515.         ELSE x.mode := Reg
  516.         END
  517.       ELSIF f = Set THEN
  518.         COCX.SetOp(op,x,y);
  519.         IF consts THEN
  520.           x.intval := SYSTEM.VAL(LONGINT,SYSTEM.VAL(SET,x.intval)-SYSTEM.VAL(SET,y.intval))  
  521.         ELSE x.mode := Reg
  522.         END
  523.       ELSIF f # Undef THEN COCS.Mark(106); x.mode := Reg
  524.       END  
  525.  
  526.     | 8 (*OR*): 
  527.       COCX.BoolOp(op,x,y);
  528.       IF consts & (x.intval = 0) THEN x.intval := y.intval 
  529.       ELSE x.mode := Reg 
  530.       END
  531.     
  532.    (* relations *)
  533.     | 9, 10 (*=,#*):  
  534.       IF f IN {Bool, SInt .. LInt, Set, NilTyp, Pointer, ProcTyp} THEN
  535.         COCX.NumRel(op,convert,x,y);
  536.         IF consts THEN
  537.           IF (x.intval = y.intval) = (op = 9) THEN x.intval := 1 ELSE x.intval := 0 END
  538.         ELSE x.mode := Reg
  539.         END
  540.       ELSIF f IN realSet THEN COCX.NumRel(op,convert,x,y); x.mode := Reg
  541.       ELSIF strings() THEN COCX.StrRel(op,x,y); x.mode := Reg
  542.       ELSIF (f = Char) # (g = Char) THEN COCS.Mark(100); x.mode := Reg
  543.       ELSIF f = Char THEN
  544.         COCX.CharRel(op,x,y);
  545.         IF consts THEN
  546.           IF (x.intval = y.intval) = (op = 9) THEN x.intval := 1 ELSE x.intval := 0 END
  547.         ELSE x.mode := Reg
  548.         END
  549.       ELSIF f # Undef THEN COCS.Mark(107); x.mode := Reg
  550.       END;
  551.       x.typ := COCT.booltyp
  552.     
  553.     | 11,14 (*<,>=*): 
  554.       IF f IN intSet THEN
  555.         COCX.NumRel(op,convert,x,y);
  556.         IF consts THEN
  557.           IF (x.intval < y.intval) = (op = 11) THEN x.intval := 1 ELSE x.intval := 0 END
  558.         ELSE x.mode := Reg
  559.         END
  560.       ELSIF f IN realSet THEN COCX.NumRel(op,convert,x,y); x.mode := Reg
  561.       ELSIF strings() THEN COCX.StrRel(op,x,y); x.mode := Reg
  562.       ELSIF (f = Char) # (g = Char) THEN COCS.Mark(100); x.mode := Reg
  563.       ELSIF f = Char THEN
  564.         COCX.CharRel(op,x,y);
  565.         IF consts THEN
  566.           IF (x.intval < y.intval) = (op = 11) THEN x.intval := 1 ELSE x.intval := 0 END
  567.         ELSE x.mode := Reg
  568.         END
  569.       ELSIF f # Undef THEN COCS.Mark(108); x.mode := Reg
  570.       END;
  571.       x.typ := COCT.booltyp
  572.     
  573.     | 12,13 (*<=,>*): 
  574.       IF f IN intSet THEN
  575.         COCX.NumRel(op,convert,x,y);
  576.         IF consts THEN
  577.           IF (x.intval <= y.intval) = (op = 12) THEN x.intval := 1 ELSE x.intval := 0 END
  578.         ELSE x.mode := Reg
  579.         END
  580.       ELSIF f IN realSet THEN COCX.NumRel(op,convert,x,y); x.mode := Reg
  581.       ELSIF strings() THEN COCX.StrRel(op,x,y); x.mode := Reg
  582.       ELSIF (f = Char) # (g = Char) THEN COCS.Mark(100); x.mode := Reg
  583.       ELSIF f = Char THEN
  584.         COCX.CharRel(op,x,y);
  585.         IF consts THEN
  586.           IF (x.intval <= y.intval) = (op = 12) THEN x.intval := 1 ELSE x.intval := 0 END
  587.         ELSE x.mode := Reg
  588.         END                                      
  589.       ELSIF f # Undef THEN COCS.Mark(108); x.mode := Reg
  590.       END;
  591.       x.typ := COCT.booltyp
  592.     END  
  593.   END Op;  
  594.  
  595.   PROCEDURE TkFct*(VAR x: COCT.Item; fctno: INTEGER);
  596.   BEGIN COCX.StProcPfx(fctno,rngchk);
  597.   END TkFct;
  598.     
  599.   PROCEDURE StPar1*(VAR x: COCT.Item; fctno: INTEGER);
  600.     VAR f: INTEGER; s: LONGINT;
  601.   BEGIN f := x.typ.form;
  602.     CASE fctno OF 0: (*HALT*)  
  603.       IF (f = SInt) & (x.mode = Con) THEN  
  604.         IF x.intval < 20H THEN COCS.Mark(218) ELSE COCX.StPar1Sfx(x,fctno,rngchk) END  
  605.       ELSE COCS.Mark(217)  
  606.       END ;  
  607.       x.typ := COCT.notyp  
  608.     | 1: (*NEW*) 
  609.             IF x.mode >= Con THEN COCS.Mark(112)
  610.       ELSIF f = Pointer THEN  
  611.         x.typ := x.typ.BaseTyp; f := x.typ.form;  
  612.         IF f IN {Record, Array} THEN COCX.StPar1Sfx(x,fctno,rngchk)
  613.         ELSE COCS.Mark(111)  
  614.         END  
  615.       ELSE COCS.Mark(111)  
  616.       END ;  
  617.       x.typ := COCT.notyp  
  618.     | 2: (*CC*)  
  619.       IF (f = SInt) & (x.mode = Con) THEN  
  620.         IF (0 <= x.intval) & (x.intval < 16) THEN  COCX.StPar1Sfx(x,fctno,rngchk) 
  621.         ELSE COCS.Mark(219) 
  622.         END  
  623.       ELSE COCS.Mark(217)  
  624.       END;
  625.       x.typ := COCT.notyp
  626.     | 3: (*ABS*) 
  627.       IF f IN numSet THEN 
  628.         COCX.StPar1Sfx(x,fctno,rngchk);
  629.         IF x.mode = Con THEN
  630.           CASE f OF SInt: 
  631.             IF x.intval < 0 THEN 
  632.               IF x.intval # MinSInt THEN x.intval := -x.intval
  633.               ELSE COCS.Mark(203)
  634.               END
  635.             END
  636.           | Int: 
  637.             IF x.intval < 0 THEN 
  638.               IF x.intval # MinInt THEN x.intval := -x.intval
  639.               ELSE COCS.Mark(203)
  640.               END
  641.             END
  642.           | LInt: 
  643.             IF x.intval < 0 THEN 
  644.               IF x.intval # MinLInt THEN x.intval := -x.intval
  645.               ELSE COCS.Mark(203)
  646.               END
  647.             END
  648.           | Real,LReal: IF x.fltval < 0.0 THEN  x.intval := -x.intval END
  649.           END
  650.         ELSE IF x.mode > Reg THEN COCS.Mark(126) END; x.mode := Reg
  651.         END
  652.       ELSE COCS.Mark(111); x.mode := Reg
  653.       END;
  654.     | 4: (*CAP*) 
  655.       IF f = Char THEN COCX.StPar1Sfx(x,fctno,rngchk);
  656.         IF x.mode = Con THEN x.intval := ORD(CAP(CHR(x.intval))) 
  657.         ELSE IF x.mode > Reg THEN COCS.Mark(126) END; x.mode := Reg
  658.         END
  659.       ELSE COCS.Mark(111); x.typ := COCT.chartyp; x.mode := Reg
  660.       END;
  661.     | 5: (*ORD*)   
  662.       IF f IN {Byte, Char} THEN COCX.StPar1Sfx(x,fctno,rngchk); 
  663.         IF x.mode # Con THEN IF x.mode > Reg THEN COCS.Mark(126) END; x.mode := Reg END
  664.       ELSE COCS.Mark(111); x.mode := Reg 
  665.       END;
  666.       x.typ := COCT.inttyp
  667.     | 6: (*ENTIER*)  
  668.       IF f IN realSet THEN 
  669.         COCX.StPar1Sfx(x,fctno,rngchk);
  670.         IF x.mode = Con THEN 
  671.           IF (MinLInt <= x.fltval) & (x.fltval <= MaxLInt) THEN x.intval := ENTIER(x.fltval)
  672.           ELSE COCS.Mark(203)
  673.           END
  674.         ELSE IF x.mode > Reg THEN COCS.Mark(126) END; x.mode := Reg
  675.         END
  676.       ELSE COCS.Mark(111); x.mode := Reg 
  677.       END;  
  678.       x.typ := COCT.linttyp
  679.     | 7: (*SIZE*)  
  680.       IF x.mode = Typ THEN COCX.StPar1Sfx(x,fctno,rngchk) ELSE COCS.Mark(110) END;
  681.       x.typ := COCT.linttyp; x.mode := Reg
  682.     | 8: (*ODD*)  
  683.       IF f IN intSet THEN COCX.StPar1Sfx(x,fctno,rngchk);
  684.         IF x.mode = Con THEN
  685.           IF ODD(x.intval) THEN x.intval := 1 ELSE x.intval := 0 END 
  686.         ELSE IF x.mode > Reg THEN COCS.Mark(126) END; x.mode := Reg
  687.         END
  688.       ELSE COCS.Mark(111); x.mode := Reg 
  689.       END;
  690.       x.typ := COCT.booltyp
  691.     | 9: (*ADR*) 
  692.       IF x.mode < Con THEN COCX.StPar1Sfx(x,fctno,rngchk)
  693.       ELSE COCS.Mark(127)
  694.       END;
  695.       x.typ := COCT.linttyp; x.mode := Reg
  696.     | 10: (*MIN*)  
  697.       IF x.mode = Typ THEN COCX.StPar1Sfx(x,fctno,rngchk); x.mode := Con;      
  698.         CASE f OF      
  699.           Bool, Char:  x.intval := MinChar      
  700.         | SInt:  x.intval := MinSInt      
  701.         | Int:   x.intval := MinInt       
  702.         | LInt:  x.intval := MinLInt      
  703.         | Real:  x.fltval := MinReal      
  704.         | LReal: x.fltval := MinLReal      
  705.         | Set:   x.intval := MinSet; x.typ := COCT.inttyp        
  706.         | Undef, NilTyp .. Record: COCS.Mark(111)        
  707.         END      
  708.       ELSE COCS.Mark(110); x.mode := Reg      
  709.       END      
  710.     | 11: (*MAX*)  
  711.       IF x.mode = Typ THEN COCX.StPar1Sfx(x,fctno,rngchk); x.mode := Con;      
  712.         CASE f OF      
  713.           Bool:  x.intval := MaxBool    
  714.         | Char:  x.intval := MaxChar      
  715.         | SInt:  x.intval := MaxSInt      
  716.         | Int:   x.intval := MaxInt      
  717.         | LInt:  x.intval := MaxLInt     
  718.         | Real:  x.fltval := MaxReal      
  719.         | LReal: x.fltval := MaxLReal     
  720.         | Set:   x.intval := MaxSet; x.typ := COCT.inttyp      
  721.         | Undef, NilTyp .. Record: COCS.Mark(111)      
  722.         END      
  723.       ELSE COCS.Mark(110); x.mode := Reg
  724.       END       
  725.     | 12: (*CHR*)   
  726.       IF f IN intSet THEN COCX.StPar1Sfx(x,fctno,rngchk);
  727.         IF x.mode = Con THEN
  728.           IF (0 > x.intval) OR (x.intval >= 100H) THEN COCS.Mark(203) END
  729.         ELSE IF x.mode > Reg THEN COCS.Mark(126) END; x.mode := Reg
  730.         END
  731.       ELSE COCS.Mark(111) ; x.mode := Reg
  732.       END;  
  733.       x.typ := COCT.chartyp  
  734.     | 13: (*SHORT*)  
  735.       IF f IN {Int,LInt,LReal} THEN 
  736.         COCX.StPar1Sfx(x,fctno,rngchk);
  737.         CASE f OF Int: 
  738.           IF x.mode = Con THEN SetIntType(x);  
  739.             IF x.typ.form # SInt THEN COCS.Mark(203); x.mode := Reg END  
  740.                     ELSE IF x.mode > Reg THEN COCS.Mark(126) END; x.mode := Reg
  741.           END; 
  742.           x.typ := COCT.sinttyp
  743.         | LInt:
  744.           IF x.mode = Con THEN SetIntType(x);  
  745.             IF x.typ.form = LInt THEN COCS.Mark(203); x.mode := Reg END  
  746.                     ELSE IF x.mode > Reg THEN COCS.Mark(126) END; x.mode := Reg
  747.           END;
  748.           x.typ := COCT.inttyp  
  749.         | LReal:
  750.           IF x.mode = Con THEN 
  751.             IF (x.fltval > MaxReal) OR (x.fltval < MinReal) THEN COCS.Mark(203); x.mode := Reg END
  752.                     ELSE IF x.mode > Reg THEN COCS.Mark(126) END; x.mode := Reg
  753.           END;
  754.           x.typ := COCT.realtyp
  755.         END
  756.       ELSE COCS.Mark(111); x.mode := Reg
  757.       END  
  758.     | 14: (*LONG*)  
  759.       IF f IN {SInt,Int,Real} THEN COCX.StPar1Sfx(x,fctno,rngchk);
  760.                 IF x.mode > Reg THEN COCS.Mark(126) END;
  761.         CASE f OF SInt: convertII(x, COCT.inttyp)
  762.         | Int: convertII(x, COCT.linttyp)
  763.         | Real: convertRR(x)
  764.         END
  765.       ELSE COCS.Mark(111); x.mode := Reg
  766.       END  
  767.     | 15: (*OVFL*)  
  768.       IF (f = Bool) & (x.mode = Con) THEN COCX.StPar1Sfx(x,fctno,rngchk)
  769.       ELSE COCS.Mark(111)  
  770.       END;  
  771.       x.typ := COCT.notyp  
  772.     | 16,17: (*INC DEC*)   
  773.       IF x.mode >= Con THEN COCS.Mark(112)  
  774.       ELSIF f IN intSet THEN COCX.StPar1Sfx(x,fctno,rngchk)
  775.       ELSE COCS.Mark(111)  
  776.       END  
  777.     | 18,19: (*INCL EXCL*)  
  778.       IF x.mode >= Con THEN COCS.Mark(112)  
  779.       ELSIF x.typ = COCT.settyp THEN COCX.StPar1Sfx(x,fctno,rngchk)
  780.       ELSE COCS.Mark(111); x.typ := COCT.settyp  
  781.       END  
  782.     | 20: (*LEN*)  
  783.       IF (f = DynArr) OR (f = Array) THEN 
  784.                 IF x.mode >= Con THEN COCS.Mark(127) END;
  785.                 COCX.StPar1Sfx(x,fctno,rngchk)
  786.       ELSE COCS.Mark(131) 
  787.       END  
  788.     | 21: (*ASH*)  
  789.       IF f IN intSet THEN 
  790.                 IF x.mode > Reg THEN COCS.Mark(126) END; 
  791.                 COCX.StPar1Sfx(x,fctno,rngchk); x.typ := COCT.linttyp
  792.       ELSE COCS.Mark(111)
  793.       END  
  794.     | 22, 23: (*LSH ROT*)  
  795.       IF f IN {SInt, Int, LInt, Set} THEN IF x.mode > Reg THEN COCS.Mark(126) END; COCX.StPar1Sfx(x,fctno,rngchk) 
  796.       ELSE COCS.Mark(111) 
  797.       END  
  798.     | 24,25,26: (*GET, PUT, BIT*)  
  799.       IF f IN intSet THEN COCX.StPar1Sfx(x,fctno,rngchk);
  800.         IF x.mode = Con THEN x.typ := COCT.linttyp
  801.         ELSIF f = LInt THEN IF x.mode > Reg THEN COCS.Mark(126) END
  802.                 ELSE COCS.Mark(111)
  803.         END
  804.       ELSE COCS.Mark(111)  
  805.       END  
  806.     | 27: (*VAL*)  
  807.       IF x.mode = Typ THEN COCX.StPar1Sfx(x,fctno,rngchk)
  808.       ELSE COCS.Mark(110) 
  809.       END  
  810.     | 28: (*SYSTEM.NEW*)  
  811.             IF x.mode >= Con THEN COCS.Mark(112)
  812.       ELSIF f = Pointer THEN  COCX.StPar1Sfx(x,fctno,rngchk)
  813.       ELSE COCS.Mark(111)  
  814.       END  
  815.     | 29: (*COPY*)  
  816.       IF (((f=Array) OR (f=DynArr)) & (x.typ.BaseTyp.form = Char)) 
  817.          OR (f = String) THEN IF x.mode > Reg THEN COCS.Mark(126) END; COCX.StPar1Sfx(x,fctno,rngchk)
  818.       ELSE COCS.Mark(111)  
  819.       END  
  820.     | 30: (*MOVE*)  
  821.       IF f = LInt THEN IF x.mode > Reg THEN COCS.Mark(126) END; COCX.StPar1Sfx(x,fctno,rngchk)
  822.       ELSE COCS.Mark(111)  
  823.       END  
  824.     END  
  825.   END StPar1;  
  826.     
  827.   PROCEDURE StPar2*(VAR p, x: COCT.Item; fctno: INTEGER);
  828.     VAR f, L: INTEGER; y: COCT.Item; typ: COCT.Struct;  
  829.   BEGIN f := x.typ.form;  
  830.     IF fctno < 16 THEN COCS.Mark(64); RETURN END;  
  831.     CASE fctno OF 16, 17: (*INC DEC*)  
  832.       IF x.typ # p.typ THEN  
  833.         IF (x.mode = Con) & (x.typ.form IN intSet) THEN 
  834.           COCX.StPar2Sfx(p,fctno,rngchk); x.typ := p.typ  
  835.         ELSE COCS.Mark(111)  
  836.         END  
  837.             ELSE IF x.mode > Reg THEN COCS.Mark(126) END
  838.       END;
  839.       p.typ := COCT.notyp  
  840.     | 18, 19: (*INCL EXCL*) 
  841.             IF f IN intSet THEN
  842.                 IF x.mode = Con THEN
  843.                     IF (x.intval < 0) OR (MaxSet < x.intval) THEN COCS.Mark(202) END
  844.                 ELSE IF x.mode > Reg THEN COCS.Mark(126) END
  845.                 END;
  846.                 COCX.StPar2Sfx(p,fctno,rngchk)
  847.             ELSE COCS.Mark(111)
  848.             END;
  849.             p.typ := COCT.notyp 
  850.     | 20: (*LEN*)  
  851.       p.mode := Reg;
  852.       IF (x.mode = Con) & (f = SInt) THEN  
  853.         L := SHORT(x.intval); typ := p.typ;  
  854.         WHILE (L > 0) & (typ.form IN {DynArr, Array}) DO typ := typ.BaseTyp; DEC(L) END;  
  855.         IF (L # 0) OR ~(typ.form IN {DynArr, Array}) THEN COCS.Mark(132)
  856.         ELSE COCX.StPar2Sfx(p,fctno,rngchk); 
  857.           IF typ.form = DynArr THEN p.typ := COCT.linttyp
  858.           ELSE p.mode := Con; p.intval := typ.n; SetIntType(p)  
  859.           END  
  860.         END  
  861.       ELSE COCS.Mark(111)  
  862.       END  
  863.     | 21, 22, 23: (*ASH LSH ROT*)  
  864.       IF f IN intSet THEN COCX.StPar2Sfx(p,fctno,rngchk);
  865.         IF (p.mode = Con) & (x.mode = Con) THEN
  866.           CASE fctno OF 21: p.intval := ASH(p.intval,x.intval)
  867.           | 22: p.intval := SYSTEM.LSH(p.intval,x.intval)
  868.           | 23: 
  869.             CASE p.typ.form OF SInt: p.intval := SYSTEM.ROT(SHORT(SHORT(p.intval)),x.intval)
  870.             | Int: p.intval := SYSTEM.ROT(SHORT(p.intval), x.intval)
  871.             | LInt,Set: p.intval := SYSTEM.ROT(p.intval, x.intval)
  872.             END
  873.           END
  874.         ELSE IF x.mode > Reg THEN COCS.Mark(126) END; p.mode := Reg
  875.         END
  876.       ELSE COCS.Mark(111); p.mode := Reg
  877.       END
  878.     | 24,25: (*GET PUT*)  
  879.       IF x.mode >= Con THEN COCS.Mark(127)  
  880.       ELSIF f IN {Array, DynArr, Record} THEN COCS.Mark(111)
  881.       ELSE COCX.StPar2Sfx(p,fctno,rngchk)
  882.       END;  
  883.       p.typ := COCT.notyp  
  884.     | 26: (*BIT*)  
  885.       IF f IN intSet THEN COCX.StPar2Sfx(p,fctno,rngchk);
  886.         IF x.mode = Con THEN
  887.           IF (x.intval < 0) OR (7 < x.intval) THEN COCS.Mark(203) END 
  888.                 ELSE IF x.mode > Reg THEN COCS.Mark(126) END
  889.         END
  890.       ELSE COCS.Mark(111)
  891.       END;  
  892.       p.mode := Reg; p.typ := COCT.booltyp
  893.     | 27: (*VAL*)  
  894.       COCX.StPar2Sfx(p,fctno,rngchk); 
  895.       IF x.mode > Reg THEN COCS.Mark(126) END; x.typ := p.typ; x.qoffs := p.qoffs; p := x 
  896.     | 28: (*SYSTEM.NEW*)  
  897.       IF f IN intSet THEN COCX.StPar2Sfx(p,fctno,rngchk);
  898.                 IF x.mode = Con THEN
  899.                 ELSE IF x.mode > Reg THEN COCS.Mark(126) END
  900.                 END
  901.       ELSE COCS.Mark(111)  
  902.       END ;  
  903.       p.typ := COCT.notyp  
  904.     | 29: (*COPY*)  
  905.       IF ((f = Array) OR (f = DynArr)) & (x.typ.BaseTyp.form = Char) THEN  
  906.         IF x.mode >= Con THEN COCS.Mark(112) END; 
  907.                 COCX.StPar2Sfx(p,fctno,rngchk)
  908.       ELSE COCS.Mark(111)  
  909.       END;  
  910.       p.typ := COCT.notyp  
  911.     | 30: (*MOVE*)  
  912.       IF f = LInt THEN IF x.mode > Reg THEN COCS.Mark(126) END; COCX.StPar2Sfx(p,fctno,rngchk)
  913.       ELSE COCS.Mark(111)  
  914.       END  
  915.     END  
  916.   END StPar2;  
  917.     
  918.   PROCEDURE StPar3*(VAR p, x: COCT.Item; fctno: INTEGER);
  919.     VAR f: INTEGER; 
  920.   BEGIN f := x.typ.form;  
  921.     IF fctno = 30 THEN (*MOVE*)  
  922.       IF f IN intSet THEN IF x.mode > Reg THEN COCS.Mark(126) END; 
  923.             COCX.StPar3Sfx(p,fctno,rngchk)
  924.       ELSE COCS.Mark(111)  
  925.       END;  
  926.       p.typ := COCT.notyp  
  927.     ELSE COCS.Mark(64)  
  928.     END  
  929.   END StPar3;  
  930.     
  931.   PROCEDURE StFct*(VAR p: COCT.Item; fctno, parno: INTEGER);
  932.     VAR np: INTEGER;
  933.   BEGIN   
  934.     IF fctno >= 16 THEN  
  935.       IF ((fctno = 16) OR (fctno = 17)) & (parno = 1) THEN (*INC DEC*)
  936.         COCX.StFakeSfx(fctno,rngchk); p.typ := COCT.notyp
  937.       ELSIF (fctno = 20) & (parno = 1) THEN (*LEN*)
  938.         COCX.StFakeSfx(fctno,rngchk);
  939.         IF p.typ.form = DynArr THEN p.mode := Reg; p.typ := COCT.linttyp
  940.         ELSE p.mode := Con; p.intval := p.typ.n; SetIntType(p)  
  941.         END  
  942.       ELSIF (parno < 2) OR (fctno = 30) & (parno < 3) THEN COCS.Mark(65)  
  943.       END  
  944.     ELSIF parno < 1 THEN COCS.Mark(65)  
  945.     END;
  946.     COCX.StFctSfx(fctno, rngchk)
  947.   END StFct;  
  948.     
  949. BEGIN inxchk := TRUE; rngchk := TRUE; nilchk := TRUE;
  950.  
  951.  (* SYSTEM Dependant *)
  952.   MinChar := 0H; MaxChar := 0FFH;
  953.   MinBool := 0; MaxBool := 1;
  954.   MinSInt := -128; MaxSInt := 127;
  955.   MinInt := -32768; MaxInt := 32767;
  956.   MinLInt := 80000000H; MaxLInt := 7FFFFFFFH;
  957.   MinReal := -3.402823E+38; MaxReal := 3.402823E+38;
  958.   MinLReal := -1.79769313486231D+308; MaxLReal := 1.79769313486231D+308;
  959.   MinSet := 0; MaxSet := 31  
  960.  
  961. END COCE.  
  962.