"elymasAsm.ey" include < { assembler -01 . } ":" deff assembler .|label "@" deff "%" _ : -01 deff < 1 ==PROT_READ 2 ==PROT_WRITE 4 ==PROT_EXEC 2 ==MAP_PRIVATE 16 ==MAP_FIXED 32 ==MAP_ANONYMOUS > ==MMAP < 9 ==mmap > ==SYSCALL { =*def ==struct struct values |cat fold :arrayToCode _ :globalAllocations .register .base ==address struct keys { address -101 def struct -01 . len address add =address } each } /allocateOffsetStruct deff { ==str [ str len :imm64 -- %10 %00 %00 %00 %00 %00 %00 %00 %00 str len :imm64 ] str strToUTF8Bytes cat [ 8 str len 8 mod sub %00 rep ] cat } /toConstString deff [ ] ==stringHoles [ ] ==stringValues { ==str ] _ len ==offset stringValues [ str ] cat =stringValues stringHoles [ { ==allocatedStrings ==opcodes [ allocatedStrings str . :imm64 ] =*bytesToPatch 0 8 range { _ bytesToPatch -01 offset add opcodes =[] } each } ] cat =stringHoles [ -011 len dearray %00 %00 %00 %00 %00 %00 %00 %00 } /string deff { ==opcodes stringValues len 0 gt { < < stringValues { _ toConstString -01 == }' each > { defv }' allocateOffsetStruct > ==allocatedStrings stringHoles { opcodes allocatedStrings -102 * } each [ ] =stringHoles [ ] =stringValues } rep opcodes } /stringResolve deff [ ] ==linkHoles { ==what ==where ] _ len ==offset linkHoles [ { =*resolve [ what resolve :imm64 ] =*bytesToPatch 0 8 range { _ bytesToPatch -01 where resolve offset add add sys .asm .poke } each } ] cat =linkHoles [ -011 len dearray %00 %00 %00 %00 %00 %00 %00 %00 } /linkAbs64 deff { ==resolve linkHoles { resolve -01 * } each [ ] =linkHoles } /linkResolve deff { [ } "[[" deff { ] :labelResolve stringResolve } "]]" deff { %00 %00 %00 %00 %00 %70 %00 %00 } /HEAPEND deff { %00 %00 %00 %00 %00 %60 %00 %00 } /HEAPBASE deff { %00 %00 %00 %00 %00 %50 %00 %00 } /BLOCKBASE deff { %00 %00 %00 %00 %00 %40 %00 %00 } /MARKBASE deff # 4096 16 mul 8 mul ==ALLOCCHUNKSIZE # minimum ALLOCCHUNKSIZE 4096 16 mul 8 mul 16 mul ==ALLOCCHUNKSIZE # FIXME: there is still some wonkyness with freezing < # current end of heap memory (grows upwards) [ HEAPBASE ] ==heapEnd # index of next cell likely to be free [ HEAPBASE ] ==unusedHeapStart # current parser scope [ %00 %00 %00 %00 %00 %00 %00 %00 ] ==currentScope # current parser quote state [ %00 %00 %00 %00 %00 %00 %00 %00 ] ==currentQuoted # global allocation list [ :globalAllocations .base :imm64 ] ==globalAllocationList # FIXME what is this for? directly use :globalAllocations > { defv }' allocateOffsetStruct { _ =*array len _ 4 div ==largeMoves 4 mod ==smallMoves 0 ==i largeMoves { i _ 4 add =i _ [ 3 2 1 0 ] add array { -01 256 mul add } fold -01 /rdi :movlImmMemDisp8 } rep i /rdi :addqImm8Reg smallMoves { i _ 1 add =i array /rdi :movbImmMem /rdi :incqReg } rep } /loadToRdi deff # internal functions, ABI follows SysV standards # compare two strings # rdi -> address of first string # rsi -> address of second string # rax <- 1 if both strings are equal, 0 otherwise [ /rax /rax :xorqRegReg :cmpsq # ignore memory length header :cmpsq # ignore hash /rsi /rdx :movqMemReg # load exact length :cmpsq # same exact length /fail :jnzLbl8 /rdx /rcx :movqRegReg :repz :cmpsb /fail :jnzLbl8 /rax :incqReg @fail ] :labelResolve /internalStringEqualsCode defv < # dump string to stderr for internal error reporting # rdi -> address of string on heap [ 24 /rdi /rsi :leaqMemDisp8Reg 16 /rdi /rdx :movqMemDisp8Reg 2 /rdi :movqImmReg 1 /rax :movqImmReg :syscall :retn ] /internalDumpErrorString defv # compare two strings # rdi -> address of first string # rsi -> address of second string # rax <- 1 if both strings are equal, 0 otherwise [ internalStringEqualsCode _ len dearray :retn ] /internalStringEquals defv > { defv }' allocateOffsetStruct { ==str /rdi :movqImmOOBReg str string internalDumpErrorString /rax :movqImmReg /rax :callqReg } /outputError deff < # allocate a chunk of memory # inspiration from http://wiki.luajit.org/new-garbage-collector # rdi -> size of chunk in bytes # rax <- address of allocated chunk # chunk will have GC length header initialized correctly [[ /rbx :pushqReg # /rdi :pushqReg # TODO remove these three lines once load-testing the GC seems unnecessary # /markAndSweep :callqLbl32 # /rdi :popqReg /rdi :pushqReg /searchForFreeBlock :callqLbl32 /rax /rax :andqRegReg /success :jnzLbl32 /markAndSweep :callqLbl32 @allocateFromSystemLoop /rdi :popqReg /rdi :pushqReg /searchForFreeBlock :callqLbl32 /rax /rax :andqRegReg /success :jnzLbl32 /allocateFromSystem :callqLbl32 /allocateFromSystemLoop :jmpLbl8 @success /rdi :popqReg /rbx :popqReg :retn # run through block bitmap until sufficiently many zeroes are found # if yes, allocate block @searchForFreeBlock # rdi -> size of chunk in bytes # rax <- address of allocated chunk or zero if no free block was found /rax :movqImmOOBReg HEAPBASE heapEnd /rbp :movqImmReg 0 /rbp /rbp :movqMemDisp8Reg /rax /rbp :subqRegReg # rbp now holds number of bytes in heap 4 /rbp :shrqImm8Reg # rbp now holds number of 16 byte cells in heap unusedHeapStart /rbx :movqImmReg /rbx /rbx :movqMemReg # /rbx /rbx :xorqRegReg # rbx == index of cell currently tested /r8 :pushqReg /r9 :pushqReg /r8 :movqImmOOBReg BLOCKBASE /r9 :movqImmOOBReg MARKBASE /rbx /rbp :cmpqRegReg /noFreeBlockAvailable :jbeLbl32 /rbx /rax :movqRegReg /rbx /rcx :movqRegReg %3F /rcx :andqImm8Reg # extract bit position in quadword 6 /rax :shrqImm8Reg # extract quadword 6 /rbp :shrqImm8Reg # extract one-after-last quadword /rsi /rsi :xorqRegReg # rsi > 0 => currently counting block extent of free block @testBlockBitLoop /rcx 8 /rax /r8 :btqRegMemIndexScale # test block bitmap /nonFreeBlock :jcLbl8 # block not free /rsi /rsi :andqRegReg /notCurrentlyCounting :jzLbl8 @currentlyCounting 16 /rsi :addqImm8Reg /rsi /rdi :cmpqRegReg /freeBlockFound :jbeLbl8 /rcx :incqReg 6 /rcx :btqImm8Reg 0 /rax :adcqImm8Reg %3F /rcx :andqImm8Reg /rax /rbp :cmpqRegReg /testBlockBitLoop :jaLbl8 /noFreeBlockAvailable :jmpLbl32 @notCurrentlyCounting /rcx 8 /rax /r9 :btqRegMemIndexScale # test mark bitmap /currentlyCounting :jcLbl8 # block marked, i.e. truly free block start @nonFreeBlock /rsi /rsi :xorqRegReg /rcx :incqReg 6 /rcx :btqImm8Reg 0 /rax :adcqImm8Reg %3F /rcx :andqImm8Reg /rax /rbp :cmpqRegReg /testBlockBitLoop :jaLbl8 /noFreeBlockAvailable :jmpLbl32 @freeBlockFound /r9 :popqReg /r8 :popqReg 6 /rbp :shlqImm8Reg 6 /rax :shlqImm8Reg /rcx /rax /rbx :leaqMemIndexReg # rdi == size of block to allocate # rbx == last cell of free block of sufficient size unusedHeapStart /rax :movqImmReg /rbx /rax :movqRegMem # split block if necessary /rbx :incqReg /rbx /rbp :cmpqRegReg /dontSplit :jbeLbl8 %FE /rsi :movqImmReg /rbx /rcx :movqRegReg 7 /cl :andbImmReg /sil :rolbClReg # rsi now contains mask bit for block/mark in byte (reset bit at relevant position) /rbx /rax :movqRegReg 3 /rax :shrqImm8Reg /rdx :movqImmOOBReg BLOCKBASE 1 /rdx /rax /sil :orbMemIndexScaleReg # sil now { mask block bor } /rsi :notqReg # sil now { mask block bor bnot } /rdx :movqImmOOBReg MARKBASE /sil 1 /rdx /rax :orbRegMemIndexScale # set mark bit if block bit was zero @dontSplit # mark block as used (-> white) /rdi /rsi :movqRegReg /rsi :decqReg 4 /rsi :shrqImm8Reg /rsi :incqReg /rsi /rbx :subqRegReg 1 /rsi :movqImmReg /rbx /rcx :movqRegReg 7 /cl :andbImmReg /rsi :shlqClReg # rsi now contains mask bit for block/mark in byte (set bit at relevant position) /rbx /rax :movqRegReg 3 /rax :shrqImm8Reg /rdx :movqImmOOBReg BLOCKBASE /sil 1 /rdx /rax :orbRegMemIndexScale # set block bit /rsi :notqReg # sil now { mask bnot } /rdx :movqImmOOBReg MARKBASE /sil 1 /rdx /rax :andbRegMemIndexScale # reset mark bit # ensure the new block is marked as block extend throughout in the bitmaps # TODO reconnect free blocks while scanning instead /rbx :pushqReg /rdi :pushqReg /rdi :decqReg 4 /rdi :shrqImm8Reg @markBlockFree /rdi /rdi :andqRegReg /markedBlockFree :jzLbl8 /rdi :decqReg /rbx :incqReg 1 /rsi :movqImmReg /rbx /rcx :movqRegReg 7 /cl :andbImmReg /rsi :shlqClReg # rsi now contains mask bit for block/mark in byte (set bit at relevant position) /rsi :notqReg # (reset bit at relevant position) /rbx /rax :movqRegReg 3 /rax :shrqImm8Reg /rdx :movqImmOOBReg BLOCKBASE /sil 1 /rdx /rax :andbRegMemIndexScale # reset block bit /rdx :movqImmOOBReg MARKBASE /sil 1 /rdx /rax :andbRegMemIndexScale # reset mark bit /markBlockFree :jmpLbl8 @markedBlockFree /rdi :popqReg /rbx :popqReg # prepare block length and GC header (-> light grey) 4 /rbx :shlqImm8Reg /rax :movqImmOOBReg HEAPBASE /rbx /rax :addqRegReg /rdi /rax :movqRegMem %08 7 /rax :movbImmMemDisp8 # zero rest of block # TODO eliminate this one day /rax :pushqReg /rdi /rcx :movqRegReg /rax /rdi :movqRegReg 3 /rcx :shrqImm8Reg /rcx :decqReg 8 /rdi :addqImm8Reg /rax /rax :xorqRegReg :reprcx :stosq /rax :popqReg :retn @noFreeBlockAvailable /r9 :popqReg /r8 :popqReg /rax /rax :xorqRegReg :retn # run through global state and mark reachable objects @markAndSweep /r8 :pushqReg /r9 :pushqReg /r10 :pushqReg /r11 :pushqReg /r8 :movqImmOOBReg HEAPBASE # constant through mark /r9 :movqImmOOBReg BLOCKBASE # constant through mark /r10 :movqImmOOBReg MARKBASE # constant through mark heapEnd /r11 :movqImmReg /r11 /r11 :movqMemReg # constant through mark unusedHeapStart /rax :movqImmReg /rbx /rbx :xorqRegReg /rbx /rax :movqRegMem # zero mark bitmap /r11 /rcx :movqRegReg /r8 /rcx :subqRegReg # rcx now holds number of bytes in heap 10 /rcx :shrqImm8Reg /noResetNecessary :jzLbl8 # rcx now holds number of quadwords in mark bitmap # (16 bytes per cell -> shift by 4 # 8 cells per byte -> shift by 3 # 8 bytes per quadword -> shift by 3) /r9 /rsi :movqRegReg /r10 /rdi :movqRegReg @resetMarkLoop /rsi /rax :movqMemReg /rax :notqReg /rax /rdi :andqRegMem 8 /rsi :addqImm8Reg 8 /rdi :addqImm8Reg /resetMarkLoop :loopLbl8 @noResetNecessary # start from current scope and mark all reachable blocks currentScope /rdi :movqImmReg /rdi /rdi :movqMemReg /markObject :callqLbl32 # start from stack and mark all reachable blocks :mainStack .base :STACKSIZE add /rdi :movqImmReg @loopThroughMainStack 8 /rdi :subqImm8Reg /rdi :pushqReg /rdi /rdi :movqMemReg /markObject :callqLbl32 /rdi :popqReg /rdi /rsp :cmpqRegReg /loopThroughMainStack :jbLbl8 :mainCallStack .base :STACKSIZE add /rdi :movqImmReg @loopThroughCallStack 8 /rdi :subqImm8Reg /rdi :pushqReg /rdi /rdi :movqMemReg /markObject :callqLbl32 /rdi :popqReg /rdi /r15 :cmpqRegReg /loopThroughCallStack :jbLbl8 # start from encoding buffer and mark all reachable blocks # TODO clear encoding buffer in the allocating functions (or mark via :ud2 at beginning) :quoteEncodingBuffer /rdi :movqImmReg :STACKSIZE 8 sub /rcx :movqImmReg @loopThroughEncodingBuffer /rdi :pushqReg /rdi /rdi :movqMemReg /markObject :callqLbl32 /rdi :popqReg /rdi :incqReg /loopThroughEncodingBuffer :loopLbl8 # free unmarked blocks /r11 /rcx :movqRegReg /r8 /rcx :subqRegReg # rcx now holds number of bytes in heap 10 /rcx :shrqImm8Reg # rcx now holds number of quadwords in mark bitmap # (16 bytes per cell -> shift by 4 # 8 cells per byte -> shift by 3 # 8 bytes per quadword -> shift by 3) /noFreeNecessary :jzLbl8 /r9 /rdi :movqRegReg /r10 /rsi :movqRegReg @freeLoop /rsi /rax :movqMemReg /rdi /rbx :movqMemReg /rax /rdi :andqRegMem /rbx /rsi :orqRegMem # TODO change this to xorqRegMem to auto-clear mark bits 8 /rsi :addqImm8Reg 8 /rdi :addqImm8Reg /freeLoop :loopLbl8 @noFreeNecessary /r11 :popqReg /r10 :popqReg /r9 :popqReg /r8 :popqReg :retn @markObjectDone :retn # recursively mark this object reachable @markObject # rdi == address of a reachable object or some other random bits /rdi /r11 :cmpqRegReg /markObjectDone :jbeLbl32 # pointing above the heap /rdi /r8 :cmpqRegReg /markObjectDone :jaLbl32 # pointing below the heap 15 /dil :testbImmReg /markObjectDone :jnzLbl32 # pointing to unaligned address /rdi /rdx :movqRegReg /r8 /rdx :subqRegReg # rdx == byte offset relative to heap begin 4 /rdx :shrqImm8Reg # rdx == cell index of first 16-byte cell of object 1 /rsi :movqImmReg /rdx /rcx :movqRegReg 7 /cl :andbImmReg /rsi :shlqClReg # rsi now contains mask bit for block/mark in byte (set bit at relevant position) /rdx /rcx :movqRegReg 3 /rcx :shrqImm8Reg # rcx holds byte address for block/mark byte in bitmaps /rax :movqImmOOBReg BLOCKBASE /sil 1 /rcx /rax :testbRegMemIndexScale # test block bit /markObjectDone :jzLbl8 # not pointing to an object /rax :movqImmOOBReg MARKBASE /sil 1 /rcx /rax :testbRegMemIndexScale # test mark bit /markObjectDone :jnzLbl8 # already marked /sil 1 /rcx /rax :orbRegMemIndexScale # set mark bit /rax /rax :xorqRegReg 7 /rdi /al :movbMemDisp8Reg %F0 /al :andbImmReg 4 /rax :shrqImm8Reg /markInteger :jzLbl32 /rax :decqReg /markString :jzLbl32 /rax :decqReg /markScope :jzLbl32 /rax :decqReg /markNameTable :jzLbl32 /rax :decqReg /markExtensionArea :jzLbl32 /rax :decqReg /markFunction :jzLbl32 /rax :decqReg /markFunctionCode :jzLbl32 /rax :decqReg /markArray :jzLbl32 /rax :decqReg /markFunctionType :jzLbl32 /rax /rbx :movqRegReg # for easier inspection "unknown object type during mark phase" outputError :ud2 @markInteger # "integer marked\n" outputError :retn @markString # internalDumpErrorString /rax :movqImmReg # /rax :callqReg # " string marked\n" outputError :retn @markScope # /rdi :pushqReg # "scope marked\n" outputError # /rdi :popqReg /rdi /ecx :movlMemReg 8 /rcx :subqImm8Reg @markScopeLoop /rdi :pushqReg /rcx :pushqReg /rdi /rcx /rdi :movqMemIndexReg /markObject :callqLbl32 /rcx :popqReg /rdi :popqReg 8 /rcx :subqImm8Reg /markScopeLoop :jnzLbl8 :retn @markNameTable # /rdi :pushqReg # "name table marked\n" outputError # /rdi :popqReg 8 /rdi /ecx :movlMemDisp8Reg 16 /rcx :subqImm8Reg /markNameTableEmpty :jzLbl8 @markNameTableLoop /rdi :pushqReg /rcx :pushqReg /rdi /rcx /rdi :movqMemIndexReg /markObject :callqLbl32 /rcx :popqReg /rdi :popqReg 16 /rcx :subqImm8Reg /markNameTableLoop :jnzLbl8 @markNameTableEmpty :retn @markExtensionArea # /rdi :pushqReg # "extension area marked\n" outputError # /rdi :popqReg /rdi /ecx :movlMemReg 8 /rcx :subqImm8Reg @markExtensionAreaLoop /rdi :pushqReg /rcx :pushqReg /rdi /rcx /rdi :movqMemIndexReg /markObject :callqLbl32 /rcx :popqReg /rdi :popqReg 8 /rcx :subqImm8Reg /markExtensionAreaLoop :jnzLbl8 :retn @markFunction # /rdi :pushqReg # "function marked\n" outputError # /rdi :popqReg /rdi :pushqReg /rdi :pushqReg 8 /rdi :addqImm8Reg /rdi /rdi :movqMemReg /markObject :callqLbl32 /rdi :popqReg 16 /rdi :addqImm8Reg /rdi /rdi :movqMemReg /markObject :callqLbl32 /rdi :popqReg 24 /rdi :addqImm8Reg /rdi /rdi :movqMemReg /markObject :jmpLbl32 @markFunctionCode # /rdi :pushqReg # "function code marked\n" outputError # /rdi :popqReg /rdi /ecx :movlMemReg 8 /rdi :addqImm8Reg 16 /rcx :subqImm8Reg @markFunctionCodeLoop /rdi /r11 :cmpqMemReg /codePartNotObject :jbeLbl32 # pointing above the heap /rdi :pushqReg /rcx :pushqReg /rdi /rdi :movqMemReg /markObject :callqLbl32 /rcx :popqReg /rdi :popqReg @codePartNotObject /rdi :incqReg /markFunctionCodeLoop :loopLbl8 :retn @markArray # /rdi :pushqReg # "array marked\n" outputError # /rdi :popqReg /rdi /ecx :movlMemReg 8 /rcx :subqImm8Reg /markArrayEmpty :jzLbl8 @markArrayLoop /rdi :pushqReg /rcx :pushqReg /rdi /rcx /rdi :movqMemIndexReg /markObject :callqLbl32 /rcx :popqReg /rdi :popqReg 8 /rcx :subqImm8Reg /markArrayLoop :jnzLbl8 @markArrayEmpty :retn @markFunctionType /rdi :pushqReg "function type marked FIXME\n" outputError /rdi :popqReg :ud2 # FIXME needs to be done :retn # allocate next chunk of memory from the operating system @allocateFromSystem heapEnd /rax :movqImmReg /rax /rdi :movqMemReg ALLOCCHUNKSIZE /rsi :movqImmReg # size of new block /rsi /rdi :addqRegReg /rdi /rax :movqRegMem /rsi /rdi :subqRegReg /mmapBlock :callqLbl32 # also allocate block and mark bitmaps heapEnd /rax :movqImmReg /rax /rdi :movqMemReg /rax :movqImmOOBReg HEAPBASE /rax /rdi :subqRegReg 7 /rdi :shrqImm8Reg ALLOCCHUNKSIZE 128 div /rsi :movqImmReg /rsi /rdi :subqRegReg /rax :movqImmOOBReg BLOCKBASE /rax /rdi :addqRegReg /mmapBlock :callqLbl32 heapEnd /rax :movqImmReg /rax /rdi :movqMemReg /rax :movqImmOOBReg HEAPBASE /rax /rdi :subqRegReg 7 /rdi :shrqImm8Reg ALLOCCHUNKSIZE 128 div /rsi :movqImmReg /rsi /rdi :subqRegReg /rax :movqImmOOBReg MARKBASE /rax /rdi :addqRegReg /rdi :pushqReg /mmapBlock :callqLbl32 /rdi :popqReg %01 /rdi :movbImmMem # mark whole block free :retn @mmapBlock # rdi == target address # rsi == size in bytes # record new block in global allocation list globalAllocationList /rax :movqImmReg /rax /rax :movqMemReg 16 /rax :addqImm8Mem /rax /rax :addqMemReg 16 /rax :subqImm8Reg /rdi /rax :movqRegMem /rsi 8 /rax :movqRegMemDisp8 SYSCALL .mmap /rax :movqImmReg # /rdi already fine # /rsi already fine < { MMAP -01 . } "!" deff !PROT_READ !PROT_WRITE !PROT_EXEC bor bor /rdx :movqImmReg !MAP_PRIVATE !MAP_FIXED !MAP_ANONYMOUS bor bor /r10 :movqImmReg > -- /r8 :movqImmOOBReg %FF %FF %FF %FF %FF %FF %FF %FF 0 /r9 :movqImmReg :syscall # TODO error handling :retn ]] /internalAllocate defv > { defv }' allocateOffsetStruct < # resolve element from scope # rdi -> address of scope on the heap # rsi -> address of element name on the heap # rax <- address of element on the heap (0 if nonexistant) # rdx <- %xy # y 0 eq if element is passive # y 1 eq if element is active # y 2 eq if element is quote-active # x 1 band if element is static # x 2 band if element is type constant # x 4 band if element is constant # x 8 band if element is deep constant # rcx <- address of entry (i.e. where rax was loaded from) # rdi <- number of parent pointers followed # rsi <- entry index * 8 within scope # rbp <- 0 if within scope data area # 1 if within extension area [[ /rax /rax :xorqRegReg /rax :pushqReg @retryWithParent # CHECK this is just sanity checking /rdi :pushqReg 7 /rdi /al :movbMemDisp8Reg %F0 /al :andbImmReg %20 /al :cmpbImmReg /isScope :jeLbl8 "object resolving in is not a scope" outputError :ud2 @isScope /rdi :popqReg # ENDCHECK 8 /rdi /rcx :movqMemDisp8Reg # load name table /rcx /rdx :movqRegReg 16 /rdx :addqImm8Reg # rdx will iterate over entries 8 /rcx /rcx :addqMemDisp8Reg # compute name table effective end @loop /rdx /rcx :cmpqRegReg /end :jbeLbl8 # TODO this is ridiculous /rdi :pushqReg /rsi :pushqReg /rdx :pushqReg /rcx :pushqReg /rdx /rdi :movqMemReg internalStringEqualsCode _ len dearray /rcx :popqReg /rdx :popqReg /rsi :popqReg /rdi :popqReg /rax /rax :testqRegReg /found :jnzLbl8 16 /rdx :addqImm8Reg /loop :jmpLbl8 @end # not found at all, retry with parent /rax :popqReg /rax :incqReg /rax :pushqReg 16 /rdi /rdi :movqMemDisp8Reg /rdi /rdi :testqRegReg /retryWithParent :jnzLbl8 @failed /rax :popqReg /rax /rax :xorqRegReg /rdx /rdx :xorqRegReg :retn @found # top of stack -> number of parent pointers followed 8 /rdx /rax :movqMemDisp8Reg # load default activation 8 /rdi /rdx :subqMemDisp8Reg # substract name table start 16 /rdx :subqImm8Reg # substract name table header size /rdx :shrq1Reg # divide by 2 to get offset within scope /rdx /rcx :movqRegReg # rcx == entry index * 8 in scope # rax == entry default activation /rcx /rsi :movqRegReg # save into target register for return value /rbp /rbp :xorqRegReg 32 /rcx :addqImm8Reg # add scope header size /ecx /rdi :cmplRegMem # TODO this fails for > 4 GB scopes /inDataArea :jaLbl8 /rdi /ecx :sublMemReg # substract scope length 24 /rdi /rdi :movqMemDisp8Reg # load extension area pointer /rdi /rdi :testqRegReg /outsideExtensionArea :jzLbl8 /rbp :incqReg 8 /rcx :addqImm8Reg # add extension area header length @inDataArea /rcx /rdi /rdx :movqMemIndexReg # load entry pointer /rax /rdx :xchgqRegReg /rdi /rcx :addqRegReg /rdi :popqReg :retn @outsideExtensionArea /rax :popqReg /rax /rax :xorqRegReg :retn ]] /internalResolve defv > { defv }' allocateOffsetStruct # TODO: link internal functions statically with relative calls < # allocate int # rax <- address of allocated integer # chunk will have GC length header initialized correctly [[ heapEnd /rbp :movqImmReg unusedHeapStart /rcx :movqImmReg /rdx :movqImmOOBReg HEAPBASE 0 /rbp /rbp :movqMemDisp8Reg /rcx /rcx :movqMemReg /rdi :movqImmOOBReg BLOCKBASE /rsi :movqImmOOBReg MARKBASE /rdx /rbp :subqRegReg # rbp now holds number of bytes in heap 6 /rcx :shrqImm8Reg # extract quadword 10 /rbp :shrqImm8Reg # rbp now holds number of quad-words in bitmaps @testBlockBitLoop /rcx /rbp :cmpqRegReg /noFreeBlockAvailable :jbeLbl32 8 /rcx /rdi /rax :movqMemIndexScaleReg /rax :notqReg 8 /rcx /rsi /rax :andqMemIndexScaleReg /rax /rax :bsfqRegReg # find bit with !block & mark -> free /continueTestBlockBitLoop :jzLbl8 /rax 8 /rcx /rdi :btsqRegMemIndexScale # set block bit of new block /rax 8 /rcx /rsi :btrqRegMemIndexScale # reset mark bit of new block # split block if necessary /rax :incqReg 6 /rax :btqImm8Reg 0 /rcx :adcqImm8Reg %3F /rax :andqImm8Reg /rcx /rbp :cmpqRegReg /dontSplit :jbeLbl8 # next cell outside of heap /rax 8 /rcx /rdi :btqRegMemIndexScale /dontSplit :jcLbl8 # next cell already allocated /rax 8 /rcx /rsi :btsqRegMemIndexScale # set mark bit @dontSplit 6 /rcx :shlqImm8Reg /rax /rcx :addqRegReg # rcx == cell index of cell after allocated int unusedHeapStart /rax :movqImmReg /rcx /rax :movqRegMem /rcx :decqReg # rcx == cell index of allocated int 4 /rcx :shlqImm8Reg # rcx == offset of allocated int /rdx /rcx /rax :leaqMemIndexReg /rcx :movqImmOOBReg %10 %00 %00 %00 %00 %00 %00 %08 # -> light grep /rcx /rax :movqRegMem # initialize GC header :retn @continueTestBlockBitLoop /rcx :incqReg /testBlockBitLoop :jmpLbl8 @noFreeBlockAvailable 10 /rdi :movqImmReg internalAllocate /rax :movqImmReg /rax :jmpqReg ]] /internalAllocateInteger defv # allocate scope, expecting rdi entries # rdi -> expected number of entries # rsi -> parent scope # rax <- address of scope on the heap [ /rsi :pushqReg /rdi :pushqReg # allocate name table 4 /rdi :shlqImm8Reg 16 /rdi :addqImm8Reg internalAllocate /rax :movqImmReg /rax :callqReg # set type %30 7 /rax :orbImmMemDisp8 # set fill to header size 16 8 /rax :movqImm32MemDisp8 /rdi :popqReg /rax :pushqReg # save name table on the stack 3 /rdi :shlqImm8Reg 32 /rdi :addqImm8Reg internalAllocate /rax :movqImmReg /rax :callqReg # set type and existence of all pointers %26 7 /rax :orbImmMemDisp8 8 /rax :popqMemDisp8 # reference name table 16 /rax :popqMemDisp8 # set parent /rdi /rdi :xorqRegReg # zero extension /rdi 24 /rax :movqRegMemDisp8 :retn ] /internalAllocateScope defv # allocate function # rdi -> code pointer # rsi -> scope pointer # rdx -> type pointer # rax <- address of function on the heap [ /rdi :pushqReg /rdx :pushqReg /rsi :pushqReg 32 /rdi :movqImmReg internalAllocate /rax :movqImmReg /rax :callqReg # set type %50 7 /rax :orbImmMemDisp8 /rsi :popqReg /rsi 8 /rax :movqRegMemDisp8 /rdx :popqReg /rdx 16 /rax :movqRegMemDisp8 /rdi :popqReg /rdi 24 /rax :movqRegMemDisp8 :retn ] /internalAllocateFunction defv # allocate code block # rdi -> number of code bytes # rax <- address of code block on heap [ 8 /rdi :addqImm8Reg internalAllocate /rax :movqImmReg /rax :callqReg # set type %60 7 /rax :orbImmMemDisp8 :retn ] /internalAllocateCode defv # allocate array, expecting rdi/8 entries # rdi -> expected number of entry bytes # rax <- address of array on the heap [ 8 /rdi :addqImm8Reg internalAllocate /rax :movqImmReg /rax :callqReg # set type %70 7 /rax :orbImmMemDisp8 :retn ] /internalAllocateArray defv # allocate string, holding rdi bytes # rdi -> expected number of bytes # rax <- address of string on the heap [ /rdi :pushqReg /rdi :decqReg 3 /rdi :shrqImm8Reg 4 /rdi :addqImm8Reg 3 /rdi :shlqImm8Reg internalAllocate /rax :movqImmReg /rax :callqReg # set type %10 7 /rax :orbImmMemDisp8 /rdx /rdx :xorqRegReg /rdx 8 /rax :movqRegMemDisp8 16 /rax :popqMemDisp8 :retn ] /internalAllocateString defv > { defv }' allocateOffsetStruct [ 8 /r15 :subqImm8Reg /r15 :popqMem 8 /r15 :subqImm8Reg currentScope /rbx :movqImmReg /rbx /rsi :movqMemReg /rsi /r15 :movqRegMem 8 /rdi :movqImmReg internalAllocateScope /rax :movqImmReg /rax :callqReg /rax /rbx :movqRegMem ] /scopingFunctionHeader defv [ /r15 /rcx :movqMemReg currentScope /rax :movqImmReg /rcx /rax :movqRegMem 8 /r15 :addqImm8Reg /r15 :pushqMem 8 /r15 :addqImm8Reg :retn ] /scopingFunctionFooter defv [ 8 /r15 :subqImm8Reg /r15 :popqMem ] /unscopingFunctionHeader defv [ /r15 :pushqMem 8 /r15 :addqImm8Reg :retn ] /unscopingFunctionFooter defv { :quoteEncodingBuffer /rax :movqImmReg /rax /rdi :subqRegReg /rdi :pushqReg # store opcode byte count /rdi :decqReg 3 /rdi :shrqImm8Reg /rdi :incqReg 3 /rdi :shlqImm8Reg internalAllocateCode /rax :movqImmReg /rax :callqReg # rax == code block on heap # copy opcodes :quoteEncodingBuffer /rsi :movqImmReg 8 /rax /rdi :leaqMemDisp8Reg /rcx :popqReg :reprcx :movsb } /allocateCodeFromEncodingBuffer deff { strToUTF8Bytes _ =*v len _ ==exactLength 1 sub 8 div 4 add 8 mul ==memoryLength memoryLength 2147483648 lt assert [ # allocate string memoryLength /rdi :movqImmReg internalAllocate /rax :movqImmReg /rax :callqReg # push string address on program stack /rax :pushqReg # set type 7 /rax :addqImm8Reg %10 /rax :orbImmMem # clear hash value 1 /rax :addqImm8Reg /rdx /rdx :xorqRegReg /rdx /rax :movqRegMem # load exact length 8 /rax :addqImm8Reg exactLength /rdx :movqImmReg /rdx /rax :movqRegMem exactLength 0 neq { # load string contents 0 exactLength 1 sub 8 div 1 add range { 8 mul ==i 8 /rax :addqImm8Reg /rdx :movqImmOOBReg i _ 8 add range v 8 dearray /rdx /rax :movqRegMem } each } rep ] } /constStringCode deff < [ 32 { "." } rep " " "!" "\"" "#" "$" "%" "&" "ยด" "(" ")" "*" "+" "," "-" "." "/" /0 /1 /2 /3 /4 /5 /6 /7 /8 /9 ":" ";" "<" "=" ">" "?" "@" /A /B /C /D /E /F /G /H /I /J /K /L /M /N /O /P /Q /R /S /T /U /V /W /X /Y /Z "[" "\\" "]" "^" "_" "`" /a /b /c /d /e /f /g /h /i /j /k /l /m /n /o /p /q /r /s /t /u /v /w /x /y /z "{" "|" "}" "~" "." 128 { "." } rep ] /ASCII defv { # ==addr [ -01 7 add 8 { _ sys .asm .peek -01 1 sub } rep -- ] { -01 256 mul add } fold } /peekImm64 deff { # ==addr [ -01 3 add 4 { _ sys .asm .peek -01 1 sub } rep -- ] { -01 256 mul add } fold } /peekImm32 deff { # ==addr sys .asm .peek } /peekImm8 deff [ /0 /1 /2 /3 /4 /5 /6 /7 /8 /9 /A /B /C /D /E /F ] ==base16singleDigits [ base16singleDigits { ==first base16singleDigits { first -01 cat } each } each ] ==base16digits { [ -01 8 { _ 256 mod -01 256 div } rep -- ] base16digits * reverse |cat fold } /base16encode64 deff { [ -01 4 { _ 256 mod -01 256 div } rep -- ] base16digits * reverse |cat fold } /base16encode32 deff { ==objAddr " int\n" sys .out .writestr } /intDump deff { ==objAddr " \"" sys .out .writestr objAddr 16 add peekImm64 ==length objAddr 24 add _ length add range peekImm8 ASCII * |cat fold sys .out .writestr "\"\n" sys .out .writestr } /stringDump deff { ==objAddr " scope\n" sys .out .writestr objAddr peekImm32 objAddr 4 add peekImm32 16777215 band 4294967296 mul add ==length objAddr 8 add peekImm64 ==nameTable objAddr 16 add peekImm64 ==parent objAddr 24 add peekImm64 ==extensionArea nameTable 8 add peekImm64 ==nameTableEnd 16 { _ nameTableEnd lt } { _ nameTable add base16encode64 ": " cat sys .out .writestr _ nameTable add peekImm64 stringDump _ 16 sub 2 div 32 add _ length lt { ==offset offset objAddr add peekImm64 memDump } { length sub 8 add ==offset offset extensionArea add peekImm64 memDump } ? * 16 add } loop -- } /scopeDump deff { ==objAddr " nameTable\n" sys .out .writestr } /nameTableDump deff { ==objAddr " extensionArea\n" sys .out .writestr } /extensionAreaDump deff { ==objAddr " function\n" sys .out .writestr } /functionDump deff { ==objAddr " code\n" sys .out .writestr } /codeDump deff { ==addr [ " " addr base16encode64 ": " # the perl interpreter does not like full 64bit numbers and converts them into floats addr 4 add peekImm32 _ ==heapValueB base16encode32 addr peekImm32 _ ==heapValueA base16encode32 " " [ [ heapValueA heapValueB ] { 4 { _ 256 mod -01 256 div } rep -- } each ] ASCII * 8 dearray "\n" ] |cat fold sys .out .writestr } /memDump deff { ==objAddr "Object at " objAddr base16encode64 cat " ----------\n" cat sys .out .writestr objAddr peekImm32 objAddr 4 add peekImm32 16777215 band 4294967296 mul add 8 div ==length 0 length range { 8 mul objAddr add memDump } each objAddr 7 add peekImm8 16 div [ |intDump |stringDump |scopeDump |nameTableDump |extensionAreaDump |functionDump |codeDump |die |die |die |die |die |die |die |die |die ] * objAddr -01* "^^^^^^^^^^^^^^^^^^^^^^^^^^^\n" sys .out .writestr } /heapDump deff { :mainStack .base :STACKSIZE add ==stackEnd "Stack ------------\n" sys .out .writestr :mainStack .base peekImm64 ==addr addr stackEnd gt { [ -01 stackEnd ] die } rep # Stack corrupted { addr stackEnd lt } { [ addr base16encode64 ": " addr peekImm64 ==value value base16encode64 "\n" ] |cat fold sys .out .writestr value 105553116266496 ge value 123145302310912 lt and { value peekImm32 value 4 add peekImm32 16777215 band 4294967296 mul add 8 div ==length 0 length range { 8 mul value add memDump } each } rep addr 8 add =addr } loop "^^^^^^^^^^^^^^^^^^\n" sys .out .writestr } /stackDump { currentScope peekImm64 heapDump } /globalScopeDump > -- 2 |deff rep > /assemblerLibrary defv # vim: syn=elymas