"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 .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 7 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 7 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 < # current end of heap memory (grows upwards) [ %00 %00 %00 %00 %00 %60 %00 %00 ] ==heapEnd # next free byte at end of heap [ %00 %00 %00 %00 %00 %60 %00 %00 ] ==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 > { 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 # allocate a chunk of memory # rdi -> size of chunk in bytes # rax <- address of allocated chunk # chunk will have GC length header initialized correctly # FIXME put a real allocator here [ /rbx :pushqReg /rdi :pushqReg unusedHeapStart /rax :movqImmReg /rax /rcx :movqMemReg /rcx /rbx :movqRegReg /rcx /rdx :movqRegReg /rdi /rcx :addqRegReg /rcx /rax :movqRegMem heapEnd /rax :movqImmReg /rax /rdi :movqMemReg /rdi /rcx :cmpqRegReg [ 4096 4096 mul /rsi :movqImmReg /rsi /rdi :addqRegReg /rdi /rax :movqRegMem /rsi /rdi :subqRegReg 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 ] |len { :jbeRel8 } -21*0*221* dearray /rbx /rax :movqRegReg /rdi :popqReg /rdi /rax :movqRegMem /rbx :popqReg :retn ] /internalAllocate 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 # 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 <- 0 if element is passive # 1 if element is active # 2 if element is quote-active # rcx <- address of entry (i.e. where rdx was loaded from) [ @retryWithParent 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 16 /rdi /rdi :movqMemDisp8Reg /rdi /rdi :testqRegReg /retryWithParent :jnzLbl8 @failed /rax /rax :xorqRegReg /rdx /rdx :xorqRegReg :retn @found 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 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 8 /rcx :addqImm8Reg # add extension area header length @inDataArea /rcx /rdi /rdx :movqMemIndexReg # load entry pointer /rax /rdx :xchgqRegReg /rdi /rcx :addqRegReg :retn @outsideExtensionArea /rax /rax :xorqRegReg :retn ] :labelResolve /internalResolve defv > { defv }' allocateOffsetStruct # TODO: link internal functions statically with relative calls < # 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 32 /rdi :movqImmReg internalAllocate /rax :movqImmReg /rax :callqReg # set type %50 7 /rax :orbImmMemDisp8 /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 { ==str /rdi :movqImmOOBReg str string internalDumpErrorString /rax :movqImmReg /rax :callqReg } /outputError deff [ 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 range { 8 mul ==i 8 /rax :addqImm8Reg /rdx :movqImmOOBReg i _ 7 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 1 sub 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 1 sub 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 1 sub 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