|
|
@@ -0,0 +1,622 @@
|
|
|
+IMPLEMENTATION MODULE Runtime ;
|
|
|
+
|
|
|
+(* 8086 runtime library, assembled byte by byte. Each little emitter below is
|
|
|
+ one 8086 instruction; the ModR/M byte is spelled out in the comment so the
|
|
|
+ encoding can be checked by hand against an 8086 table. This is the same
|
|
|
+ approach the compiler itself takes in Compiler.mod (Ebyte/Eword/EmCall),
|
|
|
+ so the library needs no external assembler and no binary artifact in the
|
|
|
+ tree - RT_Build assembles it every run, which is why the entry offsets are
|
|
|
+ known exactly and are not guesses.
|
|
|
+
|
|
|
+ Memory model: a .COM image, so CS = DS = ES = SS = 0 and the whole thing
|
|
|
+ lives in one 64K segment. The runtime occupies offsets 0..RT_Size-1, the
|
|
|
+ generated program follows, and the program's globals follow at
|
|
|
+ RT_Size + 1000H. Runtime data therefore sits at fixed low offsets.
|
|
|
+
|
|
|
+ Calling conventions, matching Compiler.IoCall:
|
|
|
+ WrInt/WrChar/WrBool/WrReal one 16-bit value on the stack (caller pops)
|
|
|
+ RdInt/RdChar/RdBool one address on the stack (caller pops)
|
|
|
+ WrLn/RdLn/StackChk nothing
|
|
|
+ InitMem AX = offset of the program header word block
|
|
|
+ ProgEnd/Halt nothing; exits with code 0
|
|
|
+ All entries preserve BP and SP, and every register except the documented
|
|
|
+ result, so they can be called from the middle of an expression. *)
|
|
|
+
|
|
|
+FROM SYSTEM IMPORT BYTE ;
|
|
|
+
|
|
|
+CONST
|
|
|
+ MaxRt = 4096 ;
|
|
|
+ MaxLbl = 64 ;
|
|
|
+ MaxFix = 400 ;
|
|
|
+ MaxNm = 15 ;
|
|
|
+
|
|
|
+ (* offsets inside the runtime's own data block *)
|
|
|
+ D_NUM = 0 ; (* 8 bytes, decimal conversion scratch *)
|
|
|
+ D_TRUE = 8 ; (* "TRUE$" *)
|
|
|
+ D_FALSE = 14 ; (* "FALSE$" *)
|
|
|
+ D_CRLF = 21 ; (* CR LF '$' *)
|
|
|
+ D_REAL = 24 ; (* "?REAL?" - reals are not formatted yet *)
|
|
|
+ D_END = 31 ;
|
|
|
+
|
|
|
+TYPE
|
|
|
+ LblRec = RECORD
|
|
|
+ nm : ARRAY [0..MaxNm] OF CHAR ;
|
|
|
+ off : CARDINAL ;
|
|
|
+ END ;
|
|
|
+
|
|
|
+ FixRec = RECORD
|
|
|
+ kind : CARDINAL ; (* 0 = rel8, 1 = rel16, 2 = data address *)
|
|
|
+ place : CARDINAL ; (* offset of the displacement/address field *)
|
|
|
+ nm : ARRAY [0..MaxNm] OF CHAR ;
|
|
|
+ val : CARDINAL ;
|
|
|
+ END ;
|
|
|
+
|
|
|
+VAR
|
|
|
+ rt : ARRAY [0..MaxRt - 1] OF BYTE ;
|
|
|
+ rpos : CARDINAL ;
|
|
|
+ lbl : ARRAY [0..MaxLbl - 1] OF LblRec ;
|
|
|
+ ltop : CARDINAL ;
|
|
|
+ fix : ARRAY [0..MaxFix - 1] OF FixRec ;
|
|
|
+ nfix : CARDINAL ;
|
|
|
+ dataAt : CARDINAL ;
|
|
|
+ built : BOOLEAN ;
|
|
|
+ entNm : ARRAY [0..12] OF ARRAY [0..MaxNm] OF CHAR ;
|
|
|
+
|
|
|
+(* ---------------------------------------------------------------- *)
|
|
|
+(* name helpers *)
|
|
|
+(* ---------------------------------------------------------------- *)
|
|
|
+
|
|
|
+PROCEDURE StrEq (a, b : ARRAY OF CHAR ) : BOOLEAN ;
|
|
|
+VAR i : CARDINAL ;
|
|
|
+BEGIN
|
|
|
+ i := 0 ;
|
|
|
+ WHILE (i <= HIGH (a)) AND (i <= HIGH (b)) DO
|
|
|
+ IF a [i] # b [i] THEN
|
|
|
+ RETURN FALSE
|
|
|
+ END ;
|
|
|
+ INC (i)
|
|
|
+ END ;
|
|
|
+ RETURN TRUE
|
|
|
+END StrEq ;
|
|
|
+
|
|
|
+PROCEDURE SetStr (VAR dst : ARRAY OF CHAR ; src : ARRAY OF CHAR ) ;
|
|
|
+VAR i : CARDINAL ;
|
|
|
+BEGIN
|
|
|
+ i := 0 ;
|
|
|
+ WHILE (i <= HIGH (dst)) AND (i <= HIGH (src)) DO
|
|
|
+ dst [i] := src [i] ;
|
|
|
+ INC (i)
|
|
|
+ END ;
|
|
|
+ IF i <= HIGH (dst) THEN
|
|
|
+ dst [i] := 0C
|
|
|
+ END
|
|
|
+END SetStr ;
|
|
|
+
|
|
|
+(* ---------------------------------------------------------------- *)
|
|
|
+(* primitive emitters *)
|
|
|
+(* ---------------------------------------------------------------- *)
|
|
|
+
|
|
|
+PROCEDURE B (b : CARDINAL ) ;
|
|
|
+(* emit exactly ONE byte. A two-byte opcode must be written as two B calls -
|
|
|
+ B masks to 100H, so B (8BE4H) would silently emit just E4. *)
|
|
|
+BEGIN
|
|
|
+ IF rpos >= MaxRt THEN
|
|
|
+ RETURN (* blob is oversized: drop the byte *)
|
|
|
+ END ;
|
|
|
+ rt [rpos] := VAL (BYTE, b MOD 100H) ;
|
|
|
+ INC (rpos)
|
|
|
+END B ;
|
|
|
+
|
|
|
+PROCEDURE W (w : CARDINAL ) ;
|
|
|
+BEGIN
|
|
|
+ B (w MOD 100H) ;
|
|
|
+ B ((w DIV 100H) MOD 100H) (* little endian *)
|
|
|
+END W ;
|
|
|
+
|
|
|
+PROCEDURE M (nm : ARRAY OF CHAR ) ;
|
|
|
+(* mark: nm is the current offset *)
|
|
|
+BEGIN
|
|
|
+ IF ltop < MaxLbl THEN
|
|
|
+ SetStr (lbl [ltop].nm, nm) ;
|
|
|
+ lbl [ltop].off := rpos ;
|
|
|
+ INC (ltop)
|
|
|
+ END
|
|
|
+END M ;
|
|
|
+
|
|
|
+PROCEDURE AddFix (kind, place : CARDINAL ; nm : ARRAY OF CHAR ; val : CARDINAL ) ;
|
|
|
+BEGIN
|
|
|
+ IF nfix < MaxFix THEN
|
|
|
+ fix [nfix].kind := kind ;
|
|
|
+ fix [nfix].place := place ;
|
|
|
+ fix [nfix].val := val ;
|
|
|
+ SetStr (fix [nfix].nm, nm) ;
|
|
|
+ INC (nfix)
|
|
|
+ END
|
|
|
+END AddFix ;
|
|
|
+
|
|
|
+PROCEDURE LblOff (nm : ARRAY OF CHAR ) : CARDINAL ;
|
|
|
+VAR i : CARDINAL ;
|
|
|
+BEGIN
|
|
|
+ i := 0 ;
|
|
|
+ WHILE i < ltop DO
|
|
|
+ IF StrEq (lbl [i].nm, nm) THEN
|
|
|
+ RETURN lbl [i].off
|
|
|
+ END ;
|
|
|
+ INC (i)
|
|
|
+ END ;
|
|
|
+ RETURN 0
|
|
|
+END LblOff ;
|
|
|
+
|
|
|
+PROCEDURE J8 (nm : ARRAY OF CHAR ) ;
|
|
|
+BEGIN
|
|
|
+ B (0EBH) ; (* JMP rel8 *)
|
|
|
+ AddFix (0, rpos, nm, 0) ;
|
|
|
+ B (0)
|
|
|
+END J8 ;
|
|
|
+
|
|
|
+PROCEDURE C8 (nm : ARRAY OF CHAR ) ;
|
|
|
+BEGIN
|
|
|
+ B (0E8H) ; (* CALL rel16 *)
|
|
|
+ AddFix (1, rpos, nm, 0) ;
|
|
|
+ W (0)
|
|
|
+END C8 ;
|
|
|
+
|
|
|
+PROCEDURE Jcc (code : CARDINAL ; nm : ARRAY OF CHAR ) ;
|
|
|
+BEGIN
|
|
|
+ B (code) ; (* Jcc rel8 *)
|
|
|
+ AddFix (0, rpos, nm, 0) ;
|
|
|
+ B (0)
|
|
|
+END Jcc ;
|
|
|
+
|
|
|
+PROCEDURE Dd (delta : CARDINAL ) ;
|
|
|
+(* emit a 16-bit address into the runtime's data block; the value is only
|
|
|
+ known once the data block has been placed, so it is a fixup *)
|
|
|
+BEGIN
|
|
|
+ AddFix (2, rpos, "", delta) ;
|
|
|
+ W (0)
|
|
|
+END Dd ;
|
|
|
+
|
|
|
+(* --- 8-bit / 16-bit register and memory forms, one instruction each --- *)
|
|
|
+
|
|
|
+PROCEDURE PushBp ; BEGIN B (55H) END PushBp ;
|
|
|
+PROCEDURE PopBp ; BEGIN B (5DH) END PopBp ;
|
|
|
+PROCEDURE MovBpSp ; BEGIN B (8BH) ; B (0ECH) END MovBpSp ; (* 8B EC: MOV BP,SP *)
|
|
|
+PROCEDURE MovSpBp ; BEGIN B (89H) ; B (0ECH) END MovSpBp ; (* 89 EC: MOV SP,BP *)
|
|
|
+PROCEDURE LeaveR ; BEGIN B (0C9H) END LeaveR ;
|
|
|
+PROCEDURE RetR ; BEGIN B (0C3H) END RetR ;
|
|
|
+PROCEDURE Int21 ; BEGIN B (0CDH) ; B (21H) END Int21 ;
|
|
|
+PROCEDURE PushDs ; BEGIN B (1EH) END PushDs ;
|
|
|
+PROCEDURE PopEs ; BEGIN B (7H) END PopEs ;
|
|
|
+
|
|
|
+PROCEDURE PushAx ; BEGIN B (50H) END PushAx ;
|
|
|
+PROCEDURE PopAx ; BEGIN B (58H) END PopAx ;
|
|
|
+PROCEDURE PushBx ; BEGIN B (53H) END PushBx ;
|
|
|
+PROCEDURE PopBx ; BEGIN B (5BH) END PopBx ;
|
|
|
+PROCEDURE PushCx ; BEGIN B (51H) END PushCx ;
|
|
|
+PROCEDURE PopCx ; BEGIN B (59H) END PopCx ;
|
|
|
+PROCEDURE PushDx ; BEGIN B (52H) END PushDx ;
|
|
|
+PROCEDURE PopDx ; BEGIN B (5AH) END PopDx ;
|
|
|
+PROCEDURE PushDi ; BEGIN B (57H) END PushDi ;
|
|
|
+PROCEDURE PopDi ; BEGIN B (5FH) END PopDi ;
|
|
|
+
|
|
|
+PROCEDURE XorAxAx ; BEGIN B (31H) ; B (0C0H) END XorAxAx ; (* 11 000 000 *)
|
|
|
+PROCEDURE XorCxCx ; BEGIN B (31H) ; B (0C9H) END XorCxCx ; (* 11 001 001 *)
|
|
|
+PROCEDURE XorDxDx ; BEGIN B (31H) ; B (0D2H) END XorDxDx ; (* 11 010 010 *)
|
|
|
+PROCEDURE XorDiDi ; BEGIN B (31H) ; B (0FFH) END XorDiDi ; (* 11 111 111 *)
|
|
|
+
|
|
|
+PROCEDURE IncCx ; BEGIN B (41H) END IncCx ;
|
|
|
+PROCEDURE IncSi ; BEGIN B (46H) END IncSi ;
|
|
|
+PROCEDURE DecSi ; BEGIN B (4EH) END DecSi ;
|
|
|
+PROCEDURE AddDi2 ; BEGIN B (83H) ; B (0C7H) ; B (2) END AddDi2 ; (* 11 000 111 *)
|
|
|
+
|
|
|
+PROCEDURE CmpAl (v : CARDINAL ) ; BEGIN B (3CH) ; B (v) END CmpAl ;
|
|
|
+PROCEDURE CmpAx0 ; BEGIN B (83H) ; B (0F8H) ; B (0) END CmpAx0 ;
|
|
|
+PROCEDURE CmpCx0 ; BEGIN B (83H) ; B (0F9H) ; B (0) END CmpCx0 ;
|
|
|
+PROCEDURE CmpSpW0 ; BEGIN B (83H) ; B (7CH) ; B (24H) ; B (0) ; B (0) END CmpSpW0 ;
|
|
|
+PROCEDURE CmpSiBx ; BEGIN B (39H) ; B (0DCH) END CmpSiBx ; (* 11 011 100 *)
|
|
|
+PROCEDURE CmpCxDx ; BEGIN B (39H) ; B (0D1H) END CmpCxDx ; (* 11 010 001 *)
|
|
|
+PROCEDURE CmpDiCx ; BEGIN B (39H) ; B (0CFH) END CmpDiCx ; (* 11 001 111 *)
|
|
|
+
|
|
|
+PROCEDURE AddDl (v : CARDINAL ) ; BEGIN B (80H) ; B (0C2H) ; B (v) END AddDl ;
|
|
|
+PROCEDURE SubAl (v : CARDINAL ) ; BEGIN B (2CH) ; B (v) END SubAl ;
|
|
|
+PROCEDURE NegAx ; BEGIN B (0F7H) ; B (0D8H) END NegAx ;
|
|
|
+PROCEDURE NegDi ; BEGIN B (0F7H) ; B (0DFH) END NegDi ;
|
|
|
+PROCEDURE DivCx ; BEGIN B (0F7H) ; B (0F1H) END DivCx ; (* 11 110 001 *)
|
|
|
+PROCEDURE MulBx ; BEGIN B (0F7H) ; B (0E3H) END MulBx ; (* 11 100 011 *)
|
|
|
+
|
|
|
+PROCEDURE MovAh (v : CARDINAL ) ; BEGIN B (0B4H) ; B (v) END MovAh ;
|
|
|
+PROCEDURE MovDl (v : CARDINAL ) ; BEGIN B (0B2H) ; B (v) END MovDl ;
|
|
|
+PROCEDURE MovBxV (v : CARDINAL ) ; BEGIN B (0BBH) ; W (v) END MovBxV ;
|
|
|
+PROCEDURE MovCxV (v : CARDINAL ) ; BEGIN B (0B9H) ; W (v) END MovCxV ;
|
|
|
+PROCEDURE MovDxV (v : CARDINAL ) ; BEGIN B (0BAH) ; W (v) END MovDxV ;
|
|
|
+PROCEDURE MovBxD (delta : CARDINAL ) ; BEGIN B (0BBH) ; Dd (delta) END MovBxD ;
|
|
|
+PROCEDURE MovDxD (delta : CARDINAL ) ; BEGIN B (0BAH) ; Dd (delta) END MovDxD ;
|
|
|
+
|
|
|
+PROCEDURE MovAxSp ; BEGIN B (8BH) ; B (44H) ; B (24H) ; B (0) END MovAxSp ;
|
|
|
+PROCEDURE MovSiAx ; BEGIN B (8BH) ; B (0C0H) END MovSiAx ;
|
|
|
+PROCEDURE MovAxDi ; BEGIN B (8BH) ; B (0C7H) END MovAxDi ; (* 11 000 111 *)
|
|
|
+PROCEDURE MovAxDx ; BEGIN B (8BH) ; B (0D2H) END MovAxDx ;
|
|
|
+PROCEDURE MovCxSi6 ; BEGIN B (8BH) ; B (4CH) ; B (6) END MovCxSi6 ;
|
|
|
+PROCEDURE MovDxSi2 ; BEGIN B (8BH) ; B (54H) ; B (2) END MovDxSi2 ;
|
|
|
+PROCEDURE MovAxBp4 ; BEGIN B (8BH) ; B (45H) ; B (4) END MovAxBp4 ;
|
|
|
+PROCEDURE MovBxBp4 ; BEGIN B (8BH) ; B (5EH) ; B (4) END MovBxBp4 ;
|
|
|
+PROCEDURE MovAlDh ; BEGIN B (8AH) ; B (0C0H) END MovAlDh ;
|
|
|
+PROCEDURE MovDlSi ; BEGIN B (8AH) ; B (14H) END MovDlSi ;
|
|
|
+PROCEDURE MovDlSp ; BEGIN B (8AH) ; B (54H) ; B (24H) ; B (0) END MovDlSp ;
|
|
|
+
|
|
|
+PROCEDURE StDiAx ; BEGIN B (89H) ; B (7H) END StDiAx ; (* [DI] := AX *)
|
|
|
+PROCEDURE StDiBx ; BEGIN B (89H) ; B (1FH) END StDiBx ; (* [DI] := BX *)
|
|
|
+PROCEDURE StBxCx ; BEGIN B (89H) ; B (8BH) END StBxCx ; (* [BX] := CX *)
|
|
|
+PROCEDURE StSiDl ; BEGIN B (88H) ; B (14H) END StSiDl ; (* [SI] := DL *)
|
|
|
+PROCEDURE StBxDl ; BEGIN B (88H) ; B (93H) END StBxDl ; (* [BX] := DL *)
|
|
|
+PROCEDURE MovDhAl ; BEGIN B (88H) ; B (0C6H) END MovDhAl ;
|
|
|
+PROCEDURE MovDlAl ; BEGIN B (88H) ; B (0C2H) END MovDlAl ;
|
|
|
+PROCEDURE MovSiBx ; BEGIN B (89H) ; B (0DCH) END MovSiBx ;
|
|
|
+PROCEDURE MovDiDx ; BEGIN B (89H) ; B (0D7H) END MovDiDx ;
|
|
|
+PROCEDURE MovDiAx ; BEGIN B (89H) ; B (0C7H) END MovDiAx ;
|
|
|
+PROCEDURE AddDiAx ; BEGIN B (1H) ; B (0C7H) END AddDiAx ;
|
|
|
+(* JE 74 JNE 75 JB 72 JBE 76 JGE 7D *)
|
|
|
+PROCEDURE Je8 (nm : ARRAY OF CHAR ) ; BEGIN Jcc (74H, nm) END Je8 ;
|
|
|
+PROCEDURE Jne8 (nm : ARRAY OF CHAR ) ; BEGIN Jcc (75H, nm) END Jne8 ;
|
|
|
+PROCEDURE Jb8 (nm : ARRAY OF CHAR ) ; BEGIN Jcc (72H, nm) END Jb8 ;
|
|
|
+PROCEDURE Jbe8 (nm : ARRAY OF CHAR ) ; BEGIN Jcc (76H, nm) END Jbe8 ;
|
|
|
+PROCEDURE Jge8 (nm : ARRAY OF CHAR ) ; BEGIN Jcc (7DH, nm) END Jge8 ;
|
|
|
+PROCEDURE Ja8 (nm : ARRAY OF CHAR ) ; BEGIN Jcc (77H, nm) END Ja8 ;
|
|
|
+
|
|
|
+(* ---------------------------------------------------------------- *)
|
|
|
+(* the entries *)
|
|
|
+(* ---------------------------------------------------------------- *)
|
|
|
+
|
|
|
+PROCEDURE EmitInitMem ;
|
|
|
+(* AX = offset of the program header. The header holds, at +2 the base of
|
|
|
+ the program's data area and at +6 its end, so the globals can be zeroed -
|
|
|
+ Pascal leaves them undefined, TP3's runtime clears them. Also makes
|
|
|
+ ES = DS so that any string instruction in the library would work. *)
|
|
|
+BEGIN
|
|
|
+ M ("initmem") ;
|
|
|
+ MovSiAx ; (* SI = AX = the header offset the caller passed *)
|
|
|
+ MovDxSi2 ; (* DX = [SI+2] = data base *)
|
|
|
+ MovCxSi6 ; (* CX = [SI+6] = data end *)
|
|
|
+ CmpCxDx ;
|
|
|
+ Jbe8 ("im_done") ;
|
|
|
+ MovDiDx ; (* DI = data base *)
|
|
|
+ M ("im_zero") ;
|
|
|
+ MovAxDx ;
|
|
|
+ StDiAx ;
|
|
|
+ AddDi2 ;
|
|
|
+ CmpDiCx ;
|
|
|
+ Jb8 ("im_zero") ;
|
|
|
+ M ("im_done") ;
|
|
|
+ PushDs ; PopEs ;
|
|
|
+ RetR
|
|
|
+END EmitInitMem ;
|
|
|
+
|
|
|
+PROCEDURE EmitEnd ;
|
|
|
+(* progend and halt are the same code: the compiler already zeroes AX for
|
|
|
+ progend, and a HALT argument is discarded at compile time, so both leave
|
|
|
+ with exit code 0. *)
|
|
|
+BEGIN
|
|
|
+ M ("progend") ;
|
|
|
+ M ("halt") ;
|
|
|
+ XorAxAx ;
|
|
|
+ MovAh (4CH) ;
|
|
|
+ Int21 ;
|
|
|
+ RetR
|
|
|
+END EmitEnd ;
|
|
|
+
|
|
|
+PROCEDURE EmitStackChk ;
|
|
|
+(* called from every procedure prologue. Range and stack checking are not
|
|
|
+ compiled in yet, so this must do nothing at all - in particular it must
|
|
|
+ not touch a register, because the call site is in the middle of a
|
|
|
+ partially evaluated expression. *)
|
|
|
+BEGIN
|
|
|
+ M ("stackchk") ;
|
|
|
+ RetR
|
|
|
+END EmitStackChk ;
|
|
|
+
|
|
|
+PROCEDURE EmitGetCh ;
|
|
|
+(* AL = next character, 1Ah at end of input. INT 21h AH=08h reads without
|
|
|
+ echoing, so a redirected stdin behaves the same as a keyboard. *)
|
|
|
+BEGIN
|
|
|
+ M ("getch") ;
|
|
|
+ MovAh (8) ;
|
|
|
+ Int21 ;
|
|
|
+ RetR
|
|
|
+END EmitGetCh ;
|
|
|
+
|
|
|
+PROCEDURE EmitWrInt ;
|
|
|
+(* one signed 16-bit value on the stack. Div CX gives the remainder in DX,
|
|
|
+ which is turned into a digit and stored backwards from the end of the
|
|
|
+ scratch area, then printed forwards. *)
|
|
|
+BEGIN
|
|
|
+ M ("wrint") ;
|
|
|
+ PushBp ; MovBpSp ;
|
|
|
+ MovAxBp4 ;
|
|
|
+ CmpAx0 ;
|
|
|
+ Jge8 ("wi_pos") ;
|
|
|
+ PushAx ;
|
|
|
+ MovDl (ORD ("-")) ; MovAh (2) ; Int21 ;
|
|
|
+ PopAx ;
|
|
|
+ NegAx ;
|
|
|
+ M ("wi_pos") ;
|
|
|
+ MovCxV (10) ;
|
|
|
+ MovBxD (D_NUM + 8) ; (* BX = one past the last digit *)
|
|
|
+ MovSiBx ;
|
|
|
+ M ("wi_dig") ;
|
|
|
+ XorDxDx ;
|
|
|
+ DivCx ;
|
|
|
+ AddDl (ORD ("0")) ;
|
|
|
+ DecSi ;
|
|
|
+ StSiDl ;
|
|
|
+ CmpAx0 ;
|
|
|
+ Jne8 ("wi_dig") ;
|
|
|
+ M ("wi_out") ;
|
|
|
+ CmpSiBx ;
|
|
|
+ Je8 ("wi_done") ;
|
|
|
+ MovDlSi ;
|
|
|
+ MovAh (2) ; Int21 ;
|
|
|
+ IncSi ;
|
|
|
+ J8 ("wi_out") ;
|
|
|
+ M ("wi_done") ;
|
|
|
+ MovSpBp ; PopBp ; RetR
|
|
|
+END EmitWrInt ;
|
|
|
+
|
|
|
+PROCEDURE EmitWrChar ;
|
|
|
+(* the low byte of the pushed word *)
|
|
|
+BEGIN
|
|
|
+ M ("wrchar") ;
|
|
|
+ MovDlSp ;
|
|
|
+ MovAh (2) ;
|
|
|
+ Int21 ;
|
|
|
+ RetR
|
|
|
+END EmitWrChar ;
|
|
|
+
|
|
|
+PROCEDURE EmitWrBool ;
|
|
|
+BEGIN
|
|
|
+ M ("wrbool") ;
|
|
|
+ CmpSpW0 ;
|
|
|
+ Jne8 ("wb_t") ;
|
|
|
+ MovDxD (D_FALSE) ;
|
|
|
+ J8 ("wb_o") ;
|
|
|
+ M ("wb_t") ;
|
|
|
+ MovDxD (D_TRUE) ;
|
|
|
+ M ("wb_o") ;
|
|
|
+ MovAh (9) ;
|
|
|
+ Int21 ;
|
|
|
+ RetR
|
|
|
+END EmitWrBool ;
|
|
|
+
|
|
|
+PROCEDURE EmitWrLn ;
|
|
|
+BEGIN
|
|
|
+ M ("wrln") ;
|
|
|
+ MovDxD (D_CRLF) ;
|
|
|
+ MovAh (9) ;
|
|
|
+ Int21 ;
|
|
|
+ RetR
|
|
|
+END EmitWrLn ;
|
|
|
+
|
|
|
+PROCEDURE EmitWrReal ;
|
|
|
+(* the 6-byte real is on the stack but is not formatted: the compiler does
|
|
|
+ not yet load real operands into a form the runtime could read. A visible
|
|
|
+ marker beats printing the mantissa as an integer. *)
|
|
|
+BEGIN
|
|
|
+ M ("wrreal") ;
|
|
|
+ MovDxD (D_REAL) ;
|
|
|
+ MovAh (9) ;
|
|
|
+ Int21 ;
|
|
|
+ RetR
|
|
|
+END EmitWrReal ;
|
|
|
+
|
|
|
+PROCEDURE EmitRdInt ;
|
|
|
+(* address on the stack; skips leading blanks, takes an optional sign, then
|
|
|
+ digits, stopping *before* the delimiter so the following TU_RdLn throws
|
|
|
+ away the rest of the line. Sign in CX, value in DI. *)
|
|
|
+BEGIN
|
|
|
+ M ("rdint") ;
|
|
|
+ PushBp ; MovBpSp ;
|
|
|
+ PushAx ; PushBx ; PushCx ; PushDx ; PushDi ;
|
|
|
+ M ("ri_skip") ;
|
|
|
+ C8 ("getch") ;
|
|
|
+ CmpAl (ORD (" ")) ; Je8 ("ri_skip") ;
|
|
|
+ CmpAl (9) ; Je8 ("ri_skip") ;
|
|
|
+ CmpAl (13) ; Je8 ("ri_skip") ;
|
|
|
+ CmpAl (10) ; Je8 ("ri_skip") ;
|
|
|
+ XorCxCx ;
|
|
|
+ CmpAl (ORD ("-")) ;
|
|
|
+ Jne8 ("ri_nos") ;
|
|
|
+ IncCx ;
|
|
|
+ C8 ("getch") ;
|
|
|
+ J8 ("ri_dig0") ;
|
|
|
+ M ("ri_nos") ;
|
|
|
+ CmpAl (ORD ("+")) ;
|
|
|
+ Jne8 ("ri_dig0") ;
|
|
|
+ C8 ("getch") ;
|
|
|
+ M ("ri_dig0") ;
|
|
|
+ XorDiDi ;
|
|
|
+ M ("ri_dig") ;
|
|
|
+ CmpAl (ORD ("0")) ;
|
|
|
+ Jb8 ("ri_done") ;
|
|
|
+ CmpAl (ORD ("9")) ;
|
|
|
+ Ja8 ("ri_done") ;
|
|
|
+ SubAl (ORD ("0")) ;
|
|
|
+ MovDhAl ; (* keep the digit across the multiply *)
|
|
|
+ MovAxDi ;
|
|
|
+ MovBxV (10) ;
|
|
|
+ MulBx ; (* DX:AX := DI * 10 *)
|
|
|
+ MovDiAx ;
|
|
|
+ MovAh (0) ;
|
|
|
+ MovAlDh ;
|
|
|
+ AddDiAx ;
|
|
|
+ C8 ("getch") ;
|
|
|
+ J8 ("ri_dig") ;
|
|
|
+ M ("ri_done") ;
|
|
|
+ CmpCx0 ;
|
|
|
+ Je8 ("ri_st") ;
|
|
|
+ NegDi ;
|
|
|
+ M ("ri_st") ;
|
|
|
+ MovBxBp4 ;
|
|
|
+ StDiBx ;
|
|
|
+ PopDi ; PopDx ; PopCx ; PopBx ; PopAx ;
|
|
|
+ MovSpBp ; PopBp ; RetR
|
|
|
+END EmitRdInt ;
|
|
|
+
|
|
|
+PROCEDURE EmitRdChar ;
|
|
|
+BEGIN
|
|
|
+ M ("rdchar") ;
|
|
|
+ PushBp ; MovBpSp ;
|
|
|
+ PushAx ; PushBx ;
|
|
|
+ C8 ("getch") ;
|
|
|
+ MovDlAl ;
|
|
|
+ MovBxBp4 ;
|
|
|
+ StBxDl ;
|
|
|
+ PopBx ; PopAx ;
|
|
|
+ MovSpBp ; PopBp ; RetR
|
|
|
+END EmitRdChar ;
|
|
|
+
|
|
|
+PROCEDURE EmitRdBool ;
|
|
|
+(* one character, classified the way TP3 does: T/t/Y/y/1 true, anything else
|
|
|
+ false. *)
|
|
|
+BEGIN
|
|
|
+ M ("rdbool") ;
|
|
|
+ PushBp ; MovBpSp ;
|
|
|
+ PushAx ; PushBx ; PushCx ;
|
|
|
+ C8 ("getch") ;
|
|
|
+ XorCxCx ;
|
|
|
+ CmpAl (ORD ("T")) ; Je8 ("rb_t") ;
|
|
|
+ CmpAl (ORD ("t")) ; Je8 ("rb_t") ;
|
|
|
+ CmpAl (ORD ("Y")) ; Je8 ("rb_t") ;
|
|
|
+ CmpAl (ORD ("y")) ; Je8 ("rb_t") ;
|
|
|
+ CmpAl (ORD ("1")) ; Je8 ("rb_t") ;
|
|
|
+ J8 ("rb_s") ;
|
|
|
+ M ("rb_t") ;
|
|
|
+ IncCx ;
|
|
|
+ M ("rb_s") ;
|
|
|
+ MovBxBp4 ;
|
|
|
+ StBxCx ;
|
|
|
+ PopCx ; PopBx ; PopAx ;
|
|
|
+ MovSpBp ; PopBp ; RetR
|
|
|
+END EmitRdBool ;
|
|
|
+
|
|
|
+PROCEDURE EmitRdLn ;
|
|
|
+(* discard the rest of the line, including the terminator *)
|
|
|
+BEGIN
|
|
|
+ M ("rdln") ;
|
|
|
+ PushAx ;
|
|
|
+ M ("rl_loop") ;
|
|
|
+ C8 ("getch") ;
|
|
|
+ CmpAl (13) ; Je8 ("rl_e") ;
|
|
|
+ CmpAl (10) ; Je8 ("rl_e") ;
|
|
|
+ CmpAl (26) ; Je8 ("rl_e") ; (* ^Z: end of input *)
|
|
|
+ J8 ("rl_loop") ;
|
|
|
+ M ("rl_e") ;
|
|
|
+ PopAx ;
|
|
|
+ RetR
|
|
|
+END EmitRdLn ;
|
|
|
+
|
|
|
+PROCEDURE EmitData ;
|
|
|
+BEGIN
|
|
|
+ dataAt := rpos ;
|
|
|
+ (* 8 bytes of scratch, never read before written *)
|
|
|
+ B (0) ; B (0) ; B (0) ; B (0) ; B (0) ; B (0) ; B (0) ; B (0) ;
|
|
|
+ B (ORD ("T")) ; B (ORD ("R")) ; B (ORD ("U")) ; B (ORD ("E")) ; B (ORD ("$")) ;
|
|
|
+ B (ORD ("F")) ; B (ORD ("A")) ; B (ORD ("L")) ; B (ORD ("S")) ;
|
|
|
+ B (ORD ("E")) ; B (ORD ("$")) ;
|
|
|
+ B (13) ; B (10) ; B (ORD ("$")) ;
|
|
|
+ B (ORD ("?")) ; B (ORD ("R")) ; B (ORD ("E")) ; B (ORD ("A")) ;
|
|
|
+ B (ORD ("L")) ; B (ORD ("?")) ;
|
|
|
+ WHILE rpos < dataAt + D_END DO
|
|
|
+ B (0)
|
|
|
+ END
|
|
|
+END EmitData ;
|
|
|
+
|
|
|
+PROCEDURE FixUp ;
|
|
|
+VAR i, t, rel : CARDINAL ;
|
|
|
+BEGIN
|
|
|
+ i := 0 ;
|
|
|
+ WHILE i < nfix DO
|
|
|
+ IF fix [i].kind = 2 THEN
|
|
|
+ t := (dataAt + fix [i].val) MOD 10000H ;
|
|
|
+ rt [fix [i].place] := VAL (BYTE, t MOD 100H) ;
|
|
|
+ rt [fix [i].place + 1] := VAL (BYTE, (t DIV 100H) MOD 100H)
|
|
|
+ ELSE
|
|
|
+ t := LblOff (fix [i].nm) ;
|
|
|
+ IF fix [i].kind = 0 THEN
|
|
|
+ (* rel8 is measured from the end of the instruction, i.e. one
|
|
|
+ byte past the displacement field *)
|
|
|
+ rel := (t + 100H - (fix [i].place + 1)) MOD 100H ;
|
|
|
+ rt [fix [i].place] := VAL (BYTE, rel)
|
|
|
+ ELSE
|
|
|
+ rel := (t + 10000H - (fix [i].place + 2)) MOD 10000H ;
|
|
|
+ rt [fix [i].place] := VAL (BYTE, rel MOD 100H) ;
|
|
|
+ rt [fix [i].place + 1] := VAL (BYTE, (rel DIV 100H) MOD 100H)
|
|
|
+ END
|
|
|
+ END ;
|
|
|
+ INC (i)
|
|
|
+ END
|
|
|
+END FixUp ;
|
|
|
+
|
|
|
+(* ---------------------------------------------------------------- *)
|
|
|
+(* public interface *)
|
|
|
+(* ---------------------------------------------------------------- *)
|
|
|
+
|
|
|
+PROCEDURE RT_Build ;
|
|
|
+BEGIN
|
|
|
+ IF built THEN
|
|
|
+ RETURN
|
|
|
+ END ;
|
|
|
+ rpos := 0 ; ltop := 0 ; nfix := 0 ; dataAt := 0 ;
|
|
|
+ EmitInitMem ;
|
|
|
+ EmitEnd ;
|
|
|
+ EmitStackChk ;
|
|
|
+ EmitWrInt ; EmitWrChar ; EmitWrBool ; EmitWrReal ; EmitWrLn ;
|
|
|
+ EmitRdInt ; EmitRdChar ; EmitRdBool ; EmitRdLn ;
|
|
|
+ EmitGetCh ;
|
|
|
+ EmitData ;
|
|
|
+ FixUp ;
|
|
|
+ SetStr (entNm [0], "initmem") ;
|
|
|
+ SetStr (entNm [1], "progend") ;
|
|
|
+ SetStr (entNm [2], "stackchk") ;
|
|
|
+ SetStr (entNm [3], "wrint") ;
|
|
|
+ SetStr (entNm [4], "wrchar") ;
|
|
|
+ SetStr (entNm [5], "wrbool") ;
|
|
|
+ SetStr (entNm [6], "wrreal") ;
|
|
|
+ SetStr (entNm [7], "wrln") ;
|
|
|
+ SetStr (entNm [8], "rdint") ;
|
|
|
+ SetStr (entNm [9], "rdchar") ;
|
|
|
+ SetStr (entNm [10], "rdbool") ;
|
|
|
+ SetStr (entNm [11], "rdln") ;
|
|
|
+ SetStr (entNm [12], "halt") ;
|
|
|
+ built := TRUE
|
|
|
+END RT_Build ;
|
|
|
+
|
|
|
+PROCEDURE RT_Size () : CARDINAL ;
|
|
|
+BEGIN
|
|
|
+ IF NOT built THEN
|
|
|
+ RT_Build ()
|
|
|
+ END ;
|
|
|
+ RETURN rpos
|
|
|
+END RT_Size ;
|
|
|
+
|
|
|
+PROCEDURE RT_Byte (i : CARDINAL ) : BYTE ;
|
|
|
+BEGIN
|
|
|
+ IF NOT built THEN
|
|
|
+ RT_Build ()
|
|
|
+ END ;
|
|
|
+ IF i >= rpos THEN
|
|
|
+ RETURN 0
|
|
|
+ END ;
|
|
|
+ RETURN rt [i]
|
|
|
+END RT_Byte ;
|
|
|
+
|
|
|
+PROCEDURE RT_Entry (i : CARDINAL ) : CARDINAL ;
|
|
|
+BEGIN
|
|
|
+ IF NOT built THEN
|
|
|
+ RT_Build ()
|
|
|
+ END ;
|
|
|
+ IF i > 12 THEN
|
|
|
+ RETURN 0
|
|
|
+ END ;
|
|
|
+ RETURN LblOff (entNm [i])
|
|
|
+END RT_Entry ;
|
|
|
+
|
|
|
+END Runtime.
|
