diff --git a/compiler/compiler.corth b/compiler/compiler.corth index fc433a7..0ad3be2 100644 --- a/compiler/compiler.corth +++ b/compiler/compiler.corth @@ -31,7 +31,6 @@ include "local_stack.corth" macro compiler:get-next-token let extend-macros in // Calls get-next-token and checks if a token is available-dstr. If there are no tokens, prints an error message. source-name source-file - line-no char-no extended-array extended-start extended-end macro-names macro-tokens macros-length extend-macros get-next-token @@ -43,7 +42,6 @@ end endmacro macro compiler:expect-next-token let extend-macros in // Calls get-next-token and checks if a token is available-dstr. If there are no tokens, prints an error message. source-name source-file - line-no char-no extended-array extended-start extended-end macro-names macro-tokens macros-length extend-macros expect-next-token @@ -108,40 +106,6 @@ in end NULLPTR end -proc fput-stack-contents - // ptr: stack-ptr int: stack-length file-desc: log-stream -> - ptr int file-desc -> -in let stack length log-stream in - length is-zero if - "\n" log-stream fputs - return - end - - 0 while dup length dec < do peek i in - i stack array64:get stack-item:get-type log-stream fput-int-type " " log-stream fputs - end inc end drop - - length dec stack array64:get stack-item:get-type log-stream fput-int-type -end end - - -proc fput-types - // ptr: types-array int: types-length file-desc: log-stream -> - ptr int file-desc -> -in let types-array types-length log-stream in - types-length is-zero if - "\n" log-stream fputs - return - end - - 0 while dup types-length dec < do peek i in - i types-array array64:get log-stream fput-int-type " " log-stream fputs - end inc end drop - - types-length dec types-array array64:get log-stream fput-int-type -end end - - // int: int-type -> ptr: item ptr: log-item // NOTE: Must be used inside the bodies of procedures that return only the log-item and nothing else. // NOTE: Stack must be empty. @@ -534,8 +498,6 @@ NULLPTR end end proc compile-intrinsic // ptr: source-name file-desc: source-file ptr: output-stream ptr file-desc ptr - // ptr: line-no ptr: char-no - ptr ptr // ptr: procedure-name ptr: procedure-address ptr ptr // ptr: local-stack ptr: local-stack-length ptr: peeked-item @@ -548,7 +510,6 @@ proc compile-intrinsic // Compiles an intrinsic in a Corth procedure. in let source-name source-file output-stream - line-no char-no procedure-name procedure-address local-stack local-stack-length peeked-item token-type token-arg @@ -860,8 +821,6 @@ proc collect-let-like-names ptr // ptr: source-name file-desc: source-file ptr file-desc - // ptr: line-no ptr: char-no - ptr ptr // ptr: macro-names ptr: macro-tokens ptr: macros-length ptr ptr ptr // ptr: procedure-name ptr: procedure-address @@ -875,7 +834,6 @@ proc collect-let-like-names in let new-names-list source-name source-file - line-no char-no macro-names macro-tokens macros-length procedure-name procedure-address extended-array extended-start extended-end @@ -889,7 +847,7 @@ in new-token-type TOKEN-TYPE:KEYWORD = if // If token is a keyword, it must be a 'in' keyword. new-token-arg KEYWORD:IN != if - LOG-TYPE:UNXPCT-KEYWORD generate-log0 return + new-token-address LOG-TYPE:UNXPCT-KEYWORD generate-log1 return end // Deallocate 'new-token-address'. @@ -901,7 +859,7 @@ in // Check the type of the token. new-token-type TOKEN-TYPE:NAME != if - LOG-TYPE:UNXPCT-TYPE generate-log0 return + new-token-address LOG-TYPE:UNXPCT-TYPE generate-log1 return end // TODO: Change the way that the variables are stored, so that we can also store their addresses. @@ -919,8 +877,6 @@ proc collect-memory-like-names ptr ptr int // ptr: source-name file-desc: source-file ptr file-desc - // ptr: line-no ptr: char-no - ptr ptr // ptr: macro-names ptr: macro-tokens ptr: macros-length ptr ptr ptr // ptr: extended-array ptr: extended-start ptr: extended-end @@ -932,7 +888,6 @@ proc collect-memory-like-names in let new-names-list new-sizes-list terminator-keyword source-name source-file - line-no char-no macro-names macro-tokens macros-length extended-array extended-start extended-end in @@ -945,7 +900,7 @@ in let memory-name-type memory-name-address memory-name-arg in memory-name-type TOKEN-TYPE:NAME != if - LOG-TYPE:UNXPCT-TYPE generate-log0 return + memory-name-address LOG-TYPE:UNXPCT-TYPE generate-log1 return end // Get the variable size. @@ -956,7 +911,7 @@ in let memory-size-type memory-size-address memory-size-arg in // The token after variable name should be an 'integer'. memory-size-type TOKEN-TYPE:INTEGER != if - LOG-TYPE:UNXPCT-TYPE generate-log0 return + memory-size-address LOG-TYPE:UNXPCT-TYPE generate-log1 return end true compiler:expect-next-token let log-item in log-item isn-null if @@ -966,7 +921,7 @@ in let memory-end-type memory-end-address memory-end-arg in // The token after variable size should be a 'keyword'. memory-end-type TOKEN-TYPE:KEYWORD != if - LOG-TYPE:UNXPCT-TYPE generate-log0 return + memory-end-address LOG-TYPE:UNXPCT-TYPE generate-log1 return end memory-name-arg new-names-list list64:append @@ -976,7 +931,7 @@ in memory-end-arg terminator-keyword != dup if memory-end-arg KEYWORD:AND != if // If keyword is not the terminator, check if it is 'and'. - drop LOG-TYPE:UNXPCT-KEYWORD generate-log0 return + drop memory-end-address LOG-TYPE:UNXPCT-KEYWORD generate-log1 return end end @@ -998,8 +953,6 @@ NULLPTR end end proc compile-unreachable // ptr: source-name file-desc: source-file ptr: output-stream ptr file-desc ptr - // ptr: line-no ptr: char-no - ptr ptr // ptr: macro-names-array ptr: macro-tokens-array ptr: macros-length ptr ptr ptr // ptr: procedure-name ptr: procedure-address @@ -1027,7 +980,6 @@ proc compile-unreachable // All of the tokens must be keywords as intrinsics can not allow branches. in let source-name source-file output-stream - line-no char-no macro-names macro-tokens macros-length procedure-name procedure-address local-stack local-stack-length @@ -1046,10 +998,10 @@ in let token-type token-address token-arg in token-type TOKEN-TYPE:KEYWORD != if - LOG-TYPE:UNXPCT-TYPE generate-log0 return + token-address LOG-TYPE:UNXPCT-TYPE generate-log1 return end token-arg KEYWORD:END != if - LOG-TYPE:UNXPCT-KEYWORD generate-log0 return + token-address LOG-TYPE:UNXPCT-KEYWORD generate-log1 return end labels-list list64:length is-zero if LOG-TYPE:UNREACHABLE generate-log0 return @@ -1107,7 +1059,7 @@ in else start-keyword KEYWORD:MEMORY != if - LOG-TYPE:UNXPCT-KEYWORD generate-log0 return + start-address LOG-TYPE:UNXPCT-KEYWORD generate-log1 return end label 16 + @64 label 24 + @64 let new-names old-local-memory-end in @@ -1135,8 +1087,6 @@ NULLPTR end end proc compile-keyword // ptr: source-name file-desc: source-file ptr: output-stream ptr file-desc ptr - // ptr: line-no ptr: char-no - ptr ptr // ptr: macro-names-array ptr: macro-tokens-array ptr: macros-length ptr ptr ptr // ptr: procedure-name ptr: procedure-address @@ -1162,7 +1112,6 @@ proc compile-keyword bool ptr in let source-name source-file output-stream - line-no char-no macro-names macro-tokens macros-length procedure-name procedure-address local-stack local-stack-length peeked-item @@ -1283,7 +1232,7 @@ in else start-keyword KEYWORD:MEMORY != if - false LOG-TYPE:UNXPCT-KEYWORD generate-log0 return + false start-address LOG-TYPE:UNXPCT-KEYWORD generate-log1 return end // -------- End of 'memory' -------- @@ -1373,7 +1322,7 @@ in // 32-39 -> Old stack labels-list list64:length is-zero if - false LOG-TYPE:UNXPCT-KEYWORD generate-log0 return + false token-address LOG-TYPE:UNXPCT-KEYWORD generate-log1 return end local-stack local-stack-length output-stream local-stack.convert-last-items-real @@ -1381,7 +1330,7 @@ in labels-list list64:pop-last let label in label @64 label 8 + @64 let old-keyword old-address in old-keyword KEYWORD:IF != if - false LOG-TYPE:UNXPCT-KEYWORD generate-log0 return + false old-address LOG-TYPE:UNXPCT-KEYWORD generate-log1 return end label 16 + @64 label 24 + @64 let start-id start-stack in @@ -1491,7 +1440,7 @@ in old-label @64 old-label 8 + @64 let old-keyword old-address in // Check if the label type is 'while'. old-keyword KEYWORD:WHILE != if - false LOG-TYPE:UNXPCT-KEYWORD generate-log0 return + false old-address LOG-TYPE:UNXPCT-KEYWORD generate-log1 return end old-label 16 + @64 old-label 24 + @64 let old-label-id old-stack in @@ -1549,7 +1498,6 @@ in end source-name source-file output-stream - line-no char-no macro-names macro-tokens macros-length procedure-name procedure-address local-stack local-stack-length @@ -1600,7 +1548,6 @@ in new-names-list new-sizes-list KEYWORD:IN source-name source-file - line-no char-no macro-names macro-tokens macros-length extended-array extended-start extended-end collect-memory-like-names dup isn-null if false swp return end drop @@ -1663,7 +1610,6 @@ in new-names-list source-name source-file - line-no char-no macro-names macro-tokens macros-length procedure-name procedure-address extended-array extended-start extended-end @@ -1769,7 +1715,6 @@ in new-names-list source-name source-file - line-no char-no macro-names macro-tokens macros-length procedure-name procedure-address extended-array extended-start extended-end @@ -1841,7 +1786,6 @@ in drop source-name source-file output-stream - line-no char-no macro-names macro-tokens macros-length procedure-name procedure-address local-stack local-stack-length @@ -1867,7 +1811,7 @@ in let type-type type-address type-arg in // The token after 'cast' should be an 'intrinsic type'. type-type TOKEN-TYPE:INT-TYPE != if - false LOG-TYPE:UNXPCT-TYPE generate-log0 return + false type-address LOG-TYPE:UNXPCT-TYPE generate-log1 return end local-stack local-stack-length output-stream local-stack.convert-last-items-real @@ -1901,7 +1845,7 @@ in let type-type type-address type-arg in // The token afrer 'sizeof' should be an 'intrinsic type'. type-type TOKEN-TYPE:INT-TYPE != if - false LOG-TYPE:UNXPCT-TYPE generate-log0 return + false type-address LOG-TYPE:UNXPCT-TYPE generate-log1 return end // Push the size of the intrinsic type. @@ -1914,8 +1858,6 @@ end false NULLPTR end proc compile-procedure // ptr: source-name file-desc: source-file ptr: output-stream ptr file-desc ptr - // ptr: line-no ptr: char-no - ptr ptr // ptr: data-definitions-list ptr // ptr: global-names-array ptr: global-sizes-array ptr: globals-length @@ -1938,7 +1880,6 @@ proc compile-procedure // Compiles a Corth procedure. in let source-name source-file output-stream - line-no char-no data-definitions-list global-names-array global-sizes-array globals-length proc-names-array proc-inputs-array proc-outputs-array procs-length @@ -2081,7 +2022,6 @@ in // -------- Intrinsics -------- source-name source-file output-stream - line-no char-no procedure-name procedure-address local-stack local-stack-length peeked-item @@ -2090,13 +2030,12 @@ in else token-type TOKEN-TYPE:KEYWORD != if - 0 LOG-TYPE:UNXPCT-TYPE generate-log0 return + 0 token-address LOG-TYPE:UNXPCT-TYPE generate-log1 return end // -------- Keywords -------- source-name source-file output-stream - line-no char-no macro-names macro-tokens macros-length procedure-name procedure-address local-stack local-stack-length @@ -2168,18 +2107,12 @@ in memory extended-array EXTENDED-MAX-LENGTH and extended-start sizeof(int) and extended-end sizeof(int) and - line-no sizeof(int) and - char-no sizeof(int) and namespace-name sizeof(ptr) in // Reset extended-tokens. 0 extended-start !64 0 extended-end !64 - // Reset line-no and char-no variables. - 1 line-no !64 - 0 char-no !64 - // Reset namespace. NULLPTR namespace-name !64 @@ -2189,7 +2122,7 @@ in drop drop drop log-item return end end drop let token-type token-address token-arg in - token-type TOKEN-TYPE:KEYWORD != if LOG-TYPE:UNXPCT-TYPE generate-log0 return end + token-type TOKEN-TYPE:KEYWORD != if token-address LOG-TYPE:UNXPCT-TYPE generate-log1 return end // -------- Global keywords -------- token-arg KEYWORD:INCLUDE = if @@ -2204,7 +2137,7 @@ in end let path-token-type path-token-address path-token-arg in - path-token-type TOKEN-TYPE:STRING != if LOG-TYPE:UNXPCT-TYPE generate-log0 return end + path-token-type TOKEN-TYPE:STRING != if path-token-address LOG-TYPE:UNXPCT-TYPE generate-log1 return end memory found sizeof(bool) in found !reset @@ -2275,7 +2208,6 @@ in new-names-list new-sizes-list KEYWORD:END source-name source-file - line-no char-no macro-names macro-tokens macros-length extended-array extended-start extended-end collect-memory-like-names dup isn-null if @@ -2311,7 +2243,7 @@ in let macro-name-token-type macro-name-token-address macro-name-token-arg in macro-name-token-type TOKEN-TYPE:NAME != if - LOG-TYPE:UNXPCT-TYPE generate-log0 return + macro-name-token-address LOG-TYPE:UNXPCT-TYPE generate-log1 return end // macro-tokens and macro-tokens-length are used to create a STACK for macro tokens. @@ -2371,7 +2303,7 @@ in let proc-name-token-type proc-name-token-address proc-name-token-arg in proc-name-token-type TOKEN-TYPE:NAME != if - LOG-TYPE:UNXPCT-TYPE generate-log0 return + proc-name-token-address LOG-TYPE:UNXPCT-TYPE generate-log1 return end memory input-list sizeof(ptr) and @@ -2392,7 +2324,7 @@ in input-token-type TOKEN-TYPE:KEYWORD = if // If the token was a keyword, it must be a 'KEYWORD:RETURN'. input-token-arg KEYWORD:RETURNS != if - LOG-TYPE:UNXPCT-KEYWORD generate-log0 return + input-token-address LOG-TYPE:UNXPCT-KEYWORD generate-log1 return end // Deallocate 'input-token-address'. @@ -2404,7 +2336,7 @@ in // Check if the token is of type-type. input-token-type TOKEN-TYPE:INT-TYPE != if - LOG-TYPE:UNXPCT-TYPE generate-log0 return + input-token-address LOG-TYPE:UNXPCT-TYPE generate-log1 return end input-token-arg input-list list64:append @@ -2425,7 +2357,7 @@ in output-token-type TOKEN-TYPE:KEYWORD = if // If the token is a keyword, it must be a 'KEYWORD:IN'. output-token-arg KEYWORD:IN != if - LOG-TYPE:UNXPCT-KEYWORD generate-log0 return + output-token-address LOG-TYPE:UNXPCT-KEYWORD generate-log1 return end // Deallocate 'output-token-address'. @@ -2437,7 +2369,7 @@ in // Check if the token is of type-type. output-token-type TOKEN-TYPE:INT-TYPE != if - LOG-TYPE:UNXPCT-TYPE generate-log0 return + output-token-address LOG-TYPE:UNXPCT-TYPE generate-log1 return end output-token-arg output-list list64:append @@ -2493,7 +2425,6 @@ in end inc end drop source-name source-file output-stream - line-no char-no data-definitions-list global-names-array global-sizes-array globals-length proc-names-array proc-inputs-array proc-outputs-array procs-length @@ -2526,7 +2457,7 @@ in else token-arg KEYWORD:NAMESPACE = if namespace-name @64 isn-null if - LOG-TYPE:UNXPCT-KEYWORD generate-log0 return + LOG-TYPE:REC-NAMESPACE generate-log0 return end // Get the next token, which should be the name of the procedure. @@ -2536,7 +2467,7 @@ in let name-type name-address name-arg in name-type TOKEN-TYPE:NAME != if - LOG-TYPE:UNXPCT-TYPE generate-log0 return + name-address LOG-TYPE:UNXPCT-TYPE generate-log1 return end ':' name-arg dappend8 namespace-name !64 @@ -2544,11 +2475,11 @@ in else token-arg KEYWORD:ENDNAMESPACE != if - LOG-TYPE:UNXPCT-KEYWORD generate-log0 return + token-address LOG-TYPE:UNXPCT-KEYWORD generate-log1 return end namespace-name @64 is-null if - LOG-TYPE:UNXPCT-KEYWORD generate-log0 return + token-address LOG-TYPE:UNXPCT-KEYWORD generate-log1 return end NULLPTR namespace-name !64 diff --git a/compiler/corth.corth b/compiler/corth.corth index 80b3862..f8af9c2 100644 --- a/compiler/corth.corth +++ b/compiler/corth.corth @@ -600,9 +600,6 @@ in let argc argv in // Initialize malloc. malloc:init - // Initialize debug. - debug-init - getopts.reset-length argv @64 executable-file-name !64 diff --git a/compiler/debug.corth b/compiler/debug.corth index dc24298..1886b81 100644 --- a/compiler/debug.corth +++ b/compiler/debug.corth @@ -5,57 +5,24 @@ include "core/stack.corth" macro sizeof(position) 16 endmacro macro sizeof(address) 48 endmacro -macro ADDR.FILE 0 endmacro -macro ADDR.PREV 8 endmacro -macro ADDR.START 16 endmacro -macro ADDR.END 32 endmacro - -macro POS.LINE 0 endmacro -macro POS.CHAR 8 endmacro - - -// This buffer can be used to easily write many spaces at once. -// NOTE: Trying to write more than .-BUFFER-SIZE characters may cause problems. -macro SPACE-BUFFER-SIZE 256 endmacro -memory space-buffer SPACE-BUFFER-SIZE end - -macro TILDE-BUFFER-SIZE 256 endmacro -memory tilde-buffer TILDE-BUFFER-SIZE end - - -macro sizeof(log) 24 endmacro -macro log:type 0 + endmacro -macro log:arg1 8 + endmacro -macro log:arg2 16 + endmacro - - -proc debug-init -> in - // Set up the space-buffer. - space-buffer SPACE-BUFFER-SIZE ' ' memset8 - - // Set up the tilde-buffer. - tilde-buffer TILDE-BUFFER-SIZE '~' memset8 -end - +macro addr:path 0 + endmacro // The path of the file that generated this token. +macro addr:prev 8 + endmacro // The previous token address which was a macro name and caused this token to be generated. +macro addr:start 16 + endmacro // The start position of this token. +macro addr:end 32 + endmacro // The end position of this token. proc generate-address - // ptr: file-name ptr: previous int: start-line int: start-char int: end-line int: end-char -> ptr: address - ptr ptr int int int int -> ptr + // ptr: file-name ptr: previous int: start int: end -> ptr: address + ptr ptr int int -> ptr // Returns a dynamicly-placed object to store the address of token. in sizeof(address) malloc let address in address isn-null if // Store the arguments. - address ADDR.END + POS.CHAR + !64 - address ADDR.END + POS.LINE + !64 - address ADDR.START + POS.CHAR + !64 - address ADDR.START + POS.LINE + !64 - address ADDR.PREV + !64 - address ADDR.FILE + !64 - else - // Remove the unused arguments. - drop drop drop drop drop drop - end + address addr:end !64 + address addr:start !64 + address addr:prev !64 + address addr:path !64 + else drop drop drop drop end // Return the address. address @@ -63,175 +30,150 @@ in end -proc fput-position - // int: line-no int: char-no file-desc: file-desc - int int file-desc -> - // Prints a position. -in let line-no char-no file in - line-no file fputu ":" file fputs char-no file fputu -end end - - -proc seek-line - // int: line file-desc: file-desc - int file-desc -> - // Shifts the file pointer by a specified amount of lines. +proc seek-line-rev + // file-desc: file -> int: location + file-desc -> int in let file in - memory char 1 in - while dup isn-zero do - // If EOF is reached, returns immediately. - char 1 file fgets is-zero if drop return end - - // If a newline is reached, decrease the counter. - char @8 '\n' = if dec end - end drop + memory buffer 1 in + while + file -1 SEEK-WHENCE:CUR lseek + buffer 1 file fgets is-zero if return end inc + buffer @8 '\n' != do + drop file -1 SEEK-WHENCE:CUR lseek drop + end end end end -proc fput-line - // file-desc: source file-desc: file-desc -> int: line-length - file-desc file-desc -> int - // Keeps printing until a newline is found. - // Returns the length of line read. -in let source file in - memory char 1 in - 0 while true do - // If EOF is reached, return immediately. - char 1 source fgets is-zero if return end - - // If a newline character is reached, return immediately. - char @8 '\n' = if return end - - // Print the byte to the file stream. - char 1 file fputs - inc end +macro fput-file:BUFFER-SIZE 1024 endmacro +proc fput-file + // file-desc: from file-desc: to -> + file-desc file-desc -> +in let from to in + memory buffer fput-file:BUFFER-SIZE in + while + buffer fput-file:BUFFER-SIZE from fgets let read in + buffer read to fputs + read fput-file:BUFFER-SIZE = + end + do end end end end +proc fput-file-length + // file-desc: from int: length file-desc: to -> + file-desc int file-desc -> +in let from length to in + memory buffer fput-file:BUFFER-SIZE in + length while let rem in + buffer fput-file:BUFFER-SIZE rem min2 from fgets let read in + buffer read to fputs + rem read - + read fput-file:BUFFER-SIZE = + end + end do end drop + end +end end -macro fputu-full let _value_ _file_ in - // int: int file-desc: file-desc +proc fput-file-line + // file-desc: from file-desc: to -> + file-desc file-desc -> +in let from to in + memory buffer fput-file:BUFFER-SIZE in + while + buffer fput-file:BUFFER-SIZE from fgets let read in buffer read + let last in + buffer while peek i in + i @8 '\n' != i last < & + end do inc end buffer - inc let put in + buffer put to fputs + put fput-file:BUFFER-SIZE = + end + end end + do end + end +end end - memory _buffer_ 20 in - _buffer_ _value_ intconvud let _buffer_start_ in - _buffer_ _buffer_start_ _buffer_ - ' ' memset8 - end - _buffer_ 20 _file_ fputs - end -end endmacro +macro get-char-line-no:BUFFER-SIZE 256 endmacro +proc get-char-line-no + // int: position file-desc: file -> int: char-no int: line-no + int file-desc -> int int +in let position file in + memory buffer get-char-line-no:BUFFER-SIZE and + char-no sizeof(int) and + line-no sizeof(int) in + + 0 char-no !64 + 1 line-no !64 + + while + buffer position file ftell - get-char-line-no:BUFFER-SIZE min2 file fgets buffer + let buffer-end in + buffer while dup buffer-end < do peek i in + i @8 '\n' = if + 0 char-no !64 + line-no @inc64 + else + char-no @inc64 + end + end inc end drop + // Keep iterating if the buffer was filled. + buffer-end buffer get-char-line-no:BUFFER-SIZE + = + end + do end -proc fput-address - // ptr: address file-desc: log-stream - ptr file-desc -> - // Prints the formatted address of a token. -in let address log-stream in - address ADDR.FILE + @64 let file-name in - "in '" log-stream fputs file-name file-name mlength log-stream fputs - "' between [" log-stream fputs - address ADDR.START + POS.LINE + @64 address ADDR.START + POS.CHAR + @64 log-stream fput-position - "]-[" log-stream fputs - address ADDR.END + POS.LINE + @64 address ADDR.END + POS.CHAR + @64 log-stream fput-position - "]" log-stream fputs + char-no @64 line-no @64 end end end -proc fput-lines - // ptr: address file-desc: log-stream +macro fput-here:MARK-BEG "\x1b[91m" endmacro +macro fput-here:MARK-END "\x1b[0m" endmacro +proc fput-here + // ptr: address file-desc: log-stream -> ptr file-desc -> - // Prints the formatted lines of a token. in let address log-stream in - address ADDR.FILE + @64 address ADDR.START + address ADDR.END + let file-name start-pos end-pos in - // Add a null character and open the file. - file-name null-term8 fopen-r let file in - // Check if file could be opened. + address addr:path @64 address addr:prev @64 address addr:start @64 address addr:end @64 let path prev start _end in + path fopen-r let file in file isn-pos if - "\n" log-stream fputs - return - end - - start-pos POS.LINE + @64 start-pos POS.CHAR + @64 end-pos POS.LINE + @64 end-pos POS.CHAR + @64 let start-line start-char end-line end-char in - - // Move the file pointer to the start. - file 0 SEEK-WHENCE:SET lseek drop start-line dec file seek-line + path path mlength log-stream fputs ":\n" log-stream fputs + else + // Print the flie path and the line number. + start file get-char-line-no let char-no line-no in + path path mlength log-stream fputs ":" log-stream fputs + line-no log-stream fputu ":\n" log-stream fputs + end - start-line end-line = if - start-line log-stream fputu-full ": " log-stream fputs file log-stream fput-line log-stream fputnl let length in - " " log-stream fputs space-buffer start-char log-stream fputs tilde-buffer end-char start-char - log-stream fputs log-stream fputnl - end - else - start-line log-stream fputu-full ": " log-stream fputs file log-stream fput-line log-stream fputnl let length in - " " log-stream fputs space-buffer start-char log-stream fputs tilde-buffer length start-char - log-stream fputs log-stream fputnl - end + // Move the file handle to the beginning of the line. + file seek-line-rev let line-start in + // Print the part of the line that is not marked. + file start line-start - log-stream fput-file-length - start-line inc while dup end-line < do - dup log-stream fputu-full ": " log-stream fputs file log-stream fput-line log-stream fputnl let length in - " " log-stream fputs tilde-buffer length log-stream fputs log-stream fputnl - end - inc end drop + // Print the marked part. + fput-here:MARK-BEG log-stream fputs + file _end start - log-stream fput-file-length + fput-here:MARK-END log-stream fputs - end-line log-stream fputu-full ": " log-stream fputs file log-stream fput-line log-stream fputnl let length in - " " log-stream fputs tilde-buffer end-char log-stream fputs log-stream fputnl - end + // Print the remaining of the line. + file log-stream fput-file-line end - // Close the file. file fclose drop end end - end -end end - -proc fput-lines-position - // int: line-no int: char-no ptr: file-name file-desc: log-stream - int int ptr file-desc -> - // Prints the formatted linees of a token. -in let line-no char-no file-name log-stream in - // Add a null character for fopen. - file-name null-term8 fopen-r let file in - // Check if the file could be opened. - file isn-pos if - "\n" log-stream fputs - return + // If the address was extended by a macro call, print the address of the macro call. + address addr:prev @64 isn-null if + address addr:prev @64 log-stream fput-here end - - // Move the file pointer to the start, - file 0 SEEK-WHENCE:SET lseek drop line-no dec file seek-line - - line-no log-stream fputu-full ": " log-stream fputs file log-stream fput-line log-stream fputnl let length in - " " log-stream fputs space-buffer char-no log-stream fputs tilde-buffer 1 log-stream fputs log-stream fputnl - end - - // Close the file. - file fclose drop end end end -proc fput-here - // ptr: address file-desc: log-stream -> - ptr file-desc -> -in let address log-stream in - address log-stream fput-address log-stream fputnl - address log-stream fput-lines - - address ADDR.PREV + @64 let prev in - prev isn-null if - prev log-stream fput-here - end - end -end end - - -macro fput-here-position let _line_no_ _char_no_ _file_name_ _log_stream_ in - // ptr: position file-desc: log-stream -> - _line_no_ _char_no_ _log_stream_ fput-position " in file " _log_stream_ fputs _file_name_ _file_name_ mlength _log_stream_ fputs _log_stream_ fputnl - _line_no_ _char_no_ _file_name_ _log_stream_ fput-lines-position -end endmacro +macro sizeof(log) 24 endmacro +macro log:type 0 + endmacro +macro log:arg1 8 + endmacro +macro log:arg2 16 + endmacro // Exits with error code. @@ -279,6 +221,8 @@ namespace LOG-TYPE // -------- Error messages (prefix: 2xxxx) -------- //// General errors (prefix: 20xxx) +macro CANNOT-OPEN-OUT 0x20000 endmacro // +macro CANNOT-CREAT-OUT 0x20001 endmacro // //// Lexer errors (prefix: 21xxx) macro REACHED-EOF 0x21000 endmacro // @@ -294,8 +238,12 @@ macro SYNTAX-ERROR 0x21009 endmacro // log-item: reason ptr: address //// Parsing errors (prefix: 22xxx) macro NO-TOKEN 0x22000 endmacro // log-item: reason -macro UNXPCT-TYPE 0x22001 endmacro -macro UNXPCT-KEYWORD 0x22002 endmacro +macro UNXPCT-TYPE 0x22001 endmacro // ptr: address +macro UNXPCT-KEYWORD 0x22002 endmacro // ptr: address +macro REC-NAMESPACE 0x22003 endmacro // +// TODO: Add ELSE-NO-IF +// TODO: Add DO-NO-WHILE +// TODO: Add END-NO-START //// Compilation errors (prefix: 23xxx) macro STACK-NOT-MATCH 0x23000 endmacro // @@ -314,12 +262,10 @@ macro CANNOT-OPEN-SRC 0x2300c endmacro // macro TODO-DIR-INCLUDE 0x2300d endmacro // macro UNKNOWN-FILE-TYPE 0x2300e endmacro // macro CANNOT-FIND-SRC 0x2300f endmacro // -macro CANNOT-OPEN-OUT 0x23010 endmacro // -macro CANNOT-CREAT-OUT 0x23011 endmacro // -macro ACCESSED-PEEKED 0x23012 endmacro // -macro CANNOT-INCLUDE 0x23013 endmacro // ptr: source-path -macro CANNOT-CALL-PROC 0x23014 endmacro // address: token-address -macro STACK-SIZE-NOT-EQ 0x23015 endmacro // +macro ACCESSED-PEEKED 0x23010 endmacro // +macro CANNOT-INCLUDE 0x23011 endmacro // ptr: source-path +macro CANNOT-CALL-PROC 0x23012 endmacro // address: token-address +macro STACK-SIZE-NOT-EQ 0x23013 endmacro // // -------- Assertions (prefix: 3xxxx) -------- macro MALLOC-FAILED 0x30000 endmacro // @@ -340,8 +286,6 @@ in let log-item log-stream in log-item log:arg1 @64 log-item log:arg2 @64 let type arg1 arg2 in - "(#" log-stream fputs type log-stream fputx ") " log-stream fputs - // Information messages // Warnings @@ -390,9 +334,14 @@ in let log-item log-stream in else type LOG-TYPE:UNXPCT-TYPE = if "error: unexpected token type\n" log-stream fputs + arg1 log-stream fput-here else type LOG-TYPE:UNXPCT-KEYWORD = if "error: unexpected keyword\n" log-stream fputs + arg1 log-stream fput-here + + else type LOG-TYPE:REC-NAMESPACE = if + "error: tried to start a namespace scope inside another one\n" log-stream fputs // Compilation errors else type LOG-TYPE:STACK-NOT-MATCH = if @@ -492,7 +441,7 @@ in let log-item log-stream in else "unknown\n" log-stream fputs - end end end end end end end end end end end end end end end end end end end end end + end end end end end end end end end end end end end end end end end end end end end end end end end end end end end end end end end end end end end end end end end end end end end diff --git a/compiler/enums.corth b/compiler/enums.corth index bcacd6b..c7fa61b 100644 --- a/compiler/enums.corth +++ b/compiler/enums.corth @@ -1,8 +1,6 @@ include "linux_x86/io/output.corth" include "core/arithmetic.corth" -include "debug.corth" - // TODO: Change these arrays with vectors. macro GLOBALS-MAX-COUNT 0x8000 endmacro macro MACROS-MAX-COUNT 0x8000 endmacro diff --git a/compiler/lexer.corth b/compiler/lexer.corth index dcf57cb..56a8809 100644 --- a/compiler/lexer.corth +++ b/compiler/lexer.corth @@ -20,12 +20,11 @@ end end proc strip-file - // file-desc: file ptr: line-no ptr: char-no -> bool: reached-eof - file-desc ptr ptr -> bool + // file-desc: file -> bool: reached-eof + file-desc -> bool // Removes the newline and spaces from the start of a file stream - // Keeps track of the line and char number as the bytes are read. // Also, checks if EOF is reached. -in let file line-no char-no in +in let file in memory char 1 in while true do // If EOF is reached, return immediately. @@ -34,17 +33,11 @@ in let file line-no char-no in // If a null-terminator is reached, return immediately. char @8 is-zero if true return end - char @8 '\n' = if - 0 char-no !64 - line-no @inc64 - - else + char @8 '\n' != if char @8 ' ' != if file -1 SEEK-WHENCE:CUR lseek drop false return end - - char-no @inc64 end end end @@ -52,30 +45,20 @@ end false end // dummy return proc parse-next-token - // file-desc: file ptr: file-name ptr: line-no ptr: char-no ptr: buffer ptr: buffer-end -> ptr: log-item - file-desc ptr ptr ptr ptr ptr -> ptr + // file-desc: file ptr: buffer ptr: buffer-end -> ptr: log-item + file-desc ptr ptr -> ptr // Gets the next token string before any newline or space and fills a buffer. - // Keeps track of the line and char number as the bytes are read. // NOTE: If buffer-end exceeds buffer + TOKEN-MAX-LENGTH, creates an assertion. -in let file file-name line-no char-no buffer buffer-end in +in let file buffer buffer-end in while true do - buffer-end @64 1 file fgets-keep is-zero if - // Reached EOF. - char-no @inc64 - NULLPTR return - end + // Reached EOF. + buffer-end @64 1 file fgets-keep is-zero if NULLPTR return end - buffer-end @64 @8 '\n' = if - // Reached a newline character. - char-no @inc64 - NULLPTR return - end + // Reached a newline character. + buffer-end @64 @8 '\n' = if NULLPTR return end - buffer-end @64 @8 ' ' = if - // Reached a space character. - char-no @inc64 - NULLPTR return - end + // Reached a space character. + buffer-end @64 @8 ' ' = if NULLPTR return end buffer-end @64 buffer - TOKEN-MAX-LENGTH >= if // Reached the end of the buffer. @@ -85,15 +68,14 @@ in let file file-name line-no char-no buffer buffer-end in // There is still space in the buffer. file 1 SEEK-WHENCE:CUR lseek drop buffer-end @inc64 - char-no @inc64 end end NULLPTR end // dummy proc parse-escape-sequence - // file-desc: file ptr: file-name ptr: line-no ptr: char-no -> int: escape-character ptr: log-item - file-desc ptr ptr ptr -> int ptr -in let file file-name line-no char-no in + // file-desc: file -> int: escape-character ptr: log-item + file-desc -> int ptr +in let file in // Buffer is 2 bytes because after \x, 2 new bytes are required. memory buffer 2 in // Check if we reached EOF before an escape sequence. @@ -101,9 +83,6 @@ in let file file-name line-no char-no in 0 LOG-TYPE:REACHED-EOF generate-log0 return end - // Increase the char-no, as the next character should not be a newline character. - char-no @inc64 - // Get the mapping of the escape character. buffer @8 '0' = if '\0' else buffer @8 'n' = if '\n' @@ -121,9 +100,6 @@ in let file file-name line-no char-no in 0 LOG-TYPE:REACHED-EOF generate-log0 return end - // Increase the char-no. - char-no @64 2 + char-no !64 - // Get the hexadecimal value after '\x'. memory number sizeof(int) in buffer 2 number convx ! if @@ -139,14 +115,12 @@ end end proc parse-next-string - // file-desc: file ptr: file-name ptr: line-no ptr: char-no ptr: buffer ptr: buffer-end -> ptr: log-item - file-desc ptr ptr ptr ptr ptr -> ptr + // file-desc: file ptr: buffer ptr: buffer-end -> ptr: log-item + file-desc ptr ptr -> ptr // Gets the next string before a double quote. - // Keeps track of the line and char number as the bytes are read. // NOTE: If buffer-end exceeds buffer + TOKEN-MAX-LENGTH, creates an assertion. // NOTE: If EOF is reached before a double quote is found, creates an assertion. - // TODO: Add escapes. -in let file file-name line-no char-no buffer buffer-end in +in let file buffer buffer-end in while true do buffer-end @64 let char-addr in // Check if we reached EOF before an end of string. @@ -156,7 +130,6 @@ in let file file-name line-no char-no buffer buffer-end in // Check if we reached the end of the string. char-addr @8 '"' = if - char-no @inc64 0 buffer-end @64 !8 buffer-end @inc64 NULLPTR return @@ -167,19 +140,11 @@ in let file file-name line-no char-no buffer buffer-end in LOG-TYPE:TOKEN-TOO-LONG generate-log0 LOG-TYPE:INV-STR-LIT generate-log1 return end - char-addr @8 '\n' = if - // Reached new line, reset char-no and increase line-no. - line-no @inc64 - 0 char-no !64 - else char-addr @8 '\\' = if + char-addr @8 '\\' = if // Reached a backslash, check for escape sequence. - char-no @inc64 - file file-name line-no char-no parse-escape-sequence let log-item in log-item isn-null if drop log-item return end end + file parse-escape-sequence let log-item in log-item isn-null if drop log-item return end end char-addr !8 - else - // Reached any character, increase char-no. - char-no @inc64 - end end + end buffer-end @inc64 end end @@ -187,14 +152,10 @@ NULLPTR end end proc skip-line - // file-desc: file-desc ptr: file-name ptr: line-no ptr: char-no -> - file-desc ptr ptr file-desc -> + // file-desc: file-desc -> + file-desc -> // Moves the file pointer until it passes a newline, or EOF is reached. - // Keeps track of the line and char number as the bytes are read. -in let file file-name line-no char-no in - line-no @inc64 - 0 char-no !64 - +in let file in memory char 1 in while true do // If EOF is reached, return immediately. @@ -208,11 +169,11 @@ end end proc skip-block-comment - // file-desc: file-desc ptr: file-name ptr: line-no ptr: char-no -> ptr: log-item - file-desc ptr ptr ptr -> ptr + // file-desc: file-desc -> ptr: log-item + file-desc -> ptr // Moves the file pointer until it passes a block comment end, or EOF is reached. // Keeps track of the line and char number as the bytes are read. -in let file file-name line-no char-no in +in let file in memory char 1 in while true do char 1 file fgets is-zero if @@ -222,31 +183,13 @@ in let file file-name line-no char-no in char @8 '*' = if // Reached asterisk. - char 1 file fgets is-zero if - // Reached EOF while expecting a block comment end. - LOG-TYPE:REACHED-EOF generate-log0 return - end - - char @8 '/' = if - // Reached block comment end. - char-no @inc64 - NULLPTR return - end - - char @8 '\n' = if - line-no @inc64 - 0 char-no !64 - end - else char @8 '\n' = if - // Reached a newline. - line-no @inc64 - 0 char-no !64 + // Check if reached EOF while expecting a block comment end. + char 1 file fgets is-zero if LOG-TYPE:REACHED-EOF generate-log0 return end - else - // Reached any other character - char-no @inc64 - end end + // Reached block comment end. + char @8 '/' = if NULLPTR return end + end end end NULLPTR end end @@ -255,10 +198,8 @@ NULLPTR end end proc create-name-token // ptr: file-name file-desc: file-desc ptr file-desc - // int: start-line int: start-char - int int - // ptr: line-no ptr: char-no - ptr ptr + // int: start-position + int // ptr: buffer ptr: buffer-end ptr ptr -> // int: token-type ptr: address [int|ptr]: arg ptr: log-item @@ -266,14 +207,9 @@ proc create-name-token // Checks if the name is a keyword or an intrinsic, and creates a new token. // After the keyword and intrinsic checks, macros are checked for any match. If there is any macro with the same name, the macro tokens are loaded to a buffer. -in let - file-name file - start-line start-char - line-no char-no - buffer buffer-end -in +in let file-name file start-position buffer buffer-end in // Get full token. - file file-name line-no char-no buffer buffer-end parse-next-token dup isn-null if + file buffer buffer-end parse-next-token dup isn-null if let log-item in TOKEN-TYPE:UNKNOWN NULLPTR 0 log-item end return end drop @@ -342,14 +278,13 @@ in let token-type token-arg in // Return token type, address and argument. - file-name NULLPTR start-line start-char line-no @64 char-no @64 generate-address let address in + file-name NULLPTR start-position file ftell generate-address let address in address is-null if TOKEN-TYPE:UNKNOWN NULLPTR 0 LOG-TYPE:MALLOC-FAILED generate-log0 return end token-type address token-arg NULLPTR end - end end end end @@ -358,8 +293,6 @@ end end proc get-next-token // ptr: file-name file-desc: file-desc ptr file-desc - // ptr: line-no ptr: char-no - ptr ptr // ptr: extended-tokens-array ptr: extended-tokens-start-index ptr: extended-tokens-end-index ptr ptr ptr // ptr: macro-names ptr: macro-tokens ptr: macros-length @@ -374,7 +307,6 @@ proc get-next-token // NOTE: If there is no token available, every other parameter is either NULLPTR or invalid. in let file-name file - line-no char-no extended-array extended-start extended-end macro-names macro-tokens macros-length extend-macros @@ -391,16 +323,16 @@ in extended-array EXTENDED-MAX-LENGTH extended-start extended-end deque64:pop-first else - memory buffer TOKEN-MAX-LENGTH in - memory buffer-end sizeof(int) in + memory buffer TOKEN-MAX-LENGTH and + buffer-end sizeof(int) in - file line-no char-no strip-file if + file strip-file if TOKEN-TYPE:UNKNOWN NULLPTR 0 NULLPTR false return end buffer buffer-end !64 - line-no @64 char-no @64 let start-line start-char in + file ftell let start-position in buffer 1 file fgets drop buffer-end @inc64 @@ -408,13 +340,13 @@ in // -------- Integer type -------- // Get full token. - file file-name line-no char-no buffer buffer-end parse-next-token dup isn-null if + file buffer buffer-end parse-next-token dup isn-null if let log-item in TOKEN-TYPE:UNKNOWN NULLPTR 0 log-item false end return end drop - file-name NULLPTR start-line start-char line-no @64 char-no @64 generate-address let address in + file-name NULLPTR start-position file ftell generate-address let address in address is-null if TOKEN-TYPE:UNKNOWN NULLPTR 0 LOG-TYPE:MALLOC-FAILED generate-log0 false return end memory number sizeof(int) in @@ -430,15 +362,11 @@ in // -------- Characters -------- // TODO: Add multpile character pushing. - char-no @inc64 - buffer inc 1 file fgets is-zero if // Reached EOF while expecting a character. TOKEN-TYPE:UNKNOWN NULLPTR 0 LOG-TYPE:REACHED-EOF generate-log0 false return end - char-no @inc64 - // Get the character buffer inc @8 let character in character '\n' = if TOKEN-TYPE:UNKNOWN NULLPTR 0 LOG-TYPE:REACHED-EOL generate-log0 false return end @@ -446,7 +374,7 @@ in character '\\' = if // Return the escape sequence character. - file file-name line-no char-no parse-escape-sequence dup isn-null if + file parse-escape-sequence dup isn-null if let log-item in drop TOKEN-TYPE:UNKNOWN NULLPTR 0 log-item false end return end drop else @@ -461,15 +389,13 @@ in TOKEN-TYPE:UNKNOWN NULLPTR 0 LOG-TYPE:REACHED-EOF generate-log0 false return end - char-no @inc64 - buffer @8 '\'' != if // Was expecting a single quote, but found another character. TOKEN-TYPE:UNKNOWN NULLPTR 0 LOG-TYPE:INV-CHAR-LIT generate-log0 false return end // Return token type, address and argument. - file-name NULLPTR start-line start-char line-no @64 char-no @64 generate-address let address in + file-name NULLPTR start-position file ftell generate-address let address in address is-null if TOKEN-TYPE:UNKNOWN NULLPTR 0 LOG-TYPE:MALLOC-FAILED generate-log0 false return end @@ -484,15 +410,13 @@ in // Move the buffer-end left once, so the quote is removed. buffer-end @dec64 - char-no @inc64 - // Get full string. - file file-name line-no char-no buffer buffer-end parse-next-string dup isn-null if + file buffer buffer-end parse-next-string dup isn-null if let log-item in TOKEN-TYPE:UNKNOWN NULLPTR 0 log-item false end return end drop // Return token type, address and argument. - file-name NULLPTR start-line start-char line-no @64 char-no @64 generate-address let address in + file-name NULLPTR start-position file ftell generate-address let address in address is-null if TOKEN-TYPE:UNKNOWN NULLPTR 0 LOG-TYPE:MALLOC-FAILED generate-log0 false return end @@ -507,18 +431,16 @@ in TOKEN-TYPE:UNKNOWN NULLPTR 0 LOG-TYPE:REACHED-EOF generate-log0 false return end - char-no @inc64 - buffer-end @inc64 buffer inc @8 is-ddigit if // Get full token. - file file-name line-no char-no buffer buffer-end parse-next-token dup isn-null if + file buffer buffer-end parse-next-token dup isn-null if let log-item in TOKEN-TYPE:UNKNOWN NULLPTR 0 log-item false end return end drop // Return token type, address and argument. - file-name NULLPTR start-line start-char line-no @64 char-no @64 generate-address let address in + file-name NULLPTR start-position file ftell generate-address let address in address is-null if TOKEN-TYPE:UNKNOWN NULLPTR 0 LOG-TYPE:MALLOC-FAILED generate-log0 false return end @@ -537,7 +459,7 @@ in buffer-end @dec64 - file-name file start-line start-char line-no char-no buffer buffer-end create-name-token dup isn-null if false return end drop + file-name file start-position buffer buffer-end create-name-token dup isn-null if false return end drop end else buffer @8 '/' = if @@ -551,34 +473,34 @@ in // -------- Single line comment -------- // Skip this line. - file file-name line-no char-no skip-line + file skip-line // Get next token and return it. - file-name file line-no char-no extended-array extended-start extended-end macro-names macro-tokens macros-length extend-macros get-next-token ! if false return end drop + file-name file extended-array extended-start extended-end macro-names macro-tokens macros-length extend-macros get-next-token ! if false return end drop else buffer inc @8 '*' = if // -------- Block comment -------- // Skip the block comment. - file file-name line-no char-no skip-block-comment let log-item in log-item isn-null if + file skip-block-comment let log-item in log-item isn-null if TOKEN-TYPE:UNKNOWN NULLPTR 0 log-item false return end end // Get next token and return it. - file-name file line-no char-no extended-array extended-start extended-end macro-names macro-tokens macros-length extend-macros get-next-token ! if false return end drop + file-name file extended-array extended-start extended-end macro-names macro-tokens macros-length extend-macros get-next-token ! if false return end drop else // -------- Name and keyword types -------- file -1 SEEK-WHENCE:CUR lseek drop - file-name file start-line start-char line-no char-no buffer buffer-end create-name-token dup isn-null if false return end drop + file-name file start-position buffer buffer-end create-name-token dup isn-null if false return end drop end end else // -------- Name and keyword types -------- - file-name file start-line start-char line-no char-no buffer buffer-end create-name-token dup isn-null if false return end drop + file-name file start-position buffer buffer-end create-name-token dup isn-null if false return end drop end end end end end end - end end + end end // If macros should not be extended, return immediately. @@ -597,8 +519,8 @@ in extended-array EXTENDED-MAX-LENGTH extended-start extended-end deque64:append-first // -- Token address -- - // Change the ADDR.PREV of the address. - address token-address ADDR.PREV + !64 + // Change the addr:prev of the address. + address token-address addr:prev !64 token-address dcopy extended-array EXTENDED-MAX-LENGTH extended-start extended-end deque64:append-first // -- Token type -- @@ -606,7 +528,7 @@ in end i end end drop - file-name file line-no char-no extended-array extended-start extended-end macro-names macro-tokens macros-length extend-macros get-next-token + file-name file extended-array extended-start extended-end macro-names macro-tokens macros-length extend-macros get-next-token // Deallocate 'arg'. arg mfree drop @@ -625,8 +547,6 @@ end end proc expect-next-token // ptr: file-name file-desc: file-desc ptr file-desc - // ptr: line-no ptr: char-no - ptr ptr // ptr: extended-tokens-array ptr: extended-tokens-start-index ptr: extended-tokens-end-index ptr ptr ptr // ptr: macro-names ptr: macro-tokens ptr: macros-length diff --git a/corth b/corth index e683e5c..72d596b 100755 Binary files a/corth and b/corth differ