fixed a few bugs, diagnosed more

This commit is contained in:
~d6 2022-02-13 14:46:50 -05:00
parent 233e8b07f2
commit 46f0f162eb
1 changed files with 97 additions and 41 deletions

136
femto.tal
View File

@ -64,9 +64,10 @@
%sp { #2018 DEO }
%nl { #0a18 DEO }
%cr { #0d18 DEO }
%exit { #01 .System/halt DEO BRK }
%ansi { #1b18 DEO #5b18 DEO }
%quit! { #01 .System/halt DEO }
%height { ;term/rows LDA2 NIP }
%last-line { ;term/rows LDA2 #0001 SUB2 NIP }
%pen-line { ;term/rows LDA2 #0002 SUB2 NIP }
@ -82,13 +83,28 @@
( ;setup-terminal-size JSR2 )
BRK
( ERROR HANDLING )
( using error! will print the given message before causing )
( the interpreter to halt. )
@error! ( msg* -> )
LIT '! emit sp
&loop LDAk ,&continue JCN ,&done JMP
&continue LDAk emit INC2 ,&loop JMP
&done POP2 nl
dbg BRK
( error messages )
@term-size-parse-error "error 20 "parsing 20 "term 20 "size 00
@rel-line-error "invalid 20 "relative 20 "line 20 "number 00
@open-file ( filename* -> )
.File/name DEO2
#8000 .File/length DEO2
;buffer/data .File/read DEO2
.File/success DEI2 #0000 GTH2 ,&ok JCN
;messages/input-error ;print JSR2 nl exit
;messages/input-error ;print JSR2 nl quit!
( calculate buffer limit address using start + size )
&ok .File/success DEI2 ;buffer/data ADD2 ;buffer/limit STA2
@ -130,7 +146,8 @@
;on-key .Console/vector DEO2
;draw-all JSR2
BRK
&parse-error LDAk #00 #00 DIV
&parse-error POP2 ;tmp/data LDA2
;term-size-parse-error ;error! JMP2
@setup-linecount ( -> )
;buffer/data LIT2r 0001
@ -158,8 +175,7 @@
&execute ( we saw a newline, so do something )
#00 ;tmp/pos LDA2 STA ( null terminate str )
;tmp/data ;tmp/pos STA2 ( reset pos )
( ;tmp/data ;open-file JSR2 ( open file ) )
;tmp/data ;filename ;str-copy JSR2 ( )
;tmp/data ;filename ;str-copy JSR2 ( open file )
;filename ;open-file JSR2 ( open file )
;setup-linecount JSR2 ( determine # of lines )
;setup-terminal-size JSR2 ( detect terminal dimensions )
@ -211,6 +227,7 @@
( FIXME: need to handle 'end of buffer' stuff )
@down
;cur-abs-row JSR2 ;last-abs-row JSR2 EQU2 ,&done JCN
;cursor/row LDA pen-line GTH ,&screen-down JCN
;cursor/row LDA INC ;cursor/row STA
;draw-statusbar JSR2
@ -220,14 +237,12 @@
;buffer/offset LDA2 ADD2 ;buffer/offset STA2
;buffer/line-offset LDA2k INC2 SWP2 STA2
;draw-all JSR2
BRK
&done BRK
@quit exit
@quit quit!
@ignore BRK
@die #00 #00 DIV
@insert ( c^ -> )
;cursor/col LDA pen-col GTH ,&skip JCN ( FIXME )
;cur-pos JSR2 ;shift-right JSR2
@ -251,13 +266,20 @@
;draw-all JSR2
BRK
@at-buffer-start ( -> bool^ )
;cur-pos JSR2 ;buffer/data EQU2 JMP2r
@at-line-start ( -> bool^ )
;cursor/col LDA #00 EQU JMP2r
( TODO: handle first line )
@backspace ( -> )
;cur-pos JSR2 ;buffer/data EQU2 ,&skip JCN
;cursor/col LDA #00 EQU ,&prev-line JCN
;cursor/col LDA #01 SUB ;cursor/col STA
;at-buffer-start JSR2 ,&skip JCN
;at-line-start JSR2 ,&prev-line JCN
;get-col JSR2 #01 SUB ;cursor/col STA
( ;cursor/col LDA #01 SUB ;cursor/col STA )
,&finish JMP
&prev-line
&prev-line ( TODO: what if row=0 but offset>0 ? )
;cursor/row LDA #01 SUB ;cursor/row STA
;cur-len JSR2 NIP ;cursor/col STA
;buffer/line-count LDA2k #0001 SUB2 SWP2 STA2
@ -266,12 +288,11 @@
;draw-all JSR2
&skip BRK
( there's at least one bug -- join lots of lines near start )
@delete ( -> )
;last-pos JSR2 #0001 SUB2
;cur-pos JSR2 LTH2k ,&skip JCN
;cur-pos JSR2 LDAk STH
;shift-left JSR2
;last-pos JSR2 #0001 SUB2 ( lst-1 )
;cur-pos JSR2 LTH2 ,&skip JCN
;cur-pos JSR2 LDAk STH ( cur [c] )
;shift-left JSR2 ( [c] )
STHr #0a NEQ ,&not-newline JCN
;buffer/line-count LDA2k #0001 SUB2 SWP2 STA2
&not-newline ;draw-all JSR2
@ -280,15 +301,18 @@
@escape ( -> )
#01 ;saw-esc STA BRK
( TODO: small buffers )
@goto-end ( -> )
;buffer/line-count LDA2 ;term/rows LDA2 ( #00 #00 DIV ) SUB2
DUP2 ;buffer/line-offset STA2
;abs-line JSR2 ;buffer/offset STA2
height #01 SUB ;cursor/row STA
;cur-len JSR2 NIP ;cursor/col STA
;draw-all JSR2
BRK
;more-than-one-screen JSR2 ,&large JCN
;buffer/line-count LDA2 NIP #01 SUB ;cursor/row STA
#0000 ,&continue JMP
&large
height #01 SUB ;cursor/row STA
;buffer/line-count LDA2 ;term/rows LDA2 SUB2
&continue
DUP2 ;buffer/line-offset STA2
;abs-line JSR2 ;buffer/offset STA2
;cur-len JSR2 NIP ;cursor/col STA
;draw-all JSR2 BRK
@goto-start ( -> )
;buffer/data ;buffer/offset STA2
@ -322,6 +346,13 @@
POP2 STH2r NIP ;cursor/row STA
JMP2r
@refresh
;draw-all JSR2 BRK
@debug
;rel-line-error ;error! JMP2
( #00 #00 DIV BRK )
( TODO: M-v for page up and M-> for goto end )
( M-f and M-b for next/previous word )
( M-n and M-p for next/previous paragraph )
@ -345,10 +376,12 @@
.Console/read DEI #04 EQU ( C-d ) ;delete JCN2
.Console/read DEI #05 EQU ( C-e ) ;eol JCN2
.Console/read DEI #06 EQU ( C-f ) ;forward JCN2
.Console/read DEI #0c EQU ( C-l ) ;refresh JCN2
.Console/read DEI #0d EQU ( \r ) ;newline JCN2
.Console/read DEI #0e EQU ( C-n ) ;down JCN2
.Console/read DEI #10 EQU ( C-p ) ;up JCN2
.Console/read DEI #18 EQU ( C-x ) ;quit JCN2
.Console/read DEI #1a EQU ( C-z ) ;debug JCN2
.Console/read DEI #1b EQU ( ESC ) ;escape JCN2
.Console/read DEI #7f EQU ( DEL ) ;backspace JCN2
.Console/read DEI #20 LTH ;ignore JCN2 ( ignore for now )
@ -412,15 +445,23 @@
@draw-all
;term-erase-all JSR2
#00 #00 ;term-move-cursor JSR2
#00 STH
#01 STH
;buffer/offset LDA2
&loop
LDAk #00 EQU ,&eof JCN
LDAk #0a EQU ,&eol JCN
LDAk emit INC2 ,&loop JMP
&eol INCr STHkr last-line ( #17 ) GTH ,&eof JCN
&eol INCr STHkr height GTH ,&done JCN
cr nl INC2 ,&loop JMP
&eof POP2 POPr
&eof
ansi LIT '3 emit LIT '1 emit LIT 'm emit
&eof-loop
STHkr height GTH ,&done JCN
cr nl
LIT '~ emit INCr
,&eof-loop JMP
&done POP2 POPr
ansi LIT '0 emit LIT 'm emit
;draw-statusbar JSR2
;draw-cursor JSR2
JMP2r
@ -465,6 +506,7 @@
@rel-line ( y^ -> s* )
#00 SWP SUB STH ( [-y] )
;buffer/offset LDA2 ( addr* )
STHkr #00 EQU ,&done JCN ( addr [-y] )
&newline ( addr [-y] )
STHkr ,&loop JCN ,&done JMP
&loop ( addr [-y] )
@ -473,7 +515,7 @@
INC2 ,&loop JMP ( addr+1 [-y] )
&found INC2 INCr ( addr+1 [-y+1] ) ,&newline JMP
&done POPr JMP2r
&not-found #00 #00 DIV
&not-found ;rel-line-error ;error! JMP2
@cur-line ( -> s* )
;cursor/row LDA ;rel-line JSR2 JMP2r
@ -484,6 +526,9 @@
@cur-abs-row ( -> n* )
;buffer/line-offset LDA2 #00 ;cursor/row LDA ADD2 JMP2r
@last-abs-row ( -> n* )
;buffer/line-count LDA2 #0001 SUB2 JMP2r
@shift-right ( c^ addr* -> )
ROT STH ( addr [prev^] )
;buffer/limit LDA2 ( addr limit [prev^] )
@ -499,19 +544,24 @@
;buffer/limit STA2 ( )
JMP2r
( TODO: change last/addr order and GTH -> LTH to remove hack )
@shift-left ( addr* -> )
;buffer/limit LDA2 ( addr limit )
#0001 SUB2 SWP2 ( last addr )
&loop GTH2k ,&next JCN ( last addr )
,&done JMP ( 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 )
&done POP2 ( last )
;buffer/limit STA2 ( )
;buffer/limit LDA2 ( addr limit )
#0001 SUB2 SWP2 ( last addr )
&loop GTH2k ,&next JCN ( last addr )
,&done JMP ( 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 )
&done POP2 ( last )
;buffer/limit STA2 ( )
#00 ;buffer/limit LDA2 STA ( ensure null termination )
JMP2r
( TODO: should be using get-col and get-row almost everywhere )
( otherwise, bugs! )
@get-col
;cursor/col LDA ;cur-len JSR2 NIP ;min JSR2 JMP2r
@ -521,6 +571,12 @@
@last-pos
;buffer/limit LDA2 #0001 SUB2 JMP2r
@more-than-one-screen ( -> bool^ )
;buffer/line-count LDA2 ;term/rows LDA2 GTH2 JMP2r
@fits-in-one-screen ( -> bool^ )
;buffer/line-count LDA2 ;term/rows LDA2 INC2 LTH2 JMP2r
@doc-start ( -> s* ) ;buffer/data JMP2r
@doc-limit ( -> s* ) ;buffer/limit LDA2 JMP2r
@doc-last ( -> s* ) ;buffer/limit LDA2 #0001 SUB2 JMP2r