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