eaw/tranZPUter
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

Updates

Browse Source
This commit is contained in:
Philip Smart
2021-03-17 16:12:28 +00:00
parent f72a4e6be6
commit f24d635fb9
218 changed files with 1633 additions and 84321 deletions
Download Patch File Download Diff File Expand all files Collapse all files

63
CPLD/SW/build/tranZPUterSW_constraints.sdc
View File

@@ -169,6 +169,69 @@ set_false_path -from [get_clocks {SYSCLK}] -to [get_clocks {INCLK}]
#**************************************************************
# Set Multicycle Path
#**************************************************************
set_multicycle_path -from {cpld512:cpldl512TopLevel|MAP_0000_0FFF_ROM} -to {cpld512:cpldl512TopLevel|CTLCLK_Q} -setup -end 2
set_multicycle_path -from {cpld512:cpldl512TopLevel|MAP_E000_EFFF_ROM} -to {cpld512:cpldl512TopLevel|CTLCLK_Q} -setup -end 2
#set_multicycle_path -from {cpld512:cpldl512TopLevel|MAP_F000_FFFF_ROM} -to {cpld512:cpldl512TopLevel|CTLCLK_Q} -setup -end 2
set_multicycle_path -from {cpld512:cpldl512TopLevel|MAP_1000_1FFF_CGROM} -to {cpld512:cpldl512TopLevel|CTLCLK_Q} -setup -end 2
set_multicycle_path -from {cpld512:cpldl512TopLevel|MAP_0000_0FFF_DRAM} -to {cpld512:cpldl512TopLevel|CTLCLK_Q} -setup -end 2
set_multicycle_path -from {cpld512:cpldl512TopLevel|MAP_1000_1FFF_DRAM} -to {cpld512:cpldl512TopLevel|CTLCLK_Q} -setup -end 2
#set_multicycle_path -from {cpld512:cpldl512TopLevel|MAP_2000_2FFF_DRAM} -to {cpld512:cpldl512TopLevel|CTLCLK_Q} -setup -end 2
#set_multicycle_path -from {cpld512:cpldl512TopLevel|MAP_3000_3FFF_DRAM} -to {cpld512:cpldl512TopLevel|CTLCLK_Q} -setup -end 2
#set_multicycle_path -from {cpld512:cpldl512TopLevel|MAP_4000_4FFF_DRAM} -to {cpld512:cpldl512TopLevel|CTLCLK_Q} -setup -end 2
#set_multicycle_path -from {cpld512:cpldl512TopLevel|MAP_5000_5FFF_DRAM} -to {cpld512:cpldl512TopLevel|CTLCLK_Q} -setup -end 2
#set_multicycle_path -from {cpld512:cpldl512TopLevel|MAP_6000_6FFF_DRAM} -to {cpld512:cpldl512TopLevel|CTLCLK_Q} -setup -end 2
#set_multicycle_path -from {cpld512:cpldl512TopLevel|MAP_7000_7FFF_DRAM} -to {cpld512:cpldl512TopLevel|CTLCLK_Q} -setup -end 2
set_multicycle_path -from {cpld512:cpldl512TopLevel|MAP_8000_8FFF_DRAM} -to {cpld512:cpldl512TopLevel|CTLCLK_Q} -setup -end 2
set_multicycle_path -from {cpld512:cpldl512TopLevel|MAP_9000_9FFF_DRAM} -to {cpld512:cpldl512TopLevel|CTLCLK_Q} -setup -end 2
set_multicycle_path -from {cpld512:cpldl512TopLevel|MAP_A000_AFFF_DRAM} -to {cpld512:cpldl512TopLevel|CTLCLK_Q} -setup -end 2
#set_multicycle_path -from {cpld512:cpldl512TopLevel|MAP_B000_BFFF_DRAM} -to {cpld512:cpldl512TopLevel|CTLCLK_Q} -setup -end 2
set_multicycle_path -from {cpld512:cpldl512TopLevel|MAP_C000_CFFF_DRAM} -to {cpld512:cpldl512TopLevel|CTLCLK_Q} -setup -end 2
set_multicycle_path -from {cpld512:cpldl512TopLevel|MAP_D000_DFFF_DRAM} -to {cpld512:cpldl512TopLevel|CTLCLK_Q} -setup -end 2
set_multicycle_path -from {cpld512:cpldl512TopLevel|MAP_E000_EFFF_DRAM} -to {cpld512:cpldl512TopLevel|CTLCLK_Q} -setup -end 2
#set_multicycle_path -from {cpld512:cpldl512TopLevel|MAP_F000_FFFF_DRAM} -to {cpld512:cpldl512TopLevel|CTLCLK_Q} -setup -end 2
set_multicycle_path -from {cpld512:cpldl512TopLevel|MAP_8000_8FFF_VRAM} -to {cpld512:cpldl512TopLevel|CTLCLK_Q} -setup -end 2
#set_multicycle_path -from {cpld512:cpldl512TopLevel|MAP_9000_9FFF_VRAM} -to {cpld512:cpldl512TopLevel|CTLCLK_Q} -setup -end 2
set_multicycle_path -from {cpld512:cpldl512TopLevel|MAP_A000_AFFF_VRAM} -to {cpld512:cpldl512TopLevel|CTLCLK_Q} -setup -end 2
#set_multicycle_path -from {cpld512:cpldl512TopLevel|MAP_B000_BFFF_VRAM} -to {cpld512:cpldl512TopLevel|CTLCLK_Q} -setup -end 2
set_multicycle_path -from {cpld512:cpldl512TopLevel|MAP_C000_CFFF_VRAM} -to {cpld512:cpldl512TopLevel|CTLCLK_Q} -setup -end 2
set_multicycle_path -from {cpld512:cpldl512TopLevel|MAP_D000_DFFF_VRAM} -to {cpld512:cpldl512TopLevel|CTLCLK_Q} -setup -end 2
set_multicycle_path -from {cpld512:cpldl512TopLevel|MAP_E000_E00F_IO} -to {cpld512:cpldl512TopLevel|CTLCLK_Q} -setup -end 2
set_multicycle_path -from {cpld512:cpldl512TopLevel|MAP_INHIBIT} -to {cpld512:cpldl512TopLevel|CTLCLK_Q} -setup -end 2
set_multicycle_path -from {cpld512:cpldl512TopLevel|MAP_TZFS_BANK} -to {cpld512:cpldl512TopLevel|CTLCLK_Q} -setup -end 2
#set_multicycle_path -from {cpld512:cpldl512TopLevel|MODE_320x200} -to {cpld512:cpldl512TopLevel|CTLCLK_Q} -setup -end 2
set_multicycle_path -from {cpld512:cpldl512TopLevel|MODE_640x200} -to {cpld512:cpldl512TopLevel|CTLCLK_Q} -setup -end 2
set_multicycle_path -from {cpld512:cpldl512TopLevel|MAP_0000_0FFF_ROM} -to {cpld512:cpldl512TopLevel|CTLCLK_Q} -hold -end 1
set_multicycle_path -from {cpld512:cpldl512TopLevel|MAP_E000_EFFF_ROM} -to {cpld512:cpldl512TopLevel|CTLCLK_Q} -hold -end 1
#set_multicycle_path -from {cpld512:cpldl512TopLevel|MAP_F000_FFFF_ROM} -to {cpld512:cpldl512TopLevel|CTLCLK_Q} -hold -end 1
set_multicycle_path -from {cpld512:cpldl512TopLevel|MAP_1000_1FFF_CGROM} -to {cpld512:cpldl512TopLevel|CTLCLK_Q} -hold -end 1
set_multicycle_path -from {cpld512:cpldl512TopLevel|MAP_0000_0FFF_DRAM} -to {cpld512:cpldl512TopLevel|CTLCLK_Q} -hold -end 1
set_multicycle_path -from {cpld512:cpldl512TopLevel|MAP_1000_1FFF_DRAM} -to {cpld512:cpldl512TopLevel|CTLCLK_Q} -hold -end 1
#set_multicycle_path -from {cpld512:cpldl512TopLevel|MAP_2000_2FFF_DRAM} -to {cpld512:cpldl512TopLevel|CTLCLK_Q} -hold -end 1
#set_multicycle_path -from {cpld512:cpldl512TopLevel|MAP_3000_3FFF_DRAM} -to {cpld512:cpldl512TopLevel|CTLCLK_Q} -hold -end 1
#set_multicycle_path -from {cpld512:cpldl512TopLevel|MAP_4000_4FFF_DRAM} -to {cpld512:cpldl512TopLevel|CTLCLK_Q} -hold -end 1
#set_multicycle_path -from {cpld512:cpldl512TopLevel|MAP_5000_5FFF_DRAM} -to {cpld512:cpldl512TopLevel|CTLCLK_Q} -hold -end 1
#set_multicycle_path -from {cpld512:cpldl512TopLevel|MAP_6000_6FFF_DRAM} -to {cpld512:cpldl512TopLevel|CTLCLK_Q} -hold -end 1
#set_multicycle_path -from {cpld512:cpldl512TopLevel|MAP_7000_7FFF_DRAM} -to {cpld512:cpldl512TopLevel|CTLCLK_Q} -hold -end 1
set_multicycle_path -from {cpld512:cpldl512TopLevel|MAP_8000_8FFF_DRAM} -to {cpld512:cpldl512TopLevel|CTLCLK_Q} -hold -end 1
set_multicycle_path -from {cpld512:cpldl512TopLevel|MAP_9000_9FFF_DRAM} -to {cpld512:cpldl512TopLevel|CTLCLK_Q} -hold -end 1
set_multicycle_path -from {cpld512:cpldl512TopLevel|MAP_A000_AFFF_DRAM} -to {cpld512:cpldl512TopLevel|CTLCLK_Q} -hold -end 1
#set_multicycle_path -from {cpld512:cpldl512TopLevel|MAP_B000_BFFF_DRAM} -to {cpld512:cpldl512TopLevel|CTLCLK_Q} -hold -end 1
set_multicycle_path -from {cpld512:cpldl512TopLevel|MAP_C000_CFFF_DRAM} -to {cpld512:cpldl512TopLevel|CTLCLK_Q} -hold -end 1
set_multicycle_path -from {cpld512:cpldl512TopLevel|MAP_D000_DFFF_DRAM} -to {cpld512:cpldl512TopLevel|CTLCLK_Q} -hold -end 1
set_multicycle_path -from {cpld512:cpldl512TopLevel|MAP_E000_EFFF_DRAM} -to {cpld512:cpldl512TopLevel|CTLCLK_Q} -hold -end 1
#set_multicycle_path -from {cpld512:cpldl512TopLevel|MAP_F000_FFFF_DRAM} -to {cpld512:cpldl512TopLevel|CTLCLK_Q} -hold -end 1
set_multicycle_path -from {cpld512:cpldl512TopLevel|MAP_8000_8FFF_VRAM} -to {cpld512:cpldl512TopLevel|CTLCLK_Q} -hold -end 1
#set_multicycle_path -from {cpld512:cpldl512TopLevel|MAP_9000_9FFF_VRAM} -to {cpld512:cpldl512TopLevel|CTLCLK_Q} -hold -end 1
set_multicycle_path -from {cpld512:cpldl512TopLevel|MAP_A000_AFFF_VRAM} -to {cpld512:cpldl512TopLevel|CTLCLK_Q} -hold -end 1
#set_multicycle_path -from {cpld512:cpldl512TopLevel|MAP_B000_BFFF_VRAM} -to {cpld512:cpldl512TopLevel|CTLCLK_Q} -hold -end 1
set_multicycle_path -from {cpld512:cpldl512TopLevel|MAP_C000_CFFF_VRAM} -to {cpld512:cpldl512TopLevel|CTLCLK_Q} -hold -end 1
set_multicycle_path -from {cpld512:cpldl512TopLevel|MAP_D000_DFFF_VRAM} -to {cpld512:cpldl512TopLevel|CTLCLK_Q} -hold -end 1
set_multicycle_path -from {cpld512:cpldl512TopLevel|MAP_E000_E00F_IO} -to {cpld512:cpldl512TopLevel|CTLCLK_Q} -hold -end 1
set_multicycle_path -from {cpld512:cpldl512TopLevel|MAP_INHIBIT} -to {cpld512:cpldl512TopLevel|CTLCLK_Q} -hold -end 1
set_multicycle_path -from {cpld512:cpldl512TopLevel|MAP_TZFS_BANK} -to {cpld512:cpldl512TopLevel|CTLCLK_Q} -hold -end 1
#set_multicycle_path -from {cpld512:cpldl512TopLevel|MODE_320x200} -to {cpld512:cpldl512TopLevel|CTLCLK_Q} -hold -end 1
set_multicycle_path -from {cpld512:cpldl512TopLevel|MODE_640x200} -to {cpld512:cpldl512TopLevel|CTLCLK_Q} -hold -end 1
#**************************************************************

779
CPLD/SW/tranZPUterSW.vhd
View File

File diff suppressed because it is too large Load Diff

3
CPLD/SW/tranZPUterSW_pkg.vhd
View File

@@ -75,6 +75,7 @@ package tranZPUterSW_pkg is
constant TZMM_MZ700_2 : integer := 12; -- MZ700 Mode - 0000:0FFF is on the tranZPUter board in block 6, 1000:CFFF is on the tranZPUter board in block 0, D000:FFFF is on the tranZPUter in block 6.
constant TZMM_MZ700_3 : integer := 13; -- MZ700 Mode - 0000:0FFF is on the tranZPUter board in block 0, 1000:CFFF is on the tranZPUter board in block 0, D000:FFFF is inaccessible.
constant TZMM_MZ700_4 : integer := 14; -- MZ700 Mode - 0000:0FFF is on the tranZPUter board in block 6, 1000:CFFF is on the tranZPUter board in block 0, D000:FFFF is inaccessible.
constant TZMM_MZ800 : integer := 15; -- MZ800 Mode - Running on MZ800 hardware, configuration set according to MZ700/MZ800 mode.
constant TZMM_FPGA : integer := 21; -- Open up access for the K64F to the FPGA resources such as memory. All other access to RAM or mainboard is blocked.
constant TZMM_TZPUM : integer := 22; -- Everything in on mainboard, no access to tranZPUter memory.
constant TZMM_TZPU : integer := 23; -- Everything is in tranZPUter domain, no access to underlying Sharp mainboard unless memory management mode is switched. tranZPUter RAM 64K block 0 is selected.
@@ -97,7 +98,7 @@ package tranZPUterSW_pkg is
--constant CPLD_HOST_HW : integer := MODE_MZ80A;
-- Target video hardware.
constant CPLD_HAS_FPGA_VIDEO : std_logic := '1';
constant CPLD_HAS_FPGA_VIDEO : std_logic := '0';
-- Version of hdl.
constant CPLD_VERSION : integer := 1;

6
devices/sysbus/BRAM/TZSW_DualPortBootBRAM.vhd
View File

@@ -51403,7 +51403,7 @@ architecture arch of DualPortBootBRAM is
14920 => x"4f",
14921 => x"2a",
14922 => x"20",
14923 => x"36",
14923 => x"31",
14924 => x"2f",
14925 => x"31",
14926 => x"31",
@@ -69609,11 +69609,11 @@ architecture arch of DualPortBootBRAM is
14920 => x"7a",
14921 => x"2a",
14922 => x"73",
14923 => x"30",
14923 => x"31",
14924 => x"33",
14925 => x"32",
14926 => x"76",
14927 => x"66",
14927 => x"6b",
14928 => x"20",
14929 => x"2c",
14930 => x"76",

6
devices/sysbus/BRAM/TZSW_SinglePortBootBRAM.vhd
View File

@@ -51398,7 +51398,7 @@ architecture arch of SinglePortBootBRAM is
14920 => x"4f",
14921 => x"2a",
14922 => x"20",
14923 => x"36",
14923 => x"31",
14924 => x"2f",
14925 => x"31",
14926 => x"31",
@@ -69604,11 +69604,11 @@ architecture arch of SinglePortBootBRAM is
14920 => x"7a",
14921 => x"2a",
14922 => x"73",
14923 => x"30",
14923 => x"31",
14924 => x"33",
14925 => x"32",
14926 => x"76",
14927 => x"66",
14927 => x"6b",
14928 => x"20",
14929 => x"2c",
14930 => x"76",

BIN
software/CPM/ASM80/ASM80
View File

Binary file not shown.

BIN
software/CPM/ASM80/ASM80.EXE
View File

Binary file not shown.

BIN
software/CPM/ASM80/ASM80.OV0
View File

Binary file not shown.

BIN
software/CPM/ASM80/ASM80.OV1
View File

Binary file not shown.

BIN
software/CPM/ASM80/ASM80.OV2
View File

Binary file not shown.

BIN
software/CPM/ASM80/ASM80.OV3
View File

Binary file not shown.

BIN
software/CPM/ASM80/ASM80.OV4
View File

Binary file not shown.

BIN
software/CPM/ASM80/ASM80.OV5
View File

Binary file not shown.

BIN
software/CPM/ASM80/ASXREF
View File

Binary file not shown.

BIN
software/CPM/ASM80/CONV86
View File

Binary file not shown.

BIN
software/CPM/ASM80/FPAL.LIB
View File

Binary file not shown.

BIN
software/CPM/ASM80/HEXOBJ
View File

Binary file not shown.

59
software/CPM/ASM80/ISIS.DOC
View File

@@ -1,59 +0,0 @@
Instructions for ISIS environment V1.0
======================================
The ISIS environment is designed to allow 8080 based Intel tools to run on
an 8086 PCDOS based system. The ISIS environment does not support all ISIS
calls, but sufficient to run 8051 translators and utilities. (If the program
uses an unsupported ISIS call an error message is generated).
DOS instructions
----------------
Load the software(ISIS) onto the harddisk. If ISIS is installed in the DOS
search path it will be directly loadable by entering "ISIS".
Before entering ISIS, logical names must be set to match any ISIS disk drives
used by the ISIS tools. This includes :F0: - the ISIS environment does NOT
default to the current drive. As with 8080 ISIS, filenames without a drive
prefix are directed to :F0:.
C>SET :F0:=\ISIS /* make sure there is no <SPACE> before the "=" */
C>SET :F1:=\BITBUS
C>ISIS /* invoke ISIS emulator */
DOS ISIS Environment X003
=ASM51 :F1:SAMP1.A51 /* enter ISIS commands */
...
...
=EXIT /* return to DOS */
The ISIS environment will also run under DOS in batch mode
Command file (DEMO.CMD) contains:
ASM51 :F1:SAMP1.A51
ASM51 :F1:SAMP2.A51
ASM51 :F1:SAMP3.A51
RL51 :F1:SAMP1.OBJ, &
:F1:SAMP2.OBJ, &
:F1:SAMP3.OBJ TO :F1:SAMPLE
EXIT /* must include EXIT since all program
input must be in command file
otherwise DOS will wait forever */
To invoke the command file
C>ISIS < DEMO.CMD /* This could be part of a batch job */
<CTRL-C> or <CTRL-BREAK> will abort the ISIS environment. You will need to
enter <RETURN> also if the ISIS environment is at the prompt level. Also the
command "BREAK ON" should be included in the AUTOEXEC.BAT file to permit DOS
to recognise <CTRL-BREAK> all the time (not just when performing DOS calls).
Known Bugs/Problems: None

BIN
software/CPM/ASM80/ISIS.EXE
View File

Binary file not shown.

BIN
software/CPM/ASM80/IXREF
View File

Binary file not shown.

BIN
software/CPM/ASM80/LIB
View File

Binary file not shown.

BIN
software/CPM/ASM80/LINK
View File

Binary file not shown.

BIN
software/CPM/ASM80/LINK.OVL
View File

Binary file not shown.

BIN
software/CPM/ASM80/LOCATE
View File

Binary file not shown.

BIN
software/CPM/ASM80/OBJHEX
View File

Binary file not shown.

BIN
software/CPM/ASM80/PLM51.LIB
View File

Binary file not shown.

BIN
software/CPM/ASM80/PLM80.LIB
View File

Binary file not shown.

BIN
software/CPM/ASM80/SUBMIT
View File

Binary file not shown.

BIN
software/CPM/ASM80/SYSTEM.LIB
View File

Binary file not shown.

1
software/CPM/BLANKFD/BLANK_16M.RAW
View File

File diff suppressed because one or more lines are too long

1
software/CPM/BLANKFD/BLANK_1M44.RAW
View File

File diff suppressed because one or more lines are too long

1
software/CPM/BLANKFD/BLANK_240K.RAW
View File

File diff suppressed because one or more lines are too long

1
software/CPM/BLANKFD/BLANK_320K.RAW
View File

File diff suppressed because one or more lines are too long

1
software/CPM/BLANKFD/BLANK_720K.RAW
View File

File diff suppressed because one or more lines are too long

70
software/CPM/README_C6.TXT
View File

@@ -1,70 +0,0 @@
SYSLIB 2.4 Changes (from SYSLIB 2.1)
This disk contains new SYSLIB routines to upgrade from Version 2.1
through Version 2.3 to Version 2.4 (i.e., Version 2.2, 2.3, and 2.4
changes are on this disk).
XDIR III, Version 1.3 Vertical Listing by File Type and Name
Disk: C User: 0, File Attributes: Non-System
Filename.Typ Size K RS Filename.Typ Size K RS Filename.Typ Size K RS
-------- --- ------ -- -------- --- ------ -- -------- --- ------ --
SYSLIB .HLP 14 SCRC2 .MAC 4 SZGPINS .MAC 4
SYSLIB8 .HLP 8 SFNAME .MAC 6 SYSLIB .REL 14
SYSLIB9 .HLP 8 SMHL4HC .MAC 2 README .TXT 4
SYSLIBC .HLP 10 SVERSION.MAC 2 SYSLIB .WS 108
SCLINE .MAC 2 SZCPR .MAC 8 SYSLIBHD.WS 12
SCRC .MAC 4 SZFNAME .MAC 18 SYSLIBUG.WS 124
SCRC1 .MAC 4
19 Files Occupying 356K, 19 Files on Disk and 240K Free
The REL file is affected, of course: SYSLIB.REL
The source files affected are:
SCLINE.MAC <-- New
SCRC.MAC
SCRC1.MAC
SCRC2.MAC <-- New
SFNAME.MAC <-- Bug Fix
SMHL4HC.MAC <-- Bug Fix
SVERSION.MAC <-- Version Number Updated to 2.3
SZCPR.MAC <-- The ZCPR2 routines changed due to ZCPR2 changes
SZFNAME.MAC
SZGPINS.MAC
The following Help Files (HLP) are upgraded to reflect the changes:
SYSLIB.HLP <-- for SCRC, SCRC1, SCRC2
SYSLIB8.HLP <-- for SZFNAME
SYSLIB9.HLP <-- for SZCPR, SZGPINS
SYSLIBC.HLP <-- for SCLINE
No Help File Changes were necessary for SVERSION, SFNAME, or SMHL4HC.
The following documentation files have also changed:
SYSLIB.WS <-- Main Reference Manual
SYSLIBHD.WS <-- Header for Main Reference Manual
SYSLIBUG.WS <-- User's Guide (Tutorial)
CRC Data Follows:
1 File: SCLINE .MAC -- Size: 2K -- CRC: 58 3E
2 File: SCRC .MAC -- Size: 4K -- CRC: 96 49
3 File: SCRC1 .MAC -- Size: 4K -- CRC: 7A 5D
4 File: SCRC2 .MAC -- Size: 4K -- CRC: E9 29
5 File: SFNAME .MAC -- Size: 6K -- CRC: EB 46
6 File: SMHL4HC .MAC -- Size: 2K -- CRC: 9C 15
7 File: SVERSION.MAC -- Size: 2K -- CRC: 6C A3
8 File: SYSLIB .HLP -- Size: 14K -- CRC: 2A E5
9 File: SYSLIB .REL -- Size: 14K -- CRC: 1A 33
10 File: SYSLIB .WS -- Size: 108K -- CRC: 50 E7
11 File: SYSLIB8 .HLP -- Size: 8K -- CRC: A2 A5
12 File: SYSLIB9 .HLP -- Size: 8K -- CRC: 60 75
13 File: SYSLIBC .HLP -- Size: 10K -- CRC: 4C E8
14 File: SYSLIBHD.WS -- Size: 12K -- CRC: 5F 43
15 File: SYSLIBUG.WS -- Size: 124K -- CRC: 4F 5E
16 File: SZCPR .MAC -- Size: 8K -- CRC: 3C 74
17 File: SZFNAME .MAC -- Size: 18K -- CRC: 9D A0
18 File: SZGPINS .MAC -- Size: 4K -- CRC: 18 07

320
software/CPM/cpm3/Makefile
View File

@@ -1,320 +0,0 @@
#
# Unix Makefile for CP/M 3.1
#
OBJS=mcd80a.obj mcd80f.obj parse.obj
#
HEXS=copysys.hex ccp3.hex ccpdate.hex date.hex device.hex dir.hex \
dump.hex ed.hex erase.hex get.hex gencom.hex gencpm.hex help.hex \
hexcom.hex patch.hex pip.hex put.hex rename.hex set.hex setdef.hex \
show.hex submit.hex type.hex minhlp.hex
OBJS=copysys.obj ccp3.obj ccpdate.obj date.obj device.obj dir.obj \
dump.obj ed.obj erase.obj get.obj gencom.obj gencpm.obj help.obj \
objcom.obj patch.obj pip.obj put.obj rename.obj set.obj setdef.obj \
show.obj submit.obj type.obj minhlp.obj
BLKS=date device dir disp dpb80 ed erase gencom gencpm get hexcom hexpat \
help main80 minhlp pip put rename scan search set setdef show sort \
submit timest type util
MCOMS = copysys.com ccp.com date.com device.com dir.com dump.com ed.com \
erase.com get.com gencom.com gencpm.com help.com hexcom.com patch.com \
pip.com put.com rename.com set.com setdef.com show.com \
submit.com type.com sid.com #save.com
BDOS = resbdos3.spr bdos3.spr bnkbdos3.spr
ZXCC = zxcc
THAMES = ./runthames
MAC=mac.com
RMAC=rmac.com
LINK=drlink.com
BINARIES= bdos3.spr date.com erase.com help.hlp README \
setdef.com bnkbdos3.spr device.com gencom.com hexcom.com \
rename.com show.com ccp.com dir.com gencpm.com \
patch.com resbdos3.spr submit.com copysys.com dump.com \
get.com pip.com save.com type.com cpmldr.rel \
ed.com help.com put.com set.com sid.com
SOURCES= assemble.txt disp.plm hexcom.asm parse.asm search.plm \
bdos30.asm dpb80.plm hexcom.c patch.asm setbuf.plm \
bios.bin dpb.lit hexpat.c pip.plm setdef.plm \
bioskrnl.asm drvtbl.asm inpout.asm plibios3.asm set.plm \
boot.asm dump.asm ldrlwr.asm plibios.asm show.plm \
callvers.asm echovers.asm _libios3.asm plidio.asm sopt.dcl \
ccp3.asm ed.plm _lidio.asm prs0mov.asm sopt.inc \
ccp3org.asm drlink.com prs1asm.asm sort.plm \
ccpdate.asm erase.plm loader3.asm prs2mon.asm submit.plm \
chario.asm fcb.lit mac.com putf.asm subrsx.asm \
comlit.lit fd1797sd.asm main80.plm put.plm timest.plm \
conbdos.asm finfo.lit main.plm putrsx.asm type.plm \
copyrt.lit format.lit makedate.lib random.asm _ump.asm \
copysys.asm gencom.plm Makefile README util.plm \
cpmbdos1.asm gencpm.plm making.txt rename.plm utl0mov.asm \
cpmbdos2.asm getdef.plm mcd80a.asm resbdos.asm utl1hst.asm \
cpmldr.asm getf.asm mcd80f.asm rmac.com utl2trc.asm \
crdef.plm get.plm minhlp.plm save.asm vers.lit \
date.plm getrsx.asm mon.plm scan.lit xfcb.lit \
datmod.asm getrsx.lib move.asm scan.plm \
device.plm help.dat newpip.plm scb.asm \
dirlbl.asm help.plm _opysys.asm search.lit runthames
all: $(MCOMS) $(BDOS) cpmldr.rel help.hlp
zip: cpm3src_unix.zip cpm3bin_unix.zip
cpm3src_unix.zip: $(SOURCES)
zip $@ $(SOURCES)
cpm3bin_unix.zip: $(BINARIES)
zip $@ $(BINARIES)
############################################################################
#
# Build tools
#
hexcom: hexcom.c
${CC} -o hexcom hexcom.c
hexpat: hexpat.c
${CC} -o hexpat hexpat.c
##############################################################################
#
# Help
#
help.hlp: help.dat minhlp.com
$(ZXCC) minhlp.com -[CREATE]
#
##############################################################################
#
# Specific build rules
#
# The redirection to CCPPHASE.* produces two lists of addresses (one in
# CCP3.COM and one in LOADER3.PRL) which should match.
#
loader3.rel: loader3.asm
$(ZXCC) $(RMAC) loader3 >ccpphase.lst
ccp3.hex: ccp3.asm
$(ZXCC) $(MAC) ccp3 >> ccpphase.lst
ccp.com: loader3d.tmp hexpat ccpdate.hex
./hexpat $< $@ < ccpdate.hex
loader3d.tmp: loader3c.tmp hexpat ccp3.hex
./hexpat $< $@ < ccp3.hex
loader3c.tmp: loader3a.tmp loader3b.tmp
cat loader3a.tmp loader3b.tmp > $@
# Shave the header off loader3.prl to get the loader image
loader3a.tmp: loader3.prl
dd if=loader3.prl of=loader3a.tmp bs=128 skip=2
# This empty space will be overwritten by ccp3.hex
loader3b.tmp:
dd if=/dev/zero of=loader3b.tmp bs=128 count=19
dir.tra: dir.mod
$(THAMES) :F3:locate $< code\(0100h\) stacksize\(50\) map print\($@\)
dir.mod: main80 scan search sort disp dpb80 util timest mcd80a.obj
$(THAMES) :F3:link mcd80a.obj,main80,scan,search,sort,disp,util,dpb80,timest,:F1:plm80.lib to dir.mod
erase.mod: erase.obj parse.obj mcd80a.obj
$(THAMES) :F3:link mcd80a.obj,parse.obj,$<,:F1:plm80.lib to $@
gencom.mod: gencom.obj parse.obj mcd80a.obj
$(THAMES) :F3:link mcd80a.obj,parse.obj,$<,:F1:plm80.lib to $@
gencpm.mod: gencpm.obj setbuf.obj getdef.obj crdef.obj ldrlwr.obj \
mcd80f.obj datmod.obj
$(THAMES) :F3:link mcd80f.obj,$<,setbuf.obj,getdef.obj,crdef.obj,ldrlwr.obj,datmod.obj,:F1:plm80.lib to $@
get.mod: get.obj mcd80a.obj parse.obj getf.obj
$(THAMES) :F3:link mcd80a.obj,$<,parse.obj,getf.obj,:F1:plm80.lib to $@
get.com: get.hex getrsx.rsx gencom.com hexcom
./hexcom $@ <$<
cp getrsx.rsx get.rsx
$(ZXCC) gencom.com $@ get.rsx
get.rsx: getrsx.rel
$(ZXCC) $(LINK) getrsx +-[OP]
mv -f getrsx.prl $@
pip.mod: pip.obj mcd80f.obj inpout.obj
$(THAMES) :F3:link mcd80f.obj,inpout.obj,$<,:F1:plm80.lib to $@
put.mod: put.obj mcd80a.obj parse.obj putf.obj
$(THAMES) :F3:link mcd80a.obj,$<,parse.obj,putf.obj,:F1:plm80.lib to $@
put.com: put.hex put.rsx gencom.com hexcom
./hexcom $@ <$<
$(ZXCC) gencom.com $@ put.rsx
put.rsx: putrsx.rel
$(ZXCC) $(LINK) putrsx +-[OP]
mv -f putrsx.prl $@
save.com: save.rsx gencom.com
rm -f $@
$(ZXCC) gencom save +-[NULL]
set.com: set.hex dirlbl.rsx gencom.com hexcom
./hexcom $@ <$<
$(ZXCC) gencom.com $@ dirlbl.rsx
sid.com: hexpat sid.spr prs0mov.hex
./hexpat sid.spr $@ <prs0mov.hex
submit.com: submit.hex subrsx.rsx gencom.com hexcom
./hexcom $@ <$<
cp subrsx.rsx sub.rsx
$(ZXCC) gencom.com $@ sub.rsx
rename.mod: rename.obj parse.obj mcd80a.obj
$(THAMES) :F3:link mcd80a.obj,$<,parse.obj,:F1:plm80.lib to $@
set.mod: set.obj parse.obj mcd80a.obj
$(THAMES) :F3:link mcd80a.obj,parse.obj,$<,:F1:plm80.lib to $@
submit.mod: submit.obj parse.obj getf.obj mcd80a.obj
$(THAMES) :F3:link mcd80a.obj,$<,parse.obj,getf.obj,:F1:plm80.lib to $@
type.mod: type.obj parse.obj mcd80a.obj
$(THAMES) :F3:link mcd80a.obj,$<,parse.obj,:F1:plm80.lib to $@
mcd80f.obj: mcd80f.asm
$(THAMES) :F2:asm80 $<
resbdos3.spr: resbdos.rel
$(ZXCC) $(LINK) resbdos3 +-= +resbdos +-[os]
bdos3.spr: cpmbdosx.rel
$(ZXCC) $(LINK) bdos3 +-= cpmbdosx +-[os]
bnkbdos3.spr: cpmbdos.rel
$(ZXCC) $(LINK) bnkbdos3 +-= cpmbdos +-[os]
cpmbdosx.asm: cpmbdos1.asm conbdos.asm bdos30.asm makedate.lib
cat cpmbdos1.asm conbdos.asm bdos30.asm > $@
cpmbdos.asm: cpmbdos2.asm conbdos.asm bdos30.asm makedate.lib
cat cpmbdos2.asm conbdos.asm bdos30.asm > $@
# Bits of DIR
main80: main80.plm
$(THAMES) :F1:plm80 $< debug pagewidth\(130\) optimize object\($@\)
scan: scan.plm
$(THAMES) :F1:plm80 $< debug pagewidth\(130\) optimize object\($@\)
search: search.plm
$(THAMES) :F1:plm80 $< debug pagewidth\(130\) optimize object\($@\)
sort: sort.plm
$(THAMES) :F1:plm80 $< debug pagewidth\(130\) optimize object\($@\)
disp: disp.plm
$(THAMES) :F1:plm80 $< debug pagewidth\(130\) optimize object\($@\)
dpb80: dpb80.plm
$(THAMES) :F1:plm80 $< debug pagewidth\(130\) optimize object\($@\)
util: util.plm
$(THAMES) :F1:plm80 $< debug pagewidth\(130\) optimize object\($@\)
timest: timest.plm
$(THAMES) :F1:plm80 $< debug pagewidth\(130\) optimize object\($@\)
##############################
#
# SID
#
sid.spr: prs1asm.rel prs2mon.rel
$(ZXCC) $(LINK) sid.spr +-= +prs1asm +-, +prs2mon +-[OS]
prs0mov.hex: prs0mov.asm makedate.lib
$(ZXCC) $(MAC) prs0mov
prs1asm.rel: prs1asm.asm
$(ZXCC) $(RMAC) prs1asm
prs2mon.rel: prs2mon.asm
$(ZXCC) $(RMAC) prs2mon
##############################################################################
#
# Generic build rules
#
%.obj: %.asm
$(THAMES) :F2:asm80 $< debug
###########################################################################
#
# COM files from hex files
#
%.com: %.hex hexcom
./hexcom $@ < $<
###########################################################################
#
# HEX files from asm source
#
%.hex: %.asm makedate.lib
$(ZXCC) $(MAC) `basename $< .asm`
###########################################################################
#
# HEX files from PL/M source
#
%.hex: %.tra
$(THAMES) :F3:objhex `basename $< .tra` to $@
# The "%.tra" rule also builds "%", which is what objhex actually uses, but
# I couldn't get a bare % rule to work.
%.tra: %.mod
$(THAMES) :F3:locate $< code\(0100h\) stacksize\(100\) map print\($@\)
%.mod: %.obj mcd80a.obj
$(THAMES) :F3:link mcd80a.obj,$<,:F1:plm80.lib to $@
%.obj: %.plm
$(THAMES) :F1:plm80 $< optimize debug
###########################################################################
#
# PRL and RSX files from .REL files
#
%.prl: %.rel
$(ZXCC) $(LINK) `basename $< .rel` +-[OP]
%.spr: %.rel loader*.tmp
$(ZXCC) $(LINK) `basename $< .rel` +-[OS]
%.rsx: %.rel
$(ZXCC) $(LINK) `basename $< .rel` +-[OP]
mv -f `basename $< .rel`.prl `basename $< .rel`.rsx
%.rel: %.asm
$(ZXCC) $(RMAC) `basename $< .asm`
#
#
#
clean:
rm -f $(MCOMS) $(HEXS) $(BLKS) *.lst *.rel *.sym *.tra *.rsx *.spr *.hex \
*.mod *.obj loader*.tmp help.hlp

152
software/CPM/cpm3/_libios3.asm
View File

@@ -1,152 +0,0 @@
name 'BIOSMOD'
title 'Direct BIOS Calls From PL/I-80 for CP/M 3.0'
;
;***********************************************************
;* *
;* bios calls from pl/i for track, sector io *
;* *
;***********************************************************
public settrk ;set track number
public setsec ;set sector number
public rdsec ;read sector
public wrsec ;write sector
public seldsk ;select disk & return the addr(DPH)
public sectrn ;translate sector # given translate table
public bstdma ;set dma
public bflush ;flush BIOS deblocking buffers
;
;
extrn ?boot ;system reboot entry point
extrn ?bdos ;bdos entry point
;
; utility functions
;
;***********************************************************
;***********************************************************
;* *
;* general purpose routines used upon entry *
;* *
;***********************************************************
;
;
getp2: ;get single word value to DE
mov e,m
inx h
mov d,m
inx h
push h
xchg
mov e,m
inx h
mov d,m
pop h
ret
;
;
;***********************************************************
;* *
;***********************************************************
settrk: ;set track number 0-76, 0-65535 in BC
;1-> track #
call getp2
xchg
shld BCREG
mvi a,0ah
jmp gobios
;
;***********************************************************
;* *
;***********************************************************
setsec: ;set sector number 1 - sectors per track
;1-> sector #
call getp2
xchg
shld BCREG
mvi a,0bh
jmp gobios
;
;***********************************************************
;* *
;***********************************************************
rdsec: ;read current sector into sector at dma addr
;returns 0 if no errors
; 1 non-recoverable error
mvi a,0dh
jmp gobios
;***********************************************************
;* *
;***********************************************************
wrsec: ;writes contents of sector at dma addr to current sector
;returns 0 errors occured
; 1 non-recoverable error
call getp2
xchg
shld BCREG
mvi a,0eh
jmp gobios
;
;***********************************************************
;* *
;***********************************************************
;
seldsk: ; selects disk
call getp2
mov a,e
sta BCREG
mvi a,9
jmp gobios
;
;***********************************************************
;* *
;***********************************************************
;
sectrn: ;translate sector #
call getp2
xchg
shld BCREG
xchg
call getp2
xchg
shld DEREG
mvi a,10h
jmp gobios
;
bstdma: ;set dma
call getp2
xchg
shld BCREG
mvi a,0ch
jmp gobios
;
bflush: ;flush bios buffers
mvi a,24
jmp gobios
;
;
;***********************************************************
;***********************************************************
;***********************************************************
;* *
;* call BDOS *
;* *
;***********************************************************
;
;
gobios:
sta FUNC ;load BIOS function #
lxi h,FUNC
xchg ; address of BIOSPB in DE
mvi c,032h ; BDOS function 50 call
jmp ?bdos
;
;
BIOSPB: dw FUNC
FUNC: db 0
AREG: db 0
BCREG: dw 0
DEREG: dw 0
HLREG: dw 0
;
end

607
software/CPM/cpm3/_lidio.asm
View File

@@ -1,607 +0,0 @@
name 'DIOMOD'
title 'Direct CP/M Calls From PL/I-80'
;
;***********************************************************
;* *
;* cp/m calls from pl/i for direct i/o *
;* *
;***********************************************************
public memptr ;return pointer to base of free mem
public memsiz ;return size of memory in bytes
public memwds ;return size of memory in words
public dfcb0 ;return address of default fcb 0
public dfcb1 ;return address of default fcb 1
public dbuff ;return address of default buffer
public reboot ;system reboot (#0)
public rdcon ;read console character (#1)
public wrcon ;write console character(#2)
public rdrdr ;read reader character (#3)
public wrpun ;write punch character (#4)
public wrlst ;write list character (#5)
public coninp ;direct console input (#6a)
public conout ;direct console output (#6b)
public rdstat ;read console status (#6c)
public getio ;get io byte (#8)
public setio ;set i/o byte (#9)
public wrstr ;write string (#10)
public rdbuf ;read console buffer (#10)
public break ;get console status (#11)
public vers ;get version number (#12)
public reset ;reset disk system (#13)
public select ;select disk (#14)
public open ;open file (#15)
public close ;close file (#16)
public sear ;search for file (#17)
public searn ;search for next (#18)
public delete ;delete file (#19)
public rdseq ;read file sequential mode (#20)
public wrseq ;write file sequential mode (#21)
public make ;create file (#22)
public rename ;rename file (#23)
public logvec ;return login vector (#24)
public curdsk ;return current disk number (#25)
public setdma ;set DMA address (#26)
public allvec ;return address of alloc vector (#27)
public wpdisk ;write protect disk (#28)
public rovec ;return read/only vector (#29)
public filatt ;set file attributes (#30)
public getdpb ;get base of disk parm block (#31)
public getusr ;get user code (#32a)
public setusr ;set user code (#32b)
public rdran ;read random (#33)
public wrran ;write random (#34)
public filsiz ;random file size (#35)
public setrec ;set random record pos (#36)
public resdrv ;reset drive (#37)
public wrranz ;write random, zero fill (#40)
;
;
extrn ?begin ;beginning of free list
extrn ?boot ;system reboot entry point
extrn ?bdos ;bdos entry point
extrn ?dfcb0 ;default fcb 0
extrn ?dfcb1 ;default fcb 1
extrn ?dbuff ;default buffer
;
;***********************************************************
;* *
;* equates for interface to cp/m bdos *
;* *
;***********************************************************
cr equ 0dh ;carriage return
lf equ 0ah ;line feed
eof equ 1ah ;end of file
;
readc equ 1 ;read character from console
writc equ 2 ;write console character
rdrf equ 3 ;reader input
punf equ 4 ;punch output
listf equ 5 ;list output function
diof equ 6 ;direct i/o, version 2.0
getiof equ 7 ;get i/o byte
setiof equ 8 ;set i/o byte
printf equ 9 ;print string function
rdconf equ 10 ;read console buffer
statf equ 11 ;return console status
versf equ 12 ;get version number
resetf equ 13 ;system reset
seldf equ 14 ;select disk function
openf equ 15 ;open file function
closef equ 16 ;close file
serchf equ 17 ;search for file
serchn equ 18 ;search next
deletf equ 19 ;delete file
readf equ 20 ;read next record
writf equ 21 ;write next record
makef equ 22 ;make file
renamf equ 23 ;rename file
loginf equ 24 ;get login vector
cdiskf equ 25 ;get current disk number
setdmf equ 26 ;set dma function
getalf equ 27 ;get allocation base
wrprof equ 28 ;write protect disk
getrof equ 29 ;get r/o vector
setatf equ 30 ;set file attributes
getdpf equ 31 ;get disk parameter block
userf equ 32 ;set/get user code
rdranf equ 33 ;read random
wrranf equ 34 ;write random
filszf equ 35 ;compute file size
setrcf equ 36 ;set random record position
rsdrvf equ 37 ;reset drive function
wrrnzf equ 40 ;write random zero fill
;
; utility functions
;***********************************************************
;* *
;* general purpose routines used upon entry *
;* *
;***********************************************************
;
getp1: ;get single byte parameter to register e
mov e,m ;low (addr)
inx h
mov d,m ;high(addr)
xchg ;hl = .char
mov e,m ;to register e
ret
;
getp2: ;get single word value to DE
getp2i: ;(equivalent to getp2)
call getp1
inx h
mov d,m ;get high byte as well
ret
;
getver: ;get cp/m or mp/m version number
push h ;save possible data adr
mvi c,versf
call ?bdos
pop h ;recall data addr
ret
;
chkv20: ;check for version 2.0 or greater
call getver
cpi 20
rnc ;return if > 2.0
; error message and stop
jmp vererr ;version error
;
chkv22: ;check for version 2.2 or greater
call getver
cpi 22h
rnc ;return if >= 2.2
vererr:
;version error, report and terminate
lxi d,vermsg
mvi c,printf
call ?bdos ;write message
jmp ?boot ;and reboot
vermsg: db cr,lf,'Later CP/M or MP/M Version Required$'
;
;***********************************************************
;* *
;***********************************************************
memptr: ;return pointer to base of free storage
lhld ?begin
ret
;
;***********************************************************
;* *
;***********************************************************
memsiz: ;return size of free memory in bytes
lhld ?bdos+1 ;base of bdos
xchg ;de = .bdos
lhld ?begin ;beginning of free storage
mov a,e ;low(.bdos)
sub l ;-low(begin)
mov l,a ;back to l
mov a,d ;high(.bdos)
sbb h
mov h,a ;hl = mem size remaining
ret
;
;***********************************************************
;* *
;***********************************************************
memwds: ;return size of free memory in words
call memsiz ;hl = size in bytes
mov a,h ;high(size)
ora a ;cy = 0
rar ;cy = ls bit
mov h,a ;back to h
mov a,l ;low(size)
rar ;include ls bit
mov l,a ;back to l
ret ;with wds in hl
;
;***********************************************************
;* *
;***********************************************************
dfcb0: ;return address of default fcb 0
lxi h,?dfcb0
ret
;
;***********************************************************
;* *
;***********************************************************
dfcb1: ;return address of default fcb 1
lxi h,?dfcb1
ret
;
;***********************************************************
;* *
;***********************************************************
dbuff: ;return address of default buffer
lxi h,?dbuff
ret
;
;***********************************************************
;* *
;***********************************************************
reboot: ;system reboot (#0)
jmp ?boot
;
;***********************************************************
;* *
;***********************************************************
rdcon: ;read console character (#1)
;return character value to stack
mvi c,readc
jmp chrin ;common code to read char
;
;***********************************************************
;* *
;***********************************************************
wrcon: ;write console character(#2)
;1->char(1)
mvi c,writc ;console write function
jmp chrout ;to write the character
;
;***********************************************************
;* *
;***********************************************************
rdrdr: ;read reader character (#3)
mvi c,rdrf ;reader function
chrin:
;common code for character input
call ?bdos ;value returned to A
pop h ;return address
push psw ;character to stack
inx sp ;delete flags
mvi a,1 ;character length is 1
pchl ;back to calling routine
;
;***********************************************************
;* *
;***********************************************************
wrpun: ;write punch character (#4)
;1->char(1)
mvi c,punf ;punch output function
jmp chrout ;common code to write chr
;
;***********************************************************
;* *
;***********************************************************
wrlst: ;write list character (#5)
;1->char(1)
mvi c,listf ;list output function
chrout:
;common code to write character
;1-> character to write
call getp1 ;output char to register e
jmp ?bdos ;to write and return
;
;***********************************************************
;* *
;***********************************************************
coninp: ;perform console input, char returned in stack
lxi h,chrstr ;return address
push h ;to stack for return
lhld ?boot+1 ;base of bios jmp vector
lxi d,2*3 ;offset to jmp conin
dad d
pchl ;return to chrstr
;
chrstr: ;create character string, length 1
pop h ;recall return address
push psw ;save character
inx sp ;delete psw
mvi a,1 ;length to a
pchl ;return to caller
;
;***********************************************************
;* *
;***********************************************************
conout: ;direct console output
;1->char(1)
call getp1 ;get parameter
mov c,e ;character to c
lhld ?boot+1 ;base of bios jmp
lxi d,3*3 ;console output offset
dad d ;hl = .jmp conout
pchl ;return through handler
;
;***********************************************************
;* *
;***********************************************************
rdstat: ;direct console status read
lxi h,rdsret ;read status return
push h ;return to rdsret
lhld ?boot+1 ;base of jmp vector
lxi d,1*3 ;offset to .jmp const
dad d ;hl = .jmp const
pchl
;
;***********************************************************
;* *
;***********************************************************
getio: ;get io byte (#8)
mvi c,getiof
jmp ?bdos ;value returned to A
;
;***********************************************************
;* *
;***********************************************************
setio: ;set i/o byte (#9)
;1->i/o byte
call getp1 ;new i/o byte to E
mvi c,setiof
jmp ?bdos ;return through bdos
;
;***********************************************************
;* *
;***********************************************************
wrstr: ;write string (#10)
;1->addr(string)
call getp2 ;get parameter value to DE
mvi c,printf ;print string function
jmp ?bdos ;return through bdos
;
;***********************************************************
;* *
;***********************************************************
rdbuf: ;read console buffer (#10)
;1->addr(buff)
call getp2i ;DE = .buff
mvi c,rdconf ;read console function
jmp ?bdos ;return through bdos
;
;***********************************************************
;* *
;***********************************************************
break: ;get console status (#11)
mvi c,statf
call ?bdos ;return through bdos
;
rdsret: ;return clean true value
ora a ;zero?
rz ;return if so
mvi a,0ffh ;clean true value
ret
;
;***********************************************************
;* *
;***********************************************************
vers: ;get version number (#12)
mvi c,versf
jmp ?bdos ;return through bdos
;
;***********************************************************
;* *
;***********************************************************
reset: ;reset disk system (#13)
mvi c,resetf
jmp ?bdos
;
;***********************************************************
;* *
;***********************************************************
select: ;select disk (#14)
;1->fixed(7) drive number
call getp1 ;disk number to E
mvi c,seldf
jmp ?bdos ;return through bdos
;***********************************************************
;* *
;***********************************************************
open: ;open file (#15)
;1-> addr(fcb)
call getp2i ;fcb address to de
mvi c,openf
jmp ?bdos ;return through bdos
;
;***********************************************************
;* *
;***********************************************************
close: ;close file (#16)
;1-> addr(fcb)
call getp2i ;.fcb to DE
mvi c,closef
jmp ?bdos ;return through bdos
;
;***********************************************************
;* *
;***********************************************************
sear: ;search for file (#17)
;1-> addr(fcb)
call getp2i ;.fcb to DE
mvi c,serchf
jmp ?bdos
;
;***********************************************************
;* *
;***********************************************************
searn: ;search for next (#18)
mvi c,serchn ;search next function
jmp ?bdos ;return through bdos
;
;***********************************************************
;* *
;***********************************************************
delete: ;delete file (#19)
;1-> addr(fcb)
call getp2i ;.fcb to DE
mvi c,deletf
jmp ?bdos ;return through bdos
;
;***********************************************************
;* *
;***********************************************************
rdseq: ;read file sequential mode (#20)
;1-> addr(fcb)
call getp2i ;.fcb to DE
mvi c,readf
jmp ?bdos ;return through bdos
;
;***********************************************************
;* *
;***********************************************************
wrseq: ;write file sequential mode (#21)
;1-> addr(fcb)
call getp2i ;.fcb to DE
mvi c,writf
jmp ?bdos ;return through bdos
;
;***********************************************************
;* *
;***********************************************************
make: ;create file (#22)
;1-> addr(fcb)
call getp2i ;.fcb to DE
mvi c,makef
jmp ?bdos ;return through bdos
;
;***********************************************************
;* *
;***********************************************************
rename: ;rename file (#23)
;1-> addr(fcb)
call getp2i ;.fcb to DE
mvi c,renamf
jmp ?bdos ;return through bdos
;
;***********************************************************
;* *
;***********************************************************
logvec: ;return login vector (#24)
mvi c,loginf
jmp ?bdos ;return through BDOS
;
;***********************************************************
;* *
;***********************************************************
curdsk: ;return current disk number (#25)
mvi c,cdiskf
jmp ?bdos ;return value in A
;
;***********************************************************
;* *
;***********************************************************
setdma: ;set DMA address (#26)
;1-> pointer (dma address)
call getp2 ;dma address to DE
mvi c,setdmf
jmp ?bdos ;return through bdos
;
;***********************************************************
;* *
;***********************************************************
allvec: ;return address of allocation vector (#27)
mvi c,getalf
jmp ?bdos ;return through bdos
;
;***********************************************************
;* *
;***********************************************************
wpdisk: ;write protect disk (#28)
call chkv20 ;must be 2.0 or greater
mvi c,wrprof
jmp ?bdos
;
;***********************************************************
;* *
;***********************************************************
rovec: ;return read/only vector (#29)
call chkv20 ;must be 2.0 or greater
mvi c,getrof
jmp ?bdos ;value returned in HL
;
;***********************************************************
;* *
;***********************************************************
filatt: ;set file attributes (#30)
;1-> addr(fcb)
call chkv20 ;must be 2.0 or greater
call getp2i ;.fcb to DE
mvi c,setatf
jmp ?bdos
;
;***********************************************************
;* *
;***********************************************************
getdpb: ;get base of current disk parm block (#31)
call chkv20 ;check for 2.0 or greater
mvi c,getdpf
jmp ?bdos ;addr returned in HL
;
;***********************************************************
;* *
;***********************************************************
getusr: ;get user code to register A
call chkv20 ;check for 2.0 or greater
mvi e,0ffh ;to get user code
mvi c,userf
jmp ?bdos
;
;***********************************************************
;* *
;***********************************************************
setusr: ;set user code
call chkv20 ;check for 2.0 or greater
call getp1 ;code to E
mvi c,userf
jmp ?bdos
;
;***********************************************************
;* *
;***********************************************************
rdran: ;read random (#33)
;1-> addr(fcb)
call chkv20 ;check for 2.0 or greater
call getp2i ;.fcb to DE
mvi c,rdranf
jmp ?bdos ;return through bdos
;
;***********************************************************
;* *
;***********************************************************
wrran: ;write random (#34)
;1-> addr(fcb)
call chkv20 ;check for 2.0 or greater
call getp2i ;.fcb to DE
mvi c,wrranf
jmp ?bdos ;return through bdos
;
;***********************************************************
;* *
;***********************************************************
filsiz: ;compute file size (#35)
call chkv20 ;must be 2.0 or greater
call getp2 ;.fcb to DE
mvi c,filszf
jmp ?bdos ;return through bdos
;
;***********************************************************
;* *
;***********************************************************
setrec: ;set random record position (#36)
call chkv20 ;must be 2.0 or greater
call getp2 ;.fcb to DE
mvi c,setrcf
jmp ?bdos ;return through bdos
;
;***********************************************************
;* *
;***********************************************************
resdrv: ;reset drive function (#37)
;1->drive vector - bit(16)
call chkv22 ;must be 2.2 or greater
call getp2 ;drive reset vector to DE
mvi c,rsdrvf
jmp ?bdos ;return through bdos
;
;***********************************************************
;* *
;***********************************************************
wrranz: ;write random, zero fill function
;1-> addr(fcb)
call chkv22 ;must be 2.2 or greater
call getp2i ;.fcb to DE
mvi c,wrrnzf
jmp ?bdos
;
;***********************************************************
;* *
;***********************************************************
end

835
software/CPM/cpm3/_opysys.asm
View File

@@ -1,835 +0,0 @@
title 'Copysys - updated sysgen program 6/82'
; System generation program
VERS equ 30 ;version x.x for CP/M x.x
;
;**********************************************************
;* *
;* *
;* Copysys source code *
;* *
;* *
;**********************************************************
;
FALSE equ 0
TRUE equ not FALSE
;
;
NSECTS equ 26 ;no. of sectors
NTRKS equ 2 ;no. of systems tracks
NDISKS equ 4 ;no. of disks drives
SECSIZ equ 128 ;size of sector
LOG2SEC equ 7 ;LOG2 128
SKEW equ 2 ;skew sector factor
;
FCB equ 005Ch ;location of FCB
FCBCR equ FCB+32 ;current record location
TPA equ 0100h ;Transient Program Area
LOADP equ 1000h ;LOAD Point for system
BDOS equ 05h ;DOS entry point
BOOT equ 00h ;reboot for system
CONI equ 1h ;console input function
CONO equ 2h ;console output function
SELD equ 14 ;select a disk
OPENF equ 15 ;disk open function
CLOSEF equ 16 ;open a file
DWRITF equ 21 ;Write func
MAKEF equ 22 ;mae a file
DELTEF equ 19 ;delete a file
DREADF equ 20 ;disk read function
DRBIOS equ 50 ;Direct BIOS call function
EIGHTY equ 080h ;value of 80
CTLC equ 'C'-'@' ;ConTroL C
Y equ 89 ;ASCII value of Y
;
MAXTRY equ 01 ;maximum number of tries
CR equ 0Dh ;Carriage Return
LF equ 0Ah ;Line Feed
STACKSIZE equ 016h ;size of local stack
;
WBOOT equ 01 ;address of warm boot
;
SELDSK equ 9 ;Bios func #9 SELect DiSK
SETTRK equ 10 ;BIOS func #10 SET TRacK
SETSEC equ 11 ;BIOS func #11 SET SECtor
SETDMA equ 12 ;BIOS func #12 SET DMA address
READF equ 13 ;BIOS func #13 READ selected sector
WRITF equ 14 ;BIOS func #14 WRITe selected sector
;
org TPA ;Transient Program Area
jmp START
dw 0,0,0,0,0,0,0,0
dw 0,0,0,0,0,0,0,0
dw 0,0,0,0,0,0,0,0
dw 0,0,0,0,0,0,0,0
dw 0,0,0,0,0
db 0,0,0
db 'COPYRIGHT 1982, '
db 'DIGITAL RESEARCH'
db '151282'
db 0,0,0,0
db '654321'
;
; Translate table-sector numbers are translated here to decrease
; the systen tie for missed sectors when slow controllers are
; involved. Translate takes place according to the "SKEW" factor
; set above.
;
OST: db NTRKS ;operating system tracks
SPT: db NSECTS ;sectors per track
TRAN:
TRELT set 1
TRBASE set 1
rept NSECTS
db TRELT ;generate first/next sector
TRELT set TRELT+SKEW
if TRELT gt NSECTS
TRBASE set TRBASE+1
TRELT set TRBASE
endif
endm
;
; Now leave space for extensions to translate table
;
if NSECTS lt 64
rept 64-NSECTS
db 0
endm
endif
;
; Utility subroutines
;
MLTBY3:
;multiply the contents of regE to get jmp address
mov a,e ;Acc = E
sui 1
mov e,a ;get ready for multiply
add e
add e
mov e,a
ret ;back at it
;
SEL:
sta TEMP
lda V3FLG
cpi TRUE
lda TEMP
jnz SEL2
;
sta CREG ;CREG = selected register
lxi h,0000h
shld EREG ;for first time
mvi a,SELDSK
sta BIOSFC ;store it in func space
mvi c,DRBIOS
lxi d,BIOSPB
jmp BDOS
SEL2:
mov c,a
lhld WBOOT
lxi d,SELDSK
call MLTBY3
dad d
pchl
;
TRK:
; Set up track
sta TEMP
lda V3FLG
cpi TRUE
lda TEMP
jnz TRK2
;
mvi a,00h
sta BREG ;zero out B register
mov a,c ;Acc = track #
sta CREG ;set up PB
mvi a,SETTRK ;settrk func #
sta BIOSFC
mvi c,DRBIOS
lxi d,BIOSPB
jmp BDOS
TRK2:
lhld WBOOT
lxi d,SETTRK
call MLTBY3
dad d
pchl ;gone to set track
;
SEC:
; Set up sector number
sta TEMP
lda V3FLG
cpi TRUE
lda TEMP
jnz SEC2
;
mvi a,00h
sta BREG ;zero out BREG
mov a,c ; Acc = C
sta CREG ;CREG = sector #
mvi a,SETSEC
sta BIOSFC ;set up bios call
mvi c,DRBIOS
lxi d,BIOSPB
jmp BDOS
SEC2:
lhld WBOOT
lxi d,SETSEC
call MLTBY3
dad d
pchl
;
DMA:
; Set DMA address to value of BC
sta TEMP
lda V3FLG
cpi TRUE
lda TEMP
jnz DMA2
;
mov a,b ;
sta BREG ;
mov a,c ;Set up the BC
sta CREG ;register pair
mvi a,SETDMA ;
sta BIOSFC ;set up bios #
mvi c,DRBIOS
lxi d,BIOSPB
jmp BDOS
DMA2:
lhld WBOOT
lxi d,SETDMA
call MLTBY3
dad d
pchl
;
READ:
; Perform read operation
sta TEMP
lda V3FLG
cpi TRUE
lda TEMP
jnz READ2
;
mvi a,READF
sta BIOSFC
mvi c,DRBIOS
lxi d,BIOSPB
jmp BDOS
READ2:
lhld WBOOT
lxi d,READF
call MLTBY3
dad d
pchl
;
WRITE:
; Perform write operation
sta TEMP
lda V3FLG
cpi TRUE
lda TEMP
jnz WRITE2
;
mvi a,WRITF
sta BIOSFC ;set up bios #
mvi c,DRBIOS
lxi d,BIOSPB
jmp BDOS
WRITE2:
lhld WBOOT
lxi d,WRITF
call MLTBY3
dad d
pchl
;
MULTSEC:
; Multiply the sector # in rA by the sector size
mov l,a
mvi h,0 ;sector in hl
rept LOG2SEC
dad h
endm
ret ;with HL - sector*sectorsize
;
GETCHAR:
; Read console character to rA
mvi c,CONI
call BDOS
; Convert to upper case
cpi 'A' or 20h
rc
cpi ('Z' or 20h)+1
rnc
ani 05Fh
ret
;
PUTCHAR:
; Write character from rA to console
mov e,a
mvi c,CONO
call BDOS
ret
;
CRLF:
; Send Carriage Return, Line Feed
mvi a,CR
call PUTCHAR
mvi a,LF
call PUTCHAR
ret
;
CRMSG:
; Print message addressed by the HL until zero with leading CRLF
push d
call CRLF
pop d ;drop through to OUTMSG
OUTMSG:
mvi c,9
jmp BDOS
;
SELCT:
; Select disk given by rA
mvi c,0Eh
jmp BDOS
;
DWRITE:
; Write for file copy
mvi c,DWRITF
jmp BDOS
;
DREAD:
; Disk read function
mvi c,DREADF
jmp BDOS
;
OPEN:
; File open function
mvi c,OPENF
jmp BDOS
;
CLOSE:
mvi c,CLOSEF
jmp BDOS
;
MAKE:
mvi c,MAKEF
jmp BDOS
;
DELETE:
mvi c,DELTEF
jmp BDOS
;
;
;
DSTDMA:
mvi c,26
jmp BDOS
;
SOURCE:
lxi d,GETPRM ;ask user for source drive
call CRMSG
call GETCHAR ;obtain response
cpi CR ;is it CR?
jz DFLTDR ;skip if CR only
cpi CTLC ;isit ^C?
jz REBOOT
;
sui 'A' ;normalize drive #
cpi NDISKS ;valid drive?
jc GETC ;skip to GETC if so
;
; Invalid drive
call BADDISK ;tell user bad drive
jmp SOURCE ;try again
;
GETC:
; Select disk given by Acc.
adi 'A'
sta GDISK ;store source disk
sui 'A'
mov e,a ;move disk into E for select func
call SEL ;select the disk
jmp GETVER
;
DFLTDR:
mvi c,25 ;func 25 for current disk
call BDOS ;get curdsk
adi 'A'
sta GDISK
call CRLF
lxi d,VERGET
call OUTMSG
jmp VERCR
;
GETVER:
; Getsys set r/w to read and get the system
call CRLF
lxi d,VERGET ;verify source disk
call OUTMSG
VERCR: call GETCHAR
cpi CR
jnz REBOOT ;jmp only if not verified
call CRLF
ret
;
DESTIN:
lxi d,PUTPRM ;address of message
call CRMSG ;print it
call GETCHAR ;get answer
cpi CR
jz REBOOT ;all done
sui 'A'
cpi NDISKS ;valid disk
jc PUTC
;
; Invalid drive
call BADDISK ;tell user bad drive
jmp PUTSYS ;to try again
;
PUTC:
; Set disk fron rA
adi 'A'
sta PDISK ;message sent
sui 'A'
mov e,a ;disk # in E
call SEL ;select destination drive
; Put system, set r/w to write
lxi d,VERPUT ;verify dest prmpt
call CRMSG ;print it out
call GETCHAR ;retrieve answer
cpi CR
jnz REBOOT ;exit to system if error
call CRLF
ret
;
;
GETPUT:
; Get or put CP/M (rw = 0 for read, 1 for write)
; disk is already selected
lxi h,LOADP ;load point in RAM for DMA address
shld DMADDR
;
;
;
;
; Clear track 00
mvi a,-1 ;
sta TRACK
;
RWTRK:
; Read or write next track
lxi h,TRACK
inr m ;track = track+1
lda OST ;# of OS tracks
cmp m ;=track # ?
jz ENDRW ;end of read/write
;
; Otherwise not done
mov c,m ;track number
call TRK ;set to track
mvi a,-1 ;counts 0,1,2,...,25
sta SECTOR
;
RWSEC:
; Read or write a sector
lda SPT ;sectors per track
lxi h,SECTOR
inr m ;set to next sector
cmp m ;A=26 and M=0,1,..,25
jz ENDTRK
;
; Read or write sector to or from current DMA address
lxi h,SECTOR
mov e,m ;sector number
mvi d,0 ;to DE
lxi h,TRAN
mov b,m ;tran(0) in B
dad d ;sector translated
mov c,m ;value to C ready for select
push b ;save tran(0)
call SEC
pop b ;recall tran(0),tran(sector)
mov a,c ;tran(sector)
sub b ;--tran(sector)
call MULTSEC ;*sector size
xchg ;to DE
lhld DMADDR ;base DMA
dad d
mov b,h
mov c,l ;to set BC for SEC call
call DMA ;dma address set from BC
xra a
sta RETRY ;to set zero retries
;
TRYSEC:
; Try to read or write current sector
lda RETRY
cpi MAXTRY
jc TRYOK
;
; Past MAXTRY, message and ignore
lxi d,ERRMSG
call OUTMSG
call GETCHAR
cpi CR
jnz REBOOT
;
; Typed a CR, ok to ignore
call CRLF
jmp RWSEC
;
TRYOK:
; Ok to tyr read write
inr a
sta RETRY
lda RW
ora a
jz TRYREAD
;
; Must be write
call WRITE
jmp CHKRW
TRYREAD:
call READ
CHKRW:
ora a
jz RWSEC ;zero flag if read/write ok
;
;Error, retry operation
jmp TRYSEC
;
; End of track
ENDTRK:
lda SPT ;sectors per track
call MULTSEC ;*secsize
xchg ; to DE
lhld DMADDR ;base dma for this track
dad d ;+spt*secsize
shld DMADDR ;ready for next track
jmp RWTRK ;for another track
;
ENDRW:
; End of read or write
ret
;
;*******************
;*
;* MAIN ROUTINE
;*
;*
;*******************
;
START:
lxi sp,STACK
lxi d,SIGNON
call OUTMSG
;
;get version number to check compatability
mvi c,12 ;version check
call BDOS
mov a,l ;version in Acc
cpi 30h ;version 3 or newer?
jc OLDRVR ;
mvi a,TRUE
sta V3FLG ;
jmp FCBCHK
OLDRVR:
mvi a,FALSE
sta V3FLG
;
; Check for default file liad instead of get
FCBCHK: lda FCB+1 ;blank if no file
cpi ' '
jz GETSYS ;skip to system message
lxi d,FCB ;try to open it
call OPEN
inr a ;255 becomes 00
jnz RDOK
;
; File not present
lxi d,NOFILE
call CRMSG
jmp REBOOT
;
;file present
RDOK:
xra a
sta FCBCR ;current record = 0
lxi h,LOADP
RDINP:
push h
mov b,h
mov c,l
call DMA ;DMA address set
lxi d,FCB ;ready fr read
call DREAD
pop h ;recall
ora a ;00 if read ok
jnz PUTSYS ;assume eof if not
; More to read continue
lxi d,SECSIZ
dad d ;HL is new load address
jmp RDINP
;
GETSYS:
call SOURCE ;find out source drive
;
xra a ;zero out a
sta RW ;RW = 0 to signify read
call GETPUT ;get or read system
lxi d,DONE ;end message of get or read func
call OUTMSG ;print it out
;
; Put the system
PUTSYS:
call DESTIN ;get dest drive
;
lxi h,RW ;load address
mvi m,1
call GETPUT ;to put system back on disk
lxi d,DONE
call OUTMSG ;print out end prompt
;
; FILE COPY FOR CPM.SYS
;
CPYCPM:
; Prompt the user for the source of CP/M3.SYS
;
lxi d,CPYMSG ;print copys prompt
call CRMSG ;print it
call GETCHAR ;obtain reply
cpi Y ;is it yes?
jnz REBOOT ;if not exit
;else
;
;
mvi c,13 ;func # for reset
call BDOS ;
inr a
lxi d,ERRMSG
cz FINIS
;
call SOURCE ;get source disk for CPM3.SYS
CNTNUE:
lda GDISK ;Acc = source disk
sui 'A'
mvi d,00h
mov e,a ;DE = selected disk
call SELCT
; now copy the FCBs
mvi c,36 ;for copy
lxi d,SFCB ;source file
lxi h,DFCB ;destination file
MFCB:
ldax d
inx d ;ready next
mov m,a
inx h ;ready next dest
dcr c ;decrement coun
jnz MFCB
;
lda GDISK ;Acc = source disk
sui 40h ;correct disk
lxi h,SFCB
mov m,a ;SFCB has source disk #
lda PDISK ;get the dest. disk
lxi h,DFCB ;
sui 040h ;normalize disk
mov m,a
;
xra a ;zero out a
sta DFCBCR ;current rec = 0
;
; Source and destination fcb's ready
;
lxi d,SFCB ;
call OPEN ;open the file
lxi d,NOFILE ;error messg
inr a ;255 becomes 0
cz FINIS ;done if no file
;
; Source file is present and open
lxi d,LOADP ;get DMA address
xchg ;move address to HL regs
shld BEGIN ;save for begin of write
;
lda BEGIN ;get low byte of
mov l,a ;DMA address into L
lda BEGIN+1 ;
mov h,a ;into H also
COPY1:
xchg ;DE = address of DMA
call DSTDMA ;
;
lxi d,SFCB ;
call DREAD ;read next record
ora a ;end of file?
jnz EOF ;skip write if so
;
lda CRNREC
inr a ;bump it
sta CRNREC
;
lda BEGIN
mov l,a
lda BEGIN+1
mov h,a
lxi d,EIGHTY
dad d ;add eighty to begin address
shld BEGIN
jmp COPY1 ;loop until EOF
;
EOF:
lxi d,DONE
call OUTMSG
;
COPY2:
call DESTIN ;get destination drive for CPM3.SYS
lxi d,DFCB ;set up dest FCB
xchg
lda PDISK
sui 040h ;normalize disk
mov m,a ;correct disk for dest
xchg ;DE = DFCB
call DELETE ;delete file if there
;
lxi d,DFCB ;
call MAKE ;make a new one
lxi d,NODIR
inr a ;check directory space
cz FINIS ;end if none
;
lxi d,LOADP
xchg
shld BEGIN
;
lda BEGIN
mov l,a
lda BEGIN+1
mov h,a
LOOP2:
xchg
call DSTDMA
lxi d,DFCB
call DWRITE
lxi d,FSPACE
ora a
cnz FINIS
lda CRNREC
dcr a
sta CRNREC
cpi 0
jz FNLMSG
lda BEGIN
mov l,a
lda BEGIN+1
mov h,a
lxi d,EIGHTY
dad d
shld BEGIN
jmp LOOP2
; Copy operation complete
FNLMSG:
lxi d,DFCB
mvi c,CLOSEF
call BDOS
;
lxi d,DONE
;
FINIS:
; Write message given by DE, reboot
call OUTMSG
;
REBOOT:
mvi c,13
call BDOS
call CRLF
jmp BOOT
;
BADDISK:
lxi d,QDISK
call CRMSG
ret
;****************************
;*
;*
;* DATA STRUCTURES
;*
;*
;****************************
;
BIOSPB:
; BIOS Parameter Block
BIOSFC: db 0 ;BIOS function number
AREG: db 0 ;A register contents
CREG: db 0 ;C register contents
BREG: db 0 ;B register contents
EREG: db 0 ;E register contents
DREG: db 0 ;D register contents
HLREG: dw 0 ;HL register contents
;
SFCB:
DR: ds 1
F1F8: db 'CPM3 '
T1T3: db 'SYS'
EXT: db 0
CS: db 0
RS: db 0
RCC: db 0
D0D15: ds 16
CCR: db 0
R0R2: ds 3
;
DFCB: ds 36
DFCBCR equ DFCB+32
;
;
V3FLG: db 0 ;flag for version #
TEMP: db 0
SDISK: ds 1 ;selected disk
BEGIN: dw 0
DFLAG: db 0
TRACK: ds 1 ;current track
CRNREC: db 0 ;current rec count
SECTOR: ds 1 ;current sector
RW: ds 1 ;read if 0 write if 1
DMADDR: ds 2 ;current DMA address
RETRY: ds 1 ;number of tries on this sector
SIGNON: db 'CP/M 3 COPYSYS - Version '
db VERS/10+'0','.',VERS mod 10 +'0'
db '$'
GETPRM: db 'Source drive name (or return for default) $'
VERGET: db 'Source on '
GDISK: ds 1
db ' then type return $'
PUTPRM: db 'Destination drive name (or return to reboot) $'
VERPUT: db 'Destination on '
PDISK: ds 1
db ' then type return $'
CPYMSG: db 'Do you wish to copy CPM3.SYS? $'
DONE: db 'Function complete$'
;
; Error messages......
;
QDISK: db 'ERROR: Invalid drive name (Use A, B, C, or D)$'
NOFILE: db 'ERROR: No source file on disk.$'
NODIR: db 'ERROR: No directory space.$'
FSPACE: db 'ERROR: Out of data space.$'
WRPROT: db 'ERROR: Write protected?$'
ERRMSG: db 'ERROR: Possible incompatible disk format.'
db CR,LF,' Type return to ignore.$'
CLSERR: db 'ERROR: Close operation failed.$'
;
ds STACKSIZE * 3
STACK:
end

208
software/CPM/cpm3/_ump.asm
View File

@@ -1,208 +0,0 @@
; Dump program, reads input file and displays hex data
;
org 100h
bdos equ 0005h ;dos entry point
cons equ 1 ;read console
typef equ 2 ;type function
printf equ 9 ;buffer print entry
brkf equ 11 ;break key function (true if char ready)
openf equ 15 ;file open
readf equ 20 ;read function
;
fcb equ 5ch ;file control block address
buff equ 80h ;input disk buffer address
;
; non graphic characters
cr equ 0dh ;carriage return
lf equ 0ah ;line feed
;
; file control block definitions
fcbdn equ fcb+0 ;disk name
fcbfn equ fcb+1 ;file name
fcbft equ fcb+9 ;disk file type (3 characters)
fcbrl equ fcb+12 ;file's current reel number
fcbrc equ fcb+15 ;file's record count (0 to 128)
fcbcr equ fcb+32 ;current (next) record number (0 to 127)
fcbln equ fcb+33 ;fcb length
;
; set up stack
lxi h,0
dad sp
; entry stack pointer in hl from the ccp
shld oldsp
; set sp to local stack area (restored at finis)
lxi sp,stktop
; read and print successive buffers
call setup ;set up input file
cpi 255 ;255 if file not present
jnz openok ;skip if open is ok
;
; file not there, give error message and return
lxi d,opnmsg
call err
jmp finis ;to return
;
openok: ;open operation ok, set buffer index to end
mvi a,80h
sta ibp ;set buffer pointer to 80h
; hl contains next address to print
lxi h,0 ;start with 0000
;
gloop:
push h ;save line position
call gnb
pop h ;recall line position
jc finis ;carry set by gnb if end file
mov b,a
; print hex values
; check for line fold
mov a,l
ani 0fh ;check low 4 bits
jnz nonum
; print line number
call crlf
;
; check for break key
call break
; accum lsb = 1 if character ready
rrc ;into carry
jc finis ;don't print any more
;
mov a,h
call phex
mov a,l
call phex
nonum:
inx h ;to next line number
mvi a,' '
call pchar
mov a,b
call phex
jmp gloop
;
finis:
; end of dump
call crlf
lhld oldsp
sphl
; stack pointer contains ccp's stack location
ret ;to the ccp
;
;
; subroutines
;
break: ;check break key (actually any key will do)
push h! push d! push b; environment saved
mvi c,brkf
call bdos
pop b! pop d! pop h; environment restored
ret
;
pchar: ;print a character
push h! push d! push b; saved
mvi c,typef
mov e,a
call bdos
pop b! pop d! pop h; restored
ret
;
crlf:
mvi a,cr
call pchar
mvi a,lf
call pchar
ret
;
;
pnib: ;print nibble in reg a
ani 0fh ;low 4 bits
cpi 10
jnc p10
; less than or equal to 9
adi '0'
jmp prn
;
; greater or equal to 10
p10: adi 'a' - 10
prn: call pchar
ret
;
phex: ;print hex char in reg a
push psw
rrc
rrc
rrc
rrc
call pnib ;print nibble
pop psw
call pnib
ret
;
err: ;print error message
; d,e addresses message ending with "$"
mvi c,printf ;print buffer function
call bdos
ret
;
;
gnb: ;get next byte
lda ibp
cpi 80h
jnz g0
; read another buffer
;
;
call diskr
ora a ;zero value if read ok
jz g0 ;for another byte
; end of data, return with carry set for eof
stc
ret
;
g0: ;read the byte at buff+reg a
mov e,a ;ls byte of buffer index
mvi d,0 ;double precision index to de
inr a ;index=index+1
sta ibp ;back to memory
; pointer is incremented
; save the current file address
lxi h,buff
dad d
; absolute character address is in hl
mov a,m
; byte is in the accumulator
ora a ;reset carry bit
ret
;
setup: ;set up file
; open the file for input
xra a ;zero to accum
sta fcbcr ;clear current record
;
lxi d,fcb
mvi c,openf
call bdos
; 255 in accum if open error
ret
;
diskr: ;read disk file record
push h! push d! push b
lxi d,fcb
mvi c,readf
call bdos
pop b! pop d! pop h
ret
;
; fixed message area
signon: db 'file dump version 2.0$'
opnmsg: db cr,lf,'no input file present on disk$'
; variable area
ibp: ds 2 ;input buffer pointer
oldsp: ds 2 ;entry sp value from ccp
;
; stack area
ds 64 ;reserve 32 level stack
stktop:
;
end

BIN
software/CPM/cpm3/asm80/asm80
View File

Binary file not shown.

BIN
software/CPM/cpm3/asm80/asm80.ov0
View File

Binary file not shown.

BIN
software/CPM/cpm3/asm80/asm80.ov1
View File

Binary file not shown.

BIN
software/CPM/cpm3/asm80/asm80.ov2
View File

Binary file not shown.

BIN
software/CPM/cpm3/asm80/asm80.ov3
View File

Binary file not shown.

BIN
software/CPM/cpm3/asm80/asm80.ov4
View File

Binary file not shown.

BIN
software/CPM/cpm3/asm80/asm80.ov5
View File

Binary file not shown.

BIN
software/CPM/cpm3/asm80/asxref
View File

Binary file not shown.

BIN
software/CPM/cpm3/asm80/conv86
View File

Binary file not shown.

BIN
software/CPM/cpm3/asm80/fpal.lib
View File

Binary file not shown.

BIN
software/CPM/cpm3/asm80/hexobj
View File

Binary file not shown.

59
software/CPM/cpm3/asm80/isis.doc
View File

@@ -1,59 +0,0 @@
Instructions for ISIS environment V1.0
======================================
The ISIS environment is designed to allow 8080 based Intel tools to run on
an 8086 PCDOS based system. The ISIS environment does not support all ISIS
calls, but sufficient to run 8051 translators and utilities. (If the program
uses an unsupported ISIS call an error message is generated).
DOS instructions
----------------
Load the software(ISIS) onto the harddisk. If ISIS is installed in the DOS
search path it will be directly loadable by entering "ISIS".
Before entering ISIS, logical names must be set to match any ISIS disk drives
used by the ISIS tools. This includes :F0: - the ISIS environment does NOT
default to the current drive. As with 8080 ISIS, filenames without a drive
prefix are directed to :F0:.
C>SET :F0:=\ISIS /* make sure there is no <SPACE> before the "=" */
C>SET :F1:=\BITBUS
C>ISIS /* invoke ISIS emulator */
DOS ISIS Environment X003
=ASM51 :F1:SAMP1.A51 /* enter ISIS commands */
...
...
=EXIT /* return to DOS */
The ISIS environment will also run under DOS in batch mode
Command file (DEMO.CMD) contains:
ASM51 :F1:SAMP1.A51
ASM51 :F1:SAMP2.A51
ASM51 :F1:SAMP3.A51
RL51 :F1:SAMP1.OBJ, &
:F1:SAMP2.OBJ, &
:F1:SAMP3.OBJ TO :F1:SAMPLE
EXIT /* must include EXIT since all program
input must be in command file
otherwise DOS will wait forever */
To invoke the command file
C>ISIS < DEMO.CMD /* This could be part of a batch job */
<CTRL-C> or <CTRL-BREAK> will abort the ISIS environment. You will need to
enter <RETURN> also if the ISIS environment is at the prompt level. Also the
command "BREAK ON" should be included in the AUTOEXEC.BAT file to permit DOS
to recognise <CTRL-BREAK> all the time (not just when performing DOS calls).
Known Bugs/Problems: None

BIN
software/CPM/cpm3/asm80/isis.exe
View File

Binary file not shown.

BIN
software/CPM/cpm3/asm80/ixref
View File

Binary file not shown.

BIN
software/CPM/cpm3/asm80/lib
View File

Binary file not shown.

BIN
software/CPM/cpm3/asm80/link
View File

Binary file not shown.

BIN
software/CPM/cpm3/asm80/link.ovl
View File

Binary file not shown.

BIN
software/CPM/cpm3/asm80/locate
View File

Binary file not shown.

BIN
software/CPM/cpm3/asm80/objhex
View File

Binary file not shown.

BIN
software/CPM/cpm3/asm80/plm51.lib
View File

Binary file not shown.

BIN
software/CPM/cpm3/asm80/plm80.lib
View File

Binary file not shown.

BIN
software/CPM/cpm3/asm80/submit
View File

Binary file not shown.

BIN
software/CPM/cpm3/asm80/system.lib
View File

Binary file not shown.

20
software/CPM/cpm3/assemble.txt
View File

@@ -1,20 +0,0 @@
Assembling CP/M 3
=================
The original CP/M 3 build process seems to have been written for a CP/M 3
computer; it uses the MAC, RMAC, LINK, GENCOM and HEXCOM tools, which are
not readily available for other platforms in this day and age.
HEXCOM.C (based on LOAD.C in <ftp://oak.oakland.edu/pub/unix-c/> ) serves
as a suitable replacement for HEXCOM. The command syntax is:
HEXCOM comfile <hexfile
Similarly, to build SID and the CCP, HEXPAT.C has been supplied to overlay
a COM file with a HEX file.
The other tools are run under emulation rather than being ported. You will
need to install two emulators for this: ZXCC (version 0.3 or later) and
Thames (version 0.1.0 or later). ZXCC is used to run the CP/M-hosted build
tools, while Thames runs the ISIS-hosted build tools.

6280
software/CPM/cpm3/bdos30.asm
View File

File diff suppressed because it is too large Load Diff

653
software/CPM/cpm3/bioskrnl.asm
View File

@@ -1,653 +0,0 @@
title 'Root module of relocatable BIOS for CP/M 3.0'
; version 1.0 15 Sept 82
true equ -1
false equ not true
banked equ true
; Copyright (C), 1982
; Digital Research, Inc
; P.O. Box 579
; Pacific Grove, CA 93950
; This is the invariant portion of the modular BIOS and is
; distributed as source for informational purposes only.
; All desired modifications should be performed by
; adding or changing externally defined modules.
; This allows producing "standard" I/O modules that
; can be combined to support a particular system
; configuration.
cr equ 13
lf equ 10
bell equ 7
ctlQ equ 'Q'-'@'
ctlS equ 'S'-'@'
ccp equ 0100h ; Console Command Processor gets loaded into the TPA
cseg ; GENCPM puts CSEG stuff in common memory
; variables in system data page
extrn @covec,@civec,@aovec,@aivec,@lovec ; I/O redirection vectors
extrn @mxtpa ; addr of system entry point
extrn @bnkbf ; 128 byte scratch buffer
; initialization
extrn ?init ; general initialization and signon
extrn ?ldccp,?rlccp ; load & reload CCP for BOOT & WBOOT
; user defined character I/O routines
extrn ?ci,?co,?cist,?cost ; each take device in <B>
extrn ?cinit ; (re)initialize device in <C>
extrn @ctbl ; physical character device table
; disk communication data items
extrn @dtbl ; table of pointers to XDPHs
public @adrv,@rdrv,@trk,@sect ; parameters for disk I/O
public @dma,@dbnk,@cnt ; '' '' '' ''
; memory control
public @cbnk ; current bank
extrn ?xmove,?move ; select move bank, and block move
extrn ?bank ; select CPU bank
; clock support
extrn ?time ; signal time operation
; general utility routines
public ?pmsg,?pdec ; print message, print number from 0 to 65535
public ?pderr ; print BIOS disk error message header
maclib modebaud ; define mode bits
; External names for BIOS entry points
public ?boot,?wboot,?const,?conin,?cono,?list,?auxo,?auxi
public ?home,?sldsk,?sttrk,?stsec,?stdma,?read,?write
public ?lists,?sctrn
public ?conos,?auxis,?auxos,?dvtbl,?devin,?drtbl
public ?mltio,?flush,?mov,?tim,?bnksl,?stbnk,?xmov
; BIOS Jump vector.
; All BIOS routines are invoked by calling these
; entry points.
?boot: jmp boot ; initial entry on cold start
?wboot: jmp wboot ; reentry on program exit, warm start
?const: jmp const ; return console input status
?conin: jmp conin ; return console input character
?cono: jmp conout ; send console output character
?list: jmp list ; send list output character
?auxo: jmp auxout ; send auxilliary output character
?auxi: jmp auxin ; return auxilliary input character
?home: jmp home ; set disks to logical home
?sldsk: jmp seldsk ; select disk drive, return disk parameter info
?sttrk: jmp settrk ; set disk track
?stsec: jmp setsec ; set disk sector
?stdma: jmp setdma ; set disk I/O memory address
?read: jmp read ; read physical block(s)
?write: jmp write ; write physical block(s)
?lists: jmp listst ; return list device status
?sctrn: jmp sectrn ; translate logical to physical sector
?conos: jmp conost ; return console output status
?auxis: jmp auxist ; return aux input status
?auxos: jmp auxost ; return aux output status
?dvtbl: jmp devtbl ; return address of device def table
?devin: jmp ?cinit ; change baud rate of device
?drtbl: jmp getdrv ; return address of disk drive table
?mltio: jmp multio ; set multiple record count for disk I/O
?flush: jmp flush ; flush BIOS maintained disk caching
?mov: jmp ?move ; block move memory to memory
?tim: jmp ?time ; Signal Time and Date operation
?bnksl: jmp bnksel ; select bank for code execution and default DMA
?stbnk: jmp setbnk ; select different bank for disk I/O DMA operations.
?xmov: jmp ?xmove ; set source and destination banks for one operation
jmp 0 ; reserved for future expansion
jmp 0 ; reserved for future expansion
jmp 0 ; reserved for future expansion
; BOOT
; Initial entry point for system startup.
dseg ; this part can be banked
boot:
lxi sp,boot$stack
mvi c,15 ; initialize all 16 character devices
c$init$loop:
push b ! call ?cinit ! pop b
dcr c ! jp c$init$loop
call ?init ; perform any additional system initialization
; and print signon message
lxi b,16*256+0 ! lxi h,@dtbl ; init all 16 logical disk drives
d$init$loop:
push b ; save remaining count and abs drive
mov e,m ! inx h ! mov d,m ! inx h ; grab @drv entry
mov a,e ! ora d ! jz d$init$next ; if null, no drive
push h ; save @drv pointer
xchg ; XDPH address in <HL>
dcx h ! dcx h ! mov a,m ! sta @RDRV ; get relative drive code
mov a,c ! sta @ADRV ; get absolute drive code
dcx h ; point to init pointer
mov d,m ! dcx h ! mov e,m ; get init pointer
xchg ! call ipchl ; call init routine
pop h ; recover @drv pointer
d$init$next:
pop b ; recover counter and drive #
inr c ! dcr b ! jnz d$init$loop ; and loop for each drive
jmp boot$1
cseg ; following in resident memory
boot$1:
call set$jumps
call ?ldccp ; fetch CCP for first time
jmp ccp
; WBOOT
; Entry for system restarts.
wboot:
lxi sp,boot$stack
call set$jumps ; initialize page zero
call ?rlccp ; reload CCP
jmp ccp ; then reset jmp vectors and exit to ccp
set$jumps:
if banked
mvi a,1 ! call ?bnksl
endif
mvi a,JMP
sta 0 ! sta 5 ; set up jumps in page zero
lxi h,?wboot ! shld 1 ; BIOS warm start entry
lhld @MXTPA ! shld 6 ; BDOS system call entry
ret
ds 64
boot$stack equ $
; DEVTBL
; Return address of character device table
devtbl:
lxi h,@ctbl ! ret
; GETDRV
; Return address of drive table
getdrv:
lxi h,@dtbl ! ret
; CONOUT
; Console Output. Send character in <C>
; to all selected devices
conout:
lhld @covec ; fetch console output bit vector
jmp out$scan
; AUXOUT
; Auxiliary Output. Send character in <C>
; to all selected devices
auxout:
lhld @aovec ; fetch aux output bit vector
jmp out$scan
; LIST
; List Output. Send character in <C>
; to all selected devices.
list:
lhld @lovec ; fetch list output bit vector
out$scan:
mvi b,0 ; start with device 0
co$next:
dad h ; shift out next bit
jnc not$out$device
push h ; save the vector
push b ; save the count and character
not$out$ready:
call coster ! ora a ! jz not$out$ready
pop b ! push b ; restore and resave the character and device
call ?co ; if device selected, print it
pop b ; recover count and character
pop h ; recover the rest of the vector
not$out$device:
inr b ; next device number
mov a,h ! ora l ; see if any devices left
jnz co$next ; and go find them...
ret
; CONOST
; Console Output Status. Return true if
; all selected console output devices
; are ready.
conost:
lhld @covec ; get console output bit vector
jmp ost$scan
; AUXOST
; Auxiliary Output Status. Return true if
; all selected auxiliary output devices
; are ready.
auxost:
lhld @aovec ; get aux output bit vector
jmp ost$scan
; LISTST
; List Output Status. Return true if
; all selected list output devices
; are ready.
listst:
lhld @lovec ; get list output bit vector
ost$scan:
mvi b,0 ; start with device 0
cos$next:
dad h ; check next bit
push h ; save the vector
push b ; save the count
mvi a,0FFh ; assume device ready
cc coster ; check status for this device
pop b ; recover count
pop h ; recover bit vector
ora a ; see if device ready
rz ; if any not ready, return false
inr b ; drop device number
mov a,h ! ora l ; see if any more selected devices
jnz cos$next
ori 0FFh ; all selected were ready, return true
ret
coster: ; check for output device ready, including optional
; xon/xoff support
mov l,b ! mvi h,0 ; make device code 16 bits
push h ; save it in stack
dad h ! dad h ! dad h ; create offset into device characteristics tbl
lxi d,@ctbl+6 ! dad d ; make address of mode byte
mov a,m ! ani mb$xonxoff
pop h ; recover console number in <HL>
jz ?cost ; not a xon device, go get output status direct
lxi d,xofflist ! dad d ; make pointer to proper xon/xoff flag
call cist1 ; see if this keyboard has character
mov a,m ! cnz ci1 ; get flag or read key if any
cpi ctlq ! jnz not$q ; if its a ctl-Q,
mvi a,0FFh ; set the flag ready
not$q:
cpi ctls ! jnz not$s ; if its a ctl-S,
mvi a,00h ; clear the flag
not$s:
mov m,a ; save the flag
call cost1 ; get the actual output status,
ana m ; and mask with ctl-Q/ctl-S flag
ret ; return this as the status
cist1: ; get input status with <BC> and <HL> saved
push b ! push h
call ?cist
pop h ! pop b
ora a
ret
cost1: ; get output status, saving <BC> & <HL>
push b ! push h
call ?cost
pop h ! pop b
ora a
ret
ci1: ; get input, saving <BC> & <HL>
push b ! push h
call ?ci
pop h ! pop b
ret
; CONST
; Console Input Status. Return true if
; any selected console input device
; has an available character.
const:
lhld @civec ; get console input bit vector
jmp ist$scan
; AUXIST
; Auxiliary Input Status. Return true if
; any selected auxiliary input device
; has an available character.
auxist:
lhld @aivec ; get aux input bit vector
ist$scan:
mvi b,0 ; start with device 0
cis$next:
dad h ; check next bit
mvi a,0 ; assume device not ready
cc cist1 ; check status for this device
ora a ! rnz ; if any ready, return true
inr b ; drop device number
mov a,h ! ora l ; see if any more selected devices
jnz cis$next
xra a ; all selected were not ready, return false
ret
; CONIN
; Console Input. Return character from first
; ready console input device.
conin:
lhld @civec
jmp in$scan
; AUXIN
; Auxiliary Input. Return character from first
; ready auxiliary input device.
auxin:
lhld @aivec
in$scan:
push h ; save bit vector
mvi b,0
ci$next:
dad h ; shift out next bit
mvi a,0 ; insure zero a (nonexistant device not ready).
cc cist1 ; see if the device has a character
ora a
jnz ci$rdy ; this device has a character
inr b ; else, next device
mov a,h ! ora l ; see if any more devices
jnz ci$next ; go look at them
pop h ; recover bit vector
jmp in$scan ; loop til we find a character
ci$rdy:
pop h ; discard extra stack
jmp ?ci
; Utility Subroutines
ipchl: ; vectored CALL point
pchl
?pmsg: ; print message @<HL> up to a null
; saves <BC> & <DE>
push b
push d
pmsg$loop:
mov a,m ! ora a ! jz pmsg$exit
mov c,a ! push h
call ?cono ! pop h
inx h ! jmp pmsg$loop
pmsg$exit:
pop d
pop b
ret
?pdec: ; print binary number 0-65535 from <HL>
lxi b,table10! lxi d,-10000
next:
mvi a,'0'-1
pdecl:
push h! inr a! dad d! jnc stoploop
inx sp! inx sp! jmp pdecl
stoploop:
push d! push b
mov c,a! call ?cono
pop b! pop d
nextdigit:
pop h
ldax b! mov e,a! inx b
ldax b! mov d,a! inx b
mov a,e! ora d! jnz next
ret
table10:
dw -1000,-100,-10,-1,0
?pderr:
lxi h,drive$msg ! call ?pmsg ; error header
lda @adrv ! adi 'A' ! mov c,a ! call ?cono ; drive code
lxi h,track$msg ! call ?pmsg ; track header
lhld @trk ! call ?pdec ; track number
lxi h,sector$msg ! call ?pmsg ; sector header
lhld @sect ! call ?pdec ; sector number
ret
; BNKSEL
; Bank Select. Select CPU bank for further execution.
bnksel:
sta @cbnk ; remember current bank
jmp ?bank ; and go exit through users
; physical bank select routine
xofflist db -1,-1,-1,-1,-1,-1,-1,-1 ; ctl-s clears to zero
db -1,-1,-1,-1,-1,-1,-1,-1
dseg ; following resides in banked memory
; Disk I/O interface routines
; SELDSK
; Select Disk Drive. Drive code in <C>.
; Invoke login procedure for drive
; if this is first select. Return
; address of disk parameter header
; in <HL>
seldsk:
mov a,c ! sta @adrv ; save drive select code
mov l,c ! mvi h,0 ! dad h ; create index from drive code
lxi b,@dtbl ! dad b ; get pointer to dispatch table
mov a,m ! inx h ! mov h,m ! mov l,a ; point at disk descriptor
ora h ! rz ; if no entry in table, no disk
mov a,e ! ani 1 ! jnz not$first$select ; examine login bit
push h ! xchg ; put pointer in stack & <DE>
lxi h,-2 ! dad d ! mov a,m ! sta @RDRV ; get relative drive
lxi h,-6 ! dad d ; find LOGIN addr
mov a,m ! inx h ! mov h,m ! mov l,a ; get address of LOGIN routine
call ipchl ; call LOGIN
pop h ; recover DPH pointer
not$first$select:
ret
; HOME
; Home selected drive. Treated as SETTRK(0).
home:
lxi b,0 ; same as set track zero
; SETTRK
; Set Track. Saves track address from <BC>
; in @TRK for further operations.
settrk:
mov l,c ! mov h,b
shld @trk
ret
; SETSEC
; Set Sector. Saves sector number from <BC>
; in @sect for further operations.
setsec:
mov l,c ! mov h,b
shld @sect
ret
; SETDMA
; Set Disk Memory Address. Saves DMA address
; from <BC> in @DMA and sets @DBNK to @CBNK
; so that further disk operations take place
; in current bank.
setdma:
mov l,c ! mov h,b
shld @dma
lda @cbnk ; default DMA bank is current bank
; fall through to set DMA bank
; SETBNK
; Set Disk Memory Bank. Saves bank number
; in @DBNK for future disk data
; transfers.
setbnk:
sta @dbnk
ret
; SECTRN
; Sector Translate. Indexes skew table in <DE>
; with sector in <BC>. Returns physical sector
; in <HL>. If no skew table (<DE>=0) then
; returns physical=logical.
sectrn:
mov l,c ! mov h,b
mov a,d ! ora e ! rz
xchg ! dad b ! mov l,m ! mvi h,0
ret
; READ
; Read physical record from currently selected drive.
; Finds address of proper read routine from
; extended disk parameter header (XDPH).
read:
lhld @adrv ! mvi h,0 ! dad h ; get drive code and double it
lxi d,@dtbl ! dad d ; make address of table entry
mov a,m ! inx h ! mov h,m ! mov l,a ; fetch table entry
push h ; save address of table
lxi d,-8 ! dad d ; point to read routine address
jmp rw$common ; use common code
; WRITE
; Write physical sector from currently selected drive.
; Finds address of proper write routine from
; extended disk parameter header (XDPH).
write:
lhld @adrv ! mvi h,0 ! dad h ; get drive code and double it
lxi d,@dtbl ! dad d ; make address of table entry
mov a,m ! inx h ! mov h,m ! mov l,a ; fetch table entry
push h ; save address of table
lxi d,-10 ! dad d ; point to write routine address
rw$common:
mov a,m ! inx h ! mov h,m ! mov l,a ; get address of routine
pop d ; recover address of table
dcx d ! dcx d ; point to relative drive
ldax d ! sta @rdrv ; get relative drive code and post it
inx d ! inx d ; point to DPH again
pchl ; leap to driver
; MULTIO
; Set multiple sector count. Saves passed count in
; @CNT
multio:
sta @cnt ! ret
; FLUSH
; BIOS deblocking buffer flush. Not implemented.
flush:
xra a ! ret ; return with no error
; error message components
drive$msg db cr,lf,bell,'BIOS Error on ',0
track$msg db ': T-',0
sector$msg db ', S-',0
; disk communication data items
@adrv ds 1 ; currently selected disk drive
@rdrv ds 1 ; controller relative disk drive
@trk ds 2 ; current track number
@sect ds 2 ; current sector number
@dma ds 2 ; current DMA address
@cnt db 0 ; record count for multisector transfer
@dbnk db 0 ; bank for DMA operations
cseg ; common memory
@cbnk db 0 ; bank for processor operations
end

122
software/CPM/cpm3/boot.asm
View File

@@ -1,122 +0,0 @@
title 'Boot loader module for CP/M 3.0'
true equ -1
false equ not true
banked equ true
public ?init,?ldccp,?rlccp,?time
extrn ?pmsg,?conin
extrn @civec,@covec,@aivec,@aovec,@lovec
extrn @cbnk,?bnksl
maclib ports
maclib z80
bdos equ 5
if banked
tpa$bank equ 1
else
tpa$bank equ 0
endif
dseg ; init done from banked memory
?init:
lxi h,08000h ! shld @civec ! shld @covec ; assign console to CRT:
lxi h,04000h ! shld @lovec ; assign printer to LPT:
lxi h,02000h ! shld @aivec ! shld @aovec ; assign AUX to CRT1:
lxi h,init$table ! call out$blocks ; set up misc hardware
lxi h,signon$msg ! call ?pmsg ; print signon message
ret
out$blocks:
mov a,m ! ora a ! rz ! mov b,a
inx h ! mov c,m ! inx h
outir
jmp out$blocks
cseg ; boot loading most be done from resident memory
; This version of the boot loader loads the CCP from a file
; called CCP.COM on the system drive (A:).
?ldccp:
; First time, load the A:CCP.COM file into TPA
xra a ! sta ccp$fcb+15 ; zero extent
lxi h,0 ! shld fcb$nr ; start at beginning of file
lxi d,ccp$fcb ! call open ; open file containing CCP
inr a ! jz no$CCP ; error if no file...
lxi d,0100h ! call setdma ; start of TPA
lxi d,128 ! call setmulti ; allow up to 16k bytes
lxi d,ccp$fcb ! call read ; load the thing
; now,
; copy CCP to bank 0 for reloading
lxi h,0100h ! lxi b,0C80h ; clone 3K, just in case
lda @cbnk ! push psw ; save current bank
ld$1:
mvi a,tpa$bank ! call ?bnksl ; select TPA
mov a,m ! push psw ; get a byte
mvi a,2 ! call ?bnksl ; select extra bank
pop psw ! mov m,a ; save the byte
inx h ! dcx b ; bump pointer, drop count
mov a,b ! ora c ; test for done
jnz ld$1
pop psw ! call ?bnksl ; restore original bank
ret
no$CCP: ; here if we couldn't find the file
lxi h,ccp$msg ! call ?pmsg ; report this...
call ?conin ; get a response
jmp ?ldccp ; and try again
?rlccp:
lxi h,0100h ! lxi b,0C00h ; clone 3K
rl$1:
mvi a,2 ! call ?bnksl ; select extra bank
mov a,m ! push psw ; get a byte
mvi a,tpa$bank ! call ?bnksl ; select TPA
pop psw ! mov m,a ; save the byte
inx h ! dcx b ; bump pointer, drop count
mov a,b ! ora c ; test for done
jnz rl$1
ret
; No external clock.
?time:
ret
; CP/M BDOS Function Interfaces
open:
mvi c,15 ! jmp bdos ; open file control block
setdma:
mvi c,26 ! jmp bdos ; set data transfer address
setmulti:
mvi c,44 ! jmp bdos ; set record count
read:
mvi c,20 ! jmp bdos ; read records
signon$msg db 13,10,13,10,'CP/M Version 3.0, sample BIOS',13,10,0
ccp$msg db 13,10,'BIOS Err on A: No CCP.COM file',0
ccp$fcb db 1,'CCP ','COM',0,0,0,0
ds 16
fcb$nr db 0,0,0
init$table db 3,p$zpio$3a,0CFh,0FFh,07h ; set up config port
db 3,p$zpio$3b,0CFh,000h,07h ; set up bank port
db 1,p$bank$select,0 ; select bank 0
db 0 ; end of init$table
end

28
software/CPM/cpm3/callvers.asm
View File

@@ -1,28 +0,0 @@
; CALLVERS program
bdos equ 5 ; entry point for BDOS
prtstr equ 9 ; print string function
vers equ 12 ; get version function
cr equ 0dh ; carriage return
lf equ 0ah ; line feed
org 100h
mvi d,5 ; Perform 5 times
loop: push d ; save counter
mvi c,prtstr
lxi d,call$msg ; print call message
call bdos
mvi c,vers
call bdos ; try to get version #
; CALLVERS will intercept
mov a,l
sta curvers
pop d
dcr d ; decrement counter
jnz loop
mvi c,0
jmp bdos
call$msg:
db cr,lf,'**** CALLVERS **** $'
curvers db 0
end

2841
software/CPM/cpm3/ccp3.asm
View File

File diff suppressed because it is too large Load Diff

2807
software/CPM/cpm3/ccp3org.asm
View File

File diff suppressed because it is too large Load Diff

8
software/CPM/cpm3/ccpdate.asm
View File

@@ -1,8 +0,0 @@
org 368h
maclib makedate
db ' '
@BDATE ;[JCE] Copyright & build date now in MAKEDATE.LIB
db ' '
@SCOPY

175
software/CPM/cpm3/chario.asm
View File

@@ -1,175 +0,0 @@
title 'Character I/O handler for z80 chip based system'
; Character I/O for the Modular CP/M 3 BIOS
; limitations:
; baud rates 19200,7200,3600,1800 and 134
; are approximations.
; 9600 is the maximum baud rate that is likely
; to work.
; baud rates 50, 75, and 110 are not supported
public ?cinit,?ci,?co,?cist,?cost
public @ctbl
maclib Z80 ; define Z80 op codes
maclib ports ; define port addresses
maclib modebaud ; define mode bits and baud equates
max$devices equ 6
cseg
?cinit:
mov a,c ! cpi max$devices ! jz cent$init ; init parallel printer
rnc ; invalid device
mov l,c ! mvi h,0 ; make 16 bits from device number
push h ; save device in stack
dad h ! dad h ! dad h ; *8
lxi d,@ctbl+7 ! dad d ! mov l,m ; get baud rate
mov a,l ! cpi baud$600 ; see if baud > 300
mvi a,44h ! jnc hi$speed ; if >= 600, use *16 mode
mvi a,0C4h ; else, use *64 mode
hi$speed:
sta sio$reg$4
mvi h,0 ! lxi d,speed$table ! dad d ; point to counter entry
mov a,m ! sta speed ; get and save ctc count
pop h ; recover
lxi d,data$ports ! dad d ; point at SIO port address
mov a,m ! inr a ! sta sio$port ; get and save port
lxi d,baud$ports-data$ports ! dad d ; offset to baud rate port
mov a,m ! sta ctc$port ; get and save
lxi h,serial$init$tbl
jmp stream$out
cent$init:
lxi h,pio$init$tbl
stream$out:
mov a,m ! ora a ! rz
mov b,a ! inx h ! mov c,m ! inx h
outir
jmp stream$out
?ci: ; character input
mov a,b ! cpi 6 ! jnc null$input ; can't read from centronics
ci1:
call ?cist ! jz ci1 ; wait for character ready
dcr c ! inp a ; get data
ani 7Fh ; mask parity
ret
null$input:
mvi a,1Ah ; return a ctl-Z for no device
ret
?cist: ; character input status
mov a,b ! cpi 6 ! jnc null$status ; can't read from centronics
mov l,b ! mvi h,0 ; make device number 16 bits
lxi d,data$ports ! dad d ; make pointer to port address
mov c,m ! inr c ; get SIO status port
inp a ; read from status port
ani 1 ; isolate RxRdy
rz ; return with zero
ori 0FFh
ret
null$status:
xra a ! ret
?co: ; character output
mov a,b ! cpi 6 ! jz centronics$out
jnc null$output
mov a,c ! push psw ; save character from <C>
push b ; save device number
co$spin:
call ?cost ! jz co$spin ; wait for TxEmpty
pop h ! mov l,h ! mvi h,0 ; get device number in <HL>
lxi d,data$ports ! dad d ; make address of port address
mov c,m ; get port address
pop psw ! outp a ; send data
null$output:
ret
centronics$out:
in p$centstat ! ani 20h ! jnz centronics$out
mov a,c ! out p$centdata ; give printer data
in p$centstat ! ori 1 ! out p$centstat ; set strobe
ani 7Eh ! out p$centstat ; clear strobe
ret
?cost: ; character output status
mov a,b ! cpi 6 ! jz cent$stat
jnc null$status
mov l,b ! mvi h,0
lxi d,data$ports ! dad d
mov c,m ! inr c
inp a ; get input status
ani 4 ! rz ; test transmitter empty
ori 0FFh ! ret ; return true if ready
cent$stat:
in p$centstat ! cma
ani 20h ! rz
ori 0FFh ! ret
baud$ports: ; CTC ports by physical device number
db p$baud$con1,p$baud$lpt1,p$baud$con2,p$baud$con34
db p$baud$con34,p$baud$lpt2
data$ports: ; serial base ports by physical device number
db p$crt$data,p$lpt$data,p$con2data,p$con3data
db p$con4data,p$lpt2data
@ctbl db 'CRT ' ; device 0, CRT port 0
db mb$in$out+mb$serial+mb$softbaud
db baud$9600
db 'LPT ' ; device 1, LPT port 0
db mb$in$out+mb$serial+mb$softbaud+mb$xonxoff
db baud$9600
db 'CRT1 ' ; device 2, CRT port 1
db mb$in$out+mb$serial+mb$softbaud
db baud$9600
db 'CRT2 ' ; device 3, CRT port 2
db mb$in$out+mb$serial+mb$softbaud
db baud$9600
db 'CRT3 ' ; device 4, CRT port 3
db mb$in$out+mb$serial+mb$softbaud
db baud$9600
db 'VAX ' ; device 5, LPT port 1 used for VAX interface
db mb$in$out+mb$serial+mb$softbaud
db baud$9600
db 'CEN ' ; device 6, Centronics parallel printer
db mb$output
db baud$none
db 0 ; table terminator
speed$table db 0,255,255,255,233,208,104,208,104,69,52,35,26,17,13,7
serial$init$tbl
db 2 ; two bytes to CTC
ctc$port ds 1 ; port address of CTC
db 47h ; CTC mode byte
speed ds 1 ; baud multiplier
db 7 ; 7 bytes to SIO
sio$port ds 1 ; port address of SIO
db 18h,3,0E1h,4
sio$reg$4 ds 1
db 5,0EAh
db 0 ; terminator
pio$init$tbl db 2,p$zpio$2b,0Fh,07h
db 3,p$zpio$2a,0CFh,0F8h,07h
db 0
end

16
software/CPM/cpm3/comlit.lit
View File

@@ -1,16 +0,0 @@
declare
lit literally 'literally',
dcl lit 'declare',
true lit '0ffh',
false lit '0',
boolean lit 'byte',
forever lit 'while true',
cr lit '13',
lf lit '10',
tab lit '9',
ctrlc lit '3',
ff lit '12',
date$flag$offset lit '0ch', /* [JCE] UK dates? */
page$len$offset lit '1ch',
nopage$mode$offset lit '2Ch',
sectorlen lit '128';

908
software/CPM/cpm3/conbdos.asm
View File

@@ -1,908 +0,0 @@
title 'CP/M Bdos Interface, Bdos, Version 3.0 Nov, 1982'
;*****************************************************************
;*****************************************************************
;** **
;** B a s i c D i s k O p e r a t i n g S y s t e m **
;** **
;** C o n s o l e P o r t i o n **
;** **
;*****************************************************************
;*****************************************************************
;
; November 1982
;
;
; Console handlers
;
conin:
;read console character to A
lxi h,kbchar! mov a,m! mvi m,0! ora a! rnz
;no previous keyboard character ready
jmp coninf ;get character externally
;ret
;
conech:
LXI H,STA$RET! PUSH H
CONECH0:
;read character with echo
call conin! call echoc! JC CONECH1 ;echo character?
;character must be echoed before return
push psw! mov c,a! call tabout! pop psw
RET
CONECH1:
CALL TEST$CTLS$MODE! RNZ
CPI CTLS! JNZ CONECH2
CALL CONBRK2! JMP CONECH0
CONECH2:
CPI CTLQ! JZ CONECH0
CPI CTLP! JZ CONECH0
RET
;
echoc:
;echo character if graphic
;cr, lf, tab, or backspace
cpi cr! rz ;carriage return?
cpi lf! rz ;line feed?
cpi tab! rz ;tab?
cpi ctlh! rz ;backspace?
cpi ' '! ret ;carry set if not graphic
;
CONSTX:
LDA KBCHAR! ORA A! JNZ CONB1
CALL CONSTF! ANI 1! RET
;
if BANKED
SET$CTLS$MODE:
;SET CTLS STATUS OR INPUT FLAG FOR QUEUE MANAGER
LXI H,QFLAG! MVI M,40H! XTHL! PCHL
endif
;
TEST$CTLS$MODE:
;RETURN WITH Z FLAG RESET IF CTL-S CTL-Q CHECKING DISABLED
MOV B,A! LDA CONMODE! ANI 2! MOV A,B! RET
;
conbrk: ;check for character ready
CALL TEST$CTLS$MODE! JNZ CONSTX
lda kbchar! ora a! jnz CONBRK1 ;skip if active kbchar
;no active kbchar, check external break
;DOES BIOS HAVE TYPE AHEAD?
if BANKED
LDA TYPE$AHEAD! INR A! JZ CONSTX ;YES
endif
;CONBRKX CALLED BY CONOUT
CONBRKX:
;HAS CTL-S INTERCEPT BEEN DISABLED?
CALL TEST$CTLS$MODE! RNZ ;YES
;DOES KBCHAR CONTAIN CTL-S?
LDA KBCHAR! CPI CTLS! JZ CONBRK1 ;YES
if BANKED
CALL SET$CTLS$MODE
endif
;IS A CHARACTER READY FOR INPUT?
call constf
if BANKED
POP H! MVI M,0
endif
ani 1! rz ;NO
;character ready, read it
if BANKED
CALL SET$CTLS$MODE
endif
call coninf
if BANKED
POP H! MVI M,0
endif
CONBRK1:
cpi ctls! jnz conb0 ;check stop screen function
;DOES KBCHAR CONTAIN A CTL-S?
LXI H,KBCHAR! CMP M! JNZ CONBRK2 ;NO
MVI M,0 ; KBCHAR = 0
;found ctls, read next character
CONBRK2:
if BANKED
CALL SET$CTLS$MODE
endif
call coninf ;to A
if BANKED
POP H! MVI M,0
endif
cpi ctlc! JNZ CONBRK3
LDA CONMODE! ANI 08H! JZ REBOOTX
XRA A
CONBRK3:
SUI CTLQ! RZ ; RETURN WITH A = ZERO IF CTLQ
INR A! CALL CONB3! JMP CONBRK2
conb0:
LXI H,KBCHAR
MOV B,A
;IS CONMODE(1) TRUE?
LDA CONMODE! RAR! JNC $+7 ;NO
;DOES KBCHAR = CTLC?
MVI A,CTLC! CMP M! RZ ;YES - RETURN
MOV A,B
CPI CTLQ! JZ CONB2
CPI CTLP! JZ CONB2
;character in accum, save it
MOV M,A
conb1:
;return with true set in accumulator
mvi a,1! ret
CONB2:
XRA A! MOV M,A! RET
CONB3:
CZ TOGGLE$LISTCP
MVI C,7! CNZ CONOUTF
RET
;
TOGGLE$LISTCP:
; IS PRINTER ECHO DISABLED?
LDA CONMODE! ANI 14H! JNZ TOGGLE$L1 ;YES
LXI H,LISTCP! MVI A,1! XRA M! ANI 1
MOV M,A! RET
TOGGLE$L1:
XRA A! RET
;
QCONOUTF:
;DOES FX = INPUT?
LDA FX! DCR A! JZ CONOUTF ;YES
;IS ESCAPE SEQUENCE DECODING IN EFFECT?
MOV A,B
;;; ANI 8 ;[JCE] DRI Patch 13
ANI 10h
JNZ SCONOUTF ;YES
JMP CONOUTF
;
conout:
;compute character position/write console char from C
;compcol = true if computing column position
lda compcol! ora a! jnz compout
;write the character, then compute the column
;write console character from C
;B ~= 0 -> ESCAPE SEQUENCE DECODING
LDA CONMODE! ANI 14H! MOV B,A
push b
;CALL CONBRKX FOR OUTPUT FUNCTIONS ONLY
LDA FX! DCR A! CNZ CONBRKX
pop b! push b ;recall/save character
call QCONOUTF ;externally, to console
pop b
;SKIP ECHO WHEN CONMODE & 14H ~= 0
MOV A,B! ORA A! JNZ COMPOUT
push b ;recall/save character
;may be copying to the list device
lda listcp! ora a! cnz listf ;to printer, if so
pop b ;recall the character
compout:
mov a,c ;recall the character
;and compute column position
lxi h,column ;A = char, HL = .column
cpi rubout! rz ;no column change if nulls
inr m ;column = column + 1
cpi ' '! rnc ;return if graphic
;not graphic, reset column position
dcr m ;column = column - 1
mov a,m! ora a! rz ;return if at zero
;not at zero, may be backspace or end line
mov a,c ;character back to A
cpi ctlh! jnz notbacksp
;backspace character
dcr m ;column = column - 1
ret
notbacksp:
;not a backspace character, eol?
cpi cr! rnz ;return if not
;end of line, column = 0
mvi m,0 ;column = 0
ret
;
ctlout:
;send C character with possible preceding up-arrow
mov a,c! call echoc ;cy if not graphic (or special case)
jnc tabout ;skip if graphic, tab, cr, lf, or ctlh
;send preceding up arrow
push psw! mvi c,ctl! call conout ;up arrow
pop psw! ori 40h ;becomes graphic letter
mov c,a ;ready to print
if BANKED
call chk$column! rz
endif
;(drop through to tabout)
;
tabout:
;IS FX AN INPUT FUNCTION?
LDA FX! DCR A! JZ TABOUT1 ;YES - ALWAYS EXPAND TABS FOR ECHO
;HAS TAB EXPANSION BEEN DISABLED OR
;ESCAPE SEQUENCE DECODING BEEN ENABLED?
LDA CONMODE! ANI 14H! JNZ CONOUT ;YES
TABOUT1:
;expand tabs to console
mov a,c! cpi tab! jnz conout ;direct to conout if not
;tab encountered, move to next tab position
tab0:
if BANKED
lda fx! cpi 1! jnz tab1
call chk$column! rz
tab1:
endif
mvi c,' '! call conout ;another blank
lda column! ani 111b ;column mod 8 = 0 ?
jnz tab0 ;back for another if not
ret
;
;
backup:
;back-up one screen position
call pctlh
if BANKED
lda comchr! cpi ctla! rz
endif
mvi c,' '! call conoutf
; (drop through to pctlh) ;
pctlh:
;send ctlh to console without affecting column count
mvi c,ctlh! jmp conoutf
;ret
;
crlfp:
;print #, cr, lf for ctlx, ctlu, ctlr functions
;then move to strtcol (starting column)
mvi c,'#'! call conout
call crlf
;column = 0, move to position strtcol
crlfp0:
lda column! lxi h,strtcol
cmp m! rnc ;stop when column reaches strtcol
mvi c,' '! call conout ;print blank
jmp crlfp0
;;
;
crlf:
;carriage return line feed sequence
mvi c,cr! call conout! mvi c,lf! jmp conout
;ret
;
print:
;print message until M(BC) = '$'
LXI H,OUTDELIM
ldax b! CMP M! rz ;stop on $
;more to print
inx b! push b! mov c,a ;char to C
call tabout ;another character printed
pop b! jmp print
;
QCONIN:
if BANKED
lhld apos! mov a,m! sta ctla$sw
endif
;IS BUFFER ADDRESS = 0?
LHLD CONBUFFADD! MOV A,L! ORA H! JZ CONIN ;YES
;IS CHARACTER IN BUFFER < 5?
if BANKED
call qconinx ; mov a,m with bank 1 switched in
else
MOV A,M
endif
INX H
ORA A! JNZ QCONIN1 ; NO
LXI H,0
QCONIN1:
SHLD CONBUFFADD! SHLD CONBUFFLEN! RNZ ; NO
JMP CONIN
if BANKED
chk$column:
lda conwidth! mov e,a! lda column! cmp e! ret
;
expand:
xchg! lhld apos! xchg
expand1:
ldax d! ora a! rz
inx d! inx h! mov m,a! inr b! jmp expand1
;
copy$xbuff:
mov a,b! ora a! rz
push b! mov c,b! push h! xchg! inx d
lxi h,xbuff
call move
mvi m,0! shld xpos
pop h! pop b! ret
;
copy$cbuff:
lda ccpflgs+1! ral! rnc
lxi h,xbuff! lxi d,cbuff! inr c! jnz copy$cbuff1
xchg! mov a,b! ora a! rz
sta cbuff$len
push d! lxi b,copy$cbuff2! push b
mov b,a
copy$cbuff1:
inr b! mov c,b! jmp move
copy$cbuff2:
pop h! dcx h! mvi m,0! ret
;
save$col:
lda column! sta save$column! ret
;
clear$right:
lda column! lxi h,ctla$column! cmp m! rnc
mvi c,20h! call conout! jmp clear$right
;
reverse:
lda save$column! lxi h,column! cmp m! rnc
mvi c,ctlh! call conout! jmp reverse
;
chk$buffer$size:
push b! push h
lhld apos! mvi e,0
cbs1:
mov a,m! ora a! jz cbs2
inr e! inx h! jmp cbs1
cbs2:
mov a,b! add e! cmp c
push a! mvi c,7! cnc conoutf
pop a! pop h! pop b! rc
pop d! pop d! jmp readnx
;
refresh:
lda ctla$sw! ora a! rz
lda comchr! cpi ctla! rz
cpi ctlf! rz
cpi ctlw! rz
refresh0:
push h! push b
call save$col
lhld apos
refresh1:
mov a,m! ora a! jz refresh2
mov c,a! call chk$column! jc refresh05
mov a,e! sta column! jmp refresh2
refresh05:
push h! call ctlout
pop h! inx h! jmp refresh1
refresh2:
lda column! sta new$ctla$col
refresh3:
call clear$right
call reverse
lda new$ctla$col! sta ctla$column
pop b! pop h! ret
;
init$apos:
lxi h,aposi! shld apos
xra a! sta ctla$sw
ret
;
init$xpos:
lxi h,xbuff! shld xpos! ret
;
set$ctla$column:
lxi h,ctla$sw! mov a,m! ora a! rnz
inr m! lda column! sta ctla$column! ret
;
readi:
call chk$column! cnc crlf
lda cbuff$len! mov b,a
mvi c,0! call copy$cbuff
else
readi:
MOV A,D! ORA E! JNZ READ
LHLD DMAAD! SHLD INFO
INX H! INX H! SHLD CONBUFFADD
endif
read: ;read to info address (max length, current length, buffer)
if BANKED
call init$xpos
call init$apos
readx:
call refresh
xra a! sta ctlw$sw
readx1:
endif
MVI A,1! STA FX
lda column! sta strtcol ;save start for ctl-x, ctl-h
lhld info! mov c,m! inx h! push h
XRA A! MOV B,A! STA SAVEPOS
CMP C! JNZ $+4
INR C
;B = current buffer length,
;C = maximum buffer length,
;HL= next to fill - 1
readnx:
;read next character, BC, HL active
push b! push h ;blen, cmax, HL saved
readn0:
if BANKED
lda ctlw$sw! ora a! cz qconin
nxtline:
sta comchr
else
CALL QCONIN ;next char in A
endif
;ani 7fh ;mask parity bit
pop h! pop b ;reactivate counters
cpi cr! jz readen ;end of line?
cpi lf! jz readen ;also end of line
if BANKED
cpi ctlf! jnz not$ctlf
do$ctlf:
call chk$column! dcr e! cmp e! jnc readnx
do$ctlf0:
xchg! lhld apos! mov a,m! ora a! jz ctlw$l15
inx h! shld apos! xchg! jmp notr
not$ctlf:
cpi ctlw! jnz not$ctlw
do$ctlw:
xchg! lhld apos! mov a,m! ora a! jz ctlw$l1
xchg! call chk$column! dcr e! cmp e! xchg! jc ctlw$l0
xchg! call refresh0! xchg! jmp ctlw$l13
ctlw$l0:
lhld apos! mov a,m
inx h! shld apos! jmp ctlw$l3
ctlw$l1:
lxi h,ctla$sw! mov a,m! mvi m,0
ora a! jz ctlw$l2
ctlw$l13:
lxi h,ctlw$sw! mvi m,0
ctlw$l15:
xchg! jmp readnx
ctlw$l2:
lda ctlw$sw! ora a! jnz ctlw$l25
mov a,b! ora a! jnz ctlw$l15
call init$xpos
ctlw$l25:
lhld xpos! mov a,m! ora a
sta ctlw$sw! jz ctlw$l15
inx h! shld xpos
ctlw$l3:
lxi h,ctlw$sw! mvi m,ctlw
xchg! jmp notr
not$ctlw:
cpi ctla! jnz not$ctla
do$ctla:
;do we have any characters to back over?
lda strtcol! mov d,a! lda column! cmp d
jz readnx
sta compcol ;COL > 0
mov a,b! ora a! jz linelen
;characters remain in buffer, backup one
dcr b ;remove one character
;compcol > 0 marks repeat as length compute
;backup one position in xbuff
push h
call set$ctla$column
pop d
lhld apos! dcx h
shld apos! ldax d! mov m,a! xchg! jmp linelen
not$ctla:
cpi ctlb! jnz not$ctlb
do$ctlb:
lda save$pos! cmp b! jnz ctlb$l0
mvi a,ctlw! sta ctla$sw
sta comchr! jmp do$ctlw
ctlb$l0:
xchg! lhld apos! inr b
ctlb$l1:
dcr b! lda save$pos! cmp b! jz ctlb$l2
dcx h! ldax d! mov m,a! dcx d! jmp ctlb$l1
ctlb$l2:
shld apos
push b! push d
call set$ctla$column
ctlb$l3:
lda column! mov b,a
lda strtcol! cmp b! jz read$n0
mvi c,ctlh! call conout! jmp ctlb$l3
not$ctlb:
cpi ctlk! jnz not$ctlk
xchg! lxi h,aposi! shld apos
xchg! call refresh
jmp readnx
not$ctlk:
cpi ctlg! jnz not$ctlg
lda ctla$sw! ora a! jz readnx
jmp do$ctlf0
not$ctlg:
endif
cpi ctlh! jnz noth ;backspace?
LDA CTLH$ACT! INR A! JZ DO$RUBOUT
DO$CTLH:
;do we have any characters to back over?
LDA STRTCOL! MOV D,A! LDA COLUMN! CMP D
jz readnx
STA COMPCOL ;COL > 0
MOV A,B! ORA A! JZ $+4
;characters remain in buffer, backup one
dcr b ;remove one character
;compcol > 0 marks repeat as length compute
jmp linelen ;uses same code as repeat
noth:
;not a backspace
cpi rubout! jnz notrub ;rubout char?
LDA RUBOUT$ACT! INR A! JZ DO$CTLH
DO$RUBOUT:
if BANKED
mvi a,rubout! sta comchr
lda ctla$sw! ora a! jnz do$ctlh
endif
;rubout encountered, rubout if possible
mov a,b! ora a! jz readnx ;skip if len=0
;buffer has characters, resend last char
mov a,m! dcr b! dcx h ;A = last char
;blen=blen-1, next to fill - 1 decremented
jmp rdech1 ;act like this is an echo
notrub:
;not a rubout character, check end line
cpi ctle! jnz note ;physical end line?
;yes, save active counters and force eol
push b! MOV A,B! STA SAVE$POS
push h
if BANKED
lda ctla$sw! ora a! cnz clear$right
endif
call crlf
if BANKED
call refresh
endif
xra a! sta strtcol ;start position = 00
jmp readn0 ;for another character
note:
;not end of line, list toggle?
cpi ctlp! jnz notp ;skip if not ctlp
;list toggle - change parity
push h ;save next to fill - 1
PUSH B
XRA A! CALL CONB3
POP B
pop h! jmp readnx ;for another char
notp:
;not a ctlp, line delete?
cpi ctlx! jnz notx
pop h ;discard start position
;loop while column > strtcol
backx:
lda strtcol! lxi h,column
if BANKED
cmp m! jc backx1
lhld apos! mov a,m! ora a! jnz readx
jmp read
backx1:
else
cmp m! jnc read ;start again
endif
dcr m ;column = column - 1
call backup ;one position
jmp backx
notx:
;not a control x, control u?
;not control-X, control-U?
cpi ctlu! jnz notu ;skip if not
if BANKED
xthl! call copy$xbuff! xthl
endif
;delete line (ctlu)
do$ctlu:
call crlfp ;physical eol
pop h ;discard starting position
jmp read ;to start all over
notu:
;not line delete, repeat line?
cpi ctlr! jnz notr
XRA A! STA SAVEPOS
if BANKED
xchg! call init$apos! xchg
mov a,b! ora a! jz do$ctlu
xchg! lhld apos! inr b
ctlr$l1:
dcr b! jz ctlr$l2
dcx h! ldax d! mov m,a! dcx d
jmp ctlr$l1
ctlr$l2:
shld apos! push b! push d
call crlfp! mvi a,ctlw! sta ctlw$sw
sta ctla$sw! jmp readn0
endif
linelen:
;repeat line, or compute line len (ctlh)
;if compcol > 0
push b! call crlfp ;save line length
pop b! pop h! push h! push b
;bcur, cmax active, beginning buff at HL
rep0:
mov a,b! ora a! jz rep1 ;count len to 00
inx h! mov c,m ;next to print
DCR B
POP D! PUSH D! MOV A,D! SUB B! MOV D,A
push b! push h ;count length down
LDA SAVEPOS! CMP D! CC CTLOUT
pop h! pop b ;recall remaining count
jmp rep0 ;for the next character
rep1:
;end of repeat, recall lengths
;original BC still remains pushed
push h ;save next to fill
lda compcol! ora a ;>0 if computing length
jz readn0 ;for another char if so
;column position computed for ctlh
lxi h,column! sub m ;diff > 0
sta compcol ;count down below
;move back compcol-column spaces
backsp:
;move back one more space
call backup ;one space
lxi h,compcol! dcr m
jnz backsp
if BANKED
call refresh
endif
jmp readn0 ;for next character
notr:
;not a ctlr, place into buffer
;IS BUFFER FULL?
PUSH A
MOV A,B! CMP C! JC RDECH0 ;NO
;DISCARD CHARACTER AND RING BELL
POP A! PUSH B! PUSH H
MVI C,7! CALL CONOUTF! JMP READN0
RDECH0:
if BANKED
lda comchr! cpi ctlg! jz rdech05
lda ctla$sw! ora a! cnz chk$buffer$size
rdech05:
endif
POP A
inx h! mov m,a ;character filled to mem
inr b ;blen = blen + 1
rdech1:
;look for a random control character
push b! push h ;active values saved
mov c,a ;ready to print
if BANKED
call save$col
endif
call ctlout ;may be up-arrow C
pop h! pop b
if BANKED
lda comchr! cpi ctlg! jz do$ctlh
cpi rubout! jz rdech2
call refresh
rdech2:
endif
LDA CONMODE! ANI 08H
;;; JNZ NOTC ;[JCE] DRI Patch 13
jnz patch$064b
mov a,m ;recall char
cpi ctlc ;set flags for reboot test
patch$064b: mov a,b ;move length to A
jnz notc ;skip if not a control c
cpi 1 ;control C, must be length 1
jz REBOOTX ;reboot if blen = 1
;length not one, so skip reboot
notc:
;not reboot, are we at end of buffer?
if BANKED
cmp c! jnc buffer$full
else
jmp readnx ;go for another if not
endif
if BANKED
push b! push h
call chk$column! jc readn0
lda ctla$sw! ora a! jz do$new$line
lda comchr! cpi ctlw! jz back$one
cpi ctlf! jz back$one
do$newline:
mvi a,ctle! jmp nxtline
back$one:
;back up to previous character
pop h! pop b
dcr b! xchg
lhld apos! dcx h! shld apos
ldax d! mov m,a! xchg! dcx h
push b! push h! call reverse
;disable ctlb or ctlw
xra a! sta ctlw$sw! jmp readn0
buffer$full:
xra a! sta ctlw$sw! jmp readnx
endif
readen:
;end of read operation, store blen
if BANKED
call expand
endif
pop h! mov m,b ;M(current len) = B
if BANKED
push b
call copy$xbuff
pop b
mvi c,0ffh! call copy$cbuff
endif
LXI H,0! SHLD CONBUFFADD
mvi c,cr! jmp conout ;return carriage
;ret
;
func1 equ CONECH
;return console character with echo
;
func2: equ tabout
;write console character with tab expansion
;
func3:
;return reader character
call readerf
jmp sta$ret
;
;func4: equated to punchf
;write punch character
;
;func5: equated to listf
;write list character
;write to list device
;
func6:
;direct console i/o - read if 0ffh
mov a,c! inr a! jz dirinp ;0ffh => 00h, means input mode
inr a! JZ DIRSTAT ;0feh => direct STATUS function
INR A! JZ DIRINP1 ;0fdh => direct input, no status
JMP CONOUTF
DIRSTAT:
;0feH in C for status
CALL CONSTX! JNZ LRET$EQ$FF! JMP STA$RET
dirinp:
CALL CONSTX ;status check
ora a! RZ ;skip, return 00 if not ready
;character is ready, get it
dirinp1:
call CONIN ;to A
jmp sta$ret
;
func7:
call auxinstf
jmp sta$ret
;
func8:
call auxoutstf
jmp sta$ret
;
func9:
;write line until $ encountered
xchg ;was lhld info
mov c,l! mov b,h ;BC=string address
jmp print ;out to console
func10 equ readi
;read a buffered console line
func11:
;IS CONMODE(1) TRUE?
LDA CONMODE! RAR! JNC NORMAL$STATUS ;NO
;CTL-C ONLY STATUS CHECK
if BANKED
LXI H,QFLAG! MVI M,80H! PUSH H
endif
LXI H,CTLC$STAT$RET! PUSH H
;DOES KBCHAR = CTL-C?
LDA KBCHAR! CPI CTLC! JZ CONB1 ;YES
;IS THERE A READY CHARACTER?
CALL CONSTF! ORA A! RZ ;NO
;IS THE READY CHARACTER A CTL-C?
CALL CONINF! CPI CTLC! JZ CONB0 ;YES
STA KBCHAR! XRA A! RET
CTLC$STAT$RET:
if BANKED
CALL STA$RET
POP H! MVI M,0! RET
else
JMP STA$RET
endif
NORMAL$STATUS:
;check console status
call conbrk
;(drop through to sta$ret)
sta$ret:
;store the A register to aret
sta aret
func$ret: ;
ret ;jmp goback (pop stack for non cp/m functions)
;
setlret1:
;set lret = 1
mvi a,1! jmp sta$ret ;
;
FUNC109: ;GET/SET CONSOLE MODE
;DOES DE = 0FFFFH?
MOV A,D! ANA E! INR A
LHLD CONMODE! JZ STHL$RET ;YES - RETURN CONSOLE MODE
XCHG! SHLD CONMODE! RET ;NO - SET CONSOLE MODE
;
FUNC110: ;GET/SET FUNCTION 9 DELIMITER
LXI H,OUT$DELIM
;DOES DE = 0FFFFH?
MOV A,D! ANA E! INR A
MOV A,M! JZ STA$RET ;YES - RETURN DELIMITER
MOV M,E! RET ;NO - SET DELIMITER
;
FUNC111: ;PRINT BLOCK TO CONSOLE
FUNC112: ;LIST BLOCK
XCHG! MOV E,M! INX H! MOV D,M! INX H
MOV C,M! INX H! MOV B,M! XCHG
;HL = ADDR OF STRING
;BC = LENGTH OF STRING
BLK$OUT:
MOV A,B! ORA C! RZ
PUSH B! PUSH H! MOV C,M
LDA FX! CPI 111! JZ BLK$OUT1
CALL LISTF! JMP BLK$OUT2
BLK$OUT1:
CALL TABOUT
BLK$OUT2:
POP H! INX H! POP B! DCX B
JMP BLK$OUT
SCONOUTF EQU CONOUTF
;
; data areas
;
compcol:db 0 ;true if computing column position
strtcol:db 0 ;starting column position after read
if not BANKED
kbchar: db 0 ;initial key char = 00
endif
SAVEPOS:DB 0 ;POSITION IN BUFFER CORRESPONDING TO
;BEGINNING OF LINE
if BANKED
comchr: db 0
cbuff$len: db 0
cbuff: ds 256
db 0
xbuff: db 0
ds 354
aposi: db 0
xpos: dw 0
apos: dw 0
ctla$sw: db 0
ctlw$sw: db 0
save$column: db 0
ctla$column: db 0
new$ctla$col: db 0
endif
; end of BDOS Console module

8
software/CPM/cpm3/copyrt.lit
View File

@@ -1,8 +0,0 @@
/*
Copyright (C) 1982
Digital Research
P.O. Box 579
Pacific Grove, CA 93950
*/

837
software/CPM/cpm3/copysys.asm
View File

@@ -1,837 +0,0 @@
title 'Copysys - updated sysgen program 6/82'
; System generation program
VERS equ 30 ;version x.x for CP/M x.x
;
;**********************************************************
;* *
;* *
;* Copysys source code *
;* *
;* *
;**********************************************************
;
FALSE equ 0
TRUE equ not FALSE
;
;
NSECTS equ 26 ;no. of sectors
NTRKS equ 2 ;no. of systems tracks
NDISKS equ 4 ;no. of disks drives
SECSIZ equ 128 ;size of sector
LOG2SEC equ 7 ;LOG2 128
SKEW equ 2 ;skew sector factor
;
FCB equ 005Ch ;location of FCB
FCBCR equ FCB+32 ;current record location
TPA equ 0100h ;Transient Program Area
LOADP equ 1000h ;LOAD Point for system
BDOS equ 05h ;DOS entry point
BOOT equ 00h ;reboot for system
CONI equ 1h ;console input function
CONO equ 2h ;console output function
SELD equ 14 ;select a disk
OPENF equ 15 ;disk open function
CLOSEF equ 16 ;open a file
DWRITF equ 21 ;Write func
MAKEF equ 22 ;mae a file
DELTEF equ 19 ;delete a file
DREADF equ 20 ;disk read function
DRBIOS equ 50 ;Direct BIOS call function
EIGHTY equ 080h ;value of 80
CTLC equ 'C'-'@' ;ConTroL C
Y equ 89 ;ASCII value of Y
;
MAXTRY equ 01 ;maximum number of tries
CR equ 0Dh ;Carriage Return
LF equ 0Ah ;Line Feed
STACKSIZE equ 016h ;size of local stack
;
WBOOT equ 01 ;address of warm boot
;
SELDSK equ 9 ;Bios func #9 SELect DiSK
SETTRK equ 10 ;BIOS func #10 SET TRacK
SETSEC equ 11 ;BIOS func #11 SET SECtor
SETDMA equ 12 ;BIOS func #12 SET DMA address
READF equ 13 ;BIOS func #13 READ selected sector
WRITF equ 14 ;BIOS func #14 WRITe selected sector
;
org TPA ;Transient Program Area
jmp START
dw 0,0,0,0,0,0,0,0
dw 0,0,0,0,0,0,0,0
dw 0,0,0,0,0,0,0,0
dw 0,0,0,0,0,0,0,0
dw 0,0,0,0,0
db 0,0,0
maclib makedate
@LCOPY
@BDATE
db 0,0,0,0
db '654321'
;
; Translate table-sector numbers are translated here to decrease
; the systen tie for missed sectors when slow controllers are
; involved. Translate takes place according to the "SKEW" factor
; set above.
;
OST: db NTRKS ;operating system tracks
SPT: db NSECTS ;sectors per track
TRAN:
TRELT set 1
TRBASE set 1
rept NSECTS
db TRELT ;generate first/next sector
TRELT set TRELT+SKEW
if TRELT gt NSECTS
TRBASE set TRBASE+1
TRELT set TRBASE
endif
endm
;
; Now leave space for extensions to translate table
;
if NSECTS lt 64
rept 64-NSECTS
db 0
endm
endif
;
; Utility subroutines
;
MLTBY3:
;multiply the contents of regE to get jmp address
mov a,e ;Acc = E
sui 1
mov e,a ;get ready for multiply
add e
add e
mov e,a
ret ;back at it
;
SEL:
sta TEMP
lda V3FLG
cpi TRUE
lda TEMP
jnz SEL2
;
sta CREG ;CREG = selected register
lxi h,0000h
shld EREG ;for first time
mvi a,SELDSK
sta BIOSFC ;store it in func space
mvi c,DRBIOS
lxi d,BIOSPB
jmp BDOS
SEL2:
mov c,a
lhld WBOOT
lxi d,SELDSK
call MLTBY3
dad d
pchl
;
TRK:
; Set up track
sta TEMP
lda V3FLG
cpi TRUE
lda TEMP
jnz TRK2
;
mvi a,00h
sta BREG ;zero out B register
mov a,c ;Acc = track #
sta CREG ;set up PB
mvi a,SETTRK ;settrk func #
sta BIOSFC
mvi c,DRBIOS
lxi d,BIOSPB
jmp BDOS
TRK2:
lhld WBOOT
lxi d,SETTRK
call MLTBY3
dad d
pchl ;gone to set track
;
SEC:
; Set up sector number
sta TEMP
lda V3FLG
cpi TRUE
lda TEMP
jnz SEC2
;
mvi a,00h
sta BREG ;zero out BREG
mov a,c ; Acc = C
sta CREG ;CREG = sector #
mvi a,SETSEC
sta BIOSFC ;set up bios call
mvi c,DRBIOS
lxi d,BIOSPB
jmp BDOS
SEC2:
lhld WBOOT
lxi d,SETSEC
call MLTBY3
dad d
pchl
;
DMA:
; Set DMA address to value of BC
sta TEMP
lda V3FLG
cpi TRUE
lda TEMP
jnz DMA2
;
mov a,b ;
sta BREG ;
mov a,c ;Set up the BC
sta CREG ;register pair
mvi a,SETDMA ;
sta BIOSFC ;set up bios #
mvi c,DRBIOS
lxi d,BIOSPB
jmp BDOS
DMA2:
lhld WBOOT
lxi d,SETDMA
call MLTBY3
dad d
pchl
;
READ:
; Perform read operation
sta TEMP
lda V3FLG
cpi TRUE
lda TEMP
jnz READ2
;
mvi a,READF
sta BIOSFC
mvi c,DRBIOS
lxi d,BIOSPB
jmp BDOS
READ2:
lhld WBOOT
lxi d,READF
call MLTBY3
dad d
pchl
;
WRITE:
; Perform write operation
sta TEMP
lda V3FLG
cpi TRUE
lda TEMP
jnz WRITE2
;
mvi a,WRITF
sta BIOSFC ;set up bios #
mvi c,DRBIOS
lxi d,BIOSPB
jmp BDOS
WRITE2:
lhld WBOOT
lxi d,WRITF
call MLTBY3
dad d
pchl
;
MULTSEC:
; Multiply the sector # in rA by the sector size
mov l,a
mvi h,0 ;sector in hl
rept LOG2SEC
dad h
endm
ret ;with HL - sector*sectorsize
;
GETCHAR:
; Read console character to rA
mvi c,CONI
call BDOS
; Convert to upper case
cpi 'A' or 20h
rc
cpi ('Z' or 20h)+1
rnc
ani 05Fh
ret
;
PUTCHAR:
; Write character from rA to console
mov e,a
mvi c,CONO
call BDOS
ret
;
CRLF:
; Send Carriage Return, Line Feed
mvi a,CR
call PUTCHAR
mvi a,LF
call PUTCHAR
ret
;
CRMSG:
; Print message addressed by the HL until zero with leading CRLF
push d
call CRLF
pop d ;drop through to OUTMSG
OUTMSG:
mvi c,9
jmp BDOS
;
SELCT:
; Select disk given by rA
mvi c,0Eh
jmp BDOS
;
DWRITE:
; Write for file copy
mvi c,DWRITF
jmp BDOS
;
DREAD:
; Disk read function
mvi c,DREADF
jmp BDOS
;
OPEN:
; File open function
mvi c,OPENF
jmp BDOS
;
CLOSE:
mvi c,CLOSEF
jmp BDOS
;
MAKE:
mvi c,MAKEF
jmp BDOS
;
DELETE:
mvi c,DELTEF
jmp BDOS
;
;
;
DSTDMA:
mvi c,26
jmp BDOS
;
SOURCE:
lxi d,GETPRM ;ask user for source drive
call CRMSG
call GETCHAR ;obtain response
cpi CR ;is it CR?
jz DFLTDR ;skip if CR only
cpi CTLC ;isit ^C?
jz REBOOT
;
sui 'A' ;normalize drive #
cpi NDISKS ;valid drive?
jc GETC ;skip to GETC if so
;
; Invalid drive
call BADDISK ;tell user bad drive
jmp SOURCE ;try again
;
GETC:
; Select disk given by Acc.
adi 'A'
sta GDISK ;store source disk
sui 'A'
mov e,a ;move disk into E for select func
call SEL ;select the disk
jmp GETVER
;
DFLTDR:
mvi c,25 ;func 25 for current disk
call BDOS ;get curdsk
adi 'A'
sta GDISK
call CRLF
lxi d,VERGET
call OUTMSG
jmp VERCR
;
GETVER:
; Getsys set r/w to read and get the system
call CRLF
lxi d,VERGET ;verify source disk
call OUTMSG
VERCR: call GETCHAR
cpi CR
jnz REBOOT ;jmp only if not verified
call CRLF
ret
;
DESTIN:
lxi d,PUTPRM ;address of message
call CRMSG ;print it
call GETCHAR ;get answer
cpi CR
jz REBOOT ;all done
sui 'A'
cpi NDISKS ;valid disk
jc PUTC
;
; Invalid drive
call BADDISK ;tell user bad drive
jmp PUTSYS ;to try again
;
PUTC:
; Set disk fron rA
adi 'A'
sta PDISK ;message sent
sui 'A'
mov e,a ;disk # in E
call SEL ;select destination drive
; Put system, set r/w to write
lxi d,VERPUT ;verify dest prmpt
call CRMSG ;print it out
call GETCHAR ;retrieve answer
cpi CR
jnz REBOOT ;exit to system if error
call CRLF
ret
;
;
GETPUT:
; Get or put CP/M (rw = 0 for read, 1 for write)
; disk is already selected
lxi h,LOADP ;load point in RAM for DMA address
shld DMADDR
;
;
;
;
; Clear track 00
mvi a,-1 ;
sta TRACK
;
RWTRK:
; Read or write next track
lxi h,TRACK
inr m ;track = track+1
lda OST ;# of OS tracks
cmp m ;=track # ?
jz ENDRW ;end of read/write
;
; Otherwise not done
mov c,m ;track number
call TRK ;set to track
mvi a,-1 ;counts 0,1,2,...,25
sta SECTOR
;
RWSEC:
; Read or write a sector
lda SPT ;sectors per track
lxi h,SECTOR
inr m ;set to next sector
cmp m ;A=26 and M=0,1,..,25
jz ENDTRK
;
; Read or write sector to or from current DMA address
lxi h,SECTOR
mov e,m ;sector number
mvi d,0 ;to DE
lxi h,TRAN
mov b,m ;tran(0) in B
dad d ;sector translated
mov c,m ;value to C ready for select
push b ;save tran(0)
call SEC
pop b ;recall tran(0),tran(sector)
mov a,c ;tran(sector)
sub b ;--tran(sector)
call MULTSEC ;*sector size
xchg ;to DE
lhld DMADDR ;base DMA
dad d
mov b,h
mov c,l ;to set BC for SEC call
call DMA ;dma address set from BC
xra a
sta RETRY ;to set zero retries
;
TRYSEC:
; Try to read or write current sector
lda RETRY
cpi MAXTRY
jc TRYOK
;
; Past MAXTRY, message and ignore
lxi d,ERRMSG
call OUTMSG
call GETCHAR
cpi CR
jnz REBOOT
;
; Typed a CR, ok to ignore
call CRLF
jmp RWSEC
;
TRYOK:
; Ok to tyr read write
inr a
sta RETRY
lda RW
ora a
jz TRYREAD
;
; Must be write
call WRITE
jmp CHKRW
TRYREAD:
call READ
CHKRW:
ora a
jz RWSEC ;zero flag if read/write ok
;
;Error, retry operation
jmp TRYSEC
;
; End of track
ENDTRK:
lda SPT ;sectors per track
call MULTSEC ;*secsize
xchg ; to DE
lhld DMADDR ;base dma for this track
dad d ;+spt*secsize
shld DMADDR ;ready for next track
jmp RWTRK ;for another track
;
ENDRW:
; End of read or write
ret
;
;*******************
;*
;* MAIN ROUTINE
;*
;*
;*******************
;
START:
lxi sp,STACK
lxi d,SIGNON
call OUTMSG
;
;get version number to check compatability
mvi c,12 ;version check
call BDOS
mov a,l ;version in Acc
cpi 30h ;version 3 or newer?
jc OLDRVR ;
mvi a,TRUE
sta V3FLG ;
jmp FCBCHK
OLDRVR:
mvi a,FALSE
sta V3FLG
;
; Check for default file liad instead of get
FCBCHK: lda FCB+1 ;blank if no file
cpi ' '
jz GETSYS ;skip to system message
lxi d,FCB ;try to open it
call OPEN
inr a ;255 becomes 00
jnz RDOK
;
; File not present
lxi d,NOFILE
call CRMSG
jmp REBOOT
;
;file present
RDOK:
xra a
sta FCBCR ;current record = 0
lxi h,LOADP
RDINP:
push h
mov b,h
mov c,l
call DMA ;DMA address set
lxi d,FCB ;ready fr read
call DREAD
pop h ;recall
ora a ;00 if read ok
jnz PUTSYS ;assume eof if not
; More to read continue
lxi d,SECSIZ
dad d ;HL is new load address
jmp RDINP
;
GETSYS:
call SOURCE ;find out source drive
;
xra a ;zero out a
sta RW ;RW = 0 to signify read
call GETPUT ;get or read system
lxi d,DONE ;end message of get or read func
call OUTMSG ;print it out
;
; Put the system
PUTSYS:
call DESTIN ;get dest drive
;
lxi h,RW ;load address
mvi m,1
call GETPUT ;to put system back on disk
lxi d,DONE
call OUTMSG ;print out end prompt
;
; FILE COPY FOR CPM.SYS
;
CPYCPM:
; Prompt the user for the source of CP/M3.SYS
;
lxi d,CPYMSG ;print copys prompt
call CRMSG ;print it
call GETCHAR ;obtain reply
cpi Y ;is it yes?
jnz REBOOT ;if not exit
;else
;
;
mvi c,13 ;func # for reset
call BDOS ;
inr a
lxi d,ERRMSG
cz FINIS
;
call SOURCE ;get source disk for CPM3.SYS
CNTNUE:
lda GDISK ;Acc = source disk
sui 'A'
mvi d,00h
mov e,a ;DE = selected disk
call SELCT
; now copy the FCBs
mvi c,36 ;for copy
lxi d,SFCB ;source file
lxi h,DFCB ;destination file
MFCB:
ldax d
inx d ;ready next
mov m,a
inx h ;ready next dest
dcr c ;decrement coun
jnz MFCB
;
lda GDISK ;Acc = source disk
sui 40h ;correct disk
lxi h,SFCB
mov m,a ;SFCB has source disk #
lda PDISK ;get the dest. disk
lxi h,DFCB ;
sui 040h ;normalize disk
mov m,a
;
xra a ;zero out a
sta DFCBCR ;current rec = 0
;
; Source and destination fcb's ready
;
lxi d,SFCB ;
call OPEN ;open the file
lxi d,NOFILE ;error messg
inr a ;255 becomes 0
cz FINIS ;done if no file
;
; Source file is present and open
lxi d,LOADP ;get DMA address
xchg ;move address to HL regs
shld BEGIN ;save for begin of write
;
lda BEGIN ;get low byte of
mov l,a ;DMA address into L
lda BEGIN+1 ;
mov h,a ;into H also
COPY1:
xchg ;DE = address of DMA
call DSTDMA ;
;
lxi d,SFCB ;
call DREAD ;read next record
ora a ;end of file?
jnz EOF ;skip write if so
;
lda CRNREC
inr a ;bump it
sta CRNREC
;
lda BEGIN
mov l,a
lda BEGIN+1
mov h,a
lxi d,EIGHTY
dad d ;add eighty to begin address
shld BEGIN
jmp COPY1 ;loop until EOF
;
EOF:
lxi d,DONE
call OUTMSG
;
COPY2:
call DESTIN ;get destination drive for CPM3.SYS
lxi d,DFCB ;set up dest FCB
xchg
lda PDISK
sui 040h ;normalize disk
mov m,a ;correct disk for dest
xchg ;DE = DFCB
call DELETE ;delete file if there
;
lxi d,DFCB ;
call MAKE ;make a new one
lxi d,NODIR
inr a ;check directory space
cz FINIS ;end if none
;
lxi d,LOADP
xchg
shld BEGIN
;
lda BEGIN
mov l,a
lda BEGIN+1
mov h,a
LOOP2:
xchg
call DSTDMA
lxi d,DFCB
call DWRITE
lxi d,FSPACE
ora a
cnz FINIS
lda CRNREC
dcr a
sta CRNREC
cpi 0
jz FNLMSG
lda BEGIN
mov l,a
lda BEGIN+1
mov h,a
lxi d,EIGHTY
dad d
shld BEGIN
jmp LOOP2
; Copy operation complete
FNLMSG:
lxi d,DFCB
mvi c,CLOSEF
call BDOS
;
lxi d,DONE
;
FINIS:
; Write message given by DE, reboot
call OUTMSG
;
REBOOT:
mvi c,13
call BDOS
call CRLF
jmp BOOT
;
BADDISK:
lxi d,QDISK
call CRMSG
ret
;****************************
;*
;*
;* DATA STRUCTURES
;*
;*
;****************************
;
BIOSPB:
; BIOS Parameter Block
BIOSFC: db 0 ;BIOS function number
AREG: db 0 ;A register contents
CREG: db 0 ;C register contents
BREG: db 0 ;B register contents
EREG: db 0 ;E register contents
DREG: db 0 ;D register contents
HLREG: dw 0 ;HL register contents
;
SFCB:
DR: ds 1
F1F8: db 'CPM3 '
T1T3: db 'SYS'
EXT: db 0
CS: db 0
RS: db 0
RCC: db 0
D0D15: ds 16
CCR: db 0
R0R2: ds 3
;
DFCB: ds 36
DFCBCR equ DFCB+32
;
;
V3FLG: db 0 ;flag for version #
TEMP: db 0
SDISK: ds 1 ;selected disk
BEGIN: dw 0
DFLAG: db 0
TRACK: ds 1 ;current track
CRNREC: db 0 ;current rec count
SECTOR: ds 1 ;current sector
RW: ds 1 ;read if 0 write if 1
DMADDR: ds 2 ;current DMA address
RETRY: ds 1 ;number of tries on this sector
SIGNON: db 'CP/M 3 COPYSYS - Version '
db VERS/10+'0','.',VERS mod 10 +'0'
db '$'
GETPRM: db 'Source drive name (or return for default) $'
VERGET: db 'Source on '
GDISK: ds 1
db ' then type return $'
PUTPRM: db 'Destination drive name (or return to reboot) $'
VERPUT: db 'Destination on '
PDISK: ds 1
db ' then type return $'
CPYMSG: db 'Do you wish to copy CPM3.SYS? $'
DONE: db 'Function complete$'
;
; Error messages......
;
QDISK: db 'ERROR: Invalid drive name (Use A, B, C, or D)$'
NOFILE: db 'ERROR: No source file on disk.$'
NODIR: db 'ERROR: No directory space.$'
FSPACE: db 'ERROR: Out of data space.$'
WRPROT: db 'ERROR: Write protected?$'
ERRMSG: db 'ERROR: Possible incompatible disk format.'
db CR,LF,' Type return to ignore.$'
CLSERR: db 'ERROR: Close operation failed.$'
;
ds STACKSIZE * 3
STACK:
end


7900
software/CPM/cpm3/cpmbdos.asm
View File

File diff suppressed because it is too large Load Diff

711
software/CPM/cpm3/cpmbdos1.asm
View File

@@ -1,711 +0,0 @@
title 'CP/M BDOS Interface, BDOS, Version 3.0 Dec, 1982'
;*****************************************************************
;*****************************************************************
;** **
;** B a s i c D i s k O p e r a t i n g S y s t e m **
;** **
;** I n t e r f a c e M o d u l e **
;** **
;*****************************************************************
;*****************************************************************
;
; Copyright (c) 1978, 1979, 1980, 1981, 1982
; Digital Research
; Box 579, Pacific Grove
; California
;
; December 1982
;
on equ 0ffffh
off equ 00000h
MPM equ off
BANKED equ off
;
; equates for non graphic characters
;
ctla equ 01h ; control a
ctlb equ 02h ; control b
ctlc equ 03h ; control c
ctle equ 05h ; physical eol
ctlf equ 06h ; control f
ctlg equ 07h ; control g
ctlh equ 08h ; backspace
ctlk equ 0bh ; control k
ctlp equ 10h ; prnt toggle
ctlq equ 11h ; start screen
ctlr equ 12h ; repeat line
ctls equ 13h ; stop screen
ctlu equ 15h ; line delete
ctlw equ 17h ; control w
ctlx equ 18h ; =ctl-u
ctlz equ 1ah ; end of file
rubout equ 7fh ; char delete
tab equ 09h ; tab char
cr equ 0dh ; carriage return
lf equ 0ah ; line feed
ctl equ 5eh ; up arrow
org 0000h
base equ $
; Base page definitions
bnkbdos$pg equ base+0fc00h
resbdos$pg equ base+0fd00h
scb$pg equ base+0fb00h
bios$pg equ base+0ff00h
; Bios equates
bios equ bios$pg
bootf equ bios$pg ; 00. cold boot function
if BANKED
wbootf equ scb$pg+68h ; 01. warm boot function
constf equ scb$pg+6eh ; 02. console status function
coninf equ scb$pg+74h ; 03. console input function
conoutf equ scb$pg+7ah ; 04. console output function
listf equ scb$pg+80h ; 05. list output function
else
wbootf equ bios$pg+3 ; 01. warm boot function
constf equ bios$pg+6 ; 02. console status function
coninf equ bios$pg+9 ; 03. console input function
conoutf equ bios$pg+12 ; 04. console output function
listf equ bios$pg+15 ; 05. list output function
endif
punchf equ bios$pg+18 ; 06. punch output function
readerf equ bios$pg+21 ; 07. reader input function
homef equ bios$pg+24 ; 08. disk home function
seldskf equ bios$pg+27 ; 09. select disk function
settrkf equ bios$pg+30 ; 10. set track function
setsecf equ bios$pg+33 ; 11. set sector function
setdmaf equ bios$pg+36 ; 12. set dma function
readf equ bios$pg+39 ; 13. read disk function
writef equ bios$pg+42 ; 14. write disk function
liststf equ bios$pg+45 ; 15. list status function
sectran equ bios$pg+48 ; 16. sector translate
conoutstf equ bios$pg+51 ; 17. console output status function
auxinstf equ bios$pg+54 ; 18. aux input status function
auxoutstf equ bios$pg+57 ; 19. aux output status function
devtblf equ bios$pg+60 ; 20. retunr device table address fx
devinitf equ bios$pg+63 ; 21. initialize device function
drvtblf equ bios$pg+66 ; 22. return drive table address
multiof equ bios$pg+69 ; 23. multiple i/o function
flushf equ bios$pg+72 ; 24. flush function
movef equ bios$pg+75 ; 25. memory move function
timef equ bios$pg+78 ; 26. system get/set time function
selmemf equ bios$pg+81 ; 27. select memory function
setbnkf equ bios$pg+84 ; 28. set dma bank function
xmovef equ bios$pg+87 ; 29. extended move function
if BANKED
; System Control Block equates
olog equ scb$pg+090h
rlog equ scb$pg+092h
SCB equ scb$pg+09ch
; Expansion Area - 6 bytes
hashl equ scb$pg+09ch
hash equ scb$pg+09dh
version equ scb$pg+0a1h
; Utilities Section - 8 bytes
util$flgs equ scb$pg+0a2h
dspl$flgs equ scb$pg+0a6h
; CLP Section - 4 bytes
clp$flgs equ scb$pg+0aah
clp$errcde equ scb$pg+0ach
; CCP Section - 8 bytes
ccp$comlen equ scb$pg+0aeh
ccp$curdrv equ scb$pg+0afh
ccp$curusr equ scb$pg+0b0h
ccp$conbuff equ scb$pg+0b1h
ccp$flgs equ scb$pg+0b3h
; Device I/O Section - 32 bytes
conwidth equ scb$pg+0b6h
column equ scb$pg+0b7h
conpage equ scb$pg+0b8h
conline equ scb$pg+0b9h
conbuffadd equ scb$pg+0bah
conbufflen equ scb$pg+0bch
conin$rflg equ scb$pg+0beh
conout$rflg equ scb$pg+0c0h
auxin$rflg equ scb$pg+0c2h
auxout$rflg equ scb$pg+0c4h
lstout$rflg equ scb$pg+0c6h
page$mode equ scb$pg+0c8h
pm$default equ scb$pg+0c9h
ctlh$act equ scb$pg+0cah
rubout$act equ scb$pg+0cbh
type$ahead equ scb$pg+0cch
contran equ scb$pg+0cdh
conmode equ scb$pg+0cfh
outdelim equ scb$pg+0d3h
listcp equ scb$pg+0d4h
qflag equ scb$pg+0d5h
; BDOS Section - 42 bytes
scbadd equ scb$pg+0d6h
dmaad equ scb$pg+0d8h
olddsk equ scb$pg+0dah
info equ scb$pg+0dbh
resel equ scb$pg+0ddh
relog equ scb$pg+0deh
fx equ scb$pg+0dfh
usrcode equ scb$pg+0e0h
dcnt equ scb$pg+0e1h
;searcha equ scb$pg+0e3h
searchl equ scb$pg+0e5h
multcnt equ scb$pg+0e6h
errormode equ scb$pg+0e7h
searchchain equ scb$pg+0e8h
temp$drive equ scb$pg+0ech
errdrv equ scb$pg+0edh
media$flag equ scb$pg+0f0h
bdos$flags equ scb$pg+0f3h
stamp equ scb$pg+0f4h
commonbase equ scb$pg+0f9h
error equ scb$pg+0fbh ;jmp error$sub
bdosadd equ scb$pg+0feh
; Resbdos equates
resbdos equ resbdos$pg
move$out equ resbdos$pg+9 ; a=bank #, hl=dest, de=srce
move$tpa equ resbdos$pg+0ch ; a=bank #, hl=dest, de=srce
srch$hash equ resbdos$pg+0fh ; a=bank #, hl=hash table addr
hashmx equ resbdos$pg+12h ; max hash search dcnt
rd$dir$flag equ resbdos$pg+14h ; directory read flag
make$xfcb equ resbdos$pg+15h ; make function flag
find$xfcb equ resbdos$pg+16h ; search function flag
xdcnt equ resbdos$pg+17h ; dcnt save for empty fcb,
; user 0 fcb, or xfcb
xdmaad equ resbdos$pg+19h ; resbdos dma copy area addr
curdma equ resbdos$pg+1bh ; current dma
copy$cr$only equ resbdos$pg+1dh ; dont restore fcb flag
user$info equ resbdos$pg+1eh ; user fcb address
kbchar equ resbdos$pg+20h ; conbdos look ahead char
qconinx equ resbdos$pg+21h ; qconin mov a,m routine
ELSE
move$out equ movef
move$tpa equ movef
ENDIF
;
serial: db '654321'
;
; Enter here from the user's program with function number in c,
; and information address in d,e
;
bdose: ; Arrive here from user programs
xchg! shld info! xchg ; info=de, de=info
mov a,c! sta fx! cpi 14! jc bdose2
lxi h,0! shld dircnt ; dircnt,multnum = 0
lda olddsk! sta seldsk ; Set seldsk
if BANKED
dcr a! sta copy$cr$init
ENDIF
; If mult$cnt ~= 1 then read or write commands
; are handled by the shell
lda mult$cnt! dcr a! jz bdose2
lxi h,mult$fxs
bdose1:
mov a,m! ora a! jz bdose2
cmp c! jz shell
inx h! jmp bdose1
bdose2:
mov a,e! sta linfo ; linfo = low(info) - don't equ
lxi h,0! shld aret ; Return value defaults to 0000
shld resel ; resel,relog = 0
; Save user's stack pointer, set to local stack
dad sp! shld entsp ; entsp = stackptr
if not BANKED
lxi sp,lstack ; local stack setup
ENDIF
lxi h,goback ; Return here after all functions
push h ; jmp goback equivalent to ret
mov a,c! cpi nfuncs! jnc high$fxs ; Skip if invalid #
mov c,e ; possible output character to c
lxi h,functab! jmp bdos$jmp
; look for functions 98 ->
high$fxs:
cpi 128! jnc test$152
sui 98! jc lret$eq$ff ; Skip if function < 98
cpi nfuncs2! jnc lret$eq$ff
lxi h,functab2
bdos$jmp:
mov e,a! mvi d,0 ; de=func, hl=.ciotab
dad d! dad d! mov e,m! inx h! mov d,m ; de=functab(func)
lhld info ; info in de for later xchg
xchg! pchl ; dispatched
; CAUTION: In banked systems only,
; error$sub is referenced indirectly by the SCB ERROR
; field in RESBDOS as (0fc7ch). This value is converted
; to the actual address of error$sub by GENSYS. If the offset
; of error$sub is changed, the SCB ERROR value must also
; be changed.
;
; error subroutine
;
error$sub:
mvi b,0! push b! dcr c
lxi h,errtbl! dad b! dad b
mov e,m! inx h! mov d,m! xchg
call errflg
pop b! lda error$mode! ora a! rnz
jmp reboote
mult$fxs: db 20,21,33,34,40,0
maclib makedate
if BANKED
@LCOPY
@BDATE
else
@SCOPY
@BDATE
; 31 level stack
dw 0c7c7h,0c7c7h,0c7c7h,0c7c7h,0c7c7h,0c7c7h,0c7c7h
dw 0c7c7h,0c7c7h,0c7c7h,0c7c7h,0c7c7h,0c7c7h,0c7c7h,0c7c7h
dw 0c7c7h,0c7c7h,0c7c7h,0c7c7h,0c7c7h,0c7c7h,0c7c7h,0c7c7h
dw 0c7c7h,0c7c7h,0c7c7h,0c7c7h,0c7c7h,0c7c7h,0c7c7h,0c7c7h
lstack:
endif
; dispatch table for functions
functab:
dw rebootx1, func1, func2, func3
dw punchf, listf, func6, func7
dw func8, func9, func10, func11
diskf equ ($-functab)/2 ; disk funcs
dw func12,func13,func14,func15
dw func16,func17,func18,func19
dw func20,func21,func22,func23
dw func24,func25,func26,func27
dw func28,func29,func30,func31
dw func32,func33,func34,func35
dw func36,func37,func38,func39
dw func40,lret$eq$ff,func42,func43
dw func44,func45,func46,func47
dw func48,func49,func50
nfuncs equ ($-functab)/2
functab2:
dw func98,func99
dw func100,func101,func102,func103
dw func104,func105,func106,func107
dw func108,func109,func110,func111
dw func112
nfuncs2 equ ($-functab2)/2
errtbl:
dw permsg
dw rodmsg
dw rofmsg
dw selmsg
dw 0
dw 0
dw passmsg
dw fxstsmsg
dw wildmsg
test$152:
cpi 152! rnz
;
; PARSE version 3.0b Oct 08 1982 - Doug Huskey
;
;
; DE->.(.filename,.fcb)
;
; filename = [d:]file[.type][;password]
;
; fcb assignments
;
; 0 => drive, 0 = default, 1 = A, 2 = B, ...
; 1-8 => file, converted to upper case,
; padded with blanks (left justified)
; 9-11 => type, converted to upper case,
; padded with blanks (left justified)
; 12-15 => set to zero
; 16-23 => password, converted to upper case,
; padded with blanks
; 24-25 => 0000h
; 26 => length of password (0 - 8)
;
; Upon return, HL is set to FFFFH if DE locates
; an invalid file name;
; otherwise, HL is set to 0000H if the delimiter
; following the file name is a 00H (NULL)
; or a 0DH (CR);
; otherwise, HL is set to the address of the delimiter
; following the file name.
;
lxi h,sthl$ret
push h
lhld info
mov e,m ;get first parameter
inx h
mov d,m
push d ;save .filename
inx h
mov e,m ;get second parameter
inx h
mov d,m
pop h ;DE=.fcb HL=.filename
xchg
parse0:
push h ;save .fcb
xra a
mov m,a ;clear drive byte
inx h
lxi b,20h*256+11
call pad ;pad name and type w/ blanks
lxi b,4
call pad ;EXT, S1, S2, RC = 0
lxi b,20h*256+8
call pad ;pad password field w/ blanks
lxi b,12
call pad ;zero 2nd 1/2 of map, cr, r0 - r2
;
; skip spaces
;
call skps
;
; check for drive
;
ldax d
cpi ':' ;is this a drive?
dcx d
pop h
push h ;HL = .fcb
jnz parse$name
;
; Parse the drive-spec
;
parsedrv:
call delim
jz parse$ok
sui 'A'
jc perror1
cpi 16
jnc perror1
inx d
inx d ;past the ':'
inr a ;set drive relative to 1
mov m,a ;store the drive in FCB(0)
;
; Parse the file-name
;
parse$name:
inx h ;HL = .fcb(1)
call delim
jz parse$ok
lxi b,7*256
parse6: ldax d ;get a character
cpi '.' ;file-type next?
jz parse$type ;branch to file-type processing
cpi ';'
jz parse$pw
call gfc ;process one character
jnz parse6 ;loop if not end of name
jmp parse$ok
;
; Parse the file-type
;
parse$type:
inx d ;advance past dot
pop h
push h ;HL =.fcb
lxi b,9
dad b ;HL =.fcb(9)
lxi b,2*256
parse8: ldax d
cpi ';'
jz parsepw
call gfc ;process one character
jnz parse8 ;loop if not end of type
;
parse$ok:
pop b
push d
call skps ;skip trailing blanks and tabs
dcx d
call delim ;is next nonblank char a delim?
pop h
rnz ;no
lxi h,0
ora a
rz ;return zero if delim = 0
cpi cr
rz ;return zero if delim = cr
xchg
ret
;
; handle parser error
;
perror:
pop b ;throw away return addr
perror1:
pop b
lxi h,0ffffh
ret
;
; Parse the password
;
parsepw:
inx d
pop h
push h
lxi b,16
dad b
lxi b,7*256+1
parsepw1:
call gfc
jnz parsepw1
mvi a,7
sub b
pop h
push h
lxi b,26
dad b
mov m,a
ldax d ;delimiter in A
jmp parse$ok
;
; get next character of name, type or password
;
gfc: call delim ;check for end of filename
rz ;return if so
cpi ' ' ;check for control characters
inx d
jc perror ;error if control characters encountered
inr b ;error if too big for field
dcr b
jm perror
inr c
dcr c
jnz gfc1
cpi '*' ;trap "match rest of field" character
jz setmatch
gfc1: mov m,a ;put character in fcb
inx h
dcr b ;decrement field size counter
ora a ;clear zero flag
ret
;;
setmatch:
mvi m,'?' ;set match one character
inx h
dcr b
jp setmatch
ret
;
; check for delimiter
;
; entry: A = character
; exit: z = set if char is a delimiter
;
delimiters: db cr,tab,' .,:;[]=<>|',0
delim: ldax d ;get character
push h
lxi h,delimiters
delim1: cmp m ;is char in table
jz delim2
inr m
dcr m ;end of table? (0)
inx h
jnz delim1
ora a ;reset zero flag
delim2: pop h
rz
;
; not a delimiter, convert to upper case
;
cpi 'a'
rc
cpi 'z'+1
jnc delim3
ani 05fh
delim3: ani 07fh
ret ;return with zero set if so
;
; pad with blanks or zeros
;
pad: mov m,b
inx h
dcr c
jnz pad
ret
;
; skip blanks and tabs
;
skps: ldax d
inx d
cpi ' ' ;skip spaces & tabs
jz skps
cpi tab
jz skps
ret
;
; end of PARSE
;
errflg:
; report error to console, message address in hl
push h! call crlf ; stack mssg address, new line
lda adrive! adi 'A'! sta dskerr ; current disk name
lxi b,dskmsg
if BANKED
call zprint ; the error message
else
call print
endif
pop b
if BANKED
lda bdos$flags! ral! jnc zprint
call zprint ; error message tail
lda fx! mvi b,30h
lxi h,pr$fx1
cpi 100! jc errflg1
mvi m,31h! inx h! sui 100
errflg1:
sui 10! jc errflg2
inr b! jmp errflg1
errflg2:
mov m,b! inx h! adi 3ah! mov m,a
inx h! mvi m,20h
lxi h,pr$fcb! mvi m,0
lda resel! ora a! jz errflg3
mvi m,20h! push d
lhld info! inx h! xchg! lxi h,pr$fcb1
mvi c,8! call move! mvi m,'.'! inx h
mvi c,3! call move! pop d
errflg3:
call crlf
lxi b,pr$fx! jmp zprint
zprint:
ldax b! ora a! rz
push b! mov c,a
call tabout
pop b! inx b! jmp zprint
pr$fx: db 'BDOS Function = '
pr$fx1: db ' '
pr$fcb: db ' File = '
pr$fcb1:ds 12
db 0
else
jmp print
endif
reboote:
lxi h,0fffdh! jmp rebootx0 ; BDOS error
rebootx:
;;; lxi h,0fffeh ; CTL-C error
call patch$1e25 ;[JCE] DRI patch 13
rebootx0:
shld clp$errcde
rebootx1:
jmp wbootf
entsp: ds 2 ; entry stack pointer
shell:
lxi h,0! dad sp! shld shell$sp
if not BANKED
lxi sp,shell$stk
endif
lxi h,shell$rtn! push h
call save$rr! call save$dma
lda mult$cnt
mult$io:
push a! sta mult$num! call cbdos
ora a! jnz shell$err
lda fx! cpi 33! cnc incr$rr
call adv$dma
pop a! dcr a! jnz mult$io
mov h,a! mov l,a! ret
shell$sp: dw 0
dw 0c7c7h,0c7c7h,0c7c7h,0c7c7h,0c7c7h
shell$stk: ; shell has 5 level stack
hold$dma: dw 0
cbdos:
lda fx! mov c,a
cbdos1:
lhld info! xchg! jmp bdose2
adv$dma:
lhld dmaad! lxi d,80h! dad d! jmp reset$dma1
save$dma:
lhld dmaad! shld hold$dma! ret
reset$dma:
lhld hold$dma
reset$dma1:
shld dmaad! jmp setdma
shell$err:
pop b! inr a! rz
lda mult$cnt! sub b! mov h,a! ret
shell$rtn:
push h! lda fx! cpi 33! cnc reset$rr
call reset$dma
pop d! lhld shell$sp! sphl! xchg
mov a,l! mov b,h! ret
page

712
software/CPM/cpm3/cpmbdos2.asm
View File

@@ -1,712 +0,0 @@
title 'CP/M BDOS Interface, BDOS, Version 3.0 Dec, 1982'
;*****************************************************************
;*****************************************************************
;** **
;** B a s i c D i s k O p e r a t i n g S y s t e m **
;** **
;** I n t e r f a c e M o d u l e **
;** **
;*****************************************************************
;*****************************************************************
;
; Copyright (c) 1978, 1979, 1980, 1981, 1982
; Digital Research
; Box 579, Pacific Grove
; California
;
; December 1982
;
on equ 0ffffh
off equ 00000h
MPM equ off
BANKED equ on
;
; equates for non graphic characters
;
ctla equ 01h ; control a
ctlb equ 02h ; control b
ctlc equ 03h ; control c
ctle equ 05h ; physical eol
ctlf equ 06h ; control f
ctlg equ 07h ; control g
ctlh equ 08h ; backspace
ctlk equ 0bh ; control k
ctlp equ 10h ; prnt toggle
ctlq equ 11h ; start screen
ctlr equ 12h ; repeat line
ctls equ 13h ; stop screen
ctlu equ 15h ; line delete
ctlw equ 17h ; control w
ctlx equ 18h ; =ctl-u
ctlz equ 1ah ; end of file
rubout equ 7fh ; char delete
tab equ 09h ; tab char
cr equ 0dh ; carriage return
lf equ 0ah ; line feed
ctl equ 5eh ; up arrow
org 0000h
base equ $
; Base page definitions
bnkbdos$pg equ base+0fc00h
resbdos$pg equ base+0fd00h
scb$pg equ base+0fb00h
bios$pg equ base+0ff00h
; Bios equates
bios equ bios$pg
bootf equ bios$pg ; 00. cold boot function
if BANKED
wbootf equ scb$pg+68h ; 01. warm boot function
constf equ scb$pg+6eh ; 02. console status function
coninf equ scb$pg+74h ; 03. console input function
conoutf equ scb$pg+7ah ; 04. console output function
listf equ scb$pg+80h ; 05. list output function
else
wbootf equ bios$pg+3 ; 01. warm boot function
constf equ bios$pg+6 ; 02. console status function
coninf equ bios$pg+9 ; 03. console input function
conoutf equ bios$pg+12 ; 04. console output function
listf equ bios$pg+15 ; 05. list output function
endif
punchf equ bios$pg+18 ; 06. punch output function
readerf equ bios$pg+21 ; 07. reader input function
homef equ bios$pg+24 ; 08. disk home function
seldskf equ bios$pg+27 ; 09. select disk function
settrkf equ bios$pg+30 ; 10. set track function
setsecf equ bios$pg+33 ; 11. set sector function
setdmaf equ bios$pg+36 ; 12. set dma function
readf equ bios$pg+39 ; 13. read disk function
writef equ bios$pg+42 ; 14. write disk function
liststf equ bios$pg+45 ; 15. list status function
sectran equ bios$pg+48 ; 16. sector translate
conoutstf equ bios$pg+51 ; 17. console output status function
auxinstf equ bios$pg+54 ; 18. aux input status function
auxoutstf equ bios$pg+57 ; 19. aux output status function
devtblf equ bios$pg+60 ; 20. retunr device table address fx
devinitf equ bios$pg+63 ; 21. initialize device function
drvtblf equ bios$pg+66 ; 22. return drive table address
multiof equ bios$pg+69 ; 23. multiple i/o function
flushf equ bios$pg+72 ; 24. flush function
movef equ bios$pg+75 ; 25. memory move function
timef equ bios$pg+78 ; 26. system get/set time function
selmemf equ bios$pg+81 ; 27. select memory function
setbnkf equ bios$pg+84 ; 28. set dma bank function
xmovef equ bios$pg+87 ; 29. extended move function
if BANKED
; System Control Block equates
olog equ scb$pg+090h
rlog equ scb$pg+092h
SCB equ scb$pg+09ch
; Expansion Area - 6 bytes
hashl equ scb$pg+09ch
hash equ scb$pg+09dh
version equ scb$pg+0a1h
; Utilities Section - 8 bytes
util$flgs equ scb$pg+0a2h
dspl$flgs equ scb$pg+0a6h
; CLP Section - 4 bytes
clp$flgs equ scb$pg+0aah
clp$errcde equ scb$pg+0ach
; CCP Section - 8 bytes
ccp$comlen equ scb$pg+0aeh
ccp$curdrv equ scb$pg+0afh
ccp$curusr equ scb$pg+0b0h
ccp$conbuff equ scb$pg+0b1h
ccp$flgs equ scb$pg+0b3h
; Device I/O Section - 32 bytes
conwidth equ scb$pg+0b6h
column equ scb$pg+0b7h
conpage equ scb$pg+0b8h
conline equ scb$pg+0b9h
conbuffadd equ scb$pg+0bah
conbufflen equ scb$pg+0bch
conin$rflg equ scb$pg+0beh
conout$rflg equ scb$pg+0c0h
auxin$rflg equ scb$pg+0c2h
auxout$rflg equ scb$pg+0c4h
lstout$rflg equ scb$pg+0c6h
page$mode equ scb$pg+0c8h
pm$default equ scb$pg+0c9h
ctlh$act equ scb$pg+0cah
rubout$act equ scb$pg+0cbh
type$ahead equ scb$pg+0cch
contran equ scb$pg+0cdh
conmode equ scb$pg+0cfh
outdelim equ scb$pg+0d3h
listcp equ scb$pg+0d4h
qflag equ scb$pg+0d5h
; BDOS Section - 42 bytes
scbadd equ scb$pg+0d6h
dmaad equ scb$pg+0d8h
olddsk equ scb$pg+0dah
info equ scb$pg+0dbh
resel equ scb$pg+0ddh
relog equ scb$pg+0deh
fx equ scb$pg+0dfh
usrcode equ scb$pg+0e0h
dcnt equ scb$pg+0e1h
;searcha equ scb$pg+0e3h
searchl equ scb$pg+0e5h
multcnt equ scb$pg+0e6h
errormode equ scb$pg+0e7h
searchchain equ scb$pg+0e8h
temp$drive equ scb$pg+0ech
errdrv equ scb$pg+0edh
media$flag equ scb$pg+0f0h
bdos$flags equ scb$pg+0f3h
stamp equ scb$pg+0f4h
commonbase equ scb$pg+0f9h
error equ scb$pg+0fbh ;jmp error$sub
bdosadd equ scb$pg+0feh
; Resbdos equates
resbdos equ resbdos$pg
move$out equ resbdos$pg+9 ; a=bank #, hl=dest, de=srce
move$tpa equ resbdos$pg+0ch ; a=bank #, hl=dest, de=srce
srch$hash equ resbdos$pg+0fh ; a=bank #, hl=hash table addr
hashmx equ resbdos$pg+12h ; max hash search dcnt
rd$dir$flag equ resbdos$pg+14h ; directory read flag
make$xfcb equ resbdos$pg+15h ; make function flag
find$xfcb equ resbdos$pg+16h ; search function flag
xdcnt equ resbdos$pg+17h ; dcnt save for empty fcb,
; user 0 fcb, or xfcb
xdmaad equ resbdos$pg+19h ; resbdos dma copy area addr
curdma equ resbdos$pg+1bh ; current dma
copy$cr$only equ resbdos$pg+1dh ; dont restore fcb flag
user$info equ resbdos$pg+1eh ; user fcb address
kbchar equ resbdos$pg+20h ; conbdos look ahead char
qconinx equ resbdos$pg+21h ; qconin mov a,m routine
ELSE
move$out equ movef
move$tpa equ movef
ENDIF
;
serial: db '654321'
;
; Enter here from the user's program with function number in c,
; and information address in d,e
;
bdose: ; Arrive here from user programs
xchg! shld info! xchg ; info=de, de=info
mov a,c! sta fx! cpi 14! jc bdose2
lxi h,0! shld dircnt ; dircnt,multnum = 0
lda olddsk! sta seldsk ; Set seldsk
if BANKED
dcr a! sta copy$cr$init
ENDIF
; If mult$cnt ~= 1 then read or write commands
; are handled by the shell
lda mult$cnt! dcr a! jz bdose2
lxi h,mult$fxs
bdose1:
mov a,m! ora a! jz bdose2
cmp c! jz shell
inx h! jmp bdose1
bdose2:
mov a,e! sta linfo ; linfo = low(info) - don't equ
lxi h,0! shld aret ; Return value defaults to 0000
shld resel ; resel,relog = 0
; Save user's stack pointer, set to local stack
dad sp! shld entsp ; entsp = stackptr
if not BANKED
lxi sp,lstack ; local stack setup
ENDIF
lxi h,goback ; Return here after all functions
push h ; jmp goback equivalent to ret
mov a,c! cpi nfuncs! jnc high$fxs ; Skip if invalid #
mov c,e ; possible output character to c
lxi h,functab! jmp bdos$jmp
; look for functions 98 ->
high$fxs:
cpi 128! jnc test$152
sui 98! jc lret$eq$ff ; Skip if function < 98
cpi nfuncs2! jnc lret$eq$ff
lxi h,functab2
bdos$jmp:
mov e,a! mvi d,0 ; de=func, hl=.ciotab
dad d! dad d! mov e,m! inx h! mov d,m ; de=functab(func)
lhld info ; info in de for later xchg
xchg! pchl ; dispatched
; CAUTION: In banked systems only,
; error$sub is referenced indirectly by the SCB ERROR
; field in RESBDOS as (0fc7ch). This value is converted
; to the actual address of error$sub by GENSYS. If the offset
; of error$sub is changed, the SCB ERROR value must also
; be changed.
;
; error subroutine
;
error$sub:
mvi b,0! push b! dcr c
lxi h,errtbl! dad b! dad b
mov e,m! inx h! mov d,m! xchg
call errflg
pop b! lda error$mode! ora a! rnz
jmp reboote
mult$fxs: db 20,21,33,34,40,0
maclib makedate
if BANKED
@LCOPY
@BDATE
ds 5
else
@SCOPY
@BDATE
; 31 level stack
dw 0c7c7h,0c7c7h,0c7c7h,0c7c7h,0c7c7h,0c7c7h,0c7c7h
dw 0c7c7h,0c7c7h,0c7c7h,0c7c7h,0c7c7h,0c7c7h,0c7c7h,0c7c7h
dw 0c7c7h,0c7c7h,0c7c7h,0c7c7h,0c7c7h,0c7c7h,0c7c7h,0c7c7h
dw 0c7c7h,0c7c7h,0c7c7h,0c7c7h,0c7c7h,0c7c7h,0c7c7h,0c7c7h
lstack:
endif
; dispatch table for functions
functab:
dw rebootx1, func1, func2, func3
dw punchf, listf, func6, func7
dw func8, func9, func10, func11
diskf equ ($-functab)/2 ; disk funcs
dw func12,func13,func14,func15
dw func16,func17,func18,func19
dw func20,func21,func22,func23
dw func24,func25,func26,func27
dw func28,func29,func30,func31
dw func32,func33,func34,func35
dw func36,func37,func38,func39
dw func40,lret$eq$ff,func42,func43
dw func44,func45,func46,func47
dw func48,func49,func50
nfuncs equ ($-functab)/2
functab2:
dw func98,func99
dw func100,func101,func102,func103
dw func104,func105,func106,func107
dw func108,func109,func110,func111
dw func112
nfuncs2 equ ($-functab2)/2
errtbl:
dw permsg
dw rodmsg
dw rofmsg
dw selmsg
dw 0
dw 0
dw passmsg
dw fxstsmsg
dw wildmsg
test$152:
cpi 152! rnz
;
; PARSE version 3.0b Oct 08 1982 - Doug Huskey
;
;
; DE->.(.filename,.fcb)
;
; filename = [d:]file[.type][;password]
;
; fcb assignments
;
; 0 => drive, 0 = default, 1 = A, 2 = B, ...
; 1-8 => file, converted to upper case,
; padded with blanks (left justified)
; 9-11 => type, converted to upper case,
; padded with blanks (left justified)
; 12-15 => set to zero
; 16-23 => password, converted to upper case,
; padded with blanks
; 24-25 => 0000h
; 26 => length of password (0 - 8)
;
; Upon return, HL is set to FFFFH if DE locates
; an invalid file name;
; otherwise, HL is set to 0000H if the delimiter
; following the file name is a 00H (NULL)
; or a 0DH (CR);
; otherwise, HL is set to the address of the delimiter
; following the file name.
;
lxi h,sthl$ret
push h
lhld info
mov e,m ;get first parameter
inx h
mov d,m
push d ;save .filename
inx h
mov e,m ;get second parameter
inx h
mov d,m
pop h ;DE=.fcb HL=.filename
xchg
parse0:
push h ;save .fcb
xra a
mov m,a ;clear drive byte
inx h
lxi b,20h*256+11
call pad ;pad name and type w/ blanks
lxi b,4
call pad ;EXT, S1, S2, RC = 0
lxi b,20h*256+8
call pad ;pad password field w/ blanks
lxi b,12
call pad ;zero 2nd 1/2 of map, cr, r0 - r2
;
; skip spaces
;
call skps
;
; check for drive
;
ldax d
cpi ':' ;is this a drive?
dcx d
pop h
push h ;HL = .fcb
jnz parse$name
;
; Parse the drive-spec
;
parsedrv:
call delim
jz parse$ok
sui 'A'
jc perror1
cpi 16
jnc perror1
inx d
inx d ;past the ':'
inr a ;set drive relative to 1
mov m,a ;store the drive in FCB(0)
;
; Parse the file-name
;
parse$name:
inx h ;HL = .fcb(1)
call delim
jz parse$ok
lxi b,7*256
parse6: ldax d ;get a character
cpi '.' ;file-type next?
jz parse$type ;branch to file-type processing
cpi ';'
jz parse$pw
call gfc ;process one character
jnz parse6 ;loop if not end of name
jmp parse$ok
;
; Parse the file-type
;
parse$type:
inx d ;advance past dot
pop h
push h ;HL =.fcb
lxi b,9
dad b ;HL =.fcb(9)
lxi b,2*256
parse8: ldax d
cpi ';'
jz parsepw
call gfc ;process one character
jnz parse8 ;loop if not end of type
;
parse$ok:
pop b
push d
call skps ;skip trailing blanks and tabs
dcx d
call delim ;is next nonblank char a delim?
pop h
rnz ;no
lxi h,0
ora a
rz ;return zero if delim = 0
cpi cr
rz ;return zero if delim = cr
xchg
ret
;
; handle parser error
;
perror:
pop b ;throw away return addr
perror1:
pop b
lxi h,0ffffh
ret
;
; Parse the password
;
parsepw:
inx d
pop h
push h
lxi b,16
dad b
lxi b,7*256+1
parsepw1:
call gfc
jnz parsepw1
mvi a,7
sub b
pop h
push h
lxi b,26
dad b
mov m,a
ldax d ;delimiter in A
jmp parse$ok
;
; get next character of name, type or password
;
gfc: call delim ;check for end of filename
rz ;return if so
cpi ' ' ;check for control characters
inx d
jc perror ;error if control characters encountered
inr b ;error if too big for field
dcr b
jm perror
inr c
dcr c
jnz gfc1
cpi '*' ;trap "match rest of field" character
jz setmatch
gfc1: mov m,a ;put character in fcb
inx h
dcr b ;decrement field size counter
ora a ;clear zero flag
ret
;;
setmatch:
mvi m,'?' ;set match one character
inx h
dcr b
jp setmatch
ret
;
; check for delimiter
;
; entry: A = character
; exit: z = set if char is a delimiter
;
delimiters: db cr,tab,' .,:;[]=<>|',0
delim: ldax d ;get character
push h
lxi h,delimiters
delim1: cmp m ;is char in table
jz delim2
inr m
dcr m ;end of table? (0)
inx h
jnz delim1
ora a ;reset zero flag
delim2: pop h
rz
;
; not a delimiter, convert to upper case
;
cpi 'a'
rc
cpi 'z'+1
jnc delim3
ani 05fh
delim3: ani 07fh
ret ;return with zero set if so
;
; pad with blanks or zeros
;
pad: mov m,b
inx h
dcr c
jnz pad
ret
;
; skip blanks and tabs
;
skps: ldax d
inx d
cpi ' ' ;skip spaces & tabs
jz skps
cpi tab
jz skps
ret
;
; end of PARSE
;
errflg:
; report error to console, message address in hl
push h! call crlf ; stack mssg address, new line
lda adrive! adi 'A'! sta dskerr ; current disk name
lxi b,dskmsg
if BANKED
call zprint ; the error message
else
call print
endif
pop b
if BANKED
lda bdos$flags! ral! jnc zprint
call zprint ; error message tail
lda fx! mvi b,30h
lxi h,pr$fx1
cpi 100! jc errflg1
mvi m,31h! inx h! sui 100
errflg1:
sui 10! jc errflg2
inr b! jmp errflg1
errflg2:
mov m,b! inx h! adi 3ah! mov m,a
inx h! mvi m,20h
lxi h,pr$fcb! mvi m,0
lda resel! ora a! jz errflg3
mvi m,20h! push d
lhld info! inx h! xchg! lxi h,pr$fcb1
mvi c,8! call move! mvi m,'.'! inx h
mvi c,3! call move! pop d
errflg3:
call crlf
lxi b,pr$fx! jmp zprint
zprint:
ldax b! ora a! rz
push b! mov c,a
call tabout
pop b! inx b! jmp zprint
pr$fx: db 'BDOS Function = '
pr$fx1: db ' '
pr$fcb: db ' File = '
pr$fcb1:ds 12
db 0
else
jmp print
endif
reboote:
lxi h,0fffdh! jmp rebootx0 ; BDOS error
rebootx:
;;; lxi h,0fffeh ; CTL-C error
call patch$1e25 ;[JCE] DRI Patch 13
rebootx0:
shld clp$errcde
rebootx1:
jmp wbootf
entsp: ds 2 ; entry stack pointer
shell:
lxi h,0! dad sp! shld shell$sp
if not BANKED
lxi sp,shell$stk
endif
lxi h,shell$rtn! push h
call save$rr! call save$dma
lda mult$cnt
mult$io:
push a! sta mult$num! call cbdos
ora a! jnz shell$err
lda fx! cpi 33! cnc incr$rr
call adv$dma
pop a! dcr a! jnz mult$io
mov h,a! mov l,a! ret
shell$sp: dw 0
dw 0c7c7h,0c7c7h,0c7c7h,0c7c7h,0c7c7h
shell$stk: ; shell has 5 level stack
hold$dma: dw 0
cbdos:
lda fx! mov c,a
cbdos1:
lhld info! xchg! jmp bdose2
adv$dma:
lhld dmaad! lxi d,80h! dad d! jmp reset$dma1
save$dma:
lhld dmaad! shld hold$dma! ret
reset$dma:
lhld hold$dma
reset$dma1:
shld dmaad! jmp setdma
shell$err:
pop b! inr a! rz
lda mult$cnt! sub b! mov h,a! ret
shell$rtn:
push h! lda fx! cpi 33! cnc reset$rr
call reset$dma
pop d! lhld shell$sp! sphl! xchg
mov a,l! mov b,h! ret
page

7899
software/CPM/cpm3/cpmbdosx.asm
View File

File diff suppressed because it is too large Load Diff

1572
software/CPM/cpm3/cpmldr.asm
View File

File diff suppressed because it is too large Load Diff

201
software/CPM/cpm3/crdef.plm
View File

@@ -1,201 +0,0 @@
$title('GENCPM Token File Creator')
create$defaults:
do;
/*
Copyright (C) 1982
Digital Research
P.O. Box 579
Pacific Grove, CA 93950
*/
/*
Revised:
20 Sept 82 by Bruce Skidmore
*/
declare true literally '0FFH';
declare false literally '0';
declare forever literally 'while true';
declare boolean literally 'byte';
declare cr literally '0dh';
declare lf literally '0ah';
declare tab literally '09h';
/*
D a t a S t r u c t u r e s
*/
declare data$fcb (36) byte external;
declare obuf (128) byte at (.memory);
declare hexASCII (16) byte external;
declare symtbl (20) structure(
token(8) byte,
len byte,
flags byte,
qptr byte,
ptr address) external;
/*
B D O S P r o c e d u r e & F u n c t i o n C a l l s
*/
delete$file:
procedure (fcb$address) external;
declare fcb$address address;
end delete$file;
create$file:
procedure (fcb$address) external;
declare fcb$address address;
end create$file;
close$file:
procedure (fcb$address) external;
declare fcb$address address;
end close$file;
write$record:
procedure (fcb$address) external;
declare fcb$address address;
end write$record;
set$DMA$address:
procedure (DMA$address) external;
declare DMA$address address;
end set$DMA$address;
/*
M a i n C R T D E F P r o c e d u r e
*/
crtdef:
procedure public;
declare (flags,symbol$done,i,j,obuf$index,inc) byte;
declare val$adr address;
declare val based val$adr byte;
inc$obuf$index:
procedure;
if obuf$index = 7fh then
do;
call write$record(.data$fcb);
do obuf$index = 0 to 7fh;
obuf(obuf$index) = 1ah;
end;
obuf$index = 0;
end;
else
obuf$index = obuf$index + 1;
end inc$obuf$index;
emit$ascii$hex:
procedure(dig);
declare dig byte;
call inc$obuf$index;
obuf(obuf$index) = hexASCII(shr(dig,4));
call inc$obuf$index;
obuf(obuf$index) = hexASCII(dig and 0fh);
end emit$ascii$hex;
call set$dma$address(.obuf);
call delete$file(.data$fcb);
call create$file(.data$fcb);
obuf$index = 0ffh;
do i = 0 to 21;
symbol$done = false;
flags = symtbl(i).flags;
inc = 0;
do while (inc < 16) and (not symbol$done);
do j = 0 to 7;
call inc$obuf$index;
obuf(obuf$index) = symtbl(i).token(j);
end;
if (flags and 8) = 0 then
symbol$done = true;
else
do;
if (flags and 10h) <> 0 then
obuf(obuf$index) = 'A' + inc;
else
do;
if inc < 10 then
do;
obuf(obuf$index) = '0' + inc;
end;
else
do;
obuf(obuf$index) = 'A' + inc - 10;
end;
end;
end;
call inc$obuf$index;
obuf(obuf$index) = ' ';
call inc$obuf$index;
obuf(obuf$index) = '=';
call inc$obuf$index;
obuf(obuf$index) = ' ';
val$adr = symtbl(i).ptr + (inc * symtbl(i).len);
if (flags and 1) <> 0 then
do;
call inc$obuf$index;
obuf(obuf$index) = 'A' + val;
end;
else
do;
if (flags and 2) <> 0 then
do;
call inc$obuf$index;
if val then
obuf(obuf$index) = 'Y';
else
obuf(obuf$index) = 'N';
end;
else
do;
call emit$ascii$hex(val);
if (flags and 18h) = 8 then
do;
call inc$obuf$index;
obuf(obuf$index) = ',';
val$adr = val$adr + 1;
call emit$ascii$hex(val);
call inc$obuf$index;
obuf(obuf$index) = ',';
val$adr = val$adr + 1;
call emit$ascii$hex(val);
end;
end;
end;
call inc$obuf$index;
obuf(obuf$index) = cr;
call inc$obuf$index;
obuf(obuf$index) = lf;
inc = inc + 1;
end;
end;
if obuf$index <= 7fh then
call write$record(.data$fcb);
call close$file(.data$fcb);
end crtdef;
end create$defaults;

672
software/CPM/cpm3/date.plm
View File

@@ -1,672 +0,0 @@
$title ('CP/M V3.0 Date and Time')
tod:
do;
/*
Revised:
14 Sept 81 by Thomas Rolander
Modifications:
Date: September 2,1982
Programmer: Thomas J. Mason
Changes:
The 'P' option was changed to the 'C'ontinuous option.
Also added is the 'S'et option to let the user set either
the time or the date.
Date: October 31,1982
Programmer: Bruce K. Skidmore
Changes:
Added Function 50 call to signal Time Set and Time Get.
Date: 17 May 1998
Programmer: John Elliott
Changes:
Year 2000 fixes (flagged [JCE] below)
Patch 17 implemented
Date: 18 Sep 1998
Programmer: John Elliott
Changes:
Added "YMD" date format
*/
declare PLM label public;
mon1:
procedure (func,info) external;
declare func byte;
declare info address;
end mon1;
mon2:
procedure (func,info) byte external;
declare func byte;
declare info address;
end mon2;
mon2a:
procedure (func,info) address external;
declare func byte;
declare info address;
end mon2a;
declare xdos literally 'mon2a';
declare date$flag$offset literally '0ch'; /* [JCE] Date format */
declare fcb (1) byte external;
declare fcb16 (1) byte external;
declare tbuff (1) byte external;
RETURN$VERSION$FUNC:
procedure address;
return MON2A(12,0);
end RETURN$VERSION$FUNC;
read$console:
procedure byte;
return mon2 (1,0);
end read$console;
write$console:
procedure (char);
declare char byte;
call mon1 (2,char);
end write$console;
print$buffer:
procedure (buffer$address);
declare buffer$address address;
call mon1 (9,buffer$address);
end print$buffer;
READ$CONSOLE$BUFFER:
procedure (BUFF$ADR);
declare BUFF$ADR address;
call MON1(10,BUFF$ADR);
end READ$CONSOLE$BUFFER;
check$console$status:
procedure byte;
return mon2 (11,0);
end check$console$status;
terminate:
procedure;
call mon1 (0,0);
end terminate;
crlf:
procedure;
call write$console (0dh);
call write$console (0ah);
end crlf;
get$date$flag: procedure byte; /* [JCE] Read the date format flag */
declare scbpb structure
(offset byte,
set byte,
value address);
scbpb.offset = date$flag$offset;
scbpb.set = 0;
return (mon2(49,.scbpb) and 3); /* [JCE 18-9-1998] extra date formats */
end get$date$flag; /* [JCE] ends */
/*****************************************************
Time & Date ASCII Conversion Code
*****************************************************/
declare BUFFER$ADR structure (
MAX$CHARS byte,
NUMB$OF$CHARS byte,
CONSOLE$BUFFER(23) byte) /* [JCE] size 21 -> 23 throughout */
initial(23,0,0,0,0,0,0,0,0,0,0,0, /* because of printing */
0,0,0,0,0,0,0,0,0,0,0,0,0); /* four-figure year nos. */
declare tod$adr address;
declare tod based tod$adr structure (
opcode byte,
date address,
hrs byte,
min byte,
sec byte,
ASCII (23) byte );
declare string$adr address;
declare string based string$adr (1) byte;
declare index byte;
declare lit literally 'literally',
forever lit 'while 1',
word lit 'address';
/* - - - - - - - - - - - - - - - - - - - - - - */
emitchar:
procedure(c);
declare c byte;
string(index := index + 1) = c;
end emitchar;
/*- - - - - - - - - - - - - - - - - - - - - - -*/
emitn:
procedure(a);
declare a address;
declare c based a byte;
do while c <> '$';
string(index := index + 1) = c;
a = a + 1;
end;
end emitn;
/*- - - - - - - - - - - - - - - - - - - - - - -*/
emit$bcd:
procedure(b);
declare b byte;
call emitchar('0'+b);
end emit$bcd;
/*- - - - - - - - - - - - - - - - - - - - - - -*/
emit$bcd$pair:
procedure(b);
declare b byte;
call emit$bcd(shr(b,4));
call emit$bcd(b and 0fh);
end emit$bcd$pair;
/*- - - - - - - - - - - - - - - - - - - - - - -*/
emit$colon:
procedure(b);
declare b byte;
call emit$bcd$pair(b);
call emitchar(':');
end emit$colon;
/*- - - - - - - - - - - - - - - - - - - - - - -*/
emit$bin$pair:
procedure(b);
declare b byte;
call emit$bcd(b/10);
call emit$bcd(b mod 10);
end emit$bin$pair;
/*- - - - - - - - - - - - - - - - - - - - - - -*/
emit$slant:
procedure(b);
declare b byte;
call emit$bin$pair(b);
call emitchar('/');
end emit$slant;
/*- - - - - - - - - - - - - - - - - - - - - - -*/
emit$dash: /* [JCE 18-9-1998] for YMD format dates */
procedure(b);
declare b byte;
call emit$bin$pair(b);
call emitchar('-');
end emit$dash;
/*- - - - - - - - - - - - - - - - - - - - - - -*/
declare chr byte;
/*- - - - - - - - - - - - - - - - - - - - - - -*/
gnc:
procedure;
/* get next command byte */
if chr = 0 then return;
if index = 22 then /* [JCE] 20 -> 22 */
do;
chr = 0;
return;
end;
chr = string(index := index + 1);
end gnc;
/*- - - - - - - - - - - - - - - - - - - - - - -*/
deblank:
procedure;
do while chr = ' ';
call gnc;
end;
end deblank;
numeric:
procedure byte;
/* test for numeric */
return (chr - '0') < 10;
end numeric;
scan$numeric:
procedure(lb,ub) byte;
declare (lb,ub) byte;
declare b byte;
b = 0;
call deblank;
if not numeric then go to error;
do while numeric;
if (b and 1110$0000b) <> 0 then go to error;
b = shl(b,3) + shl(b,1); /* b = b * 10 */
if carry then go to error;
b = b + (chr - '0');
if carry then go to error;
call gnc;
end;
if (b < lb) or (b > ub) then go to error;
return b;
end scan$numeric;
scan$delimiter:
procedure(d,lb,ub) byte;
declare (d,lb,ub) byte;
call deblank;
if chr <> d then go to error;
call gnc;
return scan$numeric(lb,ub);
end scan$delimiter;
declare base$year lit '78', /* base year for computations */
base$day lit '0', /* starting day for base$year 0..6 */
month$size (*) byte data
/* jan feb mar apr may jun jul aug sep oct nov dec */
( 31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31),
month$days (*) word data
/* jan feb mar apr may jun jul aug sep oct nov dec */
( 000,031,059,090,120,151,181,212,243,273,304,334);
leap$days:
procedure(y,m) byte;
declare (y,m) byte;
/* compute days accumulated by leap years */
declare yp byte;
yp = shr(y,2); /* yp = y/4 */
if (y and 11b) = 0 and month$days(m) < 59 then
/* y not 00, y mod 4 = 0, before march, so not leap yr */
return yp - 1;
/* otherwise, yp is the number of accumulated leap days */
return yp;
end leap$days;
declare word$value word;
get$next$digit:
procedure byte;
/* get next lsd from word$value */
declare lsd byte;
lsd = word$value mod 10;
word$value = word$value / 10;
return lsd;
end get$next$digit;
bcd:
procedure (val) byte;
declare val byte;
return shl((val/10),4) + val mod 10;
end bcd;
declare (month, day, year, hrs, min, sec) byte;
set$date:
procedure;
declare (i, leap$flag) byte; /* temporaries */
if get$date$flag = 2 then /* [JCE 18-9-1998] YMD format */
do;
year = scan$numeric(0,99);
month = scan$delimiter('-',1,12) - 1;
if (leap$flag := month = 1) then i = 29;
else i = month$size(month);
day = scan$delimiter('-',1,i);
end;
else
if get$date$flag = 1 then /* [JCE] UK format */
do;
day = scan$numeric(1,31);
month = scan$delimiter('/',1,12) - 1;
if (leap$flag := month = 1) then i = 29;
else i = month$size(month);
if day > i then go to error;
/* [JCE] year2000: Was year = scan$delimiter('/',base$year,99); */
year = scan$delimiter('/',0,99); /* [JCE] */
end;
else /* US format */
do;
month = scan$numeric(1,12) - 1;
/* may be feb 29 */
if (leap$flag := month = 1) then i = 29;
else i = month$size(month);
day = scan$delimiter('/',1,i);
/* [JCE] year2000: Was year = scan$delimiter('/',base$year,99); */
year = scan$delimiter('/',0,99); /* [JCE] */
end;
if year < base$year /* [JCE] */
then year = year + 100; /* [JCE] Dates past 2000 */
/* ensure that feb 29 is in a leap year */
if leap$flag and day = 29 and (year and 11b) <> 0 then
/* feb 29 of non-leap year */ go to error;
/* compute total days */
tod.date = month$days(month)
+ 365 * (year - base$year)
+ day
- leap$days(base$year,0)
+ leap$days(year,month);
end SET$DATE;
SET$TIME:
procedure;
tod.hrs = bcd (scan$numeric(0,23));
tod.min = bcd (scan$delimiter(':',0,59));
if tod.opcode = 2
then
/* date, hours and minutes only */
do;
if chr = ':'
then i = scan$delimiter (':',0,59);
tod.sec = 0;
end;
/* include seconds */
else tod.sec = bcd (scan$delimiter(':',0,59));
end set$time;
bcd$pair:
procedure(a,b) byte;
declare (a,b) byte;
return shl(a,4) or b;
end bcd$pair;
compute$year:
procedure;
/* compute year from number of days in word$value */
declare year$length word;
year = base$year;
do forever;
year$length = 365;
if (year and 11b) = 0 then /* leap year */
year$length = 366;
if word$value <= year$length then
return;
word$value = word$value - year$length;
year = year + 1;
end;
end compute$year;
declare week$day byte, /* day of week 0 ... 6 */
day$list (*) byte data ('Sun$Mon$Tue$Wed$Thu$Fri$Sat$'),
leap$bias byte; /* bias for feb 29 */
compute$month:
procedure;
month = 12;
do while month > 0;
if (month := month - 1) < 2 then /* jan or feb */
leapbias = 0;
if month$days(month) + leap$bias < word$value then return;
end;
end compute$month;
declare date$test byte, /* true if testing date */
test$value word; /* sequential date value under test */
get$date$time:
procedure;
/* get date and time */
hrs = tod.hrs;
min = tod.min;
sec = tod.sec;
word$value = tod.date;
/* word$value contains total number of days */
week$day = (word$value + base$day - 1) mod 7;
call compute$year;
/* year has been set, word$value is remainder */
leap$bias = 0;
if (year and 11b) = 0 and word$value > 59 then
/* after feb 29 on leap year */ leap$bias = 1;
call compute$month;
day = word$value - (month$days(month) + leap$bias);
month = month + 1;
end get$date$time;
emit$date$time:
procedure;
declare century byte; /* [JCE] century */
century = 19; /* [JCE] start in the 1900s */
call emitn(.day$list(shl(week$day,2)));
call emitchar(' ');
century = century + (year / 100); /* [JCE] Y2000 fix for output */
year = year mod 100; /* [JCE] */
if get$date$flag = 0 then /* [JCE] US or UK format for dates? */
do;
call emit$slant(month);
call emit$slant(day);
call emit$bin$pair(century);
call emit$bin$pair(year);
end;
else
if get$date$flag = 1 then /* [JCE 18-9-1998] UK format */
do;
call emit$slant(day);
call emit$slant(month);
call emit$bin$pair(century);
call emit$bin$pair(year);
end;
else /* [JCE 18-9-1998] YMD format */
do;
call emit$bin$pair(century);
call emit$dash(year);
call emit$dash(month);
call emit$bin$pair(day);
end;
/* [JCE] end of Y2000 fix for output */
call emitchar(' ');
call emit$colon(hrs);
call emit$colon(min);
call emit$bcd$pair(sec);
end emit$date$time;
tod$ASCII:
procedure (parameter);
declare parameter address;
declare ret address;
ret = 0;
tod$adr = parameter;
string$adr = .tod.ASCII;
if tod.opcode = 0 then
do;
call get$date$time;
index = -1;
call emit$date$time;
end;
else
do;
if (tod.opcode = 1) or
(tod.opcode = 2) then
do;
chr = string(index:=0);
call set$date;
call set$time;
ret = .string(index);
end;
else
do;
go to error;
end;
end;
end tod$ASCII;
/********************************************************
********************************************************/
declare lcltod structure (
opcode byte,
date address,
hrs byte,
min byte,
sec byte,
ASCII (23) byte ); /* [JCE] 21 -> 23 */
declare datapgadr address;
declare datapg based datapgadr address;
declare extrnl$todadr address;
declare extrnl$tod based extrnl$todadr structure (
date address,
hrs byte,
min byte,
sec byte );
declare i byte;
declare ret address;
display$tod:
procedure;
lcltod.opcode = 0; /* read tod */
call mon1(50,.(26,0,0,0,0,0,0,0)); /* BIOS TIME GET SIGNAL */
call move (5,.extrnl$tod.date,.lcltod.date);
call tod$ASCII (.lcltod);
call write$console (0dh);
do i = 0 to 22; /* [JCE] 20 -> 22 */
call write$console (lcltod.ASCII(i));
end;
end display$tod;
comp:
procedure (cnt,parmadr1,parmadr2) byte;
declare (i,cnt) byte;
declare (parmadr1,parmadr2) address;
declare parm1 based parmadr1 (5) byte;
declare parm2 based parmadr2 (5) byte;
do i = 0 to cnt-1;
if parm1(i) <> parm2(i)
then return 0;
end;
return 0ffh;
end comp;
/**************************************
Main Program
**************************************/
declare last$dseg$byte byte initial (0);
declare CURRENT$VERSION address initial (0);
declare CPM30 byte initial (030h);
declare MPM byte initial (01h);
PLM:
do;
CURRENT$VERSION = RETURN$VERSION$FUNC;
if (low(CURRENT$VERSION) >= CPM30) and (high(CURRENT$VERSION) <> MPM) then
do;
datapgadr = xdos (49,.(03ah,0));
extrnl$todadr = xdos(49,.(03ah,0)) + 58H;
if (FCB(1) = 'C') then
do while FCB(1) = 'C';
call mon1(105,.(0,0,0,0)); /* [JCE] this implements Patch 17 */
if comp(5,.extrnl$tod.date,.lcltod.date) = 0 then
call display$tod;
if check$console$status then
do;
ret = read$console;
fcb(1) = 0;
end;
end;
else
if (FCB(1) = ' ') then
do;
call display$tod;
end;
else
if (FCB(1) = 'S')
then do;
call crlf;
call print$buffer(.('Enter today''s date (','$')); /* [JCE] UK-format */
if get$date$flag =2 then /* [JCE] */
call print$buffer(.('YY-MM-DD): ','$')); /* [JCE 18-9-1998] YMD format */
else if get$date$flag = 1 then /* [JCE 18-9-1998] */
call print$buffer(.('DD/MM/YY): ','$')); /* [JCE] UK format */
else call print$buffer(.('MM/DD/YY): ','$')); /* [JCE] US format */
call move(23,.(000000000000000000000),.buffer$adr.console$buffer);
call read$console$buffer(.buffer$adr);
if buffer$adr.numb$of$chars > 0
then do;
call move(23,.buffer$adr.console$buffer,.lcltod.ASCII);
tod$adr = .lcltod;
string$adr = .tod.ASCII;
chr = string(index := 0);
call set$date;
call move(2,.lcltod.date,.extrnl$tod.date);
end; /* date initialization */
call crlf;
call print$buffer(.('Enter the time (HH:MM:SS): ','$'));
call move(23,.(000000000000000000000),.buffer$adr.console$buffer);
call read$console$buffer(.buffer$adr);
if buffer$adr.numb$of$chars > 0
then do;
call move(23,.buffer$adr.console$buffer,.lcltod.ASCII);
tod$adr = .lcltod;
string$adr = .tod.ASCII;
chr = string(index := 0);
call set$time;
call crlf;
call print$buffer(.('Press any key to set time ','$'));
ret = read$console;
call move(3,.lcltod.hrs,.extrnl$tod.hrs);
call mon1(50,.(26,0,0ffh,0,0,0,0,0)); /* BIOS TIME SET SIGNAL */
end;
call crlf;
end;
else do;
call move (23,.tbuff(1),.lcltod.ASCII);
lcltod.opcode = 1;
call tod$ASCII (.lcltod);
call crlf;
call print$buffer (.('Strike key to set time','$'));
ret = read$console;
call move (5,.lcltod.date,.extrnl$tod.date);
call mon1(50,.(26,0,0ffh,0,0,0,0,0)); /* BIOS TIME SET SIGNAL */
call crlf;
end;
call terminate;
end;
else
do;
call CRLF;
call PRINT$BUFFER(.('ERROR: Requires CP/M3.','$'));
call CRLF;
call TERMINATE;
end;
end;
error:
do;
call crlf;
call print$buffer (.('ERROR: Illegal time/date specification.','$'));
call terminate;
end;

169
software/CPM/cpm3/datmod.asm
View File

@@ -1,169 +0,0 @@
$title ('GENCPM Data module')
name datmod
; Copyright (C) 1982
; Digital Research
; P.O. Box 579
; Pacific Grove, CA 93950
;
; Revised:
; 15 Nov 82 by Bruce Skidmore
;
cseg
public symtbl
;declare symtbl(16) structure(
; token(8) byte, /* question variable name */
; len byte, /* length of structure in array of structures */
; flags byte, /* type of variable */
; qptr byte, /* index into query array */
; ptr address); /* pointer to the associated data structure */
; flags definition:
; bit(3) = 1 then array of structures
; bit(4) = 1 then index is A-P else index is 0-F
; bit(2) = 1 then numeric variable
; bit(1) = 1 boolean variable legal values are Y or N
; bit(0) = 1 drive variable legal values are A-P
symtbl:
db 'PRTMSG ',1, 00000010B,0
dw prtmsg
db 'PAGWID ',1, 00000100B,1
dw conwid
db 'PAGLEN ',1, 00000100B,2
dw conpag
db 'BACKSPC ',1, 00000010B,3
dw bckspc
db 'RUBOUT ',1, 00000010B,4
dw rubout
db 'BOOTDRV ',1, 00000001B,5
dw bdrive
db 'MEMTOP ',1, 00000100B,6
dw memtop
db 'BNKSWT ',1, 00000010B,7
dw bnkswt
db 'COMBAS ',1, 00000100B,8
dw bnktop
db 'LERROR ',1, 00000010B,9
dw lerror
db 'NUMSEGS ',1, 00000100B,10
dw numseg
db 'MEMSEG00',5, 00001100B,11
dw memtbl+5
db 'HASHDRVA',1, 00011010B,27
dw hash
db 'ALTBNKSA',10,00011010B,43
dw record+3
db 'NDIRRECA',10,00011100B,59
dw record+4
db 'NDTARECA',10,00011100B,75
dw record+5
db 'ODIRDRVA',10,00011001B,91
dw record+6
db 'ODTADRVA',10,00011001B,107
dw record+7
db 'OVLYDIRA',10,00011010B,123
dw record+8
db 'OVLYDTAA',10,00011010B,139
dw record+9
db 'CRDATAF ',1,00000010B,155
dw crdatf
db 'DBLALV ',1,00000010B,156
dw dblalv
public lerror,prtmsg,bnkswt,memtop,bnktop
public bdrive,conpag,conwid,bckspc
public rubout,numseg,hash,memtbl,record
public crdatf,dblalv
lerror:
db 0ffh
prtmsg:
db 0ffh
bnkswt:
db 0ffh
memtop:
db 0ffh
bnktop:
db 0c0h
bdrive:
db 00h
conpag:
db 23
conwid:
db 79
bckspc:
db 0
rubout:
db 0ffh
numseg:
db 3
hash:
db 0ffh,0ffh,0ffh,0ffh
db 0ffh,0ffh,0ffh,0ffh
db 0ffh,0ffh,0ffh,0ffh
db 0ffh,0ffh,0ffh,0ffh
memtbl:
db 0,0,0,0,0
db 0,080h,00h,0,0
db 0,0c0h,02h,0,0
db 0,0c0h,03h,0,0
db 0,0c0h,04h,0,0
db 0,0c0h,05h,0,0
db 0,0c0h,06h,0,0
db 0,0c0h,07h,0,0
db 0,0c0h,08h,0,0
db 0,0c0h,09h,0,0
db 0,0c0h,0ah,0,0
db 0,0c0h,0bh,0,0
db 0,0c0h,0ch,0,0
db 0,0c0h,0dh,0,0
db 0,0c0h,0eh,0,0
db 0,0c0h,0fh,0,0
db 0,0c0h,10h,0,0
record:
dw 0
db 0,0,1,1,0,0,0ffh,0ffh
dw 0
db 0,0,1,1,0,0,0ffh,0ffh
dw 0
db 0,0,1,1,0,0,0ffh,0ffh
dw 0
db 0,0,1,1,0,0,0ffh,0ffh
dw 0
db 0,0,1,1,0,0,0ffh,0ffh
dw 0
db 0,0,1,1,0,0,0ffh,0ffh
dw 0
db 0,0,1,1,0,0,0ffh,0ffh
dw 0
db 0,0,1,1,0,0,0ffh,0ffh
dw 0
db 0,0,1,1,0,0,0ffh,0ffh
dw 0
db 0,0,1,1,0,0,0ffh,0ffh
dw 0
db 0,0,1,1,0,0,0ffh,0ffh
dw 0
db 0,0,1,1,0,0,0ffh,0ffh
dw 0
db 0,0,1,1,0,0,0ffh,0ffh
dw 0
db 0,0,1,1,0,0,0ffh,0ffh
dw 0
db 0,0,1,1,0,0,0ffh,0ffh
dw 0
db 0,0,1,1,0,0,0ffh,0ffh
crdatf:
db 0
dblalv:
db 0ffh
public quest
quest:
ds 157
end


1333
software/CPM/cpm3/device.plm
View File

File diff suppressed because it is too large Load Diff

546
software/CPM/cpm3/dirlbl.asm
View File

@@ -1,546 +0,0 @@
;Function 100 RSX (set/create directory label
; Only for Non banked systems
;
; Procedure:
; 1. If this BDOS call ~= f100 then go to NEXT
; 2. select the current disk for BIOS calls
; 3. search for current label
; 4. if no label then do
; a. find first empty dir slot
; b. if no empties then return error
; c. create dir label from user FCB in DE
; d. call update SFCB
; e. return
; 5. if password protected then ok = password()
; 6. if ~ok then return error
; 7. update label from user info
; 8. call update SFCB
; 9. return
;
; P. Balma
;
; RSX PREFIX
;
serial: db 0,0,0,0,0,0
jmp1: jmp ftest
NEXTj: db 0c3h ; next RSX or BDOS
NEXTa: db 0,0 ; next address
prev: dw 0 ; where from
remove: db 0ffh ; remove RSX at warm start
nbank: db 0FFh ; non banked RSX
rsxname: db 'DIRLBL '
space: dw 0
patch: db 0
;
;
ftest:
push a ;save user regs
mov a,c
cpi 64h ;compare BDOS func 100
jz func100
pop a ;some other BDOS call
goto$next:
lhld NEXTa ; go to next and don't return
pchl
; Set directory label
; de -> .fcb
; drive location
; name & type fields user's discretion
; extent field definition
; bit 1 (80h): enable passwords on drive
; bit 2 (40h): enable file access
; bit 3 (20h): enable file update stamping
; bit 4 (10h): enable file create stamping
; bit 8 (01h): assign new password to dir lbl
func100:
pop a
lxi h,0 ! dad sp ! shld ret$stack ; save user stack
lxi sp,loc$stack
xchg ! shld info ! xchg
mvi c,19h ! call goto$next ! sta curdsk ; get current disk
mvi c,1dh ! call goto$next ; is drive R/O ?
lda curdsk ! mov c,a ! call hlrotr
mov a,l ! ani 01h ! jnz read$only
lhld info ! call getexta ! push a ; if user tries to set time
ani 0111$0000b ! sta set$time ; stamps and no SFCB's...error
mov a,m ! ani 7fh ! mov m,a ; mask off password bit
ani 1 ! sta newpass ; but label can have password
mvi c,69h ! push d ! lxi d,stamp ; get time for possible
call goto$next ! pop d ; update later
mvi c,31h ! lxi d,SCBPB ! call goto$next; get BDOS current dma
shld curdma
lda curdsk ! call dsksel ; BIOS select and sets
; disk parameters
; Does dir lbl exist on drive?
call search ; return if found or
push h ! mvi b,0 ; successfully made
lxi d,20h ! lda nfcbs ! mov c,a ; Are there SFCB's in directory
main0: dad d ! mov a,m ! cpi 21h ! jz main1
inr b ! lda i ! inr a ! sta i ! cmp c
jnz main0
lda set$time ! ora a ! jnz no$SFCB ; no, but user wants to set
; time stamp
sta SFCB ; SFCB = false
main1: shld SFCB$addr ! mov a,b ! sta j ! lhld info
xchg ! pop h ! push h ! inx h ; HL => dir FCB, DE => user FCB
inx d ! mvi c,0ch ; prepare to move DE to HL
call move ! lda newpass ; find out if new password ?
ora a
cnz scramble ; scramble user pass & put in
; dFCB
lda SFCB ! inr a ! jnz mainx1 ; any SFCB's
main2: ; update time & date stamp
lda j ! mov b,a ! mvi a,2 ; j = FCB position from SFCB
sub b ; in 4 FCB sector (0,1,2), thus
; FCBx - 2
; FCBy - 1
; FCBz - 0
; SFCB
; So, 2-j gives FCB offset in
; SFCB
mvi b,0 ! mov c,a ! lhld SFCB$addr
inx h ! lxi d,0ah ! inr c
mainx0: dcr c ! jz mainx1
dad d ! jmp mainx0
mainx1: pop d ! push d ! push h ; HL => dFCB
xchg ! lxi d,18h ! dad d ; HL => dfcb(24) (TS field)
xchg ! pop h ! push d ; of DIR LABEL
; HL => Time/stamp pos in SFCB
lda NEW ! inr a ! jnz st0 ; did we create a new DL?
call stamper ! jmp st1 ; yes
st0: lxi d,4 ! dad d ; update time stamp
pop d ! push h ! xchg ! lxi d,4 ; DFCB position
dad d ! xchg ! pop h ! push d
st1: call stamper
pop h
mainr: pop h ! call getexta ! ori 1 ! mov m,a ; set lsb extent
call write$dir
xra a ! lxi h,0 !jmp goback ; no SFCB, so finished
no$SFCB:
mvi a,0ffh ! lxi h,0ffh ! jmp goback
read$only:
mvi a,0ffh ! lxi h,02ffh
goback: push h ! lhld aDIRBCB ! mvi m,0ffh ; tell BDOS not to use buffer
; contents
push a
mvi c,0dh ! call goto$next ; BDOS reset
lda curdsk ! mov e,a ! mvi c,0eh
call goto$next
lda curdsk ! call seldsk ; restore BDOS environment
pop a ! pop d
lhld ret$stack ! sphl ; restore user stack
xchg ; move error return to h
ret
dsksel: ; select disk and get parameters
call seldsk ; Bios select disk
call gethl ; DE = XLT addr
shld XLT ! xchg
lxi b,0ah ! dad b ; HL = addr DPB
call gethl
shld aDPB ! xchg
lxi b,4 ! dad b ; HL = addr DIR BCB
call gethl ! shld aDIRBCB
lxi b,0ah ! dad b ; Hl => DIR buffer
;
;[JCE] CP/M 3 Patch 10
mov e,m
inx h
mov d,m
xchg
;[JCE] end of patch
shld bufptr ; use BDOS buffer for
; BIOS reads & writes
; must jam FF into it to
; signal don't use when done
lhld aDPB
call gethl ; get [HL]
shld spt ! xchg
inx h! inx h! inx h ! inx h! inx h! ; HL => dirmax
call gethl ! shld dirmax ! xchg
inx h ! inx h !
call gethl ! shld checkv ! xchg
call gethl ! shld offset ! xchg
; HL => phys shift
call gethl ! xchg ; E = physhf, D = phymsk
inr d ! mov a,d ; phys mask+1 = # 128 byte rcd
; phymsk * 4 = nfcbs/rcd
ora a ! ral ! ora a ! ral ; clear carry & shift phymsk
sta nfcbs
lhld spt ; spt = spt/phymsk
mov c,e ! call hlrotr ; => spt = shl(spt,physhf)
shld spt
ret
search: ; search dir for pattern in
; info of length in c
xra a ! sta sect ! sta empty
lxi h,0 ! shld dcnt
lhld bufptr ! mov b,h ! mov c,l ; set BIOS dma
call setdma
src0: call read$dir
cpi 0 ! jnz oops ; if A ~= 0 then BIOS error
mvi b,0 ! lda nfcbs ! mov c,a ; BC always = nfcbs
lhld bufptr ! lxi d,20h ; start of buffer and FCB
xra a ; do i = 0 to nfcbs - 1
src1: sta i ! mov a,m ; user #
cpi 20h ! jnz src2 ; dir label mark
push h ! lxi d,10h ! dad d ! mov a,m ; found label, move to DM to
ora a ! pop h ! rz ; check if label is pass prot
push h ! cpi 20h ! pop h ! jnz checkpass
ret
src2: lda empty ! inr a ! jz src3 ; record first sect with empty
mov a,m
cpi 0e5h ! jnz src3 ! lda sect ; save sector #
sta savsect ! mvi a,0ffh ! sta empty ; set empty found = true
src3: dad d ; position to next FCB
lda i ! inr a ; while i < nfcbs
cmp c ! jnz src1
lhld dirmax ! xchg ! lhld dcnt ; while (dcnt < dirmax) &
; dir label not found
dad b ! shld dcnt ! call subdh ; is dcnt <= dirmax ?
jc not$found ; no
lda sect ! inr a ! sta sect ! jmp src0
oops: mvi a,0ffh ! lxi h,1ffh
pop b ! jmp goback ; return perm. error
not$found: ; must make a label
lda empty ! inr a ! jnz no$space ; if empty = false...
lda savsect ! sta sect
call read$dir ; get sector
lhld bufptr ! lxi d,20h ! mvi c,0 ; C = FCB offset in buffer
nf0: mov a,m ! cpi 0e5h ! jz nf1
dad d ! inr c !jmp nf0 ; know that empty occurs here
; so don't need bounds test
nf1: mvi m,20h ! mov a,c ! sta i
mvi a,0 ! push h ! mvi c,32 ; clear fcb to spaces
nf2: inx h ! dcr c ! jz nf3
mov m,a ! jmp nf2
nf3: pop h
mvi a,0ffh ! sta NEW
ret ; HL => dir FCB
no$space: mvi a,0ffh ! lxi h,0ffh ! pop b ! jmp goback
check$pass: ; Dir is password protected, check dma for
; proper password
push h ; save addr dir FCB
lxi d,0dh ! dad d ! mov c,m ; get XOR sum in S1, C = S1
lxi d,0ah ! dad d ; position to last char in label pass
mvi b,8 ; # chars in pass
xchg ! lhld curdma ! xchg ; DE => user pass, HL => label pass
cp0: mov a,m ! xra c ! push b ; HL = XOR(HL,C)
mov c,a ! ldax d ! cmp c ; compare user and label passwords
jnz wrong$pass
pop b ! inx d ! dcx h ! dcr b
jnz cp0
xchg ! shld curdma ; curdma => 2nd pass in field if there
pop h ; restore dir FCB addr
mvi a,0ffh ! sta oldpass
ret
wrong$pass:
mvi a,0ffh ! lxi h,07ffh ! pop b ! pop b
jmp goback
scramble: ; encrypt password at curdma
; 1. sum each char of pass.
; 2. XOR each char with sum
; 3. reverse order of encrypted pass
lxi b,8 ! lhld curdma ;checkpass sets to 2nd pos if
lda oldpass ! inr a ! jz scr0 ;old pass else must move dma
dad b ! shld curdma
; B = sum, C = max size of pass
scr0: mov a,m ! add b ! mov b,a ! dcr c
inx h ! jnz scr0
pop d ! pop h ! push d ; H => dFCB, D was return
lxi d,0dh ! dad d ! mov m,b ; S1 = sum
lxi d,0ah ! dad d ; position to last char in pass
mvi c,8 ! xchg ! lhld curdma
scr1: mov a,m ! xra b ! xchg ! mov m,a ; XOR(char) => dFCB
xchg ! inx h ! dcx d ! dcr c ! jnz scr1
ret
read$dir: ; read directory into bufptr
call track
call sector
call rdsec
ret
writedir: ; write directory from bufptr
lda sect
call track
call sector
call wrsec
ret
track: ; set the track for the BIOS call
lhld spt ! call intdiv ; E = integer(sect/spt)
lhld offset ! dad d ! xchg ! call settrk
ret
sector: ; set the sector for the BIOS
lda sect
lhld spt ! call intdiv ; get mod(sect,spt)
mov a,c ! sub l ; D = x * spt such that D > sect
; D - spt = least x*spt s.t. D < sect
mov c,a ! lda sect ! sub c ; a => remainder of sect/spt
mvi b,0 ! mov c,a ! lhld XLT ; BC = logical sector #, DE = translate
xchg ! call sectrn ; table address
xchg ! call setsec ; BC = physical sector #
ret
intdiv: ; compute the integer division of A/L
mvi c,0 ! lxi d,0
int0: push a ; compute the additive sum of L such
mov a,l ! add c ! mov c,a ; that C = E*L where C = 1,2,3,...
pop a
cmp C ! inr e ! jnc int0 ; if A < E*L then return E - 1
dcr e
ret
getexta:
; Get current extent field address to hl
lxi d,0ch ! dad d ; hl=.fcb(extnum)
mov a,m
ret
move: ; Move data length of length c from source de to
; destination given by hl
inr c ; in case it is zero
move0:
dcr c! rz ; more to move
ldax d! mov m,a ; one byte moved
inx d! inx h ; to next byte
jmp move0
gethl: ; get the word pointed at by HL
mov e,m ! inx h ! mov d,m ! inx h
xchg ! ret
subdh: ; HL = DE - HL
ora a ; clear carry
mov a,e ! sub l ! mov l,a
mov a,d ! sbb h ! mov h,a
ret
hlrotr:
; rotate HL right by amount c
inr c ; in case zero
hlr: dcr c! rz ; return when zero
mov a,h! ora a! rar! mov h,a ; high byte
mov a,l! rar! mov l,a ; low byte
jmp hlr
stamper: ; move time stamp into SFCB & FCB
lda SFCB ! inr a ; no SFCB, update DL only
cz stmp ! pop b ! pop d ! push h ! xchg
push b ! call stmp ! pop b ! xchg ! pop h ! push d
push b
ret
stmp: lxi d,stamp ! mvi c,4 ! call move
ret
;**********************************************************************
curdsk: db 0
set$time: db 0
oldpass: db 0
newpass: db 0
pass$prot db 0
sect: db 0
empty: db 0
stamp: ds 4
NEW: db 0
nfcbs: db 0
i: db 0
j: db 0
SFCB: db 0ffh
savsect: db 0
SFCB$addr: dw 0
info: dw 0
checkv dw 0
offset: dw 0
XLT: dw 0
bufptr: dw 0
spt: dw 0
dcnt: dw 0
curdma: dw 0
aDIRBCB dw 0
aDPB: dw 0
dFCB: dw 0
dirmax: dw 0
SCBPB:
Soff: db 3ch
Sset: db 0
Svalue: dw 0
;
;***********************************************************
;* *
;* bios calls from for track, sector io *
;* *
;***********************************************************
;***********************************************************
;* *
;* equates for interface to cp/m bios *
;* *
;***********************************************************
;
;
base equ 0
wboot equ base+1h ;warm boot entry point stored here
sdsk equ 18h ;bios select disk entry point
strk equ 1bh ;bios set track entry point
ssec equ 1eh ;bios set sector entry point
stdma equ 21h
read equ 24h ;bios read sector entry point
write equ 27h ;bios write sector entry point
stran equ 2dh ;bios sector translation entry point
;
;***********************************************************
;* *
;***********************************************************
seldsk: ;select drive number 0-15, in C
;1-> drive no.
;returns-> pointer to translate table in HL
mov c,a ;c = drive no.
lxi d,sdsk
jmp gobios
;
;***********************************************************
;* *
;***********************************************************
settrk: ;set track number 0-76, 0-65535 in BC
;1-> track no.
mov b,d
mov c,e ;bc = track no.
lxi d,strk
jmp gobios
;
;***********************************************************
;* *
;***********************************************************
setsec: ;set sector number 1 - sectors per track
;1-> sector no.
mov b,d
mov c,e ;bc = sector no.
lxi d,ssec
jmp gobios
;
;***********************************************************
;* *
;***********************************************************
rdsec: ;read current sector into sector at dma addr
;returns in A register: 0 if no errors
; 1 non-recoverable error
lxi d,read
jmp gobios
;***********************************************************
;* *
;***********************************************************
wrsec: ;writes contents of sector at dma addr to current sector
;returns in A register: 0 errors occured
; 1 non-recoverable error
lxi d,write
jmp gobios
;
;***********************************************************
;* *
;***********************************************************
sectrn: ;translate sector number
;1-> logical sector number (fixed(15))
;2-> pointer to translate table
;returns-> physical sector number
push d
lxi d,stran
lhld wboot
dad d ;hl = sectran entry point
pop d
pchl
;
;
setdma: ; set dma
; 1 -> BC = dma address
lxi d,stdma
jmp gobios
;
;
;***********************************************************
;***********************************************************
;***********************************************************
;* *
;* compute offset from warm boot and jump to bios *
;* *
;***********************************************************
;
;
gobios: ;jump to bios entry point
;de -> offset from warm boot entry point
lhld wboot
dad d
lxi d,0
pchl
;
ret$stack: dw 0
ds 32
ds 32 ;[JCE] Add extra stack as per CP/M Patch 10
loc$stack:
end


677
software/CPM/cpm3/disp.plm
View File

@@ -1,677 +0,0 @@
$title ('SDIR - Display Files')
display:
do;
/* Display Module for SDIR */
$include(comlit.lit)
$include(mon.plm)
dcl debug boolean external;
dcl (cur$drv, cur$usr) byte external;
dcl (os,bdos) byte external;
$include(vers.lit)
dcl used$de address external; /* number of used directory entries */
dcl date$opt boolean external; /* date option flag */
dcl display$attributes boolean external; /* attributes display flag */
dcl sorted boolean external;
dcl filesfound address external;
dcl no$page$mode byte external;
dcl sfcbs$present byte external; /* sfcb's there/not there indicator */
$include (search.lit)
dcl find find$structure external;
dcl format byte external, /* format is one of the following */
page$len address external, /* page size before printing new headers */
message boolean external, /* print titles and msg when no file found */
formfeeds boolean external; /* use form feeds to separate headers */
$include(format.lit)
dcl file$displayed boolean public initial (false);
/* true if we ever display a file, from any drive or user */
/* used by main.plm for file not found message */
dcl dir$label byte external;
$include(fcb.lit)
$include(xfcb.lit)
dcl
buf$fcb$adr address external, /* index into directory buffer */
buf$fcb based buf$fcb$adr (32) byte,
/* fcb template for dir */
(f$i$adr,last$f$i$adr,first$f$i$adr) address external,
cur$file address; /* number of file currently */
/* being displayed */
$include(finfo.lit)
/* structure of file info */
dcl file$info based f$i$adr f$info$structure;
dcl x$i$adr address external,
xfcb$info based x$i$adr x$info$structure;
dcl f$i$indices$base address external, /* if sorted then f$i$indices */
f$i$indices based f$i$indices$base (1) address; /* are here */
/* -------- Routines in util.plm -------- */
printchar: procedure (char) external;
dcl char byte;
end printchar;
print: procedure (string$adr) external; /* BDOS call # 9 */
dcl string$adr address;
end print;
printb: procedure external;
end printb;
crlf: procedure external;
end crlf;
printfn: procedure(fname$adr) external;
dcl fname$adr address;
end printfn;
pdecimal: procedure(v,prec,zerosup) external;
/* print value val, field size = (log10 prec) + 1 */
/* with leading zero suppression if zerosup = true */
declare v address, /* value to print */
prec address, /* precision */
zerosup boolean; /* zero suppression flag */
end pdecimal;
p3byte: procedure(byte3adr,prec)external;
/* print 3 byte value with 0 suppression */
dcl (byte3adr,prec) address; /* assume high order bit is < 10 */
end p3byte;
add3byte: procedure (byte3$adr,word$amt) external;
dcl (byte3$adr, word$amt) address;
end add3byte; /* add word to 3 byte structure */
add3byte3: procedure (byte3$adr,byte3) external;
dcl (byte3$adr, byte3) address;
end add3byte3; /* add 3 byte quantity to 3 byte total */
shr3byte: procedure (byte3$adr) external;
dcl byte3$adr address;
end shr3byte;
/* -------- Routines in search.plm -------- */
search$first: procedure(fcb$adr) byte external;
dcl fcb$adr address;
end search$first;
search$next: procedure byte external;
end search$next;
break: procedure external;
end break;
match: procedure boolean external;
dcl fcb$adr address;
end match;
/* -------- Other external routines -------- */
display$time$stamp: procedure (ts$adr) external; /* in dts.plm */
dcl ts$adr address;
end display$time$stamp;
terminate: procedure external; /* in main.plm */
end terminate;
mult23: procedure(index) address external; /* in sort.plm */
dcl index address;
end mult23;
/* -------- From dpb86.plm or dpb80.plm -------- */
$include(dpb.lit)
dpb$byte: procedure (dpb$index) byte external;
dcl dpb$index byte;
end dpb$byte;
dpb$word: procedure (dpb$index) address external;
dcl dpb$index byte;
end dpb$word;
/* -------- routines and data structures local to this module -------- */
direct$console$io: procedure byte;
return mon2(6,0ffh); /* ff to stay downward compatable */
end direct$console$io;
dcl first$time address initial (0);
/*- - - - - - - - - - - - - - - - - - - - - - -*/
wait$keypress: procedure;
declare char byte;
/* if debug then
call print(.(cr,lf,'In wait*keypress...',cr,lf,'$'));
*/
char = direct$console$io;
do while char = 0;
char = direct$console$io;
end;
if char = ctrlc then
call terminate;
end wait$keypress;
declare global$line$count byte initial(1);
/*- - - - - - - - - - - - - - - - - - - - - - -*/
crlf$and$check: procedure;
/*
if debug then
call print(.(cr,lf,'In crlf*and*check...',cr,lf,'$'));
*/
if no$page$mode = 0 then do;
if global$line$count > page$len-1 then do;
call print(.(cr,lf,'Press RETURN to Continue $'));
cur$line = cur$line + 1;
call wait$keypress;
global$line$count = 0;
end; /* global$line$count > page$len */
end; /* no$page$mode = 0 */
call crlf;
global$line$count = global$line$count + 1;
end crlf$and$check;
dcl total$kbytes structure ( /* grand total k bytes of files matched */
lword address,
hbyte byte),
total$recs structure ( /* grand total records of files matched */
lword address,
hbyte byte),
total$1k$blocks structure( /* how many 1k blocks are allocated */
lword address,
hbyte byte);
/*- - - - - - - - - - - - - - - - - - - - - - -*/
add$totals: procedure;
/*
if debug then
call print(.(cr,lf,'In add*totals...',cr,lf,'$'));
*/
call add3byte(.total$kbytes,file$info.kbytes);
call add3byte3(.total$recs,.file$info.recs$lword); /* records in file */
call add3byte(.total$1k$blocks,file$info.onekblocks);
end add$totals;
dcl files$per$line byte;
dcl cur$line address;
dcl hdr (*) byte data (' Name Bytes Recs Attributes $');
dcl hdr$bars (*) byte data ('------------ ------ ------ ------------$');
dcl hdr$pu (*) byte data (' Prot Update $');
dcl hdr$xfcb$bars (*) byte data (' ------ -------------- --------------$');
dcl hdr$access (*) byte data (' Access $');
dcl hdr$create (*) byte data (' Create $');
/* example date 04/02/55 00:34 */
/*- - - - - - - - - - - - - - - - - - - - - - -*/
display$file$info: procedure;
/* print filename.typ */
/*
if debug then
call print(.(cr,lf,'In display*file*info...',cr,lf,'$'));
*/
call printfn(.file$info.name(0));
call printb;
call pdecimal(file$info.kbytes,10000,true);
call printchar('k'); /* up to 32 Meg - Bytes */
/* or 32,000k */
call printb;
call p3byte(.file$info.recs$lword,1); /* records */
call printb;
if rol(file$info.name(f$dirsys-1),1) then /* Type */
call print(.('Sys$'));
else call print(.('Dir$'));
call printb;
if rol(file$info.name(f$rw-1),1) then
call print(.('RO$'));
else call print(.('RW$'));
call printb;
if not display$attributes then do;
if rol(file$info.name(f$arc-1),1) then
call print(.('Arcv $'));
else
call print(.(' $'));
end;
else do;
if rol(file$info.name(f$arc-1),1) then /* arc bit was on in all */
call print$char('A'); /* dir entries */
else call printb;
if rol(file$info.name(0),1) then
call print$char('1');
else call printb;
if rol(file$info.name(1),1) then
call print$char('2');
else call printb;
if rol(file$info.name(2),1) then
call print$char('3');
else call printb;
if rol(file$info.name(3),1) then
call print$char('4');
else call printb;
end;
end display$file$info;
/*- - - - - - - - - - - - - - - - - - - - - - -*/
display$xfcb$info: procedure;
/*
if debug then
call print(.(cr,lf,'In display*xfcb*info...',cr,lf,'$'));
*/
if file$info.x$i$adr <> 0 then
do;
call printb;
x$i$adr = file$info.x$i$adr;
if (xfcb$info.passmode and pm$read) <> 0 then
call print(.('Read $'));
else if (xfcb$info.passmode and pm$write) <> 0 then
call print(.('Write $'));
else if (xfcb$info.passmode and pm$delete) <> 0 then
call print(.('Delete$'));
else
call print(.('None $'));
call printb;
if (xfcb$info.update(0) <> 0 or xfcb$info.update(1) <> 0) then
call display$timestamp(.xfcb$info.update);
else call print(.(' $'));
call printb; call printb;
if (xfcb$info.create(0) <> 0 or xfcb$info.create(1) <> 0) then
call display$timestamp(.xfcb$info.create(0));
/* Create/Access */
end;
end display$xfcb$info;
dcl first$title boolean initial (true);
/*- - - - - - - - - - - - - - - - - - - - - - -*/
display$title: procedure;
/*
if debug then
call print(.(cr,lf,'In display*title...',cr,lf,'$'));
*/
if formfeeds then
call print$char(ff);
else if not first$title then
call crlf$and$check;
call print(.('Directory For Drive $'));
call printchar('A'+ cur$drv); call printchar(':');
if bdos >= bdos20 then
do;
call print(.(' User $'));
call pdecimal(cur$usr,10,true);
end;
call crlf$and$check;
cur$line = 2;
first$title = false;
end display$title;
/*- - - - - - - - - - - - - - - - - - - - - - -*/
short$display: procedure (fname$adr);
dcl fname$adr address;
/*
if debug then
call print(.(cr,lf,'In short*display...',cr,lf,'$'));
*/
if cur$file mod files$per$line = 0 then
do;
if cur$line mod page$len = 0 and first$time = 0 then
do;
call crlf$and$check;
call display$title;
call crlf$and$check;
end;
else
call crlf$and$check;
cur$line = cur$line + 1;
call printchar(cur$drv + 'A');
end;
else call printb;
call print(.(': $'));
call printfn(fname$adr);
call break;
cur$file = cur$file + 1;
first$time = first$time + 1;
end short$display;
/*- - - - - - - - - - - - - - - - - - - - - - -*/
test$att: procedure(char,off,on) boolean;
dcl (char,off,on) byte;
/*
if debug then
call print(.(cr,lf,'In test*att...',cr,lf,'$'));
*/
if (80h and char) <> 80h and off then
return(true);
if (80h and char) = 80h and on then
return(true);
return(false);
end test$att;
/*- - - - - - - - - - - - - - - - - - - - - - -*/
right$attributes: procedure(name$adr) boolean;
dcl name$adr address,
name based name$adr (1) byte;
return
test$att(name(f$rw-1),find.rw,find.ro) and
test$att(name(f$dirsys-1),find.dir,find.sys);
end right$attributes;
/*- - - - - - - - - - - - - - - - - - - - - - -*/
short$dir: procedure; /* looks like "DIR" command */
dcl dcnt byte;
/*
if debug then
call print(.(cr,lf,'In short*dir...',cr,lf,'$'));
*/
fcb(f$drvusr) = '?';
files$per$line = 4;
dcnt = search$first(.fcb);
do while dcnt <> 0ffh;
buf$fcb$adr = shl(dcnt and 11b,5)+.buff; /* dcnt mod 4 * 32 */
if (buf$fcb(f$drvusr) and 0f0h) = 0 and
buf$fcb(f$ex) = 0 and
buf$fcb(f$ex)<= dpb$byte(extmsk$b) then /* no dir labels, xfcbs */
if match then
if right$attributes(.buf$fcb(f$name)) then
call short$display(.buf$fcb(f$name));
dcnt = search$next;
end;
end short$dir;
dcl (last$plus$one,index) address;
/*- - - - - - - - - - - - - - - - - - - - - - -*/
getnxt$file$info: procedure; /* set f$i$adr to base file$info on file */
dcl right$usr boolean; /* to be displayed, f$i$adr = 0ffffh if end */
/*
if debug then
call print(.(cr,lf,'In getnxt*file*info...',cr,lf,'$'));
*/
right$usr = false;
if sorted then
do; index = index + 1;
f$i$adr = mult23(f$i$indices(index));
do while file$info.usr <> cur$usr and index <> filesfound;
index = index + 1;
f$i$adr = mult23(f$i$indices(index));
end;
if index = files$found then
f$i$adr = last$plus$one; /* no more files */
end;
else /* not sorted display in order found in directory */
do; /* use last$plus$one to avoid wrap around problems */
f$i$adr = f$i$adr + size(file$info);
do while file$info.usr <> cur$usr and f$i$adr <> last$plus$one;
f$i$adr = f$i$adr + size(file$info);
end;
end;
end getnxt$file$info;
/*- - - - - - - - - - - - - - - - - - - - - - -*/
size$display: procedure;
/*
if debug then
call print(.(cr,lf,'In size*display...',cr,lf,'$'));
*/
if (format and form$size) <> 0 then
files$per$line = 3;
else files$per$line = 4;
do while f$i$adr <> last$plus$one;
if ((file$info.x$i$adr <> 0 and find.xfcb) or
file$info.x$i$adr = 0 and find.nonxfcb) and
right$attributes(.file$info.name(0)) then
do;
call add$totals;
call short$display(.file$info.name(0));
call pdecimal(file$info.kbytes,10000,true);
call print(.('k$'));
end;
call getnxt$file$info;
end;
end size$display;
/*- - - - - - - - - - - - - - - - - - - - - - -*/
display$no$dirlabel: procedure;
/*
if debug then
call print(.(cr,lf,'In display*no*dirlabel...',cr,lf,'$'));
*/
files$per$line = 2;
first$time = 0;
do while (f$i$adr <> last$plus$one);
if ((file$info.x$i$adr <> 0 and find.xfcb) or
(file$info.x$i$adr = 0 and find.nonxfcb)) and
right$attributes(.file$info.name(0)) then
do;
if ((cur$file mod files$per$line) = 0) then /* need new line */
do;
if ((cur$line mod page$len) = 0) then
do;
if ((no$page$mode = 0) or (first$time = 0)) then do;
call crlf$and$check;
call display$title;
call crlf$and$check;
call print(.hdr);
call printb; /* two sets of hdrs */
call print(.hdr);
call crlf$and$check;
call print(.hdr$bars);
call printb;
call print(.hdr$bars);
call crlf$and$check;
cur$line = cur$line + 4;
first$time = first$time+1;
end;
else do;
call crlf$and$check;
cur$line = cur$line + 1;
end; /* no$page$mode check */
end;
else
do; call crlf$and$check;
cur$line = cur$line + 1;
end;
end;
else
call printb; /* separate the files */
call display$file$info;
cur$file = cur$file + 1;
call add$totals;
call break;
end;
call getnxt$file$info;
end;
end display$no$dirlabel;
/*- - - - - - - - - - - - - - - - - - - - - - -*/
display$with$dirlabel: procedure;
/*
if debug then
call print(.(cr,lf,'In display*with*dirlabel...',cr,lf,'$'));
*/
files$per$line = 1;
first$time = 0;
do while (f$i$adr <> last$plus$one);
if ((file$info.x$i$adr <> 0 and find.xfcb) or
(file$info.x$i$adr = 0 and find.nonxfcb)) and
right$attributes(.file$info.name(0)) then
do;
if cur$line mod page$len = 0 then
do;
if ((no$page$mode = 0) or (first$time = 0)) then do;
call crlf$and$check;
call display$title;
call crlf$and$check;
call print(.hdr);
call print(.hdr$pu);
if (dirlabel and dl$access) <> 0 then
call print(.hdr$access);
else
call print(.hdr$create);
call crlf$and$check;
call print(.hdr$bars);
call print(.hdr$xfcb$bars);
call crlf$and$check;
cur$line = cur$line + 4;
first$time = first$time + 1;
end; /* no$page$mode check */
end;
call crlf$and$check;
cur$line = cur$line + 1;
call display$file$info; /* display non bdos 3.0 file info */
call display$xfcb$info;
cur$file = cur$file + 1;
call break;
call add$totals;
end;
call getnxt$file$info;
end;
end display$with$dirlabel;
/*- - - - -MAIN ENTRY POINT - - - - - - - - - -*/
display$files: procedure public; /* MODULE ENTRY POINT */
/* display the collected data */
/*
if debug then
call print(.(cr,lf,'In main display routine...',cr,lf,'$'));
*/
cur$line, cur$file = 0; /* force titles and new line */
totalkbytes.lword, totalkbytes.hbyte, totalrecs.lword, totalrecs.hbyte =0;
total$1k$blocks.lword, total$1k$blocks.hbyte = 0;
f$i$adr = first$f$i$adr - size(file$info); /* initial if no sort */
last$plus$one = last$f$i$adr + size(file$info);
index = 0ffffh; /* initial if sorted */
call getnxt$file$info; /* base file info record */
if format > 2 then
do;
call print(.('ERROR: Illegal Format Value.',cr,lf,'$'));
call terminate; /* default could be patched - watch it */
end;
do case format; /* format = */
call short$dir; /* form$short */
call size$display; /* form$size */
/* form = full */
if date$opt then do;
if ((( dir$label and dl$exists) <> 0 ) and
((( dir$label and dl$access) <> 0 ) or
(( dir$label and dl$update) <> 0 ) or
(( dir$label and dl$makexfcb) <> 0 )) and (sfcbs$present)) then
call display$with$dirlabel; /* Timestamping is active! */
else do;
call print(.('ERROR: Date and Time Stamping Inactive.',cr,lf,'$'));
call terminate;
end;
end;
else do; /* No date option; Regular Full display */
if (((dir$label and dl$exists) <> 0) and (sfcbs$present)) then
do;
call display$with$dirlabel;
end;
else
do;
call display$no$dirlabel;
end;
end;
end; /* end of case */
if format <> form$short and cur$file > 0 then /* print totals */
do;
if cur$line + 4 > page$len and formfeeds then
do;
call printchar(cr);
call printchar(ff); /* need a new page ? */
end;
else
do;
call crlf$and$check;
call crlf$and$check;
end;
call print(.( 'Total Bytes = $'));
call p3byte(.total$kbytes,1); /* 6 digit max */
call printchar('k');
call print(.(' Total Records = $'));
call p3byte(.total$recs,10); /* 7 digit max */
call print(.(' Files Found = $'));
call pdecimal(cur$file,1000,true); /* 4 digit max */
call print(.(cr,lf,'Total 1k Blocks = $'));
call p3byte(.total$1k$blocks,1); /* 6 digit max */
call print(.(' Used/Max Dir Entries For Drive $'));
call print$char('A' + cur$drv);
call print$char(':'); call printb;
call pdecimal(used$de,1000,true);
call print$char('/');
call pdecimal(dpb$word(dirmax$w) + 1,1000,true);
end;
if cur$file = 0 then
do;
if message then
do; call crlf$and$check;
call display$title;
call print(.('No File',cr,lf,'$'));
end;
call break;
end;
else do;
file$displayed = true;
if not formfeeds then
call crlf$and$check;
end;
end display$files;
end display;

13
software/CPM/cpm3/dpb.lit
View File

@@ -1,13 +0,0 @@
/* indices into disk parameter block, used as parameters to dpb procedure */
dcl spt$w lit '0',
blkshf$b lit '2',
blkmsk$b lit '3',
extmsk$b lit '4',
blkmax$w lit '5',
dirmax$w lit '7',
dirblk$w lit '9',
chksiz lit '11',
offset$w lit '13';

45
software/CPM/cpm3/dpb80.plm
View File

@@ -1,45 +0,0 @@
$title ('SDIR 8080 - Get Disk Parameters')
dpb80:
do;
/* the purpose of this module is to allow independence */
/* of processor, i.e., 8080 or 8086 */
$include (comlit.lit)
/* function call 32 in 2.0 or later BDOS, returns the address of the disk
parameter block for the currently selected disk, which consists of:
spt (2 bytes) number of sectors per track
blkshf (1 byte) block size = shl(double(128),blkshf)
blkmsk (1 byte) sector# and blkmsk = block number
extmsk (1 byte) logical/physical extents
blkmax (2 bytes) max alloc number
dirmax (2 bytes) size of directory-1
dirblk (2 bytes) reservation bits for directory
chksiz (2 bytes) size of checksum vector
offset (2 bytes) offset for operating system
*/
$include(dpb.lit)
$include(mon.plm)
declare k$per$block address public;
declare dpb$base address;
declare dpb$array based dpb$base (15) byte;
dcl get$dpb lit '31';
dpb$byte: procedure(param) byte public;
dcl param byte;
return(dpb$array(param));
end dpb$byte;
dpb$word: procedure(param) address public;
dcl param byte;
return(dpb$array(param) + shl(double(dpb$array(param+1)),8));
end dpb$word;
base$dpb: procedure public;
dpb$base = mon3(get$dpb,0);
k$per$block = shr(dpb$byte(blkmsk$b)+1,3);
end base$dpb;
end dpb80;

BIN
software/CPM/cpm3/drlink.com
View File

Binary file not shown.

9
software/CPM/cpm3/drvtbl.asm
View File

@@ -1,9 +0,0 @@
public @dtbl
extrn fdsd0,fdsd1
cseg
@dtbl dw fdsd0,fdsd1
dw 0,0,0,0,0,0,0,0,0,0,0,0,0,0 ; drives C-P non-existant
end

488
software/CPM/cpm3/dump.asm
View File

@@ -1,488 +0,0 @@
title 'CP/M 3 DUMP Utility'
;***************************
;***************************
;** **
;** D U M P **
;** **
;** FILE DUMP ROUTINE **
;** **
;** JULY 16 1982 **
;** **
;***************************
;***************************
;
;
;
org 100h ;base of TPA
;
;******************
;* BDOS Functions *
;******************
return equ 0 ;System reset
conin equ 01 ;Read console
conout equ 02 ;Type character
bdos equ 05 ;DOS entry point
input equ 06 ;Raw console I/O
pstring equ 09 ;Type string
rstring equ 10 ;Read connsole buffer
chkio equ 11 ;Console status
reset equ 13 ;Reset Disk System
openf equ 15 ;Open file
readf equ 20 ;Read buffer
dmaf equ 26 ;Set DMA address
fsize equ 35 ;Compute file size
errmode equ 45 ;Set ERROR mode
getscb equ 49 ;Get/Set SCB
conmode equ 109 ;Set console mode
;**************************
;* Non Graphic Characters *
;**************************
ctrlc equ 03h ;control - C (^C)
ctrlx equ 018h ;control - X (^X)
cr equ 0dh ;carriage return
lf equ 0ah ;line feed
;
;*******************
;* FCB definitions *
;*******************
fcb equ 5ch ;File Control Block
buf equ 80h ;Password Buffer Location
;
;*****************
;* Begin Program *
;*****************
jmp begin
;
;*********************************************
;* Patch Area, Date, Version & Serial Number *
;*********************************************
dw 0,0,0,0,0,0
db 0
db 'DUMP VERSION 3.0'
db ' DUMP.COM '
dw 0,0,0,0,0,0,0,0
dw 0,0,0,0,0,0,0,0
maclib makedate ;[JCE] one file for all dates/copyrights
@LCOPY
@BDATE ;version date [day-month-year]
db 0,0,0,0 ;patch bit map
db '654321' ;Serial Number
;
pgraph: ;print graphic char. in ACC. or period
cpi 7fh
jnc pperiod
cpi ' '
jnc pchar
;
pperiod: ;print period
mvi a,'.'
jmp pchar
;
pchar: ;print char. in ACC. to console
push h
push d
push b
mov e,a ;value in ACC. is put in register E
mvi c,conout ;value in register E is sent to console
call bdos ;print character
pop b
pop d
pop h
ret
;
pnib: ;print nibble in low Acc.
cpi 10
jnc pnibh ;jump if 'A-F'
adi '0'
jmp pchar
;
pnibh:
adi 'A'-10
jmp pchar
;
pbyte: ;print byte in hex
push psw ;save copy for low nibble
rar ;rotate high nibble to low
rar
rar
rar
ani 0fh ;mask high nibble
call pnib
pop psw
ani 0fh
jmp pnib
;
openfile:
mvi c,openf
lxi d,fcb
call bdos ;open file
sta keepa
mov a,h
cpi 07 ;check password status
jz getpasswd ;Reg. H contains '7' if password exists
lda keepa
cpi 0ffh ;ACC.=FF if there is no file found
jz nofile
ret
;
getpasswd:
lda tpasswd
cpi 255 ;check if already tried password
jz wrngpass
call space ;set password memory area too blanks
lxi d,quest
call print ;print question
mvi a,8 ;max # of characters able to input
sta buf ;for password is eight (8)
mvi c,rstring
lxi d,buf
call bdos ;get password
lda buf+1
sta len ;store length of password
cpi 0
jz stop ;if <cr> entered then stop program
call cap ;cap the password
lxi d,buf+2
call setdma
mvi a,255
sta tpasswd ;set Tried Password Flag
mvi a,0
jmp openfile
;
space: ;this routine fills the memory
mvi a,8 ;locations from 82-89H with
lxi h,buf+2 ;a space
space2:
mvi m,' ' ;put a (blank) into the memory
inx h ;location where HL are pointing
dcr a
jnz space2
ret
;
cap: ;this routine takes the inputed
mvi b,8 ;Password and converts it to
lxi h,buf+2 ;upper-case letters
cap2:
mov a,m ;move into the ACC. where the
cpi 'a' ;current HL position points to
jc skip ;and if it is a lower-case letter
cpi '{' ;make it upper case
jnc skip
sui 20h
mov m,a
skip:
inx h ;inc the pointer to the next letter
dcr b
jnz cap2
delchar: ;this routine deletes the last
lda len ;character in the input because
adi 82h ;an extra character is added to
sta len2 ;the input when using BDOS function 10
lhld len2
mvi m,' '
ret
;
fillbuff:
lxi d,buff ;current position
fillbuff2:
sta keepa
push d
call setdma ;set DMA for file reading
call readbuff ;read file and fill BUFF
lda norec ;# records read in current loop
inr a
sta norec
cpi 8 ;check if '8' records read in loop
jz loop2
pop d
lxi h,80h ;80h=128(decimal)= # bytes in 1 record read
dad d
xchg ;changes DMA = DMA+80h
jmp fillbuff2
;
setdma:
mvi c,dmaf
call bdos ;set DMA
ret
;
readbuff:
mvi c,readf
lxi d,fcb
call bdos ;fill buffer
cpi 0 ;ACC. <> 0 if unsuccessful
rz ;return if not End Of File
lda norec
cpi 0 ;this check is needed to see if
jz stop ;the record is the first in the
mvi a,255 ;loop
sta eof ;set End Of File flag
jmp loop2 ;no more buff reading
;
break:
push b
push d ;see if character ready
push h ;if so then quit program
mvi c,chkio ;if character is a ^C
call bdos ;check console status
ora a ;zero flag is set if no character
push psw ;save all registers
mvi c,conin ;console in function
cnz bdos ;eat character if not zero
pop psw ;restore all registers
pop h
pop d
pop b
ret
;
paddr:
lhld aloc ;current display address
mov a,h
call pbyte ;high byte
mov a,l
lhld disloc
call pbyte ;low byte
mvi a,':'
jmp pchar
;
page$check:
lda page$on
cpi 0
cz page$count ;if page mode on call routine
ret
;
crlf:
mvi a,cr
call pchar
mvi a,lf
jmp pchar
;
blank:
mvi a,' '
jmp pchar
;
page$count:
lda page$size ;relative to zero
mov e,a
lda count ;current number of lines
cmp e
jz stop$display ;if xx lines then stop display
inr a
sta count ;count=count+1
ret
;
stop$display:
mvi a,0
sta count ;count=0
lxi d,con$mess
call print
stop$display2:
mvi c,input
mvi e,0fdh
call bdos
cpi ctrlc
jz stop
cpi cr ;compare character with <CR>
jnz stop$display2 ;wait until <CR> is encountered
mvi a,ctrlx
jmp pchar
;
discom: ;check line format
xchg
lhld dismax
mov a,l
sub e
mov l,a
mov a,h
sbb d
xchg
ret
;
display:
lhld size ;[(norec)x(128)]-1
xchg
lxi h,buff ;buffer location
shld disloc
dad d
;
display2:
shld dismax
;
display3:
call page$check
call crlf
call break
jnz stop ;if key pressed then quit
lhld disloc
shld tdisp
call paddr ;print the line address
;
display4:
call blank
mov a,m
call pbyte ;print byte
inx h ;increment the current buffer location
push h
lhld aloc ;aloc is current address for the display
mov a,l
ani 0fh
cpi 0fh ;check if 16 bytes printed
inx h ;increment current display address
shld aloc ;save it
pop h
jnz display4 ;if not then continue
;
display5:
shld disloc ;save the current place
lhld tdisp ;load current place - 16
xchg
call blank
call blank
;
display6:
ldax d ;get byte
call pgraph ;print if graphic character
inx d
lhld disloc
mov a,l
sub e
jnz display6
mov a,h
sub d
jnz display6
lhld disloc
call discom ;end of display ?
rc
jmp display3
;
pintro:
lxi d,intromess
call print
ret
;
setmode: ;this routine allows error codes
mvi c,errmode ;to be detected in the ACC. and
mvi e,255 ;Reg. H instead of BDOS ERROR
call bdos ;Messages
mvi c,conmode ;and also sets the console status
lxi d,1 ;so that only a ^C can affect
call bdos ;function 11
ret
;
check$page:
mvi c,getscb ;Get/Set SCB function
lxi d,page$mode
call bdos
cpi 0
rnz ;return if mode is off (false)
sta page$on ;set 'on' byte
mvi c,getscb
lxi d,page$len
call bdos
dcr a
sta page$size ;store page length (relative to zero)
ret
;
checkfile:
mvi c,fsize
lxi d,fcb
call bdos
lda fcb+33
cpi 0
rnz
lxi d,norecmess
call print
jmp stop
;
chngsize: ;if odd number of records read
sta keepa ;this routine adds 128 or
mvi a,80h ;80h to the display size
mov l,a ;because the ACC. cannot deal
lda keepa ;with decimals
ret
;
print: ;prints the string where
mvi c,pstring ;DE are pointing to
call bdos
ret
;
nofile:
mvi c,pstring
lxi d,nofmess
call bdos ;print 'FILE NOT FOUND'
jmp stop
;
wrngpass:
lxi d,badpass
call print ;print 'False Password'
;
stop: ;stop program execution
mvi c,reset
call bdos
mvi c,return
call bdos
;
begin:
lxi sp,stack
call pintro ;print the intro
call setmode ;set ERROR mode
call check$page ;check console page mode
call openfile ;open the file
call checkfile ;check if reany records exist
;
loop:
jmp fillbuff ;fill the buffer(s)
loop2:
mvi l,0 ;set L = 0
lda norec ;norec is set by fillbuff routine
rar ;(x128) or (/2)
cc chngsize ;if odd # records read then call this routine
mov h,a
dcx h
shld size ;number of bytes to display
pop d
call display ;call display routine
lda eof
cpi 255
jz stop ;jump if End Of File
mvi a,0
sta norec ;reset # records read to 0
jmp loop
;
;****************************
;* Console Messages To User *
;****************************
intromess: db cr,lf,lf,'CP/M 3 DUMP - Version 3.0$'
nofmess: db cr,lf,'ERROR: File Not Found',cr,lf,'$'
quest: db cr,lf,'Enter Password: $'
badpass: db cr,lf,'Password Error$'
norecmess: db cr,lf,'ERROR: No Records Exist$'
con$mess: db cr,lf,'Press RETURN to continue $'
;
;*****************************
;* Variable and Storage Area *
;*****************************
dismax: ds 2 ;Max.# reference
tdisp: ds 2 ;Current buffer location (for ASCII)
disloc: ds 2 ;Current buffer loocation
aloc: dw 0 ;Line address
ploc: ds 2 ;Current buffer location storage
keepa: ds 2 ;Storage for ACC.
norec: db 0 ;# of records read in certain loop (1-8)
eof: db 0 ;End Of File flag
tpasswd: dw 0 ;Tried Password flag
size: dw 0 ;Display size
page$mode: db 02ch ;page mode offset relative to SCB
db 00h
page$len: db 01ch ;page length offset relative to SCB
db 00h
page$on: db 0ffh ;page ON/OFF flag (0=ON)
page$size: db 00h ;page length relative to zero
count: db 0 ;line counter
len: dw 0 ;Password Input length
len2: dw 0 ;Extra character pointer
ds 12h
stack: ds 2
buff: ds 1024 ;The buffer (holds up to 400h = 1k)
end:


46
software/CPM/cpm3/echovers.asm
View File

@@ -1,46 +0,0 @@
; ECHOVERS RSX
pstring equ 9 ; string print function
cr equ 0dh
lf equ 0ah
;
; RSX PREFIX STRUCTURE
;
db 0,0,0,0,0,0 ; room for serial number
jmp ftest ; begin of program
next db 0c3H ; jump
dw 0 ; next module in line
prev: dw 0 ; previous module
remov: db 0ffh ; remove flag set
nonbnk: db 0
db 'ECHOVERS'
space: ds 3
ftest: ; is this function 12?
mov a,c
cpi 12
jz begin ; yes - intercept
jmp next ; some other function
begin:
lxi h,0
dad sp ;save stack
shld ret$stack
lxi sp,loc$stack
mvi c,pstring
lxi d,test$msg ; print message
call next ; call BDOS
lhld ret$stack ; restore user stack
sphl
lxi h,0031h ; return version number = 0031h
ret
test$msg:
db cr,lf,'**** ECHOVERS **** $'
ret$stack:
dw 0
ds 32 ; 16 level stack
loc$stack:
end

2647
software/CPM/cpm3/ed.plm
View File

File diff suppressed because it is too large Load Diff

824
software/CPM/cpm3/erase.plm
View File

@@ -1,824 +0,0 @@
$ TITLE('CP/M 3.0 --- ERA ')
/* contains the confirm option */
era:
do;
/*
Copyright (C) 1982
Digital Research
P.O. Box 579
Pacific Grove, CA 93950
*/
/*
Revised:
19 Jan 80 by Thomas Rolander
14 Sept 81 by Doug Huskey
23 June 82 by John Knight
03 Dec 82 by Bruce Skidmore
*/
declare
true literally '1',
false literally '0',
forever literally 'while true',
lit literally 'literally',
proc literally 'procedure',
dcl literally 'declare',
addr literally 'address',
cr literally '13',
lf literally '10',
ctrlc literally '3',
ctrlx literally '18h',
tab literally '9',
bksp literally '8',
cpmversion literally '30h',
dcnt$offset literally '45h',
searcha$offset literally '47h',
searchl$offset literally '49h',
hash1$offset literally '00h',
hash2$offset literally '02h',
hash3$offset literally '04h';
declare plm label public;
/**************************************
* *
* B D O S INTERFACE *
* *
**************************************/
mon1:
procedure (func,info) external;
declare func byte;
declare info address;
end mon1;
mon2:
procedure (func,info) byte external;
declare func byte;
declare info address;
end mon2;
mon3:
procedure (func,info) address external;
declare func byte;
declare info address;
end mon3;
parse:
procedure (pfcb) address external;
declare pfcb address;
end parse;
declare cmdrv byte external; /* command drive */
declare fcb (1) byte external; /* 1st default fcb */
declare fcb16 (1) byte external; /* 2nd default fcb */
declare pass0 address external; /* 1st password ptr */
declare len0 byte external; /* 1st passwd length */
declare pass1 address external; /* 2nd password ptr */
declare len1 byte external; /* 2nd passwd length */
declare tbuff (1) byte external; /* default dma buffer */
/**************************************
* *
* B D O S Externals *
* *
**************************************/
read$console:
procedure byte;
return mon2 (1,0);
end read$console;
printchar:
procedure(char);
declare char byte;
call mon1(2,char);
end printchar;
conin:
procedure byte;
return mon2(6,0fdh);
end conin;
print$buf:
procedure (buffer$address);
declare buffer$address address;
call mon1 (9,buffer$address);
end print$buf;
read$console$buf:
procedure (buffer$address,max) byte;
declare buffer$address address;
declare new$max based buffer$address address;
declare max byte;
new$max = max;
call mon1(10,buffer$address);
buffer$address = buffer$address + 1;
return new$max; /* actually number of chars input */
end read$console$buf;
check$con$stat:
procedure byte;
return mon2 (11,0);
end check$con$stat;
version: procedure address;
/* returns current cp/m version # */
return mon3(12,0);
end version;
setdma: procedure(dma);
declare dma address;
call mon1(26,dma);
end setdma;
search$first:
procedure (fcb$address) byte;
declare fcb$address address;
return mon2 (17,fcb$address);
end search$first;
search$next:
procedure byte;
return mon2 (18,0);
end search$next;
delete$file:
procedure (fcb$address) address;
declare fcb$address address;
return mon3 (19,fcb$address);
end delete$file;
get$user$code:
procedure byte;
return mon2 (32,0ffh);
end get$user$code;
/* 0ff => return BDOS errors */
return$errors:
procedure;
call mon1 (45,0ffh);
end return$errors;
declare scbpd structure
(offset byte,
set byte,
value address);
getscbword:
procedure (offset) address;
declare offset byte;
scbpd.offset = offset;
scbpd.set = 0;
return mon3(49,.scbpd);
end getscbword;
setscbword:
procedure (offset,value);
declare offset byte;
declare value address;
scbpd.offset = offset;
scbpd.set = 0FEh;
scbpd.value = value;
call mon1(49,.scbpd);
end setscbword;
set$console$mode: procedure;
/* set console mode to ctrl-c only */
call mon1(109,1);
end set$console$mode;
declare
parse$fn structure (
buff$adr address,
fcb$adr address);
/**************************************
* *
* GLOBAL VARIABLES *
* *
**************************************/
declare successful lit '0FFh';
declare dir$entry$adr address;
declare dir$entry based dir$entry$adr (1) byte;
declare confirm$opt byte initial (false);
declare passwd$opt byte initial (false);
declare save$passwd (8) byte;
declare (savdcnt,savsearcha,savsearchl) address;
declare (hash1,hash2,hash3) address;
/* options scanner variables and data */
declare
options(*) byte
data('PASSWORD0CONFIRM',0ffh),
off$opt(*) byte data(0,9,16),
end$list byte data (0ffh),
delimiters(*) byte data (0,'[]=, ',0,0ffh),
SPACE byte data(5),
j byte initial(0),
buf$ptr address,
index byte,
endbuf byte,
delimiter byte;
declare end$of$string byte initial('0');
/**************************************
* *
* S U B R O U T I N E S *
* *
**************************************/
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
/* * * * Option scanner * * * */
separator: procedure(character) byte;
/* determines if character is a
delimiter and which one */
declare k byte,
character byte;
k = 1;
loop: if delimiters(k) = end$list then return(0);
if delimiters(k) = character then return(k); /* null = 25 */
k = k + 1;
go to loop;
end separator;
opt$scanner: procedure(list$ptr,off$ptr,idx$ptr);
/* scans the list pointed at by idxptr
for any strings that are in the
list pointed at by list$ptr.
Offptr points at an array that
contains the indices for the known
list. Idxptr points at the index
into the list. If the input string
is unrecognizable then the index is
0, otherwise > 0.
First, find the string in the known
list that starts with the same first
character. Compare up until the next
delimiter on the input. if every input
character matches then check for
uniqueness. Otherwise try to find
another known string that has its first
character match, and repeat. If none
can be found then return invalid.
To test for uniqueness, start at the
next string in the knwon list and try
to get another match with the input.
If there is a match then return invalid.
else move pointer past delimiter and
return.
P.Balma */
declare
buff based buf$ptr (1) byte,
idx$ptr address,
off$ptr address,
list$ptr address;
declare
i byte,
j byte,
list based list$ptr (1) byte,
offsets based off$ptr (1) byte,
wrd$pos byte,
character byte,
letter$in$word byte,
found$first byte,
start byte,
index based idx$ptr byte,
save$index byte,
(len$new,len$found) byte,
valid byte;
/*****************************************************************************/
/* internal subroutines */
/*****************************************************************************/
check$in$list: procedure;
/* find known string that has a match with
input on the first character. Set index
= invalid if none found. */
declare i byte;
i = start;
wrd$pos = offsets(i);
do while list(wrd$pos) <> end$list;
i = i + 1;
index = i;
if list(wrd$pos) = character then return;
wrd$pos = offsets(i);
end;
/* could not find character */
index = 0;
return;
end check$in$list;
setup: procedure;
character = buff(0);
call check$in$list;
letter$in$word = wrd$pos;
/* even though no match may have occurred, position
to next input character. */
i = 1;
character = buff(1);
end setup;
test$letter: procedure;
/* test each letter in input and known string */
letter$in$word = letter$in$word + 1;
/* too many chars input? 0 means
past end of known string */
if list(letter$in$word) = end$of$string then valid = false;
else
if list(letter$in$word) <> character then valid = false;
i = i + 1;
character = buff(i);
end test$letter;
skip: procedure;
/* scan past the offending string;
position buf$ptr to next string...
skip entire offending string;
ie., falseopt=mod, [note: comma or
space is considered to be group
delimiter] */
character = buff(i);
delimiter = separator(character);
/* No skip for ERA */
do while ((delimiter < 1) or (delimiter > 6));
i = i + 1;
character = buff(i);
delimiter = separator(character);
end;
endbuf = i;
buf$ptr = buf$ptr + endbuf + 1;
return;
end skip;
eat$blanks: procedure;
declare charac based buf$ptr byte;
do while ((delimiter := separator(charac)) = SPACE);
buf$ptr = buf$ptr + 1;
end;
end eat$blanks;
/*****************************************************************************/
/* end of internals */
/*****************************************************************************/
/* start of procedure */
call eat$blanks;
start = 0;
call setup;
/* match each character with the option
for as many chars as input
Please note that due to the array
indices being relative to 0 and the
use of index both as a validity flag
and as a index into the option/mods
list, index is forced to be +1 as an
index into array and 0 as a flag*/
do while index <> 0;
start = index;
delimiter = separator(character);
/* check up to input delimiter */
valid = true; /* test$letter resets this */
do while delimiter = 0;
call test$letter;
if not valid then go to exit1;
delimiter = separator(character);
end;
go to good;
/* input ~= this known string;
get next known string that
matches */
exit1: call setup;
end;
/* fell through from above, did
not find a good match*/
endbuf = i; /* skip over string & return*/
call skip;
return;
/* is it a unique match in options
list? */
good: endbuf = i;
len$found = endbuf;
save$index = index;
valid = false;
next$opt:
start = index;
call setup;
if index = 0 then go to finished;
/* look at other options and check
uniqueness */
len$new = offsets(index + 1) - offsets(index) - 1;
if len$new = len$found then do;
valid = true;
do j = 1 to len$found;
call test$letter;
if not valid then go to next$opt;
end;
end;
else go to nextopt;
/* fell through...found another valid
match --> ambiguous reference */
index = 0;
call skip; /* skip input field to next delimiter*/
return;
finished: /* unambiguous reference */
index = save$index;
buf$ptr = buf$ptr + endbuf;
call eat$blanks;
if delimiter <> 0 then
buf$ptr = buf$ptr + 1;
else
delimiter = 5;
return;
end opt$scanner;
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
break: procedure;
if check$con$stat then do;
call print$buf(.(cr,lf,'*** Aborted by ^C ***$'));
call mon1(0,0);
end;
end break;
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
/* upper case character from console */
crlf: proc;
call printchar(cr);
call printchar(lf);
end crlf;
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
/* fill string @ s for c bytes with f */
fill: proc(s,f,c);
dcl s addr,
(f,c) byte,
a based s byte;
do while (c:=c-1)<>255;
a = f;
s = s+1;
end;
end fill;
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
/* error message routine */
error: proc(code);
declare
code byte;
call printchar(' ');
if code=1 then
call print$buf(.(cr,lf,'Disk I/O $'));
if code=2 then
call print$buf(.(cr,lf,'Drive $'));
if code = 3 or code = 2 then
call print$buf(.('Read Only$'));
if code = 5 then
call print$buf(.('Currently Opened$'));
if code = 7 then
call print$buf(.('Password Error$'));
if code < 3 then
call mon1(0,0);
end error;
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
/* try to delete fcb at fcb$address
return error code if unsuccessful */
delete:
procedure(fcb$address) byte;
declare
fcb$address address,
fcbv based fcb$address (32) byte,
error$code address,
code byte;
if passwd$opt then
fcbv(5) = fcbv(5) or 80h;
call setdma(.save$passwd(0)); /* password */
fcbv(0) = fcb(0); /* drive */
error$code = delete$file(fcb$address);
fcbv(5) = fcbv(5) and 7fh; /* reset xfcb bit */
if low(error$code) = 0FFh then do;
code = high(error$code);
if (code=1) or (code=2) then
call error(code);
return code;
end;
return successful;
end delete;
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
/* upper case character from console */
ucase: proc byte;
dcl c byte;
if (c:=conin) >= 'a' then
if c < '{' then
return(c-20h);
return c;
end ucase;
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
/* get password and place at fcb + 16 */
getpasswd: proc;
dcl (i,c) byte;
call print$buf(.('Password: ','$'));
retry:
call fill(.save$passwd(0),' ',8);
do i = 0 to 7;
nxtchr:
if (c:=ucase) >= ' ' then
save$passwd(i)=c;
if c = cr then
go to exit;
if c = ctrlx then
goto retry;
if c = bksp then do;
if i<1 then
goto retry;
else do;
save$passwd(i:=i-1)=' ';
goto nxtchr;
end;
end;
if c = 3 then
call mon1(0,0);
end;
exit:
c = check$con$stat; /* clear raw I/O mode */
end getpasswd;
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
/* error on deleting a file */
file$err: procedure(code);
declare code byte;
if not confirm$opt then do; /* print file */
call printchar('A'+fcb(0)-1);
call printchar(':');
call printchar(' ');
do k=1 to 11;
if k=9 then
call printchar('.');
call printchar(dir$entry(k));
end;
call print$buf(.(' $'));
end;
call print$buf(.('Not erased, $'));
call error(code);
call crlf;
end file$err;
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
erase: procedure;
if (code:=delete(.fcb)) <> successful then do;
if code < 3 then
call error(code);
else if code = 7 then do;
call file$err(code);
call getpasswd;
call crlf;
code = delete(.fcb);
end;
if code <> successful then
call file$err(code);
end;
end erase;
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
parse$options: procedure;
declare
t address,
char based t byte,
i byte;
delimiter = 1;
index = 0;
do while ((delimiter <> 0) and (delimiter <> 2) and (delimiter <> 6));
call opt$scanner(.options(0),.off$opt(0),.index);
if index = 0 then do;
/* unrecognized option */
call print$buf(.(cr,lf,'ERROR: Missing Delimiter or$'));
call print$buf(.(cr,lf,' Unrecognized Option $'));
call print$buf(.('Near: $'));
t = buf$ptr - endbuf - 1;
do i = 1 to endbuf;
call printchar(char);
t = t + 1;
end;
call mon1(0,0);
end;
if index = 1 then
passwd$opt = true;
if index = 2 then
confirm$opt = true;
end;
end parse$options;
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
input$found: procedure (buffer$adr) byte;
declare buffer$adr address;
declare char based buffer$adr byte;
do while (char = ' ') or (char = tab);
buffer$adr = buffer$adr + 1;
end;
if char = 0 then /* eoln */
return false; /* input not found */
else
return true; /* input found */
end input$found;
/**************************************
* *
* M A I N P R O G R A M *
* *
**************************************/
declare (i,k,code,response,user,dcnt) byte;
declare status address;
declare char$count byte;
declare last$dseg$byte byte
initial (0);
declare no$chars byte;
declare m based status byte;
plm:
do;
if (low(version) < cpmversion) or (high(version) = 1) then do;
call print$buf(.('Requires CP/M 3.0 $'));
call mon1(0,0);
end;
call set$console$mode;
if not input$found(.tbuff(1)) then do;
/* prompt for file */
confirm$opt = true; /* confirm, unless otherwise specified */
call print$buf(.('Enter filename: $'));
no$chars = read$console$buf(.tbuff(0),40);
char$count = no$chars + 2;
call print$buf(.(cr,lf,'$'));
tbuff(1) = ' '; /* blank out nc field */
tbuff(char$count) = 00h; /* eoln marker set */
/* convert input string to upper case */
do i = 1 to char$count;
if tbuff(i+1) >= 'a' then
if tbuff(i+1) < '}' then
tbuff(i+1) = tbuff(i+1) - 20h;
end;
end;
parse$fn.buff$adr = .tbuff(1);
parse$fn.fcb$adr = .fcb;
status = parse(.parse$fn);
if status = 0FFFFh then do;
call print$buf(.('ERROR: Invalid file name $'));
call mon1(0,0);
end;
if status <> 0 then do; /* options must follow */
do while m = ' ';
status = status + 1; /* skip over blank delimiters */
end;
buf$ptr = status + 1; /* skip first delimiter */
call parse$options;
end;
if fcb(0) = 0 then
fcb(0) = low (mon2 (25,0)) + 1;
user = get$user$code;
call return$errors;
call move(8,.fcb16,.save$passwd(0));
if not confirm$opt then do;
i = 0;
do while fcb(i:=i+1) = '?';
end;
if i > 11 then
if not passwd$opt then do;
call print$buf(.('Confirm delete all user files (Y/N)?$'));
response = read$console;
if not ((response = 'y') or (response = 'Y')) then
call mon1(0,0);
call crlf;
end;
end;
call move(16,.fcb,.fcb16);
call setdma(.tbuff);
dcnt = search$first (.fcb16);
if dcnt = 0FFh then do;
call print$buf(.('No File $'));
call mon1(0,0);
end;
do while dcnt <> 0ffh;
dir$entry$adr = .tbuff(ror(dcnt,3) and 110$0000b);
savdcnt = getscbword(dcnt$offset);
savsearcha = getscbword(searcha$offset);
savsearchl = getscbword(searchl$offset);
/* save searched fcb's hash code (5 bytes) */
hash1 = getscbword(hash1$offset);
hash2 = getscbword(hash2$offset);
hash3 = getscbword(hash3$offset);
if confirm$opt then do;
if dir$entry(0) = user then do;
call printchar ('A'+fcb(0)-1);
call printchar (':');
call printchar (' ');
do k = 1 to 11;
if k = 9
then call printchar ('.');
call printchar (dir$entry(k));
end;
call print$buf(.(' (Y/N)? $'));
response = read$console;
call printchar (cr);
call printchar (lf);
if response = ctrlc then do;
call print$buf(.(cr,lf,'*** Aborted by ^C ***$'));
call mon1(0,0);
end;
if (response = 'y') or
(response = 'Y') then do;
call move (12,.dir$entry(1),.fcb(1));
call erase;
end;
end;
end;
else do; /* not confirm option */
call move(12,.dir$entry(1),.fcb(1));
call break;
call erase;
end;
call setdma(.tbuff);
call setscbword(dcnt$offset,savdcnt);
call setscbword(searcha$offset,savsearcha);
call setscbword(searchl$offset,savsearchl);
/* restore hash code */
call setscbword(hash1$offset,hash1);
call setscbword(hash2$offset,hash2);
call setscbword(hash3$offset,hash3);
if .fcb16 <> savsearcha then /* restore search fcb if destroyed */
call move(16,.fcb16,savsearcha);
dcnt = search$next;
end;
call mon1(0,0);
end;
end era;

21
software/CPM/cpm3/fcb.lit
View File

@@ -1,21 +0,0 @@
declare
f$drvusr lit '0', /* drive/user byte */
f$name lit '1', /* file name */
f$namelen lit '8', /* file name length */
f$type lit '9', /* file type field */
f$typelen lit '3', /* type length */
f$rw lit '9', /* high bit is R/W attribute */
f$dirsys lit '10', /* high bit is dir/sys attribute */
f$arc lit '11', /* high bit is archive attribute */
f$ex lit '12', /* extent */
f$s1 lit '13', /* module byte */
f$rc lit '15', /* record count */
f$diskmap lit '16', /* file disk map */
diskmaplen lit '16', /* disk map length */
f$drvusr2 lit '16', /* fcb2 */
f$name2 lit '17',
f$type2 lit '25',
f$rrec lit '33', /* random record */
f$rreco lit '35'; /* " " overflow */

384
software/CPM/cpm3/fd1797sd.asm
View File

@@ -1,384 +0,0 @@
title 'wd1797 w/ Z80 DMA Single density diskette handler'
; CP/M-80 Version 3 -- Modular BIOS
; Disk I/O Module for wd1797 based diskette systems
; Initial version 0.01,
; Single density floppy only. - jrp, 4 Aug 82
dseg
; Disk drive dispatching tables for linked BIOS
public fdsd0,fdsd1
; Variables containing parameters passed by BDOS
extrn @adrv,@rdrv
extrn @dma,@trk,@sect
extrn @dbnk
; System Control Block variables
extrn @ermde ; BDOS error mode
; Utility routines in standard BIOS
extrn ?wboot ; warm boot vector
extrn ?pmsg ; print message @<HL> up to 00, saves <BC> & <DE>
extrn ?pdec ; print binary number in <A> from 0 to 99.
extrn ?pderr ; print BIOS disk error header
extrn ?conin,?cono ; con in and out
extrn ?const ; get console status
; Port Address Equates
maclib ports
; CP/M 3 Disk definition macros
maclib cpm3
; Z80 macro library instruction definitions
maclib z80
; common control characters
cr equ 13
lf equ 10
bell equ 7
; Extended Disk Parameter Headers (XPDHs)
dw fd$write
dw fd$read
dw fd$login
dw fd$init0
db 0,0 ; relative drive zero
fdsd0 dph trans,dpbsd,16,31
dw fd$write
dw fd$read
dw fd$login
dw fd$init1
db 1,0 ; relative drive one
fdsd1 dph trans,dpbsd,16,31
cseg ; DPB must be resident
dpbsd dpb 128,26,77,1024,64,2
dseg ; rest is banked
trans skew 26,6,1
; Disk I/O routines for standardized BIOS interface
; Initialization entry point.
; called for first time initialization.
fd$init0:
lxi h,init$table
fd$init$next:
mov a,m ! ora a ! rz
mov b,a ! inx h ! mov c,m ! inx h
outir
jmp fd$init$next
fd$init1: ; all initialization done by drive 0
ret
init$table db 4,p$zpio$1A
db 11001111b, 11000010b, 00010111b,11111111b
db 4,p$zpio$1B
db 11001111b, 11011101b, 00010111b,11111111b
db 0
fd$login:
; This entry is called when a logical drive is about to
; be logged into for the purpose of density determination.
; It may adjust the parameters contained in the disk
; parameter header pointed at by <DE>
ret ; we have nothing to do in
; simple single density only environment.
; disk READ and WRITE entry points.
; these entries are called with the following arguments:
; relative drive number in @rdrv (8 bits)
; absolute drive number in @adrv (8 bits)
; disk transfer address in @dma (16 bits)
; disk transfer bank in @dbnk (8 bits)
; disk track address in @trk (16 bits)
; disk sector address in @sect (16 bits)
; pointer to XDPH in <DE>
; they transfer the appropriate data, perform retries
; if necessary, then return an error code in <A>
fd$read:
lxi h,read$msg ; point at " Read "
mvi a,88h ! mvi b,01h ; 1797 read + Z80DMA direction
jmp rw$common
fd$write:
lxi h,write$msg ; point at " Write "
mvi a,0A8h ! mvi b,05h ; 1797 write + Z80DMA direction
; jmp wr$common
rw$common: ; seek to correct track (if necessary),
; initialize DMA controller,
; and issue 1797 command.
shld operation$name ; save message for errors
sta disk$command ; save 1797 command
mov a,b ! sta zdma$direction ; save Z80DMA direction code
lhld @dma ! shld zdma$dma ; get and save DMA address
lda @rdrv ! mov l,a ! mvi h,0 ; get controller-relative disk drive
lxi d,select$table ! dad d ; point to select mask for drive
mov a,m ! sta select$mask ; get select mask and save it
out p$select ; select drive
more$retries:
mvi c,10 ; allow 10 retries
retry$operation:
push b ; save retry counter
lda select$mask ! lxi h,old$select ! cmp m
mov m,a
jnz new$track ; if not same drive as last, seek
lda @trk ! lxi h,old$track ! cmp m
mov m,a
jnz new$track ; if not same track, then seek
in p$fdmisc ! ani 2 ! jnz same$track ; head still loaded, we are OK
new$track: ; or drive or unloaded head means we should . . .
call check$seek ; . . read address and seek if wrong track
lxi b,16667 ; 100 ms / (24 t states*250 ns)
spin$loop: ; wait for head/seek settling
dcx b
mov a,b ! ora c
jnz spin$loop
same$track:
lda @trk ! out p$fdtrack ; give 1797 track
lda @sect ! out p$fdsector ; and sector
lxi h,dma$block ; point to dma command block
lxi b,dmab$length*256 + p$zdma ; command block length and port address
outir ; send commands to Z80 DMA
in p$bankselect ; get old value of bank select port
ani 3Fh ! mov b,a ; mask off DMA bank and save
lda @dbnk ! rrc ! rrc ; get DMA bank to 2 hi-order bits
ani 0C0h ! ora b ; merge with other bank stuff
out p$bankselect ; and select the correct DMA bank
lda disk$command ; get 1797 command
call exec$command ; start it then wait for IREQ and read status
sta disk$status ; save status for error messages
pop b ; recover retry counter
ora a ! rz ; check status and return to BDOS if no error
ani 0001$0000b ; see if record not found error
cnz check$seek ; if a record not found, we might need to seek
dcr c ! jnz retry$operation
; suppress error message if BDOS is returning errors to application...
lda @ermde ! cpi 0FFh ! jz hard$error
; Had permanent error, print message like:
; BIOS Err on d: T-nn, S-mm, <operation> <type>, Retry ?
call ?pderr ; print message header
lhld operation$name ! call ?pmsg ; last function
; then, messages for all indicated error bits
lda disk$status ; get status byte from last error
lxi h,error$table ; point at table of message addresses
errm1:
mov e,m ! inx h ! mov d,m ! inx h ; get next message address
add a ! push psw ; shift left and push residual bits with status
xchg ! cc ?pmsg ! xchg ; print message, saving table pointer
pop psw ! jnz errm1 ; if any more bits left, continue
lxi h,error$msg ! call ?pmsg ; print "<BEL>, Retry (Y/N) ? "
call u$conin$echo ; get operator response
cpi 'Y' ! jz more$retries ; Yes, then retry 10 more times
hard$error: ; otherwise,
mvi a,1 ! ret ; return hard error to BDOS
cancel: ; here to abort job
jmp ?wboot ; leap directly to warmstart vector
; subroutine to seek if on wrong track
; called both to set up new track or drive
check$seek:
push b ; save error counter
call read$id ; try to read ID, put track in <B>
jz id$ok ; if OK, we're OK
call step$out ; else step towards Trk 0
call read$id ; and try again
jz id$ok ; if OK, we're OK
call restore ; else, restore the drive
mvi b,0 ; and make like we are at track 0
id$ok:
mov a,b ! out p$fdtrack ; send current track to track port
lda @trk ! cmp b ! pop b ! rz ; if its desired track, we are done
out p$fddata ; else, desired track to data port
mvi a,00011010b ; seek w/ 10 ms. steps
jmp exec$command
step$out:
mvi a,01101010b ; step out once at 10 ms.
jmp exec$command
restore:
mvi a,00001011b ; restore at 15 ms
; jmp exec$command
exec$command: ; issue 1797 command, and wait for IREQ
; return status
out p$fdcmnd ; send 1797 command
wait$IREQ: ; spin til IREQ
in p$fdint ! ani 40h ! jz wait$IREQ
in p$fdstat ; get 1797 status and clear IREQ
ret
read$id:
lxi h,read$id$block ; set up DMA controller
lxi b,length$id$dmab*256 + p$zdma ; for READ ADDRESS operation
outir
mvi a,11000100b ; issue 1797 read address command
call exec$command ; wait for IREQ and read status
ani 10011101b ; mask status
lxi h,id$buffer ! mov b,m ; get actual track number in <B>
ret ; and return with Z flag true for OK
u$conin$echo: ; get console input, echo it, and shift to upper case
call ?const ! ora a ! jz u$c1 ; see if any char already struck
call ?conin ! jmp u$conin$echo ; yes, eat it and try again
u$c1:
call ?conin ! push psw
mov c,a ! call ?cono
pop psw ! cpi 'a' ! rc
sui 'a'-'A' ; make upper case
ret
disk$command ds 1 ; current wd1797 command
select$mask ds 1 ; current drive select code
old$select ds 1 ; last drive selected
old$track ds 1 ; last track seeked to
disk$status ds 1 ; last error status code for messages
select$table db 0001$0000b,0010$0000b ; for now use drives C and D
; error message components
read$msg db ', Read',0
write$msg db ', Write',0
operation$name dw read$msg
; table of pointers to error message strings
; first entry is for bit 7 of 1797 status byte
error$table dw b7$msg
dw b6$msg
dw b5$msg
dw b4$msg
dw b3$msg
dw b2$msg
dw b1$msg
dw b0$msg
b7$msg db ' Not ready,',0
b6$msg db ' Protect,',0
b5$msg db ' Fault,',0
b4$msg db ' Record not found,',0
b3$msg db ' CRC,',0
b2$msg db ' Lost data,',0
b1$msg db ' DREQ,',0
b0$msg db ' Busy,',0
error$msg db ' Retry (Y/N) ? ',0
; command string for Z80DMA device for normal operation
dma$block db 0C3h ; reset DMA channel
db 14h ; channel A is incrementing memory
db 28h ; channel B is fixed port address
db 8Ah ; RDY is high, CE/ only, stop on EOB
db 79h ; program all of ch. A, xfer B->A (temp)
zdma$dma ds 2 ; starting DMA address
dw 128-1 ; 128 byte sectors in SD
db 85h ; xfer byte at a time, ch B is 8 bit address
db p$fddata ; ch B port address (1797 data port)
db 0CFh ; load B as source register
db 05h ; xfer A->B
db 0CFh ; load A as source register
zdma$direction ds 1 ; either A->B or B->A
db 0CFh ; load final source register
db 87h ; enable DMA channel
dmab$length equ $-dma$block
read$id$block db 0C3h ; reset DMA channel
db 14h ; channel A is incrementing memory
db 28h ; channel B is fixed port address
db 8Ah ; RDY is high, CE/ only, stop on EOB
db 7Dh ; program all of ch. A, xfer A->B (temp)
dw id$buffer ; starting DMA address
dw 6-1 ; Read ID always xfers 6 bytes
db 85h ; byte xfer, ch B is 8 bit address
db p$fddata ; ch B port address (1797 data port)
db 0CFh ; load dest (currently source) register
db 01h ; xfer B->A
db 0CFh ; load source register
db 87h ; enable DMA channel
length$id$dmab equ $-read$id$block
cseg ; easier to put ID buffer in common
id$buffer ds 6 ; buffer to hold ID field
; track
; side
; sector
; length
; CRC 1
; CRC 2
end

15
software/CPM/cpm3/finfo.lit
View File

@@ -1,15 +0,0 @@
/* file info record for SDIR - note if this structure changes in size */
/* the multXX: routine in the sort.plm module must also change */
declare
f$info$structure lit 'structure(
usr byte, name (8) byte, type (3) byte, onekblocks address,
kbytes address, recs$lword address, recs$hbyte byte,
hash$link address, x$i$adr address)';
declare
x$info$structure lit 'structure (
create (4) byte,
update (4) byte,
passmode byte)';

5
software/CPM/cpm3/format.lit
View File

@@ -1,5 +0,0 @@
dcl form$short lit '0', /* format values for SDIR */
form$size lit '1',
form$full lit '2';

1999
software/CPM/cpm3/gencom.plm
View File

File diff suppressed because it is too large Load Diff

Some files were not shown because too many files have changed in this diff Show More