home *** CD-ROM | disk | FTP | other *** search
/ Fresh Fish 10 / Fresh_Fish_10_2352.bin / new / dev / obero / oberon / projectoberonsrc / obc.mod (.txt) < prev    next >
Oberon Text  |  1994-10-17  |  19KB  |  547 lines
  1. Syntax10.Scn.Fnt
  2. MODULE OBC;  (*NW 30.5.87 / 28.3.93*)
  3.     IMPORT Files, OBS, OBT;
  4.     CONST ObjMark = 0F5X; CodeLength = 20000; LinkLength = 250;
  5.                 ConstLength = 3500; EntryLength = 96; MaxImps = 32;
  6.                 MaxPtrs = 64; MaxRecs = 32; MaxComs = 40; MaxExts = 7;
  7.         (*instruction prefixes*)
  8.             F6 = 4EH; F7 = 0CEH; F9 = 3EH; F11 = 0BEH;
  9.         (*object and item modes*)
  10.             Var   =  1; VarX  =  2; Ind   =  3; IndX  =  4; RegI  =  5;
  11.             RegX  =  6; Abs   =  7; Con   =  8; Stk   =  9; Stk0 = 10; Coc   = 11; Reg   = 12;
  12.             Fld   = 13; Typ   = 14; LProc = 15; SProc = 16; CProc = 17; IProc = 18; Mod   = 19; Head  = 20;
  13.         (*structure forms*)
  14.             Undef = 0; Byte = 1; Bool = 2; Char = 3; SInt = 4; Int = 5; LInt = 6;
  15.             Real = 7; LReal = 8; Set = 9; String = 10; NilTyp = 11; NoTyp = 12;
  16.             Pointer = 13; ProcTyp = 14; Array = 15; DynArr = 16; Record = 17;
  17.     TYPE Argument =
  18.             RECORD form, gen, inx: INTEGER;
  19.                 d1, d2: LONGINT
  20.             END ;
  21.     VAR pc*, Pc*, level*: INTEGER;
  22.             wasderef*: OBT.Object;
  23.             typchk*: BOOLEAN;
  24.             RegSet, FRegSet: SET;
  25.             StrOffset: LONGINT;
  26.             conx, nofrecs: INTEGER;
  27.             fixlist0: ARRAY MaxImps OF INTEGER;  (*abs adr*)
  28.             fixlist1: ARRAY MaxImps OF INTEGER;  (*PC-rel adr*)
  29.             RecTab: ARRAY MaxRecs OF OBT.Struct;
  30.             constant: ARRAY ConstLength OF CHAR;
  31.             code:  ARRAY CodeLength OF CHAR;
  32.     PROCEDURE SetStrOffset*(varsize: LONGINT);
  33.     BEGIN StrOffset := -ConstLength - varsize
  34.     END SetStrOffset;
  35.     PROCEDURE GetReg*(VAR x: OBT.Item);
  36.         VAR i: INTEGER;
  37.     BEGIN i := 7; x.mode := Reg;
  38.         LOOP IF ~(i IN RegSet) THEN x.a0 := i; INCL(RegSet,i); EXIT END ;
  39.                  IF i = 0 THEN x.a0 := 0; OBS.Mark(215); EXIT ELSE DEC(i) END ;
  40.         END
  41.     END GetReg;
  42.     PROCEDURE GetFReg*(VAR x: OBT.Item);
  43.         VAR i: INTEGER;
  44.     BEGIN i := 6; x.mode := Reg;
  45.         LOOP IF ~(i IN FRegSet) THEN x.a0 := i; INCL(FRegSet,i); EXIT END ;
  46.                  IF i = 0 THEN x.a0 := 0; OBS.Mark(216); EXIT ELSE i := i-2 END
  47.         END
  48.     END GetFReg;
  49.     PROCEDURE UsedRegisters*(): SET;
  50.     BEGIN RETURN RegSet
  51.     END UsedRegisters;
  52.     PROCEDURE FreeRegs*(r: SET);
  53.     BEGIN RegSet := r; FRegSet := {}
  54.     END FreeRegs;
  55.     PROCEDURE Release*(VAR x: OBT.Item);
  56.     BEGIN
  57.         IF x.mode = Reg THEN
  58.             IF x.typ.form IN {Real, LReal} THEN EXCL(FRegSet, x.a0) ELSE EXCL(RegSet, x.a0) END
  59.         ELSIF x.mode = RegI THEN EXCL(RegSet, x.a0)
  60.         ELSIF x.mode = RegX THEN EXCL(RegSet, x.a0); EXCL(RegSet, x.a2)
  61.         ELSIF x.mode IN {VarX, IndX} THEN EXCL(RegSet, x.a2)
  62.         END
  63.     END Release;
  64.     PROCEDURE CheckCodeSize*;
  65.     BEGIN
  66.         IF pc > CodeLength - 256 THEN OBS.Mark(210); pc := 4 END
  67.     END CheckCodeSize;
  68.     PROCEDURE AllocString*(VAR s: ARRAY OF CHAR; VAR x: OBT.Item);
  69.         VAR i: INTEGER; ch: CHAR;
  70.     BEGIN (*fill constant table backward*) i := 0;
  71.         REPEAT ch := s[i]; INC(i) UNTIL ch = 0X;
  72.         x.a1 := i;
  73.         IF i <= conx THEN
  74.             REPEAT DEC(i); DEC(conx); constant[conx] := s[i] UNTIL i = 0
  75.         ELSE OBS.Mark(230)
  76.         END ;
  77.         x.a0 := conx
  78.     END AllocString;
  79.     PROCEDURE PutByte*(x: LONGINT);
  80.     BEGIN code[pc] := CHR(x); INC(pc)
  81.     END PutByte;
  82.     PROCEDURE PutWord*(x: LONGINT); (*high byte first*)
  83.     BEGIN code[pc] := CHR(x DIV 100H); INC(pc); code[pc] := CHR(x); INC(pc)
  84.     END PutWord;
  85.     PROCEDURE PutDbl*(x: LONGINT);
  86.         VAR i: INTEGER;
  87.     BEGIN i := -32;
  88.         REPEAT INC(i, 8); code[pc] := CHR(ASH(x, i)); INC(pc) UNTIL i = 0
  89.     END PutDbl;
  90.     PROCEDURE PutF3*(op: INTEGER);
  91.     BEGIN code[pc] := CHR(op); INC(pc); code[pc] := CHR(op DIV 100H); INC(pc)
  92.     END PutF3;
  93.     PROCEDURE PutExtAdr*(mno: INTEGER; pno: LONGINT);
  94.     BEGIN PutWord(pno - 4000H); PutF3(fixlist1[mno]); fixlist1[mno] := pc - 4
  95.     END PutExtAdr;
  96.     PROCEDURE PutDisp*(x: LONGINT);
  97.     BEGIN
  98.         IF x < 0 THEN
  99.             IF x >= -40H THEN code[pc] := CHR(x+80H); INC(pc)
  100.             ELSIF x >= -2000H THEN PutWord(x+0C000H)
  101.             ELSE PutDbl(x)
  102.             END
  103.         ELSIF x < 40H THEN code[pc] := CHR(x); INC(pc)
  104.         ELSIF x < 2000H THEN PutWord(x+8000H)
  105.         ELSE PutDbl(x - 40000000H)
  106.         END
  107.     END PutDisp;
  108.     PROCEDURE PutArg(VAR z: Argument);
  109.     BEGIN
  110.         CASE z.form OF
  111.             0:   IF z.inx = 1 THEN code[pc] := CHR(z.d1); INC(pc)
  112.                     ELSIF z.inx = 2 THEN PutWord(z.d1)
  113.                     ELSIF z.inx = 4 THEN PutDbl(z.d1)
  114.                     ELSIF z.inx = 8 THEN PutDbl(z.d2); PutDbl(z.d1)
  115.                     END
  116.         | 1:
  117.         | 2,6: PutDisp(z.d1)
  118.         | 3,7: PutDisp(z.d1); PutDisp(z.d2)
  119.         | 4,8: PutDisp(z.d1 - Pc)
  120.         | 5,9: PutWord(z.d1 - 4000H); PutF3(fixlist0[z.d2]); fixlist0[z.d2] := pc - 4
  121.         END
  122.     END PutArg;
  123.     PROCEDURE Operand(VAR x: OBT.Item; VAR z: Argument);
  124.         PROCEDURE downlevel(VAR gen: INTEGER);
  125.             VAR n, op: INTEGER; b: OBT.Item;
  126.         BEGIN GetReg(b); n := level - x.lev; gen := SHORT(b.a0) + 8;
  127.             op := SHORT(b.a0)*40H - 3FE9H;
  128.             IF n = 1 THEN PutF3(op); PutDisp(8);  (*MOVD 8(FP) Rb*)
  129.             ELSE PutF3(op - 4000H); PutDisp(8); PutDisp(8);  (*MOVD 8(8(FP)) Rb*)
  130.                 WHILE n > 2 DO DEC(n);
  131.                     PutF3((SHORT(b.a0)*20H + SHORT(b.a0))*40H + 4017H); PutDisp(8)
  132.                 END
  133.             END ;
  134.         END downlevel;
  135.         PROCEDURE index;
  136.             VAR s: LONGINT;
  137.         BEGIN s := x.typ.size;
  138.             IF s = 1 THEN z.gen := 1CH
  139.             ELSIF s = 2 THEN z.gen := 1DH
  140.             ELSIF s = 4 THEN z.gen := 1EH
  141.             ELSIF s = 8 THEN z.gen := 1FH
  142.             ELSE z.gen := 1CH; PutByte(F7); PutByte(x.a2 MOD 4 * 40H + 23H);   (*MULD s, r*)
  143.                 PutByte(x.a2 DIV 4 + 0A0H); PutWord(0); PutWord(s)
  144.             END
  145.         END index;
  146.     BEGIN
  147.         CASE x.mode OF
  148.              Var:  IF x.lev = 0 THEN
  149.                              z.gen := 1BH; z.d1 := x.a0; z.form := 4
  150.                          ELSIF x.lev < 0 THEN
  151.                              z.gen := 15H; z.d1 := x.a0; z.d2 := -x.lev; z.form := 5
  152.                          ELSIF x.lev = level THEN
  153.                              z.gen := 18H; z.d1 := x.a0; z.form := 2
  154.                          ELSIF x.lev+1 = level THEN
  155.                              z.gen := 10H; z.d1 := 8; z.d2 := x.a0; z.form := 3
  156.                          ELSE downlevel(z.gen); z.d1 := x.a0; z.form := 2
  157.                          END
  158.          | Ind:  IF x.lev <= 0 THEN OBS.Mark(240)
  159.                          ELSIF x.lev = level THEN
  160.                              z.gen := 10H; z.d1 := x.a0; z.d2 := x.a1; z.form := 3
  161.                          ELSE downlevel(z.gen);
  162.                              PutF3((z.gen*20H + z.gen-8)*40H + 17H); PutDisp(x.a0);
  163.                              z.d1 := x.a1; z.form := 2
  164.                          END
  165.          | RegI: z.gen := SHORT(x.a0)+8; z.d1 := x.a1; z.form := 2
  166.          | VarX: index;
  167.                          IF x.lev = 0 THEN
  168.                              z.inx := 1BH; z.d1 := x.a0; z.form := 8
  169.                          ELSIF x.lev < 0 THEN
  170.                              z.inx := 15H; z.d1 := x.a0; z.d2 := -x.lev; z.form := 9
  171.                          ELSIF x.lev = level THEN
  172.                              z.inx := 18H; z.d1 := x.a0; z.form := 6
  173.                          ELSIF x.lev+1 = level THEN
  174.                              z.inx := 10H;  z.d1 := 8; z.d2 := x.a0; z.form := 7
  175.                          ELSE downlevel(z.inx); z.d1 := x.a0; z.form := 6
  176.                          END ;
  177.                          z.inx := z.inx*8 + SHORT(x.a2)
  178.          | IndX: index;
  179.                          IF x.lev <= 0 THEN OBS.Mark(240)
  180.                          ELSIF x.lev = level THEN
  181.                              z.inx := 10H; z.d1 := x.a0; z.d2 := x.a1; z.form := 7
  182.                          ELSE downlevel(z.inx);
  183.                              PutF3((z.inx*20H + z.inx-8)*40H + 17H); PutDisp(x.a0);
  184.                              z.d1 := x.a1; z.form := 6
  185.                          END ;
  186.                          z.inx := z.inx * 8 + SHORT(x.a2)
  187.          | RegX: index; z.inx := SHORT((x.a0+8)*8 + x.a2); z.d1 := x.a1; z.form := 6
  188.          | Con:  z.form := 0;
  189.                         CASE x.typ.form OF
  190.                              Undef, Byte, Bool, Char, SInt:
  191.                                  z.gen := 14H; z.inx := 1; z.d1 := x.a0
  192.                          | Int:
  193.                                  z.gen := 14H; z.inx := 2; z.d1 := x.a0
  194.                          | LInt, Real, Set, Pointer, ProcTyp, NilTyp:
  195.                                  z.gen := 14H; z.inx := 4; z.d1 := x.a0
  196.                          | LReal:
  197.                                  z.gen := 14H; z.inx := 8; z.d1 := x.a0; z.d2 := x.a1
  198.                          | String:
  199.                                  z.form := 4; z.gen := 1BH; z.d1 := x.a0 + StrOffset
  200.                          END
  201.          | Reg:  z.gen := SHORT(x.a0); z.form := 1
  202.          | Stk:  z.gen := 17H;  z.form := 1
  203.          | Stk0: z.gen := 19H; z.form := 2; z.d1 := 0
  204.          | Abs:  z.gen := 15H; z.form := 2; z.d1 := x.a0
  205.          | Coc, Fld .. Head: OBS.Mark(126); x.mode := Var; z.form := 0
  206.         END
  207.     END Operand;
  208.     PROCEDURE PutF0*(cond: LONGINT);
  209.     BEGIN code[pc] := CHR(cond*10H + 10); INC(pc)
  210.     END PutF0;
  211.     PROCEDURE PutF1*(op: INTEGER);
  212.     BEGIN code[pc] := CHR(op); INC(pc)
  213.     END PutF1;
  214.     PROCEDURE PutF2*(op: INTEGER; short: LONGINT; VAR x: OBT.Item);
  215.         VAR dst: Argument;
  216.     BEGIN Operand(x, dst); Pc := pc;
  217.         code[pc] := CHR(SHORT(short) MOD 2 * 80H + op); INC(pc);
  218.         code[pc] := CHR(dst.gen*8 + SHORT(short) MOD 10H DIV 2);
  219.         INC(pc);
  220.         IF dst.form >= 6 THEN code[pc] := CHR(dst.inx); INC(pc) END ;
  221.         PutArg(dst)
  222.     END PutF2;
  223.     PROCEDURE PutF4*(op: INTEGER; VAR x, y: OBT.Item);
  224.         VAR dst, src: Argument;
  225.     BEGIN Operand(x, dst); Operand(y, src); Pc := pc;
  226.         code[pc] := CHR(dst.gen MOD 4 * 40H + op); INC(pc);
  227.         code[pc] := CHR(src.gen*8 + dst.gen DIV