Subversion Repositories Spectranet

;The MIT License

;

;Copyright (c) 2009 Dylan Smith

;

;Permission is hereby granted, free of charge, to any person obtaining a copy

;of this software and associated documentation files (the "Software"), to deal

;in the Software without restriction, including without limitation the rights

;to use, copy, modify, merge, publish, distribute, sublicense, and/or sell

;copies of the Software, and to permit persons to whom the Software is

;furnished to do so, subject to the following conditions:

;

;The above copyright notice and this permission notice shall be included in

;all copies or substantial portions of the Software.

;

;THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR

;IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,

;FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE

;AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER

;LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,

;OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN

;THE SOFTWARE.

; TNFS BASIC extensions

.include        "zxrom.inc"

.include        "spectranet.inc"

.include        "defs.inc"

.include        "fcntl.inc"

.include        "sysvars.inc"

.include        "zxsysvars.inc"

.text

;---------------------------------------------------------------------------

; F_tbas_mount

; BASIC interpreter for "mount"

; Syntax: %mount mountpoint, "url"

.globl F_tbas_mount

F_tbas_mount:

        ; Syntax and runtime

        rst CALLBAS

        defw ZX_EXPT1_NUM

        cp ','                          ; comma

        jp nz, PARSE_ERROR

        rst CALLBAS

        defw ZX_NEXT_CHAR

        rst CALLBAS

        defw ZX_EXPT_EXP                ; string parameter - an URL

        call STATEMENT_END              ; followed by statement end

        ; -------- Runtime only ---------

        ld hl, INTERPWKSPC              ; clear space for the

        ld de, INTERPWKSPC+1            ; mount argument structure

        ld bc, 9

        ld (hl), 0

        ldir

        rst CALLBAS

        defw ZX_STK_FETCH               ; path string

        ld hl, INTERPWKSPC+10

        call F_basstrcpy                ; copy string from BASIC

        ld ix, INTERPWKSPC              ; where to place the mount struct

        ld hl, INTERPWKSPC+10           ; location of the string to parse

        call F_parseurl

        jr c, .badurl1

        rst CALLBAS                     ; fetch the mount point

        defw ZX_FIND_INT2

.mount1:

        ld a, c                         ; mount point in BC

        call MOUNT

        jp c, J_tbas_error              ; display the error message

        jp EXIT_SUCCESS

.badurl1:

        ld a, EBADURL

        jp J_tbas_error

        ; Copy a BASIC string to a C string.

        ; BASIC string in DE, C string (dest) in HL

.globl F_basstrcpy

F_basstrcpy:

        ld a, b                         ; end of string?

        or c

        jr z, .terminate2

        ld a, (de)

        ld (hl), a

        inc hl

        inc de

        dec bc

        jr F_basstrcpy

.terminate2:

        xor a                           ; put the null on the end

        ld (hl), a

        inc hl

        ret

;----------------------------------------------------------------------------

; F_tbas_umount

; Umount the mounted filesystem.

.globl F_tbas_umount

F_tbas_umount:

        rst CALLBAS

        defw ZX_EXPT1_NUM               ; 1 parameter - mount point number

        call STATEMENT_END

        ;--------- runtime ---------

        rst CALLBAS

        defw ZX_FIND_INT2

        ld a, c                         ; mount point is in BC

        call UMOUNT

        jp c, J_tbas_error

        jp EXIT_SUCCESS

;----------------------------------------------------------------------------

; F_tbas_chdir

; Handle changing directory

.globl F_tbas_chdir

F_tbas_chdir:

        rst CALLBAS

        defw ZX_EXPT_EXP                ; expect a string expression

        call STATEMENT_END

        ;-------- runtime --------

        rst CALLBAS

        defw ZX_STK_FETCH               ; get the string

        ld hl, INTERPWKSPC

        call F_basstrcpy                ; convert to a C string

        ld hl, INTERPWKSPC

        call CHDIR

        jp c, J_tbas_error              ; carry set = error

        jp EXIT_SUCCESS

;---------------------------------------------------------------------------

; F_tbas_aload: Loads an arbitary file from the TNFS filesystem.

; The syntax is %aload "filename" CODE address. This allows the user

; to load an arbitrary file with no ZX formatting into memory.

.globl F_tbas_aload

F_tbas_aload:

        rst CALLBAS

        defw ZX_EXPT_EXP                ; expect a string expression

        cp TOKEN_CODE                   ; expect CODE

        jp nz, PARSE_ERROR

        rst CALLBAS                     ; fetch the next bit

        defw ZX_NEXT_CHAR               ; which must be a number

        rst CALLBAS

        defw ZX_EXPT1_NUM

        call STATEMENT_END              ; and then the end of statement

        ;------- runtime -------

        rst CALLBAS

        defw ZX_FIND_INT2               ; find the 16 bit int

        push bc                         ; save it

        rst CALLBAS

        defw ZX_STK_FETCH               ; get the filename

        ld hl, INTERPWKSPC              ; save it in workspace...

        call F_basstrcpy

        ; Now read the file into memory

        ld hl, INTERPWKSPC

        pop de                          ; retrieve address

        call F_tbas_readrawfile

        jp c, J_tbas_error

        jp EXIT_SUCCESS

;----------------------------------------------------------------------------

; F_tbas_load: Loads a ZX file (BASIC, CODE etc.)

; The syntax is as for ZX BASIC LOAD, except %load.

; TODO: CODE et al.

.globl F_tbas_load

F_tbas_load:

        rst CALLBAS

        defw ZX_EXPT_EXP                ; expect a string expression

        cp TOKEN_CODE                   ; Check for CODE...

        jr z, .loadcode6

        call STATEMENT_END              ; If not, statment end for BASIC.

        ;------ runtime for BASIC ------

        xor a                           ; type 0x00 is BASIC

.loader6:

        push af                         ; save type

        rst CALLBAS

        defw ZX_STK_FETCH               ; fetch the filename

        ld a, b                         ; check for empty string

        or c

        jr nz, .havefilename6

        ld hl, STR_BOOTDOTZX

        ld de, INTERPWKSPC

        ld bc, STR_BOOTDOTZXLEN

        ldir

        jr .loadbasic6

.havefilename6:

        ld hl, INTERPWKSPC

        call F_basstrcpy                ; copy + convert to C string

.loadbasic6:

        ; Now call the loader routine with the filename in HL

        ld hl, INTERPWKSPC

        pop af                          ; get type id

        call F_tbas_loader

        jp c, J_tbas_error

        jp EXIT_SUCCESS

.loadcode6:

        ; TODO - code to a specific address.

        rst CALLBAS

        defw ZX_NEXT_CHAR

        call STATEMENT_END

        ;------ runtime for CODE with no addr -------

        ld a, 3                         ; type=CODE

        jr .loader6                     ; get the filename then load.

;----------------------------------------------------------------------------

; F_tbas_save: Save a ZX file (BASIC, CODE etc.)

; The syntax is as for ZX BASIC SAVE.

; TODO: CODE et al.

.globl F_tbas_save

F_tbas_save:

        rst CALLBAS

        defw ZX_EXPT_EXP                ; fetch the file name

        cp TOKEN_CODE                   ; for CODE

        jr z, .savecode7

        cp TOKEN_SCREEN                 ; for SCREEN$

        jr z, .savescreen7

        cp TOKEN_LINE                   ; then for LINE

        jr z, .savebasline7

        call STATEMENT_END              ; a basic BASIC save.

        ;------- runtime for simple BASIC save -------

        rst CALLBAS

        defw ZX_STK_FETCH               ; Fetch the file name

        push de                         ; save the filename

        push bc

        xor a

        call F_tbas_mktapheader

        ld hl, 0xFFFF                   ; set param1 to >32767

        ld (INTERPWKSPC+OFFSET_PARAM1), hl

        jr .makebasicblock7

        ; Deal with SAVE "filename" CODE

.savecode7:

        rst CALLBAS

        defw ZX_NEXT2_NUM               ; check for 2 numbers

        call STATEMENT_END              ; then end of command.

        ; Runtime

        rst CALLBAS

        defw ZX_FIND_INT2               ; Get the length

        push bc                         ; into BC and save it

        rst CALLBAS

        defw ZX_FIND_INT2               ; and the start

        push bc                         ; and save that, too

.savecodemain7:

        rst CALLBAS

        defw ZX_STK_FETCH               ; and get the filename

        ld a, 3                         ; type = 3 - CODE

        call F_tbas_mktapheader         ; create the header template

        pop hl                          ; retrieve the start address

        ld (INTERPWKSPC+OFFSET_PARAM1), hl      ; and put it in the header

        pop hl                          ; and the length

        ld (INTERPWKSPC+OFFSET_LENGTH), hl      ; and put it in the header

        call F_tbas_writefile           ; finally write it out

        jp c, J_tbas_error

        jp EXIT_SUCCESS

.savescreen7:

        rst CALLBAS

        defw ZX_NEXT_CHAR               ; advance to the end of the line

        call STATEMENT_END

        ; Runtime

        ld hl, 6912                     ; Put the length of a SCREEN$

        push hl                         ; on the stack

        ld hl, 16384                    ; followed by the start address

        push hl

        jr .savecodemain7               ; and do as for CODE

.savebasline7:

        rst CALLBAS

        defw ZX_NEXT_CHAR

        rst CALLBAS

        defw ZX_EXPT1_NUM               ; 1 number - the line number

        call STATEMENT_END

        ; Runtime for save "x" LINE y

        rst CALLBAS

        defw ZX_FIND_INT2               ; Fetch the number

        ld (v_bcsave), bc

        rst CALLBAS

        defw ZX_STK_FETCH               ; Fetch the file name

        push de

        push bc

        xor a                           ; type = 0

        call F_tbas_mktapheader         ; Create the header

        ld hl, (v_bcsave)               ; get LINE parameter

        ld (INTERPWKSPC+OFFSET_PARAM1), hl ; Put it into parameter 1

.makebasicblock7:

        ; Fill in the header, length and length without vars

        ld hl, (ZX_E_LINE)              ; get the length of the BASIC prog

        ld de, (ZX_PROG)                ; by calculating it

        scf

        sbc hl, de

        ld (INTERPWKSPC+OFFSET_LENGTH), hl      ; prog + vars

        ld hl, (ZX_VARS)                ; now save the length - vars

        sbc hl, de                      ; calculate it...

        ld (INTERPWKSPC+OFFSET_PARAM2), hl

        pop bc                          ; retrieve filename

        pop de

        call F_tbas_writefile           ; Write it out.

        jp c, J_tbas_error

        jp EXIT_SUCCESS

;----------------------------------------------------------------------------

; F_tbas_ls

; List a directory

; Two forms - either %cat or %cat "directory"

.globl F_tbas_ls

F_tbas_ls:

        cp 0x0d

        jr z, .noargs8

        cp ':'

        jr z, .noargs8

        ; we have an argument supplied.

        rst CALLBAS

        defw ZX_EXPT_EXP                ; expect a string

        call STATEMENT_END

        ; --------- runtime ----------

        rst CALLBAS

        defw ZX_STK_FETCH               ; get the directory arg

        ld hl, INTERPWKSPC

        call F_basstrcpy                ; convert it to a C string

        ld hl, INTERPWKSPC

        jp F_listdir

.noargs8:

        call STATEMENT_END

        ; --------- runtime ----------

        ld a, '.'

        ld (INTERPWKSPC), a             ; default directory is CWD

        xor a

        ld (INTERPWKSPC+1), a

        ld hl, INTERPWKSPC

.makecat8:

        jp F_listdir

;---------------------------------------------------------------------------

; F_tbas_tapein

; Handle the %tapein command, which takes a filename as a parameter.

.globl F_tbas_tapein

F_tbas_tapein:

        rst CALLBAS

        defw ZX_EXPT_EXP                ; expect a string expression

        call STATEMENT_END

        ;-------- runtime --------

        rst CALLBAS

        defw ZX_STK_FETCH               ; get the string

        call F_settrap

        jp c, J_tbas_error              ; carry set = error

        jp EXIT_SUCCESS

;----------------------------------------------------------------------------

; F_tbas_info

; Handle the %info command

.globl F_tbas_info

F_tbas_info:

        rst CALLBAS

        defw ZX_EXPT_EXP                ; expect a string

        call STATEMENT_END

        ;-------- runtime ----------

        rst CALLBAS

        defw ZX_STK_FETCH

        call F_showfileinfo             ; Try to open the file and show

        jp c, J_tbas_error              ; the information.

        jp EXIT_SUCCESS

;----------------------------------------------------------------------------

; F_tbas_fs

; Sets the current filesystem.

.globl F_tbas_fs

F_tbas_fs:

        rst CALLBAS

        defw ZX_EXPT1_NUM               ; expect one number - the FS number

        call STATEMENT_END

        ;-------- runtime ----------

        rst CALLBAS

        defw ZX_FIND_INT2               ; get the fs number

        ld a, c                         ; get it from BC

        call SETMOUNTPOINT

        jp nc, EXIT_SUCCESS             ; No carry = FS change OK

        ld a, EBADFS

        jp J_tbas_error

;----------------------------------------------------------------------------

; F_loadsnap

; Loads a snapshot file.

.globl F_loadsnap

F_loadsnap:

        rst CALLBAS

        defw ZX_EXPT_EXP                ; filename string

        call STATEMENT_END

        ;---------- runtime -----------

        rst CALLBAS

        defw ZX_STK_FETCH               ; get the filename

        ld hl, INTERPWKSPC+256

        call F_basstrcpy                ; copy filename as a C string

        ld de, INTERPWKSPC+256

        ld hl, 0xFB01                   ; Module ID = 0xFB, call ID = 0x01

        rst MODULECALL_NOPAGE

        jp J_tbas_error                 ; If we get here, an error occurred

;----------------------------------------------------------------------------

; F_tbas_mv

; Moves (renames) a file.

.globl F_tbas_mv

F_tbas_mv:

        rst CALLBAS

        defw ZX_EXPT_EXP                ; source filename

        cp ','                          ; and a comma

        jp nz, PARSE_ERROR

        rst CALLBAS

        defw ZX_NEXT_CHAR               ; advance past ,

        rst CALLBAS

        defw ZX_EXPT_EXP                ; destination filename

        call STATEMENT_END              ; then the end of statement

        ;------- runtime ---------

        rst CALLBAS

        defw ZX_STK_FETCH               ; destination filename

        ld hl, INTERPWKSPC+256

        call F_basstrcpy                ; copy to workspace as C string

        rst CALLBAS

        defw ZX_STK_FETCH               ; source filename

        ld hl, INTERPWKSPC

        call F_basstrcpy                ; copy to workspace

        ld hl, INTERPWKSPC              ; source and dest filename pointers

        ld de, INTERPWKSPC+256

        call RENAME

        jp nc, EXIT_SUCCESS

        jp J_tbas_error

;---------------------------------------------------------------------------

; F_tbas_rm: Removes a file

.globl F_tbas_rm

F_tbas_rm:

        rst CALLBAS

        defw ZX_EXPT_EXP                ; file to remove

        call STATEMENT_END

        ;-------- runtime ---------

        rst CALLBAS

        defw ZX_STK_FETCH

        ld hl, INTERPWKSPC

        call F_basstrcpy

        ld hl, INTERPWKSPC

        call UNLINK                     ; remove the file

        jp nc, EXIT_SUCCESS

        jp J_tbas_error

;----------------------------------------------------------------------------

; F_tbas_zxprint

; Prints a C string to the current ZX channel

; HL = pointer to string

.globl F_tbas_zxprint

F_tbas_zxprint:

        ld a, (hl)

        and a

        ret z

        rst CALLBAS

        defw 0x10

        inc hl

        jr F_tbas_zxprint

;----------------------------------------------------------------------------

; handle errors and return control to BASIC.

; A=tnfs error number

.globl J_tbas_error

J_tbas_error:

        push af                         ; save error number

        call F_geterrstr                ; get the error string

        pop af

        jp REPORTERR                    ; exit to BASIC with error string

;----------------------------------------------------------------------------

; F_tnfs_geterrstr

; Enter with A=error number

; Exits with HL=pointer to null terminated error string

.globl F_geterrstr

F_geterrstr:

        ld h, 0xFC              ; ID of messages module

        ld l, a                 ; Set the message ID to fetch

        ld de, 0x3000           ; buffer

        xor a

        ld (de), a              ; initialize with a NULL

        rst MODULECALL_NOPAGE

        ld hl, 0x3000           ; address of the message

        ret

.data

.globl STR_BOOTDOTZX

.globl STR_BOOTDOTZXLEN

STR_proto:      defb    "tnfs",0

STR_BOOTDOTZX:  defb    "boot.zx",0

STR_BOOTDOTZXEND:

STR_BOOTDOTZXLEN equ    STR_BOOTDOTZXEND-STR_BOOTDOTZX

EBADURL:                equ     0x28

EBADFS:         equ     0x29