From: Alan Cox Date: Tue, 14 Jun 2016 23:49:24 +0000 (+0100) Subject: cpm: move the emulator out and begin work on fixing it all X-Git-Url: https://git.ndcode.org/public/gitweb.cgi?a=commitdiff_plain;h=6831e26f1acbe30237bc5980ce2cd28b5b89ac83;p=FUZIX.git cpm: move the emulator out and begin work on fixing it all --- diff --git a/Applications/cpm/Makefile b/Applications/cpm/Makefile new file mode 100644 index 00000000..e8c7d2f9 --- /dev/null +++ b/Applications/cpm/Makefile @@ -0,0 +1,19 @@ +# +# +BASE=49152 +# +all: emulator runcpm + +emulator: emulator.s + echo " .org "$(BASE) >cpm.def + sdasz80 -o -l emulator.rel emulator.s + sdldz80 -m -i emulator.ihx emulator.rel -e + makebin -s 65536 emulator.ihx emulator.tmp + dd if=emulator.tmp of=emulator.bin bs=1 count=4096 skip=$(BASE) + +runcpm: runcpm.c + fcc -O2 -c runcpm.c + fcc -o runcpm runcpm.rel + +clean: + rm -f *~ *.rel *.ihx *.tmp *.bin *.lst *.lk *.noi *.map cpm.def *.sym runcpm emulator runcpm.asm diff --git a/Applications/cpm/README b/Applications/cpm/README new file mode 100644 index 00000000..0713de8e --- /dev/null +++ b/Applications/cpm/README @@ -0,0 +1,33 @@ +This is based on the CP/M emulation from Will's UZI for SocZ80 + +It's been converted to sdasz80/sdld for tool commonality with sdcc and moved +into userspace. + +TODO: + +- Start debugging it +- Check all syscall translations are still correct +- Move what we can into the runcpm loader binary +- Support tacking .COM onto the name in runcpm +- Fix up directory mapping and shrink buffer +- Use CP/M scratch space for internal variables and buffer pointers + so we can also support a high loaded version using shared common for + awkward memory mapped boxes (eg the Memotech) +- Save the syscall vector on entry as CP/M apps can re-use the RST + vector +- Find a nice way to build a relocatable version rather than one per + system type. + + +6809 folks might want to look at + +http://permalink.gmane.org/gmane.comp.hardware.tandy.coco/77846 + +and see if it could be ported over using our built in vt52 emulation and +syscalls instead of the OS/9 interfaces and if Luis will put a licence on +it. + +A faster (but 8080 only alternative) is in the Dunfield CUBIX OS. + +6502 folk may have to settle for writing themselves a DOS-65 simulator 8) + diff --git a/Applications/cpm/emulator.s b/Applications/cpm/emulator.s new file mode 100644 index 00000000..0e87076e --- /dev/null +++ b/Applications/cpm/emulator.s @@ -0,0 +1,1617 @@ + ; must begin on a page boundary (address % 256 == 0) to ensure + ; the jump table is correctly aligned + ; + ; This varies by platform so we really want to make this relocatable + ; not linked per platform somehow + ; + ; + ; TODO + ; - Recheck all syscall translations + ; - Fix up directory mapping a bit more + ; - Move some of the scratch bytes into the CP/M work area + ; - Save the syscall vector on entry and go via the saved copy as the + ; RST could be re-used by CP/M programs + ; - Make the code use indirect pointers to the directory buffer etc + ; from the scratch space so that we can eventually make it + ; multi-threaded for boxes with a large fixed common where we want to + ; try and maximise the TPA by having CP/M emulation in the fixed + ; common and allocating buffers in that space indexed off the process + ; + .module cpm + .area ASEG(ABS) + + .include "cpm.def" + +startaddr: + +fcb .EQU 0x005C ; Default CP/M FCB +buff .EQU 0x0080 ; Default CP/M Buffer +BS .EQU 0x08 ; ASCII BackSpace +TAB .EQU 0x09 ; ASCII Horizontal Tab +LF .EQU 0x0A ; ASCII Line Feed +CR .EQU 0x0D ; ASCII Carriage Return +ESC .EQU 0x1B ; ASCII ESCape Char + +TCGETS .EQU 1 ; Fuzix - get tty data +TCSETS .EQU 2 ; Fuzix - set tty data +TIOCINQ .EQU 5 ; Fuzix - characters pending + +STDIN .EQU 0 ; file descriptor value of keyboard +STDOUT .EQU 1 ; file descriptor value of display + +; +; FIXME: set up phase can be in the runcpm tool +; +; Initialize both FCB entries to blank values + +EStart: LD HL,#fcbDat ; Move initial FCB + PUSH HL + LD DE,#fcb ; into + LD BC,#16 ; position + LDIR + POP HL + LD C,#16 ; init 2nd entry + LDIR + +; Catenate argv[] elements into default buffer + + POP IX ; Get Ptr to argv[] + INC IX ; Skip "runcpm" + INC IX +; +; Load the binary of argv[1] at 0x0100 (obliterating runcpm) (passed as fd +; 2) +; + LD DE,#__bdos - 0x100 ; largest possible binary space + PUSH DE + LD DE, #0x0100 + PUSH DE + LD DE,#3 ; file handle + PUSH DE + LD DE,#7 ; read() + PUSH DE + RST 0x30 + POP DE + POP DE + POP DE + POP DE + LD DE,#3 + PUSH DE + DEC DE ; #2 close + PUSH DE + RST 0x30 + POP DE + POP DE + INC IX ; Skip binary name + INC IX +; +; Turn the following arguments into the CP/M tail and default FCB +; + LD DE,#buff+1 ; Pt to CP/M Dflt Buffer + LD C,#0 ; Cnt to 0 + INC IX ; Skip Argv[0] + INC IX +Cold0: LD L, 0(IX) ; Get Ptr to Arg element + INC IX + LD H, 0(IX) + INC IX + LD A,H + OR L ; End? + JR Z,Cold2 ; ..exit if Yes + LD A,#' ' ; Add space separator for args + LD (DE),A + INC DE + INC C ; bump count +Cold1: LD A,(HL) + OR A ; End of string? + JR Z,Cold0 ; ..try next if Yes + CP #'a' ; ensure + JR C,NoCap ; it + CP #'z'+1 ; is + JR NC,NoCap ; UCase + AND #0x5F +NoCap: LD (DE),A ; Move a byte + INC HL + INC C ; bump count + INC E ; bump ptr + JR NZ,Cold1 ; ..get next byte if no bfr ovfl + ;..else 0FF->100H, terminate + DEC E ; (back up for Null-termination) +Cold2: XOR A + LD (DE),A ; Null-terminate for safety + + LD HL,#buff ; Pt to count loc'n in buff + LD (HL),C ; save total arg count + INC HL ; advance to 1st char + LD DE,#fcb+1 + CALL FilNm ; Get Name/Typ in 1st FCB + OR A ; (set End flag) + LD DE,#fcb+17 ; (prepare) + CALL NZ,FilNm ; Get Tame/Typ in 2nd FCB if present + + LD DE,#dir + LD B,#128 + CALL ZeroDE ; Clear Directory Buffer + + LD HL,#0 + LD (0x0003),HL ; Clear IOBYTE and Default Drive/User + + JP __bios ; Go to Cold Start setup + +; Fill FCB Name.Typ fields with any present data + +FilNm: LD A,(HL) ; Get char + INC HL ; bump + OR A ; End of String? + RET Z + CP #' ' ; "Whitespace"? + JR Z,FilNm0 ; ..jump if Yes + CP #TAB + JR NZ,FilNm1 ; ..jump if No +FilNm0: DEC C ; Count down total length + LD A,C ; (prepare) + JR NZ,FilNm ; ..loop if Not End + RET ; ..else Exit showing EOL + +FilNm1: LD B,#8 ; Set length of Name field + PUSH DE ; save Ptr to Name[0] + CALL FilFl0 ; Get Name + POP DE ; restore Ptr to Name + OR A + RET Z ; ..return if End-of-Line + CP #' ' + RET Z ; ..return if separator + CP #'.' + JR Z,FilNm2 ; ..bypass char skip + +FilNm3: LD A,(HL) + INC HL + OR A + RET Z ; Exit if End of Line + CP #' ' + RET Z ; or End of Field + CP #'.' + JR NZ,FilNm3 ; ..loop til End or period + +FilNm2: LD A,E + ADD A,#8 ; Adjust FCB ptr to type field + LD E,A + LD B,#3 + ;..fall thru to get next char.. +; Move bytes from (HL) to (DE) for Count in C, Count in B or Ch in {' ','.',0} + +FilFld: LD A,(HL) ; Get Char + INC HL ; bump ptr + OR A ; End of String? + RET Z ; ..return if Yes +FilFl0: CP #'.' ; Period? + RET Z + CP #' ' ; Space? + RET Z + LD (DE),A ; Else Store byte + INC DE ; bump dest ptr + DEC C ; End of Input String? + LD A,C ; (prepare) + RET Z ; .return End if Yes + DJNZ FilFld ; ..loop til field counter ends + OR #0x0FF ; Return flag + RET + +fcbDat: .db 0 + .ascii ' ' + .db 0,0,0,0 + + +;========================================================== +; Resident Portion of Basic Disk Operating System +;========================================================== +; bdos() +; { +__bdos: JP _bdos0 +; } + +;..... +; BDOS Function Dispatch Table + +fcnTbl: .dw Fcn0 ; Warm Boot + .dw Fcn1 ; ConIn + .dw Fcn2 ; ConOut + .dw Fcn3 ; Reader In + .dw Fcn4 ; Punch Out + .dw Fcn5 ; List Output + .dw Fcn6 ; Direct Console IO + .dw Fcn7 ; Get IOBYTE + .dw Fcn8 ; Set IOBYTE + .dw Fcn9 ; WrBuf + .dw Fcn10 ; RdBuf + .dw Fcn11 ; Get Console Status + .dw Fcn12 ; Return Version # + .dw Fcn13 ; Reset Disk Drive + .dw Fcn14 ; Select Disk + .dw Fcn15 ; Open File + .dw Fcn16 ; Close File + .dw Fcn17 ; Search First Occurance + .dw Fcn18 ; Search Next Occurance + .dw Fcn19 ; Delete File + .dw Fcn20 ; Read File + .dw Fcn21 ; Write File + .dw Fcn22 ; Create File + .dw Fcn23 ; Rename File + .dw Fcn24 ; Return Disk Login Vector + .dw Fcn25 ; Return Current Disk + .dw Fcn26 ; Set DMA + .dw Fcn27 ; Get Allocation Map + .dw Fcn28 ; Write Protect Disk + .dw Fcn29 ; Get R/O Vector Address + .dw Fcn30 ; Set File Attributes + .dw Fcn31 ; Get Disk Parameter Table Address + .dw Fcn32 ; Set/Get User Code + .dw Fcn33 ; Read Random + .dw Fcn34 ; Write Random + .dw Fcn35 ; Compute File Size + .dw Fcn36 ; Set Random Record Field in FCB +; .dw Fcn37 ; Reset Multiple Drives +; .dw null ; (Fcn38 not implemented) +; .dw Fcn39 ; Get Fixed Disk Vector +; .dw Fcn40 ; Write Random +TBLSZ .EQU .-fcnTbl +MAXFCN .EQU TBLSZ/2 + +;------------------------------------------------ +; bdos0() +; { + +_bdos0: LD (_arg),DE + LD A,C + LD (_call),A + CP #MAXFCN ; Legal Function? + LD A,#0xFF ; Prepare Error code + LD L,A + RET NC ; ..return if Illegal + LD (_userSP),SP + LD SP,#_Bstack + PUSH IX + PUSH IY + LD B,#0 ; Fcn # to Word + LD HL,#_bdosX + PUSH HL ; (ret Addr to Stack) + LD HL,#fcnTbl + ADD HL,BC + ADD HL,BC ; Pt to Fcn entry in Table + LD A,(HL) + INC HL + LD H,(HL) + LD L,A + JP (HL) ; "Call" Function # + +_bdosX: POP IY + POP IX + LD SP,(_userSP) + LD DE,(_arg) ; Return Orig contents of DE + LD A,(_call) + LD C,A ; Return Orig contents of C + LD A,L + LD B,H ; Strict compatibility + OR A + RET +; } + +;------------------------------------------------ +; case 0: _exit(); /* Warm Boot */ + +Fcn0: JP WBoot + +;------------------------------------------------ +; case 6: if (arg < 0xfe) /* Direct Console I/O */ +; goto conout; +; else if (arg == 0xfe) +; return (ConSt); +; else if (ConSt) /* 0xff */ +; goto conout; +; else return (0); + +Fcn6: LD A,E ; _arg in DE + CP #0x0FE ; < 0FE ? + JR C,Fcn2 ; ..jump if Write if Yes + PUSH AF + CALL BConSt ; Else get Console Status + POP AF + INC A + RET NZ ; ..exit with 0ffh if 0feh + LD A,H + OR L ; Any char ready? + RET Z ; ..exit if Nothing available + ;..else fall thru to Fcn1.. +;------------------------------------------------ +; case 1: /* Console Input */ +; conin: read (0, &c, 1); +; if (c == '\n') +; c = '\r'; +; return (c); + +Fcn1: CALL BConIn ; Get Char from Bios +Fcn1A: LD H,#0 + CP #0x0A ; \n? + LD L,A ; (prepare for return + RET NZ ; ..return if Not + LD L,#0x0D ; Else return CR + RET + +;------------------------------------------------ +; case 3: /* Reader (Aux) Input */ +; conin: read (0, &c, 1); +; if (c == '\n') +; c = '\r'; +; return (c); + +Fcn3: CALL AuxIn ; Get Char from Bios + JR Fcn1A ; ..exit via common code + +;------------------------------------------------ +; case 2: /* Console Output */ +; conout: if (arg == '\r') +; return (0); +; c = arg; +; write (1, &c, 1); +; break; + +Fcn2: LD C,E ; _arg in DE, need char in C + JP BConOu + +;------------------------------------------------ +; case 4: /* Punch (Aux) Output */ +; conout: if (arg == '\r') +; return (0); +; c = arg; +; write (1, &c, 1); +; break; + +Fcn4: LD C,E ; _arg in DE, need char in C + JP AuxOut + +;------------------------------------------------ +; case 5: if (arg == '\r') /* List (Prntr) Output */ +; return (0); +; c = arg; +; write (2, &c, 1); +; break; + +Fcn5: LD A,E ; _arg in DE + CP #13 ; \r? + RET Z + JP List ; ..go to Bios + +;------------------------------------------------ +; case 9: ptr = (char *)arg; /* Print '$'-term String */ +; while (*ptr != '$') +; { +; if (*ptr != '\r') +; write (1, ptr, 1); +; ++ptr; +; } +; break; + ; Enter: DE -> String (arg) +Fcn9: LD A,(DE) ; Get char + INC DE ; pt to Next + CP #'$' ; End? + RET Z ; ..quit if Yes + LD C,A + PUSH DE + CALL BConOu + POP DE + JR Fcn9 ; ..loop Til done + +;------------------------------------------------ +; case 10: rdbuf (arg); +; break; +; rdbuf (arg) +; char *arg; +; { +; int nread; + +; nread = read (0, arg+2, *arg & 0xff); + +Fcn10: + push de + ex de,hl ; hl - buffer + ld e,(hl) ; e - max chars + inc hl + inc hl + ld d,#0 ; d - char cnt +get: push hl + push de + call BConIn + pop de + pop hl + cp #8 + jr z,del + cp #0x7F + jr z,del + cp #3 + jp z,0 + push hl + push de + push af + ld c,a + call BConOu + pop af + pop de + pop hl + ld (hl),a + cp #CR + jr z,eol + ld a,e + cp d + jr z,eol1 + inc hl + inc d + jr get +del: ld a,d + or a + jr z,get + push hl + push de + ld c,#8 + call BConOu + ld c,#' ' + call BConOu + ld c,#8 + call BConOu + pop de + pop hl + dec hl + dec d + jr get +eol: ld (hl),#0 +eol1: ld a,d + pop de + inc de + ld (de),a + ld hl,#0 + ret + + +;------------------------------------------------ +; case 11: return (ConSt); /* Get Console Status */ + +Fcn11: JP BConSt + +;------------------------------------------------ +; case 12: /* Return Version # */ + +Fcn12: LD HL,#0x0022 ; Say this is CP/M 2.2 + RET + +;------------------------------------------------ +; case 13: /* Reset Disk Drive */ +; SDma(0x80); +; break; +Fcn13: + LD BC,#0x80 + JP BSDma + +;------------------------------------------------ +; case 7: /* Get IO Byte */ +; case 8: break; /* Set IO Byte */ +; case 14: break; /* Select Disk +; case 25: break; /* Return Current Disk */ +; case 28: break; /* Write Protect Disk */ +; case 30: break; /* Set File Attribytes */ +; case 32: break; /* Get/Set User Code */ +Fcn7: +Fcn8: +Fcn14: +Fcn25: ; 0 = Drive A +Fcn28: +Fcn30: +Fcn32: ; Return User 0 +; default: break; +; } +; return (0); + +Exit0: LD HL,#0 + RET + +;------------------------------------------------ +; case 15: return (openfile (arg)); /* Open File */ +; openfile (blk) +; { +; desc = open (getname (arg), 2); + ; DE -> arg +Fcn15: CALL Fcn17 ; Does this file exist? + LD A,H + AND L + INC A ; File Not Found (-1)? + RET Z ; ..return -1 if File doesn't exist + +Open1: CALL CkSrch ; (Close Search File) + +; arg.recno = 0; + + CALL ZeroCR + LD 13(IY),#0x80 ; use S1 as file open flag + + JR Exit0 ; Return Dir Code for Entry + +;..... +; Common File Open Routine. Used by Read, Write and Search First. +; Enter: DE = File Mode +; HL = Ptr to Null-terminated Path String +; Exit : A = 0 if Error, HL = -1 +; File Descriptor, A <> 0 if Ok + +OpenF: PUSH DE ; Mode + PUSH HL ; Path + LD HL,#1 ; Fuzix Open Fcn # + PUSH HL + RST 0x30 ; _open (Path, Mode); + POP BC ; Clean Stack + POP BC + POP BC + LD A,H + AND L + INC A ; FF -> 0? + RET ; ..return (HL=-1/A=0 if Err, HL=fd/A<>0 of Ok) + +;------------------------------------------------ +; case 16: return (closefile (arg)); /* Close File */ + +; if (close (arg->desc) == -1) + +Fcn16: LD IY,(_arg) + LD 13(IY),#0 ; clear file open flag + + LD HL,#11 ; Fuzix sync function # + PUSH HL + RST 0x30 ; Execute! + POP BC ; Clean Stack + + JP Exit0 ; Return OK + +;.... +; Close file descriptor + +CloseV: PUSH DE + LD HL,#2 ; Fuzix Close Fcn # + PUSH HL + RST 0x30 ; Execute! + POP BC ; Clean Stack + POP BC + RET + +;------------------------------------------------ +; case 17: /* Search First */ + +Fcn17: CALL CkSrch ; Ensure Search File closed + LD HL,#'.' ; Open current directory + LD (RName),HL ; store name in Secondary work string + LD DE,#0 ; Open Read-Only + LD HL,#RName + CALL OpenF ; _open ('.', 0); + RET Z ; HL = -1, A = 0 if Can't Open + + LD (srchFD),HL ; Else Ok, Save File Descriptor + LD (curFil),HL ; Duplicate for Reading + ;..fall thru to read one entry.. +;------------------------------------------------ +; case 18: return (255); /* Search Next */ + +; +; FIXME: +; We really only need 64bytes of scratch space here +; 32-63 for the FUZIX entry +; 0-31 for the directory entry in CP/M format, but we must +; return A = 0. We also ought to magic up the second half of +; the entry but it's not clear how. The rest of the 128 bytes +; are undefined after this call. Given we can't really magic +; up the second 16 bytes we may only need 48 +; +; +Fcn18: LD HL,(dmaadr) + LD (dmaSav),HL ; Save "real" DMA +Fcn18A: LD HL,#dir+16 + LD (dmaadr),HL ; Set DMA for Dir Op'n + LD A,#16 ; Getdirent + LD DE,#32 ; Len of Dir entries + CALL RdWrt0 ; Read an Entry + JR C,#Fcn18E ; Error if Carry Set + OR A ; Read Ok? + JR Z,Fcn18E ; ..Return HL=-1 if EOF + CALL ChkDir ; Else Set Dir to CP/M, Check Match + OR A + JR NZ,Fcn18A ; ..loop if No Match + + LD A,(_call) + CP #15 ; Is this a File Open internal Call? + LD HL,#0 ; (set Success, Index 0) + JR Z,Fcn18X ; ..exit now if Yes + + LD HL,#dir ; Else + LD DE,(dmaSav) ; Move Dir Buffer to "real" DMA + LD BC,#128 + LDIR + LD L,B ; Use 0 in BC + LD H,C ; to show Index 0 (success) + JR Fcn18X ; ..exit + +Fcn18E: LD HL,#-1 +Fcn18X: LD DE,(dmaSav) + LD (dmaadr),DE ; Restore "real" DMA Addr + RET + +;------------------------------------------------ +; case 19: return (delete (arg)); /* Delete File */ + +Fcn19: CALL CkSrch ; Ensure Search file closed + +; if (unlink (getname (arg)) == -1) + ; DE -> arg + CALL GetNam ; Parse to String + PUSH HL ; String + LD HL,#6 ; UZI Unlink Fcn # + PUSH HL + RST 0x30 ; Execute! + POP BC ; Clean Stack + POP BC + +; return (255); +; return (0); + + LD A,H + AND L + INC A ; FF->0? + JP NZ,Exit0 ; return Ok if No + +ExitM1: LD HL,#-1 + RET + + +;------------------------------------------------ +; case 33: /* Read File Random */ +; readrandom (fcb) +; { + +Fcn33: CALL RWprep ; Prepare File for access + JP Z,Exit1 + + LD IY,(_arg) + LD A,33(IY) ; Set Record Count from + LD 32(IY),A ; Random Record number + LD A,34(IY) ; + LD 12(IY),A ; + + CALL DoRead + JR RWEx + +;.... +DoRead: + CALL LSeek ; Seek to Offset (128-byte rec in Block) + + CALL BRead ; Read 1 Sector + + PUSH AF + LD DE,(curFil) +;;;; CALL CloseV ; Close the file + LD DE,#0 + LD (curFil),DE + POP AF + + RET + + +;------------------------------------------------ +; case 20: return (readfile (arg)); /* Read File */ +; readfile (arg) +; { +; nread = read (blk->desc, dmaadr, 128); + ; DE -> arg (FCB) +Fcn20: CALL RWprep ; Prepare file for access + JP Z,Exit1 + + CALL DoRead ; Read 1 Sector + +; arg.recno++; + + PUSH AF + CALL IncCR ; Bump Current Record # + POP AF + +RWEx: JP C,Exit1 ; ..Error if Carry Set + +; if (nread == 0) +; return (0); + + OR A ; Good Read? + JP Z,Exit0 ; exit w/0 if Yes + +; else return (1) + + JP Exit1 + +;------------------------------------------------ +; case 34: /* Write File Random */ +; writerandom (fcb) +; { +; /* CAUTION the seek calls MUST be in this order */ +; _seek (f, (int)(fcb+33) % 128, 0); /* byte seek */ +; _seek (f, (int)(fcb+33) / 128, 3); /* block seek */ + +Fcn34: CALL RWprep ; Prepare file for access + JP Z,Exit1 + + LD IY,(_arg) + LD A,33(IY) ; Set Record Count from + LD 32(IY),A ; Random Record number + LD A,34(IY) ; + LD 12(IY),A ; + + CALL DoWrite + JR RWEx + +;.... +DoWrite: + CALL LSeek ; Seek to Offset (128-byte rec in Block) + + CALL BWrit ; Write 1 Sector + + PUSH AF + LD DE,(curFil) +;;;; CALL CloseV ; Close the file + LD DE,#0 + LD (curFil),DE + POP AF + + RET + +;------------------------------------------------ +; case 21: return (writefile (arg)); /* Write File */ +; writefile (arg) +; { +; if (write (blk->desc, dmaadr, 128) != 128) + + ; DE -> arg (FCB) +Fcn21: CALL RWprep ; Prepare file for access + JP Z,Exit1 + +Fcn21A: CALL DoWrite ; Write + +; arg.recno++; + + PUSH AF + CALL IncCR ; Bump Current Record # + POP AF + +; return (255); +; return (0); + + JR RWEx ; ..exit via Common R/W Code +; } + +;------------------------------------------------ +; case 22: return (makefile (arg)); /* Create File */ +; makefile (arg) +; { +; desc = creat (getname (blk), 0666); + +Fcn22: CALL CkSrch ; Ensure Search file closed + LD HL,#0q0666 ; Own/Grp/Oth are Read/Execute + PUSH HL ; DE -> arg + LD HL,#0x502 ; O_CREAT|O_RDWR|O_TRUNC + CALL GetNam ; This name string + PUSH HL + LD HL,#1 ; Fuzix open Fcn # + PUSH HL + RST 0x30 ; Execute! + POP BC ; Clean Stack + POP BC + POP BC + POP BC + +; if (desc == -1) + + LD A,H + AND L + INC A ; FF -> 0? + +; return (255); + + RET Z ; ..return -1 if Yes + +; arg.recno = 0; + + EX DE,HL + CALL CloseV + JP Open1 + +;------------------------------------------------ +; case 23: return (rename (arg)); /* Rename File */ +; rename (arg) +; { +; RName = getname (arg); +; +; FIXME: should use rename() syscall now +; +Fcn23: CALL CkSrch ; Ensure Search file closed + PUSH DE ; Save FCB Ptr + CALL GetNam ; parse to UZI String + + LD HL,#FName + LD DE,#RName + LD BC,#12 + LDIR ; Copy to Rename string + +; FName = getname (arg+16); + + POP DE ; DE -> _arg + LD HL,#16 + ADD HL,DE ; Offset to New Name + EX DE,HL + CALL GetNam ; parse it returning HL -> FName + +; if (link (RName, FName) < 0) { + + PUSH HL ; New Name + LD HL,#RName ; Old Name + PUSH HL + LD HL,#5 ; UZI link Fcn # + PUSH HL + RST 0x30 ; Execute! + POP BC ; Clean Stack + POP BC + POP BC + +; return (-1); + + JP C,ExitM1 ; Exit w/Err if Bad +; } +; if (unlink (RName) < 0) { + + LD HL,#RName ; Old Name + PUSH HL + LD HL,#6 ; UZI unlink Fcn # + PUSH HL + RST 0x30 ; Execute! + POP BC ; Clean Stack + POP BC + JP NC,Exit0 ; exit w/0 if Ok + +; unlink (FName); + ; Else remove the new iNode + LD HL,#FName ; New Name + PUSH HL + LD HL,#6 ; UZI unlink Fcn # + PUSH HL + RST 0x30 ; Execute! + POP BC ; Clean Stack + POP BC + +; return (-1); + + JP C,ExitM1 ; return -1 if Bad +; } +; return (0); + + JP Exit0 ; else return Ok +; } + +;------------------------------------------------ +; case 24: return (1); /* Return Disk Login Vector */ + +Fcn24: +Exit1: LD HL,#1 + RET + +;------------------------------------------------ +; case 26: dmaadr = (char *)arg; /* Set DMA Address */ +; break; + ; Enter DE = DMA Address +Fcn26: LD C,E + LD B,D ; Move to Bios Regs + JP BSDma ; Set in Bios & return + +;------------------------------------------------ +; case 27: return (-1) /* Get Allocation Map */ +; case 29: return (-1) /* Get R/O Vector Address */ +Fcn27: +Fcn29: LD HL,#-1 + RET + +;------------------------------------------------ +; case 31: return (&dpb); /* Get Disk Param Table Addr */ + +Fcn31: LD HL,#dpb + RET +; } + +;------------------------------------------------ +; case 35: /* Return File Size in FCB */ +; /* Use stat fcn, rounding up to mod-128 */ +; if (_stat (dname, &statbuf) == 0) { + ; DE -> fcb +Fcn35: CALL CkSrch ; Ensure Search file closed + CALL GetNam ; parse to UZI String + LD DE,#stBuf + PUSH DE ; &statbuf + PUSH HL ; dname + LD HL,#15 ; UZI stat Fcn # + PUSH HL + RST 0x30 ; Execute! + POP BC ; Clean Stk + POP BC + POP BC + LD IY,(_arg) + LD A,H + OR L ; 0? + JR NZ,Fcn35X ; ..jump if Bad + +; (int)fcb+33 = ((512 * statbuf.st_size.o_blkno +; + statbuf.st_size.o_offset) +; + 127) +; >> 7; +; FIXME: offset is now a simple number so this is wrong +; + LD HL,(stBuf+14) ; Get Offset + LD DE,#127 + ADD HL,DE ; round up to next 128-byte block + ADD HL,HL ; Shift so H has 128-byte blk # + LD E,H ; position in DE + LD HL,(stBuf+16) ; Get Block + ADD HL,HL ; * 2 + ADD HL,HL ; * 4 for 128-byte Block Count + ADD HL,DE ; Now have CP/M Record Size + LD 33(IY),L + LD 34(IY),H ; Store in RR fields in FCB + LD 35(IY),D ; (D = 0) + +; return (0); + + LD L,D + LD H,D ; HL = 0 + RET + +; else { +; (int)fcb+33 = 0; + +Fcn35X: LD 33(IY),#0 + LD 34(IY),#0 + LD 35(IY),#0 + +; return (-1); + + LD HL,#-1 +; } + RET + +;------------------------------------------------ +; case 36: /* Set Random Record Field in FCB */ + +Fcn36: LD IY,(_arg) + LD A,32(IY) ; Fetch RecNo + LD 33(IY),A ; place in LSB of RR field (r0) + LD A,12(IY) + LD 34(IY),A ; set (r1) + LD 35(IY),#0 ; Clear Hi byte of RR (r2) + + LD HL,#0 ; Return Ok + RET + +;=========================================================== +; BDos Support Routines +;=========================================================== +; char * +; getname (struct fcb *blk) +; { +; int j; +; static char name[16]; +; char *p; + +; p = name; + ; Enter: DE -> FCB drive byte +GetNam: LD IX,#FName ; Dest to string + EX DE,HL + PUSH HL ; (save) + INC HL ; adv to 1st char of FN + +; for (j = 0; j < 8; ++j) +; { +; if (!blk->name[j] || blk->name[j] == ' ') +; break; + + LD B,#8 +GetN0: LD A,(HL) + INC HL + OR A + JR Z,GetN1 + CP #' ' + JR Z,GetN1 + +; *p++ = chlower (blk->name[j]); + + CALL ChLower + LD 0(IX),A + INC IX + DJNZ GetN0 +; } + +GetN1: POP HL + LD DE,#9 + ADD HL,DE ; Pt to 1st char of FT + LD A,(HL) + CP #' ' ; Any Type? + JR Z,GetNX ; ..quit if Not + +; *p++ = '.'; + + LD 0(IX),#'.' + INC IX + +; for (j = 0; j < 3; ++j) + + LD B,#3 + +; { +; if (!blk->ext[j] || blk->ext[j] == ' ') +; break; + +GetN2: LD A,(HL) + INC HL + CP #' ' + JR Z,GetNX + +; *p++ = chlower (blk->ext[j]); + + CALL ChLower + LD 0(IX),A + INC IX + DJNZ GetN2 + +; } +; *p = '\0'; + +GetNX: LD 0(IX),#0 + +; return (name); + + LD HL,#FName + RET +; } + +; +; FIXME: we need to use lseek for Fuzix +; +LSeek: LD BC,#0 ; Push 0 for absolute + PUSH BC + LD IY, (_arg) ; FCB + LD C, 32(IY) ; Pull the offset out of the FCB + LD B, 12(IY) ; This is in records (128 bytes) + ; And may overflow 2^16 bytes + XOR A + SLA C ; C x 2, into carry + RL B ; B x 2 picking up carry from C + RLA ; A x 2 picking up carry from B - now in 64's + SLA C + RL B + RLA ; now in 32's + SLA C + RL B + RLA ; now in 16's + SLA C + RL B + RLA ; now in 8's + SLA C + RL B + RLA ; now in 4's + SLA C + RL B + RLA ; now in 2's + SLA C + RL B + RLA ; now in bytes + LD (LSeekData), BC ; low bits + LD (LSeekData + 2), A ; high bit (top byte already clear) + LD BC, #LSeekData ; push pointer + PUSH BC + LD HL, (curFil) + PUSH HL + LD HL,#9 ; _lseek() + PUSH HL + RST 0x30 ; Syscall + POP BC ; Recover stack + POP BC + POP BC + POP BC + RET + +;..... +; Perform File Access Preparatory actions: +; Open file for R/W and Seek to current Record # +; Enter: DE = Ptr to FCB +; Exit : A = 0 and HL = -1 if Error, A <> 0 if Ok + +RWprep: CALL CkSrch ; Ensure Search file closed + LD HL,#13 ; offset to S1 (file open flag) + ADD HL,DE + LD A,(HL) + AND #0x80 + LD HL,#-1 + RET Z + + CALL GetNam ; Parse FCB Fn.Ft to String + + CALL COpen + RET Z ; ..return -1 on error + + LD (curFil),HL ; store file descriptor for Bios + RET + +COpen: PUSH HL + LD DE,#CName +chk: LD A,(DE) + CP (HL) ; compare filename with cached name + JR NZ,differ + OR A + JR Z,same + INC HL + INC DE + JR chk +same: POP DE ; if same, just return the cached file descr + LD HL,(Cfd) + LD A,H + AND L + INC A + RET NZ + EX DE,HL + JR op1 +differ: LD HL,(Cfd) + LD A,H + AND L + INC A + EX DE,HL + CALL NZ,CloseV ; close old file + POP HL ; restore file name + CALL Ccopy +op1: LD DE,#2 ; open for R/W + CALL OpenF + LD (Cfd),HL + RET + +Ccopy: PUSH HL + LD DE,#CName +cpy: LD A,(HL) + LD (DE),A + INC HL + INC DE + OR A + JR NZ,cpy + POP HL + RET + +;..... +; Convert UZI Directory Entry at dir+16 to CP/M FCB entry at dir, Zero rest. +; Ambiguously compare FCB FN.FT at dir to that passed at arg, returning Zero +; if Match, Non-Zero if mismatch. + +ChkDir: LD DE,#dir + LD HL,#dir+16+2 ; Pt to 1st char of Name + XOR A + LD (DE),A ; Zero Drive field + INC DE ; Pt to 1st char of FN + LD B,#8 + CALL ChkD0 ; Fix Name + LD B,#3 + CALL ChkD0 ; & Type + LD B,#21 + CALL ZeroDE ; Clear rest of Dir entry + + LD DE,(_arg) + INC DE ; Pt to 1st char of FN + LD A,(DE) + CP #' ' ; Any Name present? + JR NZ,ChkFN0 ; ..jump if Yes + LD HL,#8 + ADD HL,DE ; Else offset to 1st char of FT + LD A,(HL) + CP #' ' ; Type present? + LD A,#0x0FF ; (Assume Error) + RET Z ; Return w/Err Flag if no Type either + +ChkFN0: LD HL,#dir+1 ; Else Compare name/type fields + LD B,#11 + ; Ambiguous FN.FT compare of (HL) to (DE) +ChkL: LD A,(DE) + CP #'?' ; Accept anything? + JR Z,ChkL0 ; ..jump if ambiguous + XOR (HL) + AND #0x7F ; Match? + RET NZ ; .Return Non-Zero if Not +ChkL0: INC HL + INC DE + DJNZ ChkL ; ..loop til Done + XOR A ; return Zero for Match + RET + +;..... +; Parse FileSpec addressed by HL into FN.FT Spec addressed by DE. + +ChkD0: LD A,(HL) ; Get Char + CP #'a' + JR C,ChkD1 + CP #'z'+1 + JR NC,ChkD1 + AND #0x5F ; Convert to Uppercase +ChkD1: OR A ; End of String? + JR Z,ChkDE ; ..jump if End + INC HL ; (bump Inp Ptr if Not End) + CP #'.' + JR Z,ChkDE ; ..or Period field separator + LD (DE),A ; Store char + INC DE ; bump Dest + DJNZ ChkD0 ; ..loop til field done +ChkD2: LD A,(HL) ; Get Next + OR A + RET Z ; Exit at End of string + INC HL ; (adv to next) + CP #'.' + RET Z ; or field separator + JR ChkD2 ; ..loop til end found + +ChkDE: LD A,#' ' ; Fill rest w/Spaces +ChkD3: INC B + DEC B ; More in field? + RET Z ; ..exit if Not + JR ZeroL ; ..else stuff spaces til field ends + +;..... +; Zero area addressed by DE for B Bytes. Uses A,B,DE. + +ZeroDE: XOR A +ZeroL: LD (DE),A + INC DE + DJNZ ZeroL + RET + +;..... +; Close the Directory if we just exitted a SearchF/SearchN sequence + +CkSrch: PUSH DE ; Save Regs + PUSH HL + LD DE,(srchFD) ; Get File Desc + LD A,D + OR E ; Anything open? + CALL NZ,CloseV ; Close file if Yes + LD HL,#0 + LD (srchFD),HL ; Mark as closed + POP HL ; (ignore Errors) + POP DE + RET + +;..... +; Bump current Record # for sequential R/W operations + +IncCR: LD IY,(_arg) + INC 32(IY) ; Bump Lo byte + RET NZ + INC 12(IY) ; Bump Hi byte + RET + +;..... +; Init Current Record # + +ZeroCR: LD IY,(_arg) + LD 32(IY),#0 ; Clear Lo Byte + LD 12(IY),#0 ; Clear Hi Byte + RET + +;..... +; Convert char in A to Lowercase Ascii + +ChLower: + CP #'A' + RET C + CP #'Z'+1 + RET NC + OR #0x20 ; Convert to Lcase + RET + +;= = = = = = = = = = = = = = = = = = = = = = = = = = = = = = +; Bdos data in Text Segment for treating as single module + +; struct fcb { +; char drive; +; char name[8]; +; char ext[3]; +; char junk1[4]; +; char desc; /* This byte & 1st byte of Name used for file desc */ +; char name2[8]; +; char ext2[3]; +; char junk2[4]; +; char junk3; +; }; + +_arg: .dw 00 ; Argument passed to Bdos (char *arg;) +_call: .db 0 ; Bdos Function # (char call;) +FName: .ascii ' ' ; Storage for FCB "name" String +RName: .ascii ' ' ; 2nd Storage for FCB "name" String (rename) + +CName: .ascii ' ' ; cached filename + .db 0 +Cfd: .dw -1 ; cached file descriptor + +curFil: .dw 00 ; Storage for File Descriptor of FCB + ; (set by Bdos, Used by Bios) +stBuf: .ds 30 ; Buffer for stat() results + +DOSSIZ .EQU .-EStart +RESV .EQU 0x100-(DOSSIZ&0x0FF) + .ds RESV ; Pad to make Bios start on even mult of 256 + +;============================================================ +; The Bios Jump table MUST start on an even MOD 256 boundary +;============================================================ + +__bios: JP __cold ; 0 Cold Boot +WBoot: JP Exit ; 1 Warm Boot +BConSt: JP ConSt ; 2 Console Status +BConIn: JP ConIn ; 3 Console Input +BConOu: JP ConOut ; 4 Console Output + JP List ; 5 Printer Output + JP AuxOut ; 6 Auxiliary Output (Punch) + JP AuxIn ; 7 Auxiliary Input (Reader) + JP Home ; 8 Home drive head + JP SelDsk ; 9 Select Drive + JP SetTrk ; 10 Set Track + JP SetSec ; 11 Set Sector +BSDma: JP SetDMA ; 12 Set DMA Address +BRead: JP Read ; 13 Read Sector +BWrit: JP Write ; 14 Write Sector + JP ListSt ; 15 Printer Status + JP SecTrn ; 16 Translate Sector + +;------------------------------------------------ +; Cold Entry. Set up CP/M vectors and Stack, Get +; Current TTY Parms, Save for Exit, and begin + +__cold: LD A,#0x0C3 + LD HL,#__bdos + LD SP,HL ; Set CP/M Stack for execution + LD (0x0005),A ; Set Bdos Vector + LD (0x0006),HL + LD HL,#WBoot + LD (0x0000),A ; Set Bios Warm Boot Vector + LD (0x0001),HL + + LD HL,#ttTermios0 ; & buf + LD DE,#TCGETS ; ioctl fcn to Get Parms + CALL IoCtl ; Execute ioctl fcn on STDIN + LD HL,#ttTermios0 + LD DE,#ttTermios + LD BC, #20 + LDIR ; Move to Work Area + ; Now we need to Change Modes defined in DEVTTY as: + ; RAW = 20H (0000040) + ; CRMOD = 10H (0000020) + ; ECHO = 08H (0000010) + ; CBREAK = 02H (0000002) + ; COOKED = 00H (0000000) + LD HL, #0 + ; Turn all the input and output magic off + LD (ttTermios), HL + LD (ttTermios + 2), HL + XOR A + LD (ttTermios+6), A ; Echo etch off + LD A, (ttTermios+7) + AND #0xF0 ; canonical processing off + LD (ttTermios+7), A + LD HL, #1 ; VTIME 0 + LD (ttTermios+8), HL ; VMIN 1 + LD HL, #ttTermios + LD DE, #TCSETS + CALL IoCtl ; Set terminal bits + + CALL 0x0100 ; ..Execute! + +;..... +; 1 - Warm Boot Vector (Exits back to UZI) {exit (0);} +; TTY Port Settings are restored to original state. + +Exit: LD C,#0x0D + CALL ConOut + LD C,#0x0A + CALL ConOut + LD HL,#ttTermios0 ; & buf + LD DE,#TCSETS ; ioctl fcn to Set Parms + CALL IoCtl ; Execute ioctl Fcn on STDIN + + LD HL,#0 ; Exit Good Status + PUSH HL + PUSH HL ; UZI Fcn 0 (_exit) + RST 0x30 ; Execute! +Spin: JR Spin ; Can't happen! + +;..... +; 2 - Return Console Input Status + +ConSt: LD HL,#cnt ; &buf + LD DE,#TIOCINQ ; ioctl fcn to read queue count + CALL IoCtl ; Execute ioctl on STDIN + LD HL,(cnt) + LD A,H + OR L ; Anything There? + RET Z ; ..return Zero if Not + OR #0x0FF ; Else signify char waiting + RET + +;..... +; 3 - Read Console Input Char {read (stdin, &char, 1);} + +ConIn: call ConSt + jr z,ConIn + LD HL,#1 ; 1 char + PUSH HL + LD DE,#char ; Addr to put char + PUSH DE + LD L,#STDIN ; fd + PUSH HL + LD L,#7 ; UZI Read Fcn +ChrV0: PUSH HL + RST 0x30 ; Execute + POP BC + POP BC + POP BC + POP BC + LD A,(char) + RET + +;..... +; 4 - Write Char in C to Console {write (stdout, &char, 1);} + +ConOut: LD A,C + LD DE,#char + LD (DE),A ; Stash char + LD HL,#1 ; 1 char + PUSH HL + PUSH DE ; Addr to get char + LD L,#STDOUT ; fd + PUSH HL + LD L,#8 ; UZI Write Fcn + JR ChrV0 ; ..go to common code + +;..... + +List: ; Bios Fcn 5 +AuxOut: ; Bios Fcn 6 +AuxIn: ; Bios Fcn 7 +Home: ; Bios Fcn 8 +SetTrk: ; Bios Fcn 10 +SetSec: ; Bios Fcn 11 +ListSt: ; Bios Fcn 15 +SecTrn: XOR A ; Bios Fcn 16. These are No-Ops + RET + +;..... +; 9 - Select Disk. Simply return the DPH pointer + +SelDsk: LD HL,#dph ; Return DPH Pointer + RET + +;..... +; 12 - Set DMA Transfer Address + +SetDMA: LD (dmaadr),BC ; Save Address + Ret + +;..... +; 13 - Read a "Sector" to DMA Address {read (curFil, dmaadr, 128);} + +Read: LD A,#7 ; Set UZI Read Fcn + CALL RdWrt ; Do the work + RET C ; ..exit if Error + OR A ; 0 bytes Read? + JR Z,XErr1 ; ..Return Error if Yes (EOF) + SUB #128 ; A full 128 bytes Read? + RET Z ; return Ok if Yes + LD DE,(dmaadr) + ADD HL,DE ; Else offset to byte after end +Feof: LD (HL),#0x1A ; stuff EOF in case of text + INC HL + INC A + JR NZ,Feof + RET ; exit with OK status + +;..... +; 14 - Write a "Sector" from DMA Address {write (curFil, dmaadr, 128);} + +Write: LD A,#8 ; Set UZI Write Fcn + CALL RdWrt ; Do the work + RET C ; ..exit if Error + SUB #128 ; Good Write? + RET Z ; return Ok if Yes +XErr1: SCF + JR XErr ; Else Return Error + +; Common Read/Write Support Routine + +RdWrt: LD DE,#128 ; 1 "Sector" char + ; Entry Point accessed by Search Next (BDos) +RdWrt0: PUSH DE + LD HL,(dmaadr) ; from here + PUSH HL + LD HL,(curFil) ; to this file + PUSH HL + LD E,A ; Position R/W Fcn # + PUSH DE + RST 0x30 ; Execute! + POP BC ; Clear Stack + POP BC + POP BC + POP BC + LD A,L ; Shuffle possible byte quantity + RET NC ; ..return if No Error +XErr: LD A,#0x01 ; Else Signal Error (keeping Carry) + RET + +;========================================================== +; Bios Support Utilities +;========================================================== +; Execute ioctl Function on STDIN +; Enter: HL = Addr of Parm Block +; DE = ioctl Function to execute +; Exit : None +; Uses : AF,BC,DE,HL + +IoCtl: PUSH HL ; &buf + PUSH DE ; ioctl fcn + LD E,#STDIN ; fd + PUSH DE + LD E,#29 ; Fuzix ioctl Fcn # + PUSH DE + RST 0x30 ; Execute! + POP BC ; Clean Stack + POP BC + POP BC + POP BC + RET + +;- - - - - - - - - - Data Structures - - - - - - - - - + +dph: .dw 0 ; Ptr to Skew Table + .dw 0,0,0 ; Scratch Words for BDos use + .dw dir ; Ptr to Directory Buffer + .dw dpb ; Ptr to DPB + .dw 0 ; Ptr to Disk Checksum Buffer + .dw 0 ; Ptr to ALV Buffer + + +dpb: .dw 64 ; Dummy Disk Parameter Block + .db 4 + .db 15 + .dw 0x0FFFF + .dw 1023 + .db 0x0FF,0 + .db 0,0,0,0 + +;----------------------- Data ----------------------- + +dmaadr: .dw 0x0080 ; Read/Write Transfer Addr (char *dmaadr;) +dmaSav: .dw 0 ; Temp storage of current DMA Address +srchFD: .dw 0 ; File Descriptor for Searches +char: .db ' ' ; Byte storage for Conin/Conout +cnt: .dw 0 ; Count of waiting keys +LSeekData: .dw 0 ; Used for _lseek() syscalls + .dw 0 +ttTermios: + .ds 20 ; Working TTY Port Settings +ttTermios0: + .ds 20 ; Initial TTY Port Settings + +dir: .ds 128 ; Directory Buffer + + .ds 128 +_Bstack: +_userSP:.dw 0 ; WRS: important that we write data all the way to the very last byte used + +BIOSIZ .EQU .-__bios +CPMSIZ .EQU .-__bdos + +; .end + diff --git a/Applications/cpm/runcpm.c b/Applications/cpm/runcpm.c new file mode 100644 index 00000000..f3b87358 --- /dev/null +++ b/Applications/cpm/runcpm.c @@ -0,0 +1,75 @@ +#include +#include +#include +#include +#include + +static char path[] = "/usr/lib/cpm/emulator.bin"; + +void writes(const char *p) +{ + write(2, p, strlen(p)); +} + +static struct stat st; +unsigned char buf[4]; +unsigned char *basep; +void (*exec)(char *argv[]); + +int main(int argc, char *argv[]) +{ + + int fd; + + if (argc < 2) { + writes("runcpm [app.com] [args...]\n"); + exit(1); + } + + fd = open(path, O_RDONLY); + if (fd == -1) { + perror(path); + exit(1); + } + if (read(fd, buf, 4) != 4 || buf[2] < 0x80) { + writes("runcpm: emulator.bin invalid\n"); + exit(1); + } + + basep = (unsigned char *)(((unsigned int)buf[2]) << 8); + + if (brk(basep + 0xC00)) { + writes("runcpm: insufficient memory\n"); + exit(1); + } + + memcpy(basep, buf, 4); + if (read(fd, basep + 4, 0x2FC) != 0x2FC) { + writes("runcpm: emulator.bin too short\n"); + exit(1); + } + close(fd); + + fd = open(argv[1], O_RDONLY); + if (fd == -1 || fstat(fd, &st) == -1) { + perror(argv[1]); + exit(1); + } + if (!S_ISREG(st.st_mode) || st.st_size < 256) { + writes(argv[1]); + writes(" does not appear to be a CP/M .COM file\n"); + exit(1); + } + exec = (void *)basep; + /* Make sure we pass the binary as fd 3 */ + if (fd != 3) { + dup2(fd, 3); + close(fd); + } + /* If this works it blows us away and we never return */ + (*exec)(argv); + writes("runcp: exec failure\n"); + exit(1); +} + + \ No newline at end of file