From 81091fc7da72e69d610a4ca2f7bc51d08a9f18ea Mon Sep 17 00:00:00 2001 From: ketmar Date: Thu, 26 Oct 2023 08:27:56 +0000 Subject: [PATCH] asm: added simple .SNA writer FossilOrigin-Name: 64837b23911e893292227f8e90debc527a28910664acb1f52f6e91be92026ae9 --- dox/urforth.txt | 6 ++- src/liburforth/urforth.c | 37 ++++++++----- urflibs/urasm/00-main-loader.f | 1 + urflibs/urasm/asm-test.f | 3 ++ urflibs/urasm/emit.f | 22 ++++++++ urflibs/urasm/ext/org.f | 11 ++++ urflibs/urasm/{ => writers}/00-main-loader.f | 15 ++---- urflibs/urasm/writers/sna-data.f | 77 ++++++++++++++++++++++++++++ urflibs/urasm/writers/sna.f | 69 +++++++++++++++++++++++++ 9 files changed, 215 insertions(+), 26 deletions(-) copy urflibs/urasm/{ => writers}/00-main-loader.f (55%) create mode 100644 urflibs/urasm/writers/sna-data.f create mode 100644 urflibs/urasm/writers/sna.f diff --git a/dox/urforth.txt b/dox/urforth.txt index 7c89552..f176ae2 100644 --- a/dox/urforth.txt +++ b/dox/urforth.txt @@ -1855,6 +1855,10 @@ check if raw TTY has some data to read. file i/o words. +FILES:ERRNO +( -- errno ) +last libc `errno`. can be used after failure to inspect error code. + FILES:UNLINK ( addr count -- success? ) delete file. @@ -1907,6 +1911,6 @@ read bytes from file. reading less then requested number of bytes is error. `count` can be 0 (in this case the function always succeeds). FILES:WRITE -( addr count handle -- rdsize TRUE / FALSE ) +( addr count handle -- TRUE / FALSE ) write bytes from file. writing less bytes than requested is error. `count` can be 0 (in this case the function always succeeds). diff --git a/src/liburforth/urforth.c b/src/liburforth/urforth.c index 1e87f7e..998819b 100644 --- a/src/liburforth/urforth.c +++ b/src/liburforth/urforth.c @@ -6212,6 +6212,12 @@ static char *ufoPopFileName (void) { return ufoFNameBuf; } +// FILES:ERRNO +// ( -- errno ) +UFWORD(FILES_ERRNO) { + ufoPush((uint32_t)errno); +} + // FILES:UNLINK // ( addr count -- success? ) UFWORD(FILES_UNLINK) { @@ -6262,8 +6268,8 @@ UFWORD(FILES_CREATE) { // FILES:CLOSE // ( handle -- success? ) UFWORD(FILES_CLOSE) { - const uint32_t fd = ufoPop(); - if (fd >= 0x80000000U) ufoFatal("invalid file handle in 'CLOSE'"); + const int32_t fd = (int32_t)ufoPop(); + if (fd < 0) ufoFatal("invalid file handle in 'CLOSE'"); ufoPushBool(close(fd) == 0); } @@ -6271,8 +6277,8 @@ UFWORD(FILES_CLOSE) { // ( handle -- ofs TRUE / FALSE ) // `handle` cannot be 0. UFWORD(FILES_TELL) { - const uint32_t fd = ufoPop(); - if (fd == 0 || fd >= 0x80000000U) ufoFatal("invalid file handle in 'TELL'"); + const int32_t fd = (int32_t)ufoPop(); + if (fd < 0) ufoFatal("invalid file handle in 'TELL'"); const off_t pos = lseek(fd, 0, SEEK_CUR); if (pos != (off_t)-1) { ufoPush((uint32_t)pos); @@ -6286,10 +6292,10 @@ UFWORD(FILES_TELL) { // ( ofs whence handle -- TRUE / FALSE ) // `handle` cannot be 0. UFWORD(FILES_SEEK_EX) { - const uint32_t fd = ufoPop(); + const int32_t fd = (int32_t)ufoPop(); const uint32_t whence = ufoPop(); const uint32_t ofs = ufoPop(); - if (fd == 0 || fd >= 0x80000000U) ufoFatal("invalid file handle in 'SEEK-EX'"); + if (fd < 0) ufoFatal("invalid file handle in 'SEEK-EX'"); if (whence != (uint32_t)SEEK_SET && whence != (uint32_t)SEEK_CUR && whence != (uint32_t)SEEK_END) ufoFatal("invalid `whence` in 'SEEK-EX'"); @@ -6301,8 +6307,8 @@ UFWORD(FILES_SEEK_EX) { // ( handle -- size TRUE / FALSE ) // `handle` cannot be 0. UFWORD(FILES_SIZE) { - const uint32_t fd = ufoPop(); - if (fd == 0 || fd >= 0x80000000U) ufoFatal("invalid file handle in 'SIZE'"); + const int32_t fd = (int32_t)ufoPop(); + if (fd < 0) ufoFatal("invalid file handle in 'SIZE'"); const off_t origpos = lseek(fd, 0, SEEK_CUR); if (origpos == (off_t)-1) { ufoPushBool(0); @@ -6324,8 +6330,8 @@ UFWORD(FILES_SIZE) { // ( addr count handle -- rdsize TRUE / FALSE ) // `handle` cannot be 0. UFWORD(FILES_READ) { - const uint32_t fd = ufoPop(); - if (fd == 0 || fd >= 0x80000000U) ufoFatal("invalid file handle in 'READ'"); + const int32_t fd = (int32_t)ufoPop(); + if (fd < 0) ufoFatal("invalid file handle in 'READ'"); uint32_t count = ufoPop(); uint32_t addr = ufoPop(); uint32_t done = 0; @@ -6359,8 +6365,8 @@ UFWORD(FILES_READ) { // ( addr count handle -- TRUE / FALSE ) // `handle` cannot be 0. UFWORD(FILES_READ_EXACT) { - const uint32_t fd = ufoPop(); - if (fd == 0 || fd >= 0x80000000U) ufoFatal("invalid file handle in 'READ-EXACT'"); + const int32_t fd = (int32_t)ufoPop(); + if (fd < 0) ufoFatal("invalid file handle in 'READ-EXACT'"); uint32_t count = ufoPop(); uint32_t addr = ufoPop(); if (count != 0) { @@ -6392,8 +6398,8 @@ UFWORD(FILES_READ_EXACT) { // ( addr count handle -- TRUE / FALSE ) // `handle` cannot be 0. UFWORD(FILES_WRITE) { - const uint32_t fd = ufoPop(); - if (fd == 0 || fd >= 0x80000000U) ufoFatal("invalid file handle in 'WRITE'"); + const int32_t fd = (int32_t)ufoPop(); + if (fd < 0) ufoFatal("invalid file handle in 'WRITE'"); uint32_t count = ufoPop(); uint32_t addr = ufoPop(); if (count != 0) { @@ -6408,6 +6414,7 @@ UFWORD(FILES_WRITE) { const ssize_t xres = write(fd, ufoFileIOBuffer, wr); if (xres >= 0) { wr = (uint32_t)xres; break; } if (errno == EINTR) continue; + fprintf(stderr, "ERRNO: %d (fd=%d)\n", errno, fd); //if (errno == EAGAIN || errno == EWOULDBLOCK) { wr = 0; break; } // error ufoPushBool(0); @@ -8237,6 +8244,8 @@ UFO_DISABLE_INLINE void ufoInitFilesWords (void) { UFWORDX("UNLINK", FILES_UNLINK); + UFWORDX("ERRNO", FILES_ERRNO); + ufoInterpretLine( ": SEEK ( ofs handle -- success? ) " " SEEK-SET FORTH:SWAP SEEK-EX " diff --git a/urflibs/urasm/00-main-loader.f b/urflibs/urasm/00-main-loader.f index fb0e46d..94629c9 100644 --- a/urflibs/urasm/00-main-loader.f +++ b/urflibs/urasm/00-main-loader.f @@ -14,6 +14,7 @@ $include-once $include-once $include-once +$include-once asm-emit:init-memory diff --git a/urflibs/urasm/asm-test.f b/urflibs/urasm/asm-test.f index f691b8a..fa39015 100644 --- a/urflibs/urasm/asm-test.f +++ b/urflibs/urasm/asm-test.f @@ -147,5 +147,8 @@ previous $ELSE assemble-simple disasm + " zxsnap.sna" files:create " cannot create output .SNA" ?not-error + dup asm-writers:write-sna-48 + files:close drop $ENDIF ; diff --git a/urflibs/urasm/emit.f b/urflibs/urasm/emit.f index 7108f9e..ffdbf29 100644 --- a/urflibs/urasm/emit.f +++ b/urflibs/urasm/emit.f @@ -45,6 +45,8 @@ create zx-mflags 65536 allot create; 0 value pc-$ 0 value pc 0 value disp +-1 value ent +-1 value clr : instruction-start ( -- ) @@ -56,6 +58,26 @@ create zx-mflags 65536 allot create; : .hex4 ( n -- ) base @ hex swap <# # # # # #> type base ! ; : .hex4-r ( n -- ) dup .hex2 space -8 lsh .hex2 ; +;; used in various unpackers (RLE, for example) +;; doesn't change flags +: c!-if-free ( value addr -- ) + dup 0x1_0000 u< if + dup zx-mflags + c@ zx-mflag-used and ifnot + zx-mem + c! + else 2drop endif + else 2drop endif +; + +;; doesn't change flags +: cmove-from-normal ( src zx-dest count -- ) + for + dup 0x1_0000 u< if + over c@ over zx-mem + c! + 1+ swap 1+ swap + endif + endfor 2drop +; + : here ( -- addr ) disp ; : or-c! ( value addr -- ) diff --git a/urflibs/urasm/ext/org.f b/urflibs/urasm/ext/org.f index b37e07c..b388c0c 100644 --- a/urflibs/urasm/ext/org.f +++ b/urflibs/urasm/ext/org.f @@ -7,18 +7,29 @@ ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +also-defs: asm-helpers + +: (fix-ent-clr) ( -- ) + asm-emit:ent -if asm-emit:pc to asm-emit:ent endif + asm-emit:clr -if asm-emit:pc 1- to asm-emit:clr endif +; + +previous + also-defs: asm-instr : ORG ( -- ) next-token asm-expr:expression-const dup 0 65536 within " invalid ORG address" ?not-error dup to asm-emit:pc to asm-emit:disp + asm-helpers:(fix-ent-clr) ; : DISP ( -- ) next-token asm-expr:expression-const dup 0 65536 within " invalid ORG address" ?not-error to asm-emit:disp + asm-helpers:(fix-ent-clr) ; prev-defs diff --git a/urflibs/urasm/00-main-loader.f b/urflibs/urasm/writers/00-main-loader.f similarity index 55% copy from urflibs/urasm/00-main-loader.f copy to urflibs/urasm/writers/00-main-loader.f index fb0e46d..16ee4a1 100644 --- a/urflibs/urasm/00-main-loader.f +++ b/urflibs/urasm/writers/00-main-loader.f @@ -5,17 +5,10 @@ ;; GPLv3 ONLY ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -$include-once -$include-once -$include-once -$include-once -$include-once -$include-once -$include-once -$include-once +vocab-if-none asm-writers +also-defs: asm-writers -asm-emit:init-memory +$include-once - -$include-once +prev-defs diff --git a/urflibs/urasm/writers/sna-data.f b/urflibs/urasm/writers/sna-data.f new file mode 100644 index 0000000..26e6fa1 --- /dev/null +++ b/urflibs/urasm/writers/sna-data.f @@ -0,0 +1,77 @@ +;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; and now for something completely different... +;; UrForth/C Forth Engine! +;; Copyright (C) 2023 Ketmar Dark // Invisible Vector +;; GPLv3 ONLY +;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; .SNA writer: header data +;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +create ursna48 here +0x3f c, 0x00 c, 0x00 c, 0x9b c, 0x36 c, 0x21 c, 0x17 c, 0x44 c, 0x00 c, 0xe8 c, 0x5c c, 0xad c, 0x1a c, 0xa1 c, 0x1e c, 0x3a c, +0x5c c, 0xd4 c, 0x03 c, 0x04 c, 0x2c c, 0x98 c, 0x33 c, 0x80 c, 0x5d c, 0x01 c, 0x07 c, 0xff c, 0x00 c, 0xff c, 0x00 c, 0xff c, +0x00 c, 0xff c, 0x00 c, 0xff c, 0x00 c, 0xff c, 0x00 c, 0xff c, 0x00 c, 0xff c, 0x00 c, 0xff c, 0x00 c, 0xff c, 0x00 c, 0xff c, +0x00 c, 0xff c, 0x00 c, 0xff c, 0x00 c, 0xff c, 0x00 c, 0xff c, 0x00 c, 0xff c, 0x00 c, 0xff c, 0x00 c, 0xff c, 0x00 c, 0xff c, +0x00 c, 0xff c, 0x00 c, 0xff c, 0x00 c, 0xff c, 0x00 c, 0xff c, 0x00 c, 0xff c, 0x00 c, 0x18 c, 0x00 c, 0xff c, 0x38 c, 0xff c, +0x38 c, 0xff c, 0x38 c, 0x03 c, 0x38 c, 0xff c, 0x00 c, 0x00 c, 0x08 c, 0x00 c, 0xff c, 0x00 c, 0x20 c, 0x33 c, 0x0d c, 0x05 c, +0x23 c, 0x0d c, 0x00 c, 0x03 c, 0x0d c, 0x23 c, 0x05 c, 0x00 c, 0x04 c, 0x00 c, 0x00 c, 0x0d c, 0x01 c, 0x00 c, 0x06 c, 0x00 c, +0x0b c, 0x00 c, 0x01 c, 0x00 c, 0x01 c, 0x00 c, 0x06 c, 0x00 c, 0x10 c, 0x00 c, 0x19 c, 0x00 c, 0x00 c, 0x0a c, 0x3c c, 0x40 c, +0x00 c, 0xff c, 0xcc c, 0x01 c, 0x84 c, 0x5d c, 0x54 c, 0xff c, 0x00 c, 0x02 c, 0x00 c, 0x00 c, 0x09 c, 0xff c, 0xfe c, 0xff c, +0x01 c, 0x38 c, 0x0a c, 0x00 c, 0xe4 c, 0x5c c, 0x00 c, 0x00 c, 0x11 c, 0x00 c, 0xb6 c, 0x5c c, 0xb6 c, 0x5c c, 0xcb c, 0x5c c, +0xe7 c, 0x5c c, 0xca c, 0x5c c, 0xe5 c, 0x5c c, 0xe6 c, 0x5c c, 0xe6 c, 0x5c c, 0x00 c, 0x00 c, 0x0c c, 0x00 c, 0xe8 c, 0x5c c, +0xe8 c, 0x5c c, 0xed c, 0x5c c, 0xff c, 0x92 c, 0x5c c, 0x10 c, 0x02 c, 0x00 c, 0x07 c, 0x00 c, 0x00 c, 0x02 c, 0xac c, 0x1a c, +0x00 c, 0x00 c, 0x06 c, 0x00 c, 0xab c, 0x06 c, 0x00 c, 0x58 c, 0xff c, 0x00 c, 0x00 c, 0x12 c, 0x00 c, 0x21 c, 0x00 c, 0x5b c, +0x21 c, 0x17 c, 0x00 c, 0x40 c, 0xe0 c, 0x50 c, 0x21 c, 0x18 c, 0x21 c, 0x17 c, 0x01 c, 0x38 c, 0x00 c, 0x38 c, 0x00 c, 0x08 c, +0x00 c, 0x00 c, 0x01 c, 0x0a c, 0x00 c, 0x03 c, 0x00 c, 0x00 c, 0x01 c, 0x0a c, 0x00 c, 0x12 c, 0x00 c, 0x00 c, 0x02 c, 0x87 c, +0x5d c, 0xff c, 0x00 c, 0x1f c, 0xff c, 0xf4 c, 0x09 c, 0xa8 c, 0x10 c, 0x4b c, 0xf4 c, 0x09 c, 0xc4 c, 0x15 c, 0x53 c, 0x81 c, +0x0f c, 0xc4 c, 0x15 c, 0x52 c, 0xf4 c, 0x09 c, 0xc4 c, 0x15 c, 0x50 c, 0x80 c, 0x00 c, 0x0a c, 0x15 c, 0x00 c, 0xfd c, 0xb0 c, +0x22 c, 0x32 c, 0x34 c, 0x39 c, 0x02 c, 0x39 c, 0x00 c, 0x08 c, 0x22 c, 0x3a c, 0xf9 c, 0xc0 c, 0xb0 c, 0x22 c, 0x32 c, 0x35 c, +0x30 c, 0x02 c, 0x30 c, 0x00 c, 0x06 c, 0x22 c, 0x0d c, 0x80 c, 0xf7 c, 0x0d c, 0x80 c, 0x00 c, 0x05 c, 0x00 c, 0x00 c, 0x05 c, +0x87 c, 0x5d c, 0x00 c, 0x0d c, 0x80 c, 0x00 c, 0x00 c, 0x03 c, 0x00 c, 0x87 c, 0x5d c, 0x00 c, 0x00 c, 0x02 c, 0x00 c, 0x0a c, +0x00 c, 0x00 c, 0x02 c, 0x00 c, 0x80 c, 0x00 c, 0x4a c, 0x00 c, 0x00 c, 0x40 c, 0xf3 c, 0x0d c, 0xce c, 0x0b c, 0xe2 c, 0x50 c, +0xce c, 0x0b c, 0xe3 c, 0x50 c, 0x1e c, 0x17 c, 0xdc c, 0x0a c, 0xce c, 0x0b c, 0xe4 c, 0x50 c, 0x1d c, 0x17 c, 0xdc c, 0x0a c, +0xd7 c, 0x18 c, 0x02 c, 0x00 c, 0x38 c, 0x00 c, 0x0d c, 0x19 c, 0xe6 c, 0x5c c, 0xa9 c, 0x18 c, 0xdb c, 0x02 c, 0x4d c, 0x00 c, +0xb1 c, 0x33 c, 0xe8 c, 0x5c c, 0x05 c, 0x00 c, 0xc8 c, 0x32 c, 0x29 c, 0x34 c, 0x9b c, 0x36 c, 0x65 c, 0x33 c, 0xed c, 0x1c c, +0xf1 c, 0x1b c, 0xa1 c, 0x1e c, 0x76 c, 0x1b c, 0x03 c, 0x13 c, 0x00 c, 0x3e c, 0x00 c, 0xff c, 0x00 c, 0xff c, 0x00 c, 0xff c, +0x00 c, 0xff c, 0x00 c, 0xff c, 0x00 c, 0xff c, 0x00 c, 0xff c, 0x00 c, 0xff c, 0x00 c, 0xff c, 0x00 c, 0xff c, 0x00 c, 0xff c, +0x00 c, 0xff c, 0x00 c, 0xff c, 0x00 c, 0xff c, 0x00 c, 0xff c, 0x00 c, 0xff c, 0x00 c, 0xff c, 0x00 c, 0xff c, 0x00 c, 0xff c, +0x00 c, 0xff c, 0x00 c, 0xff c, 0x00 c, 0xff c, 0x00 c, 0xff c, 0x00 c, 0xff c, 0x00 c, 0xff c, 0x00 c, 0xff c, 0x00 c, 0xff c, +0x00 c, 0xff c, 0x00 c, 0xff c, 0x00 c, 0xff c, 0x00 c, 0xff c, 0x00 c, 0xff c, 0x00 c, 0xff c, 0x00 c, 0xff c, 0x00 c, 0xff c, +0x00 c, 0xff c, 0x00 c, 0xff c, 0x00 c, 0xff c, 0x00 c, 0xff c, 0x00 c, 0xff c, 0x00 c, 0xff c, 0x00 c, 0xff c, 0x00 c, 0xff c, +0x00 c, 0xff c, 0x00 c, 0xff c, 0x00 c, 0xff c, 0x00 c, 0xff c, 0x00 c, 0xff c, 0x00 c, 0xff c, 0x00 c, 0xff c, 0x00 c, 0xff c, +0x00 c, 0xff c, 0x00 c, 0xff c, 0x00 c, 0xff c, 0x00 c, 0xff c, 0x00 c, 0xff c, 0x00 c, 0xff c, 0x00 c, 0xff c, 0x00 c, 0xff c, +0x00 c, 0xff c, 0x00 c, 0xff c, 0x00 c, 0xff c, 0x00 c, 0xff c, 0x00 c, 0xff c, 0x00 c, 0xff c, 0x00 c, 0xff c, 0x00 c, 0xff c, +0x00 c, 0xff c, 0x00 c, 0xff c, 0x00 c, 0xff c, 0x00 c, 0xff c, 0x00 c, 0xff c, 0x00 c, 0xff c, 0x00 c, 0xff c, 0x00 c, 0xff c, +0x00 c, 0xff c, 0x00 c, 0xff c, 0x00 c, 0xff c, 0x00 c, 0xff c, 0x00 c, 0xff c, 0x00 c, 0xff c, 0x00 c, 0xff c, 0x00 c, 0xff c, +0x00 c, 0xff c, 0x00 c, 0xff c, 0x00 c, 0xff c, 0x00 c, 0xff c, 0x00 c, 0xff c, 0x00 c, 0xff c, 0x00 c, 0xff c, 0x00 c, 0xff c, +0x00 c, 0xff c, 0x00 c, 0xff c, 0x00 c, 0xff c, 0x00 c, 0xff c, 0x00 c, 0xff c, 0x00 c, 0xff c, 0x00 c, 0xff c, 0x00 c, 0xff c, +0x00 c, 0xff c, 0x00 c, 0xff c, 0x00 c, 0xff c, 0x00 c, 0xff c, 0x00 c, 0xff c, 0x00 c, 0xff c, 0x00 c, 0xff c, 0x00 c, 0xff c, +0x00 c, 0xff c, 0x00 c, 0xff c, 0x00 c, 0xff c, 0x00 c, 0xff c, 0x00 c, 0xff c, 0x00 c, 0xff c, 0x00 c, 0xff c, 0x00 c, 0xff c, +0x00 c, 0xff c, 0x00 c, 0xff c, 0x00 c, 0xff c, 0x00 c, 0xff c, 0x00 c, 0xff c, 0x00 c, 0xff c, 0x00 c, 0xff c, 0x00 c, 0xff c, +0x00 c, 0xff c, 0x00 c, 0xff c, 0x00 c, 0xff c, 0x00 c, 0xff c, 0x00 c, 0xff c, 0x00 c, 0xff c, 0x00 c, 0xff c, 0x00 c, 0xff c, +0x00 c, 0xff c, 0x00 c, 0xff c, 0x00 c, 0xff c, 0x00 c, 0xff c, 0x00 c, 0xff c, 0x00 c, 0xff c, 0x00 c, 0xff c, 0x00 c, 0xff c, +0x00 c, 0xff c, 0x00 c, 0xff c, 0x00 c, 0xff c, 0x00 c, 0xff c, 0x00 c, 0xff c, 0x00 c, 0xff c, 0x00 c, 0xff c, 0x00 c, 0xff c, +0x00 c, 0xff c, 0x00 c, 0xff c, 0x00 c, 0xff c, 0x00 c, 0xff c, 0x00 c, 0xff c, 0x00 c, 0xff c, 0x00 c, 0xff c, 0x00 c, 0xff c, +0x00 c, 0xff c, 0x00 c, 0xff c, 0x00 c, 0xff c, 0x00 c, 0xff c, 0x00 c, 0xff c, 0x00 c, 0xff c, 0x00 c, 0xff c, 0x00 c, 0x29 c, +0x00 c, 0x00 c, 0x4a c, 0xdb c, 0x02 c, 0xdb c, 0x02 c, 0x4d c, 0x00 c, 0xb7 c, 0x5c c, 0xf3 c, 0x0d c, 0xce c, 0x0b c, 0xe4 c, +0x50 c, 0xce c, 0x0b c, 0xe5 c, 0x50 c, 0x1c c, 0x17 c, 0xdc c, 0x0a c, 0xce c, 0x0b c, 0xeb c, 0x50 c, 0x16 c, 0x17 c, 0xdc c, +0x0a c, 0xd7 c, 0x18 c, 0xb1 c, 0x33 c, 0xf7 c, 0x5c c, 0x05 c, 0x00 c, 0xdb c, 0x02 c, 0x4d c, 0x00 c, 0x70 c, 0x56 c, 0x90 c, +0x00 c, 0x6f c, 0x56 c, 0x8c c, 0x08 c, 0x5c c, 0x0e c, 0x00 c, 0x47 c, 0xc0 c, 0x57 c, 0x71 c, 0x0e c, 0xf3 c, 0x0d c, 0x21 c, +0x17 c, 0xc6 c, 0x1e c, 0x87 c, 0x5d c, 0x76 c, 0x1b c, 0x03 c, 0x13 c, 0x00 c, 0x3e c, 0x00 c, 0x3c c, 0x42 c, 0x00 c, 0x02 c, +0x42 c, 0x7e c, 0x42 c, 0x00 c, 0x01 c, 0x42 c, 0x00 c, 0x00 c, 0x04 c, 0x00 c, 0x7c c, 0x42 c, 0x7c c, 0x42 c, 0x00 c, 0x02 c, +0x42 c, 0x7c c, 0x00 c, 0x00 c, 0x03 c, 0x00 c, 0x3c c, 0x42 c, 0x40 c, 0x00 c, 0x03 c, 0x40 c, 0x42 c, 0x3c c, 0x00 c, 0x00 c, +0x03 c, 0x00 c, 0x78 c, 0x44 c, 0x42 c, 0x00 c, 0x03 c, 0x42 c, 0x44 c, 0x78 c, 0x00 c, 0x00 c, 0x04 c, 0x00 c, 0x7e c, 0x40 c, +0x7c c, 0x40 c, 0x00 c, 0x02 c, 0x40 c, 0x7e c, 0x00 c, 0x00 c, 0x04 c, 0x00 c, 0x7e c, 0x40 c, 0x7c c, 0x40 c, 0x02 c, 0x40 c, +0x02 c, 0x00 c, 0x00 c, 0x06 c, 0x3c c, 0x42 c, 0x40 c, 0x4e c, 0x42 c, 0x3c c, 0x00 c, 0x00 c, 0x01 c, 0x00 c, 0x42 c, 0x00 c, +0x02 c, 0x42 c, 0x7e c, 0x42 c, 0x02 c, 0x42 c, 0x02 c, 0x00 c, 0x00 c, 0x01 c, 0x3e c, 0x08 c, 0x03 c, 0x08 c, 0x00 c, 0x01 c, +0x3e c, 0x00 c, 0x00 c, 0x01 c, 0x00 c, 0x02 c, 0x02 c, 0x02 c, 0x02 c, 0x42 c, 0x00 c, 0x01 c, 0x3c c, 0x00 c, 0x00 c, 0x07 c, +0x00 c, 0x44 c, 0x48 c, 0x70 c, 0x48 c, 0x44 c, 0x42 c, 0x00 c, 0x00 c, 0x01 c, 0x00 c, 0x40 c, 0x04 c, 0x40 c, 0x00 c, 0x01 c, +0x7e c, 0x00 c, 0x00 c, 0x04 c, 0x00 c, 0x42 c, 0x66 c, 0x5a c, 0x42 c, 0x02 c, 0x42 c, 0x02 c, 0x00 c, 0x00 c, 0x06 c, 0x42 c, +0x62 c, 0x52 c, 0x4a c, 0x46 c, 0x42 c, 0x00 c, 0x00 c, 0x02 c, 0x00 c, 0x3c c, 0x42 c, 0x03 c, 0x42 c, 0x00 c, 0x01 c, 0x3c c, +0x00 c, 0x00 c, 0x02 c, 0x00 c, 0x7c c, 0x42 c, 0x00 c, 0x02 c, 0x42 c, 0x7c c, 0x40 c, 0x00 c, 0x01 c, 0x40 c, 0x00 c, 0x00 c, +0x02 c, 0x00 c, 0x3c c, 0x42 c, 0x00 c, 0x04 c, 0x42 c, 0x52 c, 0x4a c, 0x3c c, 0x00 c, 0x00 c, 0x02 c, 0x00 c, 0x7c c, 0x42 c, +0x00 c, 0x04 c, 0x42 c, 0x7c c, 0x44 c, 0x42 c, 0x00 c, 0x00 c, 0x07 c, 0x00 c, 0x3c c, 0x40 c, 0x3c c, 0x02 c, 0x42 c, 0x3c c, +0x00 c, 0x00 c, 0x02 c, 0x00 c, 0xfe c, 0x10 c, 0x04 c, 0x10 c, 0x02 c, 0x00 c, 0x05 c, 0x42 c, 0x00 c, 0x01 c, 0x3c c, 0x00 c, +here swap - +create; +constant ursna48-size diff --git a/urflibs/urasm/writers/sna.f b/urflibs/urasm/writers/sna.f new file mode 100644 index 0000000..b9df3dd --- /dev/null +++ b/urflibs/urasm/writers/sna.f @@ -0,0 +1,69 @@ +;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; and now for something completely different... +;; UrForth/C Forth Engine! +;; Copyright (C) 2023 Ketmar Dark // Invisible Vector +;; GPLv3 ONLY +;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; 48K/128K .SNA writer +;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + + +$include-once + + +: rle-unpack-to-zx ( src-addr zx-dest-addr src-len -- ) + a>r rot >a ;; copy src to A + begin over 0x1_0000 u< over 2 >= and while ( zx-dest src-len ) + 2- >r ( zx-dest | len ) + c@a +1>a c@a +1>a ( zx-dest cnt byte | len ) + over ifnot ( zx-dest 0 byte | len ) -- copy + nip 1+ r> over - >r for ( zx-dest | len ) + c@a +1>a over asm-emit:c!-if-free 1+ + endfor + else ( zx-dest cnt byte | len ) -- fill + nrot for 2dup asm-emit:c!-if-free 1+ endfor nip + endif + r> + repeat 2drop r>a +; + + +: (prepare-sna-header) ( -- ) + ursna48 27 + 16384 ursna48-size 27 - rle-unpack-to-zx + ;; patch CLEAR + asm-emit:clr dup +0if + base @ decimal swap <# # # # # # #> 23762 swap asm-emit:cmove-from-normal base ! + else drop endif + ;; patch USR + asm-emit:ent dup -if drop 0 endif + base @ decimal swap <# # # # # # #> 23773 swap asm-emit:cmove-from-normal base ! +; + +: write-sna-48 ( fd -- ) + ursna48 23 + w@ + dup asm-emit:used? swap 1+ asm-emit:used? or " cannot write .SNA (stack overlap)" ?error + (prepare-sna-header) + >r ( | fd ) + ;; write registers + ursna48 27 r@ files:write " error writing .SNA file header" ?not-error + ;; write memory + asm-emit:zx-mem 16384 + 49152 r@ files:write " error writing .SNA file memory" ?not-error + rdrop +; + +: write-sna-128 ( fd -- ) + dup >r write-sna-48 + ;; start address + ursna48 23 + 2 r@ files:write " error writing .SNA file 128K start address" ?not-error + ;; flags: 0x7FFD state, "TR-DOS active" flag + 0x10 asm-emit:zx-mem c! + asm-emit:zx-mem 1+ 0! + asm-emit:zx-mem 2 r@ files:write " error writing .SNA file 12K flags" ?not-error + asm-emit:zx-mem 16384 erase ;; empty page + 8 for + i 1 = i 4 = or ifnot + asm-emit:zx-mem 16384 r@ files:write " error writing .SNA file 128K page" ?not-error + endif + endfor + rdrop +; -- 2.11.4.GIT