;;; -*- asm -*- ; ;;; Simple option ROM for printer for ABC80; this is not authentic, but ;;; uses a hardware interface implementable with an FT232H USB module. ;;; It is (hopefully) at least similar to an ABC80 printer interface. ; ;;; - ABC-bus select code 60 decimal; ;;; OUT 0 - (OUT) output data ;;; IN 0 - (INP) input data ;;; IN 1 - (STAT) bit 0 - Rx data available ;;; bit 1 - Tx space available ;;; bit 2 - USB suspended (not ready) ;;; bit 3 - USB configured (host ready) ;;; OUT 2 - (C1) flush Tx buffer immediately ;;; OUT 3 - (C2) discard all input - only supported in some hw versions ;;; ;;; ;;; FF is used as an escape character for the file I/O and console ;;; interfaces (FF A0..BF for file, FF C0 for console) ;;; ;;; FF FE is used to represent an FF character in the printer stream, ;;; and FF FD is send on CLOSE (end of job). ;;; For other escape sequences, see print.c. ;;; ;;; To auto-initialize this, we need a modified DOS that looks for ;;; additional ROM entry points (ABC800 has this, but not ABC80.) .altmacro #include "z80.inc" #include "abc80.inc" #include "auxram.inc" #include "ufddos.inc" defc selcode=60 ; ABC-bus select code defc LARGE=(ROMSIZE >= 2048) ;; Maximum number of remote volumes defc MAX_VOLS = 32 ;; Console device, probably doesn't fit anymore defc console_dev = LARGE ;; Support strict text file access defc pra_dev = 0 ;; ABC800-style CON: and NUL: devices defc connul = LARGE ;; Quicklib routine defc quicklib = 1 ;; Return real error codes or always zero? defc return_real_errors = 0 ; Match UFD-DOS 80 ;; PR: using raw protocol (not a chardev volume?) defc raw_pr = 0 ;; XDx: device entries (secondary hard disk, not enough space in DOS) defc xd_dev = LARGE ;; CMD routine if in IEC area? defc have_cmd = LARGE && (ROMSTART == 0x7000) if !have_cmd defc c_cmd = ERR_8 defc e_cmd = ERR_8 defc e_iec = ERR_8 endif ;; Allocate memory from the BASIC stack? defc use_stack = AUXRAM_PRINTNET_BASE >= 0x8000 ;; Device timeout defc timeout = 100 ; 100/50 Hz = 2 s ;; Command opcodes NET_OPEN_A = 0xa0 NET_OPEN_B = 0xa1 NET_PREP_A = 0xa2 NET_PREP_B = 0xa3 NET_INPUT = 0xa4 NET_GET = 0xa5 NET_PRINT = 0xa6 NET_CLOSE = 0xa7 NET_CLOSALL = 0xa8 NET_INIT = 0xa9 NET_RENAME = 0xaa NET_DELETE = 0xab NET_PREAD = 0xac NET_PWRITE = 0xad NET_BLKSIZE = 0xae NET_INITSZ = 0xaf NET_SEEK0 = 0xb0 NET_SEEK1 = 0xb1 NET_SEEK2 = 0xb2 NET_SEEK3 = 0xb3 NET_SEEK4 = 0xb4 NET_SEEK5 = 0xb5 NET_SEEK6 = 0xb6 NET_SEEK7 = 0xb7 NET_SEEK8 = 0xb8 NET_PUT = 0xb9 NET_LISTVOL = 0xba NET_CMD = 0xbb ;; Framing bytes NET_SOF = 0xff ; Start of frame (command byte follows) NET_EOF = 0xef ; End of frame ;; Special commands for printing and debug NET_PR = 0xf3 ; Begin print data mode NET_PRCLOSE = 0xfd ; End print job NET_PRFF = 0xfe ; Escape FF ;; Special command for debug console NET_CON = 0xc0 .globl _org _org = ROMSTART .section .text .globl _start _start: ;; If in the IEC area, add the IEC area entry points ;; IEC: jump table follows; simply treat it as PR: if ROMSTART == 0x7000 jp c_cmd jp e_cmd jp e_iec endif if raw_pr ; jp table for PR: (if in printer area, should be first) pr_jptable: jp trivial ; OPEN jp trivial ; PREPARE jp pr_close ; CLOSE jp notforme ; INPUT jp pr_print ; PRINT jp notforme ; RDBLK jp notforme ; WRBLK jp notforme ; DELETE jp notforme ; RENAME endif prb_jptable: jp prb_open ; OPEN jp prb_prepare ; PREPARE jp prb_close ; CLOSE jp prb_input ; INPUT - might be generally useful jp prb_print ; PRINT jp prb_rdblk ; RDBLK jp prb_wrblk ; WRBLK ; Supporting DELETE and RENAME requires fixes to the DOS ROM; ; the DOS ROM contains the BASIC interpreter for these and ; it assumes it only applies to disk files. jp prx_delete ; DELETE jp prx_rename ; RENAME ;; Fixed entry points, reserved for future use fixfunc: .org 0x4a, 0xff ;; Magic number that this entry point is valid dec a ;; Init entry point, same offset as in DOS jp start if pra_dev ; jp table for PRA: pra_jptable: jp pra_open ; OPEN jp pra_prepare ; PREPARE jp pra_close ; CLOSE jp pra_input ; INPUT jp pra_print ; PRINT jp notforme ; RDBLK jp notforme ; WRBLK ; Supporting DELETE and RENAME requires fixes to the DOS ROM; ; the DOS ROM contains the BASIC interpreter for these and ; it assumes it only applies to disk files. jp prx_delete ; DELETE jp prx_rename ; RENAME endif if raw_pr pr_print: call select ld a,0F3h ; Printer data call send_esc pr_print_loop: ld a,b or c ld a,NET_PRETX jr z,done_esc ld a,(hl) call send_byte inc a jr nz,pr_not_ff ld a,NET_PRFF call send_byte pr_not_ff: dec bc inc hl jr pr_print_loop pr_close: call select ld a,NET_PREOJ jr done_esc endif ;; Select the current device, and save the stack pointer ;; to allow for an error unwind. This should be called from the ;; topmost stack so that a RET on error returns to BASIC; ;; if called in a nested context that context will be returned ;; to on error. After an error the carry flag is set and only ;; A is defined. select: ld (errsp),sp push af ld a,(SELECT) ; Old select code ld (ram_select),a ; Save old select code ld a,selcode ; Select code ld (SELECT),a ; Is this correct? out (1),a pop af ret done_esc: call send_esc done_ok: xor a done: ld sp,(errsp) ; Restore stack inc sp ; Drop return address from select inc sp push af ld a,(ram_select) ld (SELECT),a out (1),a pop af rlca ; CF <- bit 7 if return_real_errors srl a ; Strip bit 7 from result but is in CF else ld a,0 ; This is what UFD-DOS 80 does?! endif ret if pra_dev pra_open: ld a,NET_OPEN_A jr prx_open pra_prepare: ld a,NET_PREP_A jr prx_open endif prb_prepare: ld a,NET_PREP_B jr prb_open_prepare prb_open: ld a,NET_OPEN_B prb_open_prepare: call prb_setup_buf ;; Fall through... prx_open: ;; ABC80-BASIC expects DE to be preserved across this routine, ;; otherwise .BAC -> .BAS searching does not work. if pra_dev ; Handled by prb_setup_buf ld (ix+7),132 ; Line length, seems to be standard? endif call select push af ; Save command code call send_cmd ; Returns with CF = 0 ld l,(ix+3) ; Get volume name ld h,(ix+4) ld bc,3 sbc hl,bc ld (ix+6),b ; 0 call send_buf ;; HL <- filename. Do not use EX DE,HL here: if send_buf ;; aborts we have to have DE intact on return to BASIC. ld l,e ld h,d ld c,11 ; B = 0 already call send_buf call recv_reply pop hl ; H = command if quicklib and (iy+14) ; Bit 0 = command mode add a ; Bit 0 -> bit 1 and h ; Check for PREPARE (bit 1) ;; bit 1 in A is now set if quicklib endif ;; Mark buffer busy if successful, any value other than 0xff ;; works, so just use zero... if pra_dev bit 0,h ; PRA -> no buffer, no quicklib jr z,nohazbuf endif call prb_dosfd ld (hl),b ; B = 0 on exit here nohazbuf: if !quicklib jr done else ;; A is as set up above... and 2 jr z,done ; Not quicklib (A = 0 here) ;; -------- Show library listing on screen -------- prx_quicklib: ;; Restore the original select code in memory. It isn't ;; necessary to send the select code to the bus, because ;; the subsequent I/O operations will do that for us. ld a,(ram_select) ; Restore original select code ld (SELECT),a call crlf ld (ix+6),22 ; 22 lines before wait ql_getline: call S_CHECKCTRLC jr nz,ql_done ld hl,PCODE_BUF push hl ld bc,PCODE_SIZE call IX_INPUT pop hl jr c,ql_done call S_CUR_MAX_X ld bc,+(12 << 8) + 13 add c ; Space needed sub e jr c,ql_nocrlf call crlf dec (ix+6) jr nz,ql_nocrlf push ix call CON_GET pop ix ld (ix+6),1 ; = one line only cp c jr z,ql_nocrlf ld (ix+6),22 ql_nocrlf: push hl ql_find_comma: ld a,(hl) cp '.' ; Lowest valid filename character jr c,ql_found_comma ; Comma, CR, or other non-filename character inc hl djnz ql_find_comma ql_found_comma: inc b ql_pad_space: ld (hl),' ' inc hl djnz ql_pad_space ql_cleaned_comma: pop hl ; BC = 13 here call CON_PRINT jr ql_getline ql_done: call S_CLOSEFILE jp S_CMD ; Forcible return to command loop - ; abort LIST command crlf: push bc call CON_CRLF pop bc ret endif ; quicklib prx_rename: call select ld a,NET_RENAME call send_cmd ex de,hl ; HL -> new filename ld bc,11 call send_buf jr prx_reply_done prb_close: call select xor a cp (ix+14) jr z,pbc_noflush call prb_getbufaddr ld b,a ld a,(ix+10) ; End data sub l ; Skip non-data at start of buffer ld c,a call output_common pbc_noflush: call prb_dosfd ld (hl),255 ; Buffer now free ;; Returns with B=0 ld (ix+14),b if pra_dev pra_close: ld (ix+5),0 else ld (ix+5),b endif ld a,NET_CLOSE prx_simple_command: ; Just command and response, no data call send_cmd prx_reply_done: ; Reply, then done call recv_reply done2: jp done prx_delete: ld a,NET_DELETE call select jr prx_simple_command if pra_dev pra_print: call select call output_common jr done2 endif output_common: ld a,NET_PRINT prx_length_command: call send_cmd call send_word call send_buf jp recv_reply if pra_dev pra_input: call select ld a,NET_INPUT ; INPUT endif ;; This routine can be called to handle a command with a ;; reply + len + data response. ;; HL -> target_buf, A = command, BC = buffer size ; XXX: USB is fast enough that INIR/OTIR should be possible input_command: call send_cmd call recv_reply ex de,hl call recv_word ex de,hl ; Now HL -> target buf; DE -> expected byte count; ; BC -> buffer size prai_loop: ld a,d or e ret z dec de ld a,b or c jr nz,prai_space ld hl,ram_dummy inc c prai_space: dec bc call recv_byte ld (hl),a inc hl jr prai_loop prbr_protoerr: ld a,128+37 jr done2 prb_rdblk: call select prb_rdblk_nosel: ld a,NET_PREAD call send_cmd_blkno call recv_reply call prb_getbufaddr ex de,hl call recv_word sbc hl,bc jr nz,prbr_protoerr ld b,c push de prbr_recv: call recv_byte ld (de),a inc de djnz prbr_recv pop hl ; HL -> buf address jp done_ok ;; This is a slightly modified version of the BLK_INPUT routine ;; in the BASIC ROM. It has the following modifications: ;; 1. Accept or line endings as well as just ;; 2. Handle a block without an terminator ;; 3. Handle a file without terminator ;; These changes allow a text file in modern Unix/DOS format ;; to be parsed, as long as it does not have embedded ;; characters. It would be possible to heuristically handle ;; by looking for or ; the first block ought to have ;; at least one if "modern", or if ABC. ;; ;; This is intended to be a general routine, usable for other ;; devices than these. prb_input: ex de,hl ; DE -> destination pointer ld (ix+13),1 ; Inhibit output ld l,(ix+10) ; HL -> pointer into the buffer ld h,(ix+11) pbi_nextchar: xor a cp c jr z,pbi_overlong ; Output buffer overflow? call pbi_peekchar cp 9 ; TAB = compressed spaces jr z,pbi_tab cp 10 ; LF = convert to CR jr z,pbi_lf and a jr z,pbi_eof ; NUL = end of file jp m,pbi_badchar ; >= 128 -> error pbi_emit: ldi ; (DE) <- (HL), DE++, HL++, BC-- cp 13 ; CR = end of line jr nz,pbi_nextchar ;; For a CR character, look to see if the next one if LF, ;; if so eat the LF rather than having it converted to CR next time. ;; Only do this exactly once, so = 2 lines. call pbi_peekchar cp 10 jr nz,pbi_done inc hl ; Skip exactly one LF character pbi_done: xor a pbi_return: ld (ix+10),l ld (ix+11),h ret pbi_eof: pbi_err: scf jr pbi_return pbi_overlong: ld a,128 + 20 ; Line too long jr pbi_err pbi_badchar: ld a,128 + 58 ; Bad character jr pbi_err pbi_lf: ; Convert to CR and EOL, but don't eat LF ld (hl),13 ldi jr pbi_done pbi_tab: inc l ; Next byte; note that 3 = ETX is valid jr z,pbi_nextchar ; at end of block -> ignore ld b,(hl) inc l ld a,c sub b jr c,pbi_overlong ld c,a ld a,' ' pbi_tab_expand: ld (de),a inc de djnz pbi_tab_expand jr pbi_nextchar ;; Get the next character, but don't advance HL beyond ;; it. However, handle ETX and buffer overrun here. pbi_peekchar: xor a cp l ; 256-byte wrap: assume end of block jr z,pbi_newblock ld a,(hl) cp 3 ret nz pbi_newblock: call pbi_eofbuf ; Just in case IX_BLKRD fails silently... push bc push de call IX_BLKRD pop de pop bc ;; HL points to start of buffer here (we hope) jr nc,pbi_peekchar ;; On error, return EOF and also set the first byte in the buffer ;; to EOF in case input gets called again. ;; Fall through... pbi_eofbuf: call prb_getbufaddr xor a ld (hl),a ret ; Write a binary output block. prb_wrblk: call select ld a,NET_PWRITE call send_cmd_blkno call prb_getbufaddr ld bc,253 call send_buf call prb_empty_buf jp recv_reply ;; Blocking PRINT without converting to ABC-DOS text format. ;; This simply stuffs a buffer full of the PRINT contents; ;; it also assumes the buffer is full when there is a 256-byte ;; address wraparound as (ix+13) is not expected to reflect the ;; buffer length without space for ETX... and is set to 1 on ;; read (what?!) prb_print: ld a,c or b ret z ; Nothing to do... ld e,(ix+10) ld d,(ix+11) pbp_output: xor a sub e jr z,pbp_nextbuf ; No space left in buffer push bc inc b ;; A now has the number of free bytes in the buffer ;; If BC > A need to use the rest of the buffer djnz pbp_limitlen cp c jr c,pbp_limitlen ld a,c pbp_limitlen: ld c,a xor a ; Assume all good, clear carry ld b,a ex (sp),hl sbc hl,bc ; Decrement bytes left to write ex (sp),hl ldir ld (ix+10),e ld (ix+11),d ld (ix+14),1 ; Buffer dirty pop bc ret z ; Z still set from SBC HL,BC pbp_nextbuf: push hl push bc call IX_BLKWR pop bc pop hl jr nc,pbp_output ret ; Error pbp_allbuf: sub e jr pbp_limitlen ;; Get the address of the DOS file description corresponding ;; to the allocated buffer. ;; Returns with B = 0, C = DOSBUF*16, HL = DOS file description+1 prb_dosfd: ld b,0 ld c,(ix+12) ld hl,DOSFD0 + 1 add hl,bc ret ;; Set up a BUF for PRB: (open/prepare) ;; This uses routines from UFD-DOS due to space prb_setup_buf: push af push bc push hl call DOSALLOCBUF ; Allocate buffer call DOSBUFINIT ; Initialize buffer pointers call prb_dosfd inc hl ; Next block number <- 1 ld (hl),1 inc hl ld (hl),a ; A = 0 pop hl pop bc pop af ret ;; This returns with DE -> buffer start. It seems ABC80-BASIC ;; requires this to work... prb_empty_buf: ; Returns with A=0, HL->buf push af ex de,hl ld a,(ix+12) call DOSBUFREINIT ; Returns with HL -> buffer ex de,hl pop af ret ;;; Load the address of the start of the current buffer into HL, ;;; and the buffer size (253) into BC. prb_getbufaddr: ld l,3 ld h,(ix+9) ld bc,253 ret ;; Send a command header, A = command ;; Returns with CF = 0 send_cmd: push bc ld (ram_cmd),a call send_esc ld a,(ram_serial) call send_byte push ix pop bc call send_word pop bc ret ;; Send a command header, A = command, then the block ;; number taken from the DOS file descriptor. Clobbers ;; BC and HL, and increments the block number. send_cmd_blkno: call send_cmd call prb_dosfd inc hl ld c,(hl) inc hl ld b,(hl) inc bc ; Next block ld (hl),b dec hl ld (hl),c dec bc ; Point back to the original block dec bc ; DOS block numbers are 1-based ;; Fall through ;; Send a word in BC, preserves AF send_word: push af ld a,c call send_byte ld a,b call send_byte pop af ret ;; Send FF + byte; reset running checksum to FF ;; Returns with CF = 0! send_esc: push af ld a,NET_SOF call send_byte ld (ram_csum),a pop af ;; Fall through ;; Send a single byte and add to running checksum ;; Returns with A unchanged and CF = 0 send_byte: push hl ld l,a ld a,(ram_csum) add l ld (ram_csum),a in a,(1) and 2 ; TX space available call z,wait_for_tx ld a,l out (0),a pop hl ret ;; Send a buffer HL->data, BC=count ;; On return HL advanced, BC=0, AF clobbered ;; and ram_csum updated ;; ;; This assumes the interface is either fast enough or ;; buffered enough that it is not necessary to wait for ;; tx space after each individual transmit. ;; send_buf: ld a,c or b ret z push de in a,(1) and 2 call z,wait_for_tx ld a,(ram_csum) ld d,b ; High part of byte count inc d ; To be able to use ZF after DEC ld b,c ; Low part of byte count ld c,0 ; Port 1: add a,(hl) ; Update checksum outi ; Send byte, update B, HL jr nz,1b ; ZF = 1 if last iteration dec d ; Additional 256-byte blocks? jr nz,1b ld (ram_csum),a pop de ret ;; Receive a byte into A. On timeout bail to ERR 42. ;; Always returns with CF=0. recv_byte: ;; Optimistically, assume data is there already in a,(1) and 0Dh cp 09h call nz,wait_for_rx in a,(0) ; Read data ret ;; Receive a word into HL. Clobbers A. ;; Always returns with CF=0. recv_word: call recv_byte ld l,a call recv_byte ld h,a ret ;; This routine waits until the status bit given in A is zero; ;; if the the high bits of the status are anything other than ;; xxxx10xx (configured, not suspended) then immediately issue ;; device not ready. wait_for_tx: push hl ld hl,0x0A0E jr wait_for wait_for_rx: push hl ld hl,0x090D ; Mask, expected value wait_for: push bc ld b,timeout wf_ctr: ld a,(CLOCK) ld c,a wf_loop: in a,(1) and l cp h jr nz,wf_nope pop bc pop hl ret wf_nope: and 0x0C ; Invalid status bits? cp 0x08 jr nz,wf_error ; Not connected ld a,(CLOCK) cp c jr z,wf_loop djnz wf_ctr wf_error: ld a,128+42 ; Device not ready done4: jp done send_endframe: ld a,NET_EOF ; End of frame call send_byte ld a,(ram_csum) neg ; Total checksum = 0 call send_byte out (2),a ; Immediately transmit any pending output ret ;; Send end of frame, and receive a reply header. ;; If the reply is an error, terminate command and return ;; the error code to BASIC (or other caller) by calling done. recv_reply: push bc call send_endframe ld bc,(ram_cmd) rr_loop: call recv_byte rr_isff: inc a ; FF? jr nz,rr_loop call recv_byte cp c ; Command jr nz,rr_isff call recv_byte cp b ; Serial jr nz,rr_isff call recv_byte ; Error code (if any) ;; Got this far, bump sequence number inc b ld (ram_cmd),bc pop bc and a ret p ; Bit 7 = 0 -> no error jr done4 rr_timeout: dec b ; Drop the sequence number to allow resend jr wf_error ;;; ;;; Discard any (stale) input, if any. Terminate immediately if suspended, ;;; not configured, or not present. Clobbers A. ;;; flush_rx: in a,(1) and 0Dh sub 09h ret nz out (3),a ; Fast flush if supported by the hardware in a,(0) ; Consume byte jr flush_rx if console_dev prc_jptable: jp trivial ; OPEN jp trivial ; PREPARE jp trivial ; CLOSE jp notforme ; INPUT jp prc_print ; PRINT jp notforme ; RDBLK jp notforme ; WRBLK jp notforme ; DELETE jp notforme ; RENAME prc_print: call select ld a,NET_SOF call send_byte ld a,NET_CON call send_byte prc_print_loop: ld a,b or c jr z,send_byte_done ; A=00 here ld a,(hl) and a jr z,prc_skip call send_byte prc_skip: dec bc inc hl jr prc_print_loop send_byte_done: call send_byte jp done_ok endif ; console_dev start: if have_cmd ld hl,new_basic_jumps ld bc,old_basic_jumps - new_basic_jumps ld a,(65h) ; First byte different between old and new and a jr z,is_new_basic add hl,bc is_new_basic: ld de,basic_jumps ldir endif call init ; Unwind to here on error or return ld hl,__end + INIT_OFFS ; Where to search next ret init: call select ld hl,-256 add hl,sp ld sp,hl push hl ld a,NET_INIT call send_cmd call recv_reply ld a,NET_LISTVOL pop hl push hl ld bc,4*MAX_VOLS+1 ; B=0 call input_command pop hl ;; Create device list entries ;; HL -> CRAD here, A = 0 push hl ld bc,4*MAX_VOLS add hl,bc ld (hl),b ; Make sure it is null-terminated on overflow pop hl ld de,voldevs ;; Are we running with auxram on the stack? .if use_stack ld (STACK),de ; Move down the user stack .endif mk_vols: ; B = 0 on entry here ld a,(hl) and a jp z,done ; Done ;; Otherwise A = voltype inc hl push hl ld l,e ld h,d ld de,(DEVLIST) ld (DEVLIST),hl ld (hl),e inc hl ld (hl),d inc hl ex de,hl pop hl ld c,3 ; Copy volume name ldir if pra_dev ;; This requires pra_jptable and prb_jptable have the same upper bytes dec a ; Z = 1 if A = 1 = text/PRA ld a,pra_jptable & 0xff jr z,have_voltype endif ld a,prb_jptable & 0xff have_voltype: ld (de),a inc de ld a,prb_jptable >> 8 ld (de),a inc de jr mk_vols notforme: ld a,128+52 ; Ej till denna enhet scf ret if connul con_open: ;; Be nice and initialize the position fields, even though ;; we aren't really able to keep them updated... call S_CUR_MAX_X ld (ix+6),a ld (ix+7),e ;; Fall through endif trivial: ; Trivially successful call xor a ; A <- 0 carry <- 0 ret if connul alwayseof: ; End of file or file not found xor a scf ret ;;; ;;; Simple CON and NUL devices for ABC800 compatibility ;;; con_jptable: jp con_open ; OPEN jp con_open ; PREPARE jp trivial ; CLOSE jp CON_INPUT ; INPUT jp CON_PRINT ; PRINT jp notforme ; RDBLK jp notforme ; WRBLK jp notforme ; DELETE jp notforme ; RENAME nul_jptable: jp trivial ; OPEN jp trivial ; PREPARE jp trivial ; CLOSE jp alwayseof ; INPUT jp trivial ; PRINT jp notforme ; RDBLK jp notforme ; WRBLK jp notforme ; DELETE jp notforme ; RENAME endif ;;; ;;; Support for CMD (via the IEC area) ;;; ;;; CMD [#device,] expr [,expr] ... ;;; ;;; Similar to PRINT except that each argument is terminated by ;;; a null byte before sending ;;; if have_cmd defc CMD_BUF = LINE_BUF defc CMD_BUF_LEN = LINE_SIZE ;; Need 16 bytes of overflow space for numbers defc CMD_BUF_END = CMD_BUF + CMD_BUF_LEN - 16 defc e_iec = ERR_8 ; Not implemented e_cmd: ld l,0 ; No file number ld a,(de) ; Next byte code cp '#' jr nz,e_cmd_find_file inc de rst 56 ; Compute expression e_cmd_find_file: ld (iy+13),l ld ix,0 ; No file map ld a,l and a jr z,e_cmd_start ; Device 0 ;; L = file number to find ld ix,FILELIST e_cmd_find_file_next: ld c,(ix+0) ; Link ld b,(ix+1) ld a,c or b jp z,ERR_32 ; File not open push bc pop ix ld a,(ix+2) ; File number cp l jr nz,e_cmd_find_file_next ;; IX -> file map e_cmd_start: push ix ld hl,CMD_BUF ld (e_cmd_buf_ptr),hl ld (errsp),sp ; SAve stack pointer for reset e_cmd_start_expr: ld a,(de) inc de cp ',' jr z,e_cmd_start_expr cp ';' jr z,e_cmd_start_expr dec de cp 192 ; Byte code for expression jr c,e_cmd_done ; Not an expression? rst 56 ; Compute expression push de ; Save P-code pointer ld de,(e_cmd_buf_ptr) dec b ; Integer? jr nz,e_cmd_not_integer e_cmd_integer: call INT_TO_STR jr e_cmd_finish_num e_cmd_not_integer: dec b ; String? jr z,e_cmd_string e_cmd_float: ;; Floating point ld hl,2 add hl,sp ; -> exponent on stack call FLOAT_TO_STR e_cmd_finish_num: call e_cmd_check_overflow e_cmd_finish: ld (de),a inc de ld (e_cmd_buf_ptr),de pop de ; P-code pointer ld sp,(errsp) ; Reset stack jr e_cmd_start_expr e_cmd_string: pop hl ; P-code pointer pop bc ; Stack adjustment (not used) pop bc ; String address ex (sp),hl ; String length in HL, P-code pointer on stack push bc ; String address push hl ; String length push de ; Output pointer add hl,de ; End of string ex de,hl call e_cmd_check_overflow pop de ; Output pointer pop bc ; String length pop hl ; String pointer ldir jr e_cmd_finish e_cmd_done: ;; Output generated, now send it pop ix ; Restore IX map pointer push de ; P-code pointer ld hl,(e_cmd_buf_ptr) ld de,CMD_BUF xor a sbc hl,de ex de,hl ld c,e ld b,d pop de call select ld a,0BBh ; GENERIC COMMAND call prx_length_command jp done e_cmd_check_overflow: ;; DE -> end of string data push hl ld hl,CMD_BUF_END-1 ; -1 for terminal null xor a sbc hl,de pop hl ret nc ; All good e_cmd_space_overflow: rst 10h defb 128 + 20 ; "För lång rad" endif ; have_cmd ;; The value to put in the BASIC device link pointer device_list = 3000f .macro device name:req, jptbl:req 3000: defw 3000f defm \name defw \jptbl .endm if xd_dev xd_device: device "XD0", DOSJPTABLE defb 0x14 device "XD1", DOSJPTABLE defb 0x15 device "XD2", DOSJPTABLE defb 0x16 device "XD3", DOSJPTABLE defb 0x17 endif if console_dev prc_device: device "PRC", prc_jptable endif if connul con_device: device "CON", con_jptable nul_device: device "NUL", nul_jptable endif if raw_pr pr_device: device "PR ", pr_jptable endif ;; Jump table for BASIC functions that are inconsistent new_basic_jumps: ; Checksum 9913, 10042 if have_cmd jp 3392h ; Check space on stack jp 1853h ; Integer to string jp 1675h ; Float to string jp 2152h ; Compile PRINT endif old_basic_jumps: ; Checksum 11273 if have_cmd jp 339Bh ; Check space on stack jp 1855h ; Integer to string jp 1679h ; Float to string jp 2154h ; Compile PRINT endif ;; Check for overflow and pad to desired ROM size .org ROMSIZE, 0xff __end: ;; ;; In RAM; this is assuming external SRAM or equivalent at 20-22K. ;; The top 64 bytes are used by UFD-DOS. ;; defc ram_end = AUXRAM_PRINTNET_END defc ram_start = AUXRAM_PRINTNET_BASE .globl _bss _bss = AUXRAM_PRINTNET_BASE section .bss __bss: voldevs: 3000: ; Part of the device linked list defs 7*MAX_VOLS ; Up to 32 volume device entries errsp: defs 2 ; SP rollback on error return e_cmd_buf_ptr: defs 2 ; Current data buffer pointer ram_select: defs 1 ; Previous select code ram_csum: defs 1 ; Running output checksum ram_cmd: defs 1 ; Latest sent command ram_serial: defs 1 ; Latest serial number (must be immediately after ram_cmd) ram_dummy: defs 1 ; Scratch byte basic_jumps: if have_cmd CHECK_STACK_SPACE: defs 3 ; Check space on stack INT_TO_STR: defs 3 ; Integer to string FLOAT_TO_STR: defs 3 ; Float to string c_cmd: ; Compile CMD = same as PRINT C_PRINT: defs 3 ; Compile PRINT endif ;;; Check for overflow .org AUXRAM_PRINTNET_SIZE __end_bss: