seppdroid/Digital-Research-Source-Code
1
0
Fork 0
mirror of https://github.com/SEPPDROID/Digital-Research-Source-Code.git synced 2025-10-26 09:54:20 +00:00
Code Issues Actions Packages Projects Releases Wiki Activity

Upload

Browse Source 
Digital Research
This commit is contained in:
Sepp J Morris
2020-11-06 18:50:37 +01:00
parent 621ed8ccaf
commit 31738079c4
8481 changed files with 1888323 additions and 0 deletions
Download Patch File Download Diff File Expand all files Collapse all files

BIN
CONTRIBUTIONS/z80em86/support/cls.com Normal file
View File

Binary file not shown.

21
CONTRIBUTIONS/z80em86/support/cls.mac Normal file
View File

@@ -0,0 +1,21 @@
;**************************************************************************
;* *
;* CLS v1.00 clears VDU screen S.J.Kay 26/04/95 *
;* *
;* Support utility for CP/M 3 *
;* *
;**************************************************************************
maclib TPORTS.LIB
;
.z80
aseg
;
org 0100h
.phase 0100h
;
out (crt1in),a ;initialize VDU driver
ret
;
.dephase
end

789
CONTRIBUTIONS/z80em86/support/cpmdpb.dat Normal file
View File

@@ -0,0 +1,789 @@
' CP/M Disk definiton file - S.J.Kay 25/04/95
'
' FILE LABELS
' ===========
' KEY: Label
' Search key, the search key will be converted to upper case
' characters and placed in the LIB file produced, only the first
' 16 characters are recognised.
'
' NME: Label
' Disk Name, describes the disk format, only the first 64
' characters are recognised
'
' DSK: Label
' 1st data: SS, DS, UD
' SS = single sided disk
' DS = double sided disk
' UD = double sided up/down
' 2nd data: SD, DD
' SD = single density
' DD = double density
' 3rd data: LO, HI
' LO = low capacity disk
' HI = high capacity disk
'
' FMT: Label
' 1st data: 1st physcial sector number of reserved tracks
' 2nd data: 1st physical sector number of dir/data tracks
'
' DPB: Label
' 1st data: Physical sector size
' 128, 256, 512, 1024, 2048, 4096
' 2nd data: Physical sectors/track
' each sector generates 1 skew entry (maximum = 128)
' 3rd data: Total number of cylinders
' i.e. if DS disk cylinders = tracks * 2
' 4th data: Block size
' 1024, 2048, 4096, 8192, 16384
' 5th data: Directory entries
' 6th data: Reserved cylinders
'
' SKW: Label
' If this label is used then the SKD: label must be omited.
' 1st data: Skew factor
' 2nd data: first physical sector for logical sector 0
' 3rd data: 1st physical sector number of dir/data tracks
'
' SKD: Label
' If the skew table can not be produced correctly using the
' SKW: label then the skew table is entered by hand, the number
' of entries must be equal to the DPB: label 2nd data entry.
' All skew lines must commence with the SKD: label.
KEY: TEST0
NME: Z80 Emulator 80T DS HD 1024 b/s
DSK: DS, DD, HI
FMT: 1, 1
DPB: 1024, 10, 160, 2048, 512, 1
SKW: 3, 1, 1
KEY: TEST1
NME: Knight 80 80T DS DD 790K
DSK: DS, DD, LO
FMT: 1, 1
DPB: 1024, 5, 160, 2048, 256, 2
SKW: 2, 1, 1
KEY: TEST2
NME: Knight 80 80T DS DD 790K
DSK: DS, DD, HI
FMT: 1, 1
DPB: 512, 18, 160, 2048, 256, 1
SKW: 2, 1, 1
KEY: Aardvark
NME: Aardvark 35T SS DD 164K
DSK: SS, DD, LO
FMT: 1, 1
DPB: 512, 10, 35, 2048, 64, 2
SKW: 2, 1, 1
KEY: AccessMatrix
NME: Access Matrix 40T SS DD 171K
DSK: SS, DD, LO
FMT: 1, 1
DPB: 512, 9, 40, 1024, 64, 2
SKW: 3, 1, 1
KEY: Actrix-SS
NME: Actrix 40T SS DD 171K
DSK: SS, DD, LO
FMT: 1, 1
DPB: 512, 9, 40, 1024, 64, 2
SKW: 3, 1, 1
KEY: Actrix-DS
NME: Actrix 40T DS DD 350K
DSK: DS, DD, LO
FMT: 1, 1
DPB: 512, 9, 80, 2048, 64, 1
SKW: 3, 1, 1
KEY: Adler-DS
NME: Adler DS DD 304K
DSK: DS, DD, LO
FMT: 1, 1
DPB: 256, 16, 80, 2048, 128, 4
SKW: 1, 1, 1
KEY: Adler-SS
NME: Adler Textriter Series III 40T SS DD 160K
DSK: SS, DD, LO
FMT: 1, 1
DPB: 256, 16, 40, 1024, 32, 0
SKW: 3, 1, 1
KEY: Altertext
NME: Altertext Diskreader 40T SS DD 144K
DSK: SS, DD, LO
FMT: 1, 1
DPB: 256, 18, 40, 1024, 128, 3
SKW: 6, 1, 1
KEY: Ampro-SS
NME: Ampro Little Board 40T SS DD 190K
DSK: SS, DD, LO
FMT: 1, 1
DPB: 512, 10, 40, 2048, 64, 2
SKW: 1, 1, 1
KEY: Ampro-DS
NME: Ampro Little Board 40T DS DD 390K ### skew data suspect ###
DSK: DS, DD, LO
FMT: 17, 17
DPB: 512, 10, 80, 2048, 128, 2
SKW: 1, 17, 17
KEY: Archive
NME: Archive 80T DS DD 784K
DSK: DS, DD, LO
FMT: 1, 1
DPB: 512, 10, 160, 2048, 256, 3
SKW: 2, 1, 1
KEY: Atari
NME: Atari-68000 CP/M Emulator 80T SS DD 346K
DSK: SS, DD, LO
FMT: 1, 1
DPB: 512, 9, 80, 2048, 128, 2
SKW: 1, 1, 1
KEY: ATR8000
NME: ATR-8000 40T SS DD 190K
DSK: SS, DD, LO
FMT: 1, 1
DPB: 512, 10, 40, 1024, 64, 2
SKW: 1, 1, 1
KEY: Compudata
NME: Compudata
DSK: DS, DD, LO
FMT: 1, 1
DPB: 512, 10, 80, 2048, 128, 2
SKW: 2, 1, 1
KEY: Cifer
NME: Cifer 2683 40T DS DD 384K
DSK: DS, DD, LO
FMT: 1, 1
DPB: 512, 10, 80, 2048, 128, 3
SKW: 2, 1, 1
KEY: Cromenco1
NME: Cromenco C10-P 40T DS DD 390K
DSK: DS, DD, LO
FMT: 1, 1
DPB: 512, 10, 80, 2048, 128, 2
SKW: 4, 1, 1
KEY: Cromenco2
NME: Cromenco CDOS 40T SS DD 190K
DSK: SS, DD, LO
FMT: 1, 1
DPB: 512, 10, 40, 1024, 64, 2
SKW: 4, 1, 1
KEY: Cromenco3
NME: Cromenco + IntlTerm 40T DS DD 390K
DSK: DS, DD, LO
FMT: 1, 1
DPB: 512, 10, 80, 2048, 128, 1
SKW: 3, 1, 1
KEY: Cromenco4
NME: Cromenco Z-2 40T SS SD 82K
DSK: SS, SD, LO
FMT: 1, 1
DPB: 128, 18, 40, 1024, 32, 3
SKW: 5, 1, 1
KEY: Cromenco5
NME: Cromenco Z-2 40T SS DD 190K
DSK: SS, DD, LO
FMT: 1, 1
DPB: 512, 10, 40, 1024, 32, 2
SKW: 4, 1, 1
KEY: Datavue
NME: Datavue 40T DS DD 380K
DSK: DS, DD, LO
FMT: 1, 1
DPB: 512, 10, 80, 4096, 128, 2
SKW: 1, 1, 1
KEY: DD1
NME: DD1 384K
DSK: DS, DD, LO
FMT: 1, 1
DPB: 512, 10, 80, 2048, 128, 3
SKW: 3, 1, 1
KEY: DD2
NME: DD2 380K
DSK: DS, DD, LO
FMT: 1, 1
DPB: 512, 10, 80, 2048, 128, 3
SKW: 3, 2, 1
KEY: DEC1
NME: DEC Rainbow 40T DS DD 486K
DSK: DS, DD, LO
FMT: 1, 1
DPB: 512, 10, 80, 2048, 128, 2
SKW: 2, 1, 1
KEY: DEC2
NME: DEC Rainbow 100+ 80T SS DD 390K
DSK: SS, DD, LO
FMT: 1, 1
DPB: 512, 10, 80, 2048, 128, 2
SKW: 2, 1, 1
KEY: DEC3
NME: DEC VT-180 40T SS DD 171K
DSK: SS, DD, LO
FMT: 1, 1
DPB: 512, 9, 40, 1024, 64, 2
SKW: 2, 1, 1
KEY: DGOS1
NME: DGOS SS DD 137K
DSK: SS, DD, HI
FMT: 1, 1
DPB: 128, 29, 77, 1024, 64, 2
SKW: 2, 1, 1
KEY: DGOS2
NME: DGOS DS DD 282K
DSK: DS, DD, HI
FMT: 1, 1
DPB: 128, 29, 154, 1024, 128, 2
SKW: 2, 1, 1
KEY: DGOS3
NME: DGOS 8" SS DD 468K
DSK: SS, DD, HI
FMT: 1, 1
DPB: 128, 50, 77, 2048, 128, 2
SKW: 2, 1, 1
KEY: DGOS4
NME: DGOS 8" DS DD 936K
DSK: DS, DD, HI
FMT: 1, 1
DPB: 128, 50, 154, 4096, 128, 2
SKW: 2, 1, 1
KEY: DigitalResearch
NME: Digital Research CP/M Standard
DSK: SS, SD, HI
FMT: 1, 1
DPB: 128, 26, 77, 1024, 64, 2
SKW: 6, 1, 1
KEY: Digitrio1
NME: Digitrio 40 SS DD 342K
DSK: SS, DD, LO
FMT: 1, 1
DPB: 256, 18, 40, 2048, 64, 4
SKW: 1, 1, 1
KEY: Digitrio2
NME: Digitrio 80T SS DD 350K
DSK: SS, DD, LO
FMT: 1, 1
DPB: 256, 18, 80, 2048, 64, 2
SKW: 1, 1, 1
KEY: Digitrio3
NME: Digitrio 80T DS DD 702K
DSK: DS, DD, LO
FMT: 1, 1
DPB: 256, 18, 160, 2048, 128, 4
SKW: 1, 1, 1
KEY: Digitrio4
NME: Digitrio 8" SS SD 243K
DSK: SS, SD, HI
FMT: 1, 1
DPB: 256, 13, 77, 1024, 64, 2
SKW: 1, 1, 1
KEY: Epson1
NME: Epson QX-10 40T DS DD 380K
DSK: DS, DD, LO
FMT: 1, 1
DPB: 512, 10, 80, 2048, 128, 4
SKW: 1, 1, 1
KEY: Epson2
NME: Epson QX-10 MF 40T DS DD 280K
DSK: DS, DD, LO
FMT: 1, 1
DPB: 256, 16, 80, 2048, 64, 8
SKW: 1, 1, 1
KEY: Excalibur
NME: Excalibur 80T DS DD 790K
DSK: DS, DD, LO
FMT: 1, 1
DPB: 512, 10, 160, 2048, 128, 2
SKW: 3, 1, 1
KEY: Hal
NME: Hal 116K
DSK: DS, DD, LO
FMT: 1, 1
DPB: 512, 8, 80, 2048, 64, 1
SKW: 1, 1, 1
KEY: Heath1
NME: Heath Zenith w Magnolia 40T SS DD 166K
DSK: SS, DD, LO
FMT: 1, 1
DPB: 512, 9, 40, 2048, 96, 3
SKW: 1, 1, 1
KEY: Heath2
NME: Heath Zenith 89 40T SS SD 94K
DSK: SS, SD, LO
FMT: 1, 1
DPB: 256, 10, 40, 1024, 64, 3
SKW: 1, 1, 1
KEY: Heath3
NME: Heath Zenith 89 40T SS DD 152K
DSK: SS, DD, LO
FMT: 1, 1
DPB: 256, 16, 40, 1024, 128, 2
SKW: 1, 1, 1
KEY: Heath4
NME: Heath Zenith 90 40T SS DD 152K
DSK: SS, DD, LO
FMT: 1, 1
DPB: 256, 16, 40, 1024, 128, 2
SKW: 1, 1, 1
KEY: Heath5
NME: Heath Zenith 89 40T DS DD 312K
DSK: DS, DD, LO
FMT: 1, 1
DPB: 256, 16, 80, 2048, 256, 2
SKW: 1, 1, 1
KEY: Heath6
NME: Heath Zenith 100 40T SS DD 152K
DSK: SS, DD, LO
FMT: 1, 1
DPB: 512, 8, 40, 1024, 128, 2
SKW: 1, 1, 1
KEY: Heath7
NME: Heath Zenith 100 40T DS DD 314K
DSK: DS, DD, LO
FMT: 1, 1
DPB: 512, 8, 80, 2048, 256, 2
SKW: 1, 1, 1
KEY: Heath8
NME: Heath Zenith 100 40T DS DD 310K
DSK: DS, DD, LO
FMT: 1, 1
DPB: 512, 10, 80, 2048, 256, 2
SKW: 1, 1, 1
KEY: HewlettPackard
NME: Hewlett-Packard HP-125 40T DS DD 252K
DSK: DS, DD, LO
FMT: 0, 0
DPB: 256, 16, 80, 1024, 128, 3
SKW: 1, 0, 0
KEY: Holmes
NME: Holmes Engineering VID80 TRS-80 40T SS DD 195K
DSK: SS, DD, LO
FMT: 0, 0
DPB: 512, 10, 40, 1024, 64, 1
SKW: 1, 0, 0
KEY: HP-120
NME: HP-120 40T DS DD 256K
DSK: DS, DD, LO
FMT: 1, 1
DPB: 256, 16, 80, 1024, 64, 3
SKW: 1, 1, 1
KEY: HP-125
NME: HP-125 35T DS DD 250K
DSK: DS, DD, LO
FMT: 1, 1
DPB: 256, 16, 70, 1024, 128, 3
SKW: 1, 1, 1
KEY: CP/M-86-SS
NME: IBM CP/M 86 40T SS DD 156K
DSK: SS, DD, LO
FMT: 1, 1
DPB: 512, 8, 40, 1024, 64, 1
SKW: 1, 1, 1
KEY: CP/M-86-DS
NME: IBM CP/M 86 40T DS DD 316K
DSK: DS, DD, LO
FMT: 1, 1
DPB: 512, 8, 80, 2048, 64, 1
SKW: 1, 1, 1
KEY: ICL
NME: ICL PC1 40T DS DD 251K
DSK: DS, DD, LO
FMT: 1, 1
DPB: 128, 15, 80, 1024, 64, 3
SKW: 4, 8, 1
' The skew here is very suspect (excluded from lib)
' 16 sectors/track and greatest last is 28 !
'
KEY: IMS
NME: IMS 5000 40T DS DD 304K
DSK: DS, DD, LO
FMT: 1, 1
DPB: 256, 16, 80, 2048, 64, 2
SKD: 1, 9, 17, 25, 2, 10, 18, 26, 3, 11
SKD: 19, 27, 4, 12, 20, 28
KEY: Kaypro
NME: Kaypro 2 40T SS DD 195K
DSK: SS, DD, LO
FMT: 0, 0
DPB: 512, 10, 40, 1024, 64, 1
SKW: 1, 0, 1
KEY: Knight80
NME: Knight 80 80T DS DD 790K
DSK: DS, DD, LO
FMT: 1, 1
DPB: 1024, 5, 160, 2048, 256, 2
SKW: 1, 1, 1
KEY: Knight80-A
NME: Knight 80 80T DS DD 790K
DSK: DS, DD, LO
FMT: 1, 1
DPB: 512, 10, 160, 2048, 128, 2
SKW: 1, 1, 1
KEY: LNW
NME: LNW Research LNW80 40T SS DD 166K
DSK: SS, DD, LO
FMT: 1, 1
DPB: 256, 18, 40, 2048, 64, 3
SKW: 5, 1, 1
KEY: Lobo1
NME: Lobo MAX-80 40T SS DD 166K
DSK: SS, DD, LO
FMT: 0, 0
DPB: 256, 18, 40, 1024, 64, 3
SKW: 1, 0, 0
KEY: Lobo2
NME: Lobo MAX-80 40T DS DD 346K
DSK: DS, DD, LO
FMT: 0, 0
DPB: 256, 18, 80, 2048, 128, 3
SKW: 1, 0, 0
KEY: Magic
NME: Magic 40T DS DD 390K
DSK: DS, DD, LO
FMT: 1, 1
DPB: 512, 10, 80, 2048, 1, 2
SKW: 1, 1, 1
KEY: Microbee-SS-SD
NME: Microbee 40T SS SD ??? -> 173K
DSK: SS, SD, LO
FMT: 1, 1
DPB: 128, 18, 40, 1024, 64, 3
SKW: 3, 1, 1
KEY: Microbee-SBC
NME: Microbee S.B.C 40T DS DD 390K
DSK: DS, DD, LO
FMT: 1, 1
DPB: 512, 10, 80, 2048, 128, 2
SKW: 3, 2, 1
KEY: Microbee-CIAB
NME: Microbee C.I.A.B 80T SS DD 390K
DSK: SS, DD, LO
FMT: 1, 1
DPB: 512, 10, 80, 2048, 128, 2
SKW: 3, 2, 1
KEY: Microbee-Modular
NME: Microbee Modular 80T DS DD 776K
DSK: DS, DD, LO
FMT: 1, 21
DPB: 512, 10, 160, 4096, 128, 4
SKW: 3, 22, 21
KEY: Microbee-Dreamdisk
NME: Microbee Dreamdisk 80T DS DD 782K
DSK: DS, DD, LO
FMT: 1, 1
DPB: 512, 10, 160, 2048, 256, 2
SKW: 3, 2, 1
KEY: Microbee-PJB
NME: Microbee P.J.B 80T DS DD 784K
DSK: DS, DD, LO
FMT: 1, 1
DPB: 512, 10, 160, 4096, 128, 2
SKW: 3, 2, 1
' The skew here for M/OS80 is suspect
' should sector 16 be followed by 3 instead of 2 ?
' replaced skew with macro for now.
' this was the default data
' SKD: 1, 4, 7, 10, 13, 16, 2, 5, 8, 11
' SKD: 14, 3, 6, 9, 12, 15
KEY: M/OS80
NME: M/OS 80 40T DS DD 252K
DSK: DS, DD, LO
FMT: 1, 1
DPB: 256, 16, 80, 2048, 64, 7
SKW: 3, 1, 1
KEY: NEC1
NME: NEC PC-8001A 40T SS DD 148K
DSK: SS, DD, LO
FMT: 1, 1
DPB: 256, 16, 40, 1024, 64, 2
SKW: 1, 1, 1
KEY: NEC2
NME: NEC PC-8801A 40T DS DD 304K
DSK: DS, DD, LO
FMT: 1, 1
DPB: 256, 16, 80, 2048, 128, 2
SKW: 1, 1, 1
KEY: Olivetti
NME: Olivetti ETV300 40T SS DD 171K
DSK: SS, DD, LO
FMT: 1, 1
DPB: 256, 18, 40, 1024, 64, 2
SKW: 2, 1, 1
KEY: Osborne
NME: Osborne 1 40T SS SD 92K
DSK: SS, SD, LO
FMT: 1, 1
DPB: 256, 10, 40, 2048, 64, 3
SKW: 2, 1, 1
KEY: OtronaAttache
NME: Otrona Attache 40T DS DD 364K
DSK: DS, DD, LO
FMT: 1, 1
DPB: 512, 10, 80, 2048, 128, 3
SKW: 1, 1, 1
KEY: PiedPiper
NME: Pied Piper 368K
DSK: DS, DD, LO
FMT: 1, 1
DPB: 512, 10, 80, 4096, 128, 6
SKW: 2, 1, 1
KEY: Sanyo
NME: Sanyo MBC 1000 40T DS DD 312K
DSK: DS, DD, LO
FMT: 1, 1
DPB: 256, 16, 80, 2048, 64, 2
SKW: 3, 1, 1
KEY: SME-SS
NME: SME 40T SS DD 119K
DSK: SS, DD, LO
FMT: 1, 1
DPB: 128, 29, 40, 1024, 128, 2
SKW: 3, 1, 1
KEY: SME-DS
NME: SME 40T DS DD 246K
DSK: DS, DD, LO
FMT: 1, 1
DPB: 128, 29, 80, 2048, 128, 2
SKW: 3, 1, 1
' The skew here for Sorcerer1 is suspect
' should sector 10 be followed by 3 instead of 1 ?
' replaced skew with macro for now.
' this was the default data
' SKD: 2, 4, 6, 8, 10, 1, 3, 5, 7, 9
KEY: Sorcerer1
NME: Sorcerer CData 40T SS DD 190K
DSK: SS, DD, LO
FMT: 1, 1
DPB: 512, 10, 40, 2048, 128, 2
SKW: 2, 2, 1
KEY: Sorcerer2
NME: Sorcerer Exidy 40T SS DD 152K
DSK: SS, DD, LO
FMT: 1, 1
DPB: 256, 16, 40, 2048, 128, 2
SKW: 5, 6, 1
KEY: Sorcerer3
NME: Sorcerer Digitrio 40T SS SD 85K
DSK: SS, SD, LO
FMT: 1, 1
DPB: 128, 18, 40, 1024, 64, 2
SKW: 1, 1, 1
KEY: Sorcerer4
NME: Sorcerer Digitrio 40T SS DD 171K
DSK: SS, DD, LO
FMT: 1, 1
DPB: 256, 18, 40, 1024, 64, 2
SKW: 1, 1, 1
KEY: Sorcerer5
NME: Sorcerer Digitrio 40T DS DD 350K
DSK: DS, DD, LO
FMT: 1, 1
DPB: 256, 18, 80, 2048, 64, 2
SKW: 1, 1, 1
KEY: TI
NME: TI Professional 40T SS DD 156K
DSK: SS, DD, LO
FMT: 1, 1
DPB: 512, 8, 40, 1024, 64, 1
SKW: 1, 1, 1
KEY: Televideo
NME: Televideo 802/803 40T DS DD 342K
DSK: DS, DD, LO
FMT: 1, 1
DPB: 256, 18, 80, 2048, 64, 4
SKW: 1, 1, 1
KEY: Toshiba1
NME: Toshiba T-100 35T DS DD 256K
DSK: DS, DD, LO
FMT: 1, 1
DPB: 256, 16, 70, 1024, 64, 3
SKW: 4, 1, 1
KEY: Toshiba2
NME: Toshiba T-100 40T DS DD 256K
DSK: DS, DD, LO
FMT: 1, 1
DPB: 256, 16, 80, 1024, 64, 6
SKW: 4, 1, 1
KEY: TRS801
NME: TRS80 Memory Merchant Shuffle Board 40T SS DD 190K
DSK: SS, DD, LO
FMT: 1, 1
DPB: 512, 10, 40, 2048, 128, 2
SKW: 1, 1, 1
KEY: TRS802
NME: TRS80 Model 1 Bruce Orr 40T SS DD 164K
DSK: SS, DD, LO
FMT: 1, 1
DPB: 256, 18, 40, 2048, 64, 3
SKW: 2, 1, 1
KEY: TRS803
NME: TRS80 Model 1 Bruce Orr 40T SS SD 90K
DSK: SS, SD, LO
FMT: 1, 1
DPB: 256, 10, 40, 2048, 64, 3
SKW: 2, 1, 1
KEY: TRS804
NME: TRS80 Model 3 Montezuma Micro 40T SS DD 170K
DSK: SS, DD, LO
FMT: 1, 1
DPB: 256, 18, 40, 2048, 128, 2
SKW: 1, 1, 1
KEY: TRS805
NME: TRS80 Model 4 Aero 40T SS DD 195K
DSK: SS, DD, LO
FMT: 1, 1
DPB: 256, 20, 40, 1024, 64, 1
SKW: 1, 1, 1
KEY: TRS806
NME: TRS80 Model 4 Montezuma Micro 40T SS DD 170K
DSK: SS, DD, LO
FMT: 1, 1
DPB: 256, 18, 40, 2048, 128, 2
SKW: 2, 1, 1
KEY: TRS807
NME: TRS80 Model 4 Radio Shack CP/M Plus 40T SS DD 156K
DSK: SS, DD, LO
FMT: 1, 1
DPB: 512, 8, 40, 1024, 64, 1
SKW: 1, 1, 1
KEY: TRS808
NME: TRS80 Model 1 & 3 Omikron Mapper I 40T SS SD 83K
DSK: SS, SD, LO
FMT: 1, 1
DPB: 128, 18, 40, 1024, 64, 3
SKW: 4, 1, 1
KEY: TRS809
NME: TRS80 Omikron Mapper II 40T SS DD 134K
DSK: SS, DD, LO
FMT: 1, 1
DPB: 128, 28, 40, 1024, 64, 2
SKW: 5, 1, 1
KEY: Xerox1
NME: Xerox 820-1 40T SS SD 82K
DSK: SS, SD, LO
FMT: 1, 1
DPB: 128, 18, 40, 1024, 32, 3
SKW: 5, 1, 1
KEY: Xerox2
NME: Xerox 820-2 40T SS DD 157K
DSK: SS, DD, LO
FMT: 1, 1
DPB: 256, 17, 40, 1024, 64, 3
SKW: 1, 1, 1
KEY: Zorba
NME: Zorba GC200 40T DS DD 390K
DSK: DS, DD, LO
FMT: 1, 1
DPB: 512, 10, 80, 2048, 64, 2
SKW: 1, 1, 1
KEY: Z80EMU-40
NME: S.J.Kay's CP/M 3.0 40T DS DD 512 b/s 9 s/t
DSK: DS, DD, LO
FMT: 1, 1
DPB: 512, 9, 80, 2048, 128, 2
SKW: 3, 1, 1
KEY: Z80EMU-DD
NME: S.J.Kay's CP/M 3.0 80T DS DD 512 b/s 9 s/t
DSK: DS, DD, LO
FMT: 1, 1
DPB: 512, 9, 160, 2048, 128, 2
SKW: 3, 1, 1

BIN
CONTRIBUTIONS/z80em86/support/cpmjob.com Normal file
View File

Binary file not shown.

305
CONTRIBUTIONS/z80em86/support/cpmjob.pas Normal file
View File

@@ -0,0 +1,305 @@
(*************************************************************************)
(* *)
(* CPMJOB v1.00 (c) Copyright 1992-2009, S.J.Kay *)
(* *)
(* Support utility for IBM Z80 Emulator CP/M 3 *)
(* *)
(*************************************************************************)
{ WARNING - Make sure the END address is lowered to say about $8000 }
{ before compiling to disk otherwise it will crash when used from }
{ within a SUBMIT file. This happens to any TURBO v2.00a compiled }
{ program because it does not check the TPA size !. }
{
ChangeLog
---------
20 February 2009, SJK
- In EmulatorParameter procedure remove any options passed to z80em86.
27 April 1995, SJK
- Undocumented changes.
}
{$C-} { turn off ^C and ^S checking }
type
registers = record
case boolean of
true : (AL, AH, BL, BH, CL, CH, DL, DH : byte);
false : (AX, BX, CX, DX,
BP, SI, DI, DS, ES, FLAGS : integer)
end;
String80 = string[80];
const
ENDBUF = $1FFF;
FLENME = 'CPMJOB.SUB';
var
R : registers;
ComLne : string[80] absolute $0080;
CpmPth : string[80];
DosPth : string[128];
DosSpc : array [0..79] of byte;
Buffer : array [0..ENDBUF] of char;
procedure ProcZ80 (Fn, Ax : byte; BCx, DEx, HLx : integer);
begin
inline
(
$3A/Fn/ { ld a,(Fn) }
$32/* + 17/ { ld (FNCNMB),a }
$3A/Ax/ { ld a,(Ax) }
$ED/$4B/BCx/ { ld bc,(BCx) }
$ED/$5B/DEx/ { ld de,(DEx) }
$2A/HLx/ { ld hl,(HLx) }
$D3/$FF { out (FNCNMB),a }
)
end;
function FuncZ80 (Fn, Ax : byte; BCx, DEx, HLx : integer) : byte;
const
BytVal : byte = 0;
begin
inline
(
$3A/Fn/ { ld a,(Fn) }
$32/* + 17/ { ld (FNCNMB),a }
$3A/Ax/ { ld a,(Ax) }
$ED/$4B/BCx/ { ld bc,(BCx) }
$ED/$5B/DEx/ { ld de,(DEx) }
$2A/HLx/ { ld hl,(HLx) }
$D3/$FF/ { out (FNCNMB),a }
$32/BytVal { ld (BYTVAL),a }
);
FuncZ80 := BytVal
end;
function GetByt (Seg, Off : integer) : byte;
begin
GetByt := FuncZ80($B0, 0, 0, Seg, Off)
end;
procedure Intr (Int : byte; var R : registers);
begin
ProcZ80($A1, Int, $AA55, $55AA, addr(R))
end;
procedure Msdos (var R : registers);
begin
Intr($21, R)
end;
function Seg (var Dummy) : integer;
const
SegAdr : integer = 0;
begin
ProcZ80($A0, 0, 0, 0, addr(SegAdr));
Seg := SegAdr
end;
function Ofs (var VarTyp) : integer;
begin
Ofs := addr(VarTyp)
end;
procedure ReportError (ErrStr : String80);
begin
ProcZ80($FB, 0, 0, 0, 0); { turn video on }
writeln('CPMJOB.COM Error, ', ErrStr)
end;
procedure WriteSubmitFile (FleSze : integer);
var
F : text;
i, Error : integer;
begin
assign(F, CpmPth);
{$I-}
rewrite(F); { open CP/M file for writing }
Error := ioresult;
if Error = 0 then
begin
i := 0;
if FleSze <> 0 then
begin
writeln(F, 'video on');
Error := ioresult
end;
while (i < FleSze) and (Error = 0) do
begin
write(F, Buffer[i]);
Error := ioresult;
i := i + 1
end;
if FleSze <> 0 then
begin
writeln(F, 'exit');
Error := ioresult
end;
if Error = 0 then
begin
close(F); { close CP/M file }
Error := ioresult;
if Error <> 0 then
ReportError('Could not close destination file')
end
else
ReportError('Destination disk full error')
end
else
ReportError('Could not create destination file')
{$I-}
end;
procedure MakeSubmitFile;
begin
if DosPth <> '' then
begin
DosPth := DosPth + ^M^J;
move(DosPth[1], Buffer, length(DosPth))
end;
WriteSubmitFile(length(DosPth))
end;
procedure CopySubmitFile;
var
FleHnd, FleSze, Error : integer;
begin
move(DosPth[1], DosSpc[0], length(DosPth));
DosSpc[length(DosPth)] := 0;
R.AH := $3D; { open file function }
R.AL := $00; { read access }
R.DS := seg(DosSpc);
R.DX := ofs(DosSpc);
Msdos(R); { open DOS file for reading }
FleHnd := R.AX; { file handle }
Error := R.Flags and 1;
if Error = 0 then
begin
R.AH := $3F; { read file or device function }
R.BX := FleHnd; { file handle }
R.CX := ENDBUF+1; { bytes to read }
R.DS := seg(Buffer);
R.DX := ofs(Buffer);
Msdos(R); { read data from DOS file }
FleSze := R.AX; { number of bytes read from file }
if R.AX > ENDBUF then
Error := 2
else
Error := (R.Flags and 1) * 3
end;
if Error = 0 then
begin
R.AH := $3E; { close file function }
R.BX := FleHnd; { file handle }
Msdos(R); { close DOS file }
Error := (R.Flags and 1) * 4
end;
if Error <> 0 then
begin
case Error of
1 : ReportError('Could not open source submit file');
2 : ReportError('Source submit file is too big');
3 : ReportError('Reading source submit file');
4 : ReportError('Could not close source submit file')
end;
DosPth := 'exit';
MakeSubmitFile
end
else
WriteSubmitFile(FleSze)
end;
procedure EmulatorParameter;
const
SegOff : array [0..1] of integer = (0, 0);
var
CpyPth : string[80];
Seg : integer;
Off : integer;
i : integer;
options : boolean;
begin
CpyPth := '';
ProcZ80($F9, 0, 0, 0, addr(SegOff)); { seg:off of parameter }
Seg := SegOff[0];
Off := SegOff[1];
for i := 1 to GetByt(Seg, Off) do
DosPth := DosPth + chr(GetByt(Seg, Off + i));
repeat
while pos(' ', DosPth) = 1 do { delete leading spaces }
delete(DosPth, 1, 1);
options := pos('-', DosPth) = 1; { any emulator options specified ? }
if options then { deleted any leading option }
begin
delete(DosPth, 1, 1);
while (DosPth <> '') and (DosPth[1] <> ' ') do
delete(DosPth, 1, 1);
end
until not options;
while pos(' ', DosPth) = length(DosPth) do
DosPth[0] := chr(length(DosPth) - 1);
for i := 1 to length(DosPth) do
CpyPth := CpyPth + upcase(DosPth[i]);
if pos(' ', CpyPth) = 0 then { possibly a SUB file }
begin
i := pos('.SUB', CpyPth);
if (i > 0) and (i = (length(CpyPth) - 3)) then
CopySubmitFile
else
MakeSubmitFile
end
else
MakeSubmitFile
end;
function CpmParameter : boolean;
var
GotPrm : boolean;
begin
while pos(' ', CpmPth) = 1 do
delete(CpmPth, 1, 1);
GotPrm := (CpmPth <> '') and (length(CpmPth) <= 2);
if GotPrm then
begin
if length(CpmPth) = 2 then
GotPrm := CpmPth[2] = ':'
else
CpmPth := CpmPth + ':'
end;
CpmPth := CpmPth + FLENME;
CpmParameter := GotPrm
end;
begin
CpmPth := ComLne;
DosPth := '';
if CpmParameter then
begin
if FuncZ80($F8, 0, 0, 0, 0) <> 0 then { parameter to Z80.EXE ? }
EmulatorParameter
else
MakeSubmitFile
end
else
ReportError('CP/M path error')
end.

BIN
CONTRIBUTIONS/z80em86/support/cpmtodos.com Normal file
View File

Binary file not shown.

556
CONTRIBUTIONS/z80em86/support/cpmtodos.pas Normal file
View File

@@ -0,0 +1,556 @@
(*************************************************************************)
(* *)
(* CPM-TO-DOS v1.00 (c) Copyright S.J.Kay 18th April 1995 *)
(* *)
(* Copys CP/M files to DOS *)
(* *)
(*************************************************************************)
{ WARNING - Make sure the END address is lowered to say about $8000 }
{ before compiling to disk otherwise it will crash when used from }
{ within a SUBMIT file. This happens to any TURBO v2.00a compiled }
{ program because it does not check the TPA size !. }
{ As TURBO v2.00a compiled programs overwrite part of the command }
{ line parameters (only 1st 31 characters are intact) make sure that }
{ FIXTURBO.COM is run on this compiled program to allow full access }
{ to command line parameters. }
{$C-} { turn off ^C and ^S checking }
const
ComLne : string[127] = 'PARAMETERS'; { filled in by patch code }
ENDBUF = $3FFF; { 16 K copy buffer }
ENDDIR = $1F; { 32 filename directory buffer }
TMPFLE = 'CPMTODOS.$$$';
type
String12 = string[12];
String127 = string[127];
registers = record
case boolean of
true : (AL, AH, BL, BH, CL, CH, DL, DH : byte);
false : (AX, BX, CX, DX,
BP, SI, DI, DS, ES, FLAGS : integer)
end;
var
R : registers;
F : file;
Buffer : array [0..ENDBUF] of byte;
DirBuf : array [0..ENDDIR] of String12;
DMA : array [0..3, 0..31] of char;
FCB : array [0..35] of byte;
CPMdrv : byte;
DirMsk : String127;
DOSPth : String127;
CPMPth : String127;
Quiet : boolean;
ChkWrt : boolean;
OvrWrt : boolean;
Error : integer;
procedure ProcZ80 (Fn, Ax : byte; BCx, DEx, HLx : integer);
begin
inline
(
$3A/Fn/ { ld a,(Fn) }
$32/* + 17/ { ld (FNCNMB),a }
$3A/Ax/ { ld a,(Ax) }
$ED/$4B/BCx/ { ld bc,(BCx) }
$ED/$5B/DEx/ { ld de,(DEx) }
$2A/HLx/ { ld hl,(HLx) }
$D3/$FF { out (FNCNMB),a }
)
end;
procedure Intr (Int : byte; var R : registers);
begin
ProcZ80($A1, Int, $AA55, $55AA, addr(R))
end;
procedure Msdos (var R : registers);
begin
Intr($21, R)
end;
function Seg (var Dummy) : integer;
const
SegAdr : integer = 0;
begin
ProcZ80($A0, 0, 0, 0, addr(SegAdr));
Seg := SegAdr
end;
function Ofs (var VarTyp) : integer;
begin
Ofs := addr(VarTyp)
end;
type
DOSFle = record
Path : array [0..127] of byte;
Handle : integer
end;
var
ioresultDOS : integer;
D : DOSFle;
procedure AssignDOS (var F : DOSFle; Name : String127);
begin
move(Name[1], F.Path, length(Name));
F.Path[length(Name)] := 0
end;
procedure ResetDOS (var F : DOSFle);
begin
R.AH := $3D; { open file handle function }
R.AL := $02; { read/write access }
R.DS := seg(F.Path);
R.DX := ofs(F.Path);
Msdos(R); { open DOS file }
if odd(R.FLAGS) then
ioresultDOS := R.AX
else
begin
ioresultDOS := 0;
F.Handle := R.AX { file handle }
end
end;
procedure RewriteDOS (var F : DOSFle);
begin
R.AH := $3C; { create file function }
R.CX := $00; { file attribute (normal) }
R.DS := seg(F.Path);
R.DX := ofs(F.Path);
Msdos(R); { create DOS file }
if odd(R.FLAGS) then
ioresultDOS := R.AX
else
begin
ioresultDOS := 0;
F.Handle := R.AX { file handle }
end
end;
procedure CloseDOS (var F : DOSFle);
begin
R.AH := $3E; { close file handle function }
R.BX := F.Handle; { file handle }
Msdos(R); { close DOS file }
if odd(R.FLAGS) then
ioresultDOS := R.AX
else
ioresultDOS := 0
end;
procedure EraseDOS (var F : DOSFle);
begin
R.AH := $41; { delete file function }
R.DS := seg(F.Path);
R.DX := ofs(F.Path);
Msdos(R); { delete DOS file }
if odd(R.FLAGS) then
ioresultDOS := R.AX
else
ioresultDOS := 0
end;
procedure RenameDOS (var F : DOSFle; Name : String127);
var
X : DOSFle;
begin
move(Name[1], X.Path, length(Name));
X.Path[length(Name)] := 0;
R.AH := $56; { rename file function }
R.DS := seg(F.Path);
R.DX := ofs(F.Path);
R.ES := seg(X.Path);
R.DI := ofs(X.Path);
Msdos(R); { rename DOS file }
if odd(R.FLAGS) then
ioresultDOS := R.AX
else
ioresultDOS := 0
end;
procedure BlockWriteDOS (var F : DOSFle; var Source; RecCnt : integer);
begin
R.AH := $40; { write to file or device function }
R.BX := F.Handle; { file handle }
R.CX := 128 * RecCnt;
R.DS := seg(Source);
R.DX := ofs(Source);
Msdos(R); { open DOS file }
if odd(R.FLAGS) then
ioresultDOS := $FF
else
ioresultDOS := 0
end;
procedure SetupFCB;
var
PosGet, PosPut : integer;
begin
PosGet := 1;
PosPut := 1;
fillchar(FCB, sizeof(FCB), 0);
fillchar(FCB[1], 11, ' ');
FCB[0] := CPMdrv;
repeat
while (PosGet <= length(DirMsk)) and
(DirMsk[PosGet] <> '.') and (PosPut < 12) do
begin
if DirMsk[PosGet] = '*' then
repeat
FCB[PosPut] := ord('?');
PosPut := PosPut + 1
until PosPut in [9, 12]
else
begin
FCB[PosPut] := ord(upcase(DirMsk[PosGet]));
PosPut := PosPut + 1
end;
PosGet := PosGet + 1
end;
if DirMsk[PosGet] = '.' then
begin
PosGet := PosGet + 1;
PosPut := 9
end
until (PosGet > length(DirMsk)) or (PosPut = 12)
end;
procedure LoadDirectoryBuffer (var DirTot : integer);
var
DirPos, x, i : integer;
SchDir : byte;
FleNme : String12;
begin
bdos(26, addr(DMA));
i := DirTot;
SchDir := 17; { search for first function }
while i <> 0 do { move to correct directory position }
begin
bdos(SchDir, addr(FCB)); { search directory }
i := i - 1;
SchDir := 18
end;
DirPos := 0;
repeat
x := bdos(SchDir, addr(FCB));
if x <> $FF then
begin
FleNme := '';
for i := 1 to 11 do
begin
if DMA[x, i] <> ' ' then
FleNme := FleNme + DMA[x, i];
if i = 8 then
FleNme := FleNme + '.'
end;
DirBuf[DirPos] := FleNme;
DirPos := DirPos + 1;
DirTot := DirTot + 1
end;
SchDir := 18 { search for next function }
until (x = $FF) or (DirPos > ENDDIR)
end;
function FileFound (FstDir : boolean; var FleNme : String12) : boolean;
const
DirTot : integer = 0;
DirNmb : integer = 0;
GetPos : integer = 0;
begin
if FstDir then
begin
DirNmb := 0;
DirTot := 0;
SetupFCB;
end;
if DirNmb = DirTot then
begin
LoadDirectoryBuffer(DirTot);
GetPos := 0
end;
FileFound := DirNmb < DirTot;
if DirNmb < DirTot then
begin
FleNme := DirBuf[GetPos];
GetPos := GetPos + 1;
DirNmb := DirNmb + 1
end;
if DirTot = 0 then
writeln('No files found to match: ', CPMPth, DirMsk)
end;
procedure OpenFiles (FleNme : String12);
var
TmpStr : String127;
UsrRes : string[1];
Result : integer;
begin
if not Quiet then
writeln('Copying: ', FleNme);
{$I-}
assign(F, CPMPth + FleNme);
reset(F);
Error := ioresult;
{$I+}
if Error = 0 then
begin
OvrWrt := true;
if ChkWrt then
begin
AssignDOS(D, DOSPth + FleNme);
ResetDOS(D); { does file exist ? }
if ioresultDOS = 0 then
begin
CloseDOS(D);
Result := ioresultDOS;
write('Overwrite ', DOSPth, FleNme, ' ? (y/n): ');
readln(UsrRes);
OvrWrt := (UsrRes = 'y') or (UsrRes = 'Y')
end
end;
if OvrWrt then
begin
AssignDOS(D, DOSPth + TMPFLE);
RewriteDOS(D); { open temporary DOS file for writing }
Error := ioresultDOS;
if Error <> 0 then
writeln('Error can not create DOS file')
end
end
else
writeln('Error opening CP/M file for reading')
end;
procedure CloseFiles (FleNme : String12);
var
Result : integer;
begin
{$I-}
close(F); { close CP/M file }
Error := ioresult;
{$I+}
if Error <> 0 then
writeln('Error closing CP/M source file');
if OvrWrt and (Error = 0) then
begin
CloseDOS(D); { close temporary DOS file }
Error := ioresultDOS;
if Error = 0 then
begin
AssignDOS(D, DOSPth + FleNme);
EraseDOS(D);
Result := ioresultDOS;
AssignDOS(D, DOSPth + TMPFLE);
RenameDOS(D, DOSPth + FleNme);
Error := ioresultDOS;
if Error <> 0 then
writeln('Error renaming temporary DOS file')
end
else
writeln('Error closing temporary DOS file')
end
end;
procedure CopyFile (FleNme : String12);
var
BufPos : integer;
begin
repeat
BufPos := 0;
{$I-}
while (not eof(F)) and (BufPos < ENDBUF) and (Error = 0) do
begin
blockread(F, Buffer[BufPos], 1); { read data from CP/M file }
Error := ioresult;
BufPos := BufPos + 128
end;
{$I+}
if Error = 0 then
begin
BlockwriteDOS(D, Buffer, BufPos div 128); { write to DOS file }
Error := ioresultDOS;
if Error <> 0 then
writeln('Error DOS disk full')
end
else
writeln('Error reading CP/M file')
until eof(F) or (Error <> 0)
end;
procedure TransferFiles;
var
FstDir, Found : boolean;
FleNme : String12;
begin
if pos(':', DirMsk) = 2 then
begin
CPMPth := DirMsk;
CPMPth[0] := #2;
CPMdrv := (ord(DirMsk[1]) - ord('A')) + 1;
delete(DirMsk, 1, 2)
end
else
begin
CPMPth := '';
CPMdrv := 0 { default CP/M drive }
end;
if not (DOSPth[length(DOSPth)] in [':', '\']) then
DOSPth := DOSPth + '\';
FstDir := true;
while FileFound(FstDir, FleNme) and (Error = 0) do
begin
FstDir := false;
OpenFiles(FleNme);
if OvrWrt and (Error = 0) then
CopyFile(FleNme);
if Error = 0 then
CloseFiles(FleNme)
end
end;
function ParmCount : integer;
var
i, PrmCnt, PrmLen : integer;
begin
i := 1;
PrmCnt := 0;
PrmLen := length(ComLne);
while i <= PrmLen do
begin
while (i <= PrmLen) and (ComLne[i] = ' ') do
i := i + 1;
if i <= PrmLen then
PrmCnt := PrmCnt + 1;
if ComLne[i] = '/' then
i := i + 1;
while (i <= PrmLen) and (not(ComLne[i] in [' ', '/'])) do
i := i + 1
end;
ParmCount := PrmCnt
end;
function ParamStr (PrmNmb : integer) : String127;
var
i, PrmCnt, PrmLen : integer;
PrmStr : string[127];
begin
i := 1;
PrmCnt := 0;
PrmStr := '';
PrmLen := length(ComLne);
while (i <= PrmLen) and (PrmCnt < PrmNmb) do
begin
while (i <= PrmLen) AND (ComLne[i] = ' ') do
i := i + 1;
if i <= PrmLen then
PrmCnt := PrmCnt + 1;
if ComLne[i] = '/' then
begin
PrmStr := '/';
i := i + 1
end
else
PrmStr := '';
while (i <= PrmLen) and (not (ComLne[i] in [' ', '/'])) do
begin
PrmStr := PrmStr + ComLne[i];
i := i + 1
end
end;
ParamStr := PrmStr
end;
function ScanForSwitches (PrmNmb : integer) : integer;
var
SwtStr : String127;
SwtPos, i : integer;
begin
repeat
SwtStr := ParamStr(PrmNmb);
SwtPos := pos('/', SwtStr);
if Swtpos <> 0 then
begin
PrmNmb := PrmNmb - 1;
delete(SwtStr, 1, 1);
for i := 1 to length(SwtStr) do
SwtStr[i] := upcase(SwtStr[i]);
if SwtStr = 'Q' then
Quiet := true;
if SwtStr = 'F' then
ChkWrt := false
end
until SwtPos = 0;
ScanForSwitches := PrmNmb
end;
procedure ShowUsage;
begin
writeln;
writeln('CPM-TO-DOS v1.00 (c) Copyright S.J.Kay 18th April 1995');
writeln;
writeln('Use:- cpmtodos (c:files) (c:files)... d:\path [/f/q]');
writeln;
writeln('c:files = CP/M drive and files');
writeln('d:\path = DOS destination drive and path');
writeln(' /f = force overwriting of existing file(s)');
writeln(' /q = quiet, no display of file names')
end;
var
PrmTot, PrmNmb : integer;
SwtStr : String127;
begin
Quiet := false;
ChkWrt := true;
Error := 0;
PrmNmb := 1;
PrmTot := ScanForSwitches(ParmCount);
DOSPth := ParamStr(PrmTot);
if PrmTot > 1 then
begin
repeat
DirMsk := ParamStr(PrmNmb);
PrmNmb := PrmNmb + 1;
TransferFiles
until (PrmNmb >= PrmTot) or (Error <> 0)
end
else
ShowUsage
end.

BIN
CONTRIBUTIONS/z80em86/support/dosdir.com Normal file
View File

Binary file not shown.

310
CONTRIBUTIONS/z80em86/support/dosdir.pas Normal file
View File

@@ -0,0 +1,310 @@
(*************************************************************************)
(* *)
(* DOSDIR v1.00 (c) Copyright S.J.Kay 24th April 1995 *)
(* *)
(* Displays a directory of DOS disks *)
(* *)
(*************************************************************************)
{ WARNING - Make sure the END address is lowered to say about $5000 }
{ before compiling to disk otherwise it will crash when used from }
{ within a SUBMIT file. This happens to any TURBO v2.00a compiled }
{ program because it does not check the TPA size !. }
{ As TURBO v2.00a compiled programs overwrite part of the command }
{ line parameters (only 1st 31 characters are intact) make sure that }
{ FIXTURBO.COM is run on this compiled program to allow full access }
{ to command line parameters. }
{$C-} { turn off ^C and ^S checking }
const
ComLne : string[127] = 'PARAMETERS'; { filled in by patch code }
type
registers = record
case boolean of
true : (AL, AH, BL, BH, CL, CH, DL, DH : byte);
false : (AX, BX, CX, DX,
BP, SI, DI, DS, ES, FLAGS : integer)
end;
String14 = string[14];
String127 = string[127];
var
R : registers;
DTA : array [0..42] of byte; { Data Transfer Area Buffer }
DirSpc : array [0..126] of byte;
DirPrm : String127;
DirPth : String127;
DirMsk : String127;
DirDrv : byte;
DirChr : char;
Error : integer;
procedure ProcZ80 (Fn, Ax : byte; BCx, DEx, HLx : integer);
begin
inline
(
$3A/Fn/ { LD A,(Fn) }
$32/* + 17/ { LD (FNCNMB),A }
$3A/Ax/ { LD A,(Ax) }
$ED/$4B/BCx/ { LD BC,(BCx) }
$ED/$5B/DEx/ { LD DE,(DEx) }
$2A/HLx/ { LD HL,(HLx) }
$D3/$FF { OUT (FNCNMB),A }
)
end;
procedure Intr (Int : byte; var R : registers);
begin
ProcZ80($A1, Int, $AA55, $55AA, addr(R))
end;
procedure Msdos (var R : registers);
begin
Intr($21, R)
end;
function Seg (var Dummy) : integer;
const
SegAdr : integer = 0;
begin
ProcZ80($A0, 0, 0, 0, addr(SegAdr));
Seg := SegAdr
end;
function Ofs (var VarTyp) : integer;
begin
Ofs := addr(VarTyp)
end;
procedure TestExtendedError;
begin
if odd(R.FLAGS) then
begin
R.AH := $59;
R.BX := $00;
Msdos(R);
if (R.AL <> 0) and (R.AL <> 18) then
begin
Error := R.AL;
writeln;
case Error of
3 : writeln('Path not found');
15 : writeln('Invalid drive specification');
83 : writeln('Failed on DOS int 24H (critical error)')
else
writeln('Error occurred, code: ', Error, ' (dec)')
end
end
end
end;
function EntryFound (FstDir : boolean; AtrTyp : byte) : boolean;
begin
if FstDir then
R.AH := $4E { search for first function }
else
R.AH := $4F; { search for next function }
R.CX := AtrTyp; { attribute type }
R.DS := seg(DirSpc);
R.DX := ofs(DirSpc);
Msdos(R);
EntryFound := not odd(R.Flags);
TestExtendedError
end;
procedure ExtractName (var FleNme : String14);
var
SubTyp, VolTyp : boolean;
i : integer;
begin
SubTyp := (DTA[$15] and $10) <> 0;
VolTyp := (DTA[$15] and $08) <> 0;
i := 0;
if not SubTyp then
FleNme := ''
else
FleNme := '[';
while (i < 12) and (DTA[$1E+i] <> 0) do
begin
if (chr(DTA[$1E+i]) = '.') and VolTyp then
i := i + 1
else
begin
FleNme := FleNme + chr(DTA[$1E+i]);
i := i + 1
end
end;
if SubTyp then
FleNme := FleNme + ']'
end;
procedure VolumeLabel;
var
FleNme : String14;
TmpStr : String127;
begin
writeln;
TmpStr := DirChr + ':\*.*'; { look in the root directory }
move(TmpStr[1], DirSpc, length(TmpStr));
DirSpc[length(TmpStr)] := 0;
if (EntryFound(true, $08)) and (Error = 0) then
begin
ExtractName(FleNme);
writeln(' Volume in drive ', DirChr, ' is ', FleNme);
writeln
end
else
if Error = 0 then
begin
writeln(' Volume in drive ', DirChr, ' has no label ');
writeln
end
end;
procedure CheckFileOrSubdir;
begin
if (pos('*', DirMsk) = 0) and (pos('?', DirMsk) = 0) then
begin
move(DirPrm[1], DirSpc, length(DirPrm));
DirSpc[length(DirPrm)] := 0;
if EntryFound(true, $10) and (Error = 0) then
begin
if (DTA[$15] and $10) <> 0 then
DirPrm := DirPrm + '\*.*'
end
end
end;
procedure DiskDetails (FleCnt : integer);
var
Free : real;
FreStr : string[20];
i, x : integer;
begin
R.AH := $36; { get disk free space }
R.DL := DirDrv; { drive number A=1, B=2, etc }
Msdos(R); { get disk info }
Free := (R.AX * 1.0) * (R.CX * 1.0) * (R.BX * 1.0);
str(Free:11:0, FreStr);
i := length(FreStr);
x := 0;
while (i > 0) and (FreStr[i] <> ' ') do
begin
x := x + 1;
if ((x mod 3) = 0) and (FreStr[i-1] <> ' ') then
insert(',', FreStr, i);
i := i - 1
end;
writeln;
writeln(FleCnt:9, ' file(s)', '':15-length(FreStr),
FreStr, ' bytes free')
end;
procedure DosDir;
var
FstDir : boolean;
FleCnt : integer;
FleNme : String14;
begin
VolumeLabel;
if Error = 0 then
CheckFileOrSubdir;
if Error = 0 then
begin
move(DirPrm[1], DirSpc, length(DirPrm));
DirSpc[length(DirPrm)] := 0;
writeln(' Directory of ', DirPrm);
writeln;
FleCnt := 0;
FstDir := true;
while EntryFound(FstDir, $10) and (Error = 0) do
begin
FstDir := false;
FleCnt := FleCnt + 1;
ExtractName(FleNme);
write(FleNme, '':16-length(FleNme))
end
end;
if Error = 0 then
begin
if (FleCnt mod 5) <> 0 then
writeln;
if FstDir then
writeln(' No files found');
DiskDetails(FleCnt)
end
end;
var
i : integer;
begin
Error := 0;
DirPrm := ComLne;
while pos(' ', DirPrm) = 1 DO
delete(DirPrm, 1, 1);
DirMsk := DirPrm;
DirPth := DirPrm;
i := length(DirPth);
while (i > 0) and (not (DirPth[i] in [':', '\'])) do
i := i - 1;
DirPth[0] := chr(i);
delete(DirMsk, 1, i);
if pos(':', DirPth) = 2 then
DirDrv := ord(upcase(DirPth[1])) - 64
else
begin
R.AH := $19; { get current drive number }
Msdos(R); { get default drive }
DirDrv := R.AL + 1;
DirPth := chr(DirDrv + 64) + ':' + DirPth
end;
if pos('\', DirPth) = 0 then
begin
R.AH := $47;
R.DL := DirDrv;
R.DS := seg(DirPth[3]);
R.SI := ofs(DirPth[3]);
Msdos(R);
TestExtendedError;
if Error = 0 then
begin
i := 1;
while DirPth[i] <> #0 do
i := i + 1;
DirPth[0] := chr(i-1);
if pos('\', DirPth) <> 3 then
insert('\', DirPth, 3)
end
end;
if Error = 0 then
begin
DirChr := chr(DirDrv + 64);
if DirPth[length(DirPth)] <> '\' then
DirPth := DirPth + '\';
if DirMsk = '' then
DirMsk := '*.*';
DirPrm := DirPth + DirMsk;
R.AX := $1A00; { function used to set the DTA }
R.DS := seg(DTA); { store the parameter segment in DS }
R.DX := ofs(DTA); { " " " offset in DX }
Msdos(R); { set DTA location }
DosDir
end
end.

BIN
CONTRIBUTIONS/z80em86/support/dostocpm.com Normal file
View File

Binary file not shown.

379
CONTRIBUTIONS/z80em86/support/dostocpm.pas Normal file
View File

@@ -0,0 +1,379 @@
(*************************************************************************)
(* *)
(* DOS-TO-CPM v1.00 (c) Copyright S.J.Kay 18th April 1995 *)
(* *)
(* Copys DOS files to CP/M *)
(* *)
(*************************************************************************)
{ WARNING - Make sure the END address is lowered to say about $8000 }
{ before compiling to disk otherwise it will crash when used from }
{ within a SUBMIT file. This happens to any TURBO v2.00a compiled }
{ program because it does not check the TPA size !. }
{ As TURBO v2.00a compiled programs overwrite part of the command }
{ line parameters (only 1st 31 characters are intact) make sure that }
{ FIXTURBO.COM is run on this compiled program to allow full access }
{ to command line parameters. }
{$C-} { turn off ^C and ^S checking }
const
ComLne : string[127] = 'PARAMETERS'; { filled in by patch code }
ENDBUF = $3FFF; { 16 K copy buffer }
TMPFLE = 'DOSTOCPM.$$$';
type
String13 = string[13];
String127 = string[127];
registers = record
case boolean of
true : (AL, AH, BL, BH, CL, CH, DL, DH : byte);
false : (AX, BX, CX, DX,
BP, SI, DI, DS, ES, FLAGS : integer)
end;
var
R : registers;
F : file;
Buffer : array [0..ENDBUF] of byte;
DTA : array [0..42] of byte;
DirSpc : array [0..79] of byte;
FleSpc : array [0..79] of byte;
DirMsk : String127;
DOSPth : String127;
CPMPth : String127;
Quiet : boolean;
ChkWrt : boolean;
OvrWrt : boolean;
FleHnd : integer;
Error : integer;
procedure ProcZ80 (Fn, Ax : byte; BCx, DEx, HLx : integer);
begin
inline
(
$3A/Fn/ { ld a,(Fn) }
$32/* + 17/ { ld (FNCNMB),a }
$3A/Ax/ { ld a,(Ax) }
$ED/$4B/BCx/ { ld bc,(BCx) }
$ED/$5B/DEx/ { ld de,(DEx) }
$2A/HLx/ { ld hl,(HLx) }
$D3/$FF { out (FNCNMB),a }
)
end;
procedure Intr (Int : byte; var R : registers);
begin
ProcZ80($A1, Int, $AA55, $55AA, addr(R))
end;
procedure Msdos (var R : registers);
begin
Intr($21, R)
end;
function Seg (var Dummy) : integer;
const
SegAdr : integer = 0;
begin
ProcZ80($A0, 0, 0, 0, addr(SegAdr));
Seg := SegAdr
end;
function Ofs (var VarTyp) : integer;
begin
Ofs := addr(VarTyp)
end;
function FileFound (FstDir : boolean) : boolean;
begin
R.AH := $1A; { set DTA function }
R.DS := seg(DTA);
R.DX := ofs(DTA);
Msdos(R);
if FstDir then
R.AH := $4E { search for first function }
else
R.AH := $4F; { search for next function }
R.CX := 0;
R.DS := seg(DirSpc);
R.DX := ofs(DirSpc);
Msdos(R);
FileFound := not odd(R.Flags);
if FstDir and odd(R.Flags) then
writeln('No files found to match: ', DirMsk)
end;
procedure OpenFiles (FleNme : String13);
var
TmpStr : String127;
UsrRes : string[1];
Result : integer;
begin
if not Quiet then
writeln('Copying: ', FleNme);
TmpStr := DOSPth + FleNme;
move(TmpStr[1], FleSpc, length(TmpStr));
FleSpc[length(TmpStr)] := 0;
R.AH := $3D; { open file function }
R.AL := $00; { read access }
R.DS := seg(FleSpc);
R.DX := ofs(FleSpc);
Msdos(R); { open DOS file for reading }
Error := R.Flags and 1;
if Error = 0 then
begin
FleHnd := R.AX; { file handle }
OvrWrt := true;
{$I-}
if ChkWrt then
begin
assign(F, CPMPth + FleNme);
reset(F); { does file exist ? }
if ioresult = 0 then
begin
close(F);
Result := ioresult;
write('Overwrite ', CPMPth, FleNme, ' ? (y/n): ');
readln(UsrRes);
OvrWrt := (UsrRes = 'y') or (UsrRes = 'Y')
end
end;
if OvrWrt then
begin
assign(F, CPMPth + TMPFLE);
rewrite(F); { open temporary CP/M file for writing }
Error := ioresult;
if Error <> 0 then
writeln('Error CP/M disk directory full')
end
{$I+}
end
else
writeln('Error opening DOS file for reading')
end;
procedure CloseFiles (FleNme : String13);
var
Result : integer;
begin
R.AH := $3E; { close file function }
R.BX := FleHnd; { file handle }
Msdos(R); { close DOS file }
Error := R.Flags and 1;
if Error <> 0 then
writeln('Error closing DOS source file');
if OvrWrt and (Error = 0) then
begin
{$I-}
close(F); { close temporary CP/M file }
Error := ioresult;
if Error = 0 then
begin
assign(F, CPMPth + FleNme);
erase(F);
Result := ioresult;
assign(F, CPMPth + TMPFLE);
rename(F, CPMPth + FleNme);
Error := ioresult;
if Error <> 0 then
writeln('Error renaming temporary CP/M file')
end
else
writeln('Error closing temporary CP/M file')
end
{$I+}
end;
procedure CopyFile (FleNme : String13);
var
EndFle : boolean;
Blocks : integer;
begin
repeat
R.AH := $3F; { read file or device function }
R.BX := FleHnd; { file handle }
R.CX := ENDBUF+1; { bytes to read }
R.DS := seg(Buffer);
R.DX := ofs(Buffer);
Msdos(R); { read data from DOS file }
Error := R.Flags and 1;
if Error = 0 then
begin
Blocks := (R.AX + 127) div 128;
EndFle := R.AX < (ENDBUF + 1);
if EndFle then
Buffer[R.AX] := ord(^Z);
{$I-}
blockwrite(F, Buffer, Blocks); { write to CP/M file }
Error := ioresult;
if Error <> 0 then
writeln('Error CP/M disk full')
{$I+}
end
else
writeln('Error reading DOS file')
until EndFle or (Error <> 0)
end;
procedure TransferFiles;
var
FstDir, Found : boolean;
FleNme : String13;
i : integer;
begin
DOSPth := DirMsk;
i := length(DOSPth);
while (i > 0) and (not (DOSPth[i] in ['\', ':'])) do
i := i - 1;
DOSPth[0] := chr(i);
move(DirMsk[1], DirSpc, length(DirMsk));
DirSpc[length(DirMsk)] := 0;
FstDir := true;
while FileFound(FstDir) and (Error = 0) do
begin
FstDir := false;
i := 0;
FleNme := '';
while (i < 13) and (DTA[$1E+i] <> 0) do
begin
FleNme := FleNme + chr(DTA[$1E+i]);
i := i + 1
end;
OpenFiles(FleNme);
if OvrWrt and (Error = 0) then
CopyFile(FleNme);
if Error = 0 then
CloseFiles(FleNme)
end
end;
function ParmCount : integer;
var
i, PrmCnt, PrmLen : integer;
begin
i := 1;
PrmCnt := 0;
PrmLen := length(ComLne);
while i <= PrmLen do
begin
while (i <= PrmLen) and (ComLne[i] = ' ') do
i := i + 1;
if i <= PrmLen then
PrmCnt := PrmCnt + 1;
if ComLne[i] = '/' then
i := i + 1;
while (i <= PrmLen) and (not(ComLne[i] in [' ', '/'])) do
i := i + 1
end;
ParmCount := PrmCnt
end;
function ParamStr (PrmNmb : integer) : String127;
var
i, PrmCnt, PrmLen : integer;
PrmStr : string[127];
begin
i := 1;
PrmCnt := 0;
PrmStr := '';
PrmLen := length(ComLne);
while (i <= PrmLen) and (PrmCnt < PrmNmb) do
begin
while (i <= PrmLen) AND (ComLne[i] = ' ') do
i := i + 1;
if i <= PrmLen then
PrmCnt := PrmCnt + 1;
if ComLne[i] = '/' then
begin
PrmStr := '/';
i := i + 1
end
else
PrmStr := '';
while (i <= PrmLen) and (not (ComLne[i] in [' ', '/'])) do
begin
PrmStr := PrmStr + ComLne[i];
i := i + 1
end
end;
ParamStr := PrmStr
end;
function ScanForSwitches (PrmNmb : integer) : integer;
var
SwtStr : String127;
SwtPos, i : integer;
begin
repeat
SwtStr := ParamStr(PrmNmb);
SwtPos := pos('/', SwtStr);
if Swtpos <> 0 then
begin
PrmNmb := PrmNmb - 1;
delete(SwtStr, 1, 1);
for i := 1 to length(SwtStr) do
SwtStr[i] := upcase(SwtStr[i]);
if SwtStr = 'Q' then
Quiet := true;
if SwtStr = 'F' then
ChkWrt := false
end
until SwtPos = 0;
ScanForSwitches := PrmNmb
end;
procedure ShowUsage;
begin
writeln;
writeln('DOS-TO-CPM v1.00 (c) Copyright S.J.Kay 18th April 1995');
writeln;
writeln('Use:- dostocpm (d:\path\files) (d:\path\files)... c: [/f/q]');
writeln;
writeln('d:\path\files = DOS drive, path and files');
writeln(' c: = CP/M drive path');
writeln(' /f = force overwriting of existing file(s)');
writeln(' /q = quiet, no display of file names')
end;
var
PrmTot, PrmNmb : integer;
SwtStr : String127;
begin
Quiet := false;
ChkWrt := true;
Error := 0;
PrmNmb := 1;
PrmTot := ScanForSwitches(ParmCount);
CpmPth := ParamStr(PrmTot);
if PrmTot > 1 then
begin
repeat
DirMsk := ParamStr(PrmNmb);
PrmNmb := PrmNmb + 1;
TransferFiles
until (PrmNmb >= PrmTot) or (Error <> 0)
end
else
ShowUsage
end.

BIN
CONTRIBUTIONS/z80em86/support/exit.com Normal file
View File

Binary file not shown.

20
CONTRIBUTIONS/z80em86/support/exit.mac Normal file
View File

@@ -0,0 +1,20 @@
;**************************************************************************
;* *
;* EXIT v1.00 returns control to DOS S.J.Kay 22/04/95 *
;* *
;* Support utility for CP/M 3 *
;* *
;**************************************************************************
maclib TPORTS.LIB
;
.z80
aseg
;
org 0100h
.phase 0100h
;
out (extemu),a ;controled exit from the emulator
;
.dephase
end

BIN
CONTRIBUTIONS/z80em86/support/fixturbo.com Normal file
View File

Binary file not shown.

79
CONTRIBUTIONS/z80em86/support/fixturbo.pas Normal file
View File

@@ -0,0 +1,79 @@
(*************************************************************************)
(* *)
(* FIXTURBO v1.00 (c) Copyright S.J.Kay 25th April 1995 *)
(* *)
(* Allows TURBO v2.00a compiled programs to fully access *)
(* command line parameters *)
(* *)
(*************************************************************************)
{$C-} { turn off ^C and ^S checking }
const
FixDta : array [0..24] of byte =
(
$C3,$05,$01, { start: jp patch ;skip data }
$CD, { db 0cdh ; ? }
$AB, { db 0abh ; ? }
$21,$80,$00, { patch: ld hl,0080h ;command line }
$11,$E7,$1F, { ld de,1fe7h ;string const }
$01,$80,$00, { ld bc,0080h ;amount to move }
$ED,$B0, { ldir ;move to const }
$21,$C9,$1F, { ld hl,1fc9h ;original jump }
$22,$01,$01, { ld (start+1),hl ;replace jump }
$C3,$00,$01 { jp start ;original jump }
);
var
F : file;
FleNme : string[10];
TstStr : string[10];
ComLne : string[127] absolute $0080;
ComPrm : string[127];
Buffer : array [0..127] of byte;
procedure ShowUsage;
begin
writeln('FIXTURBO v1.00 (c) Copyright S.J.Kay 25th April 1995');
writeln;
writeln('Allows TURBO v2.00a compiled programs to fully access');
writeln('command line parameters');
writeln;
writeln('Use:- FIXTURBO FILENAME.COM')
end;
begin
writeln;
ComPrm := ComLne;
while pos(' ', ComPrm) = 1 do
delete(ComPrm, 1, 1);
if ComPrm <> '' then
begin
assign(F, ComPrm);
reset(F);
seek(F, ($1FE7 - $100) div 128);
blockread(F, Buffer, 1);
move(Buffer[($1FE7 - $100) mod 128], TstStr, sizeof(TstStr));
if TstStr = 'PARAMETERS' then
begin
seek(F, 0);
blockread(F, Buffer, 1);
if (Buffer[1] = $C9) and (Buffer[2] = $1F) then
begin
move(FixDta, Buffer, sizeof(FixDta));
seek(F, 0);
blockwrite(F, Buffer, 1);
close(F);
writeln(ComPrm, ' program now modified')
end
else
writeln(ComPrm, ' program allready modified')
end
else
writeln(ComPrm, ' program did not contain string ID')
end
else
ShowUsage
end.

BIN
CONTRIBUTIONS/z80em86/support/fmfd.com Normal file
View File

Binary file not shown.

380
CONTRIBUTIONS/z80em86/support/fmfd.pas Normal file
View File

@@ -0,0 +1,380 @@
(*************************************************************************)
(* FMFD *)
(* *)
(* High level disk formatting utility *)
(* for SS/DS 40/80T floppy disks *)
(* *)
(* (c) 2009 Copyright S.J.Kay *)
(*************************************************************************)
{ WARNING - Make sure the END address is lowered to say about $8000 }
{ before compiling to disk otherwise it will crash when used from }
{ within a SUBMIT file. This happens to any TURBO v2.00a compiled }
{ program because it does not check the TPA size !. }
{$C-} { turn off ^C and ^S checking }
const
APPNAME = 'FMFD';
APPVERS = '1.0.0';
APPDATE = '26 February 2009';
FORMAT_BYTE = $e5;
type
String80 = string[80];
String127 = string[127];
var
Version : integer;
DrvChr : char;
DrvCde : integer;
BnkFlg : byte;
Parameters : String80;
ComLne : String80 absolute $0080;
Buffer : array [0..1023] of byte;
SecTrk : integer;
DiskSides : integer;
DiskTracks : integer;
BIOSPB : record
FN : byte;
A : byte;
BC : integer;
DE : integer;
HL : integer
end;
procedure BiosCall (Fn, A : byte; BC, DE, HL : integer);
begin
BIOSPB.FN := Fn;
BIOSPB.A := A;
BIOSPB.BC := BC;
BIOSPB.DE := DE;
BIOSPB.HL := HL;
bdos(50, addr(BIOSPB))
end;
function BiosFunc (Fn, A : byte; BC, DE, HL : integer) : byte;
begin
BIOSPB.FN := Fn;
BIOSPB.A := A;
BIOSPB.BC := BC;
BIOSPB.DE := DE;
BIOSPB.HL := HL;
BiosFunc := bdos(50, addr(BIOSPB))
end;
procedure BiosX (Fn, Ax : byte; BCx, DEx, HLx : integer);
begin
inline
(
$3A/Fn/ { ld a,(Fn) }
$4F/ { ld c,a }
$87/ { add a,a }
$81/ { add a,c }
$06/$00/ { ld b,0 }
$4F/ { ld c,a }
$2A/$01/$00/ { ld hl,(0001h) }
$09/ { add hl,bc }
$22/* + 17/ { ld (zzzz),hl }
$3A/Ax/ { ld a,(Ax) }
$ED/$4B/BCx/ { ld bc,(BCx) }
$ED/$5B/DEx/ { ld de,(DEx) }
$2A/HLx/ { ld hl,(HLx) }
$CD/$00/$00 { call zzzz }
)
end;
procedure GetBIOSdata (AdrSor, AdrDst, Amount : integer);
begin
BiosX(28, 0, $0100, 0, 0); { set xmove banks, bank #0 to bank #1 }
BiosX(24, 0, Amount, AdrSor, AdrDst) { move memory }
end;
function GetBIOSword (AdrSor : integer) : integer;
const
WrdDst : integer = 0;
begin
GetBIOSdata(AdrSor, addr(WrdDst), 2);
GetBIOSword := WrdDst
end;
function GetBIOSbyte (AdrSor : integer) : byte;
const
BytDst : byte = 0;
begin
GetBIOSdata(AdrSor, addr(BytDst), 1);
GetBIOSbyte := BytDst
end;
{
*==========================================================================
* Return the number of command line parameters.
*
* pass: void
* return: integer number of parameters
*==========================================================================
}
function ParamCount : integer;
var
i, PrmCnt, PrmLen : integer;
begin
i := 1;
PrmCnt := 0;
PrmLen := length(ComLne);
while i <= PrmLen do
begin
while (i <= PrmLen) and (ComLne[i] = ' ') do
i := i + 1;
if i <= PrmLen then
PrmCnt := PrmCnt + 1;
if ComLne[i] = '/' then
i := i + 1;
while (i <= PrmLen) and (not(ComLne[i] in [' ', '/'])) do
i := i + 1
end;
ParamCount := PrmCnt
end;
{
*==========================================================================
* Return the specified command line parameter.
*
* pass: PrmNmb : integer
* return: String127 parameter
*==========================================================================
}
function ParamStr (PrmNmb : integer) : String127;
var
i, PrmCnt, PrmLen : integer;
PrmStr : string[127];
begin
i := 1;
PrmCnt := 0;
PrmStr := '';
PrmLen := length(ComLne);
while (i <= PrmLen) and (PrmCnt < PrmNmb) do
begin
while (i <= PrmLen) AND (ComLne[i] = ' ') do
i := i + 1;
if i <= PrmLen then
PrmCnt := PrmCnt + 1;
if ComLne[i] = '/' then
begin
PrmStr := '/';
i := i + 1
end
else
PrmStr := '';
while (i <= PrmLen) and (not (ComLne[i] in [' ', '/'])) do
begin
PrmStr := PrmStr + ComLne[i];
i := i + 1
end
end;
ParamStr := PrmStr
end;
{
*==========================================================================
* Write disk sector
*
* pass: track : integer
* sector : integer
* return: byte 0 if no error
*==========================================================================
}
function WriteDiskSector ( track : integer;
sector : integer) : byte;
var
res_a : byte;
begin
BiosCall(10, 0, track, 0, 0); { set physical track }
BiosCall(11, 0, sector, 0, 0); { set physical sector }
BiosCall(12, 0, addr(buffer), 0, 0); { set DMA address }
BiosCall(28, 1, 0, 0, 0); { set data bank #1 (TPA) }
res_a := BiosFunc(14, 0, 0, 0, 0); { write 1 sector }
WriteDiskSector := res_a;
end;
{
*==========================================================================
* Write disk track.
*
* Skewing is used to speed things up.
*
* pass: track : integer
* return: byte 0 if no error
*==========================================================================
}
function WriteDiskTrack (track : integer) : byte;
var
s : integer;
res : byte;
begin
s := 1;
repeat
res := WriteDiskSector(track, s);
s := s + 1;
until ((res <> 0) or (s > SecTrk));
WriteDiskTrack := res;
end;
{
*==========================================================================
* Format all tracks.
*
* pass: drive : char drive char (A-B)
* return: void
*==========================================================================
}
procedure FormatAllTracks;
var
t : integer;
res : integer;
completed : real;
begin
BiosCall(9, 0, DrvCde, 1, 0);
fillchar(buffer, sizeof(buffer), FORMAT_BYTE);
t := 0;
writeln;
write(' 0 percent completed', ^M);
repeat
res := WriteDiskTrack(t);
t := t + 1;
completed := (t / (DiskTracks * DiskSides)) * 100.0;
write(completed:3:0, ^M);
until ((res <> 0) or (t = (DiskTracks * DiskSides)));
bdos(37, 1 shl DrvCde); { reset the formatted drive }
writeln;
writeln;
if (res = 0) then
writeln('Format completed')
else
writeln('Format failed');
end;
{
*==========================================================================
* Format disk
*
* pass: drive : char drive char (A-B)
* return: void
*==========================================================================
}
procedure FormatDisk (drive : char);
var
TblAdr : integer;
DPH, DPB, SPT, PHM : integer;
res_hl : integer;
def_drive : byte;
response : string[1];
begin
DrvCde := ord(drive) - ord('A');
TblAdr := bioshl(21) + DrvCde * 2;
DPH := GetBIOSword(TblAdr);
if (DPH <> 0) then
begin
DPB := GetBIOSword(DPH+12);
SPT := GetBIOSword(DPB); { sectors/track }
PHM := GetBIOSbyte(DPB+16); { physical sector mask }
SecTrk := SPT DIV (PHM + 1);
writeln('WARNING - All data on ', drive,
': will be lost forever !');
write('Are you sure [y/n] ?: ');
buflen := 1;
readln(response);
if ((response = 'y') or (response = 'Y')) then
FormatAllTracks
else
writeln('Format aborted');
end
else
writeln('The drive specified does not exist')
end;
{
*==========================================================================
* Usage Information
*
* pass: void
* return: void
*==========================================================================
}
procedure UsageInformation;
begin
writeln(APPNAME, ' v', APPVERS, ' (c) Copyright S.J.Kay ', APPDATE);
writeln;
writeln('!!! WARNING !!!');
writeln('This program performs a high level disk format by writing E5 hex');
writeln('to all locations on the disk, this is just as destructive as a');
writeln('low level format, you will lose all data on the disk!');
writeln;
writeln('Usage:- ', APPNAME, ' SS/DS 40/80 drive:');
writeln;
writeln(' SS/DS = SS is single sided, DS is double sided disk');
writeln(' 40/80 = 40 or 80 tracks per disk side');
writeln('drive: = CP/M drive A: or B:');
end;
var
parm : String127;
Error : integer;
begin
Version := bdoshl(12);
if (hi(Version) = $00) and (lo(Version) >= $30) then
begin
Error := ord(ParamCount <> 3);
if (Error = 0) then
begin
parm := ParamStr(1);
if (parm = 'SS') then
DiskSides := 1
else
if (parm = 'DS') then
DiskSides := 2
else
Error := 1;
if (Error = 0) then
begin
parm := ParamStr(2);
if (parm = '40') then
DiskTracks := 40
else
if (parm = '80') then
DiskTracks := 80
else
Error := Error + 1;
end;
if (Error = 0) then
begin
parm := ParamStr(3);
if (length(parm) = 2) then
parm[1] := upcase(parm[1]);
if ((parm[2] = ':') and (parm[1] in ['A'..'B'])) then
FormatDisk(parm[1])
else
Error := Error + 1;
end;
end;
if (Error <> 0) then
UsageInformation
end
else
begin
writeln;
writeln('Wrong SYSTEM, requires CP/M Plus ver 3.0 up')
end
end.

BIN
CONTRIBUTIONS/z80em86/support/format.com Normal file
View File

Binary file not shown.

522
CONTRIBUTIONS/z80em86/support/format.pas Normal file
View File

@@ -0,0 +1,522 @@
(*************************************************************************)
(* *)
(* FORMAT v1.00 (c) Copyright S.J.Kay 2nd May 1995 *)
(* *)
(* Support utility for IBM Z80 Emulator CP/M 3 to allow formating *)
(* floppy disks to a CP/M format *)
(* *)
(*************************************************************************)
{$C-} { turn off ^C and ^S checking }
type
registers = record
case boolean of
true : (AL, AH, BL, BH, CL, CH, DL, DH : byte);
false : (AX, BX, CX, DX,
BP, SI, DI, DS, ES, FLAGS : integer)
end;
const
DrvDta : array [0..6, 0..3] of integer =
(
{ Media EndTrk SecTrk TrkCap }
( 1, 39, 9, 6250 ), { 40T DD diskette in 40T DD 5.25" }
( 2, 39, 9, 6250 ), { 40T DD diskette in 80T HD 5.25" }
( 1, 39, 9, 6250 ), { 80T DD diskette in 80T HD 5.25" }
( 3, 79, 15, 10416 ), { 80T HD diskette in 80T HD 5.25" }
( 4, 79, 9, 6250 ), { 80T DD diskette in 80T DD 3.5" }
( 4, 79, 9, 6250 ), { 80T DD diskette in 80T HD 3.5" }
( 4, 79, 18, 12500 ) { 80T HD diskette in 80T HD 3.5" }
);
var
R : registers;
ComLne : string[127] absolute $0080;
ComPrm : string[127];
DPT : array[0..10] of byte;
DrvCde : integer;
DPH : integer;
DrvInf : char;
procedure ProcZ80 (Fn, Ax : byte; BCx, DEx, HLx : integer);
begin
inline
(
$3A/Fn/ { ld a,(Fn) }
$32/* + 17/ { ld (FNCNMB),a }
$3A/Ax/ { ld a,(Ax) }
$ED/$4B/BCx/ { ld bc,(BCx) }
$ED/$5B/DEx/ { ld de,(DEx) }
$2A/HLx/ { ld hl,(HLx) }
$D3/$FF { out (FNCNMB),a }
)
end;
function FuncZ80 (Fn, Ax : byte; BCx, DEx, HLx : integer) : byte;
const
BytVal : byte = 0;
begin
inline
(
$3A/Fn/ { ld a,(Fn) }
$32/* + 17/ { ld (FNCNMB),a }
$3A/Ax/ { ld a,(Ax) }
$ED/$4B/BCx/ { ld bc,(BCx) }
$ED/$5B/DEx/ { ld de,(DEx) }
$2A/HLx/ { ld hl,(HLx) }
$D3/$FF/ { out (FNCNMB),a }
$32/BytVal { ld (BYTVAL),a }
);
FuncZ80 := BytVal
end;
function GetByt (Seg, Off : integer) : byte;
begin
GetByt := FuncZ80($B0, 0, 0, Seg, Off)
end;
procedure SetByt (Seg, Off : integer ; BytPut : byte);
begin
ProcZ80($B1, BytPut, 0, Seg, Off)
end;
function GetWrd (Seg, Off : integer) : integer;
begin
GetWrd := FuncZ80($B0, 0, 0, Seg, Off) +
FuncZ80($B0, 0, 0, Seg, Off + 1) shl 8
end;
procedure SetWrd (Seg, Off, WrdPut : integer);
begin
ProcZ80($B1, lo(WrdPut), 0, Seg, Off);
ProcZ80($B1, hi(WrdPut), 0, Seg, Off + 1)
end;
procedure Intr (Int : byte; var R : registers);
begin
ProcZ80($A1, Int, $AA55, $55AA, addr(R))
end;
procedure Msdos (var R : registers);
begin
Intr($21, R)
end;
function Seg (var Dummy) : integer;
const
SegAdr : integer = 0;
begin
ProcZ80($A0, 0, 0, 0, addr(SegAdr));
Seg := SegAdr
end;
function Ofs (var VarTyp) : integer;
begin
Ofs := addr(VarTyp)
end;
procedure BiosX (Fn, Ax : byte; BCx, DEx, HLx : integer);
begin
inline
(
$3A/Fn/ { ld a,(Fn) }
$4F/ { ld c,a }
$87/ { add a,a }
$81/ { add a,c }
$06/$00/ { ld b,0 }
$4F/ { ld c,a }
$2A/$01/$00/ { ld hl,(0001h) }
$09/ { add hl,bc }
$22/* + 17/ { ld (zzzz),hl }
$3A/Ax/ { ld a,(Ax) }
$ED/$4B/BCx/ { ld bc,(BCx) }
$ED/$5B/DEx/ { ld de,(DEx) }
$2A/HLx/ { ld hl,(HLx) }
$CD/$00/$00 { call zzzz }
)
end;
procedure GetBIOSdata (AdrSor, AdrDst, Amount : integer);
begin
BiosX(28, 0, $0100, 0, 0); { set xmove banks, bank #0 to bank #1 }
BiosX(24, 0, Amount, AdrSor, AdrDst) { move memory }
end;
function GetBIOSword (AdrSor : integer) : integer;
const
WrdDst : integer = 0;
begin
GetBIOSdata(AdrSor, addr(WrdDst), 2);
GetBIOSword := WrdDst
end;
function GetBIOSbyte (AdrSor : integer) : byte;
const
BytDst : byte = 0;
begin
GetBIOSdata(AdrSor, addr(BytDst), 1);
GetBIOSbyte := BytDst
end;
procedure DiskReset;
begin
R.AH := $00;
R.DL := DrvCde;
intr($13, R)
end;
procedure GetInterrupt (Int : byte; var S, O : integer);
begin
R.AH := $35;
R.AL := Int;
Msdos(R);
S := R.ES;
O := R.BX
end;
procedure SetInterrupt (Int : byte; S, O : integer);
begin
R.AH := $25;
R.AL := Int;
R.DS := S;
R.DX := O;
Msdos(R)
end;
procedure ReportError (ErrCde : byte);
begin
writeln;
writeln;
case ErrCde of
$01 : writeln('Bad command');
$02 : writeln('Address mark not found');
$03 : writeln('Disk is write protected');
$04 : writeln('Sector not found');
$06 : writeln('Diskette removed');
$08 : writeln('DMA overrun');
$09 : writeln('DMA across 64 KB boundary');
$0C : writeln('Bad media type');
$10 : writeln('Bad CRC or ECC');
$20 : writeln('Controller failed');
$40 : writeln('Seek failed');
$80 : writeln('Drive not ready')
else
writeln('Unknown disk error')
end
end;
procedure DataFromCPM (var TotSde : integer;
var CylTot : integer;
var EndTrk : integer;
var TotSec : integer;
var SecSze : integer);
var
DPB, SPT, DSM, OFF : integer;
UNT, BLM, PSH, PHM : byte;
begin
UNT := GetBIOSbyte(DPH-2);
DPB := GetBIOSword(DPH+12);
SPT := GetBIOSword(DPB);
BLM := GetBIOSbyte(DPB+3);
DSM := GetBIOSword(DPB+5);
OFF := GetBIOSword(DPB+13);
PSH := GetBIOSbyte(DPB+15);
PHM := GetBIOSbyte(DPB+16);
TotSde := 2 - (UNT shr 7);
CylTot := ((((DSM + 1) * (BLM + 1) + BLM) div SPT) + OFF);
EndTrk := CylTot div TotSde - 1;
TotSec := SPT div (PHM + 1);
SecSze := PSH
end;
procedure CalcDiskValues ( TotSec, SecSze, EndTrk : integer;
var Gap0, Gap1 : integer);
var
TrkCap, TrkLen : integer;
x : integer;
begin
if DrvInf = #0 then
begin
if EndTrk > 60 then
begin
if (TotSec * (128 shl SecSze)) > 5120 then
DrvInf := '7' { 80T HD diskette in 80T HD 3.5" drive }
else
DrvInf := '6' { 80T DD diskette in 80T HD 3.5" drive }
end
else
DrvInf := '2' { 40T DD diskette in 80T HD 5.25" drive }
end;
x := ord(DrvInf) - ord('1');
TrkCap := DrvDta[x, 3];
TrkLen := TrkCap - trunc(TrkCap * (3.5 / 100.0) + 96.0);
Gap1 := (TrkLen - (TotSec * (62 + (128 shl SecSze)))) div TotSec;
if Gap1 > 255 then
Gap1 := 255;
Gap0 := Gap1 div 3
end;
function SetupFloppy : boolean;
var
x, Retry : integer;
Error : boolean;
begin
Retry := 3;
x := ord(DrvInf) - ord('1');
repeat
R.AH := $17;
R.AL := DrvDta[x, 0];
R.DL := DrvCde;
intr($13, R);
Retry := Retry - 1;
Error := odd(R.FLAGS);
if Error and (Retry <> 0) then
DiskReset
until (not Error) or (Retry = 0);
Retry := 3;
if not Error then
repeat
R.AH := $18;
R.CH := DrvDta[x, 1];
R.CL := DrvDta[x, 2];
R.DL := DrvCde;
intr($13, R);
Retry := Retry - 1;
Error := odd(R.FLAGS);
if Error and (Retry <> 0) then
DiskReset
until (not Error) or (Retry = 0);
if Error then
ReportError(R.AH);
SetupFloppy := not Error
end;
function VerifyFormat (TotSec, SdeNmb, CylNmb : integer) : boolean;
var
Retry : integer;
Error : boolean;
begin
R.AH := $04;
R.AL := TotSec;
R.CH := CylNmb;
R.CL := 1;
R.DH := SdeNmb;
R.DL := DrvCde;
intr($13, R);
Error := odd(R.FLAGS);
if Error then
ReportError(R.AH);
VerifyFormat := Error
end;
function TrackFormat (SdeNmb, CylNmb, TotSec, SecSze : integer) : boolean;
var
FmtTbl : array [0..255, 0..3] of byte;
i : integer;
SecNmb : integer;
begin
SecNmb := 1;
for i := 0 to TotSec - 1 do
begin
FmtTbl[i, 0] := CylNmb;
FmtTbl[i, 1] := SdeNmb;
FmtTbl[i, 2] := SecNmb;
FmtTbl[i, 3] := SecSze;
SecNmb := SecNmb + 1
end;
R.AH := $05;
R.AL := $01;
R.CH := CylNmb;
R.CL := $00;
R.DH := SdeNmb;
R.DL := DrvCde;
R.ES := seg(FmtTbl);
R.BX := ofs(FmtTbl);
intr($13, R);
if odd(R.FLAGS) then
ReportError(R.AH);
TrackFormat := odd(R.FLAGS)
end;
procedure FormatFloppy (TotSde, CylTot, EndTrk, TotSec, SecSze : integer);
var
SdeNmb, CylNmb, CylCnt : integer;
Finish, Error : boolean;
Key : char;
begin
SdeNmb := 0;
CylNmb := 0;
CylCnt := 0;
Finish := false;
repeat
if keypressed then
begin
read(kbd, Key);
Finish := Key = ^[
end;
if not Finish then
begin
Error := TrackFormat(SdeNmb, CylNmb, TotSec, SecSze);
if not Error then
Error := VerifyFormat(TotSec, SdeNmb, CylNmb);
SdeNmb := (SdeNmb + ord(TotSde = 2)) and $01;
CylNmb := CylNmb + ord(SdeNmb = 0);
CylCnt := CylCnt + 1;
Finish := CylNmb > EndTrk;
if not Error then
write((CylCnt / CylTot) * 100.0:3:0, ^M)
end
until Error or Finish;
bdos(13)
end;
procedure StartFormat;
var
TotSde, CylTot, EndTrk, TotSec, SecSze : integer;
Gap0, Gap1 : integer;
DskPrmS, DskPrmO, i : integer;
begin
DataFromCPM(TotSde, CylTot, EndTrk, TotSec, SecSze);
CalcDiskValues(TotSec, SecSze, EndTrk, Gap0, Gap1);
writeln('Formatting: Tracks=', EndTrk+1, ' Sides=', TotSde,
' Sec/Trk=', TotSec, ' Byt/Sec=', 128 shl SecSze,
' Gap=', Gap1);
write(' 0 percent completed', ^M);
if SetupFloppy then
begin
GetInterrupt($1E, DskPrmS, DskPrmO);
for i := 0 to 10 do
DPT[i] := GetByt(DskPrmS, DskPrmO + i);
DPT[3] := SecSze; { set sector size code }
DPT[4] := TotSec; { set last sector on track }
DPT[5] := Gap0; { set intersector gap for read/write }
DPT[7] := Gap1; { set intersector gap for format }
DPT[8] := $E5; { data format value }
SetInterrupt($1E, seg(DPT), ofs(DPT));
DiskReset;
FormatFloppy(TotSde, CylTot, EndTrk, TotSec, SecSze);
SetInterrupt($1E, DskPrmS, DskPrmO);
DiskReset
end
end;
procedure PromptUser;
var
FmtNxt : STRING[1];
Key : char;
begin
repeat
writeln;
writeln('Insert a disk to be formatted in drive ',
chr(ord('A') + DrvCde));
writeln;
writeln('Press ENTER when ready');
repeat
read(kbd, Key)
until Key in [^M, ^[, ^C];
if Key = ^M then
begin
writeln;
StartFormat;
writeln;
writeln;
write('Format another disk (y/n) ?: ');
buflen := 1;
readln(FmtNxt)
end;
writeln
until ((FmtNxt <> 'Y') and (FmtNxt <> 'y')) or (Key = ^[)
end;
procedure CheckAndFormat;
begin
DrvCde := ord(ComPrm[1]) - ord('A');
DPH := GetBIOSword(bioshl(21) + DrvCde * 2);
if (DPH <> 0) and (DrvCde in [0..1]) then
PromptUser
else
writeln('Drive specified not supported')
end;
procedure ShowUsage;
begin
writeln;
writeln('FORMAT v1.00 (c) Copyright S.J.Kay 2nd May 1995');
writeln;
writeln('Formats disk according to the data held in the CP/M 3 DPB');
writeln;
writeln('If more than 59 tracks:-');
writeln(' Format will be 80T DD/HD diskette in 80T HD 3.5" drive');
writeln('If less than 60 tracks:-');
writeln(' Format will be 40T DD diskette in 80T HD 5.25" drive');
writeln;
writeln('Use an appropriate switch if other hardware is required.');
writeln;
writeln('Use:- FORMAT D: [/1/2/3/4/5/6/7]');
writeln;
writeln('D: = format diskette in drive A or B');
writeln('/1 = 40T DD diskette in 40T DD 5.25" drive');
writeln('/2 = 40T DD diskette in 80T HD 5.25" drive');
writeln('/3 = 80T DD diskette in 80T HD 5.25" drive');
writeln('/4 = 80T HD diskette in 80T HD 5.25" drive');
writeln('/5 = 80T DD diskette in 80T DD 3.5" drive');
writeln('/6 = 80T DD diskette in 80T HD 3.5" drive');
writeln('/7 = 80T HD diskette in 80T HD 3.5" drive')
end;
var
Error : boolean;
begin
DrvInf := #0;
ComPrm := ComLne;
while pos(' ', ComPrm) <> 0 do
delete(ComPrm, pos(' ', ComPrm), 1);
Error := pos(':', ComPrm) <> 2;
if not Error then
begin
if (pos('/', ComPrm) = 3) and (length(ComPrm) = 4) then
begin
Error := not (ComPrm[4] in ['1'..'7']);
if not Error then
DrvInf := ComPrm[4]
end
else
Error := (length(ComPrm) <> 2) and (DrvInf = #0);
if not Error then
CheckAndFormat
else
ShowUsage
end
else
ShowUsage
end.

BIN
CONTRIBUTIONS/z80em86/support/modem.com Normal file
View File

Binary file not shown.

451
CONTRIBUTIONS/z80em86/support/modem.pas Normal file
View File

@@ -0,0 +1,451 @@
(*************************************************************************)
(* *)
(* SIMPLE MODEM v1.00 (c) Copyright S.J.Kay 18th April 1995 *)
(* Using the Ward Christensen file transfer protocol *)
(* *)
(* Uses CP/M 3.0 AUXIN and AUXOUT routines *)
(* *)
(*************************************************************************)
type
registers = record
case boolean of
true : (AL, AH, BL, BH, CL, CH, DL, DH : byte);
false : (AX, BX, CX, DX,
BP, SI, DI, DS, ES, FLAGS : integer)
end;
const
PthNme = '';
ENDBUF = $1FFF; { must be a multiple of 128 -1 }
SOH = $01; { Start Of Header }
EOT = $04; { End Of Transmission }
ACK = $06; { Acknowledge }
NAK = $15; { Negative Acknowledge }
CAN = $18; { Cancel }
var
R : registers;
F : file;
ExtCde : byte;
Check : byte;
BufPos : integer;
Abort : boolean;
TmeOut : boolean;
FleOpn : boolean;
Buffer : array [$0000..ENDBUF] of byte;
procedure ProcZ80 (Fn, Ax : byte; BCx, DEx, HLx : integer);
begin
inline
(
$3A/Fn/ { ld a,(Fn) }
$32/* + 17/ { ld (FNCNMB),a }
$3A/Ax/ { ld a,(Ax) }
$ED/$4B/BCx/ { ld bc,(BCx) }
$ED/$5B/DEx/ { ld de,(DEx) }
$2A/HLx/ { ld hl,(HLx) }
$D3/$FF { out (FNCNMB),a }
)
end;
procedure Intr (Int : byte; var R : registers);
begin
ProcZ80($A1, Int, $AA55, $55AA, addr(R))
end;
function SerialOutputStatus : byte;
begin
SerialOutputStatus := bios(18) { test if AUXOUT is ready }
end;
function SerialInputStatus : byte;
begin
SerialInputStatus := bios(17) { test if AUXIN has a character }
end;
procedure SerialOutput (x : byte);
begin
bios(5, x);
end;
function SerialInput : byte;
begin
SerialInput := bios(6);
end;
function TickCount : integer;
begin
R.AH := $00;
intr($1A, R);
TickCount := R.DX
end;
procedure TestAbort;
var
Key : char;
begin
while keypressed do
begin
read(kbd, Key);
if (Key = ^[) or (Key = ^X) then
begin
Abort := true;
ExtCde := 1
end
end
end;
procedure WriteByte (BytVal : byte; TckVal : integer);
var
BytOut : boolean;
T : integer;
begin
TmeOut := false;
if SerialOutputStatus <> 0 then
SerialOutput(BytVal)
else
begin
BytOut := false;
T := TickCount;
repeat
if SerialOutputStatus <> 0 then
begin
SerialOutput(BytVal);
BytOut := true
end
else
begin
TmeOut := (TickCount - T) >= TckVal;
if keypressed then
TestAbort
end
until BytOut or TmeOut or Abort
end
end;
function ReadByte (TckVal : integer) : byte;
var
BytInp : boolean;
T : integer;
begin
TmeOut := false;
if SerialInputStatus <> 0 then
ReadByte := SerialInput
else
begin
BytInp := false;
T := TickCount;
repeat
if SerialInputStatus <> 0 then
begin
ReadByte := SerialInput;
BytInp := true
end
else
begin
ReadByte := $FF;
TmeOut := (TickCount - T) >= TckVal;
if keypressed then
TestAbort
end
until BytInp or TmeOut or Abort
end
end;
procedure Purge;
var
Dummy : byte;
begin
repeat
Dummy := ReadByte(19) { 1 sec time out }
until TmeOut or Abort
end;
procedure SendCancel;
var
Dummy : byte;
begin
repeat
Abort := false;
Dummy := ReadByte(19) { 1 sec time out }
until TmeOut;
WriteByte(CAN, 91) { 5 sec time out }
end;
procedure StartNAK;
var
BytVal, Retry : byte;
begin
Retry := 15;
repeat
Purge; { 1 sec min time taken }
if not Abort then
begin
WriteByte(NAK, 1820); { 100 sec time out }
if TmeOut then
begin
Abort := true;
ExtCde := 2
end;
if not Abort then
begin
BytVal := ReadByte(56); { 3 sec time out waiting ACK }
if Tmeout then
Retry := Retry - 1;
if Retry = 0 then
begin
Abort := true;
ExtCde := 3
end
end
end
until (BytVal = ACK) or Abort
end;
procedure BlockNAK;
begin
Purge;
if not Abort then
begin
WriteByte(NAK, 1820); { 100 sec time out }
if TmeOut then
begin
Abort := true;
ExtCde := 4
end
end
end;
procedure BlockACK;
begin
if not Abort then
begin
WriteByte(ACK, 1820); { 100 sec time out }
if TmeOut then
begin
Abort := true;
ExtCde := 5
end
end
end;
procedure OpenFile;
var
i : integer;
FleNme : string[12];
begin
BufPos := 0;
FleNme := '';
i := 0;
while (i < 12) and (Buffer[i] <> 0) do
begin
FleNme := FleNme + chr(Buffer[i]);
i := i + 1
end;
gotoxy(42, 17);
write(FleNme, '':12);
assign(F, PthNme + FleNme);
rewrite(F);
FleOpn := true
end;
procedure FlushBuffer;
begin
blockwrite(F, Buffer, BufPos div 128);
BufPos := 0
end;
procedure CloseFile;
begin
if FleOpn then
begin
FlushBuffer;
close(F);
FleOpn := false
end
end;
function ReadBlockByte (TckVal : integer) : byte;
var
BytVal : byte;
begin
BytVal := ReadByte(TckVal);
Check := Check + BytVal;
ReadBlockByte := BytVal
end;
function CheckHeader : boolean;
var
BytVal : byte;
begin
BytVal := ReadBlockByte(182);
if (BytVal = EOT) and (not TmeOut) and (not Abort) then
begin
CloseFile;
WriteByte(ACK, 1820);
if TmeOut then
Abort := true;
if not Abort then
WriteByte(ACK, 1820);
if TmeOut then
Abort := true;
if Abort then
ExtCde := 6
end;
CheckHeader := BytVal = EOT
end;
procedure ReadBlocks;
var
Finish : boolean;
i, SveBuf : integer;
GetBlk, BlkNmb, BlkCpl, ChkSum : byte;
BytVal : byte;
begin
BufPos := 0;
GetBlk := 0;
FleOpn := false;
repeat
i := 0;
Check := 0;
SveBuf := BufPos;
Finish := CheckHeader;
if not Finish then
begin
if (not TmeOut) and (not Abort) then
BlkNmb := ReadBlockByte(19);
if (not TmeOut) and (not Abort) then
BlkCpl := ReadBlockByte(19);
while (not TmeOut) and (not Abort) and (i < 128) do
begin
BytVal := ReadBlockByte(19);
Buffer[BufPos] := BytVal;
BufPos := BufPos + 1;
i := i + 1
end;
if (not TmeOut) and (not Abort) then
ChkSum := ReadByte(19);
if (not TmeOut) and (not Abort) then
if ChkSum = Check then
begin
if not FleOpn and (BlkNmb = 0) then
begin
OpenFile;
gotoxy(43, 18);
write(BlkNmb, '': 2);
BlockACK
end;
if BlkNmb = GetBlk then
begin
gotoxy(43, 18);
write(BlkNmb, '': 2);
GetBlk := GetBlk + 1;
if BufPos > ENDBUF then
FlushBuffer;
BlockACK
end
else
begin
BufPos := SveBuf;
if BlkNmb = (GetBlk - 1) then
BlockACK
else
begin
Abort := true;
ExtCde := 7
end
end
end;
if TmeOut or (Check <> ChkSum) then
begin
BlockNAK;
BufPos := SveBuf
end
end
until Abort or Finish
end;
procedure Receive;
var
Retry, Finish : boolean;
BytVal : byte;
begin
Abort := false;
Finish := false;
ExtCde := 0;
repeat
StartNAK; { send NAK, then wait for ACK }
if not Abort then
begin
Retry := true;
while Retry and not Abort do
begin
BytVal := ReadByte(19); { 1st letter of filename or EOT }
Retry := TmeOut;
if not Retry then
Finish := BytVal = EOT
else
BlockNAK
end;
if (not Finish) and (not Abort) then
ReadBlocks
end
until Finish or Abort;
if Abort then
SendCancel;
gotoxy(1, 23);
case ExtCde of
1 : writeln('User cancelled by pressing abort key');
2 : writeln('Unable to send initial NAK to sender');
3 : writeln('No ACK response for initial NAK sent');
4 : writeln('Unable to send NAK for bad block');
5 : writeln('Unable to send ACK for block received');
6 : writeln('Unable to send ACK for file end (EOT)');
7 : writeln('Fatal loss of sync receiving blocks')
end
end;
begin
clrscr;
writeln(' MODEM v1.00 (c) S.J.Kay 1st April 1995');
writeln;
writeln(' Uses the Ward Christensen file transfer protocol');
writeln(' with file name support.');
writeln;
writeln(' NOTE: Files will be written to the default drive.');
writeln;
writeln(' Uses AUXIN and AUXOUT devices, set device for correct values');
writeln(' before using this program');
writeln;
writeln(' To abort press the ESC or ^X keys at any time');
writeln;
gotoxy(31, 17);
write( 'Receiving:');
gotoxy(31, 18);
write( ' Block: #');
Receive
end.

174
CONTRIBUTIONS/z80em86/support/mvecde.pas Normal file
View File

@@ -0,0 +1,174 @@
(*************************************************************************)
(* *)
(* Functions common to most support programs *)
(* (c) Copyright S.J.Kay *)
(* *)
(*************************************************************************)
procedure BiosX (Fn, Ax : byte; BCx, DEx, HLx : integer);
begin
inline
(
$3A/Fn/ { ld a,(Fn) }
$4F/ { ld c,a }
$87/ { add a,a }
$81/ { add a,c }
$06/$00/ { ld b,0 }
$4F/ { ld c,a }
$2A/$01/$00/ { ld hl,(0001h) }
$09/ { add hl,bc }
$22/* + 17/ { ld (zzzz),hl }
$3A/Ax/ { ld a,(Ax) }
$ED/$4B/BCx/ { ld bc,(BCx) }
$ED/$5B/DEx/ { ld de,(DEx) }
$2A/HLx/ { ld hl,(HLx) }
$CD/$00/$00 { call zzzz }
)
end;
procedure GetBIOSdata (AdrSor, AdrDst, Amount : integer);
begin
BiosX(28, 0, $0100, 0, 0); { set xmove banks, bank #0 to bank #1 }
BiosX(24, 0, Amount, AdrSor, AdrDst) { move memory }
end;
function GetBIOSword (AdrSor : integer) : integer;
const
WrdDst : integer = 0;
begin
GetBIOSdata(AdrSor, addr(WrdDst), 2);
GetBIOSword := WrdDst
end;
function GetBIOSbyte (AdrSor : integer) : byte;
const
BytDst : byte = 0;
begin
GetBIOSdata(AdrSor, addr(BytDst), 1);
GetBIOSbyte := BytDst
end;
procedure PutBIOSdata (AdrSor, AdrDst, Amount : integer);
begin
BiosX(28, 0, $0001, 0, 0); { set xmove banks, bank #1 to bank #0 }
BiosX(24, 0, Amount, AdrSor, AdrDst) { move memory }
end;
procedure PutBIOSword (AdrDst, WrdPut : integer);
const
WrdSor : integer = 0;
begin
WrdSor := WrdPut;
PutBIOSdata(addr(WrdSor), AdrDst, 2)
end;
procedure PutBIOSbyte (AdrDst : integer; BytPut : byte);
const
BytSor : byte = 0;
begin
BytSor := BytPut;
PutBIOSdata(addr(BytSor), AdrDst, 1)
end;
type
registers = record
case boolean of
true : (AL, AH, BL, BH, CL, CH, DL, DH : byte);
false : (AX, BX, CX, DX,
BP, SI, DI, DS, ES, FLAGS : integer)
end;
procedure ProcZ80 (Fn, Ax : byte; BCx, DEx, HLx : integer);
begin
inline
(
$3A/Fn/ { ld a,(Fn) }
$32/* + 17/ { ld (FNCNMB),a }
$3A/Ax/ { ld a,(Ax) }
$ED/$4B/BCx/ { ld bc,(BCx) }
$ED/$5B/DEx/ { ld de,(DEx) }
$2A/HLx/ { ld hl,(HLx) }
$D3/$FF { out (FNCNMB),a }
)
end;
function FuncZ80 (Fn, Ax : byte; BCx, DEx, HLx : integer) : byte;
const
BytVal : byte = 0;
begin
inline
(
$3A/Fn/ { ld a,(Fn) }
$32/* + 17/ { ld (FNCNMB),a }
$3A/Ax/ { ld a,(Ax) }
$ED/$4B/BCx/ { ld bc,(BCx) }
$ED/$5B/DEx/ { ld de,(DEx) }
$2A/HLx/ { ld hl,(HLx) }
$D3/$FF/ { out (FNCNMB),a }
$32/BytVal { ld (BYTVAL),a }
);
FuncZ80 := BytVal
end;
function GetByt (Seg, Off : integer) : byte;
begin
GetByt := FuncZ80($B0, 0, 0, Seg, Off)
end;
procedure SetByt (Seg, Off : integer ; BytPut : byte);
begin
ProcZ80($B1, BytPut, 0, Seg, Off)
end;
function GetWrd (Seg, Off : integer) : integer;
begin
GetWrd := FuncZ80($B0, 0, 0, Seg, Off) +
FuncZ80($B0, 0, 0, Seg, Off + 1) shl 8
end;
procedure SetWrd (Seg, Off, WrdPut : integer);
begin
ProcZ80($B1, lo(WrdPut), 0, Seg, Off);
ProcZ80($B1, hi(WrdPut), 0, Seg, Off + 1)
end;
procedure Intr (Int : byte; var R : registers);
begin
ProcZ80($A1, Int, $AA55, $55AA, addr(R))
end;
procedure Msdos (var R : registers);
begin
Intr($21, R)
end;
function Seg (var Dummy) : integer;
const
SegAdr : integer = 0;
begin
ProcZ80($A0, 0, 0, 0, addr(SegAdr));
Seg := SegAdr
end;
function Ofs (var VarTyp) : integer;
begin
Ofs := addr(VarTyp)
end;

BIN
CONTRIBUTIONS/z80em86/support/putldr.com Normal file
View File

Binary file not shown.

441
CONTRIBUTIONS/z80em86/support/putldr.pas Normal file
View File

@@ -0,0 +1,441 @@
{*************************************************************************}
{* *}
{* PUTLDR v1.00 (c) Copyright S.J.Kay 18th April 1995 *}
{* *}
{* Places S.J.Kay's CP/M 3.0 loader on system stracks *}
{* *}
{*************************************************************************}
{ LAYOUT OF CPMLDR.SYS FILE }
{ }
{ FILE OFFSET R/W/C DESCRIPTION OF ITEM }
{ 0, 1 2 c JP XXXX jumps over data }
{ 3 4 r if AA55 hex value here then assume correct file }
{ 5 r CPMLDR.SYS version }
{ 6, 7 r CPMLDR.SYS execute address (calculate offsets) }
{ 8, 9 r DPH table address }
{ 10, 11 r DPB table address }
{ 12, 13 r XLT sector translate table address }
{ 14, 15 w bytes in physical sector }
{ 16 w physical sectors per track }
{ 17 w RDRV (udf, density, type, physical drive) }
{ 18 w tracks to be loaded }
{ 19 w flag for loader to initialize banked system }
{$C-} { turn off ^C and ^S checking }
type
String80 = string[80];
const
MAXBUF = 127;
var
Version : integer;
DrvChr : char;
DrvCde : integer;
BnkFlg : byte;
Parameters : String80;
ComLne : String80 absolute $0080;
FleBuf : array[0..MAXBUF, 0..127] of byte;
VerBuf : array[0..1023] of byte;
BIOSPB : record
FN : byte;
A : byte;
BC : integer;
DE : integer;
HL : integer
end;
procedure BiosCall (Fn, A : byte; BC, DE, HL : integer);
begin
BIOSPB.FN := Fn;
BIOSPB.A := A;
BIOSPB.BC := BC;
BIOSPB.DE := DE;
BIOSPB.HL := HL;
bdos(50, addr(BIOSPB))
end;
function BiosFunc (Fn, A : byte; BC, DE, HL : integer) : byte;
begin
BIOSPB.FN := Fn;
BIOSPB.A := A;
BIOSPB.BC := BC;
BIOSPB.DE := DE;
BIOSPB.HL := HL;
BiosFunc := bdos(50, addr(BIOSPB))
end;
procedure BiosX (Fn, Ax : byte; BCx, DEx, HLx : integer);
begin
inline
(
$3A/Fn/ { ld a,(Fn) }
$4F/ { ld c,a }
$87/ { add a,a }
$81/ { add a,c }
$06/$00/ { ld b,0 }
$4F/ { ld c,a }
$2A/$01/$00/ { ld hl,(0001h) }
$09/ { add hl,bc }
$22/* + 17/ { ld (zzzz),hl }
$3A/Ax/ { ld a,(Ax) }
$ED/$4B/BCx/ { ld bc,(BCx) }
$ED/$5B/DEx/ { ld de,(DEx) }
$2A/HLx/ { ld hl,(HLx) }
$CD/$00/$00 { call zzzz }
)
end;
procedure GetBIOSdata (AdrSor, AdrDst, Amount : integer);
begin
BiosX(28, 0, $0100, 0, 0); { set xmove banks, bank #0 to bank #1 }
BiosX(24, 0, Amount, AdrSor, AdrDst) { move memory }
end;
function GetBIOSword (AdrSor : integer) : integer;
const
WrdDst : integer = 0;
begin
GetBIOSdata(AdrSor, addr(WrdDst), 2);
GetBIOSword := WrdDst
end;
function GetBIOSbyte (AdrSor : integer) : byte;
const
BytDst : byte = 0;
begin
GetBIOSdata(AdrSor, addr(BytDst), 1);
GetBIOSbyte := BytDst
end;
FUNCTION LoadSystemFile (VAR FleRec : integer) : boolean;
VAR
Error : integer;
F : FILE;
BEGIN
assign(F, 'CPMLDR.SYS');
FleRec := 0;
{$I-}
reset(F);
Error := ioresult;
{$I+}
IF Error = 0 THEN
BEGIN
IF NOT eof(F) THEN
BEGIN
WHILE NOT eof(F) AND (FleRec <= MAXBUF) AND (Error = 0) DO
BEGIN
{$I-}
blockread(F, FleBuf[FleRec, 0], 1);
Error := ioresult;
{$I+}
FleRec := FleRec + 1
END;
close(F);
IF Error <> 0 THEN
writeln('Error reading CPMLDR.SYS')
ELSE
IF NOT eof(F) THEN
BEGIN
writeln('Error, CPMLDR.SYS to big too load');
Error := 1
END
ELSE
BEGIN
IF (FleBuf[0,3] <> $55) AND (FleBuf[0,4] <> $AA) THEN
BEGIN
writeln('Error, not the correct file');
Error := 1
END
END
END
ELSE
BEGIN
writeln('Error, CPMLDR.SYS is an empty file');
Error := 1
END
END
ELSE
writeln('CPMLDR.SYS not found');
LoadSystemFile := Error = 0
END;
PROCEDURE WriteLoaderFile ( FleRec : integer;
SecTrk : integer;
SecCnt : integer;
BufOff : integer;
VAR Error : integer);
VAR
Track, Sector, BufPos : integer;
BEGIN
BiosCall(9, 0, DrvCde, 1, 0);
writeln('Placing CPMLDR.SYS onto systems tracks of drive ',
chr(DrvCde + ord('A')), ':');
BufPos := 0;
Sector := 1;
Track := 0;
REPEAT
IF Sector > SecTrk THEN
BEGIN
Track := Track + 1;
Sector := 1
END;
BiosCall(10, 0, Track, 0, 0); { set physical track }
BiosCall(11, 0, Sector, 0, 0); { set physical sector }
BiosCall(12, 0, addr(FleBuf[BufPos, 0]), 0, 0); { set DMA address }
BiosCall(28, 1, 0, 0, 0); { set data bank #1 (TPA) }
Error := BiosFunc(14, 0, 0, 0, 0); { write 1 sector }
BufPos := BufPos + BufOff;
Sector := Sector + 1;
SecCnt := SecCnt - 1
UNTIL (SecCnt = 0) OR (Error <> 0);
IF Error > 0 THEN
writeln('Error writing system tracks')
END;
PROCEDURE VerifyLoaderTracks ( FleRec : integer;
SecTrk : integer;
SecCnt : integer;
VAR Error : integer);
VAR
Track, Sector : integer;
BEGIN
writeln('Verifying...');
Sector := 1;
Track := 0;
REPEAT
IF Sector > SecTrk THEN
BEGIN
Track := Track + 1;
Sector := 1
END;
BiosCall(10, 0, Track, 0, 0); { set physical track }
BiosCall(11, 0, Sector, 0, 0); { set physical sector }
BiosCall(12, 0, addr(VerBuf), 0, 0); { set DMA address }
BiosCall(28, 1, 0, 0, 0); { set data bank #1 (TPA) }
Error := BiosFunc(13, 0, 0, 0, 0); { read 1 sector }
Sector := Sector + 1;
SecCnt := SecCnt - 1
UNTIL (SecCnt = 0) OR (Error <> 0);
IF Error > 0 THEN
writeln('Error, CRC error detected')
END;
PROCEDURE WriteSystemTracks (FleRec : integer;
SecTrk : integer;
SecCnt : integer;
BufOff : integer);
VAR
Error : integer;
BEGIN
WriteLoaderFile(FleRec, SecTrk, SecCnt, BufOff, Error);
IF Error = 0 THEN
VerifyLoaderTracks(FleRec, SecTrk, SecCnt, Error)
END;
PROCEDURE SetDskInf (DPH, XLT, DPB, PHM, SecTrk, TrkCnt : integer);
VAR
FleBse, ExeAdr, OffSet, SecLen : integer;
DPBPos, XLTPos : integer;
BEGIN
FleBse := addr(FleBuf); { base address of file buffer }
ExeAdr := mem[FleBse + 6] + mem[FleBse + 7] SHL 8; { code exec address }
OffSet := FleBse - ExeAdr;
SecLen := (PHM + 1) * 128; { calculate sector length }
DPBPos := (mem[FleBse + 10] + mem[FleBse + 11] SHL 8) + OffSet;
GetBIOSdata(DPB, DPBPos, 17);
XLTPos := (mem[FleBse + 12] + mem[FleBse + 13] SHL 8) + OffSet;
GetBIOSdata(XLT, XLTPos, 64);
mem[FleBse + 14] := lo(SecLen); { LSB of sector length }
mem[FleBse + 15] := hi(SecLen); { MSB of sector length }
mem[FleBse + 16] := SecTrk; { physical sectors/track }
mem[FleBse + 17] := GetBIOSbyte(DPH-2); { get UNIT byte from DPH }
mem[FleBse + 18] := TrkCnt; { tracks to be loaded }
mem[FleBse + 19] := BnkFlg { banked loader configuration flag }
END;
FUNCTION DestinationTracks ( FleRec : integer;
VAR SecTrk : integer;
VAR SecCnt : integer;
VAR BufOff : integer) : boolean;
VAR
TblAdr, TrkCnt, Error : integer;
DPH, XLT, DPB, SPT, PHM, OFF : integer;
BEGIN
Error := 0;
DrvCde := ord(DrvChr) - ord('A');
TblAdr := bioshl(21) + DrvCde * 2;
DPH := GetBIOSword(TblAdr);
IF DPH <> 0 THEN
BEGIN
XLT := GetBIOSword(DPH);
DPB := GetBIOSword(DPH+12);
SPT := GetBIOSword(DPB); { sectors/track }
OFF := GetBIOSword(DPB+13); { track offset }
PHM := GetBIOSbyte(DPB+16); { physical sector mask }
IF OFF = 0 THEN
BEGIN
writeln('Error, drive ', DrvChr, ': has no system tracks');
Error := 1
END
ELSE
BEGIN
IF FleRec > (SPT * OFF) THEN
BEGIN
writeln('Error, system too big for system tracks');
Error := 1
END
ELSE
BEGIN
SecTrk := SPT DIV (PHM + 1);
SecCnt := (FleRec + PHM) DIV (PHM + 1);
BufOff := PHM + 1;
TrkCnt := (FleRec + (SPT - 1)) DIV SPT;
SetDskInf(DPH, XLT, DPB, PHM, SecTrk, TrkCnt)
END
END
END
ELSE
BEGIN
writeln('Error, drive ', DrvChr, ': does not exist');
Error := 1
END;
DestinationTracks := Error = 0
END;
PROCEDURE PlaceLoader;
VAR
FleRec, SecTrk, SecCnt, BufOff : integer;
BEGIN
IF LoadSystemFile(FleRec) THEN
BEGIN
if DestinationTracks(FleRec, SecTrk, SecCnt, BufOff) then
WriteSystemTracks(FleRec, SecTrk, SecCnt, BufOff)
END
END;
FUNCTION ParmCount (VAR Parameters : String80) : integer;
VAR
Index, PrmCnt, PrmLen : integer;
BEGIN
Index := 1;
PrmCnt := 0;
PrmLen := length(Parameters);
WHILE Index <= PrmLen DO
BEGIN
WHILE (Index <= PrmLen) AND (Parameters[Index] = ' ') DO
Index := Index + 1;
IF Index <= PrmLen
THEN
PrmCnt := PrmCnt + 1;
WHILE (Index <= PrmLen) AND (Parameters[Index] <> ' ') DO
Index := Index + 1
END;
ParmCount := PrmCnt
END;
PROCEDURE RetParmStr ( PrmNmb : integer;
VAR Parameters : String80;
VAR PrmStr : String80);
VAR
Index, PrmCnt, PrmLen : integer;
BEGIN
Index := 1;
PrmCnt := 0;
PrmLen := length(Parameters);
WHILE (Index <= PrmLen) AND (PrmCnt < PrmNmb) DO
BEGIN
PrmStr := '';
WHILE (Index <= PrmLen) AND (Parameters[Index] = ' ') DO
Index := Index + 1;
IF Index <= PrmLen
THEN
PrmCnt := PrmCnt + 1;
WHILE (Index <= PrmLen) AND (Parameters[Index] <> ' ') DO
BEGIN
PrmStr := concat(PrmStr, Parameters[Index]);
Index := Index + 1
END
END
END;
FUNCTION ExtractParameters : boolean;
VAR
PrmStr : String80;
Error : boolean;
BEGIN
Error := ParmCount(Parameters) <> 2;
IF NOT Error THEN
BEGIN
RetParmStr(1, Parameters, PrmStr);
PrmStr[1] := upcase(PrmStr[1]);
Error := (PrmStr <> 'B') and (PrmStr <> 'N');
IF NOT Error THEN
BEGIN
IF PrmStr = 'B' THEN
BnkFlg := $ff
ELSE
BnkFlg := $00;
RetParmStr(2, Parameters, PrmStr);
PrmStr[1] := upcase(PrmStr[1]);
Error := length(PrmStr) > 2;
IF NOT Error AND (length(PrmStr) = 2) THEN
Error := PrmStr[2] <> ':';
DrvChr := PrmStr[1]
END
END;
ExtractParameters := Error = false
END;
procedure ShowUsage;
begin
writeln;
writeln('PUTLDR v1.00 (c) Copyright S.J.Kay 18th April 1995');
writeln;
writeln('Places CPMLDR.SYS file on disk system tracks');
writeln;
writeln('Use:- putldr x d:');
writeln;
writeln(' x = B for a banked loader configuration');
writeln(' x = N for a non banked loader configuration');
writeln('d: = destination drive')
end;
begin
Parameters := ComLne;
Version := bdoshl(12);
if (hi(Version) = $00) and (lo(Version) >= $30) then
begin
if ExtractParameters then
PlaceLoader
else
ShowUsage
end
else
begin
writeln;
writeln('Wrong SYSTEM, requires CP/M Plus ver 3.0 up')
end
end.

BIN
CONTRIBUTIONS/z80em86/support/reset.com Normal file
View File

Binary file not shown.

60
CONTRIBUTIONS/z80em86/support/reset.mac Normal file
View File

@@ -0,0 +1,60 @@
;**************************************************************************
;* *
;* RESET v1.00 (c) Copyright S.J.Kay 26th April 1995 *
;* *
;* Puts Z80 Emulator into bootup mode and sets user byte to determine *
;* which CP/M 3 system CPMLDR.SYS will load. *
;* *
;**************************************************************************
maclib TPORTS.LIB
;
.z80
aseg
;
bdos equ 0005h
;
org 0100h
.phase 0100h
;
ld hl,0080h ;parameter address
ld c,(hl)
inc hl
chkchr: ld a,c ;characters to check
or a
jp z,reset
ld a,(hl) ;get a character
dec c
inc hl
cp ' ' ;ignore any leading spaces
jp z,chkchr
ld b,2 ;use banked CP/M 3 system
cp 'B' ;banked CP/M 3 system ?
jp z,setsys
dec b ;use non banked CP/M 3 system
cp 'N' ;non banked CP/M 3 system ?
jp z,setsys
dec b ;use default CP/M 3 system
cp 'D' ;default CP/M 3 system ?
jp nz,prmerr
setsys: ld hl,0 ;access user byte number 0
ld a,b
ld c,0ffh ;set user byte function
out (usrbyt),a ;set user byte
reset: out (rstz80),a ;reset the Z80 Emulator
prmerr: ld de,errmsg
ld c,09h ;BDOS print string function
jp bdos
;
errmsg: db 0dh, 0ah
db 'RESET v1.00 (c) Copyright S.J.Kay 26th April 1995'
db 0dh, 0ah, 0ah
db 'Use:-', 0dh, 0ah
db 'reset n -boots up Non banked CP/M 3', 0dh, 0ah
db 'reset b -boots up Banked CP/M 3', 0dh, 0ah
db 'reset d -boots up Default system', 0dh, 0ah
db 'reset -boots up same system', 0dh, 0ah
db '$'
;
.dephase
end

BIN
CONTRIBUTIONS/z80em86/support/setdrive.com Normal file
View File

Binary file not shown.

326
CONTRIBUTIONS/z80em86/support/setdrive.pas Normal file
View File

@@ -0,0 +1,326 @@
(*************************************************************************)
(* *)
(* SETDRIVE v1.00 (c) Copyright S.J.Kay 7th April 1995 *)
(* *)
(* Support utility for IBM Z80 Emulator CP/M 3 to allow setting *)
(* floppy drives to different CP/M formats *)
(* *)
(*************************************************************************)
{$I SETDRV.INC }
FUNCTION Log2 (X : integer): integer;
VAR
Y : integer;
BEGIN
Y := 0;
WHILE X > 1 DO
BEGIN
X := X DIV 2;
Y := Y + 1
END;
Log2 := Y
END;
FUNCTION ALV01 (Blocks : integer): integer;
VAR
X, BitPos : integer;
BEGIN
X := 1024 * 32;
BitPos := 0;
WHILE Blocks > 0 DO
BEGIN
BitPos := BitPos + X;
X := X shr 1;
Blocks := Blocks - 1
END;
ALV01 := BitPos
END;
PROCEDURE SetDPBData;
VAR
SPT, BSH, BLM, EXM, DSM, DRM, ALV, CKS, OFF, PSH, PHM : integer;
BEGIN
SPT := (DPBM[0] DIV 128) * DPBM[1];
DPBD[0] := lo(SPT);
DPBD[1] := hi(SPT);
BSH := Log2(DPBM[3] DIV 128);
DPBD[2] := BSH;
BLM := DPBM[3] DIV 128 - 1;
DPBD[3] := BLM;
DSM := (SPT * (DPBM[2] - DPBM[5])) DIV (BLM + 1) - 1;
EXM := DPBM[3] DIV ((ord(DSM > 255) + 1) * 1024) - 1;
DPBD[4] := EXM;
DPBD[5] := lo(DSM);
DPBD[6] := hi(DSM);
DRM := DPBM[4] - 1;
DPBD[7] := lo(DRM);
DPBD[8] := hi(DRM);
ALV := ALV01((DPBM[4] * 32 + (DPBM[3] - 32)) DIV DPBM[3]);
DPBD[9] := hi(ALV);
DPBD[10] := lo(ALV);
CKS := DPBM[4] DIV 4;
DPBD[11] := lo(CKS);
DPBD[12] := hi(CKS);
OFF := DPBM[5];
DPBD[13] := lo(OFF);
DPBD[14] := hi(OFF);
PSH := Log2(DPBM[0] DIV 128);
DPBD[15] := PSH;
PHM := DPBM[0] DIV 128 - 1;
DPBD[16] := PHM
END;
PROCEDURE DiskDPBLabel (VAR Data : String255;
VAR X : integer;
VAR Result : integer);
VAR
InpDat : String10;
Count, Number, L : integer;
BEGIN
L := length(Data);
Count := 0;
WHILE (Result = 0) AND (Count < 6) DO
BEGIN
ExtractData(Data, InpDat, X, L);
IF InpDat = '' THEN
Result := 255
ELSE
val(InpDat, Number, Result);
DPBM[Count] := Number;
Count := Count + 1
END;
SetDPBData
END;
PROCEDURE MakeSkewData (VAR Data : String255;
VAR X : integer;
VAR Result : integer);
VAR
UseSec : ARRAY [0..255] OF boolean;
FstSkw, SkwFac, FstPhy, TotSec : byte;
EndSec, NxtSec, Number, Count, SF, L : integer;
InpDat : String10;
BEGIN
L := length(Data);
Count := 0;
WHILE (Result = 0) AND (Count < 3) DO
BEGIN
ExtractData(Data, InpDat, X, L);
IF InpDat = '' THEN
Result := 255
ELSE
val(InpDat, Number, Result);
IF Result = 0 THEN
CASE Count OF
0 : SkwFac := Number;
1 : FstSkw := Number;
2 : FstPhy := Number
END;
Count := Count + 1
END;
TotSec := DPBM[1];
IF Result = 0 THEN
BEGIN
FOR Count := 0 TO 255 DO
UseSec[Count] := false;
Count := 1;
EndSec := FstPhy + (TotSec - 1);
NxtSec := FstSkw;
UseSec[FstSkw] := true;
SKWD[0] := FstSkw;
WHILE (Count < TotSec) AND (Result = 0) DO
BEGIN
SF := SkwFac;
WHILE SF > 0 DO
BEGIN
NxtSec := NxtSec + 1;
IF NxtSec > EndSec THEN
NxtSec := FstPhy;
SF := SF - 1
END;
WHILE UseSec[NxtSec] DO
NxtSec := NxtSec + 1;
UseSec[NxtSec] := true;
SKWD[Count] := NxtSec;
Count := Count + 1
END
END
ELSE
writeln('Error in skew definition')
END;
PROCEDURE ExtractSkewData (VAR Data : String255;
VAR X : integer;
VAR Result : integer);
VAR
InpDat : String10;
LabNme : String16;
Count : integer;
Number : integer;
L : integer;
BEGIN
L := length(Data);
Count := 0;
WHILE (Result = 0) AND (Count < DPBM[1]) DO
BEGIN
ExtractData(Data, InpDat, X, L);
IF InpDat = '' THEN
BEGIN
FindLabel(Data, LabNme, X, L, Result);
IF LabNme <> 'SKD' THEN
Result := 255
ELSE
L := length(Data)
END
ELSE
BEGIN
val(InpDat, Number, Result);
IF Result = 0 THEN
SKWD[Count] := Number;
Count := Count + 1
END
END
END;
PROCEDURE ReadFormat (VAR LabNme : String16;
VAR Result : integer);
VAR
Data : String255;
FulNme : String255;
C : integer;
X : integer;
L : integer;
BEGIN
C := 0;
REPEAT
FindLabel(Data, LabNme, X, L, Result);
IF Result = 0 THEN
CASE C OF
0 : BEGIN
Result := ord(LabNme <> 'NME');
IF Result = 0 THEN
StrgData(Data, DskNme, X, L, false);
END;
1 : BEGIN
Result := ord(LabNme <> 'DSK');
IF Result = 0 THEN
DiskHardwareLabel(Data, X, Result)
END;
2 : BEGIN
Result := ord(LabNme <> 'FMT');
{ ignore this label }
END;
3 : BEGIN
Result := ord(LabNme <> 'DPB');
IF Result = 0 THEN
DiskDPBLabel(Data, X, Result)
END;
4 : BEGIN
Result := ord((LabNme <> 'SKW') AND (LabNme <> 'SKD'));
IF Result = 0 THEN
IF LabNme = 'SKW' THEN
MakeSkewData(Data, X, Result)
ELSE
ExtractSkewData(Data, X, Result)
END
END;
C := C + 1
UNTIL (Result > 0) OR (C > 4)
END;
PROCEDURE FindKeyName (VAR Result : integer);
VAR
LabNme : String16;
Data : String255;
KeyNme : String255;
KeyFnd : boolean;
X : integer;
L : integer;
BEGIN
KeyFnd := false;
WHILE NOT (KeyFnd) AND (Result = 0) DO
BEGIN
LabNme := '';
WHILE (LabNme <> 'KEY') AND (Result = 0) DO
FindLabel(Data, LabNme, X, L, Result);
IF LabNme = 'KEY' THEN
BEGIN
StrgData(Data, KeyNme, X, L, true);
KeyFnd := KeyNme = ComLne
END
END;
IF NOT KeyFnd THEN
writeln('Error, Disk key not found')
END;
PROCEDURE InstallData;
BEGIN
DPB := GetBIOSword(DPH+12);
XLT := GetBIOSword(DPH);
PutBIOSdata(addr(DPBD), DPB, 17);
PutBIOSdata(addr(SKWD), XLT, 50);
PutBIOSbyte(DPH-2, RDRV);
writeln('Drive ', chr(DrvCde + ord('A')), ': ', DskNme);
bdos(13) { reset drives }
END;
PROCEDURE SetDrive;
VAR
Result : integer;
LabNme : String16;
BEGIN
Result := 0;
IF NOT OpenDataFile('CPMDPB.DAT') THEN
writeln('Error, CP/M disk data file not found')
ELSE
BEGIN
FindKeyName(Result);
IF Result = 0 THEN
BEGIN
LabNme := '';
WHILE Result = 0 DO
ReadFormat(LabNme, Result);
CloseDataFile;
InstallData
END
END
END;
BEGIN
ComLne := CpmComLne;
WHILE pos(' ', ComLne) = 1 do
delete(ComLne, 1, 1);
IF (pos(':', ComLne) = 2) THEN
BEGIN
DrvCde := ord(ComLne[1]) - ord('A');
DrvTbl := bioshl(21) + (DrvCde * 2);
DPH := mem[DrvTbl + 1] SHL 8 + mem[DrvTbl];
IF (DPH <> 0) AND (DrvCde IN [0..1]) THEN
BEGIN
delete(ComLne, 1, 2);
WHILE pos(' ', ComLne) = 1 do
delete(ComLne, 1, 1);
SetDrive
END
ELSE
writeln('Error, drive specified not supported')
END
ELSE
BEGIN
writeln('SETDRIVE v1.00 (c) Copyright S.J.Kay 7th April 1995');
writeln;
writeln('Use the format:- SETDRIVE D: DISKNAME')
END
END.

273
CONTRIBUTIONS/z80em86/support/setdrv.inc Normal file
View File

@@ -0,0 +1,273 @@
(*************************************************************************)
(* *)
(* SETDRIVE v1.00 (c) Copyright S.J.Kay 7th April 1995 *)
(* *)
(* Support utility for IBM Z80 Emulator CP/M 3 to allow setting *)
(* floppy drives to different CP/M formats *)
(* *)
(*************************************************************************)
TYPE
String10 = STRING[10];
String16 = STRING[16];
String80 = STRING[80];
String255 = STRING[255];
VAR
F : TEXT;
CpmComLne : String80 ABSOLUTE $0080;
ComLne : String80;
DskNme : String255;
DPH : integer;
DPB : integer;
XLT : integer;
DrvTbl : integer;
DrvCde : byte;
RDRV : byte;
DPBM : ARRAY [0..5] OF integer;
DPBD : ARRAY [0..16] OF byte;
SKWD : ARRAY [0..255] OF byte;
procedure BiosX (Fn, Ax : byte; BCx, DEx, HLx : integer);
begin
inline
(
$3A/Fn/ { ld a,(Fn) }
$4F/ { ld c,a }
$87/ { add a,a }
$81/ { add a,c }
$06/$00/ { ld b,0 }
$4F/ { ld c,a }
$2A/$01/$00/ { ld hl,(0001h) }
$09/ { add hl,bc }
$22/* + 17/ { ld (zzzz),hl }
$3A/Ax/ { ld a,(Ax) }
$ED/$4B/BCx/ { ld bc,(BCx) }
$ED/$5B/DEx/ { ld de,(DEx) }
$2A/HLx/ { ld hl,(HLx) }
$CD/$00/$00 { call zzzz }
)
end;
procedure GetBIOSdata (AdrSor, AdrDst, Amount : integer);
begin
BiosX(28, 0, $0100, 0, 0); { set xmove banks, bank #0 to bank #1 }
BiosX(24, 0, Amount, AdrSor, AdrDst) { move memory }
end;
function GetBIOSword (AdrSor : integer) : integer;
const
WrdDst : integer = 0;
begin
GetBIOSdata(AdrSor, addr(WrdDst), 2);
GetBIOSword := WrdDst
end;
function GetBIOSbyte (AdrSor : integer) : byte;
const
BytDst : byte = 0;
begin
GetBIOSdata(AdrSor, addr(BytDst), 1);
GetBIOSbyte := BytDst
end;
procedure PutBIOSdata (AdrSor, AdrDst, Amount : integer);
begin
BiosX(28, 0, $0001, 0, 0); { set xmove banks, bank #1 to bank #0 }
BiosX(24, 0, Amount, AdrSor, AdrDst) { move memory }
end;
procedure PutBIOSword (AdrDst, WrdPut : integer);
const
WrdSor : integer = 0;
begin
WrdSor := WrdPut;
PutBIOSdata(addr(WrdSor), AdrDst, 2)
end;
procedure PutBIOSbyte (AdrDst : integer; BytPut : byte);
const
BytSor : byte = 0;
begin
BytSor := BytPut;
PutBIOSdata(addr(BytSor), AdrDst, 1)
end;
FUNCTION OpenDataFile (FleNme : String80) : boolean;
BEGIN
{$I-}
assign(F, FleNme);
reset(F);
OpenDataFile := ioresult = 0
{$I+}
END;
PROCEDURE CloseDataFile;
VAR
Dummy : integer;
BEGIN
{$I-}
close(F);
Dummy := ioresult
{$I+}
END;
FUNCTION ReadDataFile (VAR Data : String255) : integer;
BEGIN
ReadDataFile := ord(eof(F));
IF NOT eof(F) THEN
readln(F, Data)
END;
PROCEDURE ReadTextFile (VAR Data : String255;
VAR X : integer;
VAR L : integer;
VAR Result : integer);
BEGIN
Data := '';
WHILE (Data = '') AND (Result = 0) DO
BEGIN
Result := ReadDataFile(Data);
IF Data <> '' THEN
BEGIN
X := 1;
L := length(Data);
WHILE (X <= L) AND (Data[X] = ' ') DO
X := X + 1;
IF X > L THEN
Data := ''
ELSE
IF Data[X] = chr(39) THEN
Data := ''
END
END
END;
PROCEDURE StrgData (VAR Data : String255;
VAR RetStr : String255;
X : integer;
L : integer;
UpStr : boolean);
BEGIN
RetStr := '';
WHILE L > 0 DO
BEGIN
IF UpStr THEN
RetStr := RetStr + upcase(Data[X])
ELSE
RetStr := RetStr + Data[X];
X := X + 1;
L := L - 1
END
END;
PROCEDURE FindLabel (VAR Data : String255;
VAR LabNme : String16;
VAR X : integer;
VAR L : integer;
VAR Result : integer);
BEGIN
REPEAT
LabNme := '';
ReadTextFile(Data, X, L, Result);
IF Result = 0 THEN
BEGIN
WHILE (X <= L) AND (NOT (Data[X] IN [':', ' '])) DO
BEGIN
LabNme := LabNme + upcase(Data[X]);
X := X + 1
END;
X := X + 1;
WHILE (X <= L) AND (Data[X] = ' ') DO
X := X + 1;
L := (L + 1) - X
END
UNTIL (Result > 0) or (LabNme <> '')
END;
PROCEDURE ExtractData (VAR Data : String255;
VAR InpDat : String10;
VAR X : integer;
VAR L : integer);
BEGIN
InpDat := '';
WHILE (X <= L) AND (Data[X] = ' ') DO
X := X + 1;
IF (X <= L) AND (Data[X] = ',') THEN
X := X + 1;
WHILE (X <= L) AND (Data[X] = ' ') DO
X := X + 1;
WHILE (X <= L) AND (NOT(Data[X] IN [' ', ','])) DO
BEGIN
InpDat := concat(InpDat, upcase(Data[X]));
X := X + 1
END
END;
PROCEDURE DiskHardwareLabel (VAR Data : String255;
VAR X : integer;
VAR Result : integer);
VAR
InpDat : String10;
Count : integer;
L : integer;
BEGIN
L := length(Data);
Count := 0;
RDRV := 0;
WHILE (Result = 0) AND (Count < 3) DO
BEGIN
ExtractData(Data, InpDat, X, L);
CASE Count OF
0 : IF InpDat = 'SS' THEN
RDRV := $80
ELSE
IF InpDat = 'DS' THEN
RDRV := $40
ELSE
IF InpDat = 'UD' THEN
RDRV := 0
ELSE
Result := 255;
1 : IF InpDat = 'SD' THEN
BEGIN
{ ignore this value }
END
ELSE
IF InpDat = 'DD' THEN
BEGIN
{ ignore this value }
END
ELSE
Result := 255;
2 : IF InpDat = 'LO' THEN
BEGIN
{ ignore this value }
END
ELSE
IF InpDat = 'HI' THEN
BEGIN
{ ignore this value }
END
ELSE
Result := 255
END;
Count := Count + 1
END;
RDRV := RDRV + DrvCde AND $03
END;

BIN
CONTRIBUTIONS/z80em86/support/terminal.com Normal file
View File

Binary file not shown.

62
CONTRIBUTIONS/z80em86/support/terminal.pas Normal file
View File

@@ -0,0 +1,62 @@
(*************************************************************************)
(* *)
(* SIMPLE TERMINAL v1.00 (c) Copyright S.J.Kay 18th April 1995 *)
(* *)
(* Uses CP/M 3.0 AUXIN and AUXOUT routines *)
(* *)
(*************************************************************************)
{$C-} { turn off ^C and ^S checking }
var
ExtTrm : boolean;
function GetKey : char;
var
Key : char;
begin
read(kbd, Key);
if Key = ^@ then
begin
ExtTrm := (Key = ^@); { exit key ? }
GetKey := #0
end
else
GetKey := Key
end;
procedure Terminal;
var
Key, X : char;
begin
ExtTrm := false;
while not ExtTrm do
begin
while bios(17) <> 0 do { test if AUXIN has a character }
write(chr(bios(6)));
if keypressed then
begin
Key := GetKey;
if Key <> #0 then
if bios(18) <> 0 then
bios(5, ord(Key))
end
end;
writeln;
writeln;
writeln(' *** TERMINAL EXITED BY USER ***')
end;
begin
writeln('SIMPLE TERMINAL v1.00 (c) Copyright S.J.Kay 18th April 1995');
writeln;
writeln('Uses CP/M 3.0 AUXIN, AUXOUT, CONIN, CONOUT devices');
writeln('set these devices for appropriate values');
writeln;
writeln('Press ^@ key to exit to system');
writeln;
Terminal
end.

71
CONTRIBUTIONS/z80em86/support/tports.lib Normal file
View File

@@ -0,0 +1,71 @@
;**************************************************************************
;* IBM Z80 Emulator System Interfacing Functions for CP/M 3 *
;* *
;* Date : 26th April 1995 *
;* Programmer : S.J.Kay *
;* *
;**************************************************************************
;
kbd1in equ 000h ;keyboard #1 initialize
kbd1st equ 001h ;keyboard #1 status
kbd1ip equ 002h ;keyboard #1 input
;
kbd2in equ 010h ;keyboard #2 (STDIN) initialize
kbd2st equ 011h ;keyboard #2 (STDIN) status
kbd2ip equ 012h ;keyboard #2 (STDIN) input
;
crt1in equ 020h ;CRT #1 initialize
crt1st equ 021h ;CRT #1 status
crt1op equ 022h ;CRT #1 output
;
crt2in equ 030h ;CRT #2 (STDOUT) initialize
crt2st equ 031h ;CRT #2 (STDOUT) status
crt2op equ 032h ;CRT #2 (STDOUT) output
;
lptini equ 040h ;CEN initialize
lptsta equ 041h ;CEN status
lptout equ 042h ;CEN output
;
comini equ 050h ;COM initialize
comist equ 051h ;COM input status
cominp equ 052h ;COM input
comost equ 053h ;COM output status
comout equ 054h ;COM output
;
gettme equ 060h ;get time from system clock
settme equ 061h ;set time in system clock
getdte equ 062h ;get date from system clock
setdte equ 063h ;set date in system clock
;
rdflop equ 080h ;read floppy disk sector
wrflop equ 081h ;write floppy disk sector
rdhard equ 082h ;read HDD file disk sector
wrhard equ 083h ;write HDD file disk sector
gtboot equ 084h ;get boot drive
gthard equ 085h ;get HDD file drive
flhard equ 086h ;flush HDD file data
;
blkcnt equ 090h ;return count of blocks available
blkget equ 091h ;get 128 bytes from storage
blkput equ 092h ;put 128 bytes into storage
blkfil equ 093h ;fill 128 bytes in storage with value
;
gtzseg equ 0a0h ;return current Z80 memory map segment
intfnc equ 0a1h ;interface to 8086 software interrupts
;
bnkuse equ 0f0h ;selects banked system and bank size
bnksel equ 0f1h ;select bank #0, #1
bnkmve equ 0f2h ;memory move (use bnkdta 1st if interbank)
bnkdta equ 0f3h ;select banks for interbank memory move
bnkdma equ 0f4h ;sets bank for DMA access
;
prmsta equ 0f8h ;return status of any Z80 Emulator parameters
prmget equ 0f9h ;return Z80 Emulator parameters address
vidsta equ 0fah ;return status of video output
vidset equ 0fbh ;turn video system on/off
usrbyt equ 0fch ;get/set user byte in emulator
failed equ 0fdh ;boot strap failure
rstz80 equ 0feh ;reset the Z80 emulator
extemu equ 0ffh ;exit the Z80 Emulator
;
; end of file

BIN
CONTRIBUTIONS/z80em86/support/video.com Normal file
View File

Binary file not shown.

40
CONTRIBUTIONS/z80em86/support/video.mac Normal file
View File

@@ -0,0 +1,40 @@
;**************************************************************************
;* *
;* VIDEO v1.00 turns video ON or OFF S.J.Kay 22/04/95 *
;* *
;* Support utility for CP/M 3 *
;* *
;**************************************************************************
maclib TPORTS.LIB
;
.z80
aseg
;
org 0100h
.phase 0100h
;
ld b,0 ;video on value
ld hl,0080h ;parameter address
ld c,(hl)
inc hl
chkchr: ld a,c ;characters to check
or a
jp z,video1
ld a,(hl) ;get a character
dec c
inc hl
cp ' ' ;ignore any leading spaces
jp z,chkchr
cp 'O' ;1st character must be 'O'
jp nz,video1
ld a,(hl) ;2nd character
cp 'F' ;video off if 2nd char is 'F'
jp nz,video1
dec b ;video off value
video1: ld a,b
out (vidset),a ;turn video on/off
ret
;
.dephase
end