home *** CD-ROM | disk | FTP | other *** search
/ Gold Fish 2 / goldfish_vol2_cd1.bin / files / dev / obero / oberon-a / source / oc / oci.mod < prev    next >
Text File  |  1994-08-08  |  13KB  |  423 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: 4.6 $
  8.       $Author: fjc $
  9.         $Date: 1994/08/03 11:41:38 $
  10.  
  11.   Copyright © 1993-1994, 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. MODULE OCI;
  20.  
  21. (*
  22. ** $C= CaseChk       $I= IndexChk  $L+ LongAdr   $N= NilChk
  23. ** $P- PortableCode  $R= RangeChk  $S= StackChk  $T= TypeChk
  24. ** $V= OvflChk       $Z= ZeroVars
  25. *)
  26.  
  27. IMPORT OCG, OCS, OCT, OCC;
  28.  
  29. (* --- Local declarations ----------------------------------------------- *)
  30.  
  31. CONST
  32.  
  33.   (* object modes *)
  34.  
  35.   Var = OCG.Var; VarX = OCG.VarX; VarR = OCG.VarR; Ind = OCG.Ind;
  36.   IndX = OCG.IndX; IndR = OCG.IndR; RegI = OCG.RegI; RegX = OCG.RegX;
  37.   Lab = OCG.Lab; LabI = OCG.LabI; Con = OCG.Con; Push = OCG.Push;
  38.   Pop = OCG.Pop; Coc = OCG.Coc; Reg = OCG.Reg; Fld = OCG.Fld;
  39.   Typ = OCG.Typ; Abs = OCG.Abs; XProc = OCG.XProc; LProc = OCG.LProc;
  40.   Undef = OCG.Undef; FProc = OCG.FProc;
  41.  
  42.   regSet = {VarR, IndR, Reg};
  43.   addressableSet =
  44.     {Var, VarX, Ind, IndX, Reg, RegI, RegX, Con, XProc, LProc, FProc};
  45.  
  46.   (* structure forms *)
  47.  
  48.   Char = OCT.Char; DynArr = OCT.DynArr;
  49.  
  50.   (* CPU Registers *)
  51.  
  52.   D0 = 0; D1 = 1; D7 = 7; A0 = 8; A3 = 11; A4 = 12; A5 = 13; A6 = 14;
  53.   A7 = 15; BP = A4 - 8; FP = A5 - 8; SP = A7 - 8;
  54.   DataRegs = {D0 .. D7};
  55.   AdrRegs = {A0 .. A7};
  56.  
  57.   (* Data sizes *)
  58.  
  59.   B = 1; W = 2; L = 4;
  60.  
  61. (* CONST mname = "OCI"; *)
  62.  
  63. (* --- Procedure declarations ------------------------------------------- *)
  64.  
  65. (*------------------------------------*)
  66. PROCEDURE IsParam * (obj : OCT.Object) : BOOLEAN;
  67.  
  68. BEGIN (* IsParam *)
  69.   RETURN (obj # NIL) & (obj.mode <= IndR) & (obj.a0 >= 0)
  70. END IsParam;
  71.  
  72. (*------------------------------------*)
  73. (*
  74.   Explicitly frees any registers used by x
  75. *)
  76. PROCEDURE Unload * (VAR x : OCT.Item);
  77.  
  78.   (* CONST pname = "Unload"; *)
  79.  
  80. BEGIN (* Unload *)
  81.   (* OCG.TraceIn (mname, pname); *)
  82.   IF x.mode IN {VarX, IndX, Reg, RegI, RegX, Push, Pop} THEN
  83.     OCC.FreeReg (x);
  84.   END
  85.   (* ;OCG.TraceOut (mname, pname); *)
  86. END Unload;
  87.  
  88. (*------------------------------------*)
  89. PROCEDURE Load * (VAR x : OCT.Item);
  90.  
  91.   (* CONST pname = "Load"; *)
  92.  
  93.   VAR y : OCT.Item;
  94.  
  95. BEGIN (* Load *)
  96.   (* OCG.TraceIn (mname, pname); *)
  97.   IF x.mode < Reg THEN
  98.     y := x; OCC.GetDReg (x); OCC.Move (y.typ.size, y, x); Unload (y)
  99.   ELSIF x.mode > Reg THEN
  100.     OCS.Mark (126)
  101.   END
  102.   (* ;OCG.TraceOut (mname, pname); *)
  103. END Load;
  104.  
  105. (*------------------------------------*)
  106. PROCEDURE EXT * (size, reg : LONGINT);
  107.  
  108.   (* CONST pname = "EXT"; *)
  109.  
  110. BEGIN (* EXT *)
  111.   (* OCG.TraceIn (mname, pname); *)
  112.   IF size = L THEN OCC.PutWord (OCC.EXTL + SHORT (reg))
  113.   ELSE OCC.PutWord (OCC.EXTW + SHORT (reg))
  114.   END
  115.   (* ;OCG.TraceOut (mname, pname); *)
  116. END EXT;
  117.  
  118. (*------------------------------------*)
  119. PROCEDURE DescItem * (VAR item : OCT.Item; desc : OCT.Desc; adr : LONGINT);
  120.  
  121.   (* CONST pname = "DescItem"; *)
  122.  
  123. BEGIN (* DescItem *)
  124.   (* OCG.TraceIn (mname, pname); *)
  125.   IF desc = NIL THEN
  126.     OCS.Mark (963);
  127.     item.lev := 0; item.mode := Var;
  128.     item.a0 := 0; item.a1 := 0; item.a2 := 0
  129.   ELSE
  130.     (* item = bound descr *)
  131.     item.lev := desc.lev; item.mode := desc.mode; item.a0 := desc.a0;
  132.     item.a1 := desc.a1; item.a2 := desc.a2;
  133.     IF item.mode IN {Var, VarX} THEN INC (item.a0, adr)
  134.     ELSIF item.mode IN {Ind, IndX, RegI, RegX} THEN INC (item.a1, adr)
  135.     ELSE OCS.Mark (322)
  136.     END
  137.   END;
  138.   item.desc := desc; item.typ := OCT.linttyp
  139.   (* ;OCG.TraceOut (mname, pname); *)
  140. END DescItem;
  141.  
  142. (*------------------------------------*)
  143. PROCEDURE UpdateDesc * (VAR x : OCT.Item; adr : LONGINT);
  144.  
  145.   (* CONST pname = "UpdateDesc"; *)
  146.  
  147.   VAR desc : OCT.Desc;
  148.  
  149. BEGIN (* UpdateDesc *)
  150.   (* OCG.TraceIn (mname, pname); *)
  151.   desc := x.desc;
  152.   IF desc # NIL THEN
  153.     desc.lev := x.lev; desc.mode := x.mode; desc.a0 := x.a0;
  154.     desc.a1 := x.a1; desc.a2 := x.a2;
  155.     IF desc.mode IN {Var, VarX} THEN DEC (desc.a0, adr)
  156.     ELSIF desc.mode IN {Ind, IndX, RegI, RegX} THEN DEC (desc.a1, adr)
  157.     ELSE OCS.Mark (322)
  158.     END
  159.   END
  160.   (* ;OCG.TraceOut (mname, pname); *)
  161. END UpdateDesc;
  162.  
  163. (*------------------------------------*)
  164. PROCEDURE UnloadDesc * (VAR x : OCT.Item);
  165.  
  166.   (* CONST pname = "UnloadDesc"; *)
  167.  
  168.   VAR desc : OCT.Desc;
  169.  
  170. BEGIN (* UnloadDesc *)
  171.   (* OCG.TraceIn (mname, pname); *)
  172.   desc := x.desc;
  173.   IF (desc # NIL) & (desc.mode IN {VarX, IndX, RegI, RegX}) THEN
  174.     IF desc.mode # x.mode THEN
  175.       IF desc.mode IN {RegI, RegX} THEN
  176.         OCC.UnReserveReg (SHORT (desc.a0))
  177.       END;
  178.       IF desc.mode IN {VarX, IndX, RegX} THEN
  179.         OCC.UnReserveReg (SHORT (desc.a1))
  180.       END
  181.     ELSE
  182.       IF desc.mode IN {RegI, RegX} THEN
  183.         IF desc.a0 # x.a0 THEN OCC.UnReserveReg (SHORT (desc.a0)) END
  184.       END;
  185.       IF desc.mode IN {VarX, IndX, RegX} THEN
  186.         IF desc.a2 # x.a2 THEN OCC.UnReserveReg (desc.a2) END
  187.       END;
  188.     END
  189.   END
  190.   (* ;OCG.TraceOut (mname, pname); *)
  191. END UnloadDesc;
  192.  
  193. (*------------------------------------*)
  194. PROCEDURE Adr * (VAR x : OCT.Item);
  195.  
  196.   (* CONST pname = "Adr"; *)
  197.  
  198.   VAR
  199.     reg, len, y : OCT.Item; module : OCT.Module; off : LONGINT;
  200.     dreg : INTEGER;
  201.  
  202.   (*------------------------------------*)
  203.   PROCEDURE Multiply (VAR lhs, rhs : OCT.Item);
  204.  
  205.   (* CONST pname = "Multiply"; *)
  206.  
  207.     VAR mul : OCT.Item; R : SET;
  208.  
  209.   BEGIN (* Multiply *)
  210.     (* OCG.TraceIn (mname, pname); *)
  211.     mul.mode := Lab; mul.a0 := 0; mul.a1 := 4;
  212.     mul.symbol := OCT.OberonSysMUL;
  213.     OCC.LoadRegParams2 (R, lhs, rhs);
  214.     OCC.PutF3 (OCC.JSR, mul);
  215.     OCC.RestoreRegisters (R, lhs);
  216.     Unload (rhs)
  217.     (* ;OCG.TraceOut (mname, pname); *)
  218.   END Multiply;
  219.  
  220. BEGIN (* Adr *)
  221.   (* OCG.TraceIn (mname, pname); *)
  222.   IF x.mode IN addressableSet THEN
  223.     IF (x.mode = Con) & (x.typ # OCT.stringtyp) THEN OCS.Mark (127)
  224.     ELSIF x.typ.form = DynArr THEN
  225.       len.mode := Undef;
  226.       IF x.mode IN {IndX, RegX} THEN
  227.         reg.mode := Reg; reg.a0 := x.a2; reg.typ := OCT.linttyp;
  228.       END;
  229.       WHILE x.typ.form = DynArr DO
  230.         IF x.mode IN {IndX, RegX} THEN
  231.           DescItem (len, x.desc, x.typ.adr); Multiply (reg, len)
  232.         END;
  233.         x.typ := x.typ.BaseTyp
  234.       END;
  235.       Unload (len);
  236.       IF x.mode = Var THEN x.mode := Ind; x.a1 := 0 END;
  237.       Adr (x)
  238.     ELSIF x.mode = Reg THEN
  239.       IF x.a0 IN DataRegs THEN OCS.Mark (127) END
  240.     ELSIF x.mode = Con THEN
  241.       IF x.a1 < 3 THEN OCC.AllocStringFromChar (x) END;
  242.       x.mode := LabI; x.a1 := 4
  243.     ELSIF x.mode = Var THEN
  244.       y := x; OCC.GetAReg (x); OCC.PutF2 (OCC.LEA, y, x.a0); Unload (y)
  245.     ELSIF x.mode = VarX THEN
  246.       dreg := x.a2; y := x; y.mode := Var; y.a2 := 0;
  247.       OCC.GetAReg (x); OCC.PutF2 (OCC.LEA, y, x.a0); Unload (y);
  248.       y.mode := RegX; y.a0 := x.a0; y.a1 := 0; y.a2 := dreg;
  249.       OCC.PutF2 (OCC.LEA, y, x.a0); OCC.UnReserveReg (dreg)
  250.     ELSIF x.mode = Ind THEN
  251.       IF x.a1 = 0 THEN x.mode := Var
  252.       ELSE
  253.         y := x; y.mode := Var; OCC.GetAReg (reg); reg.desc := x.desc;
  254.         OCC.Move (L, y, reg); Unload (y);
  255.         y.mode := RegI; y.a0 := reg.a0; y.a1 := x.a1; x := reg;
  256.         OCC.PutF2 (OCC.LEA, y, x.a0)
  257.       END
  258.     ELSIF x.mode = IndX THEN
  259.       off := x.a1; dreg := x.a2; y := x; y.mode := Var; y.a2 := 0;
  260.       OCC.GetAReg (x); OCC.Move (L, y, x); Unload (y);
  261.       IF off # 0 THEN
  262.         y.mode := RegI; y.a0 := x.a0; y.a1 := off;
  263.         OCC.PutF2 (OCC.LEA, y, x.a0)
  264.       END;
  265.       y.mode := RegX; y.a0 := x.a0; y.a1 := 0; y.a2 := dreg;
  266.       OCC.PutF2 (OCC.LEA, y, x.a0); OCC.UnReserveReg (dreg);
  267.       x.mode := Reg
  268.     ELSIF x.mode = RegI THEN
  269.       IF x.a1 # 0 THEN OCC.PutF2 (OCC.LEA, x, x.a0) END;
  270.       x.mode := Reg; x.a1 := 0
  271.     ELSIF x.mode = RegX THEN
  272.       y := x; x.mode := Reg; x.a1 := 0; x.a2 := 0;
  273.       OCC.PutF2 (OCC.LEA, y, x.a0); OCC.UnReserveReg (y.a2)
  274.     ELSIF x.mode IN {LProc, XProc, FProc} THEN
  275.       x.mode := LabI; x.a0 := 0; x.a1 := 4; x.symbol := x.obj.symbol
  276.     END;
  277.     IF x.mode = Reg THEN x.a1 := 0; x.a2 := 0; x.obj := NIL END
  278.   ELSE
  279.     OCS.Mark (127)
  280.   END
  281.   (* ;OCG.TraceOut (mname, pname); *)
  282. END Adr;
  283.  
  284. (*------------------------------------*)
  285. PROCEDURE LoadAdr * (VAR x : OCT.Item);
  286.  
  287.   (* CONST pname = "LoadAdr"; *)
  288.  
  289.   VAR y : OCT.Item;
  290.  
  291. BEGIN (* LoadAdr *)
  292.   (* OCG.TraceIn (mname, pname); *)
  293.   Adr (x);
  294.   IF x.mode # Reg THEN y := x; OCC.GetAReg (x); OCC.Move (L, y, x) END;
  295.   x.mode := RegI; x.a1 := 0; x.a2 := 0; x.obj := NIL
  296.   (* ;OCG.TraceOut (mname, pname); *)
  297. END LoadAdr;
  298.  
  299. (*------------------------------------*)
  300. (*
  301.   Move the address of a variable, procedure or string constant to the
  302.   specified location.
  303. *)
  304. PROCEDURE MoveAdr * (VAR x, y : OCT.Item);
  305.  
  306.   (* CONST pname = "MoveAdr"; *)
  307.  
  308.   VAR z : OCT.Item; module : OCT.Object;
  309.  
  310. BEGIN (* MoveAdr *)
  311.   (* OCG.TraceIn (mname, pname); *)
  312.   IF x.mode IN addressableSet THEN
  313.     IF (y.mode = VarR) OR (y.mode = IndR) THEN y.mode := Reg END;
  314.     IF x.mode = Reg THEN
  315.       IF x.a0 < A0 THEN OCS.Mark (127)
  316.       ELSE OCC.Move (L, x, y)
  317.       END
  318.     ELSIF (y.mode = Reg) & (y.a0 >= A0) THEN
  319.       IF x.typ.form = DynArr THEN Adr (x); OCC.Move (L, x, y)
  320.       ELSIF x.mode = Reg THEN OCC.Move (L, x, y)
  321.       ELSIF x.mode = Ind THEN
  322.         z := x; z.mode := Var; OCC.Move (L, z, y);
  323.         IF z.a1 # 0 THEN
  324.           z.mode := RegI; z.a0 := y.a0; OCC.PutF2 (OCC.LEA, z, y.a0)
  325.         END
  326.       ELSIF x.mode = IndX THEN
  327.         z := x; z.mode := Var; OCC.Move (L, z, y);
  328.         z.mode := RegX; z.a0 := y.a0; OCC.PutF2 (OCC.LEA, z, y.a0)
  329.       ELSIF x.mode IN {LProc, XProc, FProc} THEN
  330.         x.mode := Lab; x.a0 := 0; x.a1 := 4; x.symbol := x.obj.symbol;
  331.         OCC.PutF2 (OCC.LEA, x, y.a0)
  332.       ELSE
  333.         OCC.PutF2 (OCC.LEA, x, y.a0)
  334.       END
  335.     ELSE
  336.       Adr (x); OCC.Move (L, x, y)
  337.     END
  338.   ELSE
  339.     OCS.Mark (127)
  340.   END
  341.   (* ;OCG.TraceOut (mname, pname); *)
  342. END MoveAdr;
  343.  
  344. (*------------------------------------*)
  345. (*
  346.   Copies count bytes from src to dst and then terminates dst with a NUL.
  347. *)
  348. PROCEDURE CopyString *
  349.   ( VAR src, dst, count : OCT.Item );
  350.  
  351.   (* CONST pname = "CopyString"; *)
  352.  
  353.   VAR x : OCT.Item; L0 : INTEGER; i : LONGINT;
  354.  
  355. BEGIN (* CopyString *)
  356.   (* OCG.TraceIn (mname, pname); *)
  357.   IF (count.mode = Con) & (count.a0 < 5)  THEN (* inline the loop *)
  358.     IF count.a0 = 1 THEN
  359.       LoadAdr (dst); dst.mode := Pop;            (*    LEA    <dst>,Ad    *)
  360.       IF src.mode = Con THEN src.a0 := src.a2; src.typ := OCT.chartyp END;
  361.       OCC.Move (B, src, dst);                    (*    MOVE.B <src>,(Ad)+ *)
  362.       dst.mode := RegI
  363.     ELSIF count.a0 > 1 THEN
  364.       LoadAdr (src); src.mode := Pop;            (*    LEA    <src>,As    *)
  365.       LoadAdr (dst); dst.mode := Pop;            (*    LEA    <dst>,Ad    *)
  366.       i := count.a0;
  367.       WHILE i > 0 DO
  368.         OCC.Move (B, src, dst);                  (*    MOVE.B (As),(Ad)+  *)
  369.         DEC (i)
  370.       END;
  371.       dst.mode := RegI
  372.     ELSE (* src is an empty string *)
  373.       IF (dst.typ.form = DynArr) & (dst.mode IN {IndX, RegX}) THEN
  374.         LoadAdr (dst)                            (*    LEA    <dst>,Ad    *)
  375.       END
  376.     END;
  377.     OCC.PutF1 (OCC.CLR, B, dst)                  (*    CLR.B  <dst>       *)
  378.   ELSE
  379.     LoadAdr (src); src.mode := Pop;              (*    LEA    <src>,As    *)
  380.     LoadAdr (dst); dst.mode := Pop;              (*    LEA    <dst>,Ad    *)
  381.  
  382.     IF count.mode = Con THEN
  383.       IF count.a0 > 32767 THEN OCS.Mark (63); count.a0 := 1 END;
  384.       count.typ := OCT.inttyp; DEC (count.a0);
  385.       Load (count);                              (*    MOVE.L <count>,Dc  *)
  386.     ELSE
  387.       Load (count);                              (*    MOVE.L <count>,Dc  *)
  388.       OCC.PutF7 (OCC.SUBQ, L, 1, count);         (*    SUBQ.L #1,Dc       *)
  389.       OCC.PutWord (6002H);                       (*    BRA.S  2$          *)
  390.     END; (* IF *)
  391.     OCC.Move (B, src, dst);                      (* 1$ MOVE.B (As)+,(Ad)+ *)
  392.     OCC.PutWord (OCC.DBEQ + SHORT (count.a0));
  393.     OCC.PutWord (-4);                            (* 2$ DBEQ.W Dc, 1$      *)
  394.     OCC.PutWord (6702H);                         (*    BEQ.S  3$          *)
  395.     dst.mode := RegI; OCC.PutF1 (OCC.CLR, B, dst)(*    CLR.B  <dst>       *)
  396.   END;                                           (* 3$                    *)
  397.   (* ;OCG.TraceOut (mname, pname); *)
  398. END CopyString;
  399.  
  400. END OCI.
  401.  
  402. (***************************************************************************
  403.  
  404.   $Log: OCI.mod $
  405.   Revision 4.6  1994/08/03  11:41:38  fjc
  406.   - Changed error numbers.
  407.  
  408.   Revision 4.5  1994/07/26  18:33:40  fjc
  409.   *** empty log message ***
  410.  
  411.   Revision 4.4  1994/07/22  14:07:58  fjc
  412.   - Changed to support FProc objects.
  413.  
  414.   Revision 4.3  1994/07/10  13:08:14  fjc
  415.   - Commented out trace code.
  416.   - Fixed register allocation bug in MoveAdr().
  417.  
  418.   Revision 4.1  1994/06/01  09:33:44  fjc
  419.   - Bumped version number
  420.  
  421. ***************************************************************************)
  422.  
  423.