home *** CD-ROM | disk | FTP | other *** search
/ Gold Fish 3 / goldfish_volume_3.bin / files / dev / obero / oberon / projectoberonsrc / obh.mod (.txt) < prev    next >
Encoding:
Oberon Text  |  1994-10-17  |  17.7 KB  |  496 lines
  1. Syntax10.Scn.Fnt
  2. MODULE OBH;    (*NW 7.6.87 / 11.7.93*)
  3.     IMPORT OBS, OBT, OBC;
  4.     CONST
  5.         (*instruction format prefixes*)
  6.             F6 = 4EH; F7 = 0CEH; F9 = 3EH; F11 = 0BEH;
  7.         (*object and item modes*)
  8.             Var   =  1; VarX  =  2; Ind   =  3; IndX  =  4; RegI  =  5;
  9.             RegX  =  6; Abs   =  7; Con   =  8; Stk   =  9; Stk0 = 10; Coc   = 11; Reg   = 12;
  10.             Fld   = 13; LProc = 15; CProc = 17; IProc = 18; Mod   = 19;
  11.         (*structure forms*)
  12.             Undef = 0; Byte = 1; Bool = 2; Char = 3; SInt = 4; Int = 5; LInt = 6;
  13.             Real = 7; LReal = 8; Set = 9; String = 10; NilTyp = 11; NoTyp = 12;
  14.             Pointer = 13; ProcTyp = 14; Array = 15; DynArr = 16; Record = 17;
  15.     TYPE LabelRange* = RECORD low*, high*: INTEGER; label*: INTEGER END ;
  16.     VAR clrchk*, stkchk*: BOOLEAN;
  17.         lengcode: ARRAY 18 OF INTEGER;
  18.     PROCEDURE setCC(VAR x: OBT.Item; cc: LONGINT);
  19.     BEGIN
  20.         x.typ := OBT.booltyp; x.mode := Coc; x.a0 := cc; x.a1 := 0; x.a2 := 0
  21.     END setCC;
  22.     PROCEDURE AdjustSP*(n: LONGINT);
  23.     BEGIN  (*ADJSPB n*)
  24.         IF n <= 127 THEN OBC.PutF3(-5A84H); OBC.PutByte(n)
  25.         ELSE OBC.PutF3(-5A83H); OBC.PutWord(n)
  26.         END
  27.     END AdjustSP;
  28.     PROCEDURE move(L: INTEGER; VAR x, y: OBT.Item);
  29.     BEGIN
  30.         IF (y.mode = Con) & (y.a0 <= 7) & (y.a0 >= -8) THEN OBC.PutF2(L+5CH, y.a0, x)  (*MOVQi*)
  31.         ELSE OBC.PutF4(L+14H, x, y)  (*MOVi*)
  32.         END
  33.     END move;
  34.     PROCEDURE load(VAR x: OBT.Item);
  35.         VAR y: OBT.Item;
  36.     BEGIN IF x.mode # Reg THEN y := x; OBC.GetReg(x); move(lengcode[x.typ.form], x, y) END
  37.     END load;
  38.     PROCEDURE moveBW(VAR x, y: OBT.Item);
  39.     BEGIN
  40.         IF (y.mode = Con) & (y.a0 <= 7) & (y.a0 >= -8) THEN OBC.PutF2(5DH, y.a0, x)
  41.         ELSE OBC.Put(F7, 10H, x, y)  (*MOVXBW*)
  42.         END
  43.     END moveBW;
  44.     PROCEDURE moveBD(VAR x, y: OBT.Item);
  45.     BEGIN
  46.         IF (y.mode = Con) & (y.a0 <= 7) & (y.a0 >= -8) THEN OBC.PutF2(5FH, y.a0, x)
  47.         ELSE OBC.Put(F7, 1CH, x, y)  (*MOVXBD*)
  48.         END
  49.     END moveBD;
  50.     PROCEDURE moveWD(VAR x, y: OBT.Item);
  51.     BEGIN
  52.         IF (y.mode = Con) & (y.a0 <= 7) & (y.a0 >= -8) THEN OBC.PutF2(5FH, y.a0, x)
  53.         ELSE OBC.Put(F7, 1DH, x, y)  (*MOVXWD*)
  54.         END
  55.     END moveWD;
  56.     PROCEDURE Leng(VAR x: OBT.Item; L: LONGINT);
  57.         VAR y: OBT.Item;
  58.     BEGIN
  59.         IF L <= 7 THEN OBC.PutF2(5FH, L, x)       (*MOVQD*)
  60.         ELSE y.mode := Con; y.a0 := L; y.typ := OBT.linttyp; OBC.PutF4(17H, x, y)
  61.         END
  62.     END Leng;
  63.     PROCEDURE MoveBlock(VAR x, y: OBT.Item; s: LONGINT; param: BOOLEAN);
  64.         VAR L: INTEGER; z: OBT.Item;
  65.     BEGIN
  66.         IF s > 0 THEN
  67.             IF param THEN s := (s+3) DIV 4 * 4; AdjustSP(s) END ;
  68.             IF s <= 16 THEN
  69.                 OBC.Put(F7, 0, x, y); OBC.PutDisp(s-1)   (*MOVMB*)
  70.             ELSE
  71.                 z.mode := Reg; z.a0 := 1; OBC.PutF4(27H, z, y);    (*ADDR y,R1*)
  72.                 z.a0 := 2; OBC.PutF4(27H, z, x); z.a0 := 0;        (*ADDR x,R2*)
  73.                 IF s MOD 4 = 0 THEN L := 3; s := s DIV 4
  74.                 ELSIF s MOD 2 = 0 THEN L := 1; s := s DIV 2
  75.                 ELSE L := 0
  76.                 END ;
  77.                 Leng(z, s);
  78.                 OBC.PutF1(14); OBC.PutByte(L); OBC.PutByte(0)      (*MOVS*)
  79.             END
  80.         END
  81.     END MoveBlock;
  82.     PROCEDURE DynArrBnd(ftyp, atyp: OBT.Struct; lev: INTEGER; adr: LONGINT; varpar: BOOLEAN);
  83.         VAR f: INTEGER; x, y, z: OBT.Item;
  84.     BEGIN (* ftyp.form = DynArr *)
  85.         x.mode := Stk; y.mode := Var;
  86.         IF varpar & (ftyp.BaseTyp.form = Byte) THEN
  87.             IF atyp.form # DynArr THEN
  88.                 IF (atyp.form # Array) OR (atyp.BaseTyp.size > 1) THEN OBS.Mark(-1) END ;
  89.                 Leng(x, atyp.size)
  90.             ELSE y.lev := lev; y.a0 := adr + atyp.adr; y.typ := OBT.linttyp;
  91.                 atyp := atyp.BaseTyp;
  92.                 IF atyp.form # DynArr THEN
  93.                     IF atyp.size > 1 THEN
  94.                         OBS.Mark(-1); z.mode := Con; z.typ := OBT.linttyp; z.a0 := atyp.size;
  95.                         load(y); OBC.Put(F7, 23H, y, z);    (* MULD z, Ry *)
  96.                         z.mode := Con; z.typ := OBT.linttyp; z.a0 := atyp.size
  97.                     END
  98.                 ELSE OBS.Mark(-1); load(y); OBC.PutF2(0FH, 1, y);
  99.                     REPEAT z.mode := Var; z.lev := lev; z.a0 := atyp.adr + adr; z.typ := OBT.linttyp;
  100.                         load(z); OBC.Put(F7, 23H, y, z);    (* MULD Rz, Ry *)
  101.                         atyp := atyp.BaseTyp
  102.                     UNTIL atyp.form # DynArr;
  103.                     IF atyp.size > 1 THEN
  104.                         z.mode := Con; z.typ := OBT.linttyp; z.a0 := atyp.size;
  105.                         OBC.Put(F7, 23H, y, z)    (* MULD z, Ry *)
  106.                     END
  107.                 END ;
  108.                 OBC.PutF4(17H, x, y)    (* MOVD apdynarrlen, TOS *)
  109.             END
  110.         ELSE
  111.             LOOP f := atyp.form;
  112.                 IF f = Array THEN Leng(x, atyp.size DIV atyp.BaseTyp.size)
  113.                 ELSIF f = DynArr THEN y.lev := lev; y.a0 := atyp.adr + adr; OBC.PutF4(17H, x, y)
  114.                 ELSE OBS.Mark(66); EXIT
  115.                 END ;
  116.                 ftyp := ftyp.BaseTyp; atyp := atyp.BaseTyp;
  117.                 IF ftyp.form # DynArr THEN
  118.                     IF ftyp # atyp THEN
  119.                         IF ~varpar & (ftyp.form = Pointer) & (atyp.form = Pointer) THEN
  120.                             ftyp := ftyp.BaseTyp; atyp := atyp.BaseTyp;
  121.                             IF (ftyp.form = Record) & (atyp.form = Record) THEN
  122.                                 WHILE (ftyp # atyp) & (atyp # NIL) DO atyp := atyp.BaseTyp END ;
  123.                                 IF atyp = NIL THEN OBS.Mark(113) END
  124.                             ELSE OBS.Mark(67)
  125.                             END
  126.                         ELSE OBS.Mark(67)
  127.                         END
  128.                     END ;
  129.                     EXIT
  130.                 END
  131.             END
  132.         END
  133.     END DynArrBnd;
  134.     PROCEDURE Trap*(n: INTEGER);
  135.     BEGIN OBC.PutF1(0F2H); OBC.PutByte(n)  (*BPT n*)
  136.     END Trap;
  137.     PROCEDURE CompareParLists*(x, y: OBT.Object);
  138.         VAR xt, yt: OBT.Struct;
  139.     BEGIN
  140.         WHILE x # NIL DO
  141.             IF y # NIL THEN
  142.                 xt := x.typ; yt := y.typ;
  143.                 WHILE (xt.form = DynArr) & (yt.form = DynArr) DO
  144.                     xt := xt.BaseTyp; yt := yt.BaseTyp
  145.                 END ;
  146.                 IF x.mode # y.mode THEN OBS.Mark(115)
  147.                 ELSIF xt # yt THEN
  148.                     IF (xt.form = ProcTyp) & (yt.form = ProcTyp) THEN
  149.                         CompareParLists(xt.link, yt.link)
  150.                     ELSE OBS.Mark(115)
  151.                     END
  152.                 END ;
  153.                 y := y.next
  154.             ELSE OBS.Mark(116)
  155.             END ;
  156.             x := x.next
  157.         END ;
  158.         IF (y # NIL) & (y.mode <= Ind) & (y.a0 > 0) THEN OBS.Mark(117) END
  159.     END CompareParLists;
  160.     PROCEDURE Assign*(VAR x, y: OBT.Item; param: BOOLEAN);
  161.         VAR f, g, L, u: INTEGER; s, vsz: LONGINT;
  162.                 p, q: OBT.Struct;
  163.                 tag, tdes: OBT.Item;
  164.     BEGIN f := x.typ.form; g := y.typ.form;
  165.         IF x.mode = Con THEN OBS.Mark(56)
  166.         ELSIF (x.mode IN {Var, VarX}) & (x.lev < 0) THEN OBS.Mark(-3)
  167.         END ;
  168.         CASE f OF
  169.         Undef, String:
  170.     | Byte: IF g IN {Undef, Byte, Char, SInt} THEN
  171.                         IF param THEN moveBD(x, y) ELSE move(0, x, y) END
  172.                     ELSE OBS.Mark(113)
  173.                     END
  174.     | Bool: IF param THEN u := 3 ELSE u := 0 END ;
  175.                     IF y.mode = Coc THEN
  176.                         IF (y.a1 = 0) & (y.a2 = 0) THEN OBC.PutF2(u+3CH, y.a0, x)
  177.                         ELSE
  178.                             IF ODD(y.a0) THEN OBC.PutF0(y.a0-1) ELSE OBC.PutF0(y.a0+1) END ;
  179.                             OBC.PutWord(y.a2); y.a2 := OBC.pc-2;
  180.                             OBC.FixLink(y.a1); OBC.PutF2(u+5CH, 1, x);
  181.                             OBC.PutF0(14); L := OBC.pc; OBC.PutWord(0);
  182.                             OBC.FixLink(y.a2); OBC.PutF2(u+5CH, 0, x); OBC.fixup(L)
  183.                         END
  184.                     ELSIF g = Bool THEN
  185.                         IF y.mode = Con THEN OBC.PutF2(u+5CH, y.a0, x)
  186.                         ELSIF param THEN OBC.Put(F7, 18H, x, y)  (*MOVZBD*)
  187.                         ELSE OBC.PutF4(14H, x, y)
  188.                         END
  189.                     ELSE OBS.Mark(113)
  190.                     END
  191.     | Char, SInt:
  192.                     IF g = f THEN
  193.                         IF param THEN moveBD(x, y) ELSE move(0, x, y) END
  194.                     ELSE OBS.Mark(113)
  195.                     END
  196.     | Int:  IF g = Int THEN
  197.                         IF param THEN moveWD(x, y) ELSE move(1, x, y) END
  198.                     ELSIF g = SInt THEN
  199.                         IF param THEN moveBD(x, y) ELSE moveBW(x, y) END
  200.                     ELSE OBS.Mark(113)
  201.                     END
  202.     | LInt: IF g = LInt THEN move(3, x, y)
  203.                     ELSIF g = Int THEN moveWD(x, y)
  204.                     ELSIF g = SInt THEN moveBD(x, y)
  205.                     ELSE OBS.Mark(113)
  206.                     END
  207.     | Real: IF g = Real THEN OBC.Put(F11, 5, x, y)
  208.                     ELSIF (SInt <= g) & (g <= LInt) THEN OBC.Put(F9, lengcode[g]+4, x, y)
  209.                     ELSE OBS.Mark(113)
  210.                     END
  211.     | LReal:IF g = LReal THEN OBC.Put(F11, 4, x, y)
  212.                     ELSIF g = Real THEN OBC.Put(F9, 1BH, x, y)
  213.                     ELSIF (SInt <= g) & (g <= LInt) THEN OBC.Put(F9, lengcode[g], x, y)
  214.                     ELSE OBS.Mark(113)
  215.                     END
  216.     | Set:  IF g = f THEN move(3, x, y) ELSE OBS.Mark(113) END
  217.     | Pointer:
  218.                     IF x.typ = y.typ THEN move(3, x, y)
  219.                     ELSIF g = NilTyp THEN OBC.PutF2(5FH, 0, x)
  220.                     ELSIF g = Pointer THEN
  221.                         p := x.typ.BaseTyp; q := y.typ.BaseTyp;
  222.                         IF (p.form = Record) & (q.form = Record) THEN
  223.                             WHILE (q # p) & (q # NIL) DO q := q.BaseTyp END ;
  224.                             IF q # NIL THEN move(3, x, y) ELSE OBS.Mark(113) END
  225.                         ELSE OBS.Mark(113)
  226.                         END
  227.                     ELSE OBS.Mark(113)
  228.                     END
  229.     | Array: s := x.typ.size;
  230.                     IF x.typ = y.typ THEN MoveBlock(x, y, s, param)
  231.                     ELSIF (g = String) & (x.typ.BaseTyp.form = Char) THEN
  232.                         s := y.a1; vsz := x.typ.size;  (*check length of string*)
  233.                         IF s > vsz THEN OBS.Mark(114) END ;
  234.                         IF param THEN
  235.                             vsz := (vsz+3) DIV 4 - (s+3) DIV 4;
  236.                             IF vsz > 0 THEN AdjustSP(vsz*4) END
  237.                         END ;
  238.                         MoveBlock(x, y, s, param)
  239.                     ELSE OBS.Mark(113)
  240.                     END
  241.     | DynArr: s := x.typ.size;
  242.                     IF param THEN (*formal parameter is open array*)
  243.                         IF (g = String) & (x.typ.BaseTyp.form = Char) THEN Leng(x, y.a1)
  244.                         ELSIF y.mode >= Abs THEN OBS.Mark(59)
  245.                         ELSE DynArrBnd(x.typ, y.typ, y.lev, y.a0, FALSE)
  246.                         END ;
  247.                         IF g = DynArr THEN OBC.DynArrAdr(x, y)
  248.                         ELSE OBC.PutF4(27H, x, y)
  249.                         END
  250.                     ELSE OBS.Mark(113)
  251.                     END
  252.     | Record: s := x.typ.size;
  253.                     IF x.typ # y.typ THEN
  254.                         IF g = Record THEN
  255.                             q := y.typ.BaseTyp;
  256.                             WHILE (q # NIL) & (q # x.typ) DO q := q.BaseTyp END ;
  257.                             IF q = NIL THEN OBS.Mark(113) END
  258.                         ELSE OBS.Mark(113)
  259.                         END
  260.                     END;
  261.                     IF OBC.typchk & ~param &
  262.                         ( ((x.mode = Ind) OR (x.mode = RegI)) & (x.obj = OBC.wasderef)    (* p^ := *)
  263.                             OR (x.mode = Ind) & (x.obj # NIL) & (x.obj # OBC.wasderef) )    (* varpar := *) THEN
  264.                         tag := x; tdes.mode := Var; tdes.lev := -x.typ.mno; tdes.a0 := x.typ.adr;
  265.                         IF x.obj = OBC.wasderef THEN tag.a1 := - 4
  266.                         ELSE tag.mode := Var; INC(tag.a0, 4)
  267.                         END;
  268.                         OBC.PutF4(7, tdes, tag);    (* CMPD tag, tdes *)
  269.                         OBC.PutF0(0); OBC.PutDisp(4);    (* BEQ continue *)
  270.                         OBC.PutF1(0F2H); OBC.PutByte(19)    (* BPT 19 *)
  271.                     END;
  272.                     MoveBlock(x, y, s, param)
  273.     | ProcTyp:
  274.                     IF (x.typ = y.typ) OR (y.typ.form = NilTyp) THEN OBC.PutF4(17H, x, y)
  275.                     ELSIF (y.mode = LProc) & (y.lev <= 0) OR (y.mode = IProc) THEN
  276.                         (*procedure y to proc. variable x; check compatibility*)
  277.                         IF x.typ.BaseTyp = y.typ THEN
  278.                             CompareParLists(x.typ.link, y.obj.dsc);
  279.                             IF (y.a0 = 0) & (y.lev >= 0) THEN OBS.Mark(235) (*forward*) END ;
  280.                             y.mode := Var; OBC.PutF4(27H, x, y)   (*ADDR*)
  281.                         ELSE OBS.Mark(118)
  282.                         END
  283.                     ELSE OBS.Mark(111)
  284.                     END
  285.     | NoTyp, NilTyp: OBS.Mark(111)
  286.         END
  287.     END Assign;
  288.     PROCEDURE FJ*(VAR loc: INTEGER);
  289.     BEGIN OBC.PutF0(14); OBC.PutWord(loc); loc := OBC.pc-2
  290.     END FJ;
  291.     PROCEDURE CFJ*(VAR x: OBT.Item; VAR loc: INTEGER);
  292.     BEGIN
  293.         IF x.typ.form = Bool THEN
  294.             IF x.mode # Coc THEN OBC.PutF2(1CH, 1, x); setCC(x, 0) END
  295.         ELSE OBS.Mark(120); setCC(x, 0)
  296.         END ;
  297.         IF ODD(x.a0) THEN OBC.PutF0(x.a0-1) ELSE OBC.PutF0(x.a0+1) END ;
  298.         loc := OBC.pc; OBC.PutWord(x.a2); OBC.FixLink(x.a1)
  299.     END CFJ;
  300.     PROCEDURE BJ*(loc: INTEGER);
  301.     BEGIN OBC.PutF0(14); OBC.PutDisp(loc - OBC.pc + 1)
  302.     END BJ;
  303.     PROCEDURE CBJ*(VAR x: OBT.Item; loc: INTEGER);
  304.     BEGIN
  305.         IF x.typ.form = Bool THEN
  306.             IF x.mode # Coc THEN OBC.PutF2(1CH, 1, x); setCC(x,0) END
  307.         ELSE OBS.Mark(120); setCC(x, 0)
  308.         END ;
  309.         IF ODD(x.a0) THEN OBC.PutF0(x.a0-1) ELSE OBC.PutF0(x.a0+1) END ;
  310.         OBC.PutDisp(loc - OBC.pc + 1);
  311.         OBC.FixLinkWith(x.a2, loc); OBC.FixLink(x.a1)
  312.     END CBJ;
  313.     PROCEDURE LFJ*(VAR loc: INTEGER);
  314.     BEGIN OBC.PutF0(14); OBC.PutWord(-4000H); OBC.PutWord(0); loc := OBC.pc-4
  315.     END LFJ;
  316.     PROCEDURE PrepCall*(VAR x: OBT.Item; VAR fpar: OBT.Object);
  317.     BEGIN
  318.         IF (x.mode = LProc) OR (x.mode = CProc) THEN
  319.             fpar := x.obj.dsc
  320.         ELSIF (x.typ # NIL) & (x.typ.form = ProcTyp) THEN
  321.             fpar := x.typ.link
  322.         ELSE OBS.Mark(121); fpar := NIL; x.typ := OBT.undftyp
  323.         END
  324.     END PrepCall;
  325.     PROCEDURE Param*(VAR ap: OBT.Item; f: OBT.Object);
  326.         VAR q: OBT.Struct; fp, tag: OBT.Item;
  327.     BEGIN fp.mode := Stk; fp.typ := f.typ;
  328.         IF f.mode = Ind THEN (*VAR parameter*)
  329.             IF ap.mode >= Con THEN OBS.Mark(122) END ;
  330.             IF fp.typ.form = DynArr THEN
  331.                 DynArrBnd(fp.typ, ap.typ, ap.lev, ap.a0, TRUE);
  332.                 IF ap.typ.form = DynArr THEN OBC.DynArrAdr(fp, ap)
  333.                 ELSE OBC.PutF4(27H, fp, ap)
  334.                 END
  335.             ELSIF (fp.typ.form = Record) & (ap.typ.form = Record) THEN
  336.                 q := ap.typ;
  337.                 WHILE (q # fp.typ) & (q # NIL) DO q := q.BaseTyp END ;
  338.                 IF q # NIL THEN
  339.                     IF (ap.mode = Ind) & (ap.obj # NIL) & (ap.obj # OBC.wasderef) THEN
  340.                         (*actual par is VAR-par*)
  341.                         ap.mode := Var; ap.a0 := ap.a0 + 4; OBC.PutF4(17H, fp, ap);
  342.                         ap.a0 := ap.a0 - 4; OBC.PutF4(17H, fp, ap)
  343.                     ELSIF ((ap.mode = Ind) OR (ap.mode = RegI)) & (ap.obj = OBC.wasderef) THEN
  344.                         (*actual par is p^*)
  345.                         ap.a1 := - 4; OBC.PutF4(17H, fp, ap);
  346.                         IF ap.mode = Ind THEN ap.mode := Var ELSE ap.mode := Reg END;
  347.                         OBC.PutF4(17H, fp, ap)
  348.                     ELSE
  349.                         tag.mode := Var; tag.lev := -ap.typ.mno; tag.a0 := ap.typ.adr;
  350.                         OBC.PutF4(17H, fp, tag); OBC.PutF4(27H, fp, ap)
  351.                     END
  352.                 ELSE OBS.Mark(111)
  353.                 END
  354.             ELSIF (ap.typ = fp.typ) OR ((fp.typ.form = Byte) & (ap.typ.form IN {Char, SInt})) THEN
  355.                 IF (ap.mode = Ind) & (ap.a1 = 0) THEN (*actual var par*)
  356.                     ap.mode := Var; OBC.PutF4(17H, fp, ap)
  357.                 ELSE OBC.PutF4(27H, fp, ap)
  358.                 END
  359.             ELSE OBS.Mark(123)
  360.             END
  361.         ELSE Assign(fp, ap, TRUE)
  362.         END
  363.     END Param;
  364.     PROCEDURE Call*(VAR x: OBT.Item);
  365.         VAR stk, sL: OBT.Item;
  366.     BEGIN
  367.         IF x.mode = LProc THEN
  368.             IF x.lev >= 0 THEN
  369.                 IF x.lev > 0 THEN
  370.                     sL.mode := Var; sL.typ := OBT.linttyp; sL.lev := x.lev; sL.a0 := 0;
  371.                     stk.mode := Stk; OBC.PutF4(27H, stk, sL)  (*static link*)
  372.                 END ;
  373.                 OBC.PutF1(2);  (*BSR*)
  374.                 IF x.a0 = 0 THEN OBC.PutWord(x.a1); x.obj.a1 := OBC.pc - 2 (*forward link*)
  375.                 ELSE OBC.PutDisp(x.a0 - OBC.pc + 1)
  376.                 END
  377.             ELSE OBC.PutF1(2); OBC.PutExtAdr(-x.lev, x.a0) (*BSR*)
  378.             END
  379.         ELSIF (x.mode < Con) & (x.typ.form # Undef) THEN
  380.             IF (x.mode = Var) & (x.lev > 0) & (x.lev = OBC.level) THEN x.mode := Ind
  381.             ELSE load(x); x.mode := RegI
  382.             END ;
  383.             x.a1 := 0; OBC.PutF2(7FH, 12, x); x.typ := x.typ.BaseTyp  (*JSRD*)
  384.         ELSIF x.mode = CProc THEN
  385.             OBC.PutF1(0E2H); OBC.PutByte(x.a0)            (*SVC n*)
  386.         ELSE OBS.Mark(121)
  387.         END
  388.         (*function result is marked when restoring registers*)
  389.     END Call;
  390.     PROCEDURE Enter*(mode: SHORTINT; VAR L: INTEGER);
  391.     BEGIN OBC.CheckCodeSize; OBC.PutF1(82H);  (*ENTER*)
  392.         IF mode = IProc THEN OBC.PutByte(0C0H) ELSE OBC.PutByte(0) END ;
  393.         IF mode = Mod THEN OBC.PutByte(0)
  394.         ELSIF stkchk & (mode # IProc) THEN (*check SP against stack limit*)
  395.             L := OBC.pc; OBC.PutWord(0);
  396.             OBC.PutF3(-47D9H); OBC.PutF3(547H); OBC.PutDisp(3FF0H);  (*ADDR TOS, R0; CMPD R0, lim*)
  397.             OBC.PutF0(4); OBC.PutDisp(4); OBC.PutF1(0F2H); OBC.PutByte(14);  (*BHI *+4  BPT 14*)
  398.         ELSIF clrchk THEN (*clear local frame*)
  399.             OBC.PutByte(0); OBC.PutF3(-57D9H); L := OBC.pc; OBC.PutWord(0);  (*ADDR @n, R0*)
  400.             OBC.PutF3(-47A1H); OBC.PutF3(64DH); OBC.PutDisp(-2)   (*MOVQD 0, TOS;  ACBW -4, R0, -2*)
  401.         ELSE L := OBC.pc; OBC.PutWord(0)
  402.         END
  403.     END Enter;
  404.     PROCEDURE CopyDynArray*(adr: LONGINT; typ: OBT.Struct);
  405.         VAR size, ptr, m2, tos: OBT.Item;
  406.         PROCEDURE DynArrSize(typ: OBT.Struct);
  407.             VAR len: OBT.Item;
  408.         BEGIN
  409.             IF typ.form = DynArr THEN DynArrSize(typ.BaseTyp);
  410.                 len.mode := Var; len.lev := OBC.level; len.typ := OBT.linttyp;
  411.                 len.a0 := adr + typ.adr; load(len);
  412.                 IF size.a0 # 1 THEN OBC.Put(F7, 23H, len, size)    (* MULD size, len *) END;
  413.                 size := len
  414.             ELSE size.mode := Con; size.typ := OBT.linttyp; size.a0 := typ.size
  415.             END
  416.         END DynArrSize;
  417.     BEGIN
  418.         DynArrSize(typ);    (* load total byte size of dyn array *)
  419.         OBC.PutF2(0FH, 3, size);    (* ADDQD 3, size *)
  420.         m2.mode := Con; m2.typ := OBT.sinttyp;
  421.         m2.a0 := -2; OBC.Put(F6, 7, size, m2);    (* ASHD -2, size *)
  422.         ptr.mode := Var; ptr.lev := OBC.level; ptr.typ := OBT.linttyp;
  423.         ptr.a0 := adr; load(ptr); 
  424.         ptr.mode := RegX; ptr.a1 := -4; ptr.a2 := size.a0; tos.mode := Stk;
  425.         OBC.PutF4(17H, tos, ptr);    (* loop:    MOVD -4(ptr)[size:D], TOS *)
  426.         OBC.PutF2(4FH, -1, size); OBC.PutDisp(-4);    (* ACBD -1, size, loop *)
  427.         OBC.PutF3(-31D9H); OBC.PutDisp(0); OBC.PutDisp(adr);    (* ADDR 0(SP), adr(FP) *)
  428.         OBC.FreeRegs({})
  429.     END CopyDynArray;
  430.     PROCEDURE Result*(VAR x: OBT.Item; typ: OBT.Struct);
  431.         VAR res: OBT.Item;
  432.     BEGIN res.mode := Reg; res.typ := typ; res.a0 := 0;
  433.         Assign(res, x, FALSE)
  434.     END Result;
  435.     PROCEDURE Return*(mode: INTEGER; psize: LONGINT);
  436.     BEGIN OBC.PutF1(92H);                                     (*EXIT*)
  437.         IF mode = LProc THEN
  438.             OBC.PutByte(0); OBC.PutF1(12H); OBC.PutDisp(psize-8)  (*RET*)
  439.         ELSIF mode = IProc THEN
  440.             OBC.PutByte(3); OBC.PutF1(42H); OBC.PutDisp(0)        (*RETT 0*)
  441.         END
  442.     END Return;
  443.     PROCEDURE CaseIn*(VAR x: OBT.Item; VAR L0, L1: INTEGER);
  444.         VAR f: INTEGER; x0, z: OBT.Item;
  445.     BEGIN f := x.typ.form;
  446.         IF f = LInt THEN load(x)
  447.         ELSIF f = Int THEN x0 := x; OBC.GetReg(x); OBC.Put(F7, 1DH, x, x0)  (*MOVXWD*)
  448.         ELSIF f = Char THEN x0 := x; OBC.GetReg(x); OBC.Put(F7, 18H, x, x0)  (*MOVZBD*)
  449.         ELSIF f = SInt THEN x0 := x; OBC.GetReg(x); OBC.Put(F7, 1CH, x, x0)  (*MOVXBD*)
  450.         ELSE OBS.Mark(125)
  451.         END ;
  452.         z.mode := Con; z.typ := OBT.linttyp; z.a0 := 0; OBC.PutF4(23H, x, z);   (*SUBi*)
  453.         L0 := OBC.pc; OBC.PutF4(7, z, x);   (*CMPi*)
  454.         OBC.PutF0(11); OBC.PutWord(0);   (*BHS*)
  455.         L1 := OBC.pc; OBC.PutF3(-1083H); OBC.PutByte(x.a0+0D8H); OBC.PutWord(0)  (*CASE*)
  456.     END CaseIn;
  457.     PROCEDURE CaseOut*(L0, L1, L2, L3, n: INTEGER;
  458.                                          VAR tab: ARRAY OF LabelRange);
  459.         VAR i, j, lim, len: INTEGER; k: LONGINT;
  460.     BEGIN (*generate jump table*)
  461.         IF ODD(OBC.pc) THEN OBC.PutByte(0A2H) END ;
  462.         IF n > 0 THEN len := tab[n-1].high - tab[0].low + 1 ELSE len := 0 END ;
  463.         OBC.PutByte(6); OBC.PutF3(len);   (*for decoder*)
  464.         OBC.FixupImm(L0, tab[0].low);  (*SUB*)
  465.         OBC.FixupImm(L1-3, len);  (*CMP*)
  466.         OBC.FixupWith(L1-2, L2-L1+3);  (*out of bounds jump addr*)
  467.         OBC.FixupWith(L1+3, OBC.pc-L1);     (*jump address to table*)
  468.         i := 0; j := tab[0].low;
  469.         WHILE i < n DO
  470.             lim := tab[i].high;
  471.             WHILE j < tab[i].low DO OBC.PutF3(L2-L1); INC(j) END ;
  472.             WHILE j <= lim DO OBC.PutF3(tab[i].label-L1); INC(j) END ;
  473.             INC(i)
  474.         END ;
  475.         OBC.FixLink(L3)
  476.     END CaseOut;
  477. BEGIN
  478.     lengcode[Undef] := 0;
  479.     lengcode[Byte] := 0;
  480.     lengcode[Bool] := 0;
  481.     lengcode[Char] := 0;
  482.     lengcode[SInt] := 0;
  483.     lengcode[Int] := 1;
  484.     lengcode[LInt] := 3;
  485.     lengcode[Real] := 1;
  486.     lengcode[LReal] := 0;
  487.     lengcode[Set] := 3;
  488.     lengcode[String] := 0;
  489.     lengcode[NilTyp] := 3;
  490.     lengcode[ProcTyp] := 3;
  491.     lengcode[Pointer] := 3;
  492.     lengcode[Array] := 1;
  493.     lengcode[DynArr] := 1;
  494.     lengcode[Record] := 1;
  495. END OBH.
  496.