|
@@ -26,12 +26,22 @@ IMPLEMENTATION MODULE Compiler ;
|
|
|
CALL initmem, MOV BP,SP, then generated code). Forward labels and
|
|
CALL initmem, MOV BP,SP, then generated code). Forward labels and
|
|
|
forward procedure calls resolve through a patch list (ptc records).
|
|
forward procedure calls resolve through a patch list (ptc records).
|
|
|
|
|
|
|
|
- Working subset (v0.3): integer/char/boolean/byte scalars, constants
|
|
|
|
|
|
|
+ Working subset (v0.4): integer/char/boolean/byte scalars, constants
|
|
|
with folding, globals, locals, value parameters, procedures and
|
|
with folding, globals, locals, value parameters, procedures and
|
|
|
scalar-result functions, ARRAY[const..const] with constant indexing,
|
|
scalar-result functions, ARRAY[const..const] with constant indexing,
|
|
|
- control flow, GOTO/EXIT. Real/set/record/file and string runtime
|
|
|
|
|
- raise Err (ENoLib) pending the future runtime library - matching the
|
|
|
|
|
- original's "not implemented" error path. *)
|
|
|
|
|
|
|
+ control flow, GOTO/EXIT, and the standard procedures WRITE, WRITELN,
|
|
|
|
|
+ READ, READLN, HALT (DefBuiltins + IoCall).
|
|
|
|
|
+
|
|
|
|
|
+ The standard procedures are dispatched per argument, as the original
|
|
|
|
|
+ does (TPSRC8 pwriteln/pwrloop inspects each argument's class and emits
|
|
|
|
|
+ a different call per type), so the runtime is handed a value and never
|
|
|
|
|
+ a descriptor.
|
|
|
|
|
+
|
|
|
|
|
+ Still not implemented: real/set/record/file and the string runtime
|
|
|
|
|
+ raise Err (ENoLib) - the original's "not implemented" path. The
|
|
|
|
|
+ runtime blob itself, the linker that rebases the TU_* entry offsets
|
|
|
|
|
+ by the runtime's size, and CmdRun (the interpreter) are still pending,
|
|
|
|
|
+ so a compiled image cannot be executed yet. *)
|
|
|
|
|
|
|
|
FROM TextBuf IMPORT Length, CharAt ;
|
|
FROM TextBuf IMPORT Length, CharAt ;
|
|
|
|
|
|
|
@@ -57,6 +67,11 @@ CONST
|
|
|
(* symbol kinds *)
|
|
(* symbol kinds *)
|
|
|
KLabel = 100H ; KConst = 200H ; KType = 300H ;
|
|
KLabel = 100H ; KConst = 200H ; KType = 300H ;
|
|
|
KVar = 400H ; KProc = 500H ; KFunc = 600H ;
|
|
KVar = 400H ; KProc = 500H ; KFunc = 600H ;
|
|
|
|
|
+ KBuiltin = 700H ; (* standard procedure, see BI_* below *)
|
|
|
|
|
+
|
|
|
|
|
+ (* which standard procedure a KBuiltin symbol denotes *)
|
|
|
|
|
+ BI_Write = 0 ; BI_WriteLn = 1 ; BI_Read = 2 ;
|
|
|
|
|
+ BI_ReadLn = 3 ; BI_Halt = 4 ;
|
|
|
|
|
|
|
|
(* keyword tokens *)
|
|
(* keyword tokens *)
|
|
|
TkNone = 0 ; TkProgram = 1 ; TkBegin = 2 ; TkEnd = 3 ;
|
|
TkNone = 0 ; TkProgram = 1 ; TkBegin = 2 ; TkEnd = 3 ;
|
|
@@ -76,6 +91,15 @@ CONST
|
|
|
TU_ProgEnd = 10H ;
|
|
TU_ProgEnd = 10H ;
|
|
|
TU_StackChk = 18H ;
|
|
TU_StackChk = 18H ;
|
|
|
|
|
|
|
|
|
|
+ (* Standard-procedure runtime entries. TP3 does NOT pass a descriptor:
|
|
|
|
|
+ TPSRC8 pwriteln/pwrloop inspects each argument's class in CL and emits
|
|
|
|
|
+ a *different* call per type, so the type is fixed at compile time and
|
|
|
|
|
+ the runtime needs only the value. Mirrored here. *)
|
|
|
|
|
+ TU_WrInt = 20H ; TU_WrChar = 28H ; TU_WrBool = 30H ;
|
|
|
|
|
+ TU_WrReal = 38H ; TU_WrLn = 40H ;
|
|
|
|
|
+ TU_RdInt = 48H ; TU_RdChar = 50H ; TU_RdBool = 58H ;
|
|
|
|
|
+ TU_RdLn = 60H ; TU_Halt = 68H ;
|
|
|
|
|
+
|
|
|
(* TP3 error numbers *)
|
|
(* TP3 error numbers *)
|
|
|
ENoSemi = 1 ; EPointExp = 10 ; ESimpType = 30 ;
|
|
ENoSemi = 1 ; EPointExp = 10 ; ESimpType = 30 ;
|
|
|
EUnknown = 41 ; EConstRange = 45 ; EMemOvf = 98 ;
|
|
EUnknown = 41 ; EConstRange = 45 ; EMemOvf = 98 ;
|
|
@@ -126,6 +150,7 @@ TYPE
|
|
|
imm : LONGINT ;
|
|
imm : LONGINT ;
|
|
|
idx : CARDINAL ;
|
|
idx : CARDINAL ;
|
|
|
boff : CARDINAL ; (* constant fold-in for subscripts *)
|
|
boff : CARDINAL ; (* constant fold-in for subscripts *)
|
|
|
|
|
+ chr : BOOLEAN ; (* single-quoted literal, e.g. 'a' *)
|
|
|
END ;
|
|
END ;
|
|
|
|
|
|
|
|
DirRec = RECORD rng, chk : BOOLEAN END ;
|
|
DirRec = RECORD rng, chk : BOOLEAN END ;
|
|
@@ -356,7 +381,12 @@ BEGIN
|
|
|
AddPatch (pc - 2, 0) ;
|
|
AddPatch (pc - 2, 0) ;
|
|
|
RETURN p
|
|
RETURN p
|
|
|
END ;
|
|
END ;
|
|
|
- rel := (target + 10000H - pc) MOD 10000H ;
|
|
|
|
|
|
|
+ (* rel16 is measured from the END of the instruction. Here pc already
|
|
|
|
|
+ points past the opcode(s) and at the displacement field, so the
|
|
|
|
|
+ instruction ends at pc+2 - the same convention ResolvePatches uses
|
|
|
|
|
+ with "place + 2". Omitting the +2 lands every direct call/jump 2 bytes
|
|
|
|
|
+ past its target. *)
|
|
|
|
|
+ rel := (target + 10000H - (pc + 2)) MOD 10000H ;
|
|
|
Eword (rel) ;
|
|
Eword (rel) ;
|
|
|
RETURN 0
|
|
RETURN 0
|
|
|
END EmCall ;
|
|
END EmCall ;
|
|
@@ -372,7 +402,7 @@ BEGIN
|
|
|
AddPatch (pc - 2, 0) ;
|
|
AddPatch (pc - 2, 0) ;
|
|
|
RETURN p
|
|
RETURN p
|
|
|
END ;
|
|
END ;
|
|
|
- rel := (target + 10000H - pc) MOD 10000H ;
|
|
|
|
|
|
|
+ rel := (target + 10000H - (pc + 2)) MOD 10000H ; (* see EmCall *)
|
|
|
Eword (rel) ;
|
|
Eword (rel) ;
|
|
|
RETURN 0
|
|
RETURN 0
|
|
|
END EmJmpNear ;
|
|
END EmJmpNear ;
|
|
@@ -389,7 +419,7 @@ BEGIN
|
|
|
AddPatch (pc - 2, 0) ;
|
|
AddPatch (pc - 2, 0) ;
|
|
|
RETURN p
|
|
RETURN p
|
|
|
END ;
|
|
END ;
|
|
|
- rel := (target + 10000H - pc) MOD 10000H ;
|
|
|
|
|
|
|
+ rel := (target + 10000H - (pc + 2)) MOD 10000H ; (* see EmCall *)
|
|
|
Eword (rel) ;
|
|
Eword (rel) ;
|
|
|
RETURN 0
|
|
RETURN 0
|
|
|
END EmJcc ;
|
|
END EmJcc ;
|
|
@@ -567,6 +597,21 @@ BEGIN
|
|
|
END
|
|
END
|
|
|
END EmStoreVar ;
|
|
END EmStoreVar ;
|
|
|
|
|
|
|
|
|
|
+PROCEDURE EmPushVarAddr (local : BOOLEAN ; off : CARDINAL) ;
|
|
|
|
|
+(* LEA AX,[BP+disp] / LEA AX,[off] then PUSH AX - READ passes the address of
|
|
|
|
|
+ a variable, not its value. 8D 46 disp is LEA AX,[BP+disp] and 8D 06 off
|
|
|
|
|
+ is LEA AX,[off] (mod=00 rm=110 = direct disp16), both 8086-legal. *)
|
|
|
|
|
+VAR disp : CARDINAL ;
|
|
|
|
|
+BEGIN
|
|
|
|
|
+ disp := off MOD 100H ;
|
|
|
|
|
+ IF local THEN
|
|
|
|
|
+ Ebyte (8DH) ; Ebyte (46H) ; Ebyte (VAL (BYTE, disp))
|
|
|
|
|
+ ELSE
|
|
|
|
|
+ Ebyte (8DH) ; Ebyte (06H) ; Eword (off)
|
|
|
|
|
+ END ;
|
|
|
|
|
+ EmPushAx ()
|
|
|
|
|
+END EmPushVarAddr ;
|
|
|
|
|
+
|
|
|
PROCEDURE EmSubSp (n : CARDINAL) ;
|
|
PROCEDURE EmSubSp (n : CARDINAL) ;
|
|
|
BEGIN
|
|
BEGIN
|
|
|
Ebyte (81H) ; Ebyte (0ECH) ; Eword (n MOD 10000H)
|
|
Ebyte (81H) ; Ebyte (0ECH) ; Eword (n MOD 10000H)
|
|
@@ -1468,7 +1513,9 @@ PROCEDURE ParseAtom (VAR r : ERes) ;
|
|
|
(* const | variable | func(params) | '(' expr ')' *)
|
|
(* const | variable | func(params) | '(' expr ')' *)
|
|
|
VAR idx : CARDINAL ;
|
|
VAR idx : CARDINAL ;
|
|
|
strf : BOOLEAN ;
|
|
strf : BOOLEAN ;
|
|
|
|
|
+ quoted : BOOLEAN ;
|
|
|
BEGIN
|
|
BEGIN
|
|
|
|
|
+ r.chr := FALSE ; (* default: not a quoted char literal *)
|
|
|
Skip () ;
|
|
Skip () ;
|
|
|
IF CurCh () = '(' THEN
|
|
IF CurCh () = '(' THEN
|
|
|
DropCh (GetCh ()) ;
|
|
DropCh (GetCh ()) ;
|
|
@@ -1477,7 +1524,13 @@ BEGIN
|
|
|
RETURN
|
|
RETURN
|
|
|
END ;
|
|
END ;
|
|
|
IF (CurCh () = '$') OR (Digit (CurCh ())) OR (ORD (CurCh ()) = AposC) THEN
|
|
IF (CurCh () = '$') OR (Digit (CurCh ())) OR (ORD (CurCh ()) = AposC) THEN
|
|
|
|
|
+ (* remember that this was a quoted literal BEFORE RdConst consumes it:
|
|
|
|
|
+ RdConst reports a 1-character literal as TScalar (its char code),
|
|
|
|
|
+ which is right for "c := 'a'" but would make writeln('a') print 97.
|
|
|
|
|
+ Mark it so the writer picks the char entry, not the integer one. *)
|
|
|
|
|
+ quoted := (ORD (CurCh ()) = AposC) ;
|
|
|
RdConst (r.imm, r.cls, strf) ;
|
|
RdConst (r.imm, r.cls, strf) ;
|
|
|
|
|
+ r.chr := quoted AND (r.cls = TScalar) AND NOT strf ;
|
|
|
IF r.cls = TReal THEN
|
|
IF r.cls = TReal THEN
|
|
|
Err (ENoLib) ;
|
|
Err (ENoLib) ;
|
|
|
r.kind := 2 ;
|
|
r.kind := 2 ;
|
|
@@ -1701,6 +1754,114 @@ BEGIN
|
|
|
END
|
|
END
|
|
|
END Compound ;
|
|
END Compound ;
|
|
|
|
|
|
|
|
|
|
+PROCEDURE IoCall (idx : CARDINAL) ;
|
|
|
|
|
+(* WRITE / WRITELN / READ / READLN / HALT.
|
|
|
|
|
+
|
|
|
|
|
+ TP3 (TPSRC8 pwriteln, pwrloop, prdtyped) does not pass a descriptor to
|
|
|
|
|
+ the runtime: it looks at each argument's class and emits a *different*
|
|
|
|
|
+ call per type, so the formatting is fixed at compile time. Mirrored
|
|
|
|
|
+ here - one call per argument, then a final call for the line break.
|
|
|
|
|
+
|
|
|
|
|
+ WRITE/WRITELN push the value; READ/READLN push the address, so the
|
|
|
|
|
+ runtime can store. As everywhere else in this compiler the caller
|
|
|
|
|
+ cleans the argument off the stack. *)
|
|
|
|
|
+VAR args : ARRAY [0..15] OF ERes ;
|
|
|
|
|
+ nArgs, i, ent, which, acls : CARDINAL ;
|
|
|
|
|
+ reading : BOOLEAN ;
|
|
|
|
|
+ dummy : ERes ;
|
|
|
|
|
+BEGIN
|
|
|
|
|
+ which := symtab [idx].cls ; (* BI_* *)
|
|
|
|
|
+ IF which = BI_Halt THEN
|
|
|
|
|
+ IF MatchDelim ('(') THEN (* halt(0) - code ignored *)
|
|
|
|
|
+ ParseExpr (dummy) ;
|
|
|
|
|
+ ExpectDelim (')', ENoSemi)
|
|
|
|
|
+ END ;
|
|
|
|
|
+ DropC (EmCall (TU_Halt)) ;
|
|
|
|
|
+ RETURN
|
|
|
|
|
+ END ;
|
|
|
|
|
+ reading := (which = BI_Read) OR (which = BI_ReadLn) ;
|
|
|
|
|
+ nArgs := 0 ;
|
|
|
|
|
+ IF MatchDelim ('(') THEN
|
|
|
|
|
+ IF CurCh () # ')' THEN
|
|
|
|
|
+ LOOP
|
|
|
|
|
+ IF nArgs >= 16 THEN
|
|
|
|
|
+ Err (ECompOvf) ;
|
|
|
|
|
+ EXIT
|
|
|
|
|
+ END ;
|
|
|
|
|
+ ParseExpr (args [nArgs]) ;
|
|
|
|
|
+ INC (nArgs) ;
|
|
|
|
|
+ IF NOT MatchDelim (',') THEN
|
|
|
|
|
+ EXIT
|
|
|
|
|
+ END
|
|
|
|
|
+ END ;
|
|
|
|
|
+ IF NOT MatchDelim (')') THEN
|
|
|
|
|
+ Err (ENoSemi) ;
|
|
|
|
|
+ RETURN
|
|
|
|
|
+ END
|
|
|
|
|
+ ELSE
|
|
|
|
|
+ DropCh (GetCh ())
|
|
|
|
|
+ END
|
|
|
|
|
+ END ;
|
|
|
|
|
+ IF reading AND (nArgs = 0) THEN
|
|
|
|
|
+ (* readln with no variable: just skip to the next line *)
|
|
|
|
|
+ DropC (EmCall (TU_RdLn)) ;
|
|
|
|
|
+ RETURN
|
|
|
|
|
+ END ;
|
|
|
|
|
+ (* NB: guard the loop bound - with nArgs = 0, "nArgs - 1" would wrap round
|
|
|
|
|
+ to 65535 in CARDINAL and spin 65536 times. *)
|
|
|
|
|
+ IF nArgs > 0 THEN
|
|
|
|
|
+ FOR i := 0 TO nArgs - 1 DO
|
|
|
|
|
+ IF reading THEN
|
|
|
|
|
+ IF args [i].kind # 1 THEN
|
|
|
|
|
+ Err (ETypeErr) ; (* READ needs a variable *)
|
|
|
|
|
+ RETURN
|
|
|
|
|
+ END ;
|
|
|
|
|
+ acls := symtab [args [i].idx].cls ;
|
|
|
|
|
+ IF acls = TString THEN
|
|
|
|
|
+ Err (ENoLib) ; (* string runtime pending *)
|
|
|
|
|
+ RETURN
|
|
|
|
|
+ END ;
|
|
|
|
|
+ EmPushVarAddr (symtab [args [i].idx].local, symtab [args [i].idx].off) ;
|
|
|
|
|
+ IF acls = TReal THEN
|
|
|
|
|
+ ent := TU_RdInt (* real reads: not yet *)
|
|
|
|
|
+ ELSIF acls = TBool THEN
|
|
|
|
|
+ ent := TU_RdBool
|
|
|
|
|
+ ELSIF acls = TScalar THEN
|
|
|
|
|
+ ent := TU_RdInt
|
|
|
|
|
+ ELSE
|
|
|
|
|
+ ent := TU_RdChar
|
|
|
|
|
+ END
|
|
|
|
|
+ ELSE
|
|
|
|
|
+ acls := args [i].cls ;
|
|
|
|
|
+ IF acls = TString THEN
|
|
|
|
|
+ Err (ENoLib) ; (* string runtime pending *)
|
|
|
|
|
+ RETURN
|
|
|
|
|
+ END ;
|
|
|
|
|
+ LoadAtom (args [i]) ;
|
|
|
|
|
+ EmPushAx () ;
|
|
|
|
|
+ IF args [i].chr THEN
|
|
|
|
|
+ ent := TU_WrChar (* 'a' - one char, not 97 *)
|
|
|
|
|
+ ELSIF acls = TReal THEN
|
|
|
|
|
+ ent := TU_WrReal
|
|
|
|
|
+ ELSIF acls = TBool THEN
|
|
|
|
|
+ ent := TU_WrBool
|
|
|
|
|
+ ELSIF acls = TScalar THEN
|
|
|
|
|
+ ent := TU_WrInt
|
|
|
|
|
+ ELSE
|
|
|
|
|
+ ent := TU_WrChar
|
|
|
|
|
+ END
|
|
|
|
|
+ END ;
|
|
|
|
|
+ DropC (EmCall (ent)) ;
|
|
|
|
|
+ EmAddSp (2) (* one 16-bit argument *)
|
|
|
|
|
+ END
|
|
|
|
|
+ END ;
|
|
|
|
|
+ IF which = BI_WriteLn THEN
|
|
|
|
|
+ DropC (EmCall (TU_WrLn))
|
|
|
|
|
+ ELSIF which = BI_ReadLn THEN
|
|
|
|
|
+ DropC (EmCall (TU_RdLn))
|
|
|
|
|
+ END
|
|
|
|
|
+END IoCall ;
|
|
|
|
|
+
|
|
|
PROCEDURE Statmnt () ;
|
|
PROCEDURE Statmnt () ;
|
|
|
VAR tok : CARDINAL ;
|
|
VAR tok : CARDINAL ;
|
|
|
idx, i2 : CARDINAL ;
|
|
idx, i2 : CARDINAL ;
|
|
@@ -1974,6 +2135,10 @@ BEGIN
|
|
|
Err (EUnknown) ;
|
|
Err (EUnknown) ;
|
|
|
RETURN
|
|
RETURN
|
|
|
END ;
|
|
END ;
|
|
|
|
|
+ IF symtab [idx].tag = KBuiltin THEN
|
|
|
|
|
+ IoCall (idx) ;
|
|
|
|
|
+ RETURN
|
|
|
|
|
+ END ;
|
|
|
IF symtab [idx].tag = KProc THEN
|
|
IF symtab [idx].tag = KProc THEN
|
|
|
IF MatchDelim ('(') THEN
|
|
IF MatchDelim ('(') THEN
|
|
|
ParseCallArgs (idx)
|
|
ParseCallArgs (idx)
|
|
@@ -2479,6 +2644,35 @@ END DefPart ;
|
|
|
(* driver (TPSRC7 compile) *)
|
|
(* driver (TPSRC7 compile) *)
|
|
|
(* ---------------------------------------------------------------- *)
|
|
(* ---------------------------------------------------------------- *)
|
|
|
|
|
|
|
|
|
|
+PROCEDURE DefBuiltins () ;
|
|
|
|
|
+(* The standard procedures. Without these, WRITELN is absent from the
|
|
|
|
|
+ symbol table, Statmnt's identifier branch fails its Search and every
|
|
|
|
|
+ program that prints anything dies with EUnknown (41) on the '(' after the
|
|
|
|
|
+ call name - the single remaining cause of failure in the fixture matrix.
|
|
|
|
|
+
|
|
|
|
|
+ Tagged KBuiltin (not KProc) because these are not called generically:
|
|
|
|
|
+ WRITE/WRITELN/READ/READLN need TP3's per-argument type dispatch
|
|
|
|
|
+ (IoCall), and HALT takes no argument at all. defnd is TRUE because the
|
|
|
|
|
+ entry point is known - there is no forward reference to patch. *)
|
|
|
|
|
+VAR i : CARDINAL ;
|
|
|
|
|
+BEGIN
|
|
|
|
|
+ i := NewSym ("WRITE" , KBuiltin, BI_Write , 0, 0, 0, 0, FALSE) ;
|
|
|
|
|
+ symtab [i].defnd := TRUE ;
|
|
|
|
|
+ symtab [i].goPos := TU_WrInt ;
|
|
|
|
|
+ i := NewSym ("WRITELN", KBuiltin, BI_WriteLn, 0, 0, 0, 0, FALSE) ;
|
|
|
|
|
+ symtab [i].defnd := TRUE ;
|
|
|
|
|
+ symtab [i].goPos := TU_WrInt ;
|
|
|
|
|
+ i := NewSym ("READ" , KBuiltin, BI_Read , 0, 0, 0, 0, FALSE) ;
|
|
|
|
|
+ symtab [i].defnd := TRUE ;
|
|
|
|
|
+ symtab [i].goPos := TU_RdInt ;
|
|
|
|
|
+ i := NewSym ("READLN" , KBuiltin, BI_ReadLn , 0, 0, 0, 0, FALSE) ;
|
|
|
|
|
+ symtab [i].defnd := TRUE ;
|
|
|
|
|
+ symtab [i].goPos := TU_RdInt ;
|
|
|
|
|
+ i := NewSym ("HALT" , KBuiltin, BI_Halt , 0, 0, 0, 0, FALSE) ;
|
|
|
|
|
+ symtab [i].defnd := TRUE ;
|
|
|
|
|
+ symtab [i].goPos := TU_Halt
|
|
|
|
|
+END DefBuiltins ;
|
|
|
|
|
+
|
|
|
PROCEDURE Inittur () ;
|
|
PROCEDURE Inittur () ;
|
|
|
(* reset compiler state and define the standard types *)
|
|
(* reset compiler state and define the standard types *)
|
|
|
BEGIN
|
|
BEGIN
|
|
@@ -2513,6 +2707,7 @@ BEGIN
|
|
|
DropC (NewSym ("STRING" , KType, TString, 256, 1, 0, 0, FALSE)) ;
|
|
DropC (NewSym ("STRING" , KType, TString, 256, 1, 0, 0, FALSE)) ;
|
|
|
DropC (NewSym ("TRUE" , KConst, TBool, 1, 1, 0, 1, FALSE)) ;
|
|
DropC (NewSym ("TRUE" , KConst, TBool, 1, 1, 0, 1, FALSE)) ;
|
|
|
DropC (NewSym ("FALSE" , KConst, TBool, 1, 1, 0, 0, FALSE)) ;
|
|
DropC (NewSym ("FALSE" , KConst, TBool, 1, 1, 0, 0, FALSE)) ;
|
|
|
|
|
+ DefBuiltins () ;
|
|
|
tmpA := NewSym ("@@T1", KVar, TScalar, 2, 2, dc, 0, FALSE) ;
|
|
tmpA := NewSym ("@@T1", KVar, TScalar, 2, 2, dc, 0, FALSE) ;
|
|
|
dc := dc + 2 ;
|
|
dc := dc + 2 ;
|
|
|
tmpB := NewSym ("@@T2", KVar, TScalar, 2, 2, dc, 0, FALSE) ;
|
|
tmpB := NewSym ("@@T2", KVar, TScalar, 2, 2, dc, 0, FALSE) ;
|
|
@@ -2616,4 +2811,15 @@ BEGIN
|
|
|
RETURN dataSz
|
|
RETURN dataSz
|
|
|
END DataBytes ;
|
|
END DataBytes ;
|
|
|
|
|
|
|
|
|
|
+PROCEDURE CodeByteAt (i : CARDINAL) : BYTE ;
|
|
|
|
|
+(* i-th byte of the emitted image, for test harnesses that need to check
|
|
|
|
|
+ the generated 8086 code rather than just its size. Returns 0 past the
|
|
|
|
|
+ end of the image. *)
|
|
|
|
|
+BEGIN
|
|
|
|
|
+ IF i >= codeSz THEN
|
|
|
|
|
+ RETURN 0
|
|
|
|
|
+ END ;
|
|
|
|
|
+ RETURN cbuf [i]
|
|
|
|
|
+END CodeByteAt ;
|
|
|
|
|
+
|
|
|
END Compiler.
|
|
END Compiler.
|