From 765340fde250fae95bf2f350fcaa6289d0e1aa77 Mon Sep 17 00:00:00 2001 From: d6 Date: Sun, 6 Feb 2022 17:07:11 -0500 Subject: [PATCH] femto kind of working --- femto.tal | 262 ++++++++++++++++++++++++++++++++++++++++++++++++++++++ regex.tal | 27 ++++++ 2 files changed, 289 insertions(+) create mode 100644 femto.tal diff --git a/femto.tal b/femto.tal new file mode 100644 index 0000000..63eb820 --- /dev/null +++ b/femto.tal @@ -0,0 +1,262 @@ +( femto.tal ) + +|00 @System [ &vector $2 &wst $1 &rst $1 &pad $4 &r $2 &g $2 &b $2 &debug $1 &halt $1 ] +|10 @Console [ &vector $2 &read $1 &pad $5 &write $1 &error $1 ] +|a0 @File [ &vector $2 &success $2 &stat $2 &delete $1 &append $1 &name $2 &length $2 &read $2 &write $2 ] + +%dbg { #ff .System/debug DEO } +%emit { .Console/write DEO } +%sp { #2018 DEO } +%nl { #0a18 DEO } +%cr { #0d18 DEO } +%exit { #01 .System/halt DEO BRK } + +%ansi { #1b18 DEO #5b18 DEO } + +%WIDTH { #50 } +%LAST-COL { #4f } +%PEN-COL { #4e } + +%HEIGHT { #18 } +%LAST-LINE { #17 } +%PEN-LINE { #16 } + +( useful ASCII ) +( - ESC 1b ) +( - '[' 5b ) +( - ) + +( ANSI sequences ) +( goto $row,$col ESC [ $row ; $col H ) +( goto home ESC [ H ) +( go up ESC [ A ) +( go down ESC [ B ) +( go right ESC [ C ) +( go left ESC [ D ) +( ) +( erase cur->eol ESC [ K ) +( erase cur->sol ESC [ 1 K ) +( erase line ESC [ 2 K ) +( erase line->bot ESC [ J ) +( erase line->top ESC [ 1 J ) +( erase all ESC [ 2 J ) +( ) +( set attrs ESC [ $at1 ; ... m ) +( reset ESC [ m ) + +|0100 + + ;demo-path .File/name DEO2 + #8000 .File/length DEO2 + ;buffer/data .File/read DEO2 + + .File/success DEI2 #0000 GTH2 ,&ok JCN + ;input-error ;println JSR2 nl exit + + &ok + .File/success DEI2 ;buffer/data ADD2 ;buffer/limit STA2 + ;on-key .Console/vector DEO2 + ;draw-all JSR2 + BRK + +@mod-div ( x^ y^ -> x%d x/y ) + DIVk ( x y x/y ) STHk ( x y x/y [x/y] ) MUL ( x y*x/y [x/y] ) + SUB ( x%y [x/y] ) STHr ( x%y x/y ) JMP2r + +@emit-digit ( n^ -> ) + LIT '0 ADD emit JMP2r + +@emit-dec ( n^ -> ) + DUP #63 GTH ,&do3 JCN + DUP #09 GTH ,&do2 JCN + ,&do1 JMP + &do3 #64 ;mod-div JSR2 ;emit-digit JSR2 + &do2 #0a ;mod-div JSR2 ;emit-digit JSR2 + &do1 ;emit-digit JSR2 JMP2r + +@bol + #00 ;cursor/col STA + ;draw-cursor JSR2 BRK + +( FIXME: handle long lines ) +@eol + ;cur-line JSR2 ;line-len JSR2 NIP ;cursor/col STA + ;draw-cursor JSR2 BRK + +( FIXME: handle long lines ) +@forward + ;cursor/col LDA PEN-COL GTH ,&skip JCN + ;cursor/col LDA #01 ADD ;cursor/col STA + ;draw-cursor JSR2 + &skip BRK + +( FIXME: handle long lines ) +@back + ;cursor/col LDA #01 LTH ,&skip JCN + ;cursor/col LDA #01 SUB ;cursor/col STA + ;draw-cursor JSR2 + &skip BRK + +@up + ;cursor/row LDA #01 LTH ,&screen-up JCN + ;cursor/row LDA #01 SUB ;cursor/row STA + ;draw-cursor JSR2 BRK + &screen-up + ;buffer/offset LDA2 DUP2 ;buffer/data EQU2 ,&done JCN + #0001 SUB2 + &loop DUP2 ;buffer/data EQU2 ,&complete JCN + #0001 SUB2 LDAk #0a NEQ ,&loop JCN + INC2 + &complete ;buffer/offset STA2 ;draw-all JSR2 BRK + &done POP2 BRK + +( FIXME: need to handle 'end of buffer' stuff ) +@down + ;cursor/row LDA PEN-LINE GTH ,&screen-down JCN + ;cursor/row LDA #01 ADD ;cursor/row STA + ;draw-cursor JSR2 BRK + &screen-down + #00 ;rel-line JSR2 ;line-len JSR2 INC2 ( add 1 for line ending ) + ;buffer/offset LDA2 ADD2 + ;buffer/offset STA2 + ;draw-all JSR2 + BRK + +@quit exit +@ignore BRK +@die #00 #00 DIV + +@insert ( c^ -> ) + ;cursor/col LDA PEN-COL GTH ,&skip JCN ( FIXME ) + ;cur-pos JSR2 ;shift-right JSR2 + ;cursor/col LDA #01 ADD ;cursor/col STA + ;draw-all JSR2 + &skip BRK + +( FIXME: this is broken, shift-left in particular ) +@backspace ( -> ) + ;cursor/col LDA #00 EQU ,&skip JCN + ;cursor/col LDA #01 SUB ;cursor/col STA + ;cur-pos JSR2 ;shift-left JSR2 + ;draw-all JSR2 + &skip BRK + +@on-key + .Console/read DEI #01 EQU ;bol JCN2 + .Console/read DEI #02 EQU ;back JCN2 + .Console/read DEI #05 EQU ;eol JCN2 + .Console/read DEI #06 EQU ;forward JCN2 + .Console/read DEI #0e EQU ;down JCN2 + .Console/read DEI #10 EQU ;up JCN2 + .Console/read DEI #18 EQU ;quit JCN2 + .Console/read DEI #7f EQU ;backspace JCN2 + .Console/read DEI #20 LTH ;ignore JCN2 ( ignore for now ) + .Console/read DEI #7e GTH ;ignore JCN2 ( ignore for now ) + .Console/read DEI ;insert JMP2 + BRK + +@min ( x^ y^ -> min^ ) + LTHk JMP SWP POP JMP2r + +@draw-cursor + ansi ;get-row JSR2 INC ;emit-dec JSR2 + LIT '; emit ;get-col JSR2 INC ;emit-dec JSR2 + LIT 'H emit JMP2r + +@draw-all + ansi LIT '2 emit LIT 'J emit + ansi LIT 'H emit + #00 STH +( ;buffer/data ) + ;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 + cr nl INC2 ,&loop JMP + &eof POP2 POPr + ;draw-cursor JSR2 + JMP2r + +@println ( s* -> ) + &loop LDAk #00 EQU ,&eof JCN + LDAk #18 DEO INC2 ,&loop JMP + &eof POP2 JMP2r + +@cur-len ( -> n* ) + ;cur-line JSR2 ;line-len JSR2 JMP2r + +@line-len ( s* -> n* ) + #0000 STH2 + &loop LDAk #00 EQU ,&end JCN + LDAk #0a EQU ,&end JCN + INC2 INC2r ,&loop JMP + &end POP2 STH2r JMP2r + +@first-line ( -> s* ) + ;buffer/offset LDA2 JMP2r + +( line number relative to the offset, starting at 0 ) +@rel-line ( y^ -> s* ) + #00 SWP SUB STH ( [-y] ) + ;buffer/offset LDA2 ( addr* ) + &newline ( addr [-y] ) + STHkr ,&loop JCN ,&done JMP + &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 INCr ( addr+1 [-y+1] ) ,&newline JMP + &done POPr JMP2r + ¬-found #00 #00 DIV + +@cur-line ( -> s* ) + ;cursor/row LDA ;rel-line JSR2 JMP2r + +@cur-pos ( -> s* ) + ;cur-line JSR2 #00 ;get-col JSR2 ADD2 JMP2r + +@shift-right ( c^ addr* -> ) + ROT STH ( addr [prev^] ) + ;buffer/limit LDA2 ( addr limit [prev^] ) + #0001 SUB2 SWP2 ( last addr [prev^] ) + &loop LTH2k ,&done JCN ( 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^] ) + &done NIP2 DUP2 ( addr addr [prev^] ) + STHr ROT ROT ( addr prev^ addr ) + STA INC2 ( addr+1 ) + ;buffer/limit STA2 ( ) + JMP2r + +@shift-left ( addr* -> ) + ;buffer/limit LDA2 ( addr limit ) + #0001 SUB2 SWP2 ( last addr ) + &loop GTHk ,&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 ( ) + JMP2r + +@input-error "input 20 "error 00 +@demo-path "math32.txt 00 + +( col is 0-79, row is 0-23 ) +@cursor [ &col 00 &row 00 ] + +@get-col + ;cursor/col LDA ;cur-len JSR2 NIP ;min JSR2 JMP2r +@get-row + ;cursor/row LDA JMP2r + +|1ffc +( offset is address of the first visible line ) +( size is total size of data in bytes ) +@buffer [ &limit 0000 &offset :buffer/data &data $8000 ] diff --git a/regex.tal b/regex.tal index 1a5e42e..5cd7d43 100644 --- a/regex.tal +++ b/regex.tal @@ -563,3 +563,30 @@ @arena-pos :arena-bot ( the next position to allocate ) @arena-bot $400 @arena-top ( holds up to 1024 bytes ) + +( INTERVAL OPERATIONS ) +( ) +( ) + +@min ( first* last* -> min-addr* ) + SWP2 STH2k ,&incr JMP ( last first [first] ) + &loop LDAk LDAkr STHr LTH ,&replace JCN ,&incr JMP ( last a [c] ) + &replace POP2r STH2k ( last a [a] ) + &incr EQUk ,&done JCN INC2 ,&loop JMP ( last a+1 [c] ) + &done POP2 POP2 STH2r JMP2r ( c ) + +@sort ( first* last* -> ) + SWP2 ( last first ) + &loop ;min JSR2 NEQk ,&swap JCN POP2 ,&incr JMP + &swap STH2 LDA2k ( last first fx [min] ) STH2kr STA STH2r SWP2 ( last min first ) + STH2 LDA2 ( last mx [first] ) STH2kr STA STH2r ( last first ) + &incr EQUk ,&done JCN INC2 ,&loop JMP + &done POP2 POP2 JMP2r + +@iv-in-range ( c^ b0^ b1^ -> bool^ ) + ROT STHk LTH ,&above JCN + STHr GTH ,&below JCN #01 JMP2r + &above POPr POP &below #00 JMP2r + +@iv-find ( c^ iv* -> bool^ ) + \ No newline at end of file