Runtime.mod 41 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038
  1. IMPLEMENTATION MODULE Runtime ;
  2. (* 8086 runtime library, assembled byte by byte. Each little emitter below is
  3. one 8086 instruction; the ModR/M byte is spelled out in the comment so the
  4. encoding can be checked by hand against an 8086 table. This is the same
  5. approach the compiler itself takes in Compiler.mod (Ebyte/Eword/EmCall),
  6. so the library needs no external assembler and no binary artifact in the
  7. tree - RT_Build assembles it every run, which is why the entry offsets are
  8. known exactly and are not guesses.
  9. Memory model: a .COM image, so CS = DS = ES = SS = 0 and the whole thing
  10. lives in one 64K segment. The runtime occupies image offsets
  11. RT_Build's base .. base + RT_Size - 1, the generated program follows, and
  12. the program's globals follow at that + 1000H.
  13. The base is a parameter rather than an assumption, and that is not
  14. decoration. The image begins with a three-byte JMP - a .COM is entered at
  15. file offset 0, and without it a .COM built by this compiler starts by
  16. executing initmem - so the runtime does NOT sit at image offset 0. Every
  17. address the runtime bakes into its own code (its data block, and the entry
  18. offsets it hands back) therefore has to be biased by that base. Two places
  19. do it, and only two: FixUp for the data block, and RT_Entry for the
  20. entries. The emitted BYTES are identical for any base, because both are
  21. computed after assembly; tests/check_runtime.py and tests/runtime.golden
  22. pass base 0 and are unaffected.
  23. Calling conventions, matching Compiler.IoCall:
  24. WrInt/WrChar/WrBool/WrReal one 16-bit value on the stack (caller pops)
  25. RdInt/RdChar/RdBool one address on the stack (caller pops)
  26. WrLn/RdLn/StackChk nothing
  27. InitMem AX = offset of the program header word block
  28. ProgEnd/Halt nothing; exits with code 0
  29. All entries preserve BP and SP, and every register except the documented
  30. result, so they can be called from the middle of an expression. *)
  31. FROM SYSTEM IMPORT BYTE ;
  32. CONST
  33. MaxRt = 4096 ;
  34. MaxLbl = 64 ;
  35. MaxFix = 400 ;
  36. MaxNm = 15 ;
  37. (* Offsets inside the runtime's own data block. These must agree with the
  38. bytes EmitData emits, and EmitData ASSERTS that they do - because the
  39. only other way to find out is to run a program, and a D_ constant that
  40. is one too high does not crash: the $ that terminates the string it
  41. points at is simply somewhere else, and a $-string read from the wrong
  42. address runs on until it happens to find a 24h. wrln did exactly that
  43. and printed a screenful of memory, which is what found this. D_TRUE was
  44. the only one that was right, and the golden (instructions only) could
  45. not see any of it. *)
  46. D_NUM = 0 ; (* 8 bytes, decimal conversion scratch *)
  47. D_TRUE = 8 ; (* "TRUE$" - 5 bytes, 8..12 *)
  48. D_FALSE = 13 ; (* "FALSE$" - 6 bytes, 13..18 *)
  49. D_CRLF = 19 ; (* CR LF '$' - 3 bytes, 19..21 *)
  50. D_REAL = 22 ; (* "?REAL?" - 6 bytes, 22..27; reals are not formatted yet *)
  51. D_PUSH = 28 ; (* 2 bytes, 28..29: the one-character pushback. The high
  52. byte is 1 whenever a character is pending, so the
  53. word is 0 exactly when the slot is empty - a NUL in
  54. the input would otherwise be indistinguishable from
  55. "nothing pushed back". Byte 30 is unused. *)
  56. D_END = 31 ; (* the block is padded to here *)
  57. (* THE LOAD BIAS. Everything above is an offset into the image as this
  58. compiler numbers it: the entry JMP is at image 0. But a DOS .COM is
  59. NOT loaded at that offset - DOS loads it at CS:0100, because 0000..00FF
  60. is the PSP - so image offset K lives at CS:(K + 0100h), and since a
  61. .COM has CS = DS, every address baked into the image as a literal has
  62. to carry that +0100h.
  63. Getting this wrong is the single most confusing failure this compiler
  64. can have, because nothing crashes. The entry JMP is *relative*, so it
  65. still lands on the prologue; every CALL is relative, so every call
  66. still lands on the right runtime entry; initmem still runs and still
  67. zeroes the data area. The program therefore starts, runs, and prints
  68. its first field correctly - and then a $ that is 0100h too low resolves
  69. to code instead of to data, so the string walk runs on through the
  70. runtime's own instructions until it happens to hit a 24h. That is
  71. exactly what writeln('hi') did: `hi' out of wrtin's inline data, then
  72. 249 bytes of runtime machine code, stopping only at the '$' inside
  73. "TRUE$". See tests/fixtures/t02_writeln.out.
  74. The bias is a CONSTANT, not a variable to be relocated at load time,
  75. because the 8086 has no way to relocode an image in place and no way
  76. to set a segment register to a sub-paragraph boundary. It is the same
  77. +0100h the original's own output has: TPSRC7 opendest copies the
  78. generated image to 100h and runs it there, so the original's addresses
  79. are 0100h-relative too. The difference is only in how the bytes are
  80. *numbered* - ours are 0-based in the file, the original's are
  81. segment-relative - and this constant is where that difference stops.
  82. The constant itself is declared in Runtime.def, because that is the only
  83. declaration site a compiler can import - an implementation module does not
  84. re-declare what its definition module already declared. *)
  85. TYPE
  86. LblRec = RECORD
  87. nm : ARRAY [0..MaxNm] OF CHAR ;
  88. off : CARDINAL ;
  89. END ;
  90. FixRec = RECORD
  91. kind : CARDINAL ; (* 0 = rel8, 1 = rel16, 2 = data address *)
  92. place : CARDINAL ; (* offset of the displacement/address field *)
  93. nm : ARRAY [0..MaxNm] OF CHAR ;
  94. val : CARDINAL ;
  95. END ;
  96. VAR
  97. rt : ARRAY [0..MaxRt - 1] OF BYTE ;
  98. rpos : CARDINAL ;
  99. lbl : ARRAY [0..MaxLbl - 1] OF LblRec ;
  100. ltop : CARDINAL ;
  101. fix : ARRAY [0..MaxFix - 1] OF FixRec ;
  102. nfix : CARDINAL ;
  103. dataAt : CARDINAL ;
  104. rtBase : CARDINAL ;
  105. built : BOOLEAN ;
  106. entNm : ARRAY [0..13] OF ARRAY [0..MaxNm] OF CHAR ;
  107. (* ---------------------------------------------------------------- *)
  108. (* name helpers *)
  109. (* ---------------------------------------------------------------- *)
  110. PROCEDURE StrEq (a, b : ARRAY OF CHAR ) : BOOLEAN ;
  111. VAR i : CARDINAL ;
  112. BEGIN
  113. i := 0 ;
  114. WHILE (i <= HIGH (a)) AND (i <= HIGH (b)) DO
  115. IF a [i] # b [i] THEN
  116. RETURN FALSE
  117. END ;
  118. INC (i)
  119. END ;
  120. RETURN TRUE
  121. END StrEq ;
  122. PROCEDURE SetStr (VAR dst : ARRAY OF CHAR ; src : ARRAY OF CHAR ) ;
  123. VAR i : CARDINAL ;
  124. BEGIN
  125. i := 0 ;
  126. WHILE (i <= HIGH (dst)) AND (i <= HIGH (src)) DO
  127. dst [i] := src [i] ;
  128. INC (i)
  129. END ;
  130. IF i <= HIGH (dst) THEN
  131. dst [i] := 0C
  132. END
  133. END SetStr ;
  134. (* ---------------------------------------------------------------- *)
  135. (* primitive emitters *)
  136. (* ---------------------------------------------------------------- *)
  137. PROCEDURE B (b : CARDINAL ) ;
  138. (* emit exactly ONE byte. A two-byte opcode must be written as two B calls -
  139. B masks to 100H, so B (8BE4H) would silently emit just E4. *)
  140. BEGIN
  141. IF rpos >= MaxRt THEN
  142. RETURN (* blob is oversized: drop the byte *)
  143. END ;
  144. rt [rpos] := VAL (BYTE, b MOD 100H) ;
  145. INC (rpos)
  146. END B ;
  147. PROCEDURE W (w : CARDINAL ) ;
  148. BEGIN
  149. B (w MOD 100H) ;
  150. B ((w DIV 100H) MOD 100H) (* little endian *)
  151. END W ;
  152. PROCEDURE M (nm : ARRAY OF CHAR ) ;
  153. (* mark: nm is the current offset *)
  154. BEGIN
  155. IF ltop < MaxLbl THEN
  156. SetStr (lbl [ltop].nm, nm) ;
  157. lbl [ltop].off := rpos ;
  158. INC (ltop)
  159. END
  160. END M ;
  161. PROCEDURE AddFix (kind, place : CARDINAL ; nm : ARRAY OF CHAR ; val : CARDINAL ) ;
  162. BEGIN
  163. IF nfix < MaxFix THEN
  164. fix [nfix].kind := kind ;
  165. fix [nfix].place := place ;
  166. fix [nfix].val := val ;
  167. SetStr (fix [nfix].nm, nm) ;
  168. INC (nfix)
  169. END
  170. END AddFix ;
  171. PROCEDURE LblOff (nm : ARRAY OF CHAR ) : CARDINAL ;
  172. VAR i : CARDINAL ;
  173. BEGIN
  174. i := 0 ;
  175. WHILE i < ltop DO
  176. IF StrEq (lbl [i].nm, nm) THEN
  177. RETURN lbl [i].off
  178. END ;
  179. INC (i)
  180. END ;
  181. RETURN 0
  182. END LblOff ;
  183. PROCEDURE J8 (nm : ARRAY OF CHAR ) ;
  184. BEGIN
  185. B (0EBH) ; (* JMP rel8 *)
  186. AddFix (0, rpos, nm, 0) ;
  187. B (0)
  188. END J8 ;
  189. PROCEDURE C8 (nm : ARRAY OF CHAR ) ;
  190. BEGIN
  191. B (0E8H) ; (* CALL rel16 *)
  192. AddFix (1, rpos, nm, 0) ;
  193. W (0)
  194. END C8 ;
  195. PROCEDURE Jcc (code : CARDINAL ; nm : ARRAY OF CHAR ) ;
  196. BEGIN
  197. B (code) ; (* Jcc rel8 *)
  198. AddFix (0, rpos, nm, 0) ;
  199. B (0)
  200. END Jcc ;
  201. PROCEDURE Dd (delta : CARDINAL ) ;
  202. (* emit a 16-bit address into the runtime's data block; the value is only
  203. known once the data block has been placed, so it is a fixup *)
  204. BEGIN
  205. AddFix (2, rpos, "", delta) ;
  206. W (0)
  207. END Dd ;
  208. (* --- 8-bit / 16-bit register and memory forms, one instruction each --- *)
  209. (* THE 16-BIT ModR/M EFFECTIVE-ADDRESS TABLE, MEASURED NOT REMEMBERED.
  210. Every address form below was confirmed by EXECUTING it on a real 8086
  211. (qemu-system-i386) with a probe that stores a marker through the candidate
  212. encoding and then reports which physical address received it; see
  213. tests/probe/modrm19.s. The mod=11 column is not an address at all -- it
  214. names a register -- so it is confirmed instead by asking GNU as to
  215. ENCODE the eight register moves and checking FCML's decode of the result
  216. (tests/probe/modrm11.py, which also carries the hand-checking anchors).
  217. Do not "fix" any of these from memory. The version that comes to mind is
  218. wrong in exactly the cells called out below, and every one of those
  219. mistakes shipped as code that decoded cleanly:
  220. r/m mod=00 mod=01 mod=10 mod=11
  221. 000 [BX+SI] [BX+SI]+disp [BX+SI]+disp AX
  222. 001 [BX+DI] [BX+DI]+disp [BX+DI]+disp CX
  223. 010 [BP+SI] [BP+SI]+disp [BP+SI]+disp DX
  224. 011 [BP+DI] [BP+DI]+disp [BP+DI]+disp BX
  225. 100 [SI] [SI]+disp [SI]+disp SP
  226. 101 [DI] [DI]+disp [DI]+disp BP
  227. 110 disp16 [BP]+disp [BP]+disp SI
  228. 111 [BX] [BX]+disp [BX]+disp DI
  229. "disp" is disp8 for mod=01 and disp16 for mod=10.
  230. In mod=11 BOTH fields name a register and BOTH use the same list,
  231. AX CX DX BX SP BP SI DI -- the reg field and the r/m field do not
  232. differ, and there is no second BX at code 7. The memorable version
  233. drops AX off the front and invents a duplicate BX at the end, which
  234. shifts every code down by one; that is precisely how MovSiBx and
  235. CmpSiBx came to be written "89 DC" and "39 DC", which are MOV SP,BX
  236. and CMP SP,BX. Note what the shifted table gets right by luck: SP is
  237. at 100 either way, so the mistake is invisible until you check a
  238. register below it. rm=100 is SP, and SI is rm=110, not rm=100.
  239. And reg/rm swap direction with the opcode, which is the other trap:
  240. 88 /r MOV r/m8,r8 89 /r MOV r/m16,r16 reg is the SOURCE
  241. 8A /r MOV r8,r/m8 8B /r MOV r16,r/m16 reg is the TARGET
  242. So ModRM C6 names "DH and AL" either way, but 88 C6 is DH:=AL while
  243. 8A C6 is AL:=DH. The 8-bit register list is also its own, and it is not
  244. the word list:
  245. 000 001 010 011 100 101 110 111 = AL CL DL BL AH CH DH BH
  246. The two lists agree at every code except 100, where the byte form is AH
  247. and the word form is SP. Reading the same ModRM byte as the other size
  248. silently swaps AH for SP, and 88 C2 is DL:=AL while 88 17 is [BX]<-DL.
  249. The word-form list, and the four anchors nobody writes by hand:
  250. 83 C4 08 ADD SP, 8 rm=100 -> SP
  251. 83 C6 02 ADD SI, 2 rm=110 -> SI
  252. 8B EC MOV BP, SP reg=101 rm=100
  253. 8B E5 MOV SP, BP reg=100 rm=101
  254. Asking "which register is rm=100?" and answering SI is the single most
  255. common error in this file's history.
  256. Concrete recipes for opcode 8r / 9r (r/m = rm, 16-bit form):
  257. mod=00 rm=110 -> 06 <disp16> the only direct form
  258. mod=00 rm=111 -> 07 = [BX] 2 bytes
  259. mod=00 rm=101 -> 05 = [DI] 2 bytes
  260. mod=01 rm=110 -> 46 disp8 = [BP]+disp8
  261. mod=01 rm=111 -> 47 disp8 = [BX]+disp8
  262. mod=01 rm=101 -> 45 disp8 = [DI]+disp8
  263. There is no [SP] form in 16-bit mode: SIB bytes are 386-only. Anything
  264. wanting the top of the stack has to go through BP. *)
  265. PROCEDURE PushBp ; BEGIN B (55H) END PushBp ;
  266. PROCEDURE PopBp ; BEGIN B (5DH) END PopBp ;
  267. PROCEDURE MovBpSp ; BEGIN B (8BH) ; B (0ECH) END MovBpSp ; (* 8B EC: MOV BP,SP *)
  268. PROCEDURE MovSpBp ; BEGIN B (89H) ; B (0ECH) END MovSpBp ; (* 89 EC: MOV SP,BP *)
  269. PROCEDURE LeaveR ; BEGIN B (0C9H) END LeaveR ;
  270. PROCEDURE RetR ; BEGIN B (0C3H) END RetR ;
  271. PROCEDURE Int21 ; BEGIN B (0CDH) ; B (21H) END Int21 ;
  272. PROCEDURE PushDs ; BEGIN B (1EH) END PushDs ;
  273. PROCEDURE PopEs ; BEGIN B (7H) END PopEs ;
  274. PROCEDURE PushAx ; BEGIN B (50H) END PushAx ;
  275. PROCEDURE PopAx ; BEGIN B (58H) END PopAx ;
  276. PROCEDURE PushBx ; BEGIN B (53H) END PushBx ;
  277. PROCEDURE PopBx ; BEGIN B (5BH) END PopBx ;
  278. PROCEDURE PushCx ; BEGIN B (51H) END PushCx ;
  279. PROCEDURE PopCx ; BEGIN B (59H) END PopCx ;
  280. PROCEDURE PushDx ; BEGIN B (52H) END PushDx ;
  281. PROCEDURE PopDx ; BEGIN B (5AH) END PopDx ;
  282. PROCEDURE PushDi ; BEGIN B (57H) END PushDi ;
  283. PROCEDURE PopDi ; BEGIN B (5FH) END PopDi ;
  284. PROCEDURE XorAxAx ; BEGIN B (31H) ; B (0C0H) END XorAxAx ; (* 11 000 000 *)
  285. PROCEDURE XorCxCx ; BEGIN B (31H) ; B (0C9H) END XorCxCx ; (* 11 001 001 *)
  286. PROCEDURE XorDxDx ; BEGIN B (31H) ; B (0D2H) END XorDxDx ; (* 11 010 010 *)
  287. PROCEDURE XorDiDi ; BEGIN B (31H) ; B (0FFH) END XorDiDi ; (* 11 111 111 *)
  288. PROCEDURE IncCx ; BEGIN B (41H) END IncCx ;
  289. PROCEDURE IncSi ; BEGIN B (46H) END IncSi ;
  290. PROCEDURE DecSi ; BEGIN B (4EH) END DecSi ;
  291. PROCEDURE AddDi2 ; BEGIN B (83H) ; B (0C7H) ; B (2) END AddDi2 ; (* 11 000 111 *)
  292. PROCEDURE CmpAl (v : CARDINAL ) ; BEGIN B (3CH) ; B (v) END CmpAl ;
  293. PROCEDURE CmpAx0 ; BEGIN B (83H) ; B (0F8H) ; B (0) END CmpAx0 ;
  294. PROCEDURE CmpCx0 ; BEGIN B (83H) ; B (0F9H) ; B (0) END CmpCx0 ;
  295. PROCEDURE CmpArgW0 ;
  296. (* CMP WORD PTR [BP+2],0 - the one 16-bit argument of a BOOLEAN entry.
  297. [SP] cannot be encoded in 16-bit mode, so borrow BP for the three
  298. instructions and hand SP back untouched before the caller pops the
  299. argument. (Was 83 7C 24 00 00, which decodes as CMP WORD [SI+24h],0.)
  300. The imm8 of the 83 form is sign-extended to 16 bits, so 0 really is a
  301. 16-bit zero. *)
  302. BEGIN
  303. B (8BH) ; B (0ECH) ; (* MOV BP,SP *)
  304. B (83H) ; B (7EH) ; B (2) ; B (0) ; (* CMP WORD [BP+2],0 *)
  305. B (89H) ; B (0ECH) (* MOV SP,BP *)
  306. END CmpArgW0 ;
  307. PROCEDURE CmpSiBx ; BEGIN B (39H) ; B (0DEH) END CmpSiBx ; (* 39 DE: CMP SI,BX *)
  308. PROCEDURE CmpCxDx ; BEGIN B (39H) ; B (0D1H) END CmpCxDx ; (* 11 010 001 *)
  309. PROCEDURE CmpDiCx ; BEGIN B (39H) ; B (0CFH) END CmpDiCx ; (* 11 001 111 *)
  310. PROCEDURE CmpBx0 ; BEGIN B (83H) ; B (0FBH) ; B (0) END CmpBx0 ;
  311. PROCEDURE CmpCxV (v : CARDINAL ) ; BEGIN B (83H) ; B (0F9H) ; B (v) END CmpCxV ;
  312. PROCEDURE AddDl (v : CARDINAL ) ; BEGIN B (80H) ; B (0C2H) ; B (v) END AddDl ;
  313. PROCEDURE SubAl (v : CARDINAL ) ; BEGIN B (2CH) ; B (v) END SubAl ;
  314. PROCEDURE NegAx ; BEGIN B (0F7H) ; B (0D8H) END NegAx ;
  315. PROCEDURE NegDi ; BEGIN B (0F7H) ; B (0DFH) END NegDi ;
  316. PROCEDURE DivCx ; BEGIN B (0F7H) ; B (0F1H) END DivCx ; (* 11 110 001 *)
  317. PROCEDURE MulBx ; BEGIN B (0F7H) ; B (0E3H) END MulBx ; (* 11 100 011 *)
  318. PROCEDURE MovAh (v : CARDINAL ) ; BEGIN B (0B4H) ; B (v) END MovAh ;
  319. PROCEDURE MovDl (v : CARDINAL ) ; BEGIN B (0B2H) ; B (v) END MovDl ;
  320. (* The runtime's own data block, addressed by absolute image address. Four
  321. emitters cover it, and the difference between them is the whole subject of
  322. the mistakes recorded below, so they are named systematically:
  323. Mov<reg>Vx MOV reg, Vx -- reg := the ADDRESS (BB / BA + Dd)
  324. Ld<reg>Vx MOV reg, [Vx] -- reg := the CONTENTS (8B 1E + Dd)
  325. StVx<reg> MOV [Vx], reg -- [Vx] := reg (89 1E + Dd)
  326. "Vx" is the operand word for "a 16-bit absolute address into the data
  327. block", spelled with a V precisely so it cannot be confused with a base
  328. register: on the 8086 there is no [BX] memory form, so the address has to
  329. go through mod=00 / rm=110, and rm=111 is [BX+SI] - a different, perfectly
  330. decodable instruction. tests/audit_helpers.py checks all four.
  331. The two traps here, both of which happened:
  332. - Dd versus W. Dd turns a D_ offset into a FIXUP, so the address can be
  333. placed only once the data block has been given its final position in the
  334. image. W emits the number as it stands. The two produce the SAME
  335. instruction, and getch once used MovBxImm where it wanted the address, so
  336. `MOV BX,D_PUSH' came out as `MOV BX,001Ch' - the raw offset 1Ch, inside
  337. the entry JMP. Non-zero, so the pushback slot was never examined, getch
  338. served a byte of the runtime's own code forever, and readln hung. Hence
  339. the Imm suffix: the raw-immediate emitters are named for what they do.
  340. - address versus contents. LdBxVx and MovBxVx are both `8B`/`BB` + Dd to
  341. the eye and completely different instructions. getch's first cut used
  342. MovBxVx where it wanted the contents, so it tested the ADDRESS for zero,
  343. found 02AFh every time, and returned the low byte of memory 02AFh - 0,
  344. the value it had just stored there - instead of asking DOS. *)
  345. PROCEDURE MovBxImm (v : CARDINAL ) ; BEGIN B (0BBH) ; W (v) END MovBxImm ;
  346. PROCEDURE MovCxImm (v : CARDINAL ) ; BEGIN B (0B9H) ; W (v) END MovCxImm ;
  347. PROCEDURE MovDxImm (v : CARDINAL ) ; BEGIN B (0BAH) ; W (v) END MovDxImm ;
  348. PROCEDURE MovBxVx (delta : CARDINAL ) ; BEGIN B (0BBH) ; Dd (delta) END MovBxVx ;
  349. PROCEDURE MovDxVx (delta : CARDINAL ) ; BEGIN B (0BAH) ; Dd (delta) END MovDxVx ;
  350. PROCEDURE LdBxVx (delta : CARDINAL ) ;
  351. (* 8B 1E lo hi: BX := WORD PTR [Vx] - mod=00 / rm=110, the only 16-bit form
  352. that can carry a bare absolute address. *)
  353. BEGIN
  354. B (8BH) ; B (01EH) ; Dd (delta)
  355. END LdBxVx ;
  356. PROCEDURE MovSiAx ; BEGIN B (8BH) ; B (0F0H) END MovSiAx ; (* 8B F0: MOV SI,AX *)
  357. PROCEDURE MovAxDi ; BEGIN B (8BH) ; B (0C7H) END MovAxDi ; (* 11 000 111 *)
  358. PROCEDURE MovCxSi6 ; BEGIN B (8BH) ; B (4CH) ; B (6) END MovCxSi6 ;
  359. PROCEDURE MovDxSi2 ; BEGIN B (8BH) ; B (54H) ; B (2) END MovDxSi2 ;
  360. (* The program header is a block of words laid out by the compiler:
  361. +0 hdrFlag 1 = image is valid
  362. +2 hdrCS end of the generated code, in bytes
  363. +4 hdrDS base of the data area <- initmem wants these two
  364. +6 hdrHeap end of the data area <-
  365. +8 hdrMax max open files
  366. initmem must read the words the COMPILER WRITES, and those are +4 (hdrDS,
  367. the data base) and +6 (hdrHeap, the data end). It used to read +8, which
  368. is hdrMax -- and the compiler patches that to 0 -- so CX came out as 0,
  369. "cmp cx,dx / jbe im_done" fired immediately, and initmem silently zeroed
  370. nothing at all. A 3-byte instruction, so no entry offset moved either
  371. way; only the header offset in the byte changed. Nothing caught it
  372. because the loop was well formed - it just did nothing. The cross-check
  373. that would have: tests/run_com_tests.sh now asserts the runtime's SI-relative
  374. reads against the same header offsets it verifies the words at. *)
  375. PROCEDURE MovDxSi4 ; BEGIN B (8BH) ; B (54H) ; B (4) END MovDxSi4 ;
  376. PROCEDURE MovAxBp4 ; BEGIN B (8BH) ; B (46H) ; B (4) END MovAxBp4 ; (* AX:=[BP+4] *)
  377. PROCEDURE MovBxBp4 ; BEGIN B (8BH) ; B (5EH) ; B (4) END MovBxBp4 ; (* BX:=[BP+4] *)
  378. PROCEDURE MovAlDh ; BEGIN B (8AH) ; B (0C6H) END MovAlDh ; (* 8A C6: AL:=DH *)
  379. PROCEDURE MovDlSi ; BEGIN B (8AH) ; B (14H) END MovDlSi ;
  380. PROCEDURE MovDlArg ; BEGIN B (8AH) ; B (56H) ; B (2) END MovDlArg ; (* DL:=[BP+2] *)
  381. (* The AL twins of the three above. INT 21h AH=02h displays the character in
  382. AL, not DL, so every character this runtime writes has to arrive in AL.
  383. DL is the natural register for the digit scratch in wrint and for a stack
  384. argument in wrchar, and both of them were loading DL and then calling
  385. AH=02h - which printed whatever happened to be left in AL. For wrint that
  386. was the QUOTIENT's low byte from the preceding DIV, so writeln(1) printed a
  387. NUL and writeln(2) printed a NUL, and a two-digit number printed its
  388. quotient instead of itself. A wrong register is not a wrong encoding: the
  389. golden bytes were right, `mov dl,[si]' is a perfectly good instruction, and
  390. every byte-level check stayed green. Only running it found this. *)
  391. PROCEDURE MovAlD (v : CARDINAL ) ; BEGIN B (0B0H) ; B (v) END MovAlD ; (* MOV AL,imm8 *)
  392. PROCEDURE MovAlSi ; BEGIN B (8AH) ; B (04H) END MovAlSi ; (* 8A 04: AL:=[SI] *)
  393. PROCEDURE MovAlArg ; BEGIN B (8AH) ; B (46H) ; B (2) END MovAlArg ; (* AL:=[BP+2] *)
  394. PROCEDURE MovAlDl ; BEGIN B (8AH) ; B (0C2H) END MovAlDl ; (* 8A C2: AL:=DL *)
  395. PROCEDURE StDiAx ; BEGIN B (89H) ; B (5H) END StDiAx ; (* 89 05: [DI]:=AX *)
  396. PROCEDURE StSiDl ; BEGIN B (88H) ; B (14H) END StSiDl ; (* 88 14: [SI]:=DL *)
  397. PROCEDURE StDiDl ; BEGIN B (88H) ; B (15H) END StDiDl ; (* 88 15: [DI]:=DL *)
  398. PROCEDURE StDiCx ; BEGIN B (89H) ; B (0DH) END StDiCx ; (* 89 0D: [DI]:=CX *)
  399. PROCEDURE MovDiBp4 ; BEGIN B (8BH) ; B (7EH) ; B (4) END MovDiBp4 ; (* DI:=[BP+4] *)
  400. (* There is NO "store through BX" instruction on the 8086, and writing one
  401. anyway is the single most expensive mistake this file has produced, so the
  402. reasoning is recorded rather than left in the probe history.
  403. In 16-bit addressing the r/m column is a LOCATION, not a register list: for
  404. mod=00, rm=000..101 are [BX+SI] [BX+DI] [BP+SI] [BP+DI] [SI] [DI], and
  405. rm=110 is the only one that means "a direct displacement". rm=111 is
  406. [BX+SI], NOT [BX]. So `89 1D' - the ModR/M the first version of this used
  407. for "MOV [BX],CX" - is mod=00 reg=BX r/m=DI, i.e. MOV [DI],BX: the two
  408. operands swapped AND [BX] inexpressible. GNU as and objdump in -m i8086
  409. agree, and the bytes are perfectly well formed, which is why nothing
  410. objected. What the program saw was its own address being written over the
  411. interrupt vector table, and the variable it was asked to fill left holding
  412. whatever the loader put there: readln(n) then printed 0, and readln(c)
  413. printed a NUL. Correct by comparison: the caller puts the address in BX,
  414. and the store has to go through DI or SI, so the sequence is
  415. MOV DI,[BP+4] / MOV [DI],<value> - see StoreThrough below. *)
  416. PROCEDURE MovDlAl ; BEGIN B (88H) ; B (0C2H) END MovDlAl ;
  417. PROCEDURE XchgAxDi ; BEGIN B (87H) ; B (0C7H) END XchgAxDi ; (* 87 C7: AX<->DI *)
  418. PROCEDURE AddAxDi ; BEGIN B (03H) ; B (0C7H) END AddAxDi ; (* 03 C7: AX:=AX+DI *)
  419. PROCEDURE MovSiBx ; BEGIN B (89H) ; B (0DEH) END MovSiBx ; (* 89 DE: MOV SI,BX *)
  420. PROCEDURE MovDiDx ; BEGIN B (89H) ; B (0D7H) END MovDiDx ;
  421. PROCEDURE MovDiAx ; BEGIN B (89H) ; B (0C7H) END MovDiAx ;
  422. PROCEDURE AddDiAx ; BEGIN B (1H) ; B (0C7H) END AddDiAx ;
  423. PROCEDURE IncBx ; BEGIN B (43H) END IncBx ;
  424. PROCEDURE LdAlBx ; BEGIN B (8AH) ; B (07H) END LdAlBx ; (* 8A 07: AL:=[BX] *)
  425. PROCEDURE MovAlBl ; BEGIN B (8AH) ; B (0C3H) END MovAlBl ; (* 8A C3: AL:=BL *)
  426. (* 8A 07 and 8A C3 are one letter apart and do opposite things: the
  427. first reads the byte AT the pointer in BX, the second takes the low
  428. byte OF BX. getch's pushback path wanted the second and used the
  429. first, so it read memory 010Ah - the address of the character - and
  430. returned whatever was there. Hence the Ld/Mov split. *)
  431. PROCEDURE MovClBx ; BEGIN B (8AH) ; B (0FH) END MovClBx ; (* 8A 0F: CL:=[BX] *)
  432. PROCEDURE XorBxBx ; BEGIN B (31H) ; B (0DBH) END XorBxBx ; (* 31 DB: BX:=0 *)
  433. PROCEDURE MovBlDl ; BEGIN B (8AH) ; B (0DAH) END MovBlDl ; (* 8A DA: BL:=DL *)
  434. PROCEDURE StVxBx (delta : CARDINAL ) ;
  435. (* 89 1E lo hi: MOV [Vx],BX - the mirror of LdBxVx above, and it must use the
  436. same mod=00 / rm=110 and the same Dd fixup kind, or one of the two
  437. addresses a different place. *)
  438. BEGIN
  439. B (89H) ; B (01EH) ; Dd (delta)
  440. END StVxBx ;
  441. PROCEDURE JmpBx ; BEGIN B (0FFH) ; B (0E3H) END JmpBx ; (* FF E3: JMP BX *)
  442. (* JE 74 JNE 75 JB 72 JBE 76 JGE 7D *)
  443. PROCEDURE Je8 (nm : ARRAY OF CHAR ) ; BEGIN Jcc (74H, nm) END Je8 ;
  444. PROCEDURE Jne8 (nm : ARRAY OF CHAR ) ; BEGIN Jcc (75H, nm) END Jne8 ;
  445. PROCEDURE Jb8 (nm : ARRAY OF CHAR ) ; BEGIN Jcc (72H, nm) END Jb8 ;
  446. PROCEDURE Jbe8 (nm : ARRAY OF CHAR ) ; BEGIN Jcc (76H, nm) END Jbe8 ;
  447. PROCEDURE Jge8 (nm : ARRAY OF CHAR ) ; BEGIN Jcc (7DH, nm) END Jge8 ;
  448. PROCEDURE Ja8 (nm : ARRAY OF CHAR ) ; BEGIN Jcc (77H, nm) END Ja8 ;
  449. PROCEDURE Jcxz8 (nm : ARRAY OF CHAR ) ; BEGIN Jcc (0E3H, nm) END Jcxz8 ;
  450. PROCEDURE Loop8 (nm : ARRAY OF CHAR ) ; BEGIN Jcc (0E2H, nm) END Loop8 ;
  451. (* ---------------------------------------------------------------- *)
  452. (* the entries *)
  453. (* ---------------------------------------------------------------- *)
  454. PROCEDURE EmitInitMem ;
  455. (* AX = offset of the program header. The header holds, at +4 the base of
  456. the program's data area and at +8 its end, so the globals can be zeroed -
  457. Pascal leaves them undefined, TP3's runtime clears them. Also makes
  458. ES = DS so that any string instruction in the library would work. *)
  459. BEGIN
  460. M ("initmem") ;
  461. MovSiAx ; (* SI = AX = the header offset the caller passed *)
  462. MovDxSi4 ; (* DX = [SI+4] = hdrDS = data base *)
  463. MovCxSi6 ; (* CX = [SI+6] = hdrHeap = data end *)
  464. CmpCxDx ;
  465. Jbe8 ("im_done") ;
  466. MovDiDx ; (* DI = data base *)
  467. M ("im_zero") ;
  468. XorAxAx ; (* AX = 0: the value written into every global.
  469. The caller passes the header offset in AX, so
  470. without this the "zeroing" loop would write the
  471. header offset into all of them. *)
  472. StDiAx ;
  473. AddDi2 ;
  474. CmpDiCx ;
  475. Jb8 ("im_zero") ;
  476. M ("im_done") ;
  477. PushDs ; PopEs ;
  478. RetR
  479. END EmitInitMem ;
  480. PROCEDURE EmitEnd ;
  481. (* progend and halt are the same code: the compiler already zeroes AX for
  482. progend, and a HALT argument is discarded at compile time, so both leave
  483. with exit code 0. *)
  484. BEGIN
  485. M ("progend") ;
  486. M ("halt") ;
  487. XorAxAx ;
  488. MovAh (4CH) ;
  489. Int21 ;
  490. RetR
  491. END EmitEnd ;
  492. PROCEDURE EmitStackChk ;
  493. (* called from every procedure prologue. Range and stack checking are not
  494. compiled in yet, so this must do nothing at all - in particular it must
  495. not touch a register, because the call site is in the middle of a
  496. partially evaluated expression. *)
  497. BEGIN
  498. M ("stackchk") ;
  499. RetR
  500. END EmitStackChk ;
  501. PROCEDURE EmitGetCh ;
  502. (* AL = next character, 1Ah at end of input. INT 21h AH=08h reads without
  503. echoing, so a redirected stdin behaves the same as a keyboard.
  504. This is TP3's `getbyte' (TPSRC4:94), not a bare INT 21h. getbyte serves a
  505. buffered character from the file record without advancing the buffer
  506. pointer when the "char pre-read" flag ($02) is set, and readnum sets that
  507. flag on the character that ENDS a number - the terminating blank is *not*
  508. consumed. xreadln is then called and it is the xreadln that consumes the
  509. newline.
  510. This matters because `readln(n)' is emitted as xrdint followed by xreadln
  511. (TPSRC8 prdrdln emits xreadln whenever rdlnflg is set). A getch that
  512. always consumed its character left xreadln starting on the *following*
  513. line, so `readln(n); readln(c)' read the char from line 3 of the input.
  514. One byte of pushback reproduces the flag. *)
  515. BEGIN
  516. M ("getch") ;
  517. LdBxVx (D_PUSH) ; (* BX := the slot's contents *)
  518. CmpBx0 ;
  519. Je8 ("gc_dos") ;
  520. MovAlBl ; (* AL := the pending character, i.e. the
  521. low byte OF BX - not the byte at [BX] *)
  522. XorBxBx ;
  523. StVxBx (D_PUSH) ; (* and empty the slot *)
  524. RetR ;
  525. M ("gc_dos") ;
  526. MovAh (8) ;
  527. Int21 ;
  528. RetR
  529. END EmitGetCh ;
  530. PROCEDURE EmitUnGetCh ;
  531. (* put AL back, so the next getch returns it again. TP3 does this by
  532. rewinding the buffer pointer; a one-byte slot is the same thing. *)
  533. BEGIN
  534. M ("ungetch") ;
  535. MovDlAl ;
  536. MovBxImm (1) ; (* BH := 1 marks the slot occupied, so
  537. a pushed-back NUL is still a
  538. pushed-back NUL *)
  539. MovBlDl ;
  540. StVxBx (D_PUSH) ;
  541. RetR
  542. END EmitUnGetCh ;
  543. PROCEDURE EmitWrInt ;
  544. (* one signed 16-bit value on the stack. Div CX gives the remainder in DX,
  545. which is turned into a digit and stored backwards from the end of the
  546. scratch area, then printed forwards. *)
  547. BEGIN
  548. M ("wrint") ;
  549. PushBp ; MovBpSp ;
  550. MovAxBp4 ;
  551. CmpAx0 ;
  552. Jge8 ("wi_pos") ;
  553. PushAx ;
  554. MovAlD (ORD ("-")) ; MovAh (2) ; Int21 ;
  555. PopAx ;
  556. NegAx ;
  557. M ("wi_pos") ;
  558. MovCxImm (10) ;
  559. MovBxVx (D_NUM + 8) ; (* BX = one past the last digit *)
  560. MovSiBx ;
  561. M ("wi_dig") ;
  562. XorDxDx ;
  563. DivCx ;
  564. AddDl (ORD ("0")) ;
  565. DecSi ;
  566. StSiDl ;
  567. CmpAx0 ;
  568. Jne8 ("wi_dig") ;
  569. M ("wi_out") ;
  570. CmpSiBx ;
  571. Je8 ("wi_done") ;
  572. MovAlSi ; (* the digit: AH=02h wants it in AL *)
  573. MovAh (2) ; Int21 ;
  574. IncSi ;
  575. J8 ("wi_out") ;
  576. M ("wi_done") ;
  577. MovSpBp ; PopBp ; RetR
  578. END EmitWrInt ;
  579. PROCEDURE EmitWrChar ;
  580. (* the low byte of the one 16-bit argument, which sits above the return
  581. address. There is no [SP] addressing in 16-bit mode, so BP stands in for
  582. the stack pointer and is handed straight back before the RET.
  583. AL, not DL: see the AL twins above. *)
  584. BEGIN
  585. M ("wrchar") ;
  586. MovBpSp ;
  587. MovAlArg ;
  588. MovSpBp ;
  589. MovAh (2) ;
  590. Int21 ;
  591. RetR
  592. END EmitWrChar ;
  593. PROCEDURE EmitWrInl ;
  594. (* Write an inline string literal - TP3 TPSRC4 "xwrtinl".
  595. The compiler emits
  596. CALL wrtinl <length byte> <character>...
  597. so the return address on the stack points at the length byte that follows
  598. the call. POP BX takes that address, CX picks up the length, and the
  599. routine finishes with JMP BX - returning to just past the last character.
  600. That is the whole trick: the literal is self-delimiting, so it needs no
  601. terminator, no length table and no space in the data segment, and it costs
  602. the code stream only the characters themselves (TPSRC10 "estring" emits
  603. exactly <length byte><chars> for the same reason).
  604. Consequently this entry has NO stack argument, unlike WrInt/WrChar: the
  605. return address has already been consumed by the POP. *)
  606. BEGIN
  607. M ("wrtinl") ;
  608. PopBx ; (* BX := address of the length byte *)
  609. XorCxCx ;
  610. MovClBx ; (* CX := length *)
  611. IncBx ; (* BX -> first character *)
  612. MovAh (2) ; (* INT 21h/02h: put character, AL *)
  613. Jcxz8 ("wn_end") ; (* empty string -> nothing to do *)
  614. M ("wn_loop") ;
  615. LdAlBx ; (* AL := next character *)
  616. Int21 ; (* (preserves every register but AL) *)
  617. IncBx ;
  618. Loop8 ("wn_loop") ;
  619. M ("wn_end") ;
  620. JmpBx (* resume past the string; no RET here,
  621. the return address is already gone *)
  622. END EmitWrInl ;
  623. PROCEDURE EmitWrBool ;
  624. BEGIN
  625. M ("wrbool") ;
  626. CmpArgW0 ;
  627. Jne8 ("wb_t") ;
  628. MovDxVx (D_FALSE) ;
  629. J8 ("wb_o") ;
  630. M ("wb_t") ;
  631. MovDxVx (D_TRUE) ;
  632. M ("wb_o") ;
  633. MovAh (9) ;
  634. Int21 ;
  635. RetR
  636. END EmitWrBool ;
  637. PROCEDURE EmitWrLn ;
  638. BEGIN
  639. M ("wrln") ;
  640. MovDxVx (D_CRLF) ;
  641. MovAh (9) ;
  642. Int21 ;
  643. RetR
  644. END EmitWrLn ;
  645. PROCEDURE EmitWrReal ;
  646. (* the 6-byte real is on the stack but is not formatted: the compiler does
  647. not yet load real operands into a form the runtime could read. A visible
  648. marker beats printing the mantissa as an integer. *)
  649. BEGIN
  650. M ("wrreal") ;
  651. MovDxVx (D_REAL) ;
  652. MovAh (9) ;
  653. Int21 ;
  654. RetR
  655. END EmitWrReal ;
  656. PROCEDURE EmitRdInt ;
  657. (* address on the stack. A transcription of TP3 TPSRC4 xrdint/readnum:
  658. rnspace: getbyte ; ^Z ? -> rnend
  659. consume ; <= 20h ? -> rnspace
  660. rndig: [buf]=char ; getbyte ; <= 20h ? -> rnend (NOT consumed)
  661. consume ; -> rndig
  662. rnend: buf[0] := 0
  663. Two behaviours are load-bearing and neither is obvious:
  664. - the character that ENDS the scan is left pending, because readnum tests
  665. it *before* clearing getbyte's pre-read flag. xreadln, which the
  666. compiler emits next for a readln, is what consumes the newline. See the
  667. note on getch.
  668. - ^Z before any digit reaches rnend with "nothing entered", and xrdint
  669. (JZ rdierr) then returns WITHOUT touching the variable. CX carries both
  670. the sign and that state: 0 = positive, 1 = negative, 2 = nothing read.
  671. Sign in CX, value in DI. *)
  672. BEGIN
  673. M ("rdint") ;
  674. PushBp ; MovBpSp ;
  675. PushAx ; PushBx ; PushCx ; PushDx ; PushDi ;
  676. M ("ri_lead") ;
  677. C8 ("getch") ;
  678. CmpAl (26) ; (* ^Z: end of input *)
  679. Je8 ("ri_none") ;
  680. CmpAl (20) ; (* every control char and the space *)
  681. Jbe8 ("ri_lead") ;
  682. XorCxCx ;
  683. CmpAl (ORD ("-")) ;
  684. Jne8 ("ri_nos") ;
  685. IncCx ;
  686. C8 ("getch") ;
  687. J8 ("ri_dig0") ;
  688. M ("ri_nos") ;
  689. CmpAl (ORD ("+")) ;
  690. Jne8 ("ri_dig0") ;
  691. C8 ("getch") ;
  692. M ("ri_dig0") ;
  693. XorDiDi ;
  694. M ("ri_dig") ;
  695. CmpAl (ORD ("0")) ;
  696. Jb8 ("ri_done") ;
  697. CmpAl (ORD ("9")) ;
  698. Ja8 ("ri_done") ;
  699. SubAl (ORD ("0")) ;
  700. MovAh (0) ; (* AX := the digit, 0..9 *)
  701. XchgAxDi ; (* AX := the value so far, DI := the digit.
  702. The digit has to survive MUL, and the 8-bit
  703. reg field of 8A/88 has only AL/CL/DL/BL/AH/
  704. CH/DH/BH - there is no SI or DI byte to park
  705. it in. MUL r/m16 writes DX, so the previous
  706. version's "keep the digit across the multiply"
  707. comment was describing a register the multiply
  708. owns. Every read of an integer therefore
  709. returned 0: the digit was computed, moved to
  710. DH, and multiplied away one instruction later. *)
  711. MovBxImm (10) ;
  712. MulBx ; (* DX:AX := value * 10 *)
  713. AddAxDi ; (* AX := low word + digit. A carry out of bit 15
  714. is dropped, which is what a 16-bit INTEGER
  715. does anyway - the high word of the product is
  716. never stored. *)
  717. MovDiAx ;
  718. C8 ("getch") ;
  719. J8 ("ri_dig") ;
  720. M ("ri_done") ;
  721. C8 ("ungetch") ; (* the delimiter stays pending *)
  722. CmpCxV (2) ;
  723. Je8 ("ri_out") ;
  724. CmpCx0 ;
  725. Je8 ("ri_st") ;
  726. NegDi ;
  727. M ("ri_st") ;
  728. MovAxDi ; (* the parsed value out of DI, into AX... *)
  729. MovDiBp4 ; (* ...the caller's address into DI... *)
  730. StDiAx ; (* ...and store. The three are needed
  731. because there is no [BX] form; see the
  732. note on the store emitters. *)
  733. M ("ri_out") ;
  734. PopDi ; PopDx ; PopCx ; PopBx ; PopAx ;
  735. MovSpBp ; PopBp ; RetR ;
  736. M ("ri_none") ; (* ^Z first: leave the variable alone *)
  737. PopDi ; PopDx ; PopCx ; PopBx ; PopAx ;
  738. MovSpBp ; PopBp ; RetR
  739. END EmitRdInt ;
  740. PROCEDURE EmitRdChar ;
  741. BEGIN
  742. M ("rdchar") ;
  743. PushBp ; MovBpSp ;
  744. PushAx ; PushBx ; PushDi ;
  745. C8 ("getch") ;
  746. MovDlAl ;
  747. MovDiBp4 ; (* no [BX] form: the address goes in DI *)
  748. StDiDl ;
  749. PopDi ; PopBx ; PopAx ;
  750. MovSpBp ; PopBp ; RetR
  751. END EmitRdChar ;
  752. PROCEDURE EmitRdBool ;
  753. (* one character, classified the way TP3 does: T/t/Y/y/1 true, anything else
  754. false. *)
  755. BEGIN
  756. M ("rdbool") ;
  757. PushBp ; MovBpSp ;
  758. PushAx ; PushBx ; PushCx ; PushDi ;
  759. C8 ("getch") ;
  760. XorCxCx ;
  761. CmpAl (ORD ("T")) ; Je8 ("rb_t") ;
  762. CmpAl (ORD ("t")) ; Je8 ("rb_t") ;
  763. CmpAl (ORD ("Y")) ; Je8 ("rb_t") ;
  764. CmpAl (ORD ("y")) ; Je8 ("rb_t") ;
  765. CmpAl (ORD ("1")) ; Je8 ("rb_t") ;
  766. J8 ("rb_s") ;
  767. M ("rb_t") ;
  768. IncCx ;
  769. M ("rb_s") ;
  770. MovDiBp4 ; (* DI = the caller's address, because there is
  771. no [BX] to store through *)
  772. StDiCx ;
  773. PopDi ; PopCx ; PopBx ; PopAx ;
  774. MovSpBp ; PopBp ; RetR
  775. END EmitRdBool ;
  776. PROCEDURE EmitRdLn ;
  777. (* discard the rest of the line, including the terminator *)
  778. BEGIN
  779. M ("rdln") ;
  780. PushAx ;
  781. M ("rl_loop") ;
  782. C8 ("getch") ;
  783. CmpAl (13) ; Je8 ("rl_e") ;
  784. CmpAl (10) ; Je8 ("rl_e") ;
  785. CmpAl (26) ; Je8 ("rl_e") ; (* ^Z: end of input *)
  786. J8 ("rl_loop") ;
  787. M ("rl_e") ;
  788. PopAx ;
  789. RetR
  790. END EmitRdLn ;
  791. PROCEDURE Str5 (s : ARRAY OF CHAR ; n : CARDINAL) ;
  792. (* emit n characters, so the strings below are visibly the same length as the
  793. D_ constants claim and an off-by-one in either place is a compile-time
  794. mismatch rather than a wrong pointer nobody notices *)
  795. VAR i : CARDINAL ;
  796. BEGIN
  797. i := 0 ;
  798. WHILE i < n DO
  799. B (ORD (s [i])) ;
  800. INC (i)
  801. END
  802. END Str5 ;
  803. PROCEDURE EmitData ;
  804. (* The runtime's data block. The D_ constants name the offsets in it and are
  805. ASSERTED against what is emitted here, three ways: the starting offset of
  806. each string, the offset just past it, and the block's total length. A D_
  807. constant is a 16-bit immediate inside a MOV, so a wrong one is a
  808. perfectly well-formed instruction that reads the wrong memory - see the
  809. note on the D_ block. *)
  810. BEGIN
  811. dataAt := rpos ;
  812. (* Each D_ is checked BEFORE the string it names is emitted, because it
  813. names that string's START. *)
  814. IF dataAt + D_NUM # rpos THEN
  815. HALT
  816. END ;
  817. (* 8 bytes of scratch, never read before written *)
  818. B (0) ; B (0) ; B (0) ; B (0) ; B (0) ; B (0) ; B (0) ; B (0) ;
  819. IF dataAt + D_TRUE # rpos THEN
  820. HALT
  821. END ;
  822. Str5 ("TRUE$", 5) ;
  823. IF dataAt + D_FALSE # rpos THEN
  824. HALT
  825. END ;
  826. Str5 ("FALSE$", 6) ;
  827. IF dataAt + D_CRLF # rpos THEN
  828. HALT
  829. END ;
  830. B (13) ; B (10) ; B (ORD ("$")) ;
  831. IF dataAt + D_REAL # rpos THEN
  832. HALT
  833. END ;
  834. Str5 ("?REAL?", 6) ;
  835. IF dataAt + D_PUSH # rpos THEN
  836. HALT
  837. END ;
  838. B (0) ; B (0) ; (* the pushback slot, empty to begin with *)
  839. WHILE rpos < dataAt + D_END DO
  840. B (0)
  841. END ;
  842. (* the total, so D_END is checked too and not just used as a pad target *)
  843. IF rpos - dataAt # D_END THEN
  844. HALT
  845. END
  846. END EmitData ;
  847. PROCEDURE FixUp ;
  848. VAR i, t, rel : CARDINAL ;
  849. BEGIN
  850. i := 0 ;
  851. WHILE i < nfix DO
  852. IF fix [i].kind = 2 THEN
  853. (* A data address, and the ONE kind that is absolute rather than
  854. relative: rtBase says where the blob sits in the image, val says
  855. where inside the blob, and LoadBias says where the image itself
  856. sits once DOS has loaded it. All three are needed; omitting any
  857. one produces a readable-looking address into the wrong bytes. *)
  858. t := (dataAt + rtBase + fix [i].val + LoadBias) MOD 10000H ;
  859. rt [fix [i].place] := VAL (BYTE, t MOD 100H) ;
  860. rt [fix [i].place + 1] := VAL (BYTE, (t DIV 100H) MOD 100H)
  861. ELSE
  862. t := LblOff (fix [i].nm) ;
  863. IF fix [i].kind = 0 THEN
  864. (* rel8 is measured from the end of the instruction, i.e. one
  865. byte past the displacement field *)
  866. rel := (t + 100H - (fix [i].place + 1)) MOD 100H ;
  867. rt [fix [i].place] := VAL (BYTE, rel)
  868. ELSE
  869. rel := (t + 10000H - (fix [i].place + 2)) MOD 10000H ;
  870. rt [fix [i].place] := VAL (BYTE, rel MOD 100H) ;
  871. rt [fix [i].place + 1] := VAL (BYTE, (rel DIV 100H) MOD 100H)
  872. END
  873. END ;
  874. INC (i)
  875. END
  876. END FixUp ;
  877. (* ---------------------------------------------------------------- *)
  878. (* public interface *)
  879. (* ---------------------------------------------------------------- *)
  880. PROCEDURE RT_Build (base : CARDINAL) ;
  881. BEGIN
  882. IF built THEN
  883. RETURN
  884. END ;
  885. rtBase := base ; (* must precede every Emit*, they read it *)
  886. rpos := 0 ; ltop := 0 ; nfix := 0 ; dataAt := 0 ;
  887. EmitInitMem ;
  888. EmitEnd ;
  889. EmitStackChk ;
  890. EmitWrInt ; EmitWrChar ; EmitWrBool ; EmitWrReal ; EmitWrLn ;
  891. EmitWrInl ;
  892. EmitRdInt ; EmitRdChar ; EmitRdBool ; EmitRdLn ;
  893. EmitGetCh ; EmitUnGetCh ;
  894. EmitData ;
  895. FixUp ;
  896. SetStr (entNm [0], "initmem") ;
  897. SetStr (entNm [1], "progend") ;
  898. SetStr (entNm [2], "stackchk") ;
  899. SetStr (entNm [3], "wrint") ;
  900. SetStr (entNm [4], "wrchar") ;
  901. SetStr (entNm [5], "wrbool") ;
  902. SetStr (entNm [6], "wrreal") ;
  903. SetStr (entNm [7], "wrln") ;
  904. SetStr (entNm [8], "rdint") ;
  905. SetStr (entNm [9], "rdchar") ;
  906. SetStr (entNm [10], "rdbool") ;
  907. SetStr (entNm [11], "rdln") ;
  908. SetStr (entNm [12], "halt") ;
  909. SetStr (entNm [13], "wrtinl") ;
  910. built := TRUE
  911. END RT_Build ;
  912. PROCEDURE RT_Size () : CARDINAL ;
  913. BEGIN
  914. IF NOT built THEN
  915. RT_Build (0)
  916. END ;
  917. RETURN rpos
  918. END RT_Size ;
  919. PROCEDURE RT_Byte (i : CARDINAL ) : BYTE ;
  920. BEGIN
  921. IF NOT built THEN
  922. RT_Build (0)
  923. END ;
  924. IF i >= rpos THEN
  925. RETURN 0
  926. END ;
  927. RETURN rt [i]
  928. END RT_Byte ;
  929. PROCEDURE RT_Entry (i : CARDINAL ) : CARDINAL ;
  930. BEGIN
  931. IF NOT built THEN
  932. RT_Build (0)
  933. END ;
  934. IF i > 13 THEN
  935. RETURN 0
  936. END ;
  937. RETURN rtBase + LblOff (entNm [i])
  938. END RT_Entry ;
  939. PROCEDURE RT_CodeEnd () : CARDINAL ;
  940. BEGIN
  941. IF NOT built THEN
  942. RT_Build (0)
  943. END ;
  944. RETURN dataAt
  945. END RT_CodeEnd ;
  946. END Runtime.