home *** CD-ROM | disk | FTP | other *** search
/ Gold Fish 3 / goldfish_volume_3.bin / files / dev / obero / oberon-a / source / oc / oci.mod < prev    next >
Encoding:
Text File  |  1995-06-29  |  13.2 KB  |  447 lines
  1. (*************************************************************************
  2.  
  3.      $RCSfile: OCI.mod $
  4.   Description: Common routines used by modules OCE, OCP, OCH and Compiler
  5.  
  6.    Created by: fjc (Frank Copeland)
  7.     $Revision: 5.17 $
  8.       $Author: fjc $
  9.         $Date: 1995/06/02 18:38:40 $
  10.  
  11.   Copyright © 1993-1995, Frank Copeland
  12.   This module forms part of the OC program
  13.   See OC.doc for conditions of use and distribution
  14.  
  15.   Log entries are at the end of the file.
  16.  
  17. *************************************************************************)
  18.  
  19. <* STANDARD- *> <* MAIN- *> <*$ LongVars+ *>
  20.  
  21. MODULE OCI;
  22.  
  23. IMPORT OCM, OCS, OCT, OCC;
  24.  
  25. (* --- Local declarations --------------------------------------------- *)
  26.  
  27. CONST
  28.  
  29.   (* object modes *)
  30.  
  31.   Var = OCM.Var; VarR = OCM.VarR; VarX = OCM.VarX; Ind = OCM.Ind;
  32.   IndR = OCM.IndR; IndX = OCM.IndX; RegI = OCM.RegI; RegX = OCM.RegX;
  33.   Lab = OCM.Lab; LabI = OCM.LabI; Con = OCM.Con; Push = OCM.Push;
  34.   Pop = OCM.Pop; Coc = OCM.Coc; Reg = OCM.Reg; Fld = OCM.Fld;
  35.   Typ = OCM.Typ; Abs = OCM.Abs; XProc = OCM.XProc; LProc = OCM.LProc;
  36.   Undef = OCM.Undef; CallBack = OCM.CallBack;
  37.  
  38.   addressableSet =
  39.     { Var, VarX, Ind, IndR, IndX, Reg, RegI, RegX, Con, XProc, LProc,
  40.       CallBack };
  41.  
  42.   (* structure forms *)
  43.  
  44.   Char = OCT.Char; DynArr = OCT.DynArr; String = OCT.String;
  45.   TagTyp = OCT.TagTyp;
  46.  
  47.   (* CPU Registers *)
  48.  
  49.   D0 = 0; D1 = 1; D7 = 7; A0 = 8; A3 = 11; A4 = 12; A5 = 13; A6 = 14;
  50.   A7 = 15; BP = A4 - 8; FP = A5 - 8; SP = A7 - 8;
  51.   DataRegs = {D0 .. D7};
  52.   AdrRegs = {A0 .. A7};
  53.  
  54.   (* Data sizes *)
  55.  
  56.   B = 1; W = 2; L = 4;
  57.  
  58. (* --- Procedure declarations ------------------------------------------- *)
  59.  
  60. (*------------------------------------*)
  61. (*
  62.   Explicitly frees any registers used by x
  63. *)
  64. PROCEDURE Unload * (VAR x : OCT.Item);
  65.  
  66. BEGIN (* Unload *)
  67.   IF x.mode IN {VarX, IndX, Reg, RegI, RegX, Push, Pop} THEN
  68.     OCC.FreeReg (x);
  69.   END
  70. END Unload;
  71.  
  72. (*------------------------------------*)
  73. PROCEDURE Load * (VAR x : OCT.Item);
  74.  
  75.   VAR y : OCT.Item;
  76.  
  77. BEGIN (* Load *)
  78.   IF x.mode < Reg THEN
  79.     IF OCC.InDataReg (x.obj) THEN OCC.GetDReg (x, x.obj)
  80.     ELSE
  81.       y := x; OCC.GetDReg (x, x.obj); OCC.Move (y.typ.size, y, x);
  82.       Unload (y)
  83.     END;
  84.   ELSIF x.mode > Reg THEN OCS.Mark (126)
  85.   END
  86. END Load;
  87.  
  88. (*------------------------------------*)
  89. PROCEDURE EXT * (size, reg : LONGINT);
  90.  
  91. BEGIN (* EXT *)
  92.   (* OCM.TraceIn (mname, pname); *)
  93.   IF size = L THEN OCC.PutWord (OCC.EXTL + reg)
  94.   ELSE OCC.PutWord (OCC.EXTW + reg)
  95.   END
  96. END EXT;
  97.  
  98. (*------------------------------------*)
  99. PROCEDURE DescItem * (VAR item : OCT.Item; desc : OCT.Desc; adr : LONGINT);
  100.  
  101. BEGIN (* DescItem *)
  102.   IF desc = NIL THEN
  103.     OCS.Mark (963);
  104.     item.lev := 0; item.mode := Var;
  105.     item.a0 := 0; item.a1 := 0; item.a2 := 0
  106.   ELSE
  107.     (* item = bound descr *)
  108.     item.lev := desc.lev; item.mode := desc.mode; item.a0 := desc.a0;
  109.     item.a1 := desc.a1; item.a2 := desc.a2;
  110.     IF item.mode IN {Var, VarR, VarX} THEN INC (item.a0, adr)
  111.     ELSIF item.mode IN {Ind, IndR, IndX, RegI, RegX} THEN INC (item.a1, adr)
  112.     ELSE OCS.Mark (322)
  113.     END
  114.   END;
  115.   item.desc := desc; item.typ := OCT.linttyp; item.wordIndex := FALSE
  116. END DescItem;
  117.  
  118. (*------------------------------------*)
  119. PROCEDURE UpdateDesc * (VAR x : OCT.Item; adr : LONGINT);
  120.  
  121.   VAR desc : OCT.Desc;
  122.  
  123. BEGIN (* UpdateDesc *)
  124.   desc := x.desc;
  125.   IF desc # NIL THEN
  126.     desc.lev := x.lev; desc.mode := x.mode; desc.a0 := x.a0;
  127.     desc.a1 := x.a1; desc.a2 := x.a2;
  128.     IF desc.mode IN {Var, VarX} THEN DEC (desc.a0, adr)
  129.     ELSIF desc.mode IN {Ind, IndR, IndX, RegI, RegX} THEN DEC (desc.a1, adr)
  130.     ELSE OCS.Mark (322)
  131.     END
  132.   END
  133. END UpdateDesc;
  134.  
  135. (*------------------------------------*)
  136. PROCEDURE UnloadDesc * (VAR x : OCT.Item);
  137.  
  138.   VAR desc : OCT.Desc; reg : OCT.Item;
  139.  
  140. BEGIN (* UnloadDesc *)
  141.   desc := x.desc;
  142.   IF desc # NIL THEN
  143.     IF desc.mode IN {VarX, IndX, RegI, RegX} THEN
  144.       IF desc.mode # x.mode THEN
  145.         DescItem (reg, desc, 0); OCC.FreeReg (reg)
  146.       ELSE
  147.         reg.mode := Reg;
  148.         IF desc.mode IN {RegI, RegX} THEN
  149.           IF desc.a0 # x.a0 THEN reg.a0 := desc.a0; OCC.FreeReg (reg) END
  150.         END;
  151.         IF desc.mode IN {VarX, IndX, RegX} THEN
  152.           IF desc.a2 # x.a2 THEN reg.a0 := desc.a2; OCC.FreeReg (reg) END
  153.         END;
  154.       END
  155.     END;
  156.     desc.mode := Undef
  157.   END;
  158. END UnloadDesc;
  159.  
  160. (*------------------------------------*)
  161. PROCEDURE Adr * (VAR x : OCT.Item);
  162.  
  163.   VAR
  164.     reg, len, y : OCT.Item; module : OCT.Module; off : LONGINT;
  165.     dreg : INTEGER; wordIndex : BOOLEAN; desc : OCT.Desc;
  166.  
  167.   (*------------------------------------*)
  168.   PROCEDURE Multiply (VAR lhs, rhs : OCT.Item);
  169.  
  170.     VAR R : OCC.RegState;
  171.  
  172.   BEGIN (* Multiply *)
  173.     OCC.LoadRegParams2 (R, lhs, rhs);
  174.     OCC.CallKernel (OCC.kMul32);
  175.     OCC.RestoreRegisters (R, lhs);
  176.     Unload (rhs)
  177.   END Multiply;
  178.  
  179. BEGIN (* Adr *)
  180.   IF x.mode IN addressableSet THEN
  181.     IF x.mode = Con THEN
  182.       IF (x.typ # OCT.stringtyp) & (x.typ # OCT.tagtyp) THEN
  183.         OCS.Mark (127)
  184.       ELSE
  185.         IF (x.typ = OCT.stringtyp) & (x.a1 < 3) THEN
  186.           OCC.AllocStringFromChar (x)
  187.         END;
  188.         IF OCM.SmallData THEN
  189.           y := x; OCC.GetAReg (x, NIL);
  190.           OCC.PutF2 (OCC.LEA, y, x.a0); Unload (y)
  191.         ELSE
  192.           x.mode := LabI; x.a1 := L
  193.         END
  194.       END
  195.     ELSIF x.typ.form = DynArr THEN
  196.       len.mode := Undef;
  197.       IF x.mode IN {IndX, RegX} THEN
  198.         reg.mode := Reg; reg.a0 := x.a2; reg.typ := OCT.linttyp;
  199.       END;
  200.       WHILE x.typ.form = DynArr DO
  201.         IF x.mode IN {IndX, RegX} THEN
  202.           DescItem (len, x.desc, x.typ.adr); Multiply (reg, len)
  203.         END;
  204.         x.typ := x.typ.BaseTyp
  205.       END;
  206.       Unload (len);
  207.       IF x.mode = Var THEN x.mode := Ind; x.a1 := 0 END;
  208.       Adr (x)
  209.     ELSIF x.mode = Reg THEN
  210.       IF x.a0 IN DataRegs THEN OCS.Mark (127) END
  211.     ELSIF x.mode = Var THEN
  212.       y := x; OCC.GetAReg (x, NIL);
  213.       OCC.PutF2 (OCC.LEA, y, x.a0); Unload (y)
  214.     ELSIF x.mode = Ind THEN
  215.       IF x.a1 = 0 THEN
  216.         x.mode := Var
  217.       ELSE
  218.         y := x; OCC.GetAReg (x, NIL);
  219.         OCC.PutF2 (OCC.LEA, y, x.a0); Unload (y)
  220.       END
  221.     ELSIF x.mode IN {VarX, IndX, RegX} THEN
  222.       y := x; desc := x.desc;
  223.       OCC.GetAReg (x, NIL); x.desc := desc;
  224.       OCC.PutF2 (OCC.LEA, y, x.a0); Unload (y)
  225.     ELSIF x.mode = RegI THEN
  226.       IF x.a1 # 0 THEN
  227.         y := x; OCC.GetAReg (x, NIL);
  228.         OCC.PutF2 (OCC.LEA, y, x.a0); Unload (y)
  229.       END;
  230.       x.mode := Reg
  231.     ELSIF x.mode IN {LProc, XProc, CallBack} THEN
  232.       x.mode := LabI; x.a0 := 0; x.a1 := L; x.label := x.obj.label
  233.     END;
  234.     IF x.mode = Reg THEN x.a1 := 0; x.a2 := 0; x.obj := NIL END
  235.   ELSE
  236.     OCS.Mark (127)
  237.   END
  238. END Adr;
  239.  
  240. (*------------------------------------*)
  241. PROCEDURE LoadAdr * (VAR x : OCT.Item);
  242.  
  243.   VAR y : OCT.Item;
  244.  
  245. BEGIN (* LoadAdr *)
  246.   Adr (x);
  247.   IF x.mode # Reg THEN
  248.     y := x; OCC.GetAReg (x, NIL); OCC.Move (L, y, x)
  249.   END;
  250.   x.mode := RegI; x.a1 := 0; x.a2 := 0; x.obj := NIL
  251. END LoadAdr;
  252.  
  253. (*------------------------------------*)
  254. (*
  255.   Move the address of a variable, procedure or string constant to the
  256.   specified location.
  257. *)
  258. PROCEDURE MoveAdr * (VAR x, y : OCT.Item);
  259.  
  260.   VAR
  261.     z : OCT.Item; module : OCT.Object; off, reg : LONGINT;
  262.     wordIndex : BOOLEAN;
  263.  
  264. BEGIN (* MoveAdr *)
  265.   IF x.mode IN addressableSet THEN
  266.     IF x.mode = Reg THEN
  267.       IF x.a0 < A0 THEN OCS.Mark (127)
  268.       ELSE OCC.Move (L, x, y)
  269.       END
  270.     ELSIF (y.mode = Reg) & (y.a0 >= A0) THEN
  271.       IF x.typ.form = DynArr THEN Adr (x); OCC.Move (L, x, y)
  272.       ELSIF x.mode = Reg THEN OCC.Move (L, x, y)
  273.       ELSIF x.mode = Ind THEN
  274.         z := x; z.mode := Var; OCC.Move (L, z, y);
  275.         IF z.a1 # 0 THEN
  276.           z.mode := RegI; z.a0 := y.a0; OCC.PutF2 (OCC.LEA, z, y.a0)
  277.         END
  278.       ELSIF x.mode = IndX THEN
  279.         off := x.a1; reg := x.a2; wordIndex := x.wordIndex;
  280.         z := x; z.mode := Var; OCC.Move (L, z, y);
  281.         z.mode := RegX; z.a0 := y.a0; z.a1 := off; z.a2 := reg;
  282.         z.wordIndex := wordIndex;
  283.         OCC.PutF2 (OCC.LEA, z, y.a0)
  284.       ELSIF x.mode IN {LProc, XProc, CallBack} THEN
  285.         x.mode := Lab; x.a0 := 0; x.a1 := L; x.label := x.obj.label;
  286.         OCC.PutF2 (OCC.LEA, x, y.a0)
  287.       ELSE
  288.         OCC.PutF2 (OCC.LEA, x, y.a0)
  289.       END
  290.     ELSE
  291.       Adr (x); OCC.Move (L, x, y)
  292.     END
  293.   ELSE
  294.     OCS.Mark (127)
  295.   END
  296. END MoveAdr;
  297.  
  298. (*------------------------------------*)
  299. (*
  300.   Copies count bytes from src to dst and then terminates dst with a NUL.
  301. *)
  302. PROCEDURE CopyString * ( VAR src, dst, count : OCT.Item );
  303.  
  304.   VAR x : OCT.Item; L0 : INTEGER; i : LONGINT;
  305.  
  306. BEGIN (* CopyString *)
  307.   IF (count.mode = Con) & (count.a0 < 5)  THEN (* inline the loop *)
  308.     IF count.a0 = 1 THEN
  309.       LoadAdr (dst); dst.mode := Pop;           (*    LEA    <dst>,Ad    *)
  310.       OCC.ForgetReg (dst.a0);
  311.       IF src.mode = Con THEN src.a0 := src.a2; src.typ := OCT.chartyp END;
  312.       OCC.Move (B, src, dst);                   (*    MOVE.B <src>,(Ad)+ *)
  313.       dst.mode := RegI
  314.     ELSIF count.a0 > 1 THEN
  315.       LoadAdr (src); src.mode := Pop;           (*    LEA    <src>,As    *)
  316.       LoadAdr (dst); dst.mode := Pop;           (*    LEA    <dst>,Ad    *)
  317.       OCC.ForgetReg (src.a0); OCC.ForgetReg (dst.a0);
  318.       i := count.a0;
  319.       WHILE i > 0 DO
  320.         OCC.Move (B, src, dst);                 (*    MOVE.B (As)+,(Ad)+ *)
  321.         DEC (i)
  322.       END;
  323.       dst.mode := RegI
  324.     ELSE (* src is an empty string *)
  325.       IF (dst.typ.form = DynArr) & (dst.mode IN {IndX, RegX}) THEN
  326.         LoadAdr (dst)                           (*    LEA    <dst>,Ad    *)
  327.       END
  328.     END;
  329.     OCC.PutF1 (OCC.CLR, B, dst)                 (*    CLR.B  <dst>       *)
  330.   ELSE
  331.     LoadAdr (src); src.mode := Pop;             (*    LEA    <src>,As    *)
  332.     LoadAdr (dst); dst.mode := Pop;             (*    LEA    <dst>,Ad    *)
  333.     OCC.ForgetReg (src.a0); OCC.ForgetReg (dst.a0);
  334.  
  335.     IF (count.mode = Con) & (count.a0 < 65536) THEN
  336.       count.typ := OCT.inttyp; DEC (count.a0);
  337.       Load (count);                             (*    MOVE.W <count>,Dc  *)
  338.       OCC.Move (B, src, dst);                   (* 1$ MOVE.B (As)+,(Ad)+ *)
  339.       OCC.PutWord (OCC.DBEQ + count.a0);
  340.       OCC.PutWord (-4);                         (*    DBEQ.W Dc, 1$      *)
  341.       OCC.PutWord (6702H)                       (*    BEQ.S  3$          *)
  342.     ELSIF count.mode = Con THEN
  343.       DEC (count.a0); Load (count);             (*    MOVE.L <count>,Dc  *)
  344.       OCC.Move (B, src, dst);                   (* 1$ MOVE.B (As)+,(Ad)+ *)
  345.       OCC.PutWord (6706H);                      (*    BEQ.S  3$          *)
  346.       OCC.PutF7 (OCC.SUBQ, L, 1, count);        (*    SUBQ.L #1,Dc       *)
  347.       OCC.PutWord (66F8H)                       (*    BNE    1$          *)
  348.     ELSE
  349.       Load (count);                             (*    MOVE.L <count>,Dc  *)
  350.       OCC.PutF7 (OCC.SUBQ, L, 1, count);        (* 1$ SUBQ.L #1,Dc       *)
  351.       OCC.PutWord (6706H);                      (*    BEQ.S  2$          *)
  352.       OCC.Move (B, src, dst);                   (*    MOVE.B (As)+,(Ad)+ *)
  353.       OCC.PutWord (66F8H);                      (*    BNE.S  1$          *)
  354.       OCC.PutWord (6002H)                       (*    BRA.S  3$          *)
  355.     END;
  356.     dst.mode := RegI;
  357.     OCC.PutF1 (OCC.CLR, B, dst)                 (* 2$ CLR.B  <dst>       *)
  358.   END;                                          (* 3$                    *)
  359. END CopyString;
  360.  
  361. (*------------------------------------*)
  362. (*
  363.   Compares src and dst, selecting the correct instruction for the operand
  364.   types.
  365. *)
  366. PROCEDURE CMP* ( size : LONGINT; VAR src, dst : OCT.Item );
  367.  
  368.   VAR
  369.  
  370. BEGIN (* CMP *)
  371.   IF (src.mode = Con) THEN
  372.     IF (OCM.SmallData & (src.typ.form IN {String, TagTyp}))
  373.     OR (dst.mode = Con)
  374.     THEN
  375.       Load (dst)
  376.     END
  377.   ELSIF dst.mode # Reg THEN
  378.     Load (dst)
  379.   END;
  380.   IF dst.mode = Reg THEN
  381.     OCC.PutF5 (OCC.CMP, size, src, dst)
  382.   ELSE
  383.     OCC.PutF6 (OCC.CMPI, size, src, dst)
  384.   END;
  385.   Unload (dst)
  386. END CMP;
  387.  
  388. END OCI.
  389.  
  390. (*************************************************************************
  391.  
  392.   $Log: OCI.mod $
  393.   Revision 5.17  1995/06/02  18:38:40  fjc
  394.   - Various changes to implement the SMALLDATA and RESIDENT
  395.     options.
  396.   - Added CMP procedure.
  397.  
  398.   Revision 5.16  1995/05/13  23:05:18  fjc
  399.   - Converted INTEGER to LONGINT where necessary.
  400.  
  401.   Revision 5.15  1995/05/08  17:05:12  fjc
  402.   - Minor corrections.
  403.  
  404.   Revision 5.13  1995/03/25  17:05:01  fjc
  405.   - Fixed problems in UnloadDesc().
  406.  
  407.   Revision 5.12  1995/03/23  18:12:30  fjc
  408.   - FreeDesc() now calls FreeReg instead of emulating it.
  409.   - Cleaned up Adr().
  410.  
  411.   Revision 5.11  1995/03/13  11:30:26  fjc
  412.   - Minor fixes to register allocation.
  413.  
  414.   Revision 5.10  1995/03/09  19:09:21  fjc
  415.   - Incorporated changes from 5.22.
  416.  
  417.   Revision 5.9  1995/02/27  17:01:02  fjc
  418.   - Removed tracing code.
  419.   - Changed to use new register handling procedures.
  420.  
  421.   Revision 5.8.1.1  1995/03/08  18:59:09  fjc
  422.   - OC 5.22
  423.  
  424.   Revision 5.8  1995/01/26  00:17:17  fjc
  425.   - Release 1.5
  426.  
  427.   Revision 5.6  1995/01/03  21:21:29  fjc
  428.   - Changed OCG to OCM.
  429.  
  430.   Revision 5.5  1994/12/16  17:20:24  fjc
  431.   - Changed Symbol to Label.
  432.  
  433.   Revision 5.4  1994/10/23  16:08:14  fjc
  434.   - Fixed register allocation bug in UnloadDesc().
  435.   - Changed Multiply() to use OCC.CallKernel().
  436.  
  437.   Revision 5.3  1994/09/25  17:47:18  fjc
  438.   - Changed to reflect new object modes and system flags.
  439.  
  440.   Revision 5.2  1994/09/15  10:27:13  fjc
  441.   - Replaced switches with pragmas.
  442.  
  443.   Revision 5.1  1994/09/03  19:29:08  fjc
  444.   - Bumped version number
  445.  
  446. *************************************************************************)
  447.