Oberon/V2/OCC

MODULE OCC; (*NW 30.5.87 / 16.3.91*) IMPORT Files, OCS, OCT; CONST CodeLength = 18000; LinkLength = 250; ConstLength = 3500; EntryLength = 64; CodeLim = CodeLength - 100; MaxPtrs = 64; MaxRecs = 32; MaxComs = 40; MaxExts = 7; (*instruction format prefixes*) F6 = 4EH; F7 = 0CEH; F9 = 3EH; F11 = 0BEH; (*object and item modes*) Var = 1; VarX = 2; Ind = 3; IndX = 4; RegI = 5; RegX = 6; Abs = 7; Con = 8; Stk = 9; Coc = 10; Reg = 11; Fld = 12; Typ = 13; LProc = 14; XProc = 15; SProc = 16; CProc = 17; IProc = 18; Mod = 19; Head = 20; (*structure forms*) Undef = 0; Byte = 1; Bool = 2; Char = 3; SInt = 4; Int = 5; LInt = 6; Real = 7; LReal = 8; Set = 9; String = 10; NilTyp = 11; NoTyp = 12; Pointer = 13; ProcTyp = 14; Array = 15; DynArr = 16; Record = 17; TYPE Argument = RECORD form, gen, inx: INTEGER; d1, d2: LONGINT END ; VAR pc*, level*: INTEGER; wasderef*: OCT.Object; typchk*: BOOLEAN; RegSet*, FRegSet: SET; lnkx, conx, nofptrs, nofrec: INTEGER; PtrTab: ARRAY MaxPtrs OF LONGINT; RecTab: ARRAY MaxRecs OF OCT.Struct; constant: ARRAY ConstLength OF CHAR; code: ARRAY CodeLength OF CHAR; link: ARRAY LinkLength OF INTEGER; entry: ARRAY EntryLength OF INTEGER; PROCEDURE GetReg*(VAR x: OCT.Item); VAR i: INTEGER; BEGIN i := 7; x.mode := Reg; LOOP IF ~(i IN RegSet) THEN x.a0 := i; INCL(RegSet,i); EXIT END ; IF i = 0 THEN x.a0 := 0; OCS.Mark(215); EXIT ELSE DEC(i) END ; END END GetReg; PROCEDURE GetFReg*(VAR x: OCT.Item); VAR i: INTEGER; BEGIN i := 6; x.mode := Reg; LOOP IF ~(i IN FRegSet) THEN x.a0 := i; INCL(FRegSet,i); EXIT END ; IF i = 0 THEN x.a0 := 0; OCS.Mark(216); EXIT ELSE i := i-2 END END END GetFReg; PROCEDURE FreeRegs*(r: SET); BEGIN RegSet := r; FRegSet := {} END FreeRegs; PROCEDURE AllocInt*(k: INTEGER); BEGIN IF conx < ConstLength-1 THEN constant[conx] := CHR(k); INC(conx); constant[conx] := CHR(k DIV 100H); INC(conx) ELSE OCS.Mark(230); conx := 0 END END AllocInt; PROCEDURE AllocString*(VAR s: ARRAY OF CHAR; VAR x: OCT.Item); VAR i: INTEGER; ch: CHAR; BEGIN INC(conx, (-conx) MOD 4); i := 0; REPEAT ch := s[i]; INC(i); IF conx >= ConstLength THEN OCS.Mark(230); conx := 0 END ; constant[conx] := ch; INC(conx) UNTIL ch = 0X; x.lev := 0; x.a0 := conx - i; x.a1 := i 	END AllocString; PROCEDURE AllocBounds*(min, max: INTEGER; VAR adr: LONGINT); BEGIN INC(conx, (-conx) MOD 4); adr := conx; AllocInt(max); AllocInt(min) END AllocBounds; PROCEDURE PutByte*(x: LONGINT); BEGIN code[pc] := CHR(x); INC(pc) END PutByte; PROCEDURE PutWord*(x: LONGINT); BEGIN code[pc] := CHR(x DIV 100H); INC(pc); code[pc] := CHR(x); INC(pc) END PutWord; PROCEDURE PutDbl(x: LONGINT); VAR i: INTEGER; BEGIN i := -32; REPEAT INC(i, 8); code[pc] := CHR(ASH(x, i)); INC(pc) UNTIL i = 0 END PutDbl; PROCEDURE PutDisp*(x: LONGINT); BEGIN IF x < 0 THEN IF x >= -40H THEN code[pc] := CHR(x+80H); INC(pc) ELSIF x >= -2000H THEN PutWord(x+0C000H) ELSE PutDbl(x) END ELSIF x < 40H THEN code[pc] := CHR(x); INC(pc) ELSIF x < 2000H THEN PutWord(x+8000H) ELSE PutDbl(x - 40000000H) END END PutDisp; PROCEDURE PutArg(VAR z: Argument); BEGIN CASE z.form OF 			0: IF z.inx = 1 THEN code[pc] := CHR(z.d1); INC(pc) ELSIF z.inx = 2 THEN PutWord(z.d1) ELSIF z.inx = 4 THEN PutDbl(z.d1) ELSE PutDbl(z.d2); PutDbl(z.d1) END | 1: PutDisp(z.d1) | 2, 5: 		| 3, 6: PutDisp(z.d1) | 4, 7: PutDisp(z.d1); PutDisp(z.d2) END END PutArg; PROCEDURE PutF3*(op: INTEGER); BEGIN code[pc] := CHR(op); INC(pc); code[pc] := CHR(op DIV 100H); INC(pc) END PutF3; PROCEDURE Operand(VAR x: OCT.Item; VAR z: Argument); VAR F: INTEGER; PROCEDURE downlevel(VAR gen: INTEGER); VAR n, op: INTEGER; b: OCT.Item; BEGIN GetReg(b); n := level - x.lev; gen := SHORT(b.a0) + 8; op := SHORT(b.a0)*40H - 3FE9H; IF n = 1 THEN PutF3(op); PutDisp(8); (*MOVD 8(FP) Rb*) ELSE PutF3(op - 4000H); PutDisp(8); PutDisp(8); (*MOVD 8(8(FP)) Rb*) WHILE n > 2 DO DEC(n); PutF3((SHORT(b.a0)*20H + SHORT(b.a0))*40H + 4017H); PutDisp(8) END END ; END downlevel; PROCEDURE index; VAR s: LONGINT; BEGIN s := x.typ.size; IF s = 1 THEN z.gen := 1CH ELSIF s = 2 THEN z.gen := 1DH ELSIF s = 4 THEN z.gen := 1EH ELSIF s = 8 THEN z.gen := 1FH ELSE z.gen := 1CH; PutByte(F7); PutByte(x.a2 MOD 4 * 40H + 23H); PutByte(x.a2 DIV 4 + 0A0H); PutWord(0); PutWord(s) (*MUL r s*) END ; END index; BEGIN F := x.mode; CASE x.mode OF 			Var: IF x.lev = 0 THEN z.gen := 1AH; z.d1 := x.a0; z.form := 3 ELSIF x.lev < 0 THEN (*EXT*) z.gen := 16H; z.d1 := -x.lev; z.d2 := x.a0; z.form := 4 ELSIF x.lev = level THEN z.gen := 18H; z.d1 := x.a0; z.form := 3 ELSIF x.lev+1 = level THEN z.gen := 10H; z.d1 := 8; z.d2 := x.a0; z.form := 4 ELSE downlevel(z.gen); z.d1 := x.a0; z.form := 3 END | Ind: IF x.lev = 0 THEN z.gen := 12H; z.d1 := x.a0; z.d2 := x.a1; z.form := 4 ELSIF x.lev = level THEN z.gen := 10H; z.d1 := x.a0; z.d2 := x.a1; z.form := 4 ELSE downlevel(z.gen); PutF3((z.gen*20H + z.gen-8)*40H + 17H); PutDisp(x.a0); z.d1 := x.a1; z.form := 3 END | RegI: z.gen := SHORT(x.a0)+8; z.d1 := x.a1; z.form := 3 | VarX: index; IF x.lev = 0 THEN z.inx := 1AH; z.d1 := x.a0; z.form := 6 ELSIF x.lev < 0 THEN (*EXT*) z.inx := 16H; z.d1 := -x.lev; z.d2 := x.a0; z.form := 7 ELSIF x.lev = level THEN z.inx := 18H; z.d1 := x.a0; z.form := 6 ELSIF x.lev+1 = level THEN z.inx := 10H; z.d1 := 8; z.d2 := x.a0; z.form := 7 ELSE downlevel(z.inx); z.d1 := x.a0; z.form := 6 END ; z.inx := z.inx*8 + SHORT(x.a2) | IndX: index; IF x.lev = 0 THEN z.inx := 12H; z.d1 := x.a0; z.d2 := x.a1; z.form := 7 ELSIF x.lev = level THEN z.inx := 10H; z.d1 := x.a0; z.d2 := x.a1; z.form := 7 ELSE downlevel(z.inx); PutF3((z.inx*20H + z.inx-8)*40H + 17H); PutDisp(x.a0); z.d1 := x.a1; z.form := 6 END ; z.inx := z.inx * 8 + SHORT(x.a2) | RegX: index; z.inx := SHORT((x.a0+8)*8 + x.a2); z.d1 := x.a1; z.form := 6 | Con: CASE x.typ.form OF 				Undef, Byte, Bool, Char, SInt: z.gen := 14H; z.inx := 1; z.d1 := x.a0; z.form := 0 | Int: z.gen := 14H; z.inx := 2; z.d1 := x.a0; z.form := 0 | LInt, Real, Set, Pointer, ProcTyp, NilTyp: z.gen := 14H; z.inx := 4; z.d1 := x.a0; z.form := 0 | LReal: z.gen := 14H; z.inx := 8; z.d1 := x.a0; z.d2 := x.a1; z.form := 0 | String: z.gen := 1AH; z.d1 := x.a0; z.form := 3 END | Reg: z.gen := SHORT(x.a0); z.form := 2 | Stk: z.gen := 17H; z.form := 2 | Abs: z.gen := 15H; z.form := 1; z.d1 := x.a0 | Coc, Fld .. Head: OCS.Mark(126); x.mode := Var; z.form := 0 END END Operand; PROCEDURE PutF0*(cond: LONGINT); BEGIN code[pc] := CHR(cond*10H + 10); INC(pc) END PutF0; PROCEDURE PutF1*(op: INTEGER); BEGIN code[pc] := CHR(op); INC(pc) END PutF1; PROCEDURE PutF2*(op: INTEGER; short: LONGINT; VAR x: OCT.Item); VAR dst: Argument; BEGIN Operand(x, dst); code[pc] := CHR(SHORT(short) MOD 2 * 80H + op); INC(pc); code[pc] := CHR(dst.gen*8 + SHORT(short) MOD 10H DIV 2); INC(pc); IF dst.form > 4 THEN code[pc] := CHR(dst.inx); INC(pc) END ; PutArg(dst) END PutF2; PROCEDURE PutF4*(op: INTEGER; VAR x, y: OCT.Item); VAR dst, src: Argument; BEGIN Operand(x, dst); Operand(y, src); code[pc] := CHR(dst.gen MOD 4 * 40H + op); INC(pc); code[pc] := CHR(src.gen*8 + dst.gen DIV 4); INC(pc); IF src.form > 4 THEN code[pc] := CHR(src.inx); INC(pc) END ; IF dst.form > 4 THEN code[pc] := CHR(dst.inx); INC(pc) END ; PutArg(src); PutArg(dst) END PutF4; PROCEDURE Put*(F, op: INTEGER; VAR x, y: OCT.Item); VAR dst, src: Argument; BEGIN Operand(x, dst); Operand(y, src); code[pc] := CHR(F); INC(pc); code[pc] := CHR(dst.gen MOD 4 * 40H + op); INC(pc); code[pc] := CHR(src.gen*8 + dst.gen DIV 4); INC(pc); IF src.form > 4 THEN code[pc] := CHR(src.inx); INC(pc) END ; IF dst.form > 4 THEN code[pc] := CHR(dst.inx); INC(pc) END ; PutArg(src); PutArg(dst) END Put; PROCEDURE AllocTypDesc*(typ: OCT.Struct); (* typ.form = Record *) BEGIN INC(conx, (-conx) MOD 4); typ.mno := 0; typ.adr := conx; IF typ.n > MaxExts THEN OCS.Mark(233) ELSIF nofrec < MaxRecs THEN PtrTab[nofptrs] := conx; INC(nofptrs); RecTab[nofrec] := typ; INC(nofrec); AllocInt(0); AllocInt(0) ELSE OCS.Mark(223) END END AllocTypDesc; PROCEDURE InitTypDescs*; VAR x, y: OCT.Item; i: INTEGER; typ: OCT.Struct; BEGIN x.mode := Ind; x.lev := 0; y.mode := Var; i := 0; WHILE i < nofrec DO typ := RecTab[i]; INC(i); x.a0 := typ.adr; WHILE typ.BaseTyp # NIL DO (*initialization of base tag fields*) x.a1 := typ.n * 4; y.lev := -typ.mno; y.a0 := typ.adr; PutF4(17H, x, y); typ := typ.BaseTyp END END END InitTypDescs; PROCEDURE SaveRegisters*(VAR gR, fR: SET; VAR x: OCT.Item); VAR i, r, m: INTEGER; t: SET; BEGIN t := RegSet; IF x.mode IN {Reg, RegI, RegX} THEN EXCL(RegSet, x.a0) END ; IF x.mode IN {VarX, IndX, RegX} THEN EXCL(RegSet, x.a2) END ; gR := RegSet; fR := FRegSet; IF RegSet # {} THEN i := 0; r := 1; m := 0; REPEAT IF i IN RegSet THEN INC(m, r) END ; INC(r, r); INC(i) UNTIL i = 8; PutF1(62H); PutByte(m) END ; RegSet := t - RegSet; i := 0; WHILE FRegSet # {} DO 			IF i IN FRegSet THEN PutF1(F11); PutF3(i*800H + 5C4H); EXCL(FRegSet, i) 			END ; INC(i, 2) END END SaveRegisters; PROCEDURE RestoreRegisters*(gR, fR: SET; VAR x: OCT.Item); VAR i, r, m: INTEGER; y: OCT.Item; BEGIN RegSet := gR; FRegSet := fR; i := 8; (*set result mode*) x.mode := Reg; x.a0 := 0; IF (x.typ.form = Real) OR (x.typ.form = LReal) THEN IF 0 IN fR THEN GetFReg(y); Put(F11, 4, y, x); x.a0 := y.a0 END ; INCL(FRegSet, 0) ELSE IF 0 IN gR THEN GetReg(y); PutF4(17H, y, x); x.a0 := y.a0 END ; INCL(RegSet, 0) END ; WHILE fR # {} DO 			DEC(i, 2); IF i IN fR THEN PutF1(F11); PutF3(i*40H - 47FCH); EXCL(fR, i) 			END END ; IF gR # {} THEN i := 8; r := 1; m := 0; REPEAT DEC(i); IF i IN gR THEN INC(m, r) END ; INC(r, r) 			UNTIL i = 0; PutF1(72H); PutF1(m) END END RestoreRegisters; PROCEDURE DynArrAdr*(VAR x, y: OCT.Item); (* x := ADR(y) *) VAR l, z: OCT.Item; BEGIN WHILE y.typ.form = DynArr DO					(* index with 0 *) IF y.mode = IndX THEN l.mode := Var; l.a0 := y.a0 + y.typ.adr; l.lev := y.lev; (* l = actual dimension length - 1 *) z.mode := Con; z.a0 := 0; z.typ := OCT.inttyp; Put(2EH, SHORT(y.a2)*8+5, z, l) (* INDEXW inxreg, l, 0 *) END; y.typ := y.typ.BaseTyp END; IF (y.mode = Var) OR (y.mode = Ind) & (y.a1 = 0) THEN y.mode := Var; PutF4(17H, x, y)				(* MOVD *) ELSE PutF4(27H, x, y); x.a1 := 0						(* ADDR *) END END DynArrAdr; PROCEDURE Entry*(i: INTEGER): INTEGER; BEGIN RETURN entry[i] END Entry; PROCEDURE SetEntry*(i: INTEGER); BEGIN entry[i] := pc 	END SetEntry; PROCEDURE LinkAdr*(m: INTEGER; n: LONGINT): INTEGER; BEGIN IF lnkx >= LinkLength THEN OCS.Mark(231); lnkx := 0 END ; link[lnkx] := m*100H + SHORT(n); INC(lnkx); RETURN lnkx-1 END LinkAdr; PROCEDURE SetLinkTable*(n: INTEGER); BEGIN (*base addresses of imported modules*) lnkx := 0; WHILE lnkx < n DO link[lnkx] := lnkx*100H + 255; INC(lnkx) END END SetLinkTable; PROCEDURE fixup*(loc: LONGINT); (*enter pc at loc*) VAR x: LONGINT; BEGIN x := pc - loc + 8001H; code[loc] := CHR(x DIV 100H); code[loc+1] := CHR(x) END fixup; PROCEDURE fixupC*(loc: LONGINT); VAR x: LONGINT; BEGIN x := pc+1 - loc; IF x > 3 THEN IF x < 2000H THEN364 code[loc] := CHR(x DIV 100H + 80H); code[loc+1] := CHR(x) ELSE OCS.Mark(211) END ELSE DEC(pc, 3) END END fixupC; PROCEDURE fixupL*(loc: LONGINT); VAR x: LONGINT; BEGIN x := pc+1 - loc; IF x > 5 THEN code[loc+2] := CHR(x DIV 100H); code[loc+3] := CHR(x) ELSE DEC(pc, 5) END END fixupL; PROCEDURE FixLink*(L: LONGINT); VAR L1: LONGINT; BEGIN WHILE L # 0 DO 			L1 := ORD(code[L])*100H + ORD(code[L+1]); fixup(L); L := L1 		END END FixLink; PROCEDURE FixupWith*(L, val: LONGINT); VAR x: LONGINT; BEGIN x := val MOD 4000H + 8000H; IF ABS(val) >= 2000H THEN OCS.Mark(208) END ; code[L] := CHR(x DIV 100H); code[L+1] := CHR(x) END FixupWith; PROCEDURE FixLinkWith*(L, val: LONGINT); VAR L1: LONGINT; BEGIN WHILE L # 0 DO 			L1 := ORD(code[L])*100H + ORD(code[L+1]); FixupWith(L, val+1 - L); L := L1 		END END FixLinkWith; PROCEDURE MergedLinks*(L0, L1: LONGINT): LONGINT; VAR L2, L3: LONGINT; BEGIN (*merge chains of the two operands of AND and OR *) IF L0 # 0 THEN L2 := L0; LOOP L3 := ORD(code[L2])*100H + ORD(code[L2+1]); IF L3 = 0 THEN EXIT END ; L2 := L3 			END ; code[L2] := CHR(L1 DIV 100H); code[L2+1] := CHR(L1); RETURN L0 		ELSE RETURN L1 		END END MergedLinks; PROCEDURE Init*; VAR i: INTEGER; BEGIN pc := 0; level := 0; lnkx := 0; conx := 0; nofptrs := 0; nofrec := 0; RegSet := {}; FRegSet := {}; i := 0; REPEAT entry[i] := 0; INC(i) UNTIL i = EntryLength END Init; PROCEDURE OutCode*(VAR name, progid: ARRAY OF CHAR; 							key: LONGINT; entno: INTEGER; datasize: LONGINT); CONST ObjMark = 0F8X; VAR ch: CHAR; f, i, m: INTEGER; K, s, s0, refpos: LONGINT; nofcom, comsize, align: INTEGER; obj: OCT.Object; typ: OCT.Struct; ObjFile: Files.File; out: Files.Rider; ComTab: ARRAY MaxComs OF OCT.Object; PROCEDURE W(n: INTEGER); BEGIN Files.Write(out, CHR(n)); Files.Write(out, CHR(n DIV 100H)) END W; 		PROCEDURE WriteName(VAR name: ARRAY OF CHAR; n: INTEGER); VAR i: INTEGER; ch: CHAR; BEGIN i := 0; REPEAT ch := name[i]; Files.Write(out, ch); INC(i) UNTIL ch = 0X; WHILE i < n DO Files.Write(out, 0X); INC(i) END END WriteName; PROCEDURE FindPtrs(typ: OCT.Struct; adr: LONGINT); VAR fld: OCT.Object; btyp: OCT.Struct; i, n, s: LONGINT; BEGIN IF typ.form = Pointer THEN IF nofptrs < MaxPtrs THEN PtrTab[nofptrs] := adr; INC(nofptrs) ELSE OCS.Mark(222) END ELSIF typ.form = Record THEN btyp := typ.BaseTyp; IF btyp # NIL THEN FindPtrs(btyp, adr) END ; fld := typ.link; WHILE fld # NIL DO 					IF fld.name # "" THEN FindPtrs(fld.typ, fld.a0 + adr) ELSIF nofptrs < MaxPtrs THEN PtrTab[nofptrs] := fld.a0 + adr; INC(nofptrs) ELSE OCS.Mark(222) END ; fld := fld.next END ELSIF typ.form = Array THEN btyp := typ.BaseTyp; n := typ.n; 				WHILE btyp.form = Array DO n := btyp.n * n; btyp := btyp.BaseTyp END ; IF (btyp.form = Pointer) OR (btyp.form = Record) THEN i := 0; s := btyp.size; WHILE i < n DO FindPtrs(btyp, i*s + adr); INC(i) END END END END FindPtrs; PROCEDURE PtrsAndComs; VAR obj, par: OCT.Object; u: INTEGER; BEGIN obj := OCT.topScope.next; WHILE obj # NIL DO 				IF obj.mode = XProc THEN par := obj.dsc; IF entry[SHORT(obj.a0)] = 0 THEN OCS.Mark(129) ELSIF (obj.marked) & (obj.typ = OCT.notyp) & ((par = NIL) OR (par.mode > 3) OR (par.a0 < 0)) THEN (*command*) u := 0; WHILE obj.name[u] > 0X DO INC(comsize); INC(u) END ; INC(comsize, 3); IF nofcom < MaxComs THEN ComTab[nofcom] := obj; INC(nofcom) ELSE OCS.Mark(232); nofcom := 0; comsize := 0 END END ELSIF obj.mode = Var THEN FindPtrs(obj.typ, obj.a0) END ; obj := obj.next END END PtrsAndComs; PROCEDURE OutRefBlk(first: OCT.Object; pc: INTEGER; name: ARRAY OF CHAR); VAR obj: OCT.Object; BEGIN obj := first; WHILE obj # NIL DO 				IF obj.mode IN {LProc, XProc, IProc} THEN OutRefBlk(obj.dsc, obj.a2, obj.name) END ; obj := obj.next END ; Files.Write(out, 0F8X); Files.WriteBytes(out, pc, 2); WriteName(name, 0); obj := first; WHILE obj # NIL DO 				IF (obj.mode = Var) OR (obj.mode = Ind) THEN f := obj.typ.form; IF (f IN {Byte .. Set, Pointer}) OR (f = Array) & (obj.typ.BaseTyp.form = Char) THEN Files.Write(out, CHR(obj.mode)); Files.Write(out, CHR(f)); Files.WriteBytes(out, obj.a0, 4); WriteName(obj.name, 0) END END ; obj:= obj.next END END OutRefBlk; BEGIN (*OutCode*) ObjFile := Files.New(name); IF ObjFile # NIL THEN Files.Set(out, ObjFile, 0); WHILE pc MOD 4 # 0 DO PutF1(0A2H) END ; (*NOP*) INC(conx, (-conx) MOD 4); nofcom := 0; comsize := 1; PtrsAndComs; align := comsize MOD 2; INC(comsize, align); (*header block*) Files.Write(out, ObjMark); Files.Write(out, "6"); W(0); W(0); W(entno); W(comsize); W(nofptrs); W(OCT.nofGmod); W(lnkx); Files.WriteBytes(out, datasize, 4); W(conx); W(pc); Files.WriteBytes(out, key, 4); WriteName(progid, 20); (*entry block*) Files.Write(out, 82X); Files.WriteBytes(out, entry, 2*entno); (*command block*) Files.Write(out, 83X); i := 0; (*write command names and entry addresses*) WHILE i < nofcom DO 				obj := ComTab[i]; WriteName(obj.name, 0); W(entry[obj.a0]); INC(i) END ; Files.Write(out, 0X); IF align > 0 THEN Files.Write(out, 0FFX) END ; (*pointer block*) Files.Write(out, 84X); i := 0; WHILE i < nofptrs DO 				IF PtrTab[i] < -4000H THEN OCS.Mark(225) END ; Files.WriteBytes(out, PtrTab[i], 2); INC(i) END ; (*import block*) Files.Write(out, 85X); i := 0; WHILE i < OCT.nofGmod DO 				obj := OCT.GlbMod[i]; Files.WriteBytes(out, obj.a1, 4); WriteName(obj.name, 0); Files.Write(out, 0X); INC(i) END ; (*link block*) Files.Write(out, 86X); Files.WriteBytes(out, link, 2*lnkx); (*data block*) Files.Write(out, 87X); Files.WriteBytes(out, constant, conx); (*code block*) Files.Write(out, 88X); Files.WriteBytes(out, code, pc); (*type block*) Files.Write(out, 89X); i := 0; WHILE i < nofrec DO 				typ := RecTab[i]; s := typ.size + 4; m := 4; s0 := 16; WHILE (m > 0) & (s > s0) DO INC(s0, s0); DEC(m) END ; IF s > s0 THEN s0 := (s+127) DIV 128 * 128 END ; nofptrs := 0; FindPtrs(typ, 0); s := nofptrs*2 + (MaxExts+1)*4; Files.WriteBytes(out, s, 2); (*td size*) Files.WriteBytes(out, typ.adr, 2); (*td adr*) K := LONG(nofptrs)*1000000H + s0; Files.WriteBytes(out, K, 4); K := 0; m := 0; REPEAT Files.WriteBytes(out, K, 4); INC(m) UNTIL m = MaxExts; m := 0; WHILE m < nofptrs DO 					Files.WriteBytes(out, PtrTab[m], 2); INC(m) END ; INC(i) END ; (*ref block*) refpos := Files.Pos(out); Files.Write(out, 8AX); OutRefBlk(OCT.topScope.next, pc, "$$"); Files.Set(out, ObjFile, 2); Files.WriteBytes(out, refpos, 4); IF ~OCS.scanerr THEN Files.Register(ObjFile) END ELSE OCS.Mark(153) END END OutCode; PROCEDURE Close*; VAR i: INTEGER; BEGIN i := 0; WHILE i < MaxRecs DO RecTab[i] := NIL; INC(i) END END Close; BEGIN NEW(wasderef) END OCC.