From 29186973c837f182b199ef33267778d6dd577876 Mon Sep 17 00:00:00 2001 From: d_m Date: Tue, 28 Nov 2023 10:33:25 -0500 Subject: [PATCH 1/2] monochrome by default now --- femto.tal | 14 ++++++++++---- 1 file changed, 10 insertions(+), 4 deletions(-) diff --git a/femto.tal b/femto.tal index a18ccf4..1826065 100644 --- a/femto.tal +++ b/femto.tal @@ -72,6 +72,7 @@ &tab-adjust $2 ( how many "extra" spaces; tab-width - 1 ) &insert-tabs $1 ( tab key inserts tabs when true ) &color $2 ( digits of highlight color in reverse order ) + &red $2 ( digits of color for line/EOF markers in reverse order ) ] ( tracks information related to the buffer's view of data ) @@ -143,7 +144,10 @@ #0004 .config/tab-width STZ2 #0003 .config/tab-adjust STZ2 #00 .config/insert-tabs STZ - #3333 .config/color STZ2 +( #3333 .config/color STZ2 ) +( #3133 .config/red STZ2 ) + #3033 .config/color STZ2 + #3033 .config/red STZ2 ;data .buffer/offset STZ2 ( start reading the filename from argv ) @@ -773,8 +777,9 @@ ( - white ) @toggle-color ( -> ) .config/color LDZ2 #3733 EQU2 ,&wrap-around JCN - .config/color LDZ2 #0100 ADD2 .config/color STZ2 ,&done JMP - &wrap-around #3033 .config/color STZ2 + .config/color LDZ2 #0100 ADD2 .config/color STZ2 + #3133 .config/red STZ2 ,&done JMP + &wrap-around #3033 DUP2 .config/color STZ2 .config/red STZ2 &done ;redraw-all JSR2 ;return JMP2 ( toggle whether to use literal tab characters ) @@ -798,6 +803,7 @@ .state/key LDZ LIT "c EQU ( M-c ) ;toggle-color JCN2 .state/key LDZ LIT "f EQU ( M-f ) ;forward-by-word JCN2 .state/key LDZ LIT "g EQU ( M-g ) ;goto-line JCN2 + .state/key LDZ LIT "h EQU ( M-h ) ;help JCN2 .state/key LDZ LIT "s EQU ( M-s ) ;regex-search JCN2 .state/key LDZ LIT "t EQU ( M-t ) ;toggle-tabs JCN2 .state/key LDZ LIT "u EQU ( M-u ) ;undo JCN2 @@ -1330,7 +1336,7 @@ ( ESC [ 3 1 m ) @emit-red ( -> ) - LIT2 00 "m LIT2 "1 "3 ,ansi-emit JMP + LIT2 00 "m .config/red LDZ2 ,ansi-emit JMP ( ESC [ 0 m ) @emit-reset ( -> ) From 06332929f658d82c944070113214eb48f0487aa5 Mon Sep 17 00:00:00 2001 From: d_m Date: Tue, 28 Nov 2023 12:08:42 -0500 Subject: [PATCH 2/2] modernize immediate jumps --- femto.tal | 968 +++++++++++++++++++++++++++--------------------------- regex.tal | 402 +++++++++++------------ 2 files changed, 686 insertions(+), 684 deletions(-) diff --git a/femto.tal b/femto.tal index 1826065..7cdf5bf 100644 --- a/femto.tal +++ b/femto.tal @@ -160,10 +160,10 @@ ( ERROR HANDLING ) -( using error! will print the given message before causing ) +( using errorq will print the given message before causing ) ( the interpreter to halt. ) -@error! ( msg* -> ) - emit-! sp ;print JSR2 nl dbg BRK +@errorq ( msg* -> ) + emit-! sp print nl dbg BRK ( open the given file at editor start up ) ( ) @@ -176,10 +176,10 @@ ;data .File/read DEO2 .File/success DEI2 #0000 EQU2 .state/modified STZ - .File/success DEI2 #ce81 LTH2 ,&ok JCN + .File/success DEI2 #ce81 LTH2 ?&ok crlf - ;messages/input-error ;print JSR2 - ;filename ;print JSR2 crlf quit! + ;messages/input-error print + ;filename print crlf quit! ( calculate buffer limit address using start + size ) &ok .File/success DEI2 ;data ADD2 .buffer/limit STZ2 @@ -191,8 +191,8 @@ ( ) ( TODO: consider supporting terminal resizing ) @setup-terminal-size ( -> ) - #03e7 DUP2 ;term-move-cursor JSR2 - ;term-get-cursor-position JSR2 + #03e7 DUP2 term-move-cursor + term-get-cursor-position ;tmp/data .tmp/pos STZ2 ;receive-terminal-size .Console/vector DEO2 JMP2r @@ -204,7 +204,7 @@ .Console/read DEI .state/key STZ .state/key LDZ .tmp/pos LDZ2 STA .tmp/pos LDZ2 INC2 .tmp/pos STZ2 - .state/key LDZ LIT "R EQU ;parse-terminal-size JCN2 + .state/key LDZ LIT "R EQU ?parse-terminal-size BRK ( parse and store terminal size information ) @@ -212,17 +212,17 @@ ( called by ;receive-terminal-size after complete message received ) @parse-terminal-size ( -> ) #0000 ,&acc STR2 - .tmp/data LDZk #1b NEQ ,&parse-error JCN ( i ) INC - LDZk LIT "[ NEQ ,&parse-error JCN ( i ) INC + .tmp/data LDZk #1b NEQ ?&parse-error ( i ) INC + LDZk LIT "[ NEQ ?&parse-error ( i ) INC &loop - LDZk LIT "; EQU ,&parse-col JCN - LIT2r :&loop ,&read JMP + LDZk LIT "; EQU ?&parse-col + LIT2r :&loop !&read &parse-col INC ,&acc LDR2 #0002 SUB2 .term/rows STZ2 #0000 ,&acc STR2 &loop2 - LDZk LIT "R EQU ,&done JCN - LIT2r :&loop2 ,&read JMP + LDZk LIT "R EQU ?&done + LIT2r :&loop2 !&read &read LDZk LIT "0 SUB #00 SWP ,&acc LDR2 #000a MUL2 ADD2 ,&acc STR2 @@ -230,19 +230,19 @@ &done ,&acc LDR2 .term/cols STZ2 POP ;on-key .Console/vector DEO2 - ;draw-all JSR2 + draw-all BRK [ &acc $2 ] &parse-error POP .tmp/data LDZ2 - ;messages/term-size-parse-error ;error! JMP2 + ;messages/term-size-parse-error !errorq @count-c ( c^ -> n* ) #0000 ,&count STR2 STH ;data - &loop LDAk #00 EQU ,&done JCN - LDAk STHkr NEQ ,&next JCN + &loop LDAk #00 EQU ?&done + LDAk STHkr NEQ ?&next ,&count LDR2 INC2 ,&count STR2 - &next INC2 ,&loop JMP + &next INC2 !&loop &done POP2 POPr ,&count LDR2 JMP2r [ &count $2 ] ( save count of number of lines in input file ) @@ -250,8 +250,8 @@ ( this method also detects whether \t characters are used, ) ( and uses this to initialize config/insert-tabs. ) @setup-linecount ( -> ) - #0a ;count-c JSR2 INC2 .buffer/line-count STZ2 - #09 ;count-c JSR2 #0000 GTH2 .config/insert-tabs STZ + #0a count-c INC2 .buffer/line-count STZ2 + #09 count-c #0000 GTH2 .config/insert-tabs STZ JMP2r ( reads filename from the program's argv ) @@ -263,78 +263,78 @@ ( - launching femto without a file name ) ( - closing the given file and opening a new one ) @read-filename ( -> ) - #12 DEI #0a EQU ,&execute JCN ( did we read \n ? ) + #12 DEI #0a EQU ?&execute ( did we read \n ? ) #12 DEI .tmp/pos LDZ2 STA ( no, so save in buffer ) .tmp/pos LDZ2 INC2 .tmp/pos STZ2 ( pos++ ) BRK ( return ) &execute ( we saw a newline, so do something ) #00 .tmp/pos LDZ2 STA ( null terminate str ) - ;filename ;open-file JSR2 ( open file ) - ;setup-linecount JSR2 ( determine # of lines ) - ;setup-terminal-size JSR2 ( detect terminal dimensions ) + ;filename open-file ( open file ) + setup-linecount ( determine # of lines ) + setup-terminal-size ( detect terminal dimensions ) BRK ( jump to beginning of line ) @bol ( -> ) #0000 .cursor/col STZ2 - ;redraw-statusbar-and-cursor JSR2 - ;return JMP2 + redraw-statusbar-and-cursor + !return ( jump to beginning of line ) @eol ( -> ) - ;cur-len JSR2 .cursor/col STZ2 - ;redraw-statusbar-and-cursor JSR2 - ;return JMP2 + cur-len .cursor/col STZ2 + redraw-statusbar-and-cursor + !return @forward ( -> ) - ;go-forward JSR2 ;return JMP2 + go-forward !return ( move forward by one character ) @go-forward ( -> ) - ;cur-pos JSR2 ;last-pos JSR2 GTH2 ( ;return JCN2 ) ,&noop JCN - ;redraw-statusbar-and-cursor JSR2 - ;cur-col JSR2 ;cur-len JSR2 LTH2 ,&normal JCN + cur-pos last-pos GTH2 ( ?return ) ?&noop + redraw-statusbar-and-cursor + cur-col cur-len LTH2 ?&normal #0000 .cursor/col STZ2 .cursor/row LDZ2 INC2 .cursor/row STZ2 - ;ensure-visible-cursor JMP2 + !ensure-visible-cursor &normal - ;cur-col JSR2 INC2 .cursor/col STZ2 + cur-col INC2 .cursor/col STZ2 &noop JMP2r ( move backward by one character ) @back ( -> ) - ;go-back JSR2 ;return JMP2 + go-back !return ( internal implementation shared by ;back and ;backspace ) @go-back ( -> ) - ;cur-pos JSR2 ;data EQU2 ,&noop JCN - ;cur-col JSR2 #0001 LTH2 ,&next-line JCN - ;cur-col JSR2 #0001 SUB2 .cursor/col STZ2 - ;redraw-statusbar-and-cursor JMP2 + cur-pos ;data EQU2 ?&noop + cur-col #0001 LTH2 ?&next-line + cur-col #0001 SUB2 .cursor/col STZ2 + !redraw-statusbar-and-cursor &next-line .cursor/row LDZ2k #0001 SUB2 ROT STZ2 - ;cur-len JSR2 .cursor/col STZ2 - ;ensure-visible-cursor JSR2 - ;redraw-statusbar-and-cursor JSR2 + cur-len .cursor/col STZ2 + ensure-visible-cursor + redraw-statusbar-and-cursor &noop JMP2r ( move up by one line ) @up ( -> ) - .cursor/row LDZ2 #0000 EQU2 ;return JCN2 + .cursor/row LDZ2 #0000 EQU2 ?return .cursor/row LDZ2 #0001 SUB2 .cursor/row STZ2 - ;ensure-visible-cursor JSR2 - ;redraw-statusbar-and-cursor JSR2 - ;return JMP2 + ensure-visible-cursor + redraw-statusbar-and-cursor + !return ( move down by one line ) @down ( -> ) .cursor/row LDZ2 - .buffer/line-count LDZ2 #0001 SUB2 EQU2 ;return JCN2 + .buffer/line-count LDZ2 #0001 SUB2 EQU2 ?return .cursor/row LDZ2 INC2 .cursor/row STZ2 - ;ensure-visible-cursor JSR2 - ;redraw-statusbar-and-cursor JSR2 - ;return JMP2 + ensure-visible-cursor + redraw-statusbar-and-cursor + !return @is-word-char ( c^ -> bool^ ) DUP #2f GTH OVR #3a LTH AND STH @@ -342,88 +342,88 @@ DUP #60 GTH SWP #7b LTH AND STHr ORA JMP2r @not-word-char ( c^ -> bool^ ) - ;is-word-char JSR2 #00 EQU JMP2r + is-word-char #00 EQU JMP2r @forward-by-word ( -> ) - ;cur-pos JSR2 + cur-pos &first - LDAk #00 EQU ,&done JCN - LDAk ;is-word-char JSR2 ,&second JCN - INC2 ;go-forward JSR2 ,&first JMP + LDAk #00 EQU ?&done + LDAk is-word-char ?&second + INC2 go-forward !&first &second - LDAk #00 EQU ,&done JCN - LDAk ;not-word-char JSR2 ,&done JCN - INC2 ;go-forward JSR2 ,&second JMP + LDAk #00 EQU ?&done + LDAk not-word-char ?&done + INC2 go-forward !&second &done - POP2 ;return JMP2 + POP2 !return @back-by-word ( -> ) - ;cur-pos JSR2 #0001 SUB2 + cur-pos #0001 SUB2 &first - DUP2 ;data LTH2 ,&done JCN - LDAk ;is-word-char JSR2 ,&second JCN - #0001 SUB2 ;go-back JSR2 ,&first JMP + DUP2 ;data LTH2 ?&done + LDAk is-word-char ?&second + #0001 SUB2 go-back !&first &second - DUP2 ;data LTH2 ,&done JCN - LDAk ;not-word-char JSR2 ,&done JCN - #0001 SUB2 ;go-back JSR2 ,&second JMP + DUP2 ;data LTH2 ?&done + LDAk not-word-char ?&done + #0001 SUB2 go-back !&second &done - POP2 ;return JMP2 + POP2 !return @help #01 .state/in-help STZ - ;term-erase-all JSR2 - #0000 #0000 ;term-move-cursor JSR2 - ;emit-color-bold JSR2 - ;help-text ;print JSR2 - ;emit-reset JSR2 - ;redraw-all JSR2 + term-erase-all + #0000 #0000 term-move-cursor + emit-color-bold + ;help-text print + emit-reset + redraw-all BRK ( center buffer view on the current line ) @center-view .term/rows LDZ2 INC2 #0002 DIV2 STH2k - .cursor/row LDZ2 LTH2 ,&standard JCN + .cursor/row LDZ2 LTH2 ?&standard POP2r #0000 .buffer/line-offset STZ2 ;data .buffer/offset STZ2 - ,&done JMP + !&done &standard .cursor/row LDZ2 STH2r SUB2 DUP2 .buffer/line-offset STZ2 - ;abs-line JSR2 .buffer/offset STZ2 + abs-line .buffer/offset STZ2 &done - ;redraw-all JSR2 ;return JMP2 + redraw-all !return ( move up by one page ) @page-up ( -> ) .term/rows LDZ2 #0002 SUB2 STH2k - .buffer/line-offset LDZ2 LTH2 ,&move-full JCN + .buffer/line-offset LDZ2 LTH2 ?&move-full POP2r - ;zero-row JSR2 + zero-row #0000 .cursor/col STZ2 - ,&done JMP + !&done &move-full .cursor/row LDZ2 STH2kr SUB2 .cursor/row STZ2 .buffer/line-offset LDZ2 STH2r SUB2 DUP2 .buffer/line-offset STZ2 - ;abs-line JSR2 .buffer/offset STZ2 + abs-line .buffer/offset STZ2 &done - ;redraw-all JSR2 ;return JMP2 + redraw-all !return ( move down by one page ) @page-down - ;eof-is-visible JSR2 ,&near-eof JCN + eof-is-visible ?&near-eof .term/rows LDZ2 #0002 SUB2 STH2k .buffer/line-offset LDZ2 ADD2 DUP2 .buffer/line-offset STZ2 - ;abs-line JSR2 .buffer/offset STZ2 + abs-line .buffer/offset STZ2 .cursor/row LDZ2 STH2r ADD2 .cursor/row STZ2 - ;redraw-all JSR2 ;return JMP2 + redraw-all !return &near-eof .buffer/line-count LDZ2 #0001 SUB2 .cursor/row STZ2 - ;cur-len JSR2 .cursor/col STZ2 - ;redraw-cursor JSR2 ;return JMP2 + cur-len .cursor/col STZ2 + redraw-cursor !return ( return true if the end of the file is visible ) @eof-is-visible ( -> bool^ ) @@ -434,9 +434,9 @@ ( beginning quitting femto, prompting if unsaved changes ) @quit #01 .state/quitting STZ - .state/modified LDZ #00 EQU ;quit-now JCN2 - ;messages/quit-prompt ;messages/null ;do-quit ;start-prompt JSR2 - ;redraw-prompt-and-cursor JSR2 ;return JMP2 + .state/modified LDZ #00 EQU ?quit-now + ;messages/quit-prompt ;messages/null ;do-quit start-prompt + redraw-prompt-and-cursor !return ( display two strings on the message line ) ( ) @@ -445,15 +445,15 @@ ( use messages/null for the second string if only one is needed. ) @send-message ( s1* s2* -> ) #01 .state/message STZ - ;move-to-message-line JSR2 - SWP2 ;print JSR2 ;print JMP2 + move-to-message-line + SWP2 print !print ( callback executed in response to the quit prompt. ) @do-quit - .tmp/data LDZ LIT "n EQU ;quit-now JCN2 - .tmp/data LDZ LIT "y EQU ;save JCN2 + .tmp/data LDZ LIT "n EQU ?quit-now + .tmp/data LDZ LIT "y EQU ?save #00 .state/quitting STZ - ;messages/unknown-input ;tmp/data ;send-message JSR2 + ;messages/unknown-input ;tmp/data send-message BRK ( label that calls quit! ) @@ -471,16 +471,16 @@ ( ) ( this should not be called for newlines, see ;newline ) @insert ( c^ -> ) - ;cur-pos JSR2 ;shift-right JSR2 - ;cur-col JSR2 INC2 .cursor/col STZ2 - ;redraw-all JSR2 ;return JMP2 + cur-pos shift-right + cur-col INC2 .cursor/col STZ2 + redraw-all !return ( insert the given character in the prompt ) @insert-prompt ( c^ -> ) .tmp/pos LDZ2 STH2k STA ( data[pos] <- c ) INC2r #00 STH2kr STA ( data[pos+1] <- 0 ) STH2r .tmp/pos STZ2 ( pos <- pos+1 ) - ;redraw-prompt-and-cursor JSR2 ;return JMP2 + redraw-prompt-and-cursor !return ( insert a tab at the cursor position ) ( ) @@ -488,48 +488,48 @@ ( either call ;insert with \t or else insert a number of ) ( spaces based on .config/tab-width. ) @insert-tab ( -> ) - .config/insert-tabs LDZ ,&use-tabs JCN + .config/insert-tabs LDZ ?&use-tabs #0000 .config/tab-width LDZ2 SUB2 &loop - DUP2 #0000 EQU2 ,&done JCN - #20 ;cur-pos JSR2 ;shift-right JSR2 - INC2 ,&loop JMP + DUP2 #0000 EQU2 ?&done + #20 cur-pos shift-right + INC2 !&loop &done - ;cur-col JSR2 .config/tab-width LDZ2 ADD2 .cursor/col STZ2 - ;redraw-all JSR2 ;return JMP2 + cur-col .config/tab-width LDZ2 ADD2 .cursor/col STZ2 + redraw-all !return &use-tabs - #09 ;insert JMP2 + #09 !insert ( insert a newline at the cursor position ) @newline ( c^ -> ) - #0a ;cur-pos JSR2 ;shift-right JSR2 + #0a cur-pos shift-right #0000 .cursor/col STZ2 .cursor/row LDZ2 INC2 .cursor/row STZ2 .buffer/line-count LDZ2k INC2 ROT STZ2 - ;ensure-visible-cursor JSR2 - ;redraw-all JSR2 ;return JMP2 + ensure-visible-cursor + redraw-all !return ( delete the character to the left of the cursor, if any ) @backspace ( -> ) - ;cur-pos JSR2 ;data EQU2 ;return JCN2 - ;go-back JSR2 ;delete JMP2 + cur-pos ;data EQU2 ?return + go-back !delete ( delete the last character in the prompt ) @backspace-prompt ( -> ) - .tmp/pos LDZ2 ;tmp/data EQU2 ,&skip JCN ( ;return JCN2 ) + .tmp/pos LDZ2 ;tmp/data EQU2 ?&skip ( ?return ) #00 .tmp/pos LDZ2 #0001 SUB2 ( 0 pos-1 ) STH2k STA ( data[pos-1] <- 0 ) STH2r .tmp/pos STZ2 ( pos <- pos-1 ) - &skip ;redraw-prompt-and-cursor JSR2 ;return JMP2 + &skip redraw-prompt-and-cursor !return ( delete the character under the cursor, if any ) @delete ( -> ) - ;last-pos JSR2 ;cur-pos JSR2 LTH2 ;return JCN2 - ;cur-pos JSR2 LDAk STH ( cur [c] ) - ;shift-left JSR2 ( [c] ) - STHr #0a NEQ ,¬-newline JCN + last-pos cur-pos LTH2 ?return + cur-pos LDAk STH ( cur [c] ) + shift-left ( [c] ) + STHr #0a NEQ ?¬-newline .buffer/line-count LDZ2k #0001 SUB2 ROT STZ2 - ¬-newline ;redraw-all JSR2 ;return JMP2 + ¬-newline redraw-all !return ( used at the start of an escape sequence to set up state. ) ( ) @@ -544,44 +544,44 @@ ( move to the end of the file ) @goto-end ( -> ) .buffer/line-count LDZ2 #0001 SUB2 .cursor/row STZ2 - .buffer/line-count LDZ2 .term/rows LDZ2 LTH2k ,&use-zero JCN - SUB2 #0002 ADD2 ,&continue JMP + .buffer/line-count LDZ2 .term/rows LDZ2 LTH2k ?&use-zero + SUB2 #0002 ADD2 !&continue &use-zero POP2 POP2 #0000 &continue DUP2 .buffer/line-offset STZ2 - ;abs-line JSR2 .buffer/offset STZ2 - ;cur-len JSR2 .cursor/col STZ2 - ;redraw-all JSR2 ;return JMP2 + abs-line .buffer/offset STZ2 + cur-len .cursor/col STZ2 + redraw-all !return ( move to the start of the file ) @goto-start ( -> ) - ;zero-row JSR2 + zero-row #0000 .cursor/col STZ2 - ;redraw-all JSR2 ;return JMP2 + redraw-all !return ( prompt for a line number and move to that line ) @goto-line ( -> ) - ;messages/goto-line ;messages/null ;do-goto-line ;start-prompt JSR2 - ;redraw-prompt-and-cursor JSR2 ;return JMP2 + ;messages/goto-line ;messages/null ;do-goto-line start-prompt + redraw-prompt-and-cursor !return ( parse the given string as a decimal number ) ( ) ( returns the number as a short followed by whether parsing was ok ) @parse-decimal-number ( addr* -> n* ok^ ) - LDAk ,&non-empty JCN + LDAk ?&non-empty #00 JMP2r &non-empty LIT2r 0000 &loop - LDAk ,&continue JCN + LDAk ?&continue POP2 STH2r #01 JMP2r &continue - LDAk LIT "0 LTH ,&fail JCN - LDAk LIT "9 GTH ,&fail JCN + LDAk LIT "0 LTH ?&fail + LDAk LIT "9 GTH ?&fail LIT2r 000a MUL2r LDAk LIT "0 SUB #00 SWP STH2 ADD2r - INC2 ,&loop JMP + INC2 !&loop &fail POP2r #00 JMP2r @@ -589,55 +589,55 @@ ( ) ( this is used as a callback from the goto-line prompt ) @do-goto-line ( n* -> ) - ;tmp/data ;parse-decimal-number JSR2 - ,&ok JCN - ;messages/unknown-input ;tmp/data ;send-message JSR2 - ;return JMP2 + ;tmp/data parse-decimal-number + ?&ok + ;messages/unknown-input ;tmp/data send-message + !return &ok #0001 SUB2 ( convert 1-indexing to 0-indexing ) - DUP2 .buffer/line-count LDZ2 LTH2 ,&within JCN - POP2 ;goto-end JMP2 + DUP2 .buffer/line-count LDZ2 LTH2 ?&within + POP2 !goto-end &within - ;jump-to-line JSR2 - ;redraw-all JSR2 ;return JMP2 + jump-to-line + redraw-all !return ( move the cursor to the given coordinates ) ( ) ( this won't move the display if the given coordinates are visible. ) @move-to-coord ( col* row* -> ) - DUP2 ;line-is-visible JSR2 ;jump-to-coord/short JCN2 - ;jump-to-coord JMP2 + DUP2 line-is-visible ?jump-to-coord/short + !jump-to-coord ( move the cursor to the given coordinates ) ( ) ( this will always ensure the display is centered on the given coordinates ) @jump-to-coord ( x* y* -> ) - .term/rows LDZ2 INC2 #0002 DIV2 LTH2k ( x y rows/2 ylines-rows? ) - ,&late JCN ( x y y-rows/2 lines-rows ) - POP2 ,&finish JMP + ?&late ( x y y-rows/2 lines-rows ) + POP2 !&finish &early ( x y rows/2 ) - POP2 #0000 ,&finish JMP ( x y 0000 ) + POP2 #0000 !&finish ( x y 0000 ) &late ( x y y-rows/2 lines-rows ) NIP2 &finish ( x y o ) - ;redraw-all JSR2 + redraw-all SUB2k STH2 DUP2 ( x y o o [y-o] ) .buffer/line-offset STZ2 ( x y o [y-o] ) - ;abs-line JSR2 .buffer/offset STZ2 ( x y [y-o] ) + abs-line .buffer/offset STZ2 ( x y [y-o] ) POP2r &short - ;redraw-statusbar-and-cursor JSR2 + redraw-statusbar-and-cursor .cursor/row STZ2 ( x ) .cursor/col STZ2 JMP2r ( jump to the given line number ) @jump-to-line ( n* -> ) - #0000 SWP2 ;jump-to-coord JMP2 + #0000 SWP2 !jump-to-coord ( ensure the cursor is visibe ) ( ) @@ -645,21 +645,21 @@ ( centered on the cursor's coordinates. ) @ensure-visible-cursor .cursor/row LDZ2 .buffer/line-offset LDZ2 - SUB2 .term/rows LDZ2 LTH2 ,&noop JCN - .cursor/row LDZ2 ;jump-to-line JSR2 - ;redraw-all JSR2 + SUB2 .term/rows LDZ2 LTH2 ?&noop + .cursor/row LDZ2 jump-to-line + redraw-all &noop JMP2r ( currently used to print stack information. ) @debug - ;messages/input-error ;error! JMP2 + ;messages/input-error !errorq ( move the terminal's cursor to the message line ) ( ) ( this low level method does not change any editor state (such as ) ( the cursor) but is used to display messages. ) @move-to-message-line ( -> ) - #0000 .term/rows LDZ2 #0002 ADD2 ;term-move-cursor JMP2 + #0000 .term/rows LDZ2 #0002 ADD2 !term-move-cursor ( start a prompt on the message line ) ( ) @@ -672,10 +672,10 @@ ( ) ( when called vector should end in a BRK instructinon. ) @start-prompt ( prompt* default* vector* -> ) - .prompt/active LDZ ,&is-active JCN + .prompt/active LDZ ?&is-active #01 .prompt/active STZ ( prompt/active <- 1 ) .prompt/vector STZ2 ( prompt/vector <- vector ) - ;tmp/data ;str-copy JSR2 ( tmp/data <- default ) + ;tmp/data str-copy ( tmp/data <- default ) ;tmp/data ADD2 .tmp/pos STZ2 ( tmp/pos <- len(default)+data ) .prompt/string STZ2 ( prompt/string <- prompt ) JMP2r @@ -686,24 +686,24 @@ @cancel-prompt ( -> ) #00 .prompt/active STZ #00 .state/quitting STZ - ;clear-message-line JSR2 - ;redraw-prompt-and-cursor JSR2 - ;return JMP2 + clear-message-line + redraw-prompt-and-cursor + !return ( finishes prompt and executes callback ) ( ) ( when called vector should end in a BRK instruction ) @finish-prompt ( -> ) #00 .prompt/active STZ - ;clear-message-line JSR2 - ;redraw-prompt-and-cursor JSR2 + clear-message-line + redraw-prompt-and-cursor .prompt/vector LDZ2 JMP2 ( begin saving the file, prompting the user for a fiel name ) @save - ;messages/save-prompt ;filename ;do-save ;start-prompt JSR2 - ;redraw-prompt-and-cursor JSR2 - ;return JMP2 + ;messages/save-prompt ;filename ;do-save start-prompt + redraw-prompt-and-cursor + !return ( save the file with the filename found in tmp/data ) @do-save ( -> ) @@ -712,57 +712,57 @@ STH2kr .File/length DEO2 ;data .File/write DEO2 - .File/success DEI2 STH2r EQU2 ,&ok JCN - ;messages/save-failed ,&finish JMP + .File/success DEI2 STH2r EQU2 ?&ok + ;messages/save-failed !&finish &ok #00 .state/modified STZ - ;tmp/data ;filename ;str-copy JSR2 POP2 + ;tmp/data ;filename str-copy POP2 ;messages/save-ok &finish - ;tmp/data ;send-message JSR2 - .state/quitting LDZ ;quit-now JCN2 + ;tmp/data send-message + .state/quitting LDZ ?quit-now #03 .state/redraw STZ ( FIXME: why do we have to do this? ) - ;return JMP2 + !return ( begin a search, prompting for a search string ) @search ( -> ) - ;messages/search-prompt ;messages/null ;do-search ;start-prompt JSR2 - ;redraw-prompt-and-cursor JSR2 - ;return JMP2 + ;messages/search-prompt ;messages/null ;do-search start-prompt + redraw-prompt-and-cursor + !return ( execute a search, using the given search string ) @do-search ( -> ) .cursor/row LDZ2 .searching/orig-row STZ2 .cursor/col LDZ2 .searching/orig-col STZ2 #0000 .searching/regex STZ2 - ;move-to-next-match JSR2 ,&found JCN - ;move-to-prev-match JSR2 ,&found JCN - ;messages/no-matches-found ;tmp/data ;send-message JSR2 BRK + move-to-next-match ?&found + move-to-prev-match ?&found + ;messages/no-matches-found ;tmp/data send-message BRK &found #01 .searching/active STZ - ;redraw-matches JSR2 - ;return JMP2 + redraw-matches + !return ( begin a search, prompting for a regular expression ) @regex-search ( -> ) - ;messages/regex-search-prompt ;messages/null ;do-regex-search ;start-prompt JSR2 - ;redraw-prompt-and-cursor JSR2 ;return JMP2 + ;messages/regex-search-prompt ;messages/null ;do-regex-search start-prompt + redraw-prompt-and-cursor !return ( execute a search, using the given regular expressions ) ( ) ( TODO: handle invalid regular expressions that fail to compile ) @do-regex-search ( -> ) - ;cur-pos JSR2 DUP2 .searching/start STZ2 .searching/end STZ2 + cur-pos DUP2 .searching/start STZ2 .searching/end STZ2 .cursor/row LDZ2 .searching/orig-row STZ2 .cursor/col LDZ2 .searching/orig-col STZ2 - ;tmp/data ;compile JSR2 .searching/regex STZ2 - ;move-to-next-regex-match JSR2 ,&found JCN - ;move-to-prev-regex-match JSR2 ,&found JCN - ;messages/no-matches-found ;tmp/data ;send-message JSR2 BRK + ;tmp/data compile .searching/regex STZ2 + move-to-next-regex-match ?&found + move-to-prev-regex-match ?&found + ;messages/no-matches-found ;tmp/data send-message BRK &found #01 .searching/active STZ - ;redraw-matches JSR2 - ;return JMP2 + redraw-matches + !return ( toggle the color used by the terminal ) ( ) @@ -776,11 +776,13 @@ ( - cyan ) ( - white ) @toggle-color ( -> ) - .config/color LDZ2 #3733 EQU2 ,&wrap-around JCN - .config/color LDZ2 #0100 ADD2 .config/color STZ2 - #3133 .config/red STZ2 ,&done JMP - &wrap-around #3033 DUP2 .config/color STZ2 .config/red STZ2 - &done ;redraw-all JSR2 ;return JMP2 + .config/color LDZ2 #3733 EQU2 ?{ + .config/color LDZ2 #0100 ADD2 DUP2 .config/color STZ2 + DUP2 #3733 LTH2 ?{ .config/red STZ2 !&done } + POP2 #3133 .config/red STZ2 !&done + } + #3033 DUP2 .config/color STZ2 .config/red STZ2 + &done redraw-all !return ( toggle whether to use literal tab characters ) ( ) @@ -788,7 +790,7 @@ ( characters are found, and 00 otherwise. ) @toggle-tabs ( -> ) .config/insert-tabs LDZk #00 EQU SWP STZ - ;redraw-statusbar-and-cursor JSR2 ;return JMP2 + redraw-statusbar-and-cursor !return ( interpret user input as an escaped sequence ) ( ) @@ -797,18 +799,18 @@ ( TODO: maybe M-% for search&replace ) @on-key-escaped ( -> ) #00 .state/saw-esc STZ - .state/key LDZ LIT "< EQU ( M-< ) ;goto-start JCN2 - .state/key LDZ LIT "> EQU ( M-> ) ;goto-end JCN2 - .state/key LDZ LIT "b EQU ( M-b ) ;back-by-word JCN2 - .state/key LDZ LIT "c EQU ( M-c ) ;toggle-color JCN2 - .state/key LDZ LIT "f EQU ( M-f ) ;forward-by-word JCN2 - .state/key LDZ LIT "g EQU ( M-g ) ;goto-line JCN2 - .state/key LDZ LIT "h EQU ( M-h ) ;help JCN2 - .state/key LDZ LIT "s EQU ( M-s ) ;regex-search JCN2 - .state/key LDZ LIT "t EQU ( M-t ) ;toggle-tabs JCN2 - .state/key LDZ LIT "u EQU ( M-u ) ;undo JCN2 - .state/key LDZ LIT "v EQU ( M-v ) ;page-up JCN2 - .state/key LDZ LIT "[ EQU ( M-[ ) ;xterm JCN2 + .state/key LDZ LIT "< EQU ( M-< ) ?goto-start + .state/key LDZ LIT "> EQU ( M-> ) ?goto-end + .state/key LDZ LIT "b EQU ( M-b ) ?back-by-word + .state/key LDZ LIT "c EQU ( M-c ) ?toggle-color + .state/key LDZ LIT "f EQU ( M-f ) ?forward-by-word + .state/key LDZ LIT "g EQU ( M-g ) ?goto-line + .state/key LDZ LIT "h EQU ( M-h ) ?help + .state/key LDZ LIT "s EQU ( M-s ) ?regex-search + .state/key LDZ LIT "t EQU ( M-t ) ?toggle-tabs + .state/key LDZ LIT "u EQU ( M-u ) ?undo + .state/key LDZ LIT "v EQU ( M-v ) ?page-up + .state/key LDZ LIT "[ EQU ( M-[ ) ?xterm BRK ( set our input to expect xterm control sequences ) @@ -829,25 +831,25 @@ ( the relevant action. ) @on-key-vt ( -> ) .state/saw-vt LDZk STH #00 SWP STZ - .state/key LDZ LIT "~ EQU ,&ok JCN + .state/key LDZ LIT "~ EQU ?&ok POPr BRK &ok - STHr DUP LIT "1 NEQ ,¬-1 JCN - ( ^[[1~ -> home ) POP ;bol JMP2 - ¬-1 DUP LIT "2 NEQ ,¬-2 JCN + STHr DUP LIT "1 NEQ ?¬-1 + ( ^[[1~ -> home ) POP !bol + ¬-1 DUP LIT "2 NEQ ?¬-2 ( ^[[2~ -> insert ) POP BRK - ¬-2 DUP LIT "3 NEQ ,¬-3 JCN - ( ^[[3~ -> delete ) POP ;delete JMP2 - ¬-3 DUP LIT "4 NEQ ,¬-4 JCN - ( ^[[4~ -> end ) POP ;eol JMP2 - ¬-4 DUP LIT "5 NEQ ,¬-5 JCN - ( ^[[5~ -> page up ) POP ;page-up JMP2 - ¬-5 DUP LIT "6 NEQ ,¬-6 JCN - ( ^[[6~ -> page down ) POP ;page-down JMP2 - ¬-6 DUP LIT "7 NEQ ,¬-7 JCN - ( ^[[7~ -> home ) POP ;bol JMP2 - ¬-7 DUP LIT "8 NEQ ,¬-8 JCN - ( ^[[8~ -> end ) POP ;eol JMP2 + ¬-2 DUP LIT "3 NEQ ?¬-3 + ( ^[[3~ -> delete ) POP !delete + ¬-3 DUP LIT "4 NEQ ?¬-4 + ( ^[[4~ -> end ) POP !eol + ¬-4 DUP LIT "5 NEQ ?¬-5 + ( ^[[5~ -> page up ) POP !page-up + ¬-5 DUP LIT "6 NEQ ?¬-6 + ( ^[[6~ -> page down ) POP !page-down + ¬-6 DUP LIT "7 NEQ ?¬-7 + ( ^[[7~ -> home ) POP !bol + ¬-7 DUP LIT "8 NEQ ?¬-8 + ( ^[[8~ -> end ) POP !eol ¬-8 ( ??? ) POP BRK @@ -859,14 +861,14 @@ ( to continue (or end) the sequence. ) @on-key-xterm ( -> ) #00 .state/saw-xterm STZ - .state/key LDZ LIT "A EQU ( ^[[A -> up ) ;up JCN2 - .state/key LDZ LIT "B EQU ( ^[[B -> down ) ;down JCN2 - .state/key LDZ LIT "C EQU ( ^[[C -> right ) ;forward JCN2 - .state/key LDZ LIT "D EQU ( ^[[D -> left ) ;back JCN2 - .state/key LDZ LIT "F EQU ( ^[[F -> end ) ;eol JCN2 - .state/key LDZ LIT "H EQU ( ^[[H -> home ) ;bol JCN2 - .state/key LDZ LIT "0 LTH ;ignore JCN2 - .state/key LDZ LIT "8 GTH ;ignore JCN2 + .state/key LDZ LIT "A EQU ( ^[[A -> up ) ?up + .state/key LDZ LIT "B EQU ( ^[[B -> down ) ?down + .state/key LDZ LIT "C EQU ( ^[[C -> right ) ?forward + .state/key LDZ LIT "D EQU ( ^[[D -> left ) ?back + .state/key LDZ LIT "F EQU ( ^[[F -> end ) ?eol + .state/key LDZ LIT "H EQU ( ^[[H -> home ) ?bol + .state/key LDZ LIT "0 LTH ?ignore + .state/key LDZ LIT "8 GTH ?ignore .state/key LDZ .state/saw-vt STZ ( ^[[1 through ^[[8 ) BRK @@ -878,9 +880,9 @@ ( ) ( if state/message is unset this is a no-op. ) @clear-message-line - .state/message LDZ #00 EQU ,&done JCN - ;move-to-message-line JSR2 - ;term-erase-line JSR2 + .state/message LDZ #00 EQU ?&done + move-to-message-line + term-erase-line #00 .state/message STZ &done JMP2r @@ -889,9 +891,9 @@ ( this method unsets searching/active and also restores ) ( the original cursor position. ) @cancel-search - .searching/orig-row LDZ2 ;jump-to-line JSR2 + .searching/orig-row LDZ2 jump-to-line .searching/orig-col LDZ2 .cursor/col STZ2 - ,finish-search JMP + !finish-search ( cancel the active search ) ( ) @@ -899,7 +901,7 @@ ( this leaves the cursor where it is. ) @finish-search #00 .searching/active STZ - ;reset-arena JSR2 ;redraw-all JSR2 ;return JMP2 + reset-arena redraw-all !return ( TODO: i haven't decided how to solve the problem of ) ( overlapping matches yet. i don't really want to maintain ) @@ -917,34 +919,34 @@ ( moves the cursor forward to the next match. if there are no ) ( further matches the cursor does not move. ) @jump-to-next-match ( -> ) - .searching/regex LDZ2 ORA ,&is-regex JCN - ;move-to-next-match JSR2 POP ;return JMP2 + .searching/regex LDZ2 ORA ?&is-regex + move-to-next-match POP !return &is-regex - ;move-to-next-regex-match JSR2 POP ;return JMP2 + move-to-next-regex-match POP !return ( jump backward to the previous match, if any. ) ( ) ( moves the cursor backward to the previous match. if there are ) ( no further matches the cursor does not move. ) @jump-to-prev-match ( -> ) - .searching/regex LDZ2 ORA ,&is-regex JCN - ;move-to-prev-match JSR2 POP ;return JMP2 + .searching/regex LDZ2 ORA ?&is-regex + move-to-prev-match POP !return &is-regex - ;move-to-prev-regex-match JSR2 POP ;return JMP2 + move-to-prev-regex-match POP !return ( move to the next substring match. ) ( ) ( called by ;jump-to-next-match. ) @move-to-next-match ( -> ok^ ) .buffer/limit LDZ2 - ;cur-pos JSR2 INC2 + cur-pos INC2 &loop - GTH2k #00 EQU ,&fail JCN - DUP2 ;matches-at JSR2 - ORA ,&found JCN - INC2 ,&loop JMP + GTH2k #00 EQU ?&fail + DUP2 matches-at + ORA ?&found + INC2 !&loop &found - NIP2 ;jump-to-pos JSR2 #01 JMP2r + NIP2 jump-to-pos #01 JMP2r &fail POP2 POP2 #00 JMP2r @@ -953,14 +955,14 @@ ( called by ;jump-to-prev-match. ) @move-to-prev-match ( -> ok^ ) ;data - ;cur-pos JSR2 #0001 SUB2 + cur-pos #0001 SUB2 &loop - GTH2k ,&fail JCN - DUP2 ;matches-at JSR2 - ORA ,&found JCN - #0001 SUB2 ,&loop JMP + GTH2k ?&fail + DUP2 matches-at + ORA ?&found + #0001 SUB2 !&loop &found - NIP2 ;jump-to-pos JSR2 #01 JMP2r + NIP2 jump-to-pos #01 JMP2r &fail POP2 POP2 #00 JMP2r @@ -969,15 +971,15 @@ ( called by ;jump-to-next-match. ) @move-to-next-regex-match ( -> ok^ ) .searching/end LDZ2 .buffer/limit LDZ2 OVR2 - GTH2 ,&ok JCN + GTH2 ?&ok POP2 #00 JMP2r &ok - .searching/regex LDZ2 ;rx-search JSR2 ,&found JCN + .searching/regex LDZ2 rx-search ?&found #00 JMP2r &found ;search-end LDA2 .searching/end STZ2 ;search-start LDA2 DUP2 .searching/start STZ2 - ;jump-to-pos JSR2 #01 JMP2r + jump-to-pos #01 JMP2r ( move to the previous substring match. ) ( ) @@ -993,19 +995,19 @@ ( and then taking the last match before the cursor works. ) @move-to-prev-regex-match ( -> ok^ ) LITr 00 - ;cur-pos JSR2 ;data ( limit pos [res] ) + cur-pos ;data ( limit pos [res] ) &loop ( limit pos [res] ) - GTH2k #00 EQU ,&done JCN ( limit pos ) - DUP2 .searching/regex LDZ2 ;rx-search JSR2 ( limit pos match? ) - #00 EQU ,&done JCN ( limit pos ) - OVR2 ;search-end LDA2 LTH2 ,&done JCN + GTH2k #00 EQU ?&done ( limit pos ) + DUP2 .searching/regex LDZ2 rx-search ( limit pos match? ) + #00 EQU ?&done ( limit pos ) + OVR2 ;search-end LDA2 LTH2 ?&done POP2 POPr LITr 01 ;search-start LDA2 .searching/start STZ2 ;search-end LDA2 DUP2 .searching/end STZ2 - ,&loop JMP + !&loop &done - POP2 POP2 STHr DUP #00 EQU ,&fail JCN - .searching/start LDZ2 ;jump-to-pos JSR2 + POP2 POP2 STHr DUP #00 EQU ?&fail + .searching/start LDZ2 jump-to-pos &fail JMP2r @@ -1017,14 +1019,14 @@ ( - end the search leaving the cursor where it is (enter) ) ( - cancel the search restoring the cursor (C-g) ) @on-key-searching - .state/key LDZ #07 EQU ( C-g ) ;cancel-search JCN2 - .state/key LDZ #08 EQU ( C-h ) ;help JCN2 - .state/key LDZ #0d EQU ( \r ) ;finish-search JCN2 - .state/key LDZ #12 EQU ( C-r ) ;jump-to-prev-match JCN2 - .state/key LDZ #13 EQU ( C-s ) ;jump-to-next-match JCN2 - .state/key LDZ #6e EQU ( n ) ;jump-to-next-match JCN2 - .state/key LDZ #70 EQU ( p ) ;jump-to-prev-match JCN2 - ;ignore JMP2 + .state/key LDZ #07 EQU ( C-g ) ?cancel-search + .state/key LDZ #08 EQU ( C-h ) ?help + .state/key LDZ #0d EQU ( \r ) ?finish-search + .state/key LDZ #12 EQU ( C-r ) ?jump-to-prev-match + .state/key LDZ #13 EQU ( C-s ) ?jump-to-next-match + .state/key LDZ #6e EQU ( n ) ?jump-to-next-match + .state/key LDZ #70 EQU ( p ) ?jump-to-prev-match + !ignore ( on-key event handler to use when prompt is active ) ( ) @@ -1040,13 +1042,13 @@ ( C-a, C-d, etc. however, it's enough extra work to enable ) ( this that for now i haven't done it. ) @on-key-prompt - .state/key LDZ #07 EQU ( C-g ) ;cancel-prompt JCN2 - .state/key LDZ #08 EQU ( C-h ) ;help JCN2 - .state/key LDZ #0d EQU ( \r ) ;finish-prompt JCN2 - .state/key LDZ #7f EQU ( DEL ) ;backspace-prompt JCN2 - .state/key LDZ #20 LTH ;ignore JCN2 ( ignore for now ) - .state/key LDZ #7e GTH ;ignore JCN2 ( ignore for now ) - .state/key LDZ ( printable ASCII ) ;insert-prompt JMP2 + .state/key LDZ #07 EQU ( C-g ) ?cancel-prompt + .state/key LDZ #08 EQU ( C-h ) ?help + .state/key LDZ #0d EQU ( \r ) ?finish-prompt + .state/key LDZ #7f EQU ( DEL ) ?backspace-prompt + .state/key LDZ #20 LTH ?ignore ( ignore for now ) + .state/key LDZ #7e GTH ?ignore ( ignore for now ) + .state/key LDZ ( printable ASCII ) !insert-prompt BRK ( on-key event handler ) @@ -1065,34 +1067,34 @@ @on-key #00 .state/in-undo STZ .Console/read DEI .state/key STZ - ;clear-message-line JSR2 - .state/in-help LDZ #00 .state/in-help STZ ;return JCN2 - .searching/active LDZ ;on-key-searching JCN2 - .prompt/active LDZ ;on-key-prompt JCN2 - .state/saw-vt LDZ ;on-key-vt JCN2 - .state/saw-xterm LDZ ;on-key-xterm JCN2 - .state/saw-esc LDZ ;on-key-escaped JCN2 - .state/key LDZ #01 EQU ( C-a ) ;bol JCN2 - .state/key LDZ #02 EQU ( C-b ) ;back JCN2 - .state/key LDZ #04 EQU ( C-d ) ;delete JCN2 - .state/key LDZ #05 EQU ( C-e ) ;eol JCN2 - .state/key LDZ #06 EQU ( C-f ) ;forward JCN2 - .state/key LDZ #08 EQU ( C-h ) ;help JCN2 - .state/key LDZ #09 EQU ( \t ) ;insert-tab JCN2 - .state/key LDZ #0c EQU ( C-l ) ;center-view JCN2 - .state/key LDZ #0d EQU ( \r ) ;newline JCN2 - .state/key LDZ #0e EQU ( C-n ) ;down JCN2 - .state/key LDZ #0f EQU ( C-o ) ;save JCN2 - .state/key LDZ #10 EQU ( C-p ) ;up JCN2 - .state/key LDZ #13 EQU ( C-s ) ;search JCN2 - .state/key LDZ #16 EQU ( C-v ) ;page-down JCN2 - .state/key LDZ #18 EQU ( C-x ) ;quit JCN2 - .state/key LDZ #1a EQU ( C-z ) ;debug JCN2 - .state/key LDZ #1b EQU ( ESC ) ;escape JCN2 - .state/key LDZ #7f EQU ( DEL ) ;backspace JCN2 - .state/key LDZ #20 LTH ;ignore JCN2 ( ignore for now ) - .state/key LDZ #7e GTH ;ignore JCN2 ( ignore for now ) - .state/key LDZ ( printable ASCII ) ;insert JMP2 + clear-message-line + .state/in-help LDZ #00 .state/in-help STZ ?return + .searching/active LDZ ?on-key-searching + .prompt/active LDZ ?on-key-prompt + .state/saw-vt LDZ ?on-key-vt + .state/saw-xterm LDZ ?on-key-xterm + .state/saw-esc LDZ ?on-key-escaped + .state/key LDZ #01 EQU ( C-a ) ?bol + .state/key LDZ #02 EQU ( C-b ) ?back + .state/key LDZ #04 EQU ( C-d ) ?delete + .state/key LDZ #05 EQU ( C-e ) ?eol + .state/key LDZ #06 EQU ( C-f ) ?forward + .state/key LDZ #08 EQU ( C-h ) ?help + .state/key LDZ #09 EQU ( \t ) ?insert-tab + .state/key LDZ #0c EQU ( C-l ) ?center-view + .state/key LDZ #0d EQU ( \r ) ?newline + .state/key LDZ #0e EQU ( C-n ) ?down + .state/key LDZ #0f EQU ( C-o ) ?save + .state/key LDZ #10 EQU ( C-p ) ?up + .state/key LDZ #13 EQU ( C-s ) ?search + .state/key LDZ #16 EQU ( C-v ) ?page-down + .state/key LDZ #18 EQU ( C-x ) ?quit + .state/key LDZ #1a EQU ( C-z ) ?debug + .state/key LDZ #1b EQU ( ESC ) ?escape + .state/key LDZ #7f EQU ( DEL ) ?backspace + .state/key LDZ #20 LTH ?ignore ( ignore for now ) + .state/key LDZ #7e GTH ?ignore ( ignore for now ) + .state/key LDZ ( printable ASCII ) !insert ( return the smaller of two short values ) @min2 ( x* y* -> min* ) @@ -1111,90 +1113,90 @@ ( ) ( these don't perform a redraw right away, but instead ) ( signal that the next drawing should include that part. ) -@redraw-cursor ( -> ) #01 ,redraw-add JMP -@redraw-statusbar-and-cursor ( -> ) #03 ,redraw-add JMP -@redraw-prompt-and-cursor ( -> ) #05 ,redraw-add JMP -@redraw-matches ( -> ) #08 ,redraw-add JMP -@redraw-all ( -> ) #1f ,redraw-add JMP +@redraw-cursor ( -> ) #01 !redraw-add +@redraw-statusbar-and-cursor ( -> ) #03 !redraw-add +@redraw-prompt-and-cursor ( -> ) #05 !redraw-add +@redraw-matches ( -> ) #08 !redraw-add +@redraw-all ( -> ) #1f !redraw-add ( draw the current cursor location ) @draw-cursor ( -> ) .prompt/active LDZ #00 EQU JMP JMP2r ( TODO: handle long lines ) - ;cur-w-col JSR2 lmargin ADD2 + cur-w-col lmargin ADD2 .cursor/row LDZ2 .buffer/line-offset LDZ2 SUB2 - ;term-move-cursor JMP2 + !term-move-cursor ( current column in terms of display width ) ( ) ( this is different than ;cur-col due to tabs ) @cur-w-col ( -> col* ) LIT2r 0000 ( [0] ) - ;cur-line JSR2 DUP2 ;cur-col JSR2 ADD2 SWP2 ( lim s [0] ) - &loop GTH2k ,&next JCN + cur-line DUP2 cur-col ADD2 SWP2 ( lim s [0] ) + &loop GTH2k ?&next POP2 POP2 STH2r JMP2r - &next LDAk #09 EQU ,&tabs JCN INC2 INC2r ,&loop JMP - &tabs INC2 .config/tab-width LDZ2 STH2 ADD2r ,&loop JMP + &next LDAk #09 EQU ?&tabs INC2 INC2r !&loop + &tabs INC2 .config/tab-width LDZ2 STH2 ADD2r !&loop ( move the terminal cursor to the statusbar line ) @move-to-statusbar ( -> ) - #0000 .term/rows LDZ2 ;term-move-cursor JMP2 + #0000 .term/rows LDZ2 !term-move-cursor ( draw the full statusbar ) @draw-statusbar ( -> ) - ;move-to-statusbar JSR2 - ;emit-color-reverse JSR2 + move-to-statusbar + emit-color-reverse LIT2r 2018 .term/cols LDZ2 #0001 ( cols i [2018] ) - &loop LTH2k ,&done JCN DEOkr INC2 ,&loop JMP + &loop LTH2k ?&done DEOkr INC2 !&loop &done POP2 POP2 POP2r ( ) - ;move-to-statusbar JSR2 + move-to-statusbar ( display ** if the buffer has unsaved changes, -- otherwise ) #2d .state/modified LDZ #00 NEQ #03 MUL SUB DUP emit emit sp - ;filename ;print JSR2 + ;filename print sp emit-[ - .buffer/limit LDZ2 ;data SUB2 ;emit-dec2 JSR2 - ;messages/bytes ;print JSR2 + .buffer/limit LDZ2 ;data SUB2 emit-dec2 + ;messages/bytes print sp - .buffer/line-count LDZ2 ;emit-dec2 JSR2 - ;messages/lines ;print JSR2 + .buffer/line-count LDZ2 emit-dec2 + ;messages/lines print sp emit-lpar - ;cur-col JSR2 INC2 ;emit-dec2 JSR2 + cur-col INC2 emit-dec2 emit-, - .cursor/row LDZ2 INC2 ;emit-dec2 JSR2 + .cursor/row LDZ2 INC2 emit-dec2 emit-rpar sp emit-[ LIT "s .config/insert-tabs LDZ ADD emit emit-] sp - ;messages/help-msg ;print JSR2 - ;emit-reset JMP2 + ;messages/help-msg print + !emit-reset @draw-prompt ( -> ) - ;clear-message-line JSR2 - .prompt/active LDZ ,&is-active JCN + clear-message-line + .prompt/active LDZ ?&is-active JMP2r &is-active #01 .state/message STZ - ;move-to-message-line JSR2 - ;emit-color-bold JSR2 - .prompt/string LDZ2 ;print JSR2 - ;emit-reset JSR2 - ;tmp/data ;print JSR2 + move-to-message-line + emit-color-bold + .prompt/string LDZ2 print + emit-reset + ;tmp/data print JMP2r @draw-linenum ( n* -> ) - ;emit-reset JSR2 - ;emit-color JSR2 - ;emit-dec2-pad JSR2 sp - ;emit-reset JMP2 + emit-reset + emit-color + emit-dec2-pad sp + !emit-reset @matches-at ( s* -> limit* ) LIT2r :tmp/data - &loop LDAkr STHr #00 EQU ,&done JCN - LDAk LDAkr STHr NEQ ,&fail JCN - INC2 INC2r ,&loop JMP + &loop LDAkr STHr #00 EQU ?&done + LDAk LDAkr STHr NEQ ?&fail + INC2 INC2r !&loop &fail POP2 #0000 &done POP2r JMP2r @@ -1202,93 +1204,93 @@ @draw-region ( offset* limit* col* row* -> ) OVR2 ( offset limit col row col ) .term/cols LDZ2 SWP2 SUB2 STH2 ( offset limit col row [cols-col] ) - ;term-move-cursor JSR2 ( offset limit [cols-col] ) + term-move-cursor ( offset limit [cols-col] ) OVR2 STH2r ADD2 ( offset limit offset+cols-col ) - ;min2 JSR2 STH2 ( offset [cutoff] ) + min2 STH2 ( offset [cutoff] ) &loop ( i [cutoff] ) - DUP2 STH2kr LTH2 #00 EQU ,&done JCN - LDAk #00 EQU ,&done JCN - LDAk #18 DEO INC2 ,&loop JMP + DUP2 STH2kr LTH2 #00 EQU ?&done + LDAk #00 EQU ?&done + LDAk #18 DEO INC2 !&loop &done POP2 POP2r JMP2r @screen-limit ( -> sc-limit* ) .term/rows LDZ2 .buffer/line-offset LDZ2 ADD2 ( row0+rows ) - DUP2 .buffer/line-count LDZ2 LTH2 ,¬-end JCN + DUP2 .buffer/line-count LDZ2 LTH2 ?¬-end POP2 .buffer/limit LDZ2 JMP2r ¬-end - ;abs-line JMP2 + !abs-line @draw-regex-matches ( -> ) - ;emit-color-reverse-bold JSR2 ( ) - ;screen-limit JSR2 .buffer/offset LDZ2 ( limit pos ) + emit-color-reverse-bold ( ) + screen-limit .buffer/offset LDZ2 ( limit pos ) &loop ( limit pos ) GTH2k #00 EQU ( limit pos limit>pos=0? ) - ,&done JCN ( limit pos ) + ?&done ( limit pos ) DUP2 .searching/regex LDZ2 ( limit pos pos rx ) - ;rx-search JSR2 #00 EQU ( limit pos found=0? ) - ,&done JCN ( limit pos ) + rx-search #00 EQU ( limit pos found=0? ) + ?&done ( limit pos ) POP2 ;search-start LDA2 ( limit start ) GTH2k #00 EQU ( limit start limit>start=0? ) - ,&done JCN ( limit start ) + ?&done ( limit start ) ;search-end LDA2 OVR2 ( limit start end start ) - ;pos-to-row-col JSR2 ( limit start end row col ) + pos-to-row-col ( limit start end row col ) lmargin ADD2 ( limit start end row col+lm ) SWP2 .buffer/line-offset LDZ2 SUB2 ( limit start end col+lm row-lo ) - ;draw-region JSR2 ( limit ) - ;search-end LDA2 ( limit end ) ,&loop JMP + draw-region ( limit ) + ;search-end LDA2 ( limit end ) !&loop &done ( limit pos ) POP2 POP2 JMP2r @draw-matches ( -> ) ( return if not searching ) - .searching/active LDZ #00 EQU ,&return JCN ( ) - .searching/regex LDZ2 ORA ;draw-regex-matches JCN2 - ;emit-color-reverse-bold JSR2 + .searching/active LDZ #00 EQU ?&return ( ) + .searching/regex LDZ2 ORA ?draw-regex-matches + emit-color-reverse-bold lmargin ,&x STR2 #0000 ,&y STR2 ( x <- 0, y <- 0 ) .buffer/offset LDZ2 DUP2 - ;screen-limit JSR2 SUB2 STH2 ( offset [-count] ) + screen-limit SUB2 STH2 ( offset [-count] ) &loop ( offset [-count] ) - STH2kr #0000 EQU2 ,&done JCN - DUP2 ;matches-at JSR2 ( offset mlim [-count] ) - DUP2 ORA ,&found JCN + STH2kr #0000 EQU2 ?&done + DUP2 matches-at ( offset mlim [-count] ) + DUP2 ORA ?&found POP2 ( offset [-count] ) - LDAk #0a EQU ,&newline JCN - ,&count-tabs JSR - #0001 ,&next JMP ( offset n [-count] ) + LDAk #0a EQU ?&newline + draw-matches/count-tabs + #0001 !&next ( offset n [-count] ) &found ( offset mlim [-count] ) STH2k ( offset mlim [mlim -count] ) OVR2 SWP2 ,&x LDR2 ,&y LDR2 ( offset offset mlim x y [mlim -count] ) - ;draw-region JSR2 ( offset [mlim -count] ) + draw-region ( offset [mlim -count] ) STH2r ( offset mlim [-count] ) OVR2 SUB2 ( offset mlim-offset [-count] ) &next ( offset n [-count] ) DUP2 ,&x LDR2 ADD2 ,&x STR2 ( offset n [-count ) STH2k ( offset n [n -count] ) ADD2 ADD2r ( offset+n [n-count] ) - ,&loop JMP + !&loop &newline ( offset [-count] ) lmargin ,&x STR2 ,&y LDR2 INC2 ,&y STR2 INC2 INC2r - ,&loop JMP + !&loop &done POP2 POP2r - ;emit-reset JSR2 + emit-reset &return JMP2r [ &x $2 &y $2 ] &count-tabs ( offset -> offset ) - LDAk #09 NEQ ,&count-tabs/done JCN + LDAk #09 NEQ ?&count-tabs/done ,&x LDR2 .config/tab-adjust LDZ2 ADD2 ,&x STR2 &count-tabs/done JMP2r @emit-tab ( -> ) #0000 .config/tab-width LDZ2 SUB2 LIT2r 2018 - &loop ORAk ,&next JCN POP2 POP2r JMP2r - &next DEOkr INC2 ,&loop JMP + &loop ORAk ?&next POP2 POP2r JMP2r + &next DEOkr INC2 !&loop ( ANSI terminal notes ) @@ -1304,171 +1306,171 @@ ( ANSI control sequence to move the cursor to the given coord ) ( ESC [ $row ; $col H ) @term-move-cursor ( col* row* -> ) - ansi INC2 ( row+1 ) ;emit-dec2 JSR2 - emit-; INC2 ( col+1 ) ;emit-dec2 JSR2 + ansi INC2 ( row+1 ) emit-dec2 + emit-; INC2 ( col+1 ) emit-dec2 emit-H JMP2r ( ANSI control sequence to move N positions right ) ( ESC [ $n C ) @term-move-right ( n* -> ) - ansi ;emit-dec2 JSR2 emit-C JMP2r + ansi emit-dec2 emit-C JMP2r ( ANSI control sequence to get the cursor position ) ( ESC [ 6 n ) @term-get-cursor-position ( -> ) - LIT2 00 "n LIT "6 ,ansi-emit JMP + LIT2 00 "n LIT "6 !ansi-emit ( ANSI control sequence to erase entire screen ) ( ESC [ 2 J ) @term-erase-all ( -> ) - LIT2 00 "J LIT "2 ,ansi-emit JMP + LIT2 00 "J LIT "2 !ansi-emit ( ANSI control sequence to erase the current line ) ( ESC [ 2 K ) @term-erase-line ( -> ) - LIT2 00 "K LIT "2 ,ansi-emit JMP + LIT2 00 "K LIT "2 !ansi-emit @ansi-emit ( 00 cn ... c1 c0 -> ) LITr 18 ( Console/write ) #5b1b STHkr DEO STHkr DEO ( ESC [ ) - &loop DUP ,&next JCN POP POPr JMP2r - &next STHkr DEO ,&loop JMP + &loop DUP ?&next POP POPr JMP2r + &next STHkr DEO !&loop ( ESC [ 3 1 m ) @emit-red ( -> ) - LIT2 00 "m .config/red LDZ2 ,ansi-emit JMP + LIT2 00 "m .config/red LDZ2 !ansi-emit ( ESC [ 0 m ) @emit-reset ( -> ) - #00 LIT2 "m "0 ,ansi-emit JMP + #00 LIT2 "m "0 !ansi-emit ( ESC [ 1 m $ ESC [ 0 m ) @emit-red-dollar ( -> ) - ,emit-red JSR emit-$ ,emit-reset JMP + emit-red emit-$ !emit-reset ( ESC [ 3 $x ; 7 m ) ( $x is 0-7 ) @emit-color-reverse ( -> ) - LIT2 00 "m LIT2 "7 "; .config/color LDZ2 ,ansi-emit JMP + LIT2 00 "m LIT2 "7 "; .config/color LDZ2 !ansi-emit @emit-color ( -> ) - LIT2 00 "m .config/color LDZ2 ,ansi-emit JMP + LIT2 00 "m .config/color LDZ2 !ansi-emit ( ESC [ 3 $x ; 1 m ) ( $x is 0-7 ) @emit-color-bold ( -> ) - LIT2 00 "m LIT2 "1 "; .config/color LDZ2 ,ansi-emit JMP + LIT2 00 "m LIT2 "1 "; .config/color LDZ2 !ansi-emit ( ESC [ 3 $x ; 1 ; 7 m ) ( $x is 0-7 ) @emit-color-reverse-bold ( -> ) - LIT2 00 "m LIT2 "7 "; LIT2 "1 "; .config/color LDZ2 ,ansi-emit JMP + LIT2 00 "m LIT2 "7 "; LIT2 "1 "; .config/color LDZ2 !ansi-emit @draw-all ( -> ) - ;term-erase-all JSR2 - #0000 #0000 ;term-move-cursor JSR2 + term-erase-all + #0000 #0000 term-move-cursor .buffer/line-offset LDZ2 STH2 LIT2r 0001 ( [k line-offset] ) .buffer/offset LDZ2 &bol - ADD2kr STH2r ;draw-linenum JSR2 + ADD2kr STH2r draw-linenum lmargin INC2 ,&x STR2 &loop ( offset [k line-offset] ) - LDAk #00 EQU ,&eof JCN - LDAk #0a EQU ,&eol JCN + LDAk #00 EQU ?&eof + LDAk #0a EQU ?&eol ,&x LDR2 .term/cols LDZ2 - LTH2k ,&ok JCN - GTH2 ,&skip JCN - ;emit-red-dollar JSR2 ,&x LDR2 INC2 ,&x STR2 + LTH2k ?&ok + GTH2 ?&skip + emit-red-dollar ,&x LDR2 INC2 ,&x STR2 &skip INC2 - ,&loop JMP + !&loop &ok POP2 POP2 - LDAk #09 EQU ,&do-tab JCN + LDAk #09 EQU ?&do-tab LDAk emit INC2 ,&x LDR2 INC2 ,&x STR2 - ,&loop JMP + !&loop &eol INC2r - STH2kr .term/rows LDZ2 GTH2 ,&done JCN - crlf INC2 ,&bol JMP - &do-tab ;emit-tab JSR2 INC2 + STH2kr .term/rows LDZ2 GTH2 ?&done + crlf INC2 !&bol + &do-tab emit-tab INC2 .config/tab-width LDZ2 ,&x LDR2 ADD2 ,&x STR2 - ,&loop JMP + !&loop [ &x $2 ] &eof - ;emit-red JSR2 + emit-red &eof-loop - STH2kr .term/rows LDZ2 GTH2 ,&done JCN + STH2kr .term/rows LDZ2 GTH2 ?&done crlf - lmargin ;term-move-right JSR2 + lmargin term-move-right emit-~ INC2r - ,&eof-loop JMP + !&eof-loop &done POP2 POP2r POP2r - ;emit-reset JSR2 - ;draw-matches JSR2 - ;draw-statusbar JSR2 - ;draw-prompt JSR2 - ;draw-cursor JMP2 + emit-reset + draw-matches + draw-statusbar + draw-prompt + !draw-cursor ( handler completion code to do necessary drawing and BRK ) @return ( -> ) .state/redraw LDZ - DUP #10 AND ,&draw-all JCN - DUP #08 AND ,&do-8 JCN ,&skip-8 JMP &do-8 ;draw-matches JSR2 - &skip-8 DUP #04 AND ,&do-4 JCN ,&skip-4 JMP &do-4 ;draw-prompt JSR2 - &skip-4 DUP #02 AND ,&do-2 JCN ,&skip-2 JMP &do-2 ;draw-statusbar JSR2 - &skip-2 DUP #01 AND ,&do-1 JCN ,&finish JMP &do-1 ;draw-cursor JSR2 ,&finish JMP - &draw-all ;draw-all JSR2 + DUP #10 AND ?&draw-all + DUP #08 AND ?&do-8 !&skip-8 &do-8 draw-matches + &skip-8 DUP #04 AND ?&do-4 !&skip-4 &do-4 draw-prompt + &skip-4 DUP #02 AND ?&do-2 !&skip-2 &do-2 draw-statusbar + &skip-2 DUP #01 AND ?&do-1 !&finish &do-1 draw-cursor !&finish + &draw-all draw-all &finish POP #00 .state/redraw STZ BRK @str-copy ( src* dst* -> len* ) STH2 DUP2 ( src src [dst] ) - &loop LDAk #00 EQU ,&done JCN + &loop LDAk #00 EQU ?&done LDAk STH2kr STA - INC2 INC2r ,&loop JMP + INC2 INC2r !&loop &done ( src src+n [dst+n] ) SWP2 SUB2 #00 STH2r STA JMP2r @print ( s* -> ) - &loop LDAk #00 EQU ,&eof JCN - LDAk #18 DEO INC2 ,&loop JMP + &loop LDAk #00 EQU ?&eof + LDAk #18 DEO INC2 !&loop &eof POP2 JMP2r @cur-len ( -> n* ) - ;cur-line JSR2 ;line-len JMP2 + cur-line !line-len @line-len ( s* -> n* ) #0000 STH2 - &loop LDAk #00 EQU ,&end JCN - LDAk #0a EQU ,&end JCN - INC2 INC2r ,&loop JMP + &loop LDAk #00 EQU ?&end + LDAk #0a EQU ?&end + INC2 INC2r !&loop &end POP2 STH2r JMP2r @line-is-visible ( n* -> bool^ ) - .buffer/line-offset LDZ2 LTH2k ,&no JCN + .buffer/line-offset LDZ2 LTH2k ?&no .term/rows LDZ2 ADD2 LTH2 JMP2r &no POP2 POP2 #00 JMP2r @jump-to-pos ( s* -> ) - ;pos-to-row-col JSR2 SWP2 ;move-to-coord JMP2 + pos-to-row-col SWP2 !move-to-coord @pos-to-row-col ( s* -> row* col* ) #0000 ,&row STR2 #0000 ,&col STR2 ;data &loop ( s pos ) - GTH2k #00 EQU ,&done JCN - LDAk #0a EQU ,&newline JCN - LDAk #09 EQU ,&tab JCN + GTH2k #00 EQU ?&done + LDAk #0a EQU ?&newline + LDAk #09 EQU ?&tab #0001 &inc ,&col LDR2 ADD2 ,&col STR2 - INC2 ,&loop JMP + INC2 !&loop &newline #0000 ,&col STR2 ,&row LDR2 INC2 ,&row STR2 - INC2 ,&loop JMP + INC2 !&loop &tab - .config/tab-width LDZ2 ,&inc JMP + .config/tab-width LDZ2 !&inc &done POP2 POP2 ,&row LDR2 ,&col LDR2 JMP2r @@ -1478,47 +1480,47 @@ @line-to-pos ( addr* y* -> s* ) #0000 SWP2 SUB2 STH2 ( addr [-y] ) &newline ( addr [-y] ) - STH2kr ORA ,&loop JCN ,&done JMP + STH2kr ORA ?&loop !&done &loop ( addr [-y] ) - LDAk #00 EQU ,¬-found JCN ( addr [-y] ) - LDAk #0a EQU ,&found JCN ( addr [-y] ) - INC2 ,&loop JMP ( addr+1 [-y] ) - &found INC2 INC2r ,&newline JMP + LDAk #00 EQU ?¬-found ( addr [-y] ) + LDAk #0a EQU ?&found ( addr [-y] ) + INC2 !&loop ( addr+1 [-y] ) + &found INC2 INC2r !&newline &done POP2r JMP2r ¬-found POP2 POP2r #0000 JMP2r ( find string pointer for absolute y coordinate ) @abs-line ( y* -> s* ) - ;data SWP2 ;line-to-pos JMP2 + ;data SWP2 !line-to-pos ( return a pointer to the current line ) @cur-line ( -> s* ) - .cursor/row LDZ2 .buffer/line-offset LDZ2 LTH2k ,&early JCN + .cursor/row LDZ2 .buffer/line-offset LDZ2 LTH2k ?&early ( if cursor/row is later than line-offset ) ( we can save some time by starting at ) ( buffer/offset instead of the beginning ) - SUB2 .buffer/offset LDZ2 SWP2 ;line-to-pos JMP2 + SUB2 .buffer/offset LDZ2 SWP2 !line-to-pos &early ( if cursor/row is earlier than line-offset ) ( we need to use the absolute y coordinate ) - POP2 ;abs-line JMP2 + POP2 !abs-line ( return a pointer to the current cursor position ) @cur-pos ( -> s* ) - ;cur-line JSR2 ;cur-col JSR2 ADD2 JMP2r + cur-line cur-col ADD2 JMP2r ( insert one character at the cursor position ) @shift-right ( c^ addr* -> ) #01 .state/modified STZ ROT STH ( addr [prev^] ) - ;last-pos JSR2 SWP2 ( last addr [prev^] ) - .state/in-undo LDZ ,&loop JCN - STH2k #00 STH2r ;u-push JSR2 - &loop LTH2k ,&done JCN ( last addr [prev^] ) + last-pos SWP2 ( last addr [prev^] ) + .state/in-undo LDZ ?&loop + STH2k #00 STH2r u-push + &loop LTH2k ?&done ( last addr [prev^] ) LDAk STH SWPr ( last addr [prev^ curr^] ) DUP2 STHr ( last addr addr prev^ [curr^] ) ROT ROT STA ( last addr [curr^] ) - INC2 ,&loop JMP ( last addr+1 [curr^] ) + INC2 !&loop ( last addr+1 [curr^] ) &done NIP2 DUP2 ( addr addr [prev^] ) STHr ROT ROT ( addr prev^ addr ) STA INC2 ( addr+1 ) @@ -1530,15 +1532,15 @@ ( TODO: change last/addr order and GTH -> LTH to remove hack ) @shift-left ( addr* -> ) #01 .state/modified STZ - ;last-pos JSR2 SWP2 ( last addr ) - .state/in-undo LDZ ,&loop JCN - STH2k ;cur-pos JSR2 LDA STH2r ;u-push JSR2 - &loop GTH2k ,&next JCN ( last addr ) - ,&done JMP ( last addr ) + last-pos SWP2 ( last addr ) + .state/in-undo LDZ ?&loop + STH2k cur-pos LDA STH2r u-push + &loop GTH2k ?&next ( last addr ) + !&done ( last addr ) &next DUP2 INC2 LDAk ( last addr addr+1 c1^ ) STH SWP2 STHr ( last addr+1 addr c1^ ) ROT ROT ( last addr+1 c1^ addr ) - STA ,&loop JMP ( last addr+1 ) + STA !&loop ( last addr+1 ) &done POP2 ( last ) .buffer/limit STZ2 ( ) #00 .buffer/limit LDZ2 STA ( ensure null termination ) @@ -1546,7 +1548,7 @@ ( current column in terms of bytes in buffer ) @cur-col ( -> col* ) - .cursor/col LDZ2 ;cur-len JSR2 ;min2 JMP2 + .cursor/col LDZ2 cur-len !min2 ( jump to the first line in the buffer ) @zero-row ( -> ) @@ -1564,11 +1566,11 @@ LITr 00 ( n [0] ) &read ( n [k] ) #000a DIV2k STH2k MUL2 SUB2 STH2r INCr ( n%10 n/10 [k+1] ) - DUP2 ORA ,&read JCN + DUP2 ORA ?&read POP2 ( top element was 0000 ) &write ( n0 n1 ... nk [k+1] ) NIP #30 ADD #18 DEO LITr 01 SUBr ( n0 ... n{k-1} [k] ) - STHkr ,&write JCN + STHkr ?&write POPr JMP2r ( emit a short as a decimal with leading spaces ) @@ -1576,12 +1578,12 @@ LITr 00 ( n [0] ) &read ( n [k] ) #000a DIV2k STH2k MUL2 SUB2 STH2r INCr ( n%10 n/10 [k+1] ) - STHkr #05 LTH ,&read JCN + STHkr #05 LTH ?&read POP2 ( top element was 0000 ) &write0 ( n0 n1 ... nk [k+1] ) - DUP2 ORA ,emit-dec2/write JCN + DUP2 ORA ?emit-dec2/write POP2 sp LITr 01 SUBr - STHkr ,&write0 JCN + STHkr ?&write0 POPr JMP2r ( various string constants used as messages for the user ) @@ -1630,19 +1632,19 @@ ( perform the undo action ) @undo ( -> ) #01 .state/in-undo STZ - ;undo-stack/pos LDA2 ;undo-stack/data EQU2 ,&noop JCN + ;undo-stack/pos LDA2 ;undo-stack/data EQU2 ?&noop ;undo-stack/pos LDA2 #0003 SUB2 DUP2 ;undo-stack/pos STA2 LDA2k STH2 ( pos [addr] ) INC2 INC2 LDA STH2r ( c addr ) - ;jump-to-pos JSR2 - DUP #00 EQU ,&delete JCN - DUP #0a EQU ,&newline JCN - DUP #09 EQU ,&tab JCN - ;insert JMP2 - &newline POP ;newline JMP2 - &tab POP ;insert-tab JMP2 - &delete POP ;delete JMP2 + jump-to-pos + DUP #00 EQU ?&delete + DUP #0a EQU ?&newline + DUP #09 EQU ?&tab + !insert + &newline POP !newline + &tab POP !insert-tab + &delete POP !delete &noop BRK ( free up space in the undo stack by evicting the oldest entry ) @@ -1650,15 +1652,15 @@ ;undo-stack/data STH2k #0003 ADD2 ( st+3 [st] ) &loop LDAk STH2kr STA INC2 INC2r - DUP2 ;undo-stack/pos LDA2 LTH2 ,&loop JCN + DUP2 ;undo-stack/pos LDA2 LTH2 ?&loop ;undo-stack/pos LDA2k #0003 SUB2 SWP2 STA2 POP2 POP2r JMP2r ( push a new item on the undo stack ) @u-push ( c^ addr* -> ) ;undo-stack/pos DUP2 LDA2 ( c^ addr* top* pos* ) - GTH2 ( c^ addr* top>pos^ ) ,&has-room JCN ( c^ addr* ) - ;u-free JSR2 + GTH2 ( c^ addr* top>pos^ ) ?&has-room ( c^ addr* ) + u-free &has-room ;undo-stack/pos LDA2 ( c^ addr* pos* ) STH2k ( c addr pos [pos] ) STA2 ( c [pos] ) diff --git a/regex.tal b/regex.tal index 731ab95..e7c850b 100644 --- a/regex.tal +++ b/regex.tal @@ -97,10 +97,10 @@ ( using error! will print the given message before causing ) ( the interpreter to halt. ) -@error!! ( msg* -> ) +@errorm ( msg* -> ) LIT "! emit! space - &loop LDAk #00 EQU ,&done JCN - LDAk emit! INC2 ,&loop JMP + &loop LDAk #00 EQU ?&done + LDAk emit! INC2 !&loop &done POP2 newline #ff0e DEO #010f DEO BRK ( error messages ) @@ -126,34 +126,34 @@ @rx-match ( str* regex* -> bool^ ) #01 ;match-multiline STA #00 ;search-mode STA - ;rx-reset JSR2 - ;loop JMP2 + rx-reset + !loop @rx-search-multiline ( str* regex* -> bool^ ) #01 ;match-multiline STA #01 ;search-mode STA - ,rx-search/main JMP + !rx-search/main @rx-search ( str* regex* -> bool^ ) #00 ;match-multiline STA #01 ;search-mode STA &main STH2 ( s* [r*] ) DUP2 ;string-start STA2 ( s* [r*] ) - &loop LDAk #00 EQU ,&eof JCN ( s* [r*] ) - ;rx-reset JSR2 ( s* [r*] ) + &loop LDAk #00 EQU ?&eof ( s* [r*] ) + rx-reset ( s* [r*] ) DUP2 ;search-start STA2 ( s* [r*] ) - DUP2 STH2kr ;loop JSR2 ( s* b^ [r*] ) - ,&found JCN ( s* [r*] ) - INC2 ,&loop JMP ( s+1* [r*] ) + DUP2 STH2kr loop ( s* b^ [r*] ) + ?&found ( s* [r*] ) + INC2 !&loop ( s+1* [r*] ) &found POP2 POP2r #01 JMP2r ( 01 ) - &eof ;rx-reset JSR2 ( s* [r*] ) + &eof rx-reset ( s* [r*] ) DUP2 ;search-start STA2 ( s* [r*] ) - STH2r ;loop JMP2 ( b^ ) + STH2r !loop ( b^ ) ( reset all "runtime" memory allocated during match/search ) @rx-reset ( -> ) - ;reset-stack JSR2 - ;subgroup-reset JMP2 + reset-stack + !subgroup-reset ( loop used during matching ) ( ) @@ -163,87 +163,87 @@ ( return a boolean, which is where the stack ) ( effects signature comes from. ) @loop ( s* r* -> bool^ ) - LDAk #01 EQU ;do-empty JCN2 - LDAk #02 EQU ;do-dot JCN2 - LDAk #03 EQU ;do-literal JCN2 - LDAk #04 EQU ;do-or JCN2 - LDAk #05 EQU ;do-or JCN2 ( same code as the or case ) - LDAk #06 EQU ;do-caret JCN2 - LDAk #07 EQU ;do-dollar JCN2 - LDAk #08 EQU ;do-lpar JCN2 - LDAk #09 EQU ;do-rpar JCN2 - LDAk #0a EQU ;do-ccls JCN2 - LDAk #0b EQU ;do-ncls JCN2 - LDAk #dd ;unknown-node-type ;error!! JSR2 + LDAk #01 EQU ?do-empty + LDAk #02 EQU ?do-dot + LDAk #03 EQU ?do-literal + LDAk #04 EQU ?do-or + LDAk #05 EQU ?do-or ( same code as the or case ) + LDAk #06 EQU ?do-caret + LDAk #07 EQU ?do-dollar + LDAk #08 EQU ?do-lpar + LDAk #09 EQU ?do-rpar + LDAk #0a EQU ?do-ccls + LDAk #0b EQU ?do-ncls + LDAk #dd ;unknown-node-type errorm ( used when we hit a dead-end during matching. ) ( ) ( if stack is non-empty we have a point we can resume from. ) @goto-backtrack ( -> bool^ ) - ;stack-exist JSR2 ,&has-stack JCN ( do we have stack? ) + stack-exist ?&has-stack ( do we have stack? ) #00 JMP2r ( no, return false ) &has-stack - ;pop4 JSR2 - ;subgroup-backtrack JSR2 - ;goto-next JMP2 ( yes, resume from the top ) + pop4 + subgroup-backtrack + !goto-next ( yes, resume from the top ) ( follow the given address (next*) to continue matching ) @goto-next ( str* next* -> bool^ ) - DUP2 #0000 GTH2 ,&has-next JCN - POP2 LDAk #00 EQU ,&end-of-string JCN - ;search-mode LDA ,&end-of-search JCN - POP2 ;goto-backtrack JMP2 + DUP2 #0000 GTH2 ?&has-next + POP2 LDAk #00 EQU ?&end-of-string + ;search-mode LDA ?&end-of-search + POP2 !goto-backtrack &end-of-search DUP2 ;search-end STA2 &end-of-string POP2 #01 JMP2r - &has-next ;loop JMP2 + &has-next !loop ( handle the empty node -- just follow the next pointer ) @do-empty ( str* regex* -> bool^ ) INC2 LDA2 ( load next ) - ;goto-next JMP2 ( jump to next ) + !goto-next ( jump to next ) ( FIXME: not currently used ) @do-lpar ( str* regex* -> bool^ ) STH2 DUP2 ( s s [r] ) INC2r LDA2kr STH2r ( s s i [r+1] ) - ;subgroup-start JSR2 ( s [r+1] ) + subgroup-start ( s [r+1] ) STH2r INC2 INC2 ( s r+3 ) - LDA2 ;goto-next JMP2 ( jump to next ) + LDA2 !goto-next ( jump to next ) ( FIXME: not currently used ) @do-rpar ( str* regex* -> bool^ ) STH2 DUP2 ( s s [r] ) INC2r LDA2kr STH2r ( s s i [r+1] ) - ;subgroup-finish JSR2 ( s [r+1] ) + subgroup-finish ( s [r+1] ) STH2r INC2 INC2 ( s r+3 ) - LDA2 ;goto-next JMP2 ( jump to next ) + LDA2 !goto-next ( jump to next ) ( handle dot -- match any one character ) @do-dot ( str* regex* -> bool^ ) INC2 LDA2 STH2 ( load and stash next ) - LDAk #00 NEQ ,&non-empty JCN ( is there a char? ) - &backtrack POP2r POP2 ;goto-backtrack JMP2 ( no, clear stacks and backtrack ) - &non-empty LDAk #0a NEQ ,&match JCN ( yes, match unless \n in search-mode ) - ;search-mode LDA ,&backtrack JCN ( if \n and search-mode, treat as EOF ) - &match INC2 STH2r ;goto-next JMP2 ( on match: inc s, restore and jump ) + LDAk #00 NEQ ?&non-empty ( is there a char? ) + &backtrack POP2r POP2 !goto-backtrack ( no, clear stacks and backtrack ) + &non-empty LDAk #0a NEQ ?&match ( yes, match unless \n in search-mode ) + ;search-mode LDA ?&backtrack ( if \n and search-mode, treat as EOF ) + &match INC2 STH2r !goto-next ( on match: inc s, restore and jump ) ( hande caret -- match string start (or possibly after newline) without advancing ) @do-caret ( str* regex* -> bool^ ) INC2 LDA2 STH2 ( load and stash next ) - DUP2 ;string-start LDA2 EQU2 ,&at-start JCN ( at string start? ) - ;match-multiline LDA ,&no-match JCN ( are we in multi-line mode? ) - DUP2 #0001 SUB2 LDA #0a EQU ,&at-start JCN ( just after newline? ) - &no-match POP2r POP2 ;goto-backtrack JMP2 ( clear stacks and backtrack ) - &at-start STH2r ;goto-next JMP2 ( go to next without advancing ) + DUP2 ;string-start LDA2 EQU2 ?&at-start ( at string start? ) + ;match-multiline LDA ?&no-match ( are we in multi-line mode? ) + DUP2 #0001 SUB2 LDA #0a EQU ?&at-start ( just after newline? ) + &no-match POP2r POP2 !goto-backtrack ( clear stacks and backtrack ) + &at-start STH2r !goto-next ( go to next without advancing ) ( hande dollar -- match string end (or possibly before newline) without advancing ) @do-dollar ( str* regex* -> bool^ ) INC2 LDA2 STH2 ( load and stash next ) - LDAk #00 EQU ,&at-end JCN ( at string end? ) - ;match-multiline LDA ,&no-match JCN ( are we in multi-line mode? ) - LDAk #0a EQU ,&at-end JCN ( at newline? ) - &no-match POP2r POP2 ;goto-backtrack JMP2 ( clear stacks and backtrack ) - &at-end STH2r ;goto-next JMP2 ( go to next without advancing ) + LDAk #00 EQU ?&at-end ( at string end? ) + ;match-multiline LDA ?&no-match ( are we in multi-line mode? ) + LDAk #0a EQU ?&at-end ( at newline? ) + &no-match POP2r POP2 !goto-backtrack ( clear stacks and backtrack ) + &at-end STH2r !goto-next ( go to next without advancing ) ( handle literal -- match one specific character ) @do-literal ( str* regex* -> bool^ ) @@ -251,23 +251,23 @@ LDAk STH ( store c ) INC2 LDA2 STH2 ROTr ( store next, move c to top ) LDAk - STHr EQU ,&matches JCN ( do we match this char? ) - POP2r POP2 ;goto-backtrack JMP2 ( no, clear stacks and backtrack ) + STHr EQU ?&matches ( do we match this char? ) + POP2r POP2 !goto-backtrack ( no, clear stacks and backtrack ) &matches - INC2 STH2r ;goto-next JMP2 ( yes, inc s, restore and jump ) + INC2 STH2r !goto-next ( yes, inc s, restore and jump ) ( handle or -- try the left branch but backtrack to the right if needed ) ( ) ( this also handles asteration, since it ends up having the same structure ) @do-or ( str* regex* -> bool^ ) INC2 OVR2 OVR2 #0002 ADD2 ( s r+1 s r+3 ) - LDA2 ;push4 JSR2 ( save (s, right) in the stack for possible backtracking ) - LDA2 ;loop JMP2 ( continue on left branch ) + LDA2 push4 ( save (s, right) in the stack for possible backtracking ) + LDA2 !loop ( continue on left branch ) @matches-cls ( str* regex* -> bool^ ) - OVR2 LDA ,¬-null JCN + OVR2 LDA ?¬-null ( needs to have a character to match ) - POP2 POP2 ;goto-backtrack JMP2 + POP2 POP2 !goto-backtrack ¬-null DUP2 INC2 LDA2 STH2 ( str regex [next] ) OVR2 INC2 STH2 ( str regex [str+1 next] ) @@ -275,24 +275,24 @@ #0003 ADD2 LDAk #00 SWP #0002 MUL2 ( r+3 len*2 [c str+1 next] ) SWP2 INC2 STH2k ADD2 STH2r ( r+4+len*2 r+4 [c str+1 next] ) &loop ( limit addr [c str+1 next] ) - EQU2k ,&missing JCN - LDAk STHkr GTH ,&next1 JCN INC2 - LDAk STHkr LTH ,&next2 JCN ,&found JMP + EQU2k ?&missing + LDAk STHkr GTH ?&next1 INC2 + LDAk STHkr LTH ?&next2 !&found &next1 INC2 - &next2 INC2 ,&loop JMP - &missing POP2 POP2 POPr ,&negated LDR ,&match JCN - &no-match POP2r POP2r ;goto-backtrack JMP2 - &found POP2 POP2 POPr ,&negated LDR ,&no-match JCN - &match STH2r STH2r ;goto-next JMP2 + &next2 INC2 !&loop + &missing POP2 POP2 POPr ,&negated LDR ?&match + &no-match POP2r POP2r !goto-backtrack + &found POP2 POP2 POPr ,&negated LDR ?&no-match + &match STH2r STH2r !goto-next [ &negated $1 ] ( ) @do-ccls ( str* regex* -> bool^ ) - #00 ,matches-cls/negated STR ,matches-cls JMP + #00 ,matches-cls/negated STR !matches-cls ( ) @do-ncls ( str* regex* -> bool^ ) - #01 ,matches-cls/negated STR ,matches-cls JMP + #01 ,matches-cls/negated STR !matches-cls ( REGEX PARSING ) @@ -325,9 +325,9 @@ @read ( -> c^ ) ;pos LDA2k ( pos s ) LDAk STHk #00 EQU ( pos s c=0 [c] ) - ,&is-eof JCN ( pos s [c] ) + ?&is-eof ( pos s [c] ) INC2 ( pos s+1 [c] ) - SWP2 STA2 ,&return JMP ( [c] ) + SWP2 STA2 !&return ( [c] ) &is-eof POP2 POP2 &return STHr ( c ) JMP2r @@ -370,8 +370,8 @@ @compile ( expr* -> regex* ) ;pos STA2 #0000 ;parens STA2 - ;rx-reset JSR2 - ;compile-region JMP2 + rx-reset + !compile-region ( the basic strategy here is to build a stack of non-or ) ( expressions to be joined together at the end of the ) @@ -385,24 +385,24 @@ ( by #ffff #ffff. above that we start with #0000 #0000 ) ( to signal an empty node. ) @compile-region ( -> r2* ) - #ffff #ffff ;push4 JSR2 ( stack delimiter ) - #0000 #0000 ;push4 JSR2 ( stack frame start ) + #ffff #ffff push4 ( stack delimiter ) + #0000 #0000 push4 ( stack frame start ) @compile-region-loop - ;read JSR2 - DUP #00 EQU ;c-done JCN2 - DUP LIT "| EQU ;c-or JCN2 - DUP LIT ". EQU ;c-dot JCN2 - DUP LIT "^ EQU ;c-caret JCN2 - DUP LIT "$ EQU ;c-dollar JCN2 - DUP LIT "( EQU ;c-lpar JCN2 - DUP LIT ") EQU ;c-rpar JCN2 - DUP LIT "[ EQU ;c-lbrk JCN2 - DUP LIT "] EQU ;c-rbrk JCN2 - DUP LIT "\ EQU ;c-esc JCN2 - DUP LIT "* EQU ;c-star JCN2 - DUP LIT "+ EQU ;c-plus JCN2 - DUP LIT "? EQU ;c-qmark JCN2 - ;c-char JMP2 + read + DUP #00 EQU ?c-done + DUP LIT "| EQU ?c-or + DUP LIT ". EQU ?c-dot + DUP LIT "^ EQU ?c-caret + DUP LIT "$ EQU ?c-dollar + DUP LIT "( EQU ?c-lpar + DUP LIT ") EQU ?c-rpar + DUP LIT "[ EQU ?c-lbrk + DUP LIT "] EQU ?c-rbrk + DUP LIT "\ EQU ?c-esc + DUP LIT "* EQU ?c-star + DUP LIT "+ EQU ?c-plus + DUP LIT "? EQU ?c-qmark + !c-char ( either finalize the given r0/r1 or else wrap it in ) ( a star node if a star is coming up next. ) @@ -410,14 +410,14 @@ ( we use this look-ahead approach rather than compiling ) ( star nodes directly since the implementation is simpler. ) @c-peek-and-finalize ( r0* r1* -> r2* ) - ;peek-to-star JSR2 ( r0 r1 next-is-star? ) ,&next-is-star JCN - ;peek-to-plus JSR2 ( r0 r1 next-is-plus? ) ,&next-is-plus JCN - ;peek-to-qmark JSR2 ( r0 r1 next-is-qmark? ) ,&next-is-qmark JCN - ,&finally JMP ( r0 r1 ) - &next-is-star ;skip JSR2 POP2 ;alloc-star JSR2 DUP2 ,&finally JMP - &next-is-plus ;skip JSR2 POP2 ;alloc-plus JSR2 DUP2 ,&finally JMP - &next-is-qmark ;skip JSR2 POP2 ;alloc-qmark JSR2 DUP2 ,&finally JMP - &finally ;push-next JSR2 ;compile-region-loop JMP2 + peek-to-star ( r0 r1 next-is-star? ) ?&next-is-star + peek-to-plus ( r0 r1 next-is-plus? ) ?&next-is-plus + peek-to-qmark ( r0 r1 next-is-qmark? ) ?&next-is-qmark + !&finally ( r0 r1 ) + &next-is-star skip POP2 alloc-star DUP2 !&finally + &next-is-plus skip POP2 alloc-plus DUP2 !&finally + &next-is-qmark skip POP2 alloc-qmark DUP2 !&finally + &finally push-next !compile-region-loop ( called when we reach EOF of the input string ) ( ) @@ -427,9 +427,9 @@ ( this is where we detect unclosed parenthesis. ) @c-done ( c^ -> r2* ) POP - ;parens LDA2 #0000 GTH2 ,&mismatched-parens JCN - ;unroll-stack JSR2 POP2 JMP2r - &mismatched-parens ;mismatched-parens ;error!! JSR2 + ;parens LDA2 #0000 GTH2 ?&mismatched-parens + unroll-stack POP2 JMP2r + &mismatched-parens ;mismatched-parens errorm ( called when we read "|" ) ( ) @@ -437,8 +437,8 @@ ( we just start a new stack frame and continue. ) @c-or ( c^ -> r2* ) POP - #0000 #0000 ;push4 JSR2 - ;compile-region-loop JMP2 + #0000 #0000 push4 + !compile-region-loop ( called when we read left parenthesis ) ( ) @@ -450,7 +450,7 @@ @c-lpar ( c^ -> r2* ) POP ;parens LDA2 INC2 ;parens STA2 ( parens++ ) - ;compile-region JMP2 + !compile-region ( called when we read right parenthesis ) ( ) @@ -463,34 +463,34 @@ ( 5. continue parsing ) @c-rpar ( c^ -> r2* ) POP - ;parens LDA2 #0000 EQU2 ,&mismatched-parens JCN + ;parens LDA2 #0000 EQU2 ?&mismatched-parens ;parens LDA2 #0001 SUB2 ;parens STA2 ( parens-- ) - ;unroll-stack JSR2 - ;c-peek-and-finalize JMP2 - &mismatched-parens ;mismatched-parens ;error!! JSR2 + unroll-stack + !c-peek-and-finalize + &mismatched-parens ;mismatched-parens errorm ( doesn't support weird things like []abc] or [-abc] or similar. ) ( doesn't currently handle "special" escapes such as \n ) @c-lbrk ( c^ -> r2* ) POP LITr 00 ;pos LDA2 ( pos [0] ) - LDAk LIT "^ NEQ ,&normal JCN INCr INC2 ( pos [negated?^] ) + LDAk LIT "^ NEQ ?&normal INCr INC2 ( pos [negated?^] ) &normal #0a STHr ADD ( src* type^ ) ;arena-pos LDA2 STH2k ( src* type^ dst* [dst*] ) STA LIT2r 0004 ADD2r ( src* [dst+4] ) &left-parse ( src* [dst*] ) - LDAk LIT "] EQU ,&done JCN - LDAk LIT "- EQU ,&error JCN - LDAk LIT "\ NEQ ,&left JCN INC2 + LDAk LIT "] EQU ?&done + LDAk LIT "- EQU ?&error + LDAk LIT "\ NEQ ?&left INC2 &left LDAk STH2kr STA INC2r - DUP2 INC2 LDA LIT "- NEQ ,&pre-right JCN INC2 INC2 - LDAk LIT "] EQU ,&error JCN - LDAk LIT "- EQU ,&error JCN + DUP2 INC2 LDA LIT "- NEQ ?&pre-right INC2 INC2 + LDAk LIT "] EQU ?&error + LDAk LIT "- EQU ?&error &pre-right - LDAk LIT "\ NEQ ,&right JCN INC2 + LDAk LIT "\ NEQ ?&right INC2 &right - LDAk STH2kr STA INC2 INC2r ,&left-parse JMP + LDAk STH2kr STA INC2 INC2r !&left-parse &done ( src* [dst*] ) INC2 ;pos STA2 STH2r ( dst* ) DUP2 ;arena-pos LDA2 ( dst dst a ) @@ -498,7 +498,7 @@ ;arena-pos LDA2 STH2k #0003 ADD2 STA ( dst [a] ) ;arena-pos STA2 STH2r ( a ) #0000 OVR2 INC2 STA2 ( a ) - DUP2 ;c-peek-and-finalize JMP2 + DUP2 !c-peek-and-finalize &error #abcd #0000 DIV ( TODO error here ) @@ -511,24 +511,24 @@ ( allocates a dot-node and continues. ) @c-dot ( c^ -> r2* ) POP - #02 ;alloc3 JSR2 - DUP2 ;c-peek-and-finalize JMP2 + #02 alloc3 + DUP2 !c-peek-and-finalize ( called when we read "^" ) ( ) ( allocates a caret-node and continues. ) @c-caret ( c^ -> r2* ) POP - #06 ;alloc3 JSR2 - DUP2 ;c-peek-and-finalize JMP2 + #06 alloc3 + DUP2 !c-peek-and-finalize ( called when we read "$" ) ( ) ( allocates a dollar-node and continues. ) @c-dollar ( c^ -> r2* ) POP - #07 ;alloc3 JSR2 - DUP2 ;c-peek-and-finalize JMP2 + #07 alloc3 + DUP2 !c-peek-and-finalize ( called when we read "\" ) ( ) @@ -536,50 +536,50 @@ ( ) ( otherwise, allocates a literal of the next character. ) @c-esc ( c^ -> r2* ) - POP ;read JSR2 - DUP LIT "a EQU ,&bel JCN - DUP LIT "b EQU ,&bs JCN - DUP LIT "t EQU ,&tab JCN - DUP LIT "n EQU ,&nl JCN - DUP LIT "v EQU ,&vtab JCN - DUP LIT "f EQU ,&ff JCN - DUP LIT "r EQU ,&cr JCN - &default ;c-char JMP2 - &bel POP #07 ,&default JMP - &bs POP #08 ,&default JMP - &tab POP #09 ,&default JMP - &nl POP #0a ,&default JMP - &vtab POP #0b ,&default JMP - &ff POP #0c ,&default JMP - &cr POP #0d ,&default JMP + POP read + DUP LIT "a EQU ?&bel + DUP LIT "b EQU ?&bs + DUP LIT "t EQU ?&tab + DUP LIT "n EQU ?&nl + DUP LIT "v EQU ?&vtab + DUP LIT "f EQU ?&ff + DUP LIT "r EQU ?&cr + &default !c-char + &bel POP #07 !&default + &bs POP #08 !&default + &tab POP #09 !&default + &nl POP #0a !&default + &vtab POP #0b !&default + &ff POP #0c !&default + &cr POP #0d !&default ( called when we read any other character ) ( ) ( allocates a literal-node and continues. ) @c-char ( c^ -> r2* ) - ;alloc-lit JSR2 ( lit ) - DUP2 ;c-peek-and-finalize JMP2 + alloc-lit ( lit ) + DUP2 !c-peek-and-finalize ( called if we parse a "*" ) ( ) ( actually calling this means the code broke an invariant somewhere. ) @c-star ( c^ -> regex* ) POP - ;star-invariant ;error!! JSR2 + ;star-invariant errorm ( called if we parse a "+" ) ( ) ( actually calling this means the code broke an invariant somewhere. ) @c-plus ( c^ -> regex* ) POP - ;plus-invariant ;error!! JSR2 + ;plus-invariant errorm ( called if we parse a "?" ) ( ) ( actually calling this means the code broke an invariant somewhere. ) @c-qmark ( c^ -> regex* ) POP - ;qmark-invariant ;error!! JSR2 + ;qmark-invariant errorm ( ALLOCATING REGEX NDOES ) @@ -589,51 +589,51 @@ @alloc3 ( mode^ -> r* ) #0000 ROT ( 00 00 mode^ ) - #03 ;alloc JSR2 ( 00 00 mode^ addr* ) + #03 alloc ( 00 00 mode^ addr* ) STH2k STA ( addr <- mode ) STH2kr INC2 STA2 ( addr+1 <- 0000 ) STH2r JMP2r ( return addr ) @alloc-empty ( -> r* ) - #01 ;alloc3 JMP2 + #01 !alloc3 @alloc-lit ( c^ -> r* ) #03 #0000 SWP2 ( 0000 c^ 03 ) - #04 ;alloc JSR2 ( 0000 c^ 03 addr* ) + #04 alloc ( 0000 c^ 03 addr* ) STH2k STA ( addr <- 03 ) STH2kr INC2 STA ( addr+1 <- c ) STH2kr #0002 ADD2 STA2 ( addr+2 <- 0000 ) STH2r JMP2r ( return addr ) @alloc-or ( right* left* -> r* ) - #05 ;alloc JSR2 STH2 ( r l [x] ) + #05 alloc STH2 ( r l [x] ) #04 STH2kr STA ( r l [x] ) STH2kr INC2 STA2 ( r [x] ) STH2kr #0003 ADD2 STA2 ( [x] ) STH2r JMP2r @alloc-star ( expr* -> r* ) - #05 ;alloc JSR2 STH2 ( expr [r] ) + #05 alloc STH2 ( expr [r] ) #05 STH2kr STA ( expr [r] ) DUP2 STH2kr INC2 STA2 ( expr [r] ) #0000 STH2kr #0003 ADD2 STA2 ( expr [r] ) STH2kr SWP2 ( r expr [r] ) - ;set-next JSR2 ( [r] ) + set-next ( [r] ) STH2r JMP2r @alloc-plus ( expr* -> r* ) - #05 ;alloc JSR2 STH2 ( expr [r] ) + #05 alloc STH2 ( expr [r] ) #05 STH2kr STA ( expr [r] ) DUP2 STH2kr INC2 STA2 ( expr [r] ) #0000 STH2kr #0003 ADD2 STA2 ( expr [r] ) STH2r SWP2 STH2k ( r expr [expr] ) - ;set-next JSR2 ( [expr] ) + set-next ( [expr] ) STH2r JMP2r @alloc-qmark ( expr* -> r* ) - ;alloc-empty JSR2 STH2k ( expr e [e] ) - OVR2 ;set-next JSR2 ( expr [e] ) - #05 ;alloc JSR2 STH2 ( expr [r e] ) + alloc-empty STH2k ( expr e [e] ) + OVR2 set-next ( expr [e] ) + #05 alloc STH2 ( expr [r e] ) #04 STH2kr STA ( expr [r e] ) STH2kr INC2 STA2 ( [r e] ) SWP2r STH2r STH2kr ( e r [r] ) @@ -642,7 +642,7 @@ ( if r is 0000, allocate an empty node ) @alloc-if-null ( r* -> r2* ) - ORAk ,&return JCN POP2 ;alloc-empty JSR2 &return JMP2r + ORAk ?&return POP2 alloc-empty &return JMP2r ( unroll one region of the parsing stack, returning ) ( a single node consisting of an alternation of ) @@ -651,23 +651,23 @@ ( this unrolls until it hits #ffff #ffff, which it ) ( also removes from the stack. ) @unroll-stack ( -> start* end* ) - ;pop4 JSR2 STH2 ( r ) + pop4 STH2 ( r ) #00 STH ( count items in stack frame ) - ;alloc-if-null JSR2 ( replace 0000 with empty ) + alloc-if-null ( replace 0000 with empty ) &loop ( r* ) - ;pop4 JSR2 POP2 ( r x ) - DUP2 #ffff EQU2 ( r x x-is-end? ) ,&done JCN + pop4 POP2 ( r x ) + DUP2 #ffff EQU2 ( r x x-is-end? ) ?&done INCr ( items++ ) - ;alloc-or JSR2 ( r|x ) ,&loop JMP + alloc-or ( r|x ) !&loop &done ( r ffff ) POP2 - STHr ,&is-or JCN + STHr ?&is-or STH2r JMP2r &is-or POP2r - ;alloc-empty JSR2 OVR2 OVR2 SWP2 ( r empty empty r ) - ;set-next-or JSR2 + alloc-empty OVR2 OVR2 SWP2 ( r empty empty r ) + set-next-or JMP2r ( add r to the top of the stock. ) @@ -675,21 +675,21 @@ ( in particular, this will write r into tail.next ) ( before replacing tail with r. ) @push-next ( r0 r1 -> ) - ;pop4 JSR2 ( r0 r1 x0 x1 ) - DUP2 #0000 EQU2 ( r0 r1 x0 x1 x1=0? ) ,&is-zero JCN + pop4 ( r0 r1 x0 x1 ) + DUP2 #0000 EQU2 ( r0 r1 x0 x1 x1=0? ) ?&is-zero STH2 ROT2 STH2r ( r1 x0 r0 x1 ) - ;set-next JSR2 SWP2 ( x0 r1 ) - ;push4 JSR2 + set-next SWP2 ( x0 r1 ) + push4 JMP2r - &is-zero POP2 POP2 ;push4 JMP2 + &is-zero POP2 POP2 !push4 ( load the given address: ) ( ) ( 1. if it points to 0000, update it to target ) ( 2. otherwise, call set-next on it ) @set-next-addr ( target* addr* -> ) - LDA2k #0000 EQU2 ( target addr addr=0? ) ,&is-zero JCN - LDA2 ;set-next JMP2 + LDA2k #0000 EQU2 ( target addr addr=0? ) ?&is-zero + LDA2 !set-next &is-zero STA2 JMP2r ( set regex.next to target ) @@ -703,18 +703,18 @@ ( back up we only bother taking the left branch. otherwise ) ( you can end up double-appending things. ) @set-next ( target* regex* -> ) - LDAk #01 LTH ,&unknown JCN - LDAk #0b GTH ,&unknown JCN - LDAk #09 GTH ,&cc JCN + LDAk #01 LTH ?&unknown + LDAk #0b GTH ?&unknown + LDAk #09 GTH ?&cc LDAk #00 SWP ;rx-node-sizes ADD2 LDA #00 SWP ADD2 #0002 SUB2 - ;set-next-addr JMP2 - &cc INC2 ;set-next-addr JMP2 - &unknown LDAk #ee ;unknown-node-type ;error!! JSR2 + !set-next-addr + &cc INC2 !set-next-addr + &unknown LDAk #ee ;unknown-node-type errorm @set-next-or-addr ( target* addr* -> ) - LDA2k #0000 EQU2 ( target addr addr=0? ) ,&is-zero JCN - LDA2 ;set-next-or JMP2 + LDA2k #0000 EQU2 ( target addr addr=0? ) ?&is-zero + LDA2 !set-next-or &is-zero STA2 JMP2r ( this is used when first building or-nodes ) @@ -722,10 +722,10 @@ ( [x1, [x2, [x3, ..., [xm, xn]]]] ) ( so we recurse on the right side but not the left. ) @set-next-or ( target* regex* -> ) - LDAk #04 NEQ ,&!4 JCN - OVR2 OVR2 INC2 ;set-next-addr JSR2 - #0003 ADD2 ;set-next-or-addr JMP2 - &!4 ;set-next JMP2 + LDAk #04 NEQ ?&!4 + OVR2 OVR2 INC2 set-next-addr + #0003 ADD2 !set-next-or-addr + &!4 !set-next ( STACK OPERATIONS ) ( ) @@ -741,7 +741,7 @@ ( push 4 bytes onto the stack ) @push4 ( str* regex* -> ) - ;assert-stack-avail JSR2 ( check for space ) + assert-stack-avail ( check for space ) ;stack-pos LDA2 #0002 ADD2 STA2 ( cell[2:3] <- regex ) ;stack-pos LDA2 STA2 ( cell[0:1] <- str ) ;stack-pos LDA2 #0004 ADD2 ;stack-pos STA2 ( pos += 4 ) @@ -749,7 +749,7 @@ ( pop 4 bytes from the stack ) @pop4 ( -> str* regex* ) - ;assert-stack-exist JSR2 ( check for space ) + assert-stack-exist ( check for space ) ;stack-pos LDA2 ( load stack-pos ) #0002 SUB2 LDA2k STH2 ( pop and stash regex ) #0002 SUB2 LDA2k STH2 ( pop and stash str ) @@ -771,11 +771,11 @@ ( error if stack is full ) @assert-stack-avail ( -> ) - ;stack-avail JSR2 ,&ok JCN ;stack-is-full ;error!! JSR2 &ok JMP2r + stack-avail ?&ok ;stack-is-full errorm &ok JMP2r ( error is stack is empty ) @assert-stack-exist ( -> ) - ;stack-exist JSR2 ,&ok JCN ;stack-is-empty ;error!! JSR2 &ok JMP2r + stack-exist ?&ok ;stack-is-empty errorm &ok JMP2r ( stack-pos points to the next free stack position (or the top if full). ) @stack-pos :stack-bot ( the next position to insert at ) @@ -810,10 +810,10 @@ #00 SWP ( size* ) ;arena-pos LDA2 STH2k ADD2 ( pos+size* [pos] ) DUP2 ;arena-top GTH2 ( pos+size pos+size>top? [pos] ) - ,&error JCN ( pos+size [pos] ) + ?&error ( pos+size [pos] ) ;arena-pos STA2 ( pos += size [pos] ) STH2r JMP2r ( pos ) - &error POP2 POP2r ;arena-is-full ;error!! JSR2 + &error POP2 POP2r ;arena-is-full errorm @arena-pos :arena-bot ( the next position to allocate ) @arena-bot $400 @arena-top ( holds up to 1024 bytes ) @@ -870,7 +870,7 @@ @subgroup-start ( s* i^ -> ) ;subgroup-pos LDA2 STH2k ( s* i^ pos* [pos*] ) - ;subgroup-top LTH2 ,&next JCN #0000 DIV ( too many subgroups ) + ;subgroup-top LTH2 ?&next #0000 DIV ( too many subgroups ) &next ( s* i^ [pos*] ) STH2kr STA STH2r INC2 STA2 @@ -878,9 +878,9 @@ @subgroup-finish ( s* i^ -> ) ;subgroup-pos LDA2 STH2k ( s* i^ pos* [pos*] ) - ;subgroup-top LTH2 ,&next JCN #0000 DIV ( too many subgroups ) + ;subgroup-top LTH2 ?&next #0000 DIV ( too many subgroups ) &next ( s* i^ [pos*] ) - STH2kr LDA EQU ,&ok JCN #0000 DIV ( mismatched subgroups ) + STH2kr LDA EQU ?&ok #0000 DIV ( mismatched subgroups ) &ok ( s* [pos*] ) STH2kr #0003 ADD2 STA2 STH2r #0005 ADD2 ;subgroup-pos STA2 @@ -888,7 +888,7 @@ @subgroup-branch ( -> ) ;subgroup-pos LDA2 STH2k ( pos* [pos*] ) - ;subgroup-top LTH2 ,&next JCN #0000 DIV ( too many subgroups ) + ;subgroup-top LTH2 ?&next #0000 DIV ( too many subgroups ) &next #00 STH2kr STA ( [*pos] ) STH2r #0005 ADD2 ;subgroup-pos STA2 @@ -897,9 +897,9 @@ @subgroup-backtrack ( -> ) ;subgroup-bot ;subgroup-pos LDA2 ( bot* pos* ) &loop ( bot* pos* ) - EQU2k ,&done JCN - LDAk #00 EQU ,&done JCN - #0005 SUB2 ,&loop JMP + EQU2k ?&done + LDAk #00 EQU ?&done + #0005 SUB2 !&loop &done ( bot* pos* ) NIP2 ;subgroup-pos STA2 JMP2r