home *** CD-ROM | disk | FTP | other *** search
/ Fresh Fish 9 / FreshFishVol9-CD1.bin / useful / dev / obero / oberon-a / source / oc / oce.mod < prev    next >
Encoding:
Text File  |  1995-03-09  |  48.7 KB  |  1,550 lines
  1. (*************************************************************************
  2.  
  3.      $RCSfile: OCE.mod $
  4.   Description: Code selection for expressions
  5.  
  6.    Created by: fjc (Frank Copeland)
  7.     $Revision: 5.9.1.1 $
  8.       $Author: fjc $
  9.         $Date: 1995/03/08 19:01:25 $
  10.  
  11.   Copyright © 1990-1993, ETH Zuerich
  12.   Copyright © 1993-1995, Frank Copeland
  13.   This module forms part of the OC program
  14.   See OC.doc for conditions of use and distribution
  15.  
  16.   Log entries are at the end of the file.
  17.  
  18. *************************************************************************)
  19.  
  20. <* STANDARD- *> <* MAIN- *> <*$ LongVars+ *>
  21.  
  22. MODULE OCE;
  23.  
  24. IMPORT SYS := SYSTEM, OCM, OCS, OCT, OCC, OCI;
  25.  
  26.  
  27. (* --- Local declarations ----------------------------------------------- *)
  28.  
  29. CONST
  30.  
  31.   (* Symbols *)
  32.  
  33.   null = OCS.null; times = OCS.times; slash = OCS.slash; div   = OCS.div;
  34.   mod  = OCS.mod;  and   = OCS.and;   plus  = OCS.plus;  minus = OCS.minus;
  35.   or   = OCS.or;   eql   = OCS.eql;   neq   = OCS.neq;   lss   = OCS.lss;
  36.   leq  = OCS.leq;  gtr   = OCS.gtr;   geq   = OCS.geq;   not   = OCS.not;
  37.  
  38.   (* object modes *)
  39.   Var = OCM.Var; VarX = OCM.VarX; Ind = OCM.Ind; IndX = OCM.IndX;
  40.   RegI = OCM.RegI; RegX = OCM.RegX; Lab = OCM.Lab; LabI = OCM.LabI;
  41.   Con = OCM.Con; Push = OCM.Push; Pop = OCM.Pop; Coc = OCM.Coc;
  42.   Reg = OCM.Reg; Fld = OCM.Fld; Typ = OCM.Typ; Abs = OCM.Abs;
  43.   XProc = OCM.XProc; RList = OCM.RList;
  44.  
  45.   (* System flags *)
  46.  
  47.   OberonFlag = OCM.OberonFlag; M2Flag = OCM.M2Flag; CFlag = OCM.CFlag;
  48.   BCPLFlag = OCM.BCPLFlag; AsmFlag = OCM.AsmFlag;
  49.  
  50.   (* structure forms *)
  51.   Undef = OCT.Undef; Byte = OCT.Byte; Bool = OCT.Bool; Char = OCT.Char;
  52.   SInt = OCT.SInt; Int = OCT.Int; LInt = OCT.LInt; Real = OCT.Real;
  53.   LReal = OCT.LReal; Set = OCT.Set; String = OCT.String;
  54.   NilTyp = OCT.NilTyp; NoTyp = OCT.NoTyp; Pointer = OCT.Pointer;
  55.   ProcTyp = OCT.ProcTyp; Array = OCT.Array; DynArr = OCT.DynArr;
  56.   Record = OCT.Record; PtrTyp = OCT.PtrTyp; AdrTyp = OCT.AdrTyp;
  57.   BPtrTyp = OCT.BPtrTyp; BSet = OCT.BSet; WSet = OCT.WSet;
  58.   Word = OCT.Word; Longword = OCT.Longword; TagTyp = OCT.TagTyp;
  59.  
  60.   intSet   = {SInt, Int, LInt};
  61.   realSet  = {Real, LReal};
  62.   setSet   = {BSet, WSet, Set};
  63.   ptrSet   = {Pointer, PtrTyp, AdrTyp, BPtrTyp};
  64.   uptrSet  = {AdrTyp, BPtrTyp};
  65.   allSet   = {0 .. 31};
  66.   adrSet   = {LInt, Pointer, PtrTyp, AdrTyp, Longword};
  67.  
  68.   (* CPU Registers *)
  69.  
  70.   D0 = 0; D1 = 1; D7 = 7; A0 = 8; A1 = 9; A3 = 11; A4 = 12; A5 = 13;
  71.   A6 = 14; A7 = 15; BP = A4; FP = A5; SP = A7;
  72.   DataRegs = {D0 .. D7};
  73.   AdrRegs = {A0 .. A7};
  74.  
  75.   (* Data sizes *)
  76.  
  77.   B = 1; W = 2; L = 4;
  78.  
  79.   (* mathffp.library function offsets *)
  80.  
  81.   SPFix = -30; SPFlt = -36; SPCmp = -42; SPTst = -48; SPAbs = -54;
  82.   SPNeg = -60; SPAdd = -66; SPSub = -72; SPMul = -78; SPDiv = -84;
  83.   SPFloor = -90; SPCeil = -96;
  84.  
  85. VAR
  86.   log : LONGINT; (* side effect of mant () *)
  87.  
  88. (* CONST mname = "OCE"; *)
  89.  
  90. (* --- Procedure declarations ------------------------------------------- *)
  91.  
  92. PROCEDURE^ Op *
  93.   (op : INTEGER; VAR lhs, rhs : OCT.Item; freeRegs : BOOLEAN);
  94.  
  95. (*------------------------------------*)
  96. PROCEDURE mant (x : LONGINT) : LONGINT; (* x DIV 2 ^ log *)
  97.  
  98. BEGIN (* mant *)
  99.   log := 0;
  100.   IF x > 0 THEN WHILE ~ODD (x) DO x := x DIV 2; INC (log) END END;
  101.   RETURN x
  102. END mant;
  103.  
  104. (*------------------------------------*)
  105. PROCEDURE MultiplyInts (
  106.   VAR lhs, rhs : OCT.Item; size : LONGINT; freeRegs : BOOLEAN);
  107.  
  108.   (* CONST pname = "MultiplyInts"; *)
  109.  
  110.   VAR R : SET; x : OCT.Item;
  111.  
  112. BEGIN (* MultiplyInts *)
  113.   (* OCM.TraceIn (mname, pname); *)
  114.   IF (lhs.mode = Con) & (mant (lhs.a0) = 1) THEN
  115.     IF log = 1 THEN
  116.       OCI.Load (rhs); OCC.PutF5 (OCC.ADD, size, rhs, rhs)
  117.     ELSIF log # 0 THEN
  118.       lhs.a0 := log; lhs.typ := OCT.sinttyp;
  119.       IF log > 8 THEN OCI.Load (lhs) END;
  120.       OCI.Load (rhs); OCC.Shift (OCC.ASL, size, lhs, rhs);
  121.       IF log > 8 THEN OCC.FreeReg (lhs) END;
  122.     END;
  123.     lhs := rhs; rhs.mode := Undef
  124.   ELSIF (rhs.mode = Con) & (mant (rhs.a0) = 1) THEN
  125.     IF log = 1 THEN
  126.       OCI.Load (lhs); OCC.PutF5 (OCC.ADD, size, lhs, lhs)
  127.     ELSIF log # 0 THEN
  128.       rhs.a0 := log; rhs.typ := OCT.sinttyp;
  129.       IF log > 8 THEN OCI.Load (rhs) END;
  130.       OCI.Load (lhs); OCC.Shift (OCC.ASL, size, rhs, lhs)
  131.     END
  132.   ELSE
  133.     IF size = L THEN
  134.       OCC.LoadRegParams2 (R, lhs, rhs);
  135.       OCC.CallKernel (OCC.kMul32);
  136.       OCC.RestoreRegisters (R, lhs);
  137.     ELSE
  138.       IF lhs.mode = Con THEN x := lhs; lhs := rhs; rhs := x END;
  139.       OCI.Load (lhs);
  140.       IF size = B THEN
  141.         OCI.EXT (W, lhs.a0);
  142.         IF rhs.mode # Con THEN OCI.Load (rhs); OCI.EXT (W, rhs.a0) END;
  143.       END;
  144.       OCC.PutF2 (OCC.MULS, rhs, lhs.a0);
  145.       IF OCS.pragma [OCS.ovflChk] THEN
  146.         OCC.GetDReg (x); OCC.Move (size, lhs, x);
  147.         IF size = B THEN OCI.EXT (W, x.a0) END; OCI.EXT (L, x.a0);
  148.         OCC.PutF5 (OCC.CMP, L, lhs, x); OCI.Unload (x);
  149.         OCC.TrapCC (OCC.RangeCheck, OCC.NE)
  150.       END
  151.     END
  152.   END;
  153.   IF freeRegs THEN OCI.Unload (rhs) END
  154.   (* ;OCM.TraceOut (mname, pname); *)
  155. END MultiplyInts;
  156.  
  157. (*------------------------------------*)
  158. PROCEDURE DivideInts (
  159.   VAR lhs, rhs : OCT.Item; size : LONGINT; freeRegs : BOOLEAN);
  160.  
  161.   (* CONST pname = "DivideInts"; *)
  162.  
  163.   VAR R : SET;
  164.  
  165. BEGIN (* DivideInts *)
  166.   (* OCM.TraceIn (mname, pname); *)
  167.   IF (rhs.mode = Con) & (mant (rhs.a0) = 1) THEN
  168.     rhs.a0 := log; rhs.typ := OCT.sinttyp;
  169.     IF log > 8 THEN OCI.Load (rhs) END;
  170.     OCI.Load (lhs);
  171.     OCC.Shift (OCC.ASR, size, rhs, lhs);
  172.   ELSE
  173.     IF size = OCM.LIntSize THEN
  174.       OCC.LoadRegParams2 (R, lhs, rhs);
  175.       OCC.CallKernel (OCC.kDiv32);
  176.       OCC.RestoreRegisters (R, lhs);
  177.     ELSE
  178.       OCI.Load (lhs);
  179.       IF lhs.typ^.form = OCT.SInt THEN OCI.EXT (W, lhs.a0) END;
  180.       OCI.EXT (L, lhs.a0);
  181.       IF rhs.typ^.form = OCT.SInt THEN
  182.         OCI.Load (rhs); OCI.EXT (W, rhs.a0)
  183.       END;
  184.       OCC.PutF2 (OCC.DIVS, rhs, lhs.a0);
  185.       (*IF OCS.pragma [OCS.ovflChk] THEN OCC.OutOp0 (TRAPV) END;*)
  186.     END
  187.   END;
  188.   IF freeRegs THEN OCI.Unload (rhs) END;
  189.   (* ;OCM.TraceOut (mname, pname); *)
  190. END DivideInts;
  191.  
  192. (*------------------------------------*)
  193. PROCEDURE ModulusInts (
  194.   VAR lhs, rhs : OCT.Item; size : LONGINT; freeRegs : BOOLEAN);
  195.  
  196.   (* CONST pname = "ModulusInts"; *)
  197.  
  198.   VAR R : SET;
  199.  
  200. BEGIN (* ModulusInts *)
  201.   (* OCM.TraceIn (mname, pname); *)
  202.   IF (rhs.mode = Con) & (mant (rhs.a0) = 1) THEN
  203.     rhs.a0 := ASH (1, log) - 1; OCI.Load (lhs);
  204.     OCC.PutF6 (OCC.ANDI, size, rhs, lhs)
  205.   ELSE
  206.     IF size = OCM.LIntSize THEN
  207.       OCC.LoadRegParams2 (R, lhs, rhs);
  208.       OCC.CallKernel (OCC.kDiv32);
  209.       OCC.PutWord (0C141H); (* EXG D0,D1 *)
  210.       OCC.RestoreRegisters (R, lhs)
  211.     ELSE
  212.       OCI.Load (lhs);
  213.       IF lhs.typ^.form = OCT.SInt THEN OCI.EXT (W, lhs.a0) END;
  214.       OCI.EXT (L, lhs.a0);
  215.       IF rhs.typ^.form = OCT.SInt THEN
  216.         OCI.Load (rhs); OCI.EXT (L, rhs.a0)
  217.       END;
  218.       OCC.PutF2 (OCC.DIVS, rhs, lhs.a0);
  219.       OCC.PutWord (OCC.SWAP + lhs.a0)
  220.     END
  221.   END;
  222.   IF freeRegs THEN OCI.Unload (rhs) END
  223.   (* ;OCM.TraceOut (mname, pname); *)
  224. END ModulusInts;
  225.  
  226. (*------------------------------------*)
  227. PROCEDURE ConvertInts * (VAR x : OCT.Item; typ : OCT.Struct);
  228.  
  229.   (* CONST pname = "ConvertInts"; *)
  230.  
  231. BEGIN (* ConvertInts *)
  232.   (* OCM.TraceIn (mname, pname); *)
  233.   IF x.mode # Con THEN
  234.     OCI.Load (x);
  235.     IF (typ.form = LInt) & (x.typ.form = SInt) THEN OCI.EXT (W, x.a0) END;
  236.     OCI.EXT (typ.size, x.a0)
  237.   END;
  238.   x.typ := typ
  239.   (* ;OCM.TraceOut (mname, pname); *)
  240. END ConvertInts;
  241.  
  242.  
  243. (*------------------------------------*)
  244. PROCEDURE RealMath (op : INTEGER; VAR lhs, rhs : OCT.Item);
  245.  
  246.   (* CONST pname = "RealMath"; *)
  247.  
  248.   VAR proc : INTEGER; R : SET;
  249.  
  250. BEGIN (* RealMath *)
  251.   (* OCM.TraceIn (mname, pname); *)
  252.   OCC.LoadRegParams2 (R, lhs, rhs);
  253.   CASE op OF
  254.     times : proc := OCC.kSPMul | slash : proc := OCC.kSPDiv |
  255.     plus  : proc := OCC.kSPAdd | minus : proc := OCC.kSPSub
  256.   ELSE
  257.     OCS.Mark (1009); OCS.Mark (op)
  258.   END;
  259.   OCC.CallKernel (proc); OCC.RestoreRegisters (R, lhs)
  260.   (* ;OCM.TraceOut (mname, pname); *)
  261. END RealMath;
  262.  
  263. (*------------------------------------*)
  264. PROCEDURE CmpReals (VAR lhs, rhs : OCT.Item);
  265.  
  266.   (* CONST pname = "CmpReals"; *)
  267.  
  268.   VAR R : SET; proc : INTEGER;
  269.  
  270. BEGIN (* CmpReals *)
  271.   (* OCM.TraceIn (mname, pname); *)
  272.   IF (rhs.mode = Con) & (rhs.a0 = 0) THEN
  273.     OCC.LoadRegParams1 (R, lhs); proc := OCC.kSPTst
  274.   ELSE
  275.     OCC.LoadRegParams2 (R, lhs, rhs); proc := OCC.kSPCmp
  276.   END;
  277.   OCC.CallKernel (proc); OCC.RestoreRegisters (R, lhs)
  278.   (* ;OCM.TraceOut (mname, pname); *)
  279. END CmpReals;
  280.  
  281. (*------------------------------------*)
  282. PROCEDURE ConvertReals (VAR x : OCT.Item; typ : OCT.Struct);
  283.  
  284.   (* CONST pname = "ConvertReals"; *)
  285.  
  286.   VAR r0 : OCT.Item; R : SET; f : INTEGER;
  287.  
  288. BEGIN (* ConvertReals *)
  289.   (* OCM.TraceIn (mname, pname); *)
  290.   f := x.typ.form;
  291.   IF f IN intSet THEN
  292.     IF x.mode = Con THEN x.typ := OCT.linttyp; f := LInt END;
  293.     r0.mode := Reg; r0.a0 := D0;
  294.     OCC.LoadRegParams1 (R, x);
  295.     IF f = SInt THEN OCI.EXT (W, r0.a0); f := Int END;
  296.     IF f = Int THEN OCI.EXT (L, r0.a0) END;
  297.     OCC.CallKernel (OCC.kSPFlt);
  298.     OCC.RestoreRegisters (R, x)
  299.   END;
  300.   x.typ := typ
  301.   (* ;OCM.TraceOut (mname, pname); *)
  302. END ConvertReals;
  303.  
  304. (*------------------------------------*)
  305. PROCEDURE NegReal (VAR x : OCT.Item);
  306.  
  307.   (* CONST pname = "NegReal"; *)
  308.  
  309.   VAR R : SET;
  310.  
  311. BEGIN (* NegReal *)
  312.   (* OCM.TraceIn (mname, pname); *)
  313.   OCC.LoadRegParams1 (R, x);
  314.   OCC.CallKernel (OCC.kSPNeg);
  315.   OCC.RestoreRegisters (R, x)
  316.   (* ;OCM.TraceOut (mname, pname); *)
  317. END NegReal;
  318.  
  319. (*------------------------------------*)
  320. PROCEDURE loadB (VAR x : OCT.Item); (* Coc-Mode *)
  321.  
  322.   (* CONST pname = "loadB"; *)
  323.  
  324.   VAR op, L0 : LONGINT;
  325.  
  326. BEGIN (* loadB *)
  327.   (* OCM.TraceIn (mname, pname); *)
  328.   IF ((x.a1 = 0) & (x.a2 = 0)) OR (x.a0 IN {OCC.T, OCC.F}) THEN
  329.     op := OCC.Scc + (x.a0 * 100H);
  330.     OCC.GetDReg (x); OCC.PutF3 (op, x)                       (*    Scc Dn *)
  331.   ELSE
  332.     op := OCC.Bcc + (OCC.invertedCC (x.a0) * 100H);
  333.     OCC.PutWord (op); OCC.PutWord (x.a2);                    (*    Bcc 1$ *)
  334.     L0 := OCC.pc - 2; OCC.FixLink (x.a1);
  335.     OCC.GetDReg (x); OCC.PutF3 (OCC.ST, x);                  (*    ST  Dn *)
  336.     OCC.PutWord (6002H);                                     (*    BRA 2$ *)
  337.     OCC.FixLink (L0); OCC.PutF3 (OCC.SF, x);                 (* 1$ SF  Dn *)
  338.   END                                                        (* 2$        *)
  339.   (* ;OCM.TraceOut (mname, pname); *)
  340. END loadB;
  341.  
  342. (*------------------------------------*)
  343. PROCEDURE setCC * (VAR x: OCT.Item; cc : LONGINT);
  344.  
  345. BEGIN (* setCC *)
  346.   x.typ := OCT.booltyp; x.mode := Coc; x.a0 := cc; x.a1 := 0; x.a2 := 0
  347. END setCC;
  348.  
  349. (*------------------------------------*)
  350. PROCEDURE cmp (VAR lhs, rhs : OCT.Item; freeX : BOOLEAN);
  351.  
  352.   (* CONST pname = "cmp"; *)
  353.  
  354.   VAR size : LONGINT;
  355.  
  356. BEGIN (* cmp *)
  357.   (* OCM.TraceIn (mname, pname); *)
  358.   size := lhs.typ.size; IF size > L THEN size := L END;
  359.   IF rhs.mode = Con THEN
  360.     IF lhs.mode = Con THEN OCI.Load (lhs)
  361.     ELSIF lhs.mode = Coc THEN loadB (lhs)
  362.     END;
  363.     IF rhs.a0 = 0 THEN OCC.PutF1 (OCC.TST, size, lhs)
  364.     ELSE OCC.PutF6 (OCC.CMPI, size, rhs, lhs)
  365.     END
  366.   ELSE
  367.     IF lhs.mode = Coc THEN loadB (lhs)
  368.     ELSE OCI.Load (lhs)
  369.     END;
  370.     OCC.PutF5 (OCC.CMP, size, rhs, lhs);
  371.   END;
  372.   IF freeX THEN OCI.Unload (lhs) END
  373.   (* ;OCM.TraceOut (mname, pname); *)
  374. END cmp;
  375.  
  376. (*------------------------------------*)
  377. PROCEDURE test (VAR x : OCT.Item);
  378.  
  379.   (* CONST pname = "test"; *)
  380.  
  381. BEGIN (* test *)
  382.   (* OCM.TraceIn (mname, pname); *)
  383.   OCC.PutF1 (OCC.TST, x.typ.size, x); OCI.Unload (x); setCC (x, OCC.NE)
  384.   (* ;OCM.TraceOut (mname, pname); *)
  385. END test;
  386.  
  387. (*------------------------------------*)
  388. PROCEDURE SetIntType * (VAR x : OCT.Item);
  389.  
  390.   (* CONST pname = "SetIntType"; *)
  391.  
  392.   VAR v : LONGINT;
  393.  
  394. BEGIN (* SetIntType *)
  395.   (* OCM.TraceIn (mname, pname); *)
  396.   v := x.a0;
  397.   IF (LONG (OCM.MinSInt) <= v) & (v <= LONG (OCM.MaxSInt)) THEN
  398.     x.typ := OCT.sinttyp
  399.   ELSIF (LONG (OCM.MinInt) <= v) & (v <= LONG (OCM.MaxInt)) THEN
  400.     x.typ := OCT.inttyp
  401.   ELSE
  402.     x.typ := OCT.linttyp
  403.   END;
  404.   (* ;OCM.TraceOut (mname, pname); *)
  405. END SetIntType;
  406.  
  407. (*------------------------------------*)
  408. PROCEDURE SetSetType (VAR x : OCT.Item);
  409.  
  410.   (* CONST pname = "SetSetType"; *)
  411.  
  412.   VAR s : SET;
  413.  
  414. BEGIN (* SetSetType *)
  415.   (* OCM.TraceIn (mname, pname); *)
  416.   s := SYS.VAL (SET, x.a0);
  417.   IF (s - {OCM.MinSet .. OCM.MaxBSet}) = {} THEN
  418.     x.typ := OCT.bsettyp
  419.   ELSIF (s - {OCM.MinSet .. OCM.MaxWSet}) = {} THEN
  420.     x.typ := OCT.wsettyp
  421.   ELSE
  422.     x.typ := OCT.settyp
  423.   END
  424.   (* ;OCM.TraceOut (mname, pname); *)
  425. END SetSetType;
  426.  
  427. (*------------------------------------*)
  428. PROCEDURE AssReal * (VAR x : OCT.Item; y : REAL);
  429.  
  430. BEGIN (* AssReal *)
  431.   SYS.PUT (SYS.ADR (x.a0), y)
  432. END AssReal;
  433.  
  434. (*------------------------------------*)
  435. PROCEDURE AssLReal * (VAR x : OCT.Item; y : LONGREAL);
  436.  
  437. BEGIN (* AssLReal *)
  438.   SYS.PUT (SYS.ADR (x.a0), y)
  439. END AssLReal;
  440.  
  441. (*------------------------------------*)
  442. PROCEDURE Index * (VAR x, y : OCT.Item);
  443.  
  444.   (* CONST pname = "Index"; *)
  445.  
  446.   VAR
  447.     f, m, r, L0 : INTEGER; i, n : LONGINT;
  448.     eltyp : OCT.Struct; br, y1, z  : OCT.Item;
  449.     desc : OCT.Desc; wordSize, calcSize, ovflChk : BOOLEAN;
  450.  
  451. BEGIN (* Index *)
  452.   (* OCM.TraceIn (mname, pname); *)
  453.   ovflChk := OCS.pragma [OCS.ovflChk]; OCS.pragma [OCS.ovflChk] := FALSE;
  454.   f := y.typ.form;
  455.   IF ~(f IN intSet) THEN OCS.Mark (80); y.typ := OCT.inttyp END;
  456.   IF x.typ = NIL THEN OCS.Mark (80); HALT (80) END;
  457.   IF x.typ.form = Array THEN
  458.     eltyp := x.typ.BaseTyp; n := x.typ.n;
  459.     wordSize := (x.typ.size <= 32767);
  460.     IF eltyp = NIL THEN OCS.Mark (81); HALT (81) END;
  461.     IF y.mode = Con THEN
  462.       IF (0 <= y.a0) & (y.a0 < n) THEN i := y.a0 * eltyp.size
  463.       ELSE OCS.Mark (81); i := 0
  464.       END;
  465.       IF x.mode = Var  THEN
  466.         INC (x.a0, i)
  467.       ELSIF (x.mode = Ind) OR (x.mode = RegI) THEN
  468.         INC (x.a1, i); x.obj := NIL
  469.       ELSE
  470.         OCI.LoadAdr (x); x.a1 := i
  471.       END
  472.     ELSE
  473.       OCI.Load (y);
  474.       IF f = SInt THEN OCI.EXT (W, y.a0); y.typ := OCT.inttyp; f := Int END;
  475.  
  476.       IF OCS.pragma [OCS.indexChk] THEN (* z = bound descr *)
  477.         z.mode := Con; z.a0 := n - 1;
  478.         IF f = Int THEN z.typ := OCT.inttyp; OCC.PutCHK (z, y.a0)
  479.         ELSE
  480.           OCC.PutF1 (OCC.TST, L, y);             (*    TST.L Dy          *)
  481.           L0 := OCC.pc; OCC.PutWord (6B00H);     (*    BMI.S 1$          *)
  482.           z.typ := OCT.linttyp;
  483.           cmp (y, z, FALSE);                     (*    CMP.L #z,Dy       *)
  484.           OCC.TrapLink (OCC.IndexCheck, OCC.GT, L0);
  485.                                                  (*    BLE.S 2$          *)
  486.                                                  (* 1$ TRAP  #IndexCheck *)
  487.         END                                      (* 2$                   *)
  488.       END;
  489.  
  490.       m := x.mode;
  491.       IF m = Var THEN
  492.         x.mode := VarX; x.wordIndex := wordSize; x.a1 := 0;
  493.         x.a2 := SHORT (y.a0); calcSize := eltyp.size > 1
  494.       ELSIF m = Ind THEN
  495.         x.mode := IndX; x.wordIndex := wordSize; x.a2 := SHORT (y.a0);
  496.         calcSize := eltyp.size > 1;
  497.       ELSIF m = RegI THEN
  498.         x.mode := RegX; x.wordIndex := wordSize; x.a2 := SHORT (y.a0);
  499.         calcSize := eltyp.size > 1;
  500.       ELSIF m IN {VarX, IndX, RegX} THEN
  501.         IF eltyp.size > 1 THEN
  502.           z.mode := Con; z.a0 := eltyp.size;
  503.           IF x.wordIndex THEN z.typ := OCT.inttyp
  504.           ELSE z.typ := OCT.linttyp
  505.           END;
  506.           Op (times, y, z, FALSE)
  507.         END;
  508.         z := y; y.mode := Reg; y.a0 := x.a2;
  509.         IF x.wordIndex THEN y.typ := OCT.inttyp
  510.         ELSE y.typ := OCT.linttyp
  511.         END;
  512.         Op (plus, y, z, TRUE);
  513.         calcSize := FALSE;
  514.       ELSE OCS.Mark (322)
  515.       END;
  516.       IF calcSize THEN
  517.         z.mode := Con; z.a0 := eltyp.size;
  518.         IF x.wordIndex THEN z.typ := OCT.inttyp
  519.         ELSE z.typ := OCT.linttyp
  520.         END;
  521.         Op (times, y, z, FALSE)
  522.       END
  523.     END; (* ELSE *)
  524.     x.typ := eltyp
  525.   ELSIF x.typ.form = DynArr THEN
  526.     IF f # LInt THEN ConvertInts (y, OCT.linttyp)
  527.     ELSIF y.mode # Con THEN OCI.Load (y)
  528.     END;
  529.  
  530.     IF OCS.pragma [OCS.indexChk] THEN
  531.       IF (y.mode = Con) & (y.a0 < 0) THEN OCS.Mark (81)
  532.       ELSE
  533.         (* z = bound descr *)
  534.         OCI.DescItem (z, x.desc, x.typ.adr);
  535.         IF y.mode # Con THEN
  536.           OCC.PutF1 (OCC.TST, L, y);             (*    TST.L y           *)
  537.           L0 := OCC.pc; OCC.PutWord (6B00H);     (*    BMI.S 1$          *)
  538.           cmp (y, z, FALSE);                     (*    CMP.L z,Dy        *)
  539.           OCC.TrapLink (OCC.IndexCheck, OCC.GE, L0);
  540.                                                  (*    BLT.S 2$          *)
  541.                                                  (* 1$ TRAP  #IndexCheck *)
  542.                                                  (* 2$                   *)
  543.         ELSE
  544.           cmp (z, y, FALSE);                     (*    CMP.L y,z         *)
  545.           OCC.TrapCC (OCC.IndexCheck, OCC.LE);   (*    BGT.S 1$          *)
  546.                                                  (*    TRAP  #IndexCheck *)
  547.                                                  (* 1$                   *)
  548.         END;
  549.         OCI.UpdateDesc (z, x.typ.adr)
  550.       END (* ELSE *)
  551.     END; (* IF *)
  552.  
  553.     IF x.mode = Var THEN (* Value parameter *)
  554.       IF y.mode = Con THEN x.mode := Ind; x.a1 := y.a0
  555.       ELSE
  556.         x.mode := IndX; x.a1 := 0; x.a2 := SHORT (y.a0);
  557.         x.wordIndex := FALSE
  558.       END
  559.     ELSIF x.mode = Ind THEN (* Variable parameter, or dereferenced ptr *)
  560.       IF y.mode = Con THEN x.a1 := y.a0
  561.       ELSE x.mode := IndX; x.a2 := SHORT (y.a0); x.wordIndex := FALSE
  562.       END
  563.     ELSIF x.mode = RegI THEN (* Dereferenced ptr *)
  564.       IF y.mode = Con THEN x.a1 := y.a0
  565.       ELSE x.mode := RegX; x.a2 := SHORT (y.a0); x.wordIndex := FALSE
  566.       END
  567.     ELSIF x.mode IN {IndX, RegX} THEN (* Indexed open array *)
  568.       IF ~OCS.pragma [OCS.indexChk] THEN (* z = bound descr *)
  569.         OCI.DescItem (z, x.desc, x.typ.adr);
  570.       END;
  571.       y1.mode := Reg; y1.a0 := x.a2; y1.typ := OCT.linttyp;
  572.       Op (times, y1, z, FALSE); Op (plus, y1, y, TRUE); y := y1;
  573.       OCI.UpdateDesc (z, x.typ.adr)
  574.     ELSE OCS.Mark (322)
  575.     END;
  576.  
  577.     x.typ := x.typ.BaseTyp;
  578.     IF x.typ # NIL THEN
  579.       IF (x.typ.form # DynArr) THEN
  580.         IF x.typ.size > 1 THEN
  581.           z.mode := Con; z.a0 := x.typ.size; SetIntType (z);
  582.           Op (times, y, z, FALSE)
  583.         END;
  584.         IF y.mode = Con THEN x.a1 := y.a0 END
  585.       ELSIF (y.mode = Con) & (y.a0 # 0) THEN
  586.         OCI.Load (y); x.a1 := 0; x.a2 := SHORT (y.a0); x.wordIndex := FALSE;
  587.         IF x.mode = Ind THEN x.mode := IndX
  588.         ELSIF x.mode = RegI THEN x.mode := RegX
  589.         ELSE OCS.Mark (322)
  590.         END
  591.       END
  592.     END
  593.   ELSE
  594.     OCS.Mark (82)
  595.   END;
  596.   OCS.pragma [OCS.ovflChk] := ovflChk
  597.   (* ;OCM.TraceOut (mname, pname); *)
  598. END Index;
  599.  
  600. (*------------------------------------*)
  601. PROCEDURE Field * (VAR x : OCT.Item; y : OCT.Object);
  602.  
  603.   (* CONST pname = "Field"; *)
  604.  
  605. BEGIN (* Field *)
  606.   (* OCM.TraceIn (mname, pname); *)
  607.   IF x.mode = Var THEN INC (x.a0, y.a0)
  608.   ELSIF (x.mode = Ind)  OR (x.mode = RegI) THEN INC (x.a1, y.a0)
  609.   ELSE OCI.LoadAdr (x); x.mode := RegI; x.a1 := y.a0
  610.   END;
  611.   x.typ := y.typ; x.obj := NIL;
  612.   IF x.lev < 0 THEN x.rdOnly := x.rdOnly OR (y.visible = OCT.RdOnly) END
  613.   (* ;OCM.TraceOut (mname, pname); *)
  614. END Field;
  615.  
  616. (*------------------------------------*)
  617. PROCEDURE DeRef * (VAR x : OCT.Item);
  618.  
  619.   (* CONST pname = "DeRef"; *)
  620.  
  621.   VAR y, z : OCT.Item; flg : INTEGER; desc : OCT.Desc; freeY : BOOLEAN;
  622.  
  623. BEGIN (* DeRef *)
  624.   (* OCM.TraceIn (mname, pname); *)
  625.   IF (x.mode <= RegX) & (x.typ.form = Pointer) THEN
  626.     flg := x.typ.sysflg;
  627.     IF flg = BCPLFlag THEN
  628.       y := x; OCC.GetDReg (z);
  629.       OCC.Move (L, y, z); OCI.Unload (y);         (*    MOVE.L  x,Dm      *)
  630.       IF OCS.pragma [OCS.nilChk] THEN OCC.TrapCC (OCC.NilCheck, OCC.EQ) END;
  631.       OCC.PutF5 (OCC.ADD, L, z, z);               (*    ADD.L   Dm, Dm    *)
  632.       OCC.PutF5 (OCC.ADD, L, z, z);               (*    ADD.L   Dm, Dm    *)
  633.       OCC.GetAReg (x); OCC.Move (L, z, x);        (*    MOVEA.L Dm,An     *)
  634.       OCI.Unload (z); x.mode := RegI
  635.     ELSE
  636.       OCI.UnloadDesc (x); y.mode := Undef;
  637.       IF
  638.         (flg = OberonFlag) & (x.typ.BaseTyp # NIL)
  639.         & (x.typ.BaseTyp.form = DynArr)
  640.       THEN
  641.         desc := x.desc; IF desc = NIL THEN desc := OCT.AllocDesc() END;
  642.         desc.lev := x.lev; desc.mode := x.mode; desc.a0 := x.a0;
  643.         desc.a1 := x.a1; desc.a2 := x.a2; x.desc := desc;
  644.         freeY := ~(desc.mode IN {VarX, IndX, RegI, RegX})
  645.       ELSE
  646.         freeY := TRUE
  647.       END;
  648.       IF x.mode = Var THEN
  649.         IF OCS.pragma [OCS.nilChk] THEN
  650.           y := x;
  651.           OCC.PutF1 (OCC.TST, L, y);                (*    TST.L x         *)
  652.           OCC.TrapCC (OCC.NilCheck, OCC.EQ);
  653.         END;
  654.         x.mode := Ind
  655.       ELSE
  656.         y := x; y.typ := OCT.ptrtyp; OCC.GetAReg (x);
  657.         IF OCS.pragma [OCS.nilChk] THEN
  658.           OCC.GetDReg (z); OCC.Move (L, y, z);    (*    MOVE.L  x,Dn      *)
  659.           OCC.TrapCC (OCC.NilCheck, OCC.EQ);
  660.           OCC.Move (L, z, x); OCI.Unload (z)      (*    MOVEA.L Dn, An    *)
  661.         ELSE
  662.           OCC.Move (L, y, x);                     (*    MOVEA.L x, An     *)
  663.         END;
  664.         IF freeY THEN OCI.Unload (y) END; x.mode := RegI
  665.       END
  666.     END;
  667.     (*x.a2 := flg;*) x.a2 := 0;
  668.     x.typ := x.typ.BaseTyp; x.obj := OCC.wasderef; x.rdOnly := FALSE
  669.   ELSE
  670.     OCS.Mark (84)
  671.   END;
  672.   x.a1 := 0
  673.   (* ;OCM.TraceOut (mname, pname); *)
  674. END DeRef;
  675.  
  676. (*------------------------------------*)
  677. PROCEDURE TypTest * (VAR x, y : OCT.Item; test : BOOLEAN);
  678.  
  679.   (* CONST pname = "TypTest"; *)
  680.  
  681.   (*------------------------------------*)
  682.   PROCEDURE GTT (t0, t1 : OCT.Struct; varpar : BOOLEAN);
  683.  
  684.     (* CONST pname = "GTT"; *)
  685.  
  686.     VAR t : OCT.Struct; xt, tdes, p : OCT.Item; R : SET;
  687.  
  688.   BEGIN (* GTT *)
  689.     (* OCM.TraceIn (mname, pname); *)
  690.     IF t0 # t1 THEN
  691.       t := t1;
  692.       IF t0.form = Record THEN
  693.         REPEAT t := t.BaseTyp UNTIL (t = NIL) OR (t = t0);
  694.       END;
  695.       IF t # NIL THEN
  696.         x.typ := y.typ;
  697.         IF OCS.pragma [OCS.typeChk] OR test THEN
  698.           R := OCC.RegSet; xt := x;
  699.           IF varpar THEN
  700.             xt.mode := Ind; xt.a0 := x.a0 + 4
  701.           ELSE
  702.             p := xt; p.typ := OCT.ptrtyp; OCC.GetAReg (xt);
  703.             IF OCS.pragma [OCS.nilChk] THEN
  704.               OCI.Load (p);                       (*    MOVE.L  p,Dn      *)
  705.               OCC.TrapCC (OCC.NilCheck, OCC.EQ);
  706.             END;
  707.             OCC.Move (L, p, xt);                  (*    MOVE.L  p,An      *)
  708.             p := xt; p.mode := RegI; p.a1 := -4;
  709.             OCC.Move (L, p, xt); xt.mode := RegI; (*    MOVE.L -4(An),An  *)
  710.           END;
  711.           xt.a1 := (t1.n + 1) * 4;
  712.           tdes.mode := LabI; tdes.a0 := 0; tdes.a1 := 4;
  713.           tdes.label := t1.label;
  714.           OCC.PutF5 (OCC.CMP, L, tdes, xt);       (*    CMP.L  #tdes,<xt> *)
  715.           IF ~test THEN OCC.TrapCC (OCC.TypeCheck, OCC.NE)
  716.           ELSE setCC (x, OCC.EQ)
  717.           END;
  718.           OCC.FreeRegs (R)
  719.         END
  720.       ELSE OCS.Mark (85); IF test THEN x.typ := OCT.booltyp END
  721.       END
  722.     ELSIF test THEN setCC (x, OCC.T)
  723.     END
  724.     (* ;OCM.TraceOut (mname, pname); *)
  725.   END GTT;
  726.  
  727. BEGIN (* TypTest *)
  728.   (* OCM.TraceIn (mname, pname); *)
  729.   IF (x.typ.form = Pointer) & (x.typ.sysflg = OberonFlag) THEN
  730.     IF (y.typ.form = Pointer) & (y.typ.sysflg = OberonFlag) THEN
  731.       GTT (x.typ.BaseTyp, y.typ.BaseTyp, FALSE)
  732.     ELSE OCS.Mark (86)
  733.     END
  734.   ELSIF x.typ.form = PtrTyp THEN
  735.     IF
  736.       (y.typ.form = Pointer) & (y.typ.sysflg = OberonFlag)
  737.       & (y.typ.BaseTyp # NIL) & (y.typ.BaseTyp.form # DynArr)
  738.     THEN
  739.       GTT (x.typ, y.typ.BaseTyp, FALSE)
  740.     ELSE OCS.Mark (86)
  741.     END
  742.   ELSIF
  743.     (x.typ.form = Record) & (x.typ.sysflg = OberonFlag)
  744.     & (x.mode = Ind) & (x.obj # NIL) & (x.obj # OCC.wasderef)
  745.     & (y.typ.form = Record) & (y.typ.sysflg = OberonFlag)
  746.   THEN
  747.     GTT (x.typ, y.typ, TRUE)
  748.   ELSE OCS.Mark (87)
  749.   END
  750.   (* ;OCM.TraceOut (mname, pname); *)
  751. END TypTest;
  752.  
  753. (*------------------------------------*)
  754. PROCEDURE In * (VAR lhs, rhs : OCT.Item);
  755.  
  756.   (* CONST pname = "In"; *)
  757.  
  758.   VAR f, g, L0 : INTEGER; bnd, br : OCT.Item;
  759.  
  760. BEGIN (* In *)
  761.   (* OCM.TraceIn (mname, pname); *)
  762.   f := lhs.typ.form; g := rhs.typ.form;
  763.   IF (f IN intSet) & (g IN setSet) THEN
  764.     IF (lhs.mode = Con) & (rhs.mode = Con) THEN
  765.       IF (lhs.a0 >= 0) & (lhs.a0 < 32) THEN
  766.         IF lhs.a0 IN SYS.VAL (SET, rhs.a0) THEN setCC (lhs, OCC.T)
  767.         ELSE setCC (lhs, OCC.F)
  768.         END
  769.       ELSE
  770.         OCS.Mark (91); setCC (lhs, OCC.F)
  771.       END
  772.     ELSIF lhs.mode = Con THEN
  773.       IF
  774.         (lhs.a0 < 0)
  775.         OR ((g = BSet) & (lhs.a0 > 7))
  776.         OR ((g = WSet) & (lhs.a0 > 15))
  777.         OR ((g = Set) & (lhs.a0 > 31))
  778.       THEN
  779.         OCS.Mark (91); setCC (lhs, OCC.F)
  780.       ELSE
  781.         OCI.Load (rhs); OCC.Bit (OCC.BTST, lhs, rhs);
  782.         OCI.Unload (rhs); setCC (lhs, OCC.NE)
  783.       END; (* ELSE *)
  784.     ELSE
  785.       IF rhs.mode = Con THEN rhs.typ := OCT.settyp; g := Set END;
  786.       OCI.Load (lhs);
  787.  
  788.       IF OCS.pragma [OCS.rangeChk] THEN
  789.         IF lhs.typ.form = SInt THEN OCI.EXT (W, lhs.a0) END;
  790.         bnd.mode := Con;
  791.         IF g = BSet THEN bnd.a0 := 7
  792.         ELSIF g = WSet THEN bnd.a0 := 15
  793.         ELSE bnd.a0 := 31
  794.         END;
  795.         IF lhs.typ.form = LInt THEN
  796.           bnd.typ := OCT.linttyp;
  797.           OCC.PutF1 (OCC.TST, L, lhs);            (*    TST.L <lhs>       *)
  798.           L0 := OCC.pc; OCC.PutWord (6B00H);      (*    BMI.S 1$          *)
  799.           cmp (lhs, bnd, FALSE);                  (*    CMP   #<bnd>,<lhs>*)
  800.           OCC.TrapLink (OCC.IndexCheck, OCC.GT, L0);
  801.                                                   (*    BLE.S 2$          *)
  802.                                                   (* 1$ TRAP  #IndexCheck *)
  803.         ELSE                                      (* 2$                   *)
  804.           bnd.typ := OCT.inttyp; OCC.PutCHK (bnd, lhs.a0)
  805.         END
  806.       END;
  807.  
  808.       OCI.Load (rhs); OCC.Bit (OCC.BTST, lhs, rhs);
  809.       OCI.Unload (lhs); OCI.Unload (rhs); setCC (lhs, OCC.NE)
  810.     END
  811.   ELSE OCS.Mark (92); setCC (lhs, OCC.F)
  812.   END
  813.   (* ;OCM.TraceOut (mname, pname); *)
  814. END In;
  815.  
  816. (*------------------------------------*)
  817. PROCEDURE Set0 * (VAR x, y : OCT.Item);
  818.  
  819.   (* CONST pname = "Set0"; *)
  820.  
  821.   VAR one : LONGINT;
  822.  
  823. BEGIN (* Set0 *)
  824.   (* OCM.TraceIn (mname, pname); *)
  825.   x.mode := Reg; x.a0 := D0; x.typ := OCT.settyp;
  826.   IF y.typ.form IN intSet THEN
  827.     IF y.mode = Con THEN
  828.       x.mode := Con;
  829.       IF (0 <= y.a0) & (y.a0 < 32) THEN
  830.         one := 1; x.a0 := SYS.LSH (one, y.a0); SetSetType (x)
  831.       ELSE
  832.         OCS.Mark (202)
  833.       END
  834.     ELSE
  835.       x.mode := Con; x.a0 := 1; OCI.Load (x); OCI.Load (y);
  836.       OCC.Shift (OCC.LSL, L, y, x); OCI.Unload (y)
  837.     END
  838.   ELSE OCS.Mark (93)
  839.   END
  840.   (* ;OCM.TraceOut (mname, pname); *)
  841. END Set0;
  842.  
  843. (*------------------------------------*)
  844. PROCEDURE Set1 * (VAR x, y, z : OCT.Item);
  845.  
  846.   (* CONST pname = "Set1"; *)
  847.  
  848.   VAR s : LONGINT;
  849.  
  850. BEGIN (* Set1 *)
  851.   (* OCM.TraceIn (mname, pname); *)
  852.   x.mode := Reg; x.a0 := D0; x.typ := OCT.settyp;
  853.   IF
  854.     (y.typ.form IN intSet) & (z.typ.form IN intSet)
  855.   THEN
  856.     IF y.mode = Con THEN
  857.       IF (0 <= y.a0) & (y.a0 < 32) THEN
  858.         y.typ := OCT.settyp; s := -1; y.a0 := SYS.LSH (s, y.a0);
  859.         IF z.mode = Con THEN
  860.           x.mode := Con;
  861.           IF (y.a0 <= z.a0) & (z.a0 < 32) THEN
  862.             s := -2; x.a0 := y.a0 - SYS.LSH (s, z.a0); SetSetType (x)
  863.           ELSE
  864.             OCS.Mark (202); x.a0 := 0
  865.           END
  866.         ELSIF y.a0 = -1 THEN
  867.           x.mode := Con; x.a0 := -2; OCI.Load (x); OCI.Load (z);
  868.           OCC.Shift (OCC.LSL, L, z, x); OCC.PutF1 (OCC.NOT, L, x);
  869.           OCC.FreeReg (z)
  870.         ELSE
  871.           x := y; y.mode := Con; y.a0 := -2; OCI.Load (y); OCI.Load (z);
  872.           OCC.Shift (OCC.LSL, L, z, y); OCC.FreeReg (z);
  873.           OCC.PutF1 (OCC.NOT, L, y); OCI.Load (x);
  874.           OCC.PutF5 (OCC.AND, L, y, x); OCC.FreeReg (y)
  875.         END
  876.       ELSE
  877.         OCS.Mark (202)
  878.       END
  879.     ELSE
  880.       x.mode := Con; x.a0 := -1; OCI.Load (x); OCI.Load (y);
  881.       OCC.Shift (OCC.LSL, L, y, x); OCC.FreeReg (y);
  882.       y.mode := Con; y.typ := NIL;
  883.       IF z.mode = Con THEN
  884.         IF (0 <= z.a0) & (z.a0 < 32) THEN
  885.           s := -2;
  886.           y.a0 := SYS.VAL (LONGINT, allSet - SYS.VAL (SET, SYS.LSH(s, z.a0)));
  887.           OCC.PutF6 (OCC.ANDI, L, y, x)
  888.         ELSE
  889.           OCS.Mark (202)
  890.         END
  891.       ELSE
  892.         y.a0 := -2; OCI.Load (y); OCI.Load (z);
  893.         OCC.Shift (OCC.LSL, L, z, y); OCC.FreeReg (z);
  894.         OCC.PutF1 (OCC.NOT, L, y); OCC.PutF5 (OCC.AND, L, y, x);
  895.         OCC.FreeReg (y)
  896.       END
  897.     END (* ELSE *)
  898.   ELSE
  899.     OCS.Mark (93)
  900.   END
  901.   (* ;OCM.TraceOut (mname, pname); *)
  902. END Set1;
  903.  
  904. (*------------------------------------*)
  905. PROCEDURE MOp * (op : INTEGER; VAR x : OCT.Item);
  906.  
  907.   (* CONST pname = "MOp"; *)
  908.  
  909.   VAR f : INTEGER; a, opcode : LONGINT; y : OCT.Item; freeY : BOOLEAN;
  910.  
  911. BEGIN (* MOp *)
  912.   (* OCM.TraceIn (mname, pname); *)
  913.   f := x.typ.form;
  914.   CASE op OF
  915.     and :
  916.       IF (x.typ.form = Bool) & (x.mode = Con) THEN
  917.         IF x.a0 = 0 THEN setCC (x, OCC.F) ELSE setCC (x, OCC.T) END
  918.       END;
  919.       IF x.mode = Coc THEN
  920.         IF x.a0 # OCC.T THEN
  921.           IF x.a0 = OCC.F THEN opcode := OCC.BRA
  922.           ELSE opcode := OCC.Bcc + (OCC.invertedCC (x.a0) * 100H)
  923.           END;
  924.           OCC.PutWord (opcode); OCC.PutWord (x.a2); x.a2 := OCC.pc - 2
  925.         END;
  926.         OCC.FixLink (x.a1)
  927.       ELSIF x.typ.form = Bool THEN
  928.         test (x); OCC.PutWord (OCC.BEQ); OCC.PutWord (x.a2);
  929.         x.a2 := OCC.pc - 2; OCC.FixLink (x.a1)
  930.       ELSE
  931.         OCS.Mark (94); x.mode := Con; x.typ := OCT.booltyp; x.a0 := 0
  932.       END
  933.     |
  934.     plus :
  935.       IF ~(f IN intSet + realSet) THEN OCS.Mark (96) END
  936.     |
  937.     minus :
  938.       IF f IN intSet THEN
  939.         IF x.mode = Con THEN x.a0 := -x.a0; SetIntType (x)
  940.         ELSE OCI.Load (x); OCC.PutF1 (OCC.NEG, x.typ.size, x)
  941.         END
  942.       ELSIF f IN realSet THEN
  943.         NegReal (x)
  944.       ELSIF f IN setSet THEN
  945.         IF x.mode = Con THEN
  946.           x.a0 := SYS.VAL (LONGINT, allSet - SYS.VAL (SET, x.a0))
  947.         ELSE
  948.           OCI.Load (x); OCC.PutF1 (OCC.NOT, x.typ.size, x)
  949.         END
  950.       ELSE
  951.         OCS.Mark (97)
  952.       END
  953.     |
  954.     or :
  955.       IF (x.typ.form = Bool) & (x.mode = Con) THEN
  956.         IF x.a0 = 0 THEN setCC (x, OCC.F) ELSE setCC (x, OCC.T) END
  957.       END; (* IF *)
  958.       IF x.mode = Coc THEN
  959.         IF x.a0 # OCC.F THEN
  960.           IF x.a0 = OCC.T THEN opcode := OCC.BRA
  961.           ELSE opcode := OCC.Bcc + (x.a0 * 100H)
  962.           END;
  963.           OCC.PutWord (opcode); OCC.PutWord (x.a1);
  964.           x.a1 := OCC.pc - 2
  965.         END;
  966.         OCC.FixLink (x.a2)
  967.       ELSIF x.typ.form = Bool THEN
  968.         test (x); OCC.PutWord (OCC.BNE); OCC.PutWord (x.a1);
  969.         x.a1 := OCC.pc - 2; OCC.FixLink (x.a2)
  970.       ELSE
  971.         OCS.Mark (94); x.mode := Con; x.typ := OCT.booltyp; x.a0 := 1
  972.       END
  973.     |
  974.     eql .. geq : (* relations *)
  975.       IF x.mode = Coc THEN loadB (x) END
  976.     |
  977.     not :
  978.       IF x.typ.form = Bool THEN
  979.         IF x.mode = Con THEN
  980.           IF x.a0 = 0 THEN x.a0 := 1 ELSE x.a0 := 0 END
  981.         ELSIF x.mode = Coc THEN
  982.           x.a0 := OCC.invertedCC (x.a0); a := x.a1; x.a1 := x.a2;
  983.           x.a2 := SHORT (a)
  984.         ELSE
  985.           y := x;
  986.           OCC.PutF1 (OCC.TST, B, y); setCC (x, OCC.EQ);
  987.         END
  988.       ELSE
  989.         OCS.Mark (98)
  990.       END
  991.     |
  992.   ELSE
  993.     OCS.Mark (1010); OCS.Mark (op)
  994.   END; (* CASE op *)
  995.   (* ;OCM.TraceOut (mname, pname); *)
  996. END MOp;
  997.  
  998. (*------------------------------------*)
  999. PROCEDURE CheckOverflow (op : INTEGER; VAR lhs, rhs : OCT.Item);
  1000.  
  1001.   (* CONST pname = "CheckOverflow"; *)
  1002.  
  1003.   CONST min = OCM.MinLInt; max = OCM.MaxLInt;
  1004.  
  1005. BEGIN (* CheckOverflow *)
  1006.   (* OCM.TraceIn (mname, pname); *)
  1007.   CASE op OF
  1008.     times :
  1009.       IF lhs.a0 < 0 THEN
  1010.         IF (rhs.a0 < 0) & (lhs.a0 < max DIV rhs.a0) THEN
  1011.           OCS.Mark (109); rhs.a0 := -1
  1012.         ELSIF (rhs.a0 > 0) & (lhs.a0 < min DIV rhs.a0) THEN
  1013.           OCS.Mark (109); rhs.a0 := 1
  1014.         END
  1015.       ELSE
  1016.         IF (rhs.a0 < 0) & (lhs.a0 > min DIV rhs.a0) THEN
  1017.           OCS.Mark (109); rhs.a0 := -1
  1018.         ELSIF (rhs.a0 > 0) & (lhs.a0 > max DIV rhs.a0) THEN
  1019.           OCS.Mark (109); rhs.a0 := 1
  1020.         END
  1021.       END
  1022.     |
  1023.     plus :
  1024.       IF lhs.a0 < 0 THEN
  1025.         IF (rhs.a0 < 0) & (lhs.a0 < min - rhs.a0) THEN
  1026.           OCS.Mark (109); rhs.a0 := 0
  1027.         END
  1028.       ELSE
  1029.         IF (rhs.a0 > 0) & (lhs.a0 > max - rhs.a0) THEN
  1030.           OCS.Mark (109); rhs.a0 := 0
  1031.         END
  1032.       END
  1033.     |
  1034.     minus :
  1035.       IF lhs.a0 < 0 THEN
  1036.         IF (rhs.a0 > 0) & (lhs.a0 < min + rhs.a0) THEN
  1037.           OCS.Mark (109); rhs.a0 := 0
  1038.         END
  1039.       ELSE
  1040.         IF (rhs.a0 < 0) & (lhs.a0 > max + rhs.a0) THEN
  1041.           OCS.Mark (109); rhs.a0 := 0
  1042.         END
  1043.       END
  1044.     |
  1045.   ELSE
  1046.     OCS.Mark (1011); OCS.Mark (op)
  1047.   END; (* CASE op *)
  1048.   (* ;OCM.TraceOut (mname, pname); *)
  1049. END CheckOverflow;
  1050.  
  1051. (*------------------------------------*)
  1052. PROCEDURE Op * (op : INTEGER; VAR lhs, rhs : OCT.Item; freeRegs : BOOLEAN);
  1053.  
  1054.   (* CONST pname = "Op"; *)
  1055.  
  1056.   CONST
  1057.     eqSet = { Undef, Char .. LInt, BSet .. Set,
  1058.               NilTyp, PtrTyp .. ProcTyp, TagTyp };
  1059.     nilSet = { Pointer, PtrTyp, AdrTyp, BPtrTyp, ProcTyp, TagTyp };
  1060.  
  1061.   VAR f, g : INTEGER; p, q, r : OCT.Struct; size : LONGINT;
  1062.  
  1063.   (*------------------------------------*)
  1064.   PROCEDURE strings () : BOOLEAN;
  1065.  
  1066.   BEGIN (* strings *)
  1067.     RETURN
  1068.       ((((f = Array) OR (f = DynArr)) & (lhs.typ.BaseTyp.form = Char))
  1069.        OR (f = String))
  1070.       & ((((g = Array) OR (g = DynArr)) & (rhs.typ.BaseTyp.form = Char))
  1071.        OR (g = String))
  1072.   END strings;
  1073.  
  1074.   (*------------------------------------*)
  1075.   PROCEDURE CompStrings (cc : INTEGER; testNul : BOOLEAN);
  1076.  
  1077.     (* CONST pname = "CompStrings"; *)
  1078.  
  1079.     VAR br, len, ch : OCT.Item; L0, L1 : INTEGER; d : OCT.Desc;
  1080.  
  1081.   BEGIN (* CompStrings *)
  1082.     (* OCM.TraceIn (mname, pname); *)
  1083.     IF (g = String) & (rhs.a1 = 1) THEN
  1084.       IF (f = String) & (lhs.a1 <= 2) THEN
  1085.         OCC.AllocStringFromChar (lhs)
  1086.       END;
  1087.       IF cc = OCC.CS THEN setCC (lhs, OCC.F)
  1088.       ELSIF cc = OCC.CC THEN setCC (lhs, OCC.T)
  1089.       ELSE
  1090.         IF (f = DynArr) & (lhs.mode = Var) THEN lhs.mode := Ind END;
  1091.         OCC.PutF1 (OCC.TST, B, lhs);               (*    TST.B   <lhs>    *)
  1092.         OCI.Unload (lhs); setCC (lhs, cc)
  1093.       END
  1094.     ELSIF (f = String) & (lhs.a1 = 1) THEN
  1095.       IF cc = OCC.CS THEN cc := OCC.HI
  1096.       ELSIF cc = OCC.HI THEN cc := OCC.CS
  1097.       ELSIF cc = OCC.CC THEN cc := OCC.LS
  1098.       ELSIF cc = OCC.LS THEN cc := OCC.CC
  1099.       END;
  1100.       IF cc = OCC.CS THEN setCC (lhs, OCC.F)
  1101.       ELSIF cc = OCC.CC THEN setCC (lhs, OCC.T)
  1102.       ELSE
  1103.         IF (g = DynArr) & (rhs.mode = Var) THEN rhs.mode := Ind END;
  1104.         OCC.PutF1 (OCC.TST, B, rhs);               (*    TST.B   <rhs>    *)
  1105.         setCC (lhs, cc)
  1106.       END
  1107.     ELSE
  1108.       IF f = String THEN
  1109.         IF lhs.a1 = 2 THEN OCC.AllocStringFromChar (lhs) END;
  1110.         len.mode := Con; len.a0 := lhs.a1 - 1; len.typ := OCT.inttyp
  1111.       ELSIF f = DynArr THEN
  1112.         OCI.DescItem (len, lhs.desc, lhs.typ.adr)
  1113.       ELSE
  1114.         len.mode := Con; len.a0 := lhs.typ.n - 1; len.typ := OCT.inttyp
  1115.       END;
  1116.       IF (g = String) & (rhs.a1 = 2) THEN OCC.AllocStringFromChar (rhs) END;
  1117.       OCI.Load (len);                              (*    MOVE.Z  <len>,Dc *)
  1118.       OCI.LoadAdr (lhs); lhs.mode := Pop;          (*    LEA     <lhs>,Aa *)
  1119.       OCI.LoadAdr (rhs); rhs.mode := Pop;          (*    LEA     <rhs>,Ab *)
  1120.       OCC.GetDReg (ch); OCC.Move (B, lhs, ch);     (*    MOVE.B  (Aa)+,Dd *)
  1121.       OCC.PutF5 (OCC.CMP, B, rhs, ch);             (*    CMP.B   (Ab)+,Dd *)
  1122.       L0 := OCC.pc; OCC.PutWord (6600H);           (* 1$ BNE.S   2$       *)
  1123.       OCC.PutF1 (OCC.TST, B, ch);                  (*    TST.B   Dd       *)
  1124.       L1 := OCC.pc; OCC.PutWord (6700H);           (*    BEQ.S   2$       *)
  1125.       OCC.PutWord (OCC.DBF + len.a0);
  1126.       OCC.PutWord (-12);                           (*    DBF.W   Dc,1$    *)
  1127.       IF testNul THEN
  1128.         lhs.mode := RegI; lhs.a1 := 0;
  1129.         OCC.PutF1 (OCC.TST, B, lhs);               (*    TST.B   (Aa)     *)
  1130.       END;                                         (* 2$                  *)
  1131.       OCC.PatchWord (L0, OCC.pc - L0 - 2);
  1132.       OCC.PatchWord (L1, OCC.pc - L1 - 2);
  1133.       OCI.Unload (lhs); OCI.Unload (len); OCI.Unload (ch);
  1134.       setCC (lhs, cc)
  1135.     END
  1136.     (* ;OCM.TraceOut (mname, pname); *)
  1137.   END CompStrings;
  1138.  
  1139.   (*------------------------------------*)
  1140.   PROCEDURE CompBool (cc : LONGINT);
  1141.  
  1142.     (* CONST pname = "CompBool"; *)
  1143.     VAR swap : OCT.Item; result : BOOLEAN;
  1144.  
  1145.   BEGIN (* CompBool *)
  1146.     (* OCM.TraceIn (mname, pname); *)
  1147.  
  1148.     IF (lhs.mode = Con) & (rhs.mode = Con) THEN
  1149.       IF cc = OCC.EQ THEN result := (lhs.a0 = rhs.a0)
  1150.       ELSE result := (lhs.a0 # rhs.a0)
  1151.       END;
  1152.       IF result THEN setCC (lhs, OCC.T)
  1153.       ELSE setCC (lhs, OCC.F)
  1154.       END;
  1155.     ELSE
  1156.       IF lhs.mode = Con THEN (* swap operands *)
  1157.         swap := rhs; rhs := lhs; lhs := swap
  1158.       END;
  1159.       IF rhs.mode = Coc THEN loadB (rhs)
  1160.       ELSIF (rhs.mode = Con) & (rhs.a0 # 0) THEN
  1161.         (* Comparing with TRUE.
  1162.         ** Invert the CC so that a TST can be used.
  1163.         *)
  1164.         cc := OCC.invertedCC (cc); rhs.a0 := 0
  1165.       END;
  1166.       cmp (lhs, rhs, freeRegs); setCC (lhs, cc)
  1167.     END; (* IF *)
  1168.  
  1169.     (* ;OCM.TraceOut (mname, pname); *)
  1170.   END CompBool;
  1171.  
  1172. BEGIN (* Op *)
  1173.   (* OCM.TraceIn (mname, pname); *)
  1174.   IF lhs.typ # rhs.typ THEN
  1175.     f := lhs.typ.form; g := rhs.typ.form;
  1176.     CASE f OF
  1177.       Undef :
  1178.       |
  1179.       SInt :
  1180.         IF g = Int THEN      ConvertInts (lhs, rhs.typ)
  1181.         ELSIF g = LInt THEN  ConvertInts (lhs, rhs.typ)
  1182.         ELSIF g = Real THEN  ConvertReals (lhs, rhs.typ)
  1183.         ELSIF g = LReal THEN ConvertReals (lhs, rhs.typ)
  1184.         ELSE OCS.Mark (100)
  1185.         END
  1186.       |
  1187.       Int :
  1188.         IF g = SInt THEN    ConvertInts (rhs, lhs.typ)
  1189.         ELSIF g = LInt THEN ConvertInts (lhs, rhs.typ)
  1190.         ELSIF g = Real THEN  ConvertReals (lhs, rhs.typ)
  1191.         ELSIF g = LReal THEN ConvertReals (lhs, rhs.typ)
  1192.         ELSE OCS.Mark (100)
  1193.         END
  1194.       |
  1195.       LInt :
  1196.         IF g = SInt THEN   ConvertInts (rhs, lhs.typ)
  1197.         ELSIF g = Int THEN ConvertInts (rhs, lhs.typ)
  1198.         ELSIF g = Real THEN  ConvertReals (lhs, rhs.typ)
  1199.         ELSIF g = LReal THEN ConvertReals (lhs, rhs.typ)
  1200.         ELSE OCS.Mark (100)
  1201.         END
  1202.       |
  1203.       Real :
  1204.         IF g IN intSet THEN  ConvertReals (rhs, lhs.typ)
  1205.         ELSIF g = LReal THEN ConvertReals (lhs, rhs.typ)
  1206.         ELSE OCS.Mark (100)
  1207.         END
  1208.       |
  1209.       LReal :
  1210.         IF g IN intSet THEN ConvertReals (rhs, lhs.typ)
  1211.         ELSIF g = Real THEN ConvertReals (rhs, lhs.typ)
  1212.         ELSE OCS.Mark (100)
  1213.         END
  1214.       |
  1215.       BSet, WSet, Set :
  1216.         IF g IN setSet THEN
  1217.           IF (lhs.mode = Con) & (rhs.mode = Con) THEN
  1218.             IF g >= f THEN lhs.typ := rhs.typ
  1219.             ELSE rhs.typ := lhs.typ
  1220.             END
  1221.           ELSIF lhs.mode = Con THEN
  1222.             SetSetType (lhs);
  1223.             IF g >= lhs.typ.form THEN lhs.typ := rhs.typ
  1224.             ELSE OCS.Mark (100)
  1225.             END
  1226.           ELSIF rhs.mode = Con THEN
  1227.             SetSetType (rhs);
  1228.             IF f >= rhs.typ.form THEN rhs.typ := lhs.typ
  1229.             ELSE OCS.Mark (100)
  1230.             END
  1231.           ELSE OCS.Mark (100)
  1232.           END
  1233.         ELSE OCS.Mark (100)
  1234.         END
  1235.       |
  1236.       NilTyp :
  1237.         IF ~(g IN nilSet) THEN OCS.Mark (100) END
  1238.       |
  1239.       Pointer :
  1240.         IF (g = Pointer) & (OCT.Tagged (lhs.typ) = OCT.Tagged (rhs.typ)) THEN
  1241.           p := lhs.typ.BaseTyp; q := rhs.typ.BaseTyp;
  1242.           IF (p.form = Record) & (q.form = Record) THEN
  1243.             IF p.n < q.n THEN r := p; p := q; q := r END;
  1244.             WHILE (p # q) & (p # NIL) DO p := p.BaseTyp END;
  1245.             IF p = NIL THEN OCS.Mark (100) END
  1246.           ELSE
  1247.             OCS.Mark (100)
  1248.           END
  1249.         ELSIF OCT.Address (lhs.typ) THEN
  1250.           IF ~(g IN {AdrTyp, NilTyp}) THEN OCS.Mark (100) END
  1251.         ELSIF g # NilTyp THEN
  1252.           OCS.Mark (100)
  1253.         END
  1254.       |
  1255.       AdrTyp :
  1256.         IF ~OCT.Address (rhs.typ) THEN OCS.Mark (100) END
  1257.       |
  1258.       PtrTyp, BPtrTyp, ProcTyp, TagTyp :
  1259.         IF g # NilTyp THEN OCS.Mark (100) END
  1260.       |
  1261.       Char :
  1262.         IF (g = String) & (rhs.a1 <= 2) THEN
  1263.           rhs.a0 := rhs.a2; rhs.typ := OCT.chartyp; g := Char
  1264.         ELSE OCS.Mark (100)
  1265.         END
  1266.       |
  1267.       String :
  1268.         IF (g = Char) & (lhs.a1 <= 2) THEN
  1269.           lhs.a0 := lhs.a2; lhs.typ := OCT.chartyp; f := Char
  1270.         ELSIF (g = String) & (lhs.a1 <= 2) & (rhs.a1 <= 2) THEN
  1271.           lhs.a0 := lhs.a2; lhs.typ := OCT.chartyp; f := Char;
  1272.           rhs.a0 := rhs.a2; rhs.typ := OCT.chartyp; g := Char
  1273.         END
  1274.       |
  1275.       Byte, Bool, NoTyp, Record, Word, Longword :
  1276.         OCS.Mark (100);
  1277.       |
  1278.       Array, DynArr :
  1279.       |
  1280.     ELSE
  1281.       OCS.Mark (1012); OCS.Mark (f)
  1282.     END; (* CASE f *)
  1283.   END; (* IF *)
  1284.  
  1285.   f := lhs.typ.form; g := rhs.typ.form; size := lhs.typ.size;
  1286.   IF lhs.mode = RList THEN (* lhs is a function procedure result *)
  1287.     IF f # Pointer THEN OCS.Mark (956) END;
  1288.     OCC.FreeReg (lhs); lhs.mode := Reg; lhs.a0 := D0; OCC.ReserveReg (D0)
  1289.   END;
  1290.   IF rhs.mode = RList THEN (* rhs is a function procedure result *)
  1291.     IF f # Pointer THEN OCS.Mark (956) END;
  1292.     OCC.FreeReg (rhs); rhs.mode := Reg; rhs.a0 := D0; OCC.ReserveReg (D0)
  1293.   END;
  1294.  
  1295.   CASE op OF
  1296.     times :
  1297.       IF f IN intSet THEN
  1298.         IF (lhs.mode = Con) & (rhs.mode = Con) THEN
  1299.           CheckOverflow (times, lhs, rhs);
  1300.           lhs.a0 := lhs.a0 * rhs.a0; SetIntType (lhs)
  1301.         ELSE
  1302.           MultiplyInts (lhs, rhs, size, freeRegs)
  1303.         END
  1304.       ELSIF f IN realSet THEN
  1305.         RealMath (times, lhs, rhs)
  1306.       ELSIF f IN setSet THEN
  1307.         IF (lhs.mode = Con) & (rhs.mode = Con) THEN
  1308.           lhs.a0 :=
  1309.             SYS.VAL (LONGINT, SYS.VAL (SET, lhs.a0) * SYS.VAL (SET, rhs.a0))
  1310.         ELSIF lhs.mode = Con THEN
  1311.           OCI.Load (rhs); OCC.PutF6 (OCC.ANDI, size, lhs, rhs); lhs := rhs;
  1312.           rhs.mode := Undef
  1313.         ELSE
  1314.           OCI.Load (lhs); OCC.PutF5 (OCC.AND, size, rhs, lhs)
  1315.         END
  1316.       ELSIF f # Undef THEN OCS.Mark (101)
  1317.       END
  1318.     |
  1319.     slash :
  1320.       IF f IN realSet THEN
  1321.         RealMath (slash, lhs, rhs)
  1322.       ELSIF f IN intSet THEN
  1323.         ConvertReals (lhs, OCT.realtyp); ConvertReals (rhs, OCT.realtyp);
  1324.         RealMath (slash, lhs, rhs)
  1325.       ELSIF f IN setSet THEN
  1326.         IF (lhs.mode = Con) & (rhs.mode = Con) THEN
  1327.           lhs.a0 :=
  1328.             SYS.VAL (LONGINT, SYS.VAL (SET, lhs.a0) / SYS.VAL (SET, rhs.a0))
  1329.         ELSIF rhs.mode = Con THEN
  1330.           OCI.Load (lhs); OCC.PutF6 (OCC.EORI, size, rhs, lhs)
  1331.         ELSIF lhs.mode = Con THEN
  1332.           OCI.Load (rhs); OCC.PutF6 (OCC.EORI, size, lhs, rhs);
  1333.           lhs := rhs; rhs.mode := Undef
  1334.         ELSE
  1335.           OCI.Load (lhs); OCI.Load (rhs);
  1336.           OCC.PutF5 (OCC.EOR, size, rhs, lhs)
  1337.         END
  1338.       ELSIF f # Undef THEN OCS.Mark (102)
  1339.       END
  1340.     |
  1341.     div :
  1342.       IF f IN intSet THEN
  1343.         IF (rhs.mode = Con) & (rhs.a0 = 0) THEN
  1344.           OCS.Mark (205); rhs.a0 := 1
  1345.         END;
  1346.         IF (lhs.mode = Con) & (rhs.mode = Con) THEN
  1347.           lhs.a0 := lhs.a0 DIV rhs.a0; SetIntType (lhs);
  1348.         ELSE
  1349.           DivideInts (lhs, rhs, size, freeRegs);
  1350.         END
  1351.       ELSIF f # Undef THEN OCS.Mark (103)
  1352.       END
  1353.     |
  1354.     mod :
  1355.       IF f IN intSet THEN
  1356.         IF (rhs.mode = Con) & (rhs.a0 = 0) THEN
  1357.           OCS.Mark (205); rhs.a0 := 1
  1358.         END;
  1359.         IF (lhs.mode = Con) & (rhs.mode = Con) THEN
  1360.           lhs.a0 := lhs.a0 MOD rhs.a0; lhs.typ := rhs.typ
  1361.         ELSE
  1362.           ModulusInts (lhs, rhs, size, freeRegs)
  1363.         END
  1364.       ELSIF f # Undef THEN OCS.Mark (104)
  1365.       END
  1366.     |
  1367.     and :
  1368.       IF rhs.mode # Coc THEN
  1369.         IF rhs.mode = Con THEN
  1370.           IF rhs.a0 = 1 THEN setCC (rhs, OCC.T) ELSE setCC (rhs, OCC.F) END
  1371.         ELSIF rhs.mode <= Reg THEN test (rhs);
  1372.         ELSE OCS.Mark (94); setCC (rhs, OCC.EQ)
  1373.         END
  1374.       END;
  1375.       IF lhs.mode = Con THEN
  1376.         IF lhs.a0 = 0 THEN
  1377.           OCC.FixLink (rhs.a1); OCC.FixLink (rhs.a2); setCC (rhs, OCC.F)
  1378.         END;
  1379.         setCC (lhs, OCC.EQ)
  1380.       END;
  1381.       IF rhs.a2 # 0 THEN lhs.a2 := SHORT (OCC.MergedLinks (lhs.a2, rhs.a2))
  1382.       END;
  1383.       lhs.a0 := rhs.a0; lhs.a1 := rhs.a1
  1384.     |
  1385.     plus :
  1386.       IF f IN intSet THEN
  1387.         IF (lhs.mode = Con) & (rhs.mode = Con) THEN
  1388.           CheckOverflow (plus, lhs, rhs); INC (lhs.a0, rhs.a0);
  1389.           SetIntType (lhs)
  1390.         ELSE
  1391.           OCI.Load (lhs); OCC.PutF5 (OCC.ADD, size, rhs, lhs);
  1392.           IF OCS.pragma [OCS.ovflChk] THEN OCC.Trap (OCC.OverflowCheck) END
  1393.         END
  1394.       ELSIF f IN realSet THEN
  1395.         RealMath (plus, lhs, rhs)
  1396.       ELSIF f IN setSet THEN
  1397.         IF (lhs.mode = Con) & (rhs.mode = Con) THEN
  1398.           lhs.a0 :=
  1399.             SYS.VAL (LONGINT, SYS.VAL (SET, lhs.a0) + SYS.VAL (SET, rhs.a0))
  1400.         ELSIF lhs.mode = Con THEN
  1401.           OCI.Load (rhs); OCC.PutF6 (OCC.ORI, size, lhs, rhs); lhs := rhs;
  1402.           rhs.mode := Undef
  1403.         ELSE
  1404.           OCI.Load (lhs); OCC.PutF5 (OCC.iOR, size, rhs, lhs)
  1405.         END
  1406.       ELSIF f # Undef THEN OCS.Mark (105)
  1407.       END
  1408.     |
  1409.     minus :
  1410.       IF f IN intSet THEN
  1411.         IF (lhs.mode = Con) & (rhs.mode = Con) THEN
  1412.           CheckOverflow (minus, lhs, rhs); DEC (lhs.a0, rhs.a0);
  1413.           SetIntType (lhs)
  1414.         ELSE
  1415.           OCI.Load (lhs); OCC.PutF5 (OCC.SUB, size, rhs, lhs);
  1416.           IF OCS.pragma [OCS.ovflChk] THEN OCC.Trap (OCC.OverflowCheck) END
  1417.         END
  1418.       ELSIF f IN realSet THEN
  1419.         RealMath (minus, lhs, rhs)
  1420.       ELSIF f IN setSet THEN
  1421.         IF (lhs.mode = Con) & (rhs.mode = Con) THEN
  1422.           lhs.a0 :=
  1423.             SYS.VAL (LONGINT, SYS.VAL (SET, lhs.a0) - SYS.VAL (SET, rhs.a0));
  1424.         ELSIF rhs.mode = Con THEN
  1425.           rhs.a0 := SYS.VAL (LONGINT, allSet - SYS.VAL (SET, rhs.a0));
  1426.           OCI.Load (lhs); OCC.PutF6 (OCC.ANDI, size, rhs, lhs)
  1427.         ELSIF lhs.mode = Con THEN
  1428.           OCI.Load (rhs); OCC.PutF1 (OCC.NOT, size, rhs);
  1429.           IF ~(lhs.a0 = -1) THEN OCC.PutF6 (OCC.ANDI, size, lhs, rhs) END;
  1430.           lhs := rhs; rhs.mode := Undef
  1431.         ELSE
  1432.           OCI.Load (lhs); OCI.Load (rhs); OCC.PutF1 (OCC.NOT, size, rhs);
  1433.           OCC.PutF5 (OCC.AND, size, rhs, lhs)
  1434.         END
  1435.       ELSIF f # Undef THEN OCS.Mark (106)
  1436.       END
  1437.     |
  1438.     or :
  1439.       IF rhs.mode # Coc THEN
  1440.         IF rhs.mode = Con THEN
  1441.           IF rhs.a0 = 1 THEN setCC (rhs, OCC.T) ELSE setCC (rhs, OCC.F) END
  1442.         ELSIF rhs.mode <= Reg THEN test (rhs)
  1443.         ELSE OCS.Mark (95); setCC (rhs, OCC.EQ)
  1444.         END
  1445.       END;
  1446.       IF lhs.mode = Con THEN
  1447.         IF lhs.a0 = 1 THEN
  1448.           OCC.FixLink (rhs.a1); OCC.FixLink (rhs.a2); setCC (rhs, OCC.T)
  1449.         END;
  1450.         setCC (lhs, OCC.EQ)
  1451.       END;
  1452.       IF rhs.a1 # 0 THEN lhs.a1 := OCC.MergedLinks (lhs.a1, rhs.a1) END;
  1453.       lhs.a0 := rhs.a0; lhs.a2 := rhs.a2
  1454.     |
  1455.     eql :
  1456.       IF f IN eqSet THEN cmp (lhs, rhs, freeRegs); setCC (lhs, OCC.EQ)
  1457.       ELSIF f IN realSet THEN CmpReals (lhs, rhs); setCC (lhs, OCC.EQ)
  1458.       ELSIF f = Bool THEN CompBool (OCC.EQ)
  1459.       ELSIF strings () THEN CompStrings (OCC.EQ, TRUE)
  1460.       ELSE OCS.Mark (107)
  1461.       END
  1462.     |
  1463.     neq :
  1464.       IF f IN eqSet THEN cmp (lhs, rhs, freeRegs); setCC (lhs, OCC.NE)
  1465.       ELSIF f IN realSet THEN CmpReals (lhs, rhs); setCC (lhs, OCC.NE)
  1466.       ELSIF f = Bool THEN CompBool (OCC.NE)
  1467.       ELSIF strings () THEN CompStrings (OCC.NE, TRUE)
  1468.       ELSE OCS.Mark (107)
  1469.       END
  1470.     |
  1471.     lss :
  1472.       IF f IN intSet THEN cmp (lhs, rhs, freeRegs); setCC (lhs, OCC.LT)
  1473.       ELSIF f = Char THEN cmp (lhs, rhs, freeRegs); setCC (lhs, OCC.CS)
  1474.       ELSIF f IN realSet THEN CmpReals (lhs, rhs); setCC (lhs, OCC.LT)
  1475.       ELSIF strings () THEN CompStrings (OCC.CS, FALSE)
  1476.       ELSE OCS.Mark (108)
  1477.       END
  1478.     |
  1479.     leq :
  1480.       IF f IN intSet THEN cmp (lhs, rhs, freeRegs); setCC (lhs, OCC.LE)
  1481.       ELSIF f = Char THEN cmp (lhs, rhs, freeRegs); setCC (lhs, OCC.LS)
  1482.       ELSIF f IN realSet THEN CmpReals (lhs, rhs); setCC (lhs, OCC.LE)
  1483.       ELSIF strings () THEN CompStrings (OCC.LS, TRUE)
  1484.       ELSE OCS.Mark (108)
  1485.       END
  1486.     |
  1487.     gtr :
  1488.       IF f IN intSet THEN cmp (lhs, rhs, freeRegs); setCC (lhs, OCC.GT)
  1489.       ELSIF f = Char THEN cmp (lhs, rhs, freeRegs); setCC (lhs, OCC.HI)
  1490.       ELSIF f IN realSet THEN CmpReals (lhs, rhs); setCC (lhs, OCC.GT)
  1491.       ELSIF strings () THEN CompStrings (OCC.HI, TRUE)
  1492.       ELSE OCS.Mark (108)
  1493.       END
  1494.     |
  1495.     geq :
  1496.       IF f IN intSet THEN cmp (lhs, rhs, freeRegs); setCC (lhs, OCC.GE)
  1497.       ELSIF f = Char THEN cmp (lhs, rhs, freeRegs); setCC (lhs, OCC.CC)
  1498.       ELSIF f IN realSet THEN CmpReals (lhs, rhs); setCC (lhs, OCC.GE)
  1499.       ELSIF strings () THEN CompStrings (OCC.CC, FALSE)
  1500.       ELSE OCS.Mark (108)
  1501.       END
  1502.     |
  1503.   ELSE
  1504.     OCS.Mark (1013); OCS.Mark (op)
  1505.   END; (* CASE op *)
  1506.  
  1507.   IF freeRegs THEN OCI.Unload (rhs) END;
  1508.   (* ;OCM.TraceOut (mname, pname); *)
  1509. END Op;
  1510.  
  1511. END OCE.
  1512.  
  1513. (***************************************************************************
  1514.  
  1515.   $Log: OCE.mod $
  1516.   Revision 5.9.1.1  1995/03/08  19:01:25  fjc
  1517.   - OC 5.22
  1518.  
  1519.   Revision 5.9  1995/02/21  11:56:58  fjc
  1520.   - Release 1.5 update 2
  1521.  
  1522.   Revision 5.8  1995/01/26  00:17:17  fjc
  1523.   - Release 1.5
  1524.  
  1525.   Revision 5.7  1995/01/03  21:19:32  fjc
  1526.   - Changed OCG to OCM.
  1527.  
  1528.   Revision 5.6  1994/12/16  17:29:27  fjc
  1529.   - Changed Symbol to Label.
  1530.   - Minor modifications to type tests.
  1531.  
  1532.   Revision 5.5  1994/10/23  16:10:52  fjc
  1533.   - All calls to the RTS now made through OCC.CallKernel().
  1534.  
  1535.   Revision 5.4  1994/09/25  17:49:43  fjc
  1536.   - Changed to reflect new object modes and system flags.
  1537.  
  1538.   Revision 5.3  1994/09/15  10:33:02  fjc
  1539.   - Replaced switches with pragmas.
  1540.   - Fixed register reservation bug in DeRef when NIL checking.
  1541.     was on.
  1542.  
  1543.   Revision 5.2  1994/09/08  10:49:29  fjc
  1544.   - Changed to use pragmas/options.
  1545.  
  1546.   Revision 5.1  1994/09/03  19:29:08  fjc
  1547.   - Bumped version number
  1548.  
  1549. ***************************************************************************)
  1550.