# Port of https://github.com/akkartik/crenshaw/blob/master/tutor2.1.pas # which corresponds to the section "single digits" in https://compilers.iecc.com/crenshaw/tutor2.txt # except that we support hex numbers of multiple digits. # # To run: # $ ./subx translate *.subx apps/crenshaw2-1b.subx -o apps/crenshaw2-1b # $ echo '1a' |./subx run apps/crenshaw2-1b # Expected output: # # syscall(exit, 1a) # bb/copy-to-EBX 3/imm32 # b8/copy-to-EAX 1/imm32/exit # cd/syscall 0x80/imm8 # # To run the generated output: # $ echo '1a' |./subx run apps/crenshaw2-1b > z1.subx # $ ./subx translate z1.subx -o z1 # $ ./subx run z1 # $ echo $? # 26 # 0x1a in decimal # # Stdin must contain just a single hex digit. Other input will print an error: # $ echo 'xyz' |./subx run apps/crenshaw2-1b # Error: integer expected # # Names in this file sometimes follow Crenshaw's original rather than my usual # naming conventions. == code # instruction effective address register displacement immediate # . op subop mod rm32 base index scale r32 # . 1-3 bytes 3 bits 2 bits 3 bits 3 bits 3 bits 2 bits 2 bits 0/1/2/4 bytes 0/1/2/4 bytes Entry: # run tests if necessary, call 'compile' if not # initialize heap # . Heap = new-segment(64KB) # . . push args 68/push Heap/imm32 68/push 0x10000/imm32/64KB # . . call e8/call new-segment/disp32 # . . discard args 81 0/subop/add 3/mod/direct 4/rm32/ESP . . . . . 8/imm32 # add to ESP # . prolog 89/copy 3/mod/direct 5/rm32/EBP . . . 4/r32/ESP . . # copy ESP to EBP # - if argc > 1 and argv[1] == "test", then return run_tests() # . argc > 1 81 7/subop/compare 1/mod/*+disp8 5/rm32/EBP . . . . 0/disp8 1/imm32 # compare *EBP 7e/jump-if-lesser-or-equal $run-main/disp8 # . argv[1] == "test" # . . push args 68/push "test"/imm32 ff 6/subop/push 1/mod/*+disp8 5/rm32/EBP . . . . 8/disp8 . # push *(EBP+8) # . . call e8/call kernel-string-equal?/disp32 # . . discard args 81 0/subop/add 3/mod/direct 4/rm32/ESP . . . . . 8/imm32 # add to ESP # . check result 3d/compare-EAX-and 1/imm32 75/jump-if-not-equal $run-main/disp8 # . run-tests() e8/call run-tests/disp32 8b/copy 0/mod/indirect 5/rm32/.disp32 . . 3/r32/EBX Num-test-failures/disp32 # copy *Num-test-failures to EBX eb/jump $main:end/disp8 $run-main: # - otherwise read a program from stdin and emit its translation to stdout # var ed/EAX : exit-descriptor 81 5/subop/subtract 3/mod/direct 4/rm32/ESP . . . . . 8/imm32 # subtract from ESP 89/copy 3/mod/direct 0/rm32/EAX . . . 4/r32/ESP . . # copy ESP to EAX # configure ed to really exit() # . ed->target = 0 c7 0/subop/copy 0/mod/direct 0/rm32/EAX . . . . . 0/imm32 # copy to *EAX # return compile(Stdin, 1/stdout, 2/stderr, ed) # . . push args 50/push-EAX/ed 68/push 2/imm32/stderr 68/push 1/imm32/stdout 68/push Stdin/imm32 # . . call e8/call compile/disp32 # . . discard args 81 0/subop/add 3/mod/direct 4/rm32/ESP . . . . . 0x10/imm32 # add to ESP # . syscall(exit, 0) bb/copy-to-EBX 0/imm32 $main:end: b8/copy-to-EAX 1/imm32/exit cd/syscall 0x80/imm8 # the main entry point compile: # in : (address buffered-file), out : fd or (address stream), err : fd or (address stream), ed : (address exit-descriptor) -> # . prolog 55/push-EBP 89/copy 3/mod/direct 5/rm32/EBP . . . 4/r32/ESP . . # copy ESP to EBP # . save registers 50/push-EAX 51/push-ECX # prime the pump # . Look = get-char(in) # . . push args ff 6/subop/push 1/mod/*+disp8 5/rm32/EBP . . . . 8/disp8 . # push *(EBP+8) # . . call e8/call get-char/disp32 # . . discard args 81 0/subop/add 3/mod/direct 4/rm32/ESP . . . . . 4/imm32 # add to ESP # var num/ECX : (address stream) on the stack # Numbers can be 32 bits or 8 hex bytes long. One of them will be in 'Look', so we need space for 7 bytes. # Sizing the stream just right buys us overflow-handling for free inside 'get-num'. # Add 12 bytes for 'read', 'write' and 'length' fields, for a total of 19 bytes, or 0x13 in hex. # The stack pointer is no longer aligned, so dump_stack() can be misleading past this point. 81 5/subop/subtract 3/mod/direct 4/rm32/ESP . . . . . 0x13/imm32 # subtract from ESP 89/copy 3/mod/direct 1/rm32/ECX . . . 4/r32/ESP . . # copy ESP to ECX # initialize the stream # . num->length = 7 c7 0/subop/copy 1/mod/*+disp8 1/rm32/ECX . . . . 8/disp8 7/imm32 # copy to *(ECX+8) # . clear-stream(num) # . . push args 51/push-ECX # . . call e8/call clear-stream/disp32 # . . discard args 81 0/subop/add 3/mod/direct 4/rm32/ESP . . . . . 4/imm32 # add to ESP # read a digit from 'in' into 'num' # . get-num(in, num, err, ed) # . . push args ff 6/subop/push 1/mod/*+disp8 5/rm32/EBP . . . . 0x14/disp8 . # push *(EBP+20) ff 6/subop/push 1/mod/*+disp8 5/rm32/EBP . . . . 0x10/disp8 . # push *(EBP+16) 51/push-ECX/num ff 6/subop/push 1/mod/*+disp8 5/rm32/EBP . . . . 8/disp8 . # push *(EBP+8) # . . call e8/call get-num/disp32 # . . discard args 81 0/subop/add 3/mod/direct 4/rm32/ESP . . . . . 0x10/imm32 # add to ESP # render 'num' into the following template on 'out': # bb/copy-to-EBX _num_ # b8/copy-to-EAX 1/imm32/exit # cd/syscall 0x80/imm8 # # . write(out, "bb/copy-to-EBX ") # . . push args 68/push "bb/copy-to-EBX "/imm32 ff 6/subop/push 1/mod/*+disp8 5/rm32/EBP . . . . 0xc/disp8 . # push *(EBP+12) # . . call e8/call write/disp32 # . . discard args 81 0/subop/add 3/mod/direct 4/rm32/ESP . . . . . 8/imm32 # add to ESP # . write-stream(out, num) # . . push args 51/push-ECX/num ff 6/subop/push 1/mod/*+disp8 5/rm32/EBP . . . . 0xc/disp8 . # push *(EBP+12) # . . call e8/call write-stream/disp32 # . . discard args 81 0/subop/add 3/mod/direct 4/rm32/ESP . . . . . 8/imm32 # add to ESP # . write(out, Newline) # . . push args 68/push Newline/imm32 ff 6/subop/push 1/mod/*+disp8 5/rm32/EBP . . . . 0xc/disp8 . # push *(EBP+12) # . . call e8/call write/disp32 # . . discard args 81 0/subop/add 3/mod/direct 4/rm32/ESP . . . . . 8/imm32 # add to ESP # . write(out, "b8/copy-to-EAX 1/imm32/exit\n") # . . push args 68/push "b8/copy-to-EAX 1/imm32/exit\n"/imm32 ff 6/subop/push 1/mod/*+disp8 5/rm32/EBP . . . . 0xc/disp8 . # push *(EBP+12) # . . call e8/call write/disp32 # . . discard args 81 0/subop/add 3/mod/direct 4/rm32/ESP . . . . . 8/imm32 # add to ESP # . write(out, "cd/syscall 0x80/imm8\n") # . . push args 68/push "cd/syscall 0x80/imm8\n"/imm32 ff 6/subop/push 1/mod/*+disp8 5/rm32/EBP . . . . 0xc/disp8 . # push *(EBP+12) # . . call e8/call write/disp32 # . . discard args 81 0/subop/add 3/mod/direct 4/rm32/ESP . . . . . 8/imm32 # add to ESP $compile:end: # . restore registers 59/pop-to-ECX 58/pop-to-EAX # . epilog 89/copy 3/mod/direct 4/rm32/ESP . . . 5/r32/EBP . . # copy EBP to ESP 5d/pop-to-EBP c3/return # Read a sequence of digits into 'out'. Abort if there are none, or if there is # no space in 'out'. # Input comes from the global variable 'Look' (first byte) and the argument # 'in' (rest). We leave the next byte from 'in' into 'Look' on exit. get-num: # in : (address buffered-file), out : (address stream), err : fd or (address stream), ed : (address exit-descriptor) -> # pseudocode: # if (!is-digit?(Look)) expected(ed, err, "integer") # do # if out->write >= out->length # write(err, "Error: too many digits in number\n") # stop(ed, 1) # out->data[out->write] = LSB(Look) # ++out->write # Look = get-char(in) # while is-digit?(Look) # This is complicated because I don't want to hard-code the error strategy in # a general helper like write-byte-buffered. Maybe I should just create a # local helper. # # within the loop we'll try to keep things in registers: # in: ESI # out: EDI # out->write: ECX (cached copy; need to keep in sync) # out->length: EDX # temporaries: EAX, EBX # We can't allocate Look to a register because it gets written implicitly in # get-char in each iteration of the loop. (Thereby demonstrating that it's # not the right interface for us. But we'll keep it just to follow Crenshaw.) # # . prolog 55/push-EBP 89/copy 3/mod/direct 5/rm32/EBP . . . 4/r32/ESP . . # copy ESP to EBP # - if (is-digit?(Look)) expected(ed, err, "integer") # . EAX = is-digit?(Look) # . . push args ff 6/subop/push 0/mod/indirect 5/rm32/.disp32 . . . Look/disp32 . # push *Look # . . call e8/call is-digit?/disp32 # . . discard args 81 0/subop/add 3/mod/direct 4/rm32/ESP . . . . . 4/imm32 # add to ESP # . if (EAX == 0) 3d/compare-EAX-and 0/imm32 75/jump-if-not-equal $get-num:main/disp8 # . expected(ed, err, "integer") # . . push args 68/push "integer"/imm32 ff 6/subop/push 1/mod/*+disp8 5/rm32/EBP .
#
#
#           The Nim Compiler
#        (c) Copyright 2015 Andreas Rumpf
#
#    See the file "copying.txt", included in this
#    distribution, for details about the copyright.
#

## Implements marshaling for the VM.

import streams, json, intsets, tables, ast, astalgo, idents, types, msgs

proc ptrToInt(x: PNode): int {.inline.} =
  result = cast[int](x) # don't skip alignment

proc getField(n: PNode; position: int): PSym =
  case n.kind
  of nkRecList:
    for i in countup(0, sonsLen(n) - 1):
      result = getField(n.sons[i], position)
      if result != nil: return
  of nkRecCase:
    result = getField(n.sons[0], position)
    if result != nil: return
    for i in countup(1, sonsLen(n) - 1):
      case n.sons[i].kind
      of nkOfBranch, nkElse:
        result = getField(lastSon(n.sons[i]), position)
        if result != nil: return
      else: internalError(n.info, "getField(record case branch)")
  of nkSym:
    if n.sym.position == position: result = n.sym
  else: discard

proc storeAny(s: var string; t: PType; a: PNode; stored: var IntSet)

proc storeObj(s: var string; typ: PType; x: PNode; stored: var IntSet) =
  internalAssert x.kind == nkObjConstr
  let start = 1
  for i in countup(start, sonsLen(x) - 1):
    if i > start: s.add(", ")
    var it = x.sons[i]
    if it.kind == nkExprColonExpr:
      internalAssert it.sons[0].kind == nkSym
      let field = it.sons[0].sym
      s.add(escapeJson(field.name.s))
      s.add(": ")
      storeAny(s, field.typ, it.sons[1], stored)
    elif typ.n != nil:
      let field = getField(typ.n, i)
      s.add(escapeJson(field.name.s))
      s.add(": ")
      storeAny(s, field.typ, it, stored)

proc skipColon*(n: PNode): PNode =
  result = n
  if n.kind == nkExprColonExpr:
    result = n.sons[1]

proc storeAny(s: var string; t: PType; a: PNode; stored: var IntSet) =
  case t.kind
  of tyNone: assert false
  of tyBool: s.add($(a.intVal != 0))
  of tyChar:
    let ch = char(a.intVal)
    if ch < '\128':
      s.add(escapeJson($ch))
    else:
      s.add($int(ch))
  of tyArray, tySequence:
    if t.kind == tySequence and a.kind == nkNilLit: s.add("null")
    else:
      s.add("[")
      for i in 0 .. a.len-1:
        if i > 0: s.add(", ")
        storeAny(s, t.elemType, a[i], stored)
      s.add("]")
  of tyTuple:
    s.add("{")
    for i in 0.. <t.len: