Subversion Repositories Spectranet

[/] [branches/] [gnubinutils/] [modules/] [basext/] [commands.asm] - Rev 380

Compare with Previous | Blame | View Log

;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

Compare with Previous | Blame | View Log