forked from amberisvibin/chibi-pc09
7884 lines
250 KiB
Plaintext
7884 lines
250 KiB
Plaintext
裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹 OS1BOOT ASM OS2CCP ASM
|
||
|
||
OS2CCP ASM H OS3BDOS ASM !"#$%&'()*+,-裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹
|
||
mon80 equ 0f800h ;intel monitor base
|
||
rmon80 equ 0ff0fh ;restart location for mon80
|
||
base equ 078h ;'base' used by controller
|
||
STAT LIN )ﾕﾖﾗﾘﾙﾚ OS3BDOS ASM 薜S2CCP $$$ 裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹t testing
|
||
bias equ 0000h
|
||
endif
|
||
cpmb equ bias ;base of dos load
|
||
bdos equ 806h+bias ;entry to dos for calls
|
||
bdose equ 1880h OS3BDOS ASM ./0123456789:;<= OS3BDOS ASM >?@ABCDEFGHIJKLM OS3BDOS ASM NOPQRSTUVWXYZ[\ﾛ OS4BIOS ASM `]^_`abcdefgh 裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹rtype equ base+1 ;result type
|
||
rbyte equ base+3 ;result byte
|
||
reset equ base+7 ;reset controller
|
||
;
|
||
dstat equ base ;disk status裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹+bias ;end of dos load
|
||
boot equ 1600h+bias ;cold start entry point
|
||
rboot equ boot+3 ;warm start entry point
|
||
;
|
||
org 03000h ; OS5TRINTSRC i XSUB0 ASM jklﾜ XSUB1 ASM mnop PIP PLM qrstuvwxyz{|}~裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹 port
|
||
ilow equ base+1 ;low iopb address
|
||
ihigh equ base+2 ;high iopb address
|
||
bsw equ 0ffh ;boot switch
|
||
recal equ 3h ;recalibr裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹loaded down from hardware boot at 3000h
|
||
;
|
||
bdosl equ bdose-cpmb
|
||
ntrks equ 2 ;number of tracks to read
|
||
bdoss equ bdosl/128 ;nu PIP PLM ≠ヤ<E289A0>㊧炎旧克署 PIP PLM 葬灯楓利劒屆撼泛 PIP PLM ｡｢ PIP LIN P｣､･ｦｧｨｩｪｫｬ title 'mds cold start loader at 3000h'
|
||
;
|
||
; MDS-800 Cold Start Loader for CP/M 2.0
|
||
;
|
||
; Version 2.0 August, 1979
|
||
;
|
||
false eq裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹ate selected drive
|
||
readf equ 4h ;disk read function
|
||
stack equ 100h ;use end of boot for stack
|
||
;
|
||
rstart:
|
||
lxi sp,stack;in ca裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹mber of sectors in dos
|
||
bdos0 equ 25 ;number of bdos sectors on track 0
|
||
bdos1 equ bdoss-bdos0 ;number of sectors on track 1
|
||
;
|
||
SUBMIT PLM Eｭｮｯｰｱｲｳｴｵ SUBMIT LIN ｶｷ STAT PLM ｸｹｺｻｼｽｾｿﾀﾁﾂﾃﾄﾅﾆﾇ STAT PLM dﾈﾉﾊﾋﾌﾍﾎﾏﾐﾑﾒﾓﾔ u 0
|
||
true equ not false
|
||
testing equ false ;if true, then go to mon80 on errors
|
||
;
|
||
if testing
|
||
bias equ 03400h
|
||
endif
|
||
if nose of call to mon80
|
||
; clear disk status
|
||
in rtype
|
||
in rbyte
|
||
; check if boot switch is off
|
||
coldstart:
|
||
in bsw
|
||
ani 02h ;sw裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹track 0
|
||
db 2 ;start with sector 2 on track 0
|
||
dw cpmb ;start at base of bdos
|
||
iopbl equ $-iopb0
|
||
;
|
||
iopb1: db 80h
|
||
db readf
|
||
ll *
|
||
; * command with comlen = 00). An initializing program *
|
||
; * can be automatically loaded by storing the command *
|
||
; ral
|
||
cc rmon80 ;not ready bit set
|
||
rar ;restore
|
||
ani 11110b ;overrun/addr err/seek/crc/xxxx
|
||
;
|
||
if testing
|
||
cnz rmon80 ;g
|
||
;
|
||
; ********************************************************
|
||
; * Base of CCP contains the following code/data *
|
||
; * ccp: jitch on?
|
||
jnz coldstart
|
||
; clear the controller
|
||
out reset ;logic cleared
|
||
;
|
||
;
|
||
mvi b,ntrks ;number of tracks to read
|
||
lxi title 'console command processor (CCP), ver 2.0'
|
||
; assembly language version of the CP/M console command processor
|
||
;
|
||
; versi
|
||
db bdos1 ;sectors to read on track 1
|
||
db 1 ;track 1
|
||
db 1 ;sector 1
|
||
dw cpmb+bdos0*128 ;base of second read
|
||
;
|
||
end
|
||
* at ccp+8, with the command length at ccp+7. In this *
|
||
; * case, the ccp executes the command before prompting *
|
||
; * the co to monitor
|
||
endif
|
||
if not testing
|
||
jnz rstart ;retry the load
|
||
endif
|
||
;
|
||
;
|
||
lxi d,iopbl ;length of iopb
|
||
dad d ;addressimp ccpstart (start with command) *
|
||
; * jmp ccpclear (start, clear command) *
|
||
; * ccp+6 127 (max command length) *
|
||
; h,iopb0
|
||
;
|
||
start:
|
||
;
|
||
; read first/next track into cpmb
|
||
mov a,l
|
||
out ilow
|
||
mov a,h
|
||
out ihigh
|
||
wait0: in dstat
|
||
ani 4
|
||
jon 2.2 February, 1980
|
||
;
|
||
; Copyright (c) 1976, 1977, 1978, 1979, 1980
|
||
; Digital Research
|
||
; Box 579, Pacific Grove,
|
||
; Califor裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹onsole for input. Note that the command is exe-*
|
||
; * cuted on both warm and cold starts. When the command*
|
||
; * line is initing next iopb
|
||
dcr b ;count down tracks
|
||
jnz start
|
||
;
|
||
;
|
||
; jmp to boot to print initial message, and set up jmps
|
||
jmp boot
|
||
;* ccp+7 comlen (command length = 00) *
|
||
; * ccp+8 ' ... ' (16 blanks) *
|
||
; *******************************************z wait0
|
||
;
|
||
; check disk status
|
||
in rtype
|
||
ani 11b
|
||
cpi 2
|
||
;
|
||
if testing
|
||
cnc rmon80 ;go to monitor if 11 or 10
|
||
endif
|
||
inia, 93950
|
||
;
|
||
false equ 0000h
|
||
true equ not false
|
||
testing equ false ;true if debugging
|
||
;
|
||
;
|
||
if testing
|
||
org 3400h
|
||
bdosl e裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹alized, a jump to "jmp ccpclear" dis- *
|
||
; * ables the automatic command execution. *
|
||
; ***********************
|
||
; parameter blocks
|
||
iopb0: db 80h ;iocw, no update
|
||
db readf ;read function
|
||
db bdos0 ;# sectors to read on track 0
|
||
db 0 ;*************
|
||
; * Normal entry is at ccp, where the command line given *
|
||
; * at ccp+8 is executed automatically (normally a nuf not testing
|
||
jnc rstart ;retry the load
|
||
endif
|
||
;
|
||
in rbyte ;i/o complete, check status
|
||
; if not ready, then go to mon80
|
||
qu $+800h ;bdos location
|
||
else
|
||
org 000h
|
||
bdosl equ $+800h ;bdos location
|
||
endif
|
||
tran equ 100h
|
||
tranm equ $
|
||
ccploc equ $
|
||
*********************************
|
||
;
|
||
jmp ccpstart ;start ccp with possible initial command
|
||
jmp ccpclear ;clear the command beturn
|
||
lf equ 10 ;line feed
|
||
la equ 5fh ;left arrow
|
||
eofile equ 1ah ;end of file
|
||
;
|
||
; utility procedures
|
||
printchar:
|
||
mov e,a!nction
|
||
searnf equ 18 ;search for next file function
|
||
delf equ 19 ;delete file function
|
||
dreadf equ 20 ;disk read function
|
||
dwriom:
|
||
;search for comfcb file
|
||
lxi d,comfcb! jmp search
|
||
;
|
||
delete: ;delete the file given by d,e
|
||
mvi c,delf! jmp bdos
|
||
;
|
||
bdary bdos entry point
|
||
buff equ 0080h ;default buffer
|
||
fcb equ 005ch ;default file control block
|
||
;
|
||
rcharf equ 1 ;read characteros
|
||
;
|
||
select:
|
||
mov e,a! mvi c,self! jmp bdos
|
||
;
|
||
bdos$inr:
|
||
call bdos! sta dcnt! inr a! ret
|
||
;
|
||
open: ;open the file given byuffer
|
||
maxlen: db 127 ;max buffer length
|
||
comlen: db 0 ;command length (filled in by dos)
|
||
; (command executed initially if coml mvi c,pcharf! jmp bdos
|
||
;
|
||
printbc:
|
||
;print character, but save b,c registers
|
||
push b! call printchar! pop b! ret
|
||
;
|
||
crlf:
|
||
tf equ 21 ;disk write function
|
||
makef equ 22 ;file make function
|
||
renf equ 23 ;rename file function
|
||
logf equ 24 ;return login vos$cond:
|
||
call bdos! ora a! ret
|
||
;
|
||
diskread:
|
||
;read the next record from the file given by d,e
|
||
mvi c,dreadf! jmp bdos$cond
|
||
function
|
||
pcharf equ 2 ;print character function
|
||
pbuff equ 9 ;print buffer function
|
||
rbuff equ 10 ;read buffer function
|
||
break d,e
|
||
mvi c,openf! jmp bdos$inr
|
||
;
|
||
openc: ;open comfcb
|
||
xra a! sta comrec ;clear next record to read
|
||
lxi d,comfcb! jmp openen non zero)
|
||
combuf:
|
||
db ' ' ;8 character fill
|
||
db ' ' ;8 character fill
|
||
db 'COPYRIGHT (C) 1979, DIGITAL RESE mvi a,cr! call printbc
|
||
mvi a,lf! jmp printbc
|
||
;
|
||
blank:
|
||
mvi a,' '! jmp printbc
|
||
;
|
||
print: ;print string starting at b,c unector
|
||
cself equ 25 ;return currently selected drive number
|
||
dmaf equ 26 ;set dma address
|
||
userf equ 32 ;set user number
|
||
;
|
||
; s
|
||
;
|
||
diskreadc:
|
||
;read the comfcb file
|
||
lxi d,comfcb! jmp diskread
|
||
;
|
||
diskwrite:
|
||
;write the next record to the file given byf equ 11 ;break key function
|
||
liftf equ 12 ;lift head function (no operation)
|
||
initf equ 13 ;initialize bdos function
|
||
self equ
|
||
;
|
||
close: ;close the file given by d,e
|
||
mvi c,closef! jmp bdos$inr
|
||
;
|
||
search: ;search for the file given by d,e
|
||
mvi c,searARCH '; 38
|
||
ds 128-($-combuf)
|
||
; total buffer length is 128 characters
|
||
comaddr:dw combuf ;address of next to char to scan
|
||
sttil next 00 entry
|
||
push b! call crlf! pop h ;now print the string
|
||
prin0: mov a,m! ora a! rz ;stop on 00
|
||
inx h! push h ;readpecial fcb flags
|
||
rofile equ 9 ;read only file
|
||
sysfile equ 10 ;system file flag
|
||
;
|
||
; special characters
|
||
cr equ 13 ;carriage r d,e
|
||
mvi c,dwritf! jmp bdos$cond
|
||
;
|
||
make: ;create the file given by d,e
|
||
mvi c,makef! jmp bdos$inr
|
||
;
|
||
renam: ;rename the fi14 ;select disk function
|
||
openf equ 15 ;open file function
|
||
closef equ 16 ;close file function
|
||
searf equ 17 ;search for file fuf! jmp bdos$inr
|
||
;
|
||
searchn:
|
||
;search for the next occurrence of the file given by d,e
|
||
mvi c,searnf! jmp bdos$inr
|
||
;
|
||
searchcaddr: ds 2 ;starting address of current fillfcb request
|
||
;
|
||
diska equ 0004h ;disk address for current disk
|
||
bdos equ 0005h ;primy for next
|
||
call printchar! pop h ;character printed
|
||
jmp prin0 ;for another character
|
||
;
|
||
initialize:
|
||
mvi c,initf! jmp bdle given by d,e
|
||
mvi c,renf! jmp bdos
|
||
;
|
||
getuser:
|
||
;return current user code in a
|
||
mvi e,0ffh ;drop through to setuser
|
||
;
|
||
sall del$sub
|
||
;translate to upper case, store zero at end
|
||
call saveuser ;user # save in case control c
|
||
mvi c,rbuff! lxi d,ma
|
||
;disk read is ok, transfer to combuf
|
||
lxi d,comlen! lxi h,buff! mvi b,128! call move0
|
||
;line is transferred, close theet to false
|
||
xra a! call select ;on drive a to erase file
|
||
lxi d,subfcb! call delete
|
||
lda cdisk! jmp select ;back to originald to upper case
|
||
;
|
||
readcom:
|
||
;read the next command into the command buffer
|
||
;check for submit file
|
||
lda submit! ora a! jz na character ready at the console
|
||
mvi c,breakf! call bdos
|
||
ora a! rz
|
||
mvi c,rcharf! call bdos ;character cleared
|
||
ora a! retetuser:
|
||
mvi c,userf! jmp bdos ;sets user number
|
||
;
|
||
saveuser:
|
||
;save user#/disk# before possible ^c or transient
|
||
calxlen! call bdos
|
||
call setdiska ;no control c, so restore diska
|
||
noread: ;enter here from submit file
|
||
;set the last character file with a
|
||
;deleted record
|
||
lxi h,submod! mvi m,0 ;clear fwflag
|
||
inx h! dcr m ;one less record
|
||
lxi d,subfcb! cal drive
|
||
;
|
||
serialize:
|
||
;check serialization
|
||
lxi d,serial! lxi h,bdosl! mvi b,6 ;check six bytes
|
||
ser0: ldax d! cmp m! jnz baosub
|
||
;scanning a submit file
|
||
;change drives to open and read the file
|
||
lda cdisk! ora a! mvi a,0! cnz select
|
||
;have to
|
||
;
|
||
cselect:
|
||
;get the currently selected drive number to reg-A
|
||
mvi c,cself! jmp bdos
|
||
;
|
||
setdmabuff:
|
||
;set default buffer l getuser ;code to a
|
||
add a! add a! add a! add a ;rot left
|
||
lxi h,cdisk! ora m ;4b=user, 4b=disk
|
||
sta diska ;stored away in m to zero for later scans
|
||
lxi h,comlen! mov b,m ;length is in b
|
||
readcom0: inx h! mov a,b! ora a ;end of scan?
|
||
jz readcom1!l close! jz nosub
|
||
;close went ok, return to original drive
|
||
lda cdisk! ora a! cnz select
|
||
;print to the 00
|
||
lxi h,cdserial
|
||
inx d! inx h! dcr b! jnz ser0
|
||
ret ;serial number is ok
|
||
;
|
||
comerr:
|
||
;error in command string starting at position open again in case xsub present
|
||
lxi d,subfcb! call open! jz nosub ;skip if no sub
|
||
lda subrc! dcr a ;read ladma address
|
||
lxi d,buff ;(drop through)
|
||
;
|
||
setdma:
|
||
;set dma address to d,e
|
||
mvi c,dmaf! jmp bdos
|
||
;
|
||
del$sub:
|
||
;delete theemory for later
|
||
ret
|
||
;
|
||
setdiska:
|
||
lda cdisk! sta diska ;user/disk
|
||
ret
|
||
;
|
||
translate:
|
||
;translate character in register A mov a,m ;get character and translate
|
||
call translate! mov m,a! dcr b! jmp readcom0
|
||
;
|
||
readcom1: ;end of scan, h,l addressombuf! call prin0
|
||
call break$key! jz noread
|
||
call del$sub! jmp ccp ;break key depressed
|
||
;
|
||
nosub: ;no submit file! c
|
||
;'staddr' and ending with first delimiter
|
||
call crlf ;space to next line
|
||
lhld staddr ;h,l address first to print
|
||
comerr0st record(s) first
|
||
sta subcr ;current record to read
|
||
lxi d,subfcb! call diskread ;end of file if last record
|
||
jnz nosub
|
||
submit file, and set submit flag to false
|
||
lxi h,submit! mov a,m! ora a! rz ;return if no sub file
|
||
mvi m,0 ;submit flag is sto upper case
|
||
cpi 61h! rc ;return if below lower case a
|
||
cpi 7bh! rnc ;return if above lower case z
|
||
ani 5fh! ret ;translate end of command
|
||
mov m,a ;store a zero
|
||
lxi h,combuf! shld comaddr ;ready to scan to zero
|
||
ret
|
||
;
|
||
break$key:
|
||
;check for : ;print characters until blank or zero
|
||
mov a,m! cpi ' '! jz comerr1; not blank
|
||
ora a! jz comerr1; not zero, so print it
|
||
;set disk to name in register b
|
||
mov a,b! sta sdisk ;mark as disk selected
|
||
mov m,b! inx d ;past the :
|
||
;
|
||
setname: ;set tcommand address in d,e
|
||
call deblank ;to first non-blank character
|
||
xchg! shld staddr ;in case of errors
|
||
xchg! pop h ;d,e hatype field with blanks
|
||
inx h! mvi m,' '! dcr b! jnz padty
|
||
;
|
||
efill: ;end of the filename/filetype fill, save command addrz ;left arrow
|
||
cpi '.'! rz
|
||
cpi ':'! rz
|
||
cpi ';'! rz
|
||
cpi '<'! rz
|
||
cpi '>'! rz
|
||
ret ;delimiter not found
|
||
;
|
||
debla b,3! cpi '.'! jnz padty ;skip the type field if no .
|
||
inx d ;past the ., to the file type field
|
||
setty0: ;set the field fro push h! call printchar! pop h! inx h
|
||
jmp comerr0; for another character
|
||
comerr1: ;print question mark,and delete sub filehe file name field
|
||
mvi b,8 ;file name length (max)
|
||
setnam0: call delim! jz padname ;not a delimiter
|
||
inx h! cpi '*'! jns command, h,l has fcb address
|
||
;look for preceding file name A: B: ...
|
||
ldax d! ora a! jz setcur0 ;use current disk if empty ress
|
||
;fill the remaining fields for the fcb
|
||
mvi b,3
|
||
efill0: inx h! mvi m,0! dcr b! jnz efill0
|
||
xchg! shld comaddr ;senk: ;deblank the input line
|
||
ldax d! ora a! rz ;treat end of line as blank
|
||
cpi ' '! rnz! inx d! jmp deblank
|
||
;
|
||
addh: ;addm the command buffer
|
||
call delim! jz padty! inx h! cpi '*'! jnz setty1
|
||
mvi m,'?' ;since * specified! jmp setty2
|
||
;
|
||
|
||
mvi a,'?'! call printchar
|
||
call crlf! call del$sub
|
||
jmp ccp ;restart with next command
|
||
;
|
||
; fcb scan and fill subroutinz setnam1 ;must be ?'s
|
||
mvi m,'?'! jmp setnam2 ;to dec count
|
||
;
|
||
setnam1: mov m,a ;store character to fcb! inx d
|
||
setnacommand
|
||
sbi 'A'-1! mov b,a ;disk name held in b if : follows
|
||
inx d! ldax d! cpi ':'! jz setdsk ;set disk name if :
|
||
;
|
||
sett new starting point
|
||
;
|
||
;recover the start address of the fcb and count ?'s
|
||
pop h! lxi b,11 ;b=0, c=8+3
|
||
scnq: inx h! a to h,l
|
||
add l! mov l,a! rnc
|
||
inr h! ret
|
||
;
|
||
fillfcb0:
|
||
;equivalent to fillfcb(0)
|
||
mvi a,0
|
||
;
|
||
fillfcb:
|
||
lxi h,comfcbsetty1: ;not a *, so copy to type field
|
||
mov m,a! inx d
|
||
setty2: ;decrement count and go again
|
||
dcr b! jnz setty0
|
||
;
|
||
e (entry is at fillfcb below)
|
||
;fill the comfcb, indexed by A (0 or 16)
|
||
;subroutines
|
||
delim: ;look for a delimiter
|
||
ldax dm2: dcr b ;count down length! jnz setnam0
|
||
;
|
||
;end of name, truncate remainder
|
||
trname: call delim! jz setty ;set type fieldcur: ;set current disk
|
||
dcx d ;back to first character of command
|
||
setcur0:
|
||
lda cdisk! mov m,a! jmp setname
|
||
;
|
||
setdsk: mov a,m! cpi '?'! jnz scnq0
|
||
;? found, count it in b! inr b
|
||
scnq0: dcr c! jnz scnq
|
||
;
|
||
;number of ?'s in c, move to a a! call addh! push h! push h ;fcb rescanned at end
|
||
xra a! sta sdisk ;clear selected disk (in case A:...)
|
||
lhld comaddr! xchg ;
|
||
;end of type field, truncate
|
||
trtyp: ;truncate type field
|
||
call delim! jz efill! inx d! jmp trtyp
|
||
;
|
||
padty: ;pad the ! ora a! rz ;not the last element
|
||
cpi ' '! jc comerr ;non graphic
|
||
rz ;treat blank as delimiter
|
||
cpi '='! rz
|
||
cpi la! if delimiter
|
||
inx d! jmp trname
|
||
;
|
||
padname: inx h! mvi m,' '! dcr b! jnz padname
|
||
;
|
||
setty: ;set the type field
|
||
mvind return with flags set
|
||
mov a,b! ora a! ret
|
||
;
|
||
intvec:
|
||
;intrinsic function names (all are four characters)
|
||
db 'DIR '
|
||
;proper disk is selected, now check sub files
|
||
;check for initial command
|
||
lda comlen! ora a! jnz ccp0 ;assume typed already
|
||
loader
|
||
lxi sp,stack! push b ;save initial disk number
|
||
;(high order 4bits=user code, low 4bits=disk#)
|
||
mov a,c! rar! xi h,di or (hlt shl 8)
|
||
shld ccploc! lxi h,ccploc! pchl
|
||
;
|
||
;
|
||
;utility subroutines for intrinsic handlers
|
||
readerr:
|
||
dcr b
|
||
jnz intrin1 ;loop while matching
|
||
;
|
||
;complete match on name, check for blank in fcb
|
||
ldax d! cpi ' '! jnz intrice
|
||
lda sdisk! ora a! jnz userfunc
|
||
;check for an intrinsic function
|
||
call intrinsic
|
||
lxi h,jmptab ;index is in the accumdb 'ERA '
|
||
db 'TYPE'
|
||
db 'SAVE'
|
||
db 'REN '
|
||
db 'USER'
|
||
intlen equ ($-intvec)/4 ;intrinsic function length
|
||
ser
|
||
;
|
||
ccp:
|
||
;enter here on each command or error condition
|
||
lxi sp,stack
|
||
call crlf ;print d> prompt, where d is disk name
|
||
carar! rar! rar! ani 0fh ;user code
|
||
mov e,a! call setuser ;user code selected
|
||
;initialize for this user, get $ flag
|
||
c;print the read error message
|
||
lxi b,rdmsg! jmp print
|
||
rdmsg: db 'READ ERROR',0
|
||
;
|
||
nofile:
|
||
;print no file message
|
||
ln3 ;otherwise matched
|
||
mov a,c! ret ;with intrinsic number in a
|
||
;
|
||
intrin2: ;mismatch, move to end of intrinsic
|
||
inx hulator
|
||
mov e,a! mvi d,0! dad d! dad d ;index in d,e
|
||
mov a,m! inx h! mov h,m! mov l,a! pchl
|
||
;pc changes to the proper inial: db 0,0,0,0,0,0
|
||
;
|
||
;
|
||
intrinsic:
|
||
;look for intrinsic functions (comfcb has been filled)
|
||
lxi h,intvec! mvi c,0 ;c countsll cselect ;get current disk number
|
||
adi 'A'! call printchar
|
||
mvi a,'>'! call printchar
|
||
call readcom ;command buffer filled
|
||
all initialize ;0ffh in accum if $ file present
|
||
sta submit ;submit flag set if $ file present
|
||
pop b ;recall usxi b,nofmsg! jmp print
|
||
nofmsg: db 'NO FILE',0
|
||
;
|
||
getnumber: ;read a number from the command line
|
||
call fillfcb0 ;should ! dcr b! jnz intrin2
|
||
;
|
||
intrin3: ;try next intrinsic
|
||
inr c ;to next intrinsic number
|
||
jmp intrin0 ;for another roundtrinsic or user function
|
||
jmptab:
|
||
dw direct ;directory search
|
||
dw erase ;file erase
|
||
dw type ;type file
|
||
dw save intrinsics as scanned
|
||
intrin0: mov a,c! cpi intlen ;done with scan?! rnc
|
||
;no, more to scan
|
||
lxi d,comfcb+1 ;beginning of
|
||
ccp0: ;(enter here from initialization with command full)
|
||
lxi d,buff! call setdma ;default dma address at buff
|
||
call cselecter code and disk number
|
||
mov a,c! ani 0fh ;disk number in accumulator
|
||
sta cdisk ;clears user code nibble
|
||
call selectbe number
|
||
lda sdisk! ora a! jnz comerr ;cannot be prefixed
|
||
;convert the byte value in comfcb to binary
|
||
lxi h,comfcb+1!
|
||
;
|
||
ccpclear:
|
||
;clear the command buffer
|
||
xra a
|
||
sta comlen
|
||
;drop through to start ccp
|
||
ccpstart:
|
||
;enter here from boot ;save memory image
|
||
dw rename ;file rename
|
||
dw user ;user number
|
||
dw userfunc;user-defined function
|
||
badserial:
|
||
l name
|
||
mvi b,4 ;length of match is in b
|
||
intrin1: ldax d! cmp m ;match?
|
||
jnz intrin2 ;skip if no match
|
||
inx d! inx h! ! sta cdisk ;current disk number saved
|
||
call fillfcb0 ;command fcb filled
|
||
cnz comerr ;the name cannot be an ambiguous referenlxi b,11 ;(b=0, c=11)
|
||
;value accumulated in b, c counts name length to zero
|
||
conv0: mov a,m! cpi ' '! jz conv1
|
||
;more tolank request, must be in comfcb
|
||
dir1: mvi e,0! push d ;E counts directory entries
|
||
call searchcom ;first one has been found
|
||
mand
|
||
lda sdisk! ora a! rz ;no action if not selected
|
||
dcr a! lxi h,cdisk! cmp m! rz ;same disk
|
||
lda cdisk! jmp select
|
||
;
|
||
;may be 3rd item
|
||
cpi 3! jnz dirb ;place blank at end if not
|
||
mvi a,9! call addhcf ;first char of type
|
||
ani 7fh! cpi ' ame:
|
||
;move 3 characters from h,l to d,e addresses
|
||
mvi b,3
|
||
move0: mov a,m! stax d! inx h! inx d
|
||
dcr b! jnz move0
|
||
|
||
call crlf
|
||
push b! call cselect! pop b
|
||
;current disk in A
|
||
adi 'A'! call printbc
|
||
mvi a,':'! call printbc
|
||
scan, convert char to binary and add
|
||
inx h! sui '0'! cpi 10! jnc comerr ;valid?
|
||
mov d,a ;save value! mov a,b ;mult by 1
|
||
cz nofile ;not found message
|
||
dir2: jz endir
|
||
;found, but may be system file
|
||
lda dcnt ;get the location of the element
|
||
;individual intrinsics follow
|
||
direct:
|
||
;directory search
|
||
call fillfcb0 ;comfcb gets file name
|
||
call setdisk ;change disk '! jz dir5
|
||
;not a blank in the file type field
|
||
dirb: mvi a,' ' ;restore trailing filename chr
|
||
dir4:
|
||
call printbc ;ret
|
||
;
|
||
addhcf: ;buff + a + c to h,l followed by fetch
|
||
lxi h,buff! add c! call addh! mov a,m! ret
|
||
;
|
||
setdisk:
|
||
;changejmp dirhdr1 ;skip current line hdr
|
||
dirhdr0:call blank ;after last one
|
||
mvi a,':'! call printbc
|
||
dirhdr1:
|
||
call blank
|
||
0
|
||
ani 1110$0000b! jnz comerr
|
||
mov a,b ;recover value
|
||
rlc! rlc! rlc ;*8
|
||
add b! jc comerr
|
||
add b! jc comerr ;*8+
|
||
rrc! rrc! rrc! ani 110$0000b! mov c,a
|
||
;c contains base index into buff for dir entry
|
||
mvi a,sysfile! call addhcf ;value drives if requested
|
||
lxi h,comfcb+1! mov a,m ;may be empty request
|
||
cpi ' '! jnz dir1 ;skip fill of ??? if not blank
|
||
;set cchar printed
|
||
inr b! mov a,b! cpi 12! jnc dir5
|
||
;check for break between names
|
||
cpi 9! jnz dir3 ;for another char
|
||
; disks for this command, if requested
|
||
xra a! sta comfcb ;clear disk name from fcb
|
||
lda sdisk! ora a! rz ;no action if not s
|
||
;compute position of name in buffer
|
||
mvi b,1 ;start with first character of name
|
||
dir3: mov a,b! call addhcf ;buff+a+c fe*2 = *10
|
||
add d! jc comerr ;+digit
|
||
mov b,a! dcr c! jnz conv0 ;for another digit
|
||
ret
|
||
conv1: ;end of digits, check fto A
|
||
ral! jc dir6 ;skip if system file
|
||
;c holds index into buffer
|
||
;another fcb found, new line?
|
||
pop d! mov a,e! inr omfcb to all ??? for current disk
|
||
mvi b,11 ;length of fill ????????.???
|
||
dir0: mvi m,'?'! inx h! dcr b! jnz dir0
|
||
;not a bprint a blank between names
|
||
call blank! jmp dir3
|
||
;
|
||
dir5: ;end of current entry
|
||
pop psw ;discard the directory countepecified
|
||
dcr a! lxi h,cdisk! cmp m! rz ;already selected
|
||
jmp select
|
||
;
|
||
resetdisk:
|
||
;return to original disk after comtched
|
||
ani 7fh ;mask flags
|
||
;may delete trailing blanks
|
||
cpi ' '! jnz dir4 ;check for blank type
|
||
pop psw! push psw or all blanks
|
||
mov a,m! cpi ' '! jnz comerr ;blanks?
|
||
inx h! dcr c! jnz conv1
|
||
mov a,b ;recover value! ret
|
||
;
|
||
movene! push d
|
||
;e=0,1,2,3,...new line if mod 4 = 0
|
||
ani 11b! push psw ;and save the test
|
||
jnz dirhdr0 ;header on current liner (mod 4)
|
||
dir6: call break$key ;check for interrupt at keyboard
|
||
jnz endir ;abort directory search
|
||
call searchn! jmp dir2er
|
||
;
|
||
;should be followed by a file to save the memory image
|
||
call fillfcb0
|
||
jnz comerr ;cannot be ambiguous
|
||
call senz typeof ;hard end of file
|
||
xra a! mov m,a ;bptr = 0
|
||
type1: ;read character at bptr and print
|
||
inr m ;bptr = bptr + 1
|
||
jmp retcom
|
||
fullmsg: db 'NO SPACE',0
|
||
;
|
||
;
|
||
rename:
|
||
;rename a file on a specific disk
|
||
call fillfcb0! jnz comerr ;must be nofile ;no file message if so
|
||
jmp retcom
|
||
;
|
||
ermsg: db 'ALL (Y/N)?',0
|
||
;
|
||
type:
|
||
call fillfcb0! jnz comerr ;don't allow ?'e around
|
||
lxi h,128! dad d! push h ;next dma address saved
|
||
call setdma ;current dma address set
|
||
lxi d,comfcb! call diskw ;for another entry
|
||
endir: ;end of directory scan
|
||
pop d ;discard directory counter
|
||
jmp retcom
|
||
;
|
||
;
|
||
erase:
|
||
call fillftdisk ;may be a disk change
|
||
lxi d,comfcb! push d! call delete ;existing file removed
|
||
pop d! call make ;create a new file o
|
||
lxi h,buff! call addh ;h,l addresses char
|
||
mov a,m! cpi eofile! jz retcom
|
||
call printchar
|
||
call break$key! jnz retc unambiguous
|
||
lda sdisk! push psw ;save for later compare
|
||
call setdisk ;disk selected
|
||
call searchcom ;is new name already ts in file name
|
||
call setdisk! call openc ;open the file
|
||
jz typerr ;zero flag indicates not found
|
||
;file opened, read 'til erite
|
||
pop d! pop h ;dma address, sector count
|
||
jnz saverr ;may be disk full case
|
||
jmp save0 ;for another sector
|
||
;
|
||
savcb0 ;cannot be all ???'s
|
||
cpi 11
|
||
jnz erasefile
|
||
;erasing all of the disk
|
||
lxi b,ermsg! call print!
|
||
call readcom
|
||
lxin disk
|
||
jz saverr ;no directory space
|
||
xra a! sta comrec; clear next record field
|
||
pop psw ;#pages to write is in a, changom ;abort if break
|
||
jmp type0 ;for another character
|
||
;
|
||
typeof: ;end of file, check for errors
|
||
dcr a! jz retcom
|
||
here?
|
||
jnz renerr3
|
||
;file doesn't exist, move to second half of fcb
|
||
lxi h,comfcb! lxi d,comfcb+16! mvi b,16! call move0
|
||
of
|
||
call crlf! lxi h,bptr! mvi m,255 ;read first buffer
|
||
type0: ;loop on bptr
|
||
lxi h,bptr! mov a,m! cpi 128 ;end buffer
|
||
e1: ;end of dump, close the file
|
||
lxi d,comfcb! call close
|
||
inr a; 255 becomes 00 if error
|
||
jnz retsave ;for another comma h,comlen! dcr m! jnz ccp ;bad input
|
||
inx h! mov a,m! cpi 'Y'! jnz ccp
|
||
;ok, erase the entire diskette
|
||
inx h! shld comadde to #sectors
|
||
mov l,a! mvi h,0! dad h!
|
||
lxi d,tran ;h,l is sector count, d,e is load address
|
||
save0: ;check for sector cocall readerr
|
||
typerr: call resetdisk! jmp comerr
|
||
;
|
||
save:
|
||
call getnumber; value to register a
|
||
push psw ;save it for lat ;check for = or left arrow
|
||
lhld comaddr! xchg! call deblank
|
||
cpi '='! jz ren1 ;ok if =
|
||
cpi la! jnz renerr2
|
||
ren1: xchg jc type1! push h ;carry if 0,1,...,127
|
||
;read another buffer full
|
||
call diskreadc! pop h ;recover address of bptr
|
||
jnd
|
||
saverr: ;must be full or read only disk
|
||
lxi b,fullmsg! call print
|
||
retsave:
|
||
;reset dma buffer
|
||
call setdmabuff
|
||
r ;otherwise error at retcom
|
||
erasefile:
|
||
call setdisk
|
||
lxi d,comfcb! call delete
|
||
inr a ;255 returned if not found
|
||
czunt zero
|
||
mov a,h! ora l! jz save1 ;may be completed
|
||
dcx h ;sector count = sector count - 1
|
||
push h ;save it for next tim! inx h! shld comaddr ;past delimiter
|
||
;proper delimiter found
|
||
call fillfcb0! jnz renerr2
|
||
;check for drive conflict
|
||
nz load1
|
||
;sector loaded, set new dma address and compare
|
||
pop h! lxi d,128! dad d
|
||
lxi d,tranm ;has the load overfloweh
|
||
lda sdisk! ora a! jz endcom ;no disk name if 0
|
||
dcr a! sta cdisk! call setdiska ;set user/disk
|
||
call select! jmp endcomaded program
|
||
lxi sp,stack ;may come back here
|
||
call setdiska! call select
|
||
jmp ccp
|
||
;
|
||
userer: ;arrive here on com; file already exists
|
||
lxi b,renmsg! call print! jmp retcom
|
||
renmsg: db 'FILE EXISTS',0
|
||
;
|
||
user:
|
||
;set user number
|
||
call ov a,m! ora a! jz bmove1! cpi ' '! jz bmove1
|
||
inx h! jmp bmove0 ;for another scan
|
||
;first blank position found
|
||
bmove1: pop psw! mov b,a ;previous drive number
|
||
lxi h,sdisk! mov a,m! ora a! jz ren2
|
||
;drive name was specified. same one?
|
||
cd?
|
||
mov a,l! sub e! mov a,h! sbb d! jnc loaderr
|
||
jmp load0 ;for another sector
|
||
;
|
||
load1: pop h! dcr a! jnz loaderr ;
|
||
user0: ;file name is present
|
||
lxi d,comfcb+9! ldax d! cpi ' '! jnz comerr ;type ' '
|
||
push d! call setdisk! pop d! lxi h,cmand error
|
||
call resetdisk! jmp comerr
|
||
;
|
||
loaderr:;cannot load the program
|
||
lxi b,loadmsg! call print
|
||
jmp retcomgetnumber; leaves the value in the accumulator
|
||
cpi 16! jnc comerr; must be between 0 and 15
|
||
mov e,a ;save for setuser call
|
||
mvi b,0! lxi d,buff+1! ;ready for the move
|
||
bmove2: mov a,m! stax d! ora a! jz bmove3
|
||
;more to move
|
||
inr b! inx h! inx mp b! mov m,b! jnz renerr2
|
||
ren2: mov m,b ;store the name in case drives switched
|
||
xra a! sta comfcb! call searchcom ;is old end file is 1
|
||
call resetdisk ;back to original disk
|
||
call fillfcb0! lxi h,sdisk! push h
|
||
mov a,m! sta comfcb ;drive nuomtype ;.com
|
||
call movename ;file type is set to .com
|
||
call openc! jz userer
|
||
;file opened properly, read it into memory
|
||
|
||
loadmsg: db 'BAD LOAD',0
|
||
comtype: db 'COM' ;for com files
|
||
;
|
||
;
|
||
retcom: ;reset disk before end of command check
|
||
call lda comfcb+1! cpi ' '! jz comerr
|
||
call setuser ;new user number set
|
||
jmp endcom
|
||
;
|
||
userfunc:
|
||
call serialize ;check serialid! jmp bmove2
|
||
bmove3: ;b has character count
|
||
mov a,b! sta buff
|
||
call crlf
|
||
;now go to the loaded program
|
||
call sfile there?
|
||
jz renerr1
|
||
;
|
||
;everything is ok, rename the file
|
||
lxi d,comfcb! call renam
|
||
jmp retcom
|
||
;
|
||
renerr1:; mber set
|
||
mvi a,16! call fillfcb ;move entire fcb to memory
|
||
pop h! mov a,m! sta comfcb+16
|
||
xra a! sta comrec ;record n lxi h,tran ;transient program base
|
||
load0: push h ;save dma address
|
||
xchg! call setdma
|
||
lxi d,comfcb! call diskread! jresetdisk
|
||
;
|
||
endcom: ;end of intrinsic command
|
||
call fillfcb0 ;to check for garbage at end of line
|
||
lda comfcb+1! sui ' '! lxzation
|
||
;load user function and set up for execution
|
||
lda comfcb+1! cpi ' '! jnz user0
|
||
;no file name, but may be disk switcetdmabuff ;default dma
|
||
call saveuser ;user code saved
|
||
;low memory diska contains user code
|
||
call tran ;gone to the lono file on disk
|
||
call nofile! jmp retcom
|
||
renerr2:; ambigous reference/name conflict
|
||
call resetdisk! jmp comerr
|
||
renerr3:umber set to zero
|
||
lxi d,fcb! lxi h,comfcb! mvi b,33! call move0
|
||
;move command line to buff
|
||
lxi h,combuf
|
||
bmove0: mi h,sdisk! ora m
|
||
;0 in accumulator if no disk selected, and blank fcb
|
||
jnz comerr
|
||
jmp ccp
|
||
;
|
||
;
|
||
;
|
||
; data areas
|
||
ds 16 ;8stack
|
||
;
|
||
; low memory locations
|
||
reboot equ 0000h ;reboot system
|
||
ioloc equ 0003h ;i/o byte location
|
||
bdosa equ 0006h ;addre **
|
||
;** **
|
||
;************************************************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 1 ;selected disk for current operation
|
||
;none=0, a=1, b=2 ...
|
||
bptr: ds 1 ;buffer pointer
|
||
end ccploc
|
||
rack function
|
||
setsecf set bios+3*11 ;set sector function
|
||
setdmaf set bios+3*12 ;set dma function
|
||
readf set bios+3*13 ;read di level stack
|
||
stack:
|
||
;
|
||
; 'submit' file control block
|
||
submit: db 0 ;00 if no submit file, ff if submitting
|
||
subfcb: db 0,'$$$ ss field of jmp BDOS
|
||
;
|
||
; bios access constants
|
||
bootf set bios+3*0 ;cold boot function
|
||
wbootf set bios+3*1 ;warm boot functio*****************
|
||
;*****************************************************************
|
||
;
|
||
; Copyright (c) 1978, 1979, 1980
|
||
; Di0ah ;line feed
|
||
ctl equ 5eh ;up arrow
|
||
;
|
||
db 0,0,0,0,0,0
|
||
;
|
||
; enter here from the user's program with function number in c,
|
||
; title 'Bdos Interface, Bdos, Version 2.2 Feb, 1980'
|
||
;*****************************************************************
|
||
;*****sk function
|
||
writef set bios+3*14 ;write disk function
|
||
liststf set bios+3*15 ;list status function
|
||
sectran set bios+3*16 ;sect ' ;file name is $$$
|
||
db 'SUB',0,0 ;file type is sub
|
||
submod: db 0 ;module number
|
||
subrc: ds 1 ;record count filed
|
||
ds 16 ;n
|
||
constf set bios+3*2 ;console status function
|
||
coninf set bios+3*3 ;console input function
|
||
conoutf set bios+3*4 ;console outpgital Research
|
||
; Box 579, Pacific Grove
|
||
; California
|
||
;
|
||
;
|
||
; 20 january 1980
|
||
;
|
||
;
|
||
on equ 0ffffh
|
||
off equ 00000h
|
||
test and information address in d,e
|
||
jmp bdose ;past parameter block
|
||
;
|
||
; ************************************************
|
||
; *** ************************************************************
|
||
;** **or translate
|
||
;
|
||
; equates for non graphic characters
|
||
ctlc equ 03h ;control c
|
||
ctle equ 05h ;physical eol
|
||
ctlh equ 08h ;backspdisk map
|
||
subcr: ds 1 ;current record to read
|
||
;
|
||
; command file control block
|
||
comfcb: ds 32 ;fields filled in later
|
||
comrec: dut function
|
||
listf set bios+3*5 ;list output function
|
||
punchf set bios+3*6 ;punch output function
|
||
readerf set bios+3*7 ;reader equ off
|
||
;
|
||
if test
|
||
org 0dc00h
|
||
else
|
||
org 0800h
|
||
endif
|
||
; bios value defined at end of module
|
||
;
|
||
ssize equ 24 ;24 level relative locations 0009 - 000e ***
|
||
; ************************************************
|
||
pererr: dw persub ;permanent e
|
||
;** 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 ace
|
||
ctlp equ 10h ;prnt toggle
|
||
ctlr equ 12h ;repeat line
|
||
ctls equ 13h ;stop/start screen
|
||
ctlu equ 15h ;line delete
|
||
ctlx equ s 1 ;current record to read/write
|
||
dcnt: ds 1 ;disk directory count (used for error codes)
|
||
cdisk: ds 1 ;current disk
|
||
sdisk: dsinput function
|
||
homef set bios+3*8 ;disk home function
|
||
seldskf set bios+3*9 ;select disk function
|
||
settrkf set bios+3*10 ;set trror subroutine
|
||
selerr: dw selsub ;select error subroutine
|
||
roderr: dw rodsub ;ro disk error subroutine
|
||
roferr: dw rofsub ;ro jmp wait$err ;wait console
|
||
;
|
||
rofsub: ;report read/only file
|
||
lxi h,rofmsg ;drop through to wait for console
|
||
;
|
||
wait$err:
|
||
;dw func24,func25,func26,func27
|
||
dw func28,func29,func30,func31
|
||
dw func32,func33,func34,func35
|
||
dw func36,func37,func38,func3kspace
|
||
cpi cr! rz ;carriage return?
|
||
cpi lf! rz ;line feed?
|
||
cpi tab! rz ;tab?
|
||
cpi ctlh! rz ;backspace?
|
||
cpi ' '! ret ;canvalid #
|
||
mov c,e ;possible output character to C
|
||
lxi h,functab! mov e,a! mvi d,0 ;DE=func, HL=.ciotab
|
||
dad d! dad d! mov e,ut character
|
||
;(drop through to conin)
|
||
;ret
|
||
;
|
||
;
|
||
; console handlers
|
||
conin:
|
||
;read console character to A
|
||
lxi h,kbchafile error subroutine
|
||
;
|
||
;
|
||
bdose: ;arrive here from user programs
|
||
xchg! shld info! xchg ;info=DE, DE=info
|
||
mov a,e! sta linwait for response before boot
|
||
call errflg! jmp reboot
|
||
;
|
||
; error messages
|
||
dskmsg: db 'Bdos Err On '
|
||
dskerr: db ' : $' ;fill9 ;
|
||
dw func40 ;
|
||
nfuncs equ ($-functab)/2
|
||
;
|
||
;
|
||
; error subroutines
|
||
persub: ;report permanent error
|
||
lxi h,permsg! calrry set if not graphic
|
||
;
|
||
conbrk: ;check for character ready
|
||
lda kbchar! ora a! jnz conb1 ;skip if active kbchar
|
||
;no activm! inx h! mov d,m ;DE=functab(func)
|
||
lhld info ;info in DE for later xchg
|
||
xchg! pchl ;dispatched
|
||
;
|
||
; dispatch table for fr! mov a,m! mvi m,0! ora a! rnz
|
||
;no previous keyboard character ready
|
||
jmp coninf ;get character externally
|
||
;ret
|
||
;
|
||
conechfo ;linfo = low(info) - don't equ
|
||
lxi h,0! shld aret ;return value defaults to 0000
|
||
;save user's stack pointer, set to localed in by errflg
|
||
permsg: db 'Bad Sector$'
|
||
selmsg: db 'Select$'
|
||
rofmsg: db 'File '
|
||
rodmsg: db 'R/O$'
|
||
;
|
||
;
|
||
errflg:
|
||
;report l errflg ;to report the error
|
||
cpi ctlc! jz reboot ;reboot if response is ctlc
|
||
ret ;and ignore the error
|
||
;
|
||
selsub: ;report e kbchar, check external break
|
||
call constf! ani 1! rz ;return if no char ready
|
||
;character ready, read it
|
||
call coninf ;tunctions
|
||
functab:
|
||
dw wbootf, func1, func2, func3
|
||
dw punchf, listf, func6, func7
|
||
dw func8, func9, func10,func11
|
||
diskf equ:
|
||
;read character with echo
|
||
call conin! call echoc! rc ;echo character?
|
||
;character must be echoed before return
|
||
p stack
|
||
dad sp! shld entsp ;entsp = stackptr
|
||
lxi sp,lstack ;local stack setup
|
||
xra a! sta fcbdsk! sta resel ;fcbdsk,resel=faerror to console, message address in HL
|
||
push h! call crlf ;stack mssg address, new line
|
||
lda curdsk! adi 'A'! sta dskerr ;curselect error
|
||
lxi h,selmsg! jmp wait$err ;wait console before boot
|
||
;
|
||
rodsub: ;report write to read/only disk
|
||
lxi h,rodmsg! o A
|
||
cpi ctls! jnz conb0 ;check stop screen function
|
||
;found ctls, read next character
|
||
call coninf ;to A
|
||
cpi ctlc! jz ($-functab)/2 ;disk funcs
|
||
dw func12,func13,func14,func15
|
||
dw func16,func17,func18,func19
|
||
dw func20,func21,func22,func23
|
||
ush psw! mov c,a! call tabout! pop psw
|
||
ret ;with character in A
|
||
;
|
||
echoc:
|
||
;echo character if graphic
|
||
;cr, lf, tab, or baclse
|
||
lxi h,goback ;return here after all functions
|
||
push h ;jmp goback equivalent to ret
|
||
mov a,c! cpi nfuncs! rnc ;skip if irent disk name
|
||
lxi b,dskmsg! call print ;the error message
|
||
pop b! call print ;error mssage tail
|
||
;jmp conin ;to get the inpreboot ;ctlc implies re-boot
|
||
;not a reboot, act as if nothing has happened
|
||
xra a! ret ;with zero in accumulator
|
||
conb0:
|
||
pop psw! ori 40h ;becomes graphic letter
|
||
mov c,a ;ready to print
|
||
;(drop through to tabout)
|
||
;
|
||
tabout:
|
||
;expand tabs toov a,c ;character back to A
|
||
cpi ctlh! jnz notbacksp
|
||
;backspace character
|
||
dcr m ;column = column - 1
|
||
ret
|
||
notbacll tabout ;another character printed
|
||
pop b! jmp print
|
||
;
|
||
read: ;read to info address (max length, current length, buffer)
|
||
acter
|
||
;may be copying to the list device
|
||
lda listcp! ora a! cnz listf ;to printer, if so
|
||
pop b ;recall the character
|
||
unctions
|
||
;then move to strtcol (starting column)
|
||
mvi c,'#'! call conout
|
||
call crlf
|
||
;column = 0, move to position strtcol
|
||
;character in accum, save it
|
||
sta kbchar
|
||
conb1:
|
||
;return with true set in accumulator
|
||
mvi a,1! ret
|
||
;
|
||
conout:
|
||
;com console
|
||
mov a,c! cpi tab! jnz conout ;direct to conout if not
|
||
;tab encountered, move to next tab position
|
||
tab0:
|
||
mvi cksp:
|
||
;not a backspace character, eol?
|
||
cpi lf! rnz ;return if not
|
||
;end of line, column = 0
|
||
mvi m,0 ;column = 0
|
||
lda column! sta strtcol ;save start for ctl-x, ctl-h
|
||
lhld info
|
||
mov c,m! inx h! push h! mvi b,0
|
||
;B = current buffer length,compout:
|
||
mov a,c ;recall the character
|
||
;and compute column position
|
||
lxi h,column ;A = char, HL = .column
|
||
cpi rubout!
|
||
crlfp0:
|
||
lda column! lxi h,strtcol
|
||
cmp m! rnc ;stop when column reaches strtcol
|
||
mvi c,' '! call conout ;print blank
|
||
pute character position/write console char from C
|
||
;compcol = true if computing column position
|
||
lda compcol! ora a! jnz compo,' '! call conout ;another blank
|
||
lda column! ani 111b ;column mod 8 = 0 ?
|
||
jnz tab0 ;back for another if not
|
||
ret
|
||
;
|
||
;
|
||
b ret
|
||
;
|
||
ctlout:
|
||
;send C character with possible preceding up-arrow
|
||
mov a,c! call echoc ;cy if not graphic (or special case)
|
||
;C = maximum buffer length,
|
||
;HL= next to fill - 1
|
||
readnx:
|
||
;read next character, BC, HL active
|
||
push b! push h ;blen, rz ;no column change if nulls
|
||
inr m ;column = column + 1
|
||
cpi ' '! rnc ;return if graphic
|
||
;not graphic, reset column po jmp crlfp0
|
||
;;
|
||
;
|
||
crlf:
|
||
;carriage return line feed sequence
|
||
mvi c,cr! call conout! mvi c,lf! jmp conout
|
||
;ret
|
||
;
|
||
print:
|
||
ut
|
||
;write the character, then compute the column
|
||
;write console character from C
|
||
push b! call conbrk ;check for screen ackup:
|
||
;back-up one screen position
|
||
call pctlh! mvi c,' '! call conoutf
|
||
; (drop through to pctlh) ;
|
||
pctlh:
|
||
;send ctlh
|
||
jnc tabout ;skip if graphic, tab, cr, lf, or ctlh
|
||
;send preceding up arrow
|
||
push psw! mvi c,ctl! call conout ;up arrow
|
||
cmax, HL saved
|
||
readn0:
|
||
call conin ;next char in A
|
||
ani 7fh ;mask parity bit
|
||
pop h! pop b ;reactivate counters
|
||
sition
|
||
dcr m ;column = column - 1
|
||
mov a,m! ora a! rz ;return if at zero
|
||
;not at zero, may be backspace or end line
|
||
m
|
||
;print message until M(BC) = '$'
|
||
ldax b! cpi '$'! rz ;stop on $
|
||
;more to print
|
||
inx b! push b! mov c,a ;char to C
|
||
castop function
|
||
pop b! push b ;recall/save character
|
||
call conoutf ;externally, to console
|
||
pop b! push b ;recall/save char to console without affecting column count
|
||
mvi c,ctlh! jmp conoutf
|
||
;ret
|
||
;
|
||
crlfp:
|
||
;print #, cr, lf for ctlx, ctlu, ctlr f cpi cr! jz readen ;end of line?
|
||
cpi lf! jz readen ;also end of line
|
||
cpi ctlh! jnz noth ;backspace?
|
||
;do we have any ;delete line (ctlu)
|
||
call crlfp ;physical eol
|
||
pop h ;discard starting position
|
||
jmp read ;to start all over
|
||
notu:.listcp flag
|
||
mvi a,1! sub m ;True-listcp
|
||
mov m,a ;listcp = not listcp
|
||
pop h! jmp readnx ;for another char
|
||
notp:
|
||
fer
|
||
rdecho:
|
||
inx h! mov m,a ;character filled to mem
|
||
inr b ;blen = blen + 1
|
||
rdech1:
|
||
;look for a random control en=blen-1, next to fill - 1 decremented
|
||
jmp rdech1 ;act like this is an echo
|
||
;
|
||
notrub:
|
||
;not a rubout character, chec ;end of repeat, recall lengths
|
||
;original BC still remains pushed
|
||
push h ;save next to fill
|
||
lda compcol! ora a ;>0 icharacters to back over?
|
||
mov a,b! ora a! jz readnx
|
||
;characters remain in buffer, backup one
|
||
dcr b ;remove one charac
|
||
;not line delete, repeat line?
|
||
cpi ctlr! jnz notr
|
||
linelen:
|
||
;repeat line, or compute line len (ctlh)
|
||
;if comp ;not a ctlp, line delete?
|
||
cpi ctlx! jnz notx
|
||
pop h ;discard start position
|
||
;loop while column > strtcol
|
||
backxcharacter
|
||
push b! push h ;active values saved
|
||
mov c,a ;ready to print
|
||
call ctlout ;may be up-arrow C
|
||
pop h! pop k end line
|
||
cpi ctle! jnz note ;physical end line?
|
||
;yes, save active counters and force eol
|
||
push b! push h! call crlff computing length
|
||
jz readn0 ;for another char if so
|
||
;column position computed for ctlh
|
||
lxi h,column! sub m ;diff > ter
|
||
lda column! sta compcol ;col > 0
|
||
;compcol > 0 marks repeat as length compute
|
||
jmp linelen ;uses same code as repecol > 0
|
||
push b! call crlfp ;save line length
|
||
pop b! pop h! push h! push b
|
||
;bcur, cmax active, beginning buff at HL
|
||
:
|
||
lda strtcol! lxi h,column
|
||
cmp m! jnc read ;start again
|
||
dcr m ;column = column - 1
|
||
call backup ;one positiob! mov a,m ;recall char
|
||
cpi ctlc ;set flags for reboot test
|
||
mov a,b ;move length to A
|
||
jnz notc ;skip if not a contro
|
||
xra a! sta strtcol ;start position = 00
|
||
jmp readn0 ;for another character
|
||
note:
|
||
;not end of line, list toggle?
|
||
0
|
||
sta compcol ;count down below
|
||
;move back compcol-column spaces
|
||
backsp:
|
||
;move back one more space
|
||
call backuat
|
||
noth:
|
||
;not a backspace
|
||
cpi rubout! jnz notrub ;rubout char?
|
||
;rubout encountered, rubout if possible
|
||
mov a, rep0:
|
||
mov a,b! ora a! jz rep1 ;count len to 00
|
||
inx h! mov c,m ;next to print
|
||
dcr b! push b! push h ;count length dn
|
||
jmp backx
|
||
notx:
|
||
;not a control x, control u?
|
||
;not control-X, control-U?
|
||
cpi ctlu! jnz notu ;skip if not
|
||
l c
|
||
cpi 1 ;control C, must be length 1
|
||
jz reboot ;reboot if blen = 1
|
||
;length not one, so skip reboot
|
||
notc:
|
||
;n cpi ctlp! jnz notp ;skip if not ctlp
|
||
;list toggle - change parity
|
||
push h ;save next to fill - 1
|
||
lxi h,listcp ;HL=p ;one space
|
||
lxi h,compcol! dcr m
|
||
jnz backsp
|
||
jmp readn0 ;for next character
|
||
notr:
|
||
;not a ctlr, place into bufb! ora a! jz readnx ;skip if len=0
|
||
;buffer has characters, resend last char
|
||
mov a,m! dcr b! dcx h ;A = last char
|
||
;blown
|
||
call ctlout ;character echoed
|
||
pop h! pop b ;recall remaining count
|
||
jmp rep0 ;for the next character
|
||
rep1:
|
||
ot reboot, are we at end of buffer?
|
||
cmp c! jc readnx ;go for another if not
|
||
readen:
|
||
;end of read operation, store ble toggle
|
||
kbchar: db 0 ;initial key char = 00
|
||
entsp: ds 2 ;entry stack pointer
|
||
ds ssize*2 ;stack size
|
||
lstack:
|
||
; end of Basict ;out to console
|
||
;
|
||
func10: equ read
|
||
;read a buffered console line
|
||
;
|
||
func11:
|
||
;check console status
|
||
call conbrk
|
||
;(dre equ 1 ;number of bytes for "byte" type
|
||
word equ 2 ;number of bytes for "word" type
|
||
;
|
||
; fixed addresses in low memory
|
||
tfcb fh => 00h, means input mode
|
||
inr a! jz constf ;0feH in C for status
|
||
;direct output function
|
||
jmp conoutf ;
|
||
dirinp:
|
||
**
|
||
;** B a s i c D i s k O p e r a t i n g S y s t e m *n
|
||
pop h! mov m,b ;M(current len) = B
|
||
mvi c,cr! jmp conout ;return carriage
|
||
;ret
|
||
func1:
|
||
;return console character I/O System
|
||
;
|
||
;*****************************************************************
|
||
;*******************************************op through to sta$ret)
|
||
sta$ret:
|
||
;store the A register to aret
|
||
sta aret
|
||
func$ret: ;
|
||
ret ;jmp goback (pop stack for nequ 005ch ;default fcb location
|
||
tbuff equ 0080h ;default buffer location
|
||
;
|
||
; fixed addresses referenced in bios module are
|
||
; call constf ;status check
|
||
ora a! jz retmon ;skip, return 00 if not ready
|
||
;character is ready, get it
|
||
call coninf ;to A*
|
||
;** **
|
||
;********************************************************with echo
|
||
call conech
|
||
jmp sta$ret
|
||
;
|
||
func2: equ tabout
|
||
;write console character with tab expansion
|
||
;
|
||
func3:
|
||
;return r**********************
|
||
;
|
||
; common values shared between bdosi and bdos
|
||
usrcode:db 0 ;current user number
|
||
curdsk: db 0 ;curreon cp/m functions)
|
||
;
|
||
setlret1:
|
||
;set lret = 1
|
||
mvi a,1! jmp sta$ret ;
|
||
;
|
||
;
|
||
;
|
||
; data areas
|
||
;
|
||
compcol:db 0 ;true if co pererr (0009), selerr (000c), roderr (000f)
|
||
;
|
||
; error message handlers
|
||
;
|
||
;per$error:
|
||
;report permanent error to user
|
||
|
||
jmp sta$ret
|
||
;
|
||
func7:
|
||
;return io byte
|
||
lda ioloc
|
||
jmp sta$ret
|
||
;
|
||
func8:
|
||
;set i/o byte
|
||
lxi h,ioloc
|
||
mov m,c
|
||
ret *********
|
||
;*****************************************************************
|
||
;
|
||
dvers equ 22h ;version 2.2
|
||
; module addresseseader character
|
||
call readerf
|
||
jmp sta$ret
|
||
;
|
||
;func4: equated to punchf
|
||
;write punch character
|
||
;
|
||
;func5: equated to listfnt disk number
|
||
info: ds 2 ;information address
|
||
aret: ds 2 ;address value to return
|
||
lret equ aret ;low(aret)
|
||
;
|
||
;************mputing column position
|
||
strtcol:db 0 ;starting column position after read
|
||
column: db 0 ;column position
|
||
listcp: db 0 ;listing; lxi h,pererr jmp goerr
|
||
;
|
||
;rod$error: ;
|
||
;report read/only disk error
|
||
; lxi h,roderr jmp goerr ;
|
||
;
|
||
;rof$error;jmp goback
|
||
;
|
||
func9:
|
||
;write line until $ encountered
|
||
xchg ;was lhld info
|
||
mov c,l! mov b,h ;BC=string address
|
||
jmp prin
|
||
;
|
||
; literal constants
|
||
true equ 0ffh ;constant true
|
||
false equ 000h ;constant false
|
||
enddir equ 0ffffh ;end of directory
|
||
byt
|
||
;write list character
|
||
;write to list device
|
||
;
|
||
func6:
|
||
;direct console i/o - read if 0ffh
|
||
mov a,c! inr a! jz dirinp ;0f*****************************************************
|
||
;*****************************************************************
|
||
;** : ;
|
||
;report read/only file error ;
|
||
; lxi h,roferr ;jmp goerr
|
||
;
|
||
sel$error:
|
||
;report select error
|
||
lxi h,selerr lect:
|
||
mvi a,true! ora a! ret ;select disk function ok
|
||
;
|
||
home:
|
||
;move to home position, then offset to start of dir
|
||
call hchg! shld tranv ;.tran vector
|
||
lxi h,buffa ;DE= source for move, HL=dest
|
||
mvi c,addlist! call move ;addlist filled
|
||
;now fe track given by arecord (actual record)
|
||
;local equates for registers
|
||
arech equ b! arecl equ c ;arecord = BC
|
||
crech equ alloca, then fill
|
||
;the values of the disk parameter block
|
||
lda curdsk! mov c,a ;current disk# to c
|
||
;lsb of e = 0 if not yeype (wrtype) is in register C
|
||
;wrtype = 0 => normal write operation
|
||
;wrtype = 1 => directory write operation
|
||
;wrtype = 2 = ;
|
||
;
|
||
;
|
||
goerr:
|
||
;HL = .errorhandler, call subroutine
|
||
mov e,m! inx h! mov d,m ;address of routine in DE
|
||
xchg! pchl ;to subomef ;move to track 00, sector 00 reference
|
||
;lxi h,offset ;mov c,m ;inx h ;mov b,m ;call settrkf ;
|
||
;first directory positionill the disk parameter block
|
||
lhld dpbaddr! xchg ;DE is source
|
||
lxi h,sectpt ;HL is destination
|
||
mvi c,dpblist! call move d! crecl equ e ;currec = DE
|
||
ctrkh equ h! ctrkl equ l ;curtrk = HL
|
||
tcrech equ h! tcrecl equ l ;tcurrec = HL
|
||
;load the t logged - in
|
||
call seldskf ;HL filled by call
|
||
;HL = 0000 if error, otherwise disk headers
|
||
mov a,h! ora l! rz ;return with > start of new block
|
||
call writef ;current drive, track, sector, dma
|
||
diocomp: ;check for disk errors
|
||
ora a! rz ;
|
||
lxi h,proutine
|
||
;
|
||
;
|
||
;
|
||
; local subroutines for bios interface
|
||
;
|
||
move:
|
||
;move data length of length C from source DE to
|
||
;destinat selected
|
||
xra a ;constant zero to accumulator
|
||
lhld curtrka! mov m,a! inx h! mov m,a ;curtrk=0000
|
||
lhld curreca! mov m,a! in;data filled
|
||
;now set single/double map mode
|
||
lhld maxall ;largest allocation number
|
||
mov a,h ;00 indicates < 255
|
||
lxi registers from memory
|
||
lxi h,arecord! mov arecl,m! inx h! mov arech,m
|
||
lhld curreca ! mov crecl,m! inx h! mov crech,m
|
||
lhld c0000 in HL and z flag
|
||
;disk header block address in hl
|
||
mov e,m! inx h! mov d,m! inx h ;DE=.tran
|
||
shld cdrmaxa! inx h! inererr ;
|
||
jmp goerr
|
||
;
|
||
seekdir:
|
||
;seek the record containing the current dir entry
|
||
lhld dcnt ;directory counter to HL
|
||
mvion 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! inxx h! mov m,a ;currec=0000
|
||
;curtrk, currec both set to 0000
|
||
ret
|
||
;
|
||
rdbuff:
|
||
;read buffer and check condition
|
||
call readf ;h,single! mvi m,true ;assume a=00
|
||
ora a! jz retselect
|
||
;high order of maxall not zero, use double dm
|
||
mvi m,false
|
||
retseurtrka ! mov a,m! inx h! mov ctrkh,m! mov ctrkl,a
|
||
;loop while arecord < currec
|
||
seek0:
|
||
mov a,arecl! sub crecl! mov a,arechx h ;.cdrmax
|
||
shld curtrka! inx h! inx h ;HL=.currec
|
||
shld curreca! inx h! inx h ;HL=.buffa
|
||
;DE still contains .tran
|
||
xi c,dskshf! call hlrotr ;value to HL
|
||
shld arecord! shld drec ;ready for seek
|
||
; jmp seek ;
|
||
;ret
|
||
;
|
||
;
|
||
seek:
|
||
;seek th h ;to next byte
|
||
jmp move0
|
||
;
|
||
selectdisk:
|
||
;select the disk drive given by curdsk, and fill
|
||
;the base addresses curtrka -current drive, track, sector, dma
|
||
jmp diocomp ;check for i/o errors
|
||
;
|
||
wrbuff:
|
||
;write buffer and check condition
|
||
;write t! sbb crech
|
||
jnc seek1 ;skip if arecord >= currec
|
||
;currec = currec - sectpt
|
||
push ctrkh! lhld sectpt
|
||
mov a,crecl! sdskmsk equ dirrec-1
|
||
fcbshf equ 5 ;log2(fcblen)
|
||
;
|
||
extnum equ 12 ;extent number field
|
||
maxext equ 31 ;largest extent number
|
||
ubcord, DE=currec
|
||
mov a,arecl! sub crecl! mov arecl,a
|
||
mov a,arech! sbb crech! mov arech,a
|
||
lhld tranv! xchg ;BC=sector#, DE=. ora a! ral! jmp dmpos1
|
||
dmpos2:
|
||
;arrive here with A = shl(ext and extmsk,7-blkshf)
|
||
add b ;add the previous shr(vrecord,bl updated values in each register
|
||
push arech! push crech! push ctrkh ;to stack for later
|
||
;stack contains (lowest) BC=arecord,or file access
|
||
;
|
||
dm$position:
|
||
;compute disk map position for vrecord to HL
|
||
lxi h,blkshf! mov c,m ;shift count to C
|
||
lda vub l! mov crecl,a
|
||
mov a,crech! sbb h! mov crech,a
|
||
pop ctrkh
|
||
;curtrk = curtrk - 1
|
||
dcx ctrkh
|
||
jmp seek0 ;for anoytes equ 13 ;unfilled bytes field
|
||
modnum equ 14 ;data module number
|
||
maxmod equ 15 ;largest module number
|
||
fwfmsk equ 80h ;filetran
|
||
call sectran ;HL = tran(sector)
|
||
mov c,l! mov b,h ;BC = tran(sector)
|
||
jmp setsecf ;sector selected
|
||
;ret
|
||
;
|
||
; file cokshf) value
|
||
;A is one of the following values, depending upon alloc
|
||
;bks blkshf
|
||
;1k 3 v/8 + extval * 16
|
||
;2k 4 DE=currec, HL=curtrk
|
||
xchg! lhld offset! dad d ;HL = curtrk+offset
|
||
mov b,h! mov c,l! call settrkf ;track set up
|
||
;note thatrecord ;current virtual record to A
|
||
dmpos0:
|
||
ora a! rar! dcr c! jnz dmpos0
|
||
;A = shr(vrecord,blkshf) = vrecord/2**(sect/blother try
|
||
seek1:
|
||
;look while arecord >= (t:=currec + sectpt)
|
||
push ctrkh
|
||
lhld sectpt! dad crech ;HL = currec+sectpt
|
||
write flag is high order modnum
|
||
namlen equ 15 ;name length
|
||
reccnt equ 15 ;record count field
|
||
dskmap equ 16 ;disk map field
|
||
ntrol block (fcb) constants
|
||
empty equ 0e5h ;empty directory entry
|
||
lstrec equ 127 ;last record# in extent
|
||
recsiz equ 128 ;reco v/16+ extval * 8
|
||
;4k 5 v/32+ extval * 4
|
||
;8k 6 v/64+ extval * 2
|
||
;16k 7 v/128+extval * 1
|
||
ret ;with dm$p BC - curtrk is difference to move in bios
|
||
pop d ;recall curtrk
|
||
lhld curtrka! mov m,e! inx h! mov m,d ;curtrk updated
|
||
;nowck)
|
||
mov b,a ;save it for later addition
|
||
mvi a,8! sub m ;8-blkshf to accumulator
|
||
mov c,a ;extent shift count in register c
|
||
jc seek2 ;can be > FFFFH
|
||
mov a,arecl! sub tcrecl! mov a,arech! sbb tcrech
|
||
jc seek2 ;skip if t > arecord
|
||
;currec = tlstfcb equ fcblen-1
|
||
nxtrec equ fcblen
|
||
ranrec equ nxtrec+1;random record field (2 bytes)
|
||
;
|
||
; reserved file indicators
|
||
rofilerd size
|
||
fcblen equ 32 ;file control block size
|
||
dirrec equ recsiz/fcblen ;directory elts / record
|
||
dskshf equ 2 ;log2(dirrec)
|
||
osition in A
|
||
;
|
||
getdm:
|
||
;return disk map value from position given by BC
|
||
lhld info ;base address of file control block
|
||
lxi compute sector as arecord-currec
|
||
pop crech ;recall currec
|
||
lhld curreca! mov m,crecl! inx h! mov m,crech
|
||
pop arech ;BC=are
|
||
lda extval ;extent value ani extmsk
|
||
dmpos1:
|
||
;blkshf = 3,4,5,6,7, C=5,4,3,2,1
|
||
;shift is 4,3,2,1,0
|
||
dcr c! jz dmpos2
|
||
|
||
xchg
|
||
;curtrk = curtrk + 1
|
||
pop ctrkh! inx ctrkh
|
||
jmp seek1 ;for another try
|
||
seek2: pop ctrkh
|
||
;arrive here with equ 9 ;high order of first type char
|
||
invis equ 10 ;invisible file in dir command
|
||
; equ 11 ;reserved
|
||
;
|
||
; utility functions f d,dskmap! dad d ;HL =.diskmap
|
||
dad b ;index by a single byte value
|
||
lda single ;single byte/map entry?
|
||
ora a! jz getdmd ;geranfill
|
||
setfcb1:
|
||
mov c,a ;=1 if sequential i/o
|
||
lda vrecord! add c! mov m,a ;fcb(nxtrec)=vrecord+seqio
|
||
xchg! lda rcount!! xchg ;DE=.fcb(reccnt)
|
||
lxi h,(nxtrec-reccnt)! dad d ;HL=.fcb(nxtrec)
|
||
ret
|
||
;
|
||
getfcb:
|
||
;set variables from currently addreslhld rodsk! lda curdsk! mov c,a! call hlrotr
|
||
mov a,l! ani 1b! ret ;non zero if nowrite
|
||
;
|
||
set$ro:
|
||
;set current disk to readkshf ;shift count to reg A
|
||
lhld arecord
|
||
atran0:
|
||
dad h! dcr a! jnz atran0 ;shl(arecord,blkshf)
|
||
shld arecord1 ;save shi
|
||
;
|
||
hlrotl:
|
||
;rotate the mask in HL by amount in C
|
||
inr c ;may be zero
|
||
hlrotl0: dcr c! rz ;return if zero
|
||
dad h! jmp hlrt disk map single byte
|
||
mov l,m! mvi h,0! ret ;with HL=00bb
|
||
getdmd:
|
||
dad b ;HL=.fcb(dm+i*2)
|
||
;double precision value ret mov m,a ;fcb(reccnt)=rcount
|
||
ret
|
||
;
|
||
hlrotr:
|
||
;hl rotate right by amount C
|
||
inr c ;in case zero
|
||
hlrotr0: dcr c! rz ;returnsed fcb
|
||
call getfcba ;addresses in DE, HL
|
||
mov a,m! sta vrecord ;vrecord=fcb(nxtrec)
|
||
xchg! mov a,m! sta rcount ;rcount=fcb( only
|
||
lxi h,rodsk! mov c,m! inx h! mov b,m
|
||
call set$cdisk ;sets bit to 1
|
||
shld rodsk
|
||
;high water mark in directory goes tfted block #
|
||
lda blkmsk! mov c,a ;mask value to C
|
||
lda vrecord! ana c ;masked value in A
|
||
ora l! mov l,a ;to HL
|
||
shld areotl0
|
||
;
|
||
set$cdisk:
|
||
;set a "1" value in curdsk position of BC
|
||
push b ;save input parameter
|
||
lda curdsk! mov c,a ;ready paraurned
|
||
mov e,m! inx h! mov d,m! xchg! ret
|
||
;
|
||
index:
|
||
;compute disk block number from current fcb
|
||
call dm$position ;0...15 when zero
|
||
mov a,h! ora a! rar! mov h,a ;high byte
|
||
mov a,l! rar! mov l,a ;low byte
|
||
jmp hlrotr0
|
||
;
|
||
;
|
||
compute$cs:
|
||
;coreccnt)
|
||
call getexta ;HL=.fcb(extnum)
|
||
lda extmsk ;extent mask to a
|
||
ana m ;fcb(extnum) and extmsk
|
||
sta extval
|
||
ret
|
||
;
|
||
seo max
|
||
lhld dirmax! inx h! xchg ;DE = directory max
|
||
lhld cdrmaxa ;HL = .cdrmax
|
||
mov m,e! inx h! mov m,d ;cdrmax = dirmax
|
||
cord ;arecord=HL or (vrecord and blkmsk)
|
||
ret
|
||
;
|
||
getexta:
|
||
;get current extent field address to A
|
||
lhld info! lxi d,extnum! meter for shift
|
||
lxi h,1 ;number to shift
|
||
call hlrotl ;HL = mask to integrate
|
||
pop b ;original mask
|
||
mov a,c! ora l! mov l,in register A
|
||
mov c,a! mvi b,0! call getdm ;value to HL
|
||
shld arecord! ret
|
||
;
|
||
allocated:
|
||
;called following index to see ifmpute checksum for current directory buffer
|
||
mvi c,recsiz ;size of directory buffer
|
||
lhld buffa ;current directory buffer
|
||
xrtfcb:
|
||
;place values back into current fcb
|
||
call getfcba ;addresses to DE, HL
|
||
lda seqio
|
||
cpi 02! jnz setfcb1! xra a ;check ret
|
||
;
|
||
check$rodir:
|
||
;check current directory element for read/only status
|
||
call getdptra ;address of element
|
||
;
|
||
checkdad d ;HL=.fcb(extnum)
|
||
ret
|
||
;
|
||
getfcba:
|
||
;compute reccnt and nxtrec addresses for get/setfcb
|
||
lhld info! lxi d,reccnt! dad da
|
||
mov a,b! ora h! mov h,a ;HL = mask or rol(1,curdsk)
|
||
ret
|
||
;
|
||
nowrite:
|
||
;return true if dir checksum difference occurred
|
||
block allocated
|
||
lhld arecord! mov a,l! ora h! ret
|
||
;
|
||
atran:
|
||
;compute actual record address, assuming index called
|
||
lda bla a ;clear checksum value
|
||
computecs0:
|
||
add m! inx h! dcr c ;cs=cs+buff(recsiz-C)
|
||
jnz computecs0
|
||
ret ;with checksum in A$rofile:
|
||
;check current buff(dptr) or fcb(0) for r/o status
|
||
lxi d,rofile! dad d ;offset to ro bit
|
||
mov a,m! ral! rnc ;retur,a
|
||
ret
|
||
;
|
||
newchecksum:
|
||
mvi c,true ;drop through to compute new checksum
|
||
checksum:
|
||
;compute current checksum record and u > dcnt
|
||
lhld dcnt! xchg ;DE = directory counter
|
||
lhld cdrmaxa ;HL=.cdrmax
|
||
mov a,e! sub m ;low(dcnt) - low(cdrmax)
|
||
inx h ;ta dma address
|
||
;ret
|
||
;
|
||
rd$dir:
|
||
;read a directory entry into the directory buffer
|
||
call setdir ;directory dma
|
||
call rdbuff
|
||
;bring module number to accumulator
|
||
;(high order bit is fwf (file write flag)
|
||
lhld info! lxi d,modnum! dad d ;HL=.fcb(mode
|
||
cmp m ;compute$cs=check(drec)?
|
||
rz ;no message if ok
|
||
;checksum error, are we beyond
|
||
;the end of the disk?
|
||
cn if not set
|
||
lxi h,roferr! jmp goerr ;
|
||
; jmp rof$error ;exit to read only disk message
|
||
;
|
||
;
|
||
check$write:
|
||
;check for wripdate the
|
||
;directory element if C=true, or check for = if not
|
||
;drec < chksiz?
|
||
lhld drec! xchg! lhld chksiz! call subdh ;DEHL = .cdrmax+1
|
||
mov a,d! sbb m ;hig(dcnt) - hig(cdrmax)
|
||
;condition dcnt - cdrmax produces cy if cdrmax>dcnt
|
||
ret
|
||
;
|
||
setcdr ;directory record loaded
|
||
; jmp setdata to data dma address
|
||
;ret
|
||
;
|
||
setdata:
|
||
;set data dma address
|
||
lxi h,dmanum)
|
||
mov a,m! ret ;A=fcb(modnum)
|
||
;
|
||
clrmodnum:
|
||
;clear the module number field for user open/make
|
||
call getmodnum! mvi m,0 all compcdr
|
||
rnc ;no message if so
|
||
call set$ro ;read/only disk set
|
||
ret
|
||
initial$cs:
|
||
;initializing the checksum
|
||
te protected disk
|
||
call nowrite! rz ;ok to write if not rodsk
|
||
lxi h,roderr! jmp goerr
|
||
; jmp rod$error ;read only disk error
|
||
-HL
|
||
rnc ;skip checksum if past checksum vector size
|
||
;drec < chksiz, so continue
|
||
push b ;save init flag
|
||
call compute$c:
|
||
;if not (cdrmax > dcnt) then cdrmax = dcnt+1
|
||
call compcdr
|
||
rc ;return if cdrmax > dcnt
|
||
;otherwise, HL = .cdrmax+1, DE =ad! jmp setdma ;to complete the call
|
||
;
|
||
setdir:
|
||
;set directory dma address
|
||
lxi h,buffa ;jmp setdma to complete call
|
||
;fcb(modnum)=0
|
||
ret
|
||
;
|
||
setfwf:
|
||
call getmodnum ;HL=.fcb(modnum), A=fcb(modnum)
|
||
;set fwf (file write flag) to "1"
|
||
ori fwfm
|
||
mov m,a! ret
|
||
;
|
||
;
|
||
wrdir:
|
||
;write the current directory entry, set checksum
|
||
call newchecksum ;initialize entry
|
||
call se
|
||
;
|
||
getdptra:
|
||
;compute the address of a directory element at
|
||
;positon dptr in the buffer
|
||
lhld buffa! lda dptr ;
|
||
addh:
|
||
s ;check sum value to A
|
||
lhld checka ;address of check sum vector
|
||
xchg
|
||
lhld drec ;value of drec
|
||
dad d ;HL = .check(dr dcnt
|
||
inx d! mov m,d! dcx h! mov m,e
|
||
ret
|
||
;
|
||
subdh:
|
||
;compute HL = DE - HL
|
||
mov a,e! sub l! mov l,a! mov a,d! sbb h! mov h;
|
||
setdma:
|
||
;HL=.dma address to set (i.e., buffa or dmaad)
|
||
mov c,m! inx h! mov b,m ;parameter ready
|
||
jmp setdmaf
|
||
;
|
||
;
|
||
dir$sk! mov m,a ;fcb(modnum)=fcb(modnum) or 80h
|
||
;also returns non zero in accumulator
|
||
ret
|
||
;
|
||
;
|
||
compcdr:
|
||
;return cy if cdrmaxtdir ;directory dma
|
||
mvi c,1 ;indicates a write directory operation
|
||
call wrbuff ;write the buffer
|
||
jmp setdata ;to da ;HL = HL + A
|
||
add l! mov l,a! rnc
|
||
;overflow to H
|
||
inr h! ret
|
||
;
|
||
;
|
||
getmodnum:
|
||
;compute the address of the module number ec)
|
||
pop b ;recall true=0ffh or false=00 to C
|
||
inr c ;0ffh produces zero flag
|
||
jz initial$cs
|
||
;not initializing, comparto$user:
|
||
;copy the directory entry to the user buffer
|
||
;after call to search or searchn by user code
|
||
lhld buffa! xchg ;sourin the low order accumulator position. HL is
|
||
;the address of the byte for possible replacement in
|
||
;memory upon return, and dir1:
|
||
add a! dcr b! jnz read$dir1
|
||
;A = (low(dcnt) and dskmsk) shl fcbshf
|
||
sta dptr ;ready for next dir operation
|
||
orasition), and
|
||
;target ALLOC position in registers HL, rotate and replace
|
||
rrc! dcr d! jnz rotr ;back into position
|
||
mov m,a ;
|
||
read$dir:
|
||
;read next directory entry, with C=true if initializing
|
||
lhld dirmax! xchg ;in preparation for subtract
|
||
lhld dcmove the bit to the low order position of A
|
||
rotl: rlc! dcr e! jnz rotl! ret
|
||
;
|
||
;
|
||
setallocbit:
|
||
;BC is the bit position of Ace is directory buffer
|
||
lhld dmaad ;destination is user dma address
|
||
mvi c,recsiz ;copy entire record
|
||
jmp move
|
||
;ret
|
||
;
|
||
enD contains the number of shifts
|
||
;required to place the returned value back into position
|
||
mov a,c! ani 111b! inr a! mov e,a! a! rnz ;return if not a new record
|
||
push b ;save initialization flag C
|
||
call seek$dir ;seek proper record
|
||
call rd$dir ;rback to ALLOC
|
||
ret
|
||
;
|
||
scandm:
|
||
;scan the disk map addressed by dptr for non-zero
|
||
;entries, the allocation vector entry corrnt! inx h! shld dcnt ;dcnt=dcnt+1
|
||
;continue while dirmax >= dcnt (dirmax-dcnt no cy)
|
||
call subdh ;DE-HL
|
||
jnc read$dir0
|
||
;yLLOC to set or reset. The
|
||
;value of the bit is in register E.
|
||
push d! call getallocbit ;shifted val A, count in D
|
||
ani 111d$of$dir:
|
||
;return zero flag if at end of directory, non zero
|
||
;if not at end (end of dir if dcnt = 0ffffh)
|
||
lxi h,dcnt! mov mov d,a
|
||
;d and e both contain the number of bit positions to shift
|
||
mov a,c! rrc! rrc! rrc! ani 11111b! mov c,a ;C shr 3 to Cead the directory record
|
||
pop b ;recall initialization flag
|
||
jmp checksum ;checksum the directory elt
|
||
;ret
|
||
;
|
||
;
|
||
getalloesponding
|
||
;to a non-zero entry is set to the value of C (0,1)
|
||
call getdptra ;HL = buffa + dptr
|
||
;HL addresses the beginninges, set dcnt to end of directory
|
||
jmp set$end$dir ;
|
||
; ret ;
|
||
read$dir0:
|
||
;not at end of directory, seek next element1$1110b ;mask low bit to zero (may be set)
|
||
pop b! ora c ;low bit of C is masked into A
|
||
; jmp rotr ;to rotate back into propera,m ;may be 0ffh
|
||
inx h! cmp m ;low(dcnt) = high(dcnt)?
|
||
rnz ;non zero returned if different
|
||
;high and low the same, = 0ffh?
|
||
mov a,b! add a! add a! add a! add a! add a ;B shl 5
|
||
ora c! mov c,a ;bbbccccc to C
|
||
mov a,b! rrc! rrc! rrc! ani 11111b! movcbit:
|
||
;given allocation vector position BC, return with byte
|
||
;containing BC shifted so that the least significant
|
||
;bit is of the directory entry
|
||
lxi d,dskmap! dad d ;hl now addresses the disk map
|
||
push b ;save the 0/1 bit to set
|
||
mvi c,fcblen-ds
|
||
;initialization flag is in C
|
||
lda dcnt! ani dskmsk ;low(dcnt) and dskmsk
|
||
mvi b,fcbshf ;to multiply by fcb size
|
||
read$ position
|
||
;ret
|
||
rotr:
|
||
;byte value from ALLOC is in register A, with shift count
|
||
;in register C (to place bit back into po
|
||
inr a ;0ffh becomes 00 if so
|
||
ret
|
||
;
|
||
set$end$dir:
|
||
;set dcnt to the end of the directory
|
||
lxi h,enddir! shld dcnt! ret
|
||
; b,a ;BC shr 3 to BC
|
||
lhld alloca ;base address of allocation vector
|
||
dad b! mov a,m ;byte to A, hl = .alloc(BC shr 3)
|
||
;now kmap+1 ;size of single byte disk map + 1
|
||
scandm0:
|
||
;loop once for each disk map entry
|
||
pop d ;recall bit parity
|
||
dcr c! )
|
||
lhld cdrmaxa! mvi m,3! inx h! mvi m,0
|
||
;cdrmax = 0000
|
||
call set$end$dir ;dcnt = enddir
|
||
;read directory entries and check! inx h ;HL = maxall/8+1
|
||
mov b,h! mov c,l ;count down BC til zero
|
||
lhld alloca ;base of allocation vector
|
||
;fill the allocatb! mov c,a ;low bits removed from C
|
||
pop psw! ana b ;low bits removed from A
|
||
sub c! ani maxext ;set flags
|
||
pop b ;restore orjz scanm3
|
||
lhld maxall ;check invalid index
|
||
mov a,l! sub c! mov a,h! sbb b ;maxall - block#
|
||
cnc set$alloc$bit ;
|
||
:
|
||
;now scan the disk map for allocated blocks
|
||
mvi c,1 ;set to allocated
|
||
call scandm
|
||
call setcdr ;set cdrmax to dcnt
|
||
rz ;all done scanning?
|
||
;no, get next entry for scan
|
||
push d ;replace bit parity
|
||
lda single! ora a! jz scandm1
|
||
;singl for allocated storage
|
||
initial2:
|
||
mvi c,true! call read$dir
|
||
call end$of$dir! rz ;return if end of directory
|
||
;not end oion vector with zeros
|
||
initial0:
|
||
mvi m,0! inx h ;alloc(i)=0
|
||
dcx b ;count length down
|
||
mov a,b! ora c! jnz initial0
|
||
;siginal values
|
||
ret
|
||
;
|
||
search:
|
||
;search for directory element of length C at info
|
||
mvi a,0ffh! sta dirloc ;changed if actuall ;bit set to 0/1
|
||
scanm3: ;
|
||
pop h! inx h ;to next bit position
|
||
pop b ;recall counter
|
||
jmp scandm0 ;for anothe
|
||
jmp initial2 ;for another entry
|
||
;
|
||
copy$dirloc:
|
||
;copy directory location to lret following
|
||
;delete, rename, ... ops
|
||
lde byte scan operation
|
||
push b ;save counter
|
||
push h ;save map address
|
||
mov c,m! mvi b,0 ;BC=block#
|
||
jmp scandm2
|
||
sf directory, valid entry?
|
||
call getdptra ;HL = buffa + dptr
|
||
mvi a,empty! cmp m
|
||
jz initial2 ;go get another item
|
||
;not et the reserved space for the directory
|
||
lhld dirblk! xchg
|
||
lhld alloca ;HL=.alloc()
|
||
mov m,e! inx h! mov m,d ;sets reserved y found
|
||
lxi h,searchl! mov m,c ;searchl = C
|
||
lhld info! shld searcha ;searcha = info
|
||
call set$end$dir ;dcnt = enddir
|
||
callr item
|
||
;
|
||
initialize:
|
||
;initialize the current disk
|
||
;lret = false ;set to true if $ file exists
|
||
;compute the length of thea dirloc! jmp sta$ret ;
|
||
; ret ;
|
||
;
|
||
compext:
|
||
;compare extent# in A with that in C, return nonzero
|
||
;if they do not mcandm1:
|
||
;double byte scan operation
|
||
dcr c ;count for double byte
|
||
push b ;save counter
|
||
mov c,m! inx h! mov b,m ;Bempty, user code the same?
|
||
lda usrcode
|
||
cmp m! jnz pdollar
|
||
;same user code, check for '$' submit
|
||
inx h! mov a,m ;firsdirectory blks
|
||
;allocation vector initialized, home disk
|
||
call home
|
||
;cdrmax = 3 (scans at least one directory record home ;to start at the beginning
|
||
;(drop through to searchn) ;
|
||
;
|
||
searchn:
|
||
;search for the next directory element, assumin allocation vector - 2
|
||
lhld maxall! mvi c,3 ;perform maxall/8
|
||
;number of bytes in alloc vector is (maxall/8)+1
|
||
call hlrotratch
|
||
push b ;save C's original value
|
||
push psw! lda extmsk! cma! mov b,a
|
||
;B has negated form of extent mask
|
||
mov a,c! ana C=block#
|
||
push h ;save map address
|
||
scandm2:
|
||
;arrive here with BC=block#, E=0/1
|
||
mov a,c! ora b ;skip if = 0000
|
||
t character
|
||
sui '$' ;dollar file?
|
||
jnz pdollar
|
||
;dollar file found, mark in lret
|
||
dcr a! sta lret ;lret = 255
|
||
pdollarg
|
||
;a previous call on search which sets searcha and
|
||
;searchl
|
||
mvi c,false! call read$dir ;read next dir element
|
||
call end$et
|
||
search$fin:
|
||
;end of directory, or empty name
|
||
call set$end$dir ;may be artifical end
|
||
mvi a,255! jmp sta$ret ;
|
||
h
|
||
push b ;save counters
|
||
mov c,m ;directory character to c
|
||
call compext ;compare user/dir char
|
||
pop b ;recall coun ;left,right pushed
|
||
call getallocbit
|
||
rar! jnc retblock ;return block number if zero
|
||
;bit is one, so try the right
|
||
po down
|
||
searchloop:
|
||
mov a,c! ora a! jz endsearch
|
||
ldax d! cpi '?'! jz searchok ;? matches all
|
||
;scan next character i element
|
||
jmp delete0 ;for another record
|
||
;
|
||
get$block:
|
||
;given allocation vector position BC, find the zero bit
|
||
;closest of$dir! jz search$fin ;skip to end if so
|
||
;not end of directory, scan for match
|
||
lhld searcha! xchg ;DE=beginning of user fc
|
||
;
|
||
;
|
||
delete:
|
||
;delete the currently addressed file
|
||
call check$write ;write protected?
|
||
mvi c,extnum! call search ;search tters
|
||
jnz searchn ;skip if no match
|
||
searchok:
|
||
;current character matches
|
||
inx d! inx h! inr b! dcr c
|
||
jmp searchp b! pop d ;left, right restored
|
||
righttst:
|
||
lhld maxall ;value of maximum allocation#
|
||
mov a,e! sub l! mov a,d! sbb h ;rigf not ubytes
|
||
mov a,b! cpi ubytes! jz searchok
|
||
;not the ubytes field, extent field?
|
||
cpi extnum ;may be extent field
|
||
to this position by searching left and right.
|
||
;if found, set the bit to one and return the bit position
|
||
;in hl. if not founb
|
||
ldax d ;first character
|
||
cpi empty ;keep scanning if empty
|
||
jz searchnext
|
||
;not empty, may be end of logical directorhrough file type
|
||
delete0:
|
||
;loop while directory matches
|
||
call end$of$dir! rz ;stop if end
|
||
;set each non zero disk map loop
|
||
endsearch:
|
||
;entire name matches, return dir position
|
||
lda dcnt! ani dskmsk! sta lret
|
||
;lret = low(dcnt) and 11ht=maxall?
|
||
jnc retblock0 ;return block 0000 if so
|
||
inx d! push b! push d ;left, right pushed
|
||
mov b,d! mov c,e ;ready rig ldax d ;fcb character
|
||
jz searchext ;skip to search extent
|
||
sub m! ani 7fh ;mask-out flags/extent modulus
|
||
jnz searcd (i.e., we pass 0 on the left, or
|
||
;maxall on the right), return 0000 in hl
|
||
mov d,b! mov e,c ;copy of starting position to dy
|
||
push d ;save search address
|
||
call compcdr ;past logical end?
|
||
pop d ;recall address
|
||
jnc search$fin ;artificial stop
|
||
entry to 0
|
||
;in the allocation vector
|
||
;may be r/o file
|
||
call check$rodir ;ro disk error if found
|
||
call getdptra ;HL=.bub
|
||
lxi h,dirloc! mov a,m! ral! rnc ;dirloc=0ffh?
|
||
;yes, change it to 0 to mark as found
|
||
xra a! mov m,a ;dirloc=0
|
||
rht for call
|
||
call getallocbit
|
||
rar! jnc retblock ;return block number if zero
|
||
pop d! pop b ;restore left and right pointehn ;skip if not matched
|
||
jmp searchok ;matched character
|
||
searchext:
|
||
;A has fcb character
|
||
;attempt an extent # matce
|
||
lefttst:
|
||
mov a,c! ora b! jz righttst ;skip if left=0000
|
||
;left not at position zero, bit zero?
|
||
dcx b! push d! push b
|
||
searchnext:
|
||
call getdptra ;HL = buffa+dptr
|
||
lda searchl! mov c,a ;length of search to c
|
||
mvi b,0 ;b counts up, c countsff(dptr)
|
||
mvi m,empty
|
||
mvi c,0! call scandm ;alloc elts set to 0
|
||
call wrdir ;write the directory
|
||
call searchn ;to nextrs
|
||
jmp lefttst ;for another attempt
|
||
retblock:
|
||
ral! inr a ;bit back into position and set to 1
|
||
;d contains the number ir! rz ;stop at end of dir
|
||
;not end of directory, rename next element
|
||
call check$rodir ;may be read-only file
|
||
mvi c,dsk. the
|
||
;new name is contained in the last half of the
|
||
;currently addressed file conrol block. the file
|
||
;name and type are r
|
||
lxi h,reccnt! dad d ;HL=.buff(dptr+reccnt)
|
||
mov b,m ;B holds directory record count
|
||
pop h! pop psw! mov m,a ;restore exte
|
||
push d ;save length for later
|
||
mvi b,0 ;double index to BC
|
||
lhld info ;HL = source for data
|
||
dad b! xchg ;DE=.fcb(C), sour end
|
||
;not end of directory, copy fcb information
|
||
open$copy:
|
||
;(referenced below to copy fcb info)
|
||
call getexta! mov a,m! pof shifts required to reposition
|
||
call rotr ;move bit back to position and store
|
||
pop h! pop d ;HL returned value, DE discarmap! mvi e,extnum! call copy$dir
|
||
;element renamed, move to next
|
||
call searchn
|
||
jmp rename0
|
||
;
|
||
indicators:
|
||
;set file inchanged, but the reel number
|
||
;is ignored. the user number is identical
|
||
call check$write ;may be write protected
|
||
;search unt number
|
||
;HL = .user extent#, B = dir rec cnt, C = dir extent#
|
||
;if user ext < dir ext then user := 128 records
|
||
;if user ece for copy
|
||
call getdptra ;HL=.buff(dptr), destination
|
||
pop b ;DE=source, HL=dest, C=length
|
||
call move ;data moved
|
||
seek$copush psw! push h ;save extent#
|
||
call getdptra! xchg ;DE = .buff(dptr)
|
||
lhld info ;HL=.fcb(0)
|
||
mvi c,nxtrec ;length of move opeded
|
||
ret
|
||
retblock0:
|
||
;cannot find an available bit, return 0000
|
||
mov a,c ;
|
||
ora b! jnz lefttst ;also at beginning dicators for current fcb
|
||
mvi c,extnum! call search ;through file type
|
||
indic0:
|
||
call end$of$dir! rz ;stop at end of dir
|
||
p to the extent field
|
||
mvi c,extnum! call search
|
||
;copy position 0
|
||
lhld info! mov a,m ;HL=.fcb(0), A=fcb(0)
|
||
lxi d,dskmap! xt = dir ext then user := dir records
|
||
;if user ext > dir ext then user := 0 records
|
||
mov a,c! cmp m! mov a,b ;ready dir reccy:
|
||
;enter from close to seek and copy current element
|
||
call seek$dir ;to the directory element
|
||
jmp wrdir ;write the directoration
|
||
push d ;save .buff(dptr)
|
||
call move ;from .buff(dptr) to .fcb(0)
|
||
;note that entire fcb is copied, including indicato
|
||
lxi h,0000h! ret
|
||
;
|
||
copy$fcb:
|
||
;copy the entire file control block
|
||
mvi c,0! mvi e,fcblen ;start at 0, to fcblen-1
|
||
; ;not end of directory, continue to change
|
||
mvi c,0! mvi e,extnum ;copy name
|
||
call copy$dir
|
||
call searchn
|
||
jmp indic0
|
||
;
|
||
dad d;HL=.fcb(dskmap)
|
||
mov m,a ;fcb(dskmap)=fcb(0)
|
||
;assume the same disk drive for new named file
|
||
rename0:
|
||
call end$of$dnt
|
||
jz open$rcnt ;if same, user gets dir reccnt
|
||
mvi a,0! jc open$rcnt ;user is larger
|
||
mvi a,128 ;directory is larger
|
||
ory element
|
||
;ret
|
||
;
|
||
;
|
||
rename:
|
||
;rename the file described by the first half of
|
||
;the currently addressed file control blockrs
|
||
call setfwf ;sets file write flag
|
||
pop d! lxi h,extnum! dad d ;HL=.buff(dptr+extnum)
|
||
mov c,m ;C = directory extent numbejmp copy$dir ;
|
||
;
|
||
copy$dir:
|
||
;copy fcb information starting at C for E bytes
|
||
;into the currently addressed directory entry
|
||
open:
|
||
;search for the directory entry, copy to fcb
|
||
mvi c,namlen! call search
|
||
call end$of$dir! rz ;return with lret=255 ifpen$rcnt: ;A has record count to fill
|
||
lhld info! lxi d,reccnt! dad d! mov m,a
|
||
ret
|
||
;
|
||
mergezero:
|
||
;HL = .fcb1(i), DE = .fcbgerr ;high same?
|
||
;merge operation ok for this pair
|
||
dcr c ;extra count for double byte
|
||
dmset:
|
||
inx d! inx h ;to next bybnzero
|
||
;fcb(i) = 0
|
||
mov m,a ;fcb(i) = buff(i)
|
||
fcbnzero:
|
||
ora a! jnz buffnzero
|
||
;buff(i) = 0
|
||
mov a,m! stax d ;hld info ;info = .empty
|
||
mvi c,1! call search ;length 1 match on empty entry
|
||
call end$of$dir ;zero flag set if no space
|
||
popcate file
|
||
call end$of$dir! rz ;return if not found
|
||
;merge the disk map at info with that at buff(dptr)
|
||
lxi b,dskmap! call xchg! dad b
|
||
;DE=.buff(reccnt), HL=.fcb(reccnt)
|
||
mov a,m! stax d ;buff(reccnt)=fcb(reccnt)
|
||
endmerge:
|
||
mvi a,true! sta f2(i),
|
||
;if fcb1(i) = 0 then fcb1(i) := fcb2(i)
|
||
mov a,m! inx h! ora m! dcx h! rnz ;return if = 0000
|
||
ldax d! mov m,a! inx d! te position
|
||
dcr c! jnz merge0 ;for more
|
||
;end of disk map merge, check record count
|
||
;DE = .buff(dptr)+32, HL = .fcb(32)
|
||
buff(i)=fcb(i)
|
||
buffnzero:
|
||
cmp m! jnz mergerr ;fcb(i) = buff(i)?
|
||
jmp dmset ;if merge ok
|
||
merged:
|
||
;this is a double b h ;recall info address
|
||
shld info ;in case we return here
|
||
rz ;return with error condition 255 if not found
|
||
xchg ;DE = infogetdptra
|
||
dad b! xchg ;DE is .buff(dptr+16)
|
||
lhld info! dad b ;DE=.buff(dptr+16), HL=.fcb(16)
|
||
mvi c,(fcblen-dskmap) ;length cb$copied ;mark as copied
|
||
jmp seek$copy ;ok to "wrdir" here - 1.4 compat
|
||
; ret ;
|
||
mergerr:
|
||
;elements did not merge inx h ;low byte copied
|
||
ldax d! mov m,a! dcx d! dcx h ;back to input form
|
||
ret
|
||
;
|
||
close:
|
||
;locate the directory element and
|
||
lxi b,-(fcblen-extnum)! dad b! xchg! dad b
|
||
;DE = .fcb(extnum), HL = .buff(dptr+extnum)
|
||
ldax d ;current user extent numbyte merge operation
|
||
call mergezero ;buff = fcb if buff 0000
|
||
xchg! call mergezero! xchg ;fcb = buff if fcb 0000
|
||
;they sh address
|
||
;clear the remainder of the fcb
|
||
lxi h,namlen! dad d ;HL=.fcb(namlen)
|
||
mvi c,fcblen-namlen ;number of bytes to fillof single byte dm
|
||
merge0:
|
||
lda single! ora a! jz merged ;skip to double
|
||
;this is a single byte map
|
||
;if fcb(i) = 0 thencorrectly
|
||
lxi h,lret! dcr m ;=255 non zero flag set
|
||
ret
|
||
;
|
||
make:
|
||
;create a new file by creating a directory entry
|
||
;there-write it
|
||
xra a! sta lret! sta dcnt! sta dcnt+1 ;
|
||
call nowrite! rnz ;skip close if r/o disk
|
||
;check file write flag - 0 ier
|
||
;if fcb(ext) >= buff(fcb) then
|
||
;buff(ext) := fcb(ext), buff(rec) := fcb(rec)
|
||
cmp m! jc endmerge
|
||
;fcb extent numbeould be identical at this point
|
||
ldax d! cmp m! jnz mergerr ;low same?
|
||
inx d! inx h ;to high byte
|
||
ldax d! cmp m! jnz mer
|
||
xra a ;clear accumulator to 00 for fill
|
||
make0:
|
||
mov m,a! inx h! dcr c! jnz make0
|
||
lxi h,ubytes! dad d ;HL = .fcb(ubytes) fcb(i) = buff(i)
|
||
;if buff(i) = 0 then buff(i) = fcb(i)
|
||
;if fcb(i) <> buff(i) then error
|
||
mov a,m! ora a! ldax d! jnz fcn opening the file
|
||
call check$write ;may be write protected
|
||
lhld info! push h ;save fcb address, look for e5
|
||
lxi h,efcb! sndicates written
|
||
call getmodnum ;fcb(modnum) in A
|
||
ani fwfmsk! rnz ;return if bit remains set
|
||
mvi c,namlen! call search ;lor >= dir extent number
|
||
mov m,a ;buff(ext) = fcb(ext)
|
||
;update directory record count field
|
||
lxi b,(reccnt-extnum)! dad b!
|
||
mov m,a ;fcb(ubytes) = 0
|
||
call setcdr ;may have extended the directory
|
||
;now copy entry to the directory
|
||
call copy$fcb
|
||
;with lret = 1
|
||
jmp open$reel2
|
||
open$reel1:
|
||
;not end of file, open
|
||
call open$copy
|
||
open$reel2:
|
||
call getfcb ;)=++1
|
||
;module number incremented, check for overflow
|
||
mov a,m! ani maxmod ;mask high order bits
|
||
jz open$r$err ;cannot ovmpatible with 1.4)
|
||
call allocated ;arecord=0000?
|
||
jz diskeof
|
||
;record has been allocated, read it
|
||
call atran ;arecord module if zero
|
||
;may be in the same extent group
|
||
mov b,a! lda extmsk! ana b
|
||
;if result is zero, then not in the same groupvrecord! lxi h,rcount! cmp m ;vrecord-rcount
|
||
;skip if rcount > vrecord
|
||
jc recordok
|
||
;not enough records in the extent
|
||
;;and set the file write flag to "1"
|
||
jmp setfwf
|
||
;ret
|
||
;
|
||
open$reel:
|
||
;close the current extent, and open the next one
|
||
;if set parameters
|
||
xra a! jmp sta$ret ;lret = 0 ;
|
||
; ret ;with lret = 0
|
||
open$r$err:
|
||
;cannot move to next extent of this ferflow to zero
|
||
;otherwise, ok to continue with new module
|
||
open$reel0:
|
||
mvi c,namlen! call search ;next extent found?
|
||
cnow a disk address
|
||
call seek ;to proper track,sector
|
||
call rdbuff ;to dma address
|
||
jmp setfcb ;replace parameter
|
||
; ret
|
||
lxi h,fcb$copied ;true if the fcb was copied to directory
|
||
ana m ;produces a 00 in accumulator if not written
|
||
jz open$reelrecord count must be 128 to continue
|
||
cpi 128 ;vrecord = 128?
|
||
jnz diskeof ;skip if vrecord<>128
|
||
call open$reel ;go to nepossible. RMF is true if in read mode
|
||
xra a! sta fcb$copied ;set true if actually copied
|
||
call close ;close current extentile
|
||
call setlret1 ;lret = 1
|
||
jmp setfwf ;ensure that it will not be closed
|
||
;ret
|
||
;
|
||
seqdiskread:
|
||
;sequential disk readall end$of$dir! jnz open$reel1
|
||
;end of file encountered
|
||
lda rmf! inr a ;0ffh becomes 00 if read
|
||
jz open$r$err ;sets ;
|
||
diskeof:
|
||
jmp setlret1 ;lret = 1
|
||
;ret
|
||
;
|
||
seqdiskwrite:
|
||
;sequential disk write
|
||
mvi a,1! sta seqio
|
||
;drop thro0 ;go to next physical extent
|
||
;result is non zero, so we must be in same logical ext
|
||
jmp open$reel1 ;to copy fcb informationxt extent if so
|
||
xra a! sta vrecord ;vrecord=00
|
||
;now check for open ok
|
||
lda lret! ora a! jnz diskeof ;stop at eof
|
||
recor
|
||
;lret remains at enddir if we cannot open the next ext
|
||
call end$of$dir! rz ;return if end
|
||
;increment extent number
|
||
lh operation
|
||
mvi a,1! sta seqio
|
||
;drop through to diskread
|
||
;
|
||
diskread: ;(may enter from seqdiskread)
|
||
mvi a,true! sta rmf ;rlret = 1
|
||
;try to extend the current file
|
||
call make
|
||
;cannot be end of directory
|
||
call end$of$dir
|
||
jz open$r$errugh to diskwrite
|
||
;
|
||
diskwrite: ;(may enter here from seqdiskwrite above)
|
||
mvi a,false! sta rmf ;read mode flag
|
||
;write record
|
||
open$mod:
|
||
;extent number overflow, go to next module
|
||
lxi b,(modnum-extnum)! dad b ;HL=.fcb(modnum)
|
||
inr m ;fcb(modnumdok:
|
||
;arrive with fcb addressing a record to read
|
||
call index
|
||
;error 2 if reading unwritten data
|
||
;(returns 1 to be cold info! lxi b,extnum! dad b ;HL=.fcb(extnum)
|
||
mov a,m! inr a! ani maxext! mov m,a ;fcb(extnum)=++1
|
||
jz open$mod ;move to nextead mode flag = true (open$reel)
|
||
;read the next record from the current fcb
|
||
call getfcb ;sets parameters for the read
|
||
lda to currently selected file
|
||
call check$write ;in case write protected
|
||
lhld info ;HL = .fcb(0)
|
||
call check$rofile ;may be a m,e! inx h! mov m,d ;double wd
|
||
diskwru:
|
||
;disk write to previously unallocated block
|
||
mvi c,2 ;marked as unallocated wri mvi a,2! jmp sta$ret ;lret=2
|
||
blockok:
|
||
;allocated block number is in HL
|
||
shld arecord
|
||
xchg ;block number to DE
|
||
|
||
;increment record count if rcount<=vrecord
|
||
lda vrecord! lxi h,rcount! cmp m ;vrecord-rcount
|
||
jc diskwr2
|
||
;rcount <= vrecvalue 0 if no space has been allocated
|
||
call dm$position
|
||
sta dminx ;save for later
|
||
lxi b,0000h ;may use block zero
|
||
or;
|
||
mvi c,2 ;
|
||
fill1: shld arecord! push b! call seek! pop b ;
|
||
call wrbuff ;write fill record ;
|
||
lhld arecord! ;resread-only file
|
||
call getfcb ;to set local parameters
|
||
lda vrecord! cpi lstrec+1 ;vrecord-128
|
||
;skip if vrecord > lstrec
|
||
;vte
|
||
diskwr1:
|
||
;continue the write operation of no allocation error
|
||
;C = 0 if normal write, 2 if to prev unalloc block
|
||
lda lhld info! lxi b,dskmap! dad b ;HL=.fcb(dskmap)
|
||
lda single! ora a ;set flags for single byte dm
|
||
lda dminx ;recall dm indexord
|
||
mov m,a! inr m ;rcount = vrecord+1
|
||
mvi c,2 ;mark as record count incremented
|
||
diskwr2:
|
||
;A has vrecord, C=2 if new ba a! jz nopblock ;skip if no previous block
|
||
;previous block exists at A
|
||
mov c,a! dcx b ;previous block # in BC
|
||
call tore last record
|
||
mvi c,0 ;change allocate flag
|
||
lda blkmsk! mov b,a! ana l! cmp b!inx h ;
|
||
jnz fill1 ;cont untirecord = 128, cannot open next extent
|
||
jnc setlret1 ;lret=1 ;
|
||
diskwr0:
|
||
;can write the next record, so continue
|
||
call inlret! ora a! rnz ;stop if non zero returned value
|
||
push b ;save write flag
|
||
call atran ;arecord set
|
||
lda seqio! dcr a! dcr a
|
||
jz allocwd ;skip if allocating word
|
||
;allocating a byte value
|
||
call addh! mov m,e ;single byte alloc
|
||
jmp diskwru ;lock or new record#
|
||
dcr c! dcr c! jnz noupdate
|
||
push psw ;save vrecord value
|
||
call getmodnum ;HL=.fcb(modnum), A=fcb(modnugetdm ;previous block # to HL
|
||
mov b,h! mov c,l ;BC=prev block#
|
||
nopblock:
|
||
;BC = 0000, or previous block #
|
||
call getl cluster is zeroed
|
||
pop h! shld arecord! call setdata
|
||
diskwr11: ;
|
||
call seek ;to proper file position
|
||
pop b! push b dex
|
||
call allocated
|
||
mvi c,0 ;marked as normal write operation for wrbuff
|
||
jnz diskwr1
|
||
;not allocated
|
||
;the argument to ! jnz diskwr11 ;
|
||
pop b! push b! mov a,c! dcr a! dcr a ;
|
||
jnz diskwr11 ;old allocation
|
||
push h ;arecord in hl ret frto continue
|
||
allocwd:
|
||
;allocate a word value
|
||
mov c,a! mvi b,0 ;double(dminx)
|
||
dad b! dad b ;HL=.fcb(dminx*2)
|
||
movm)
|
||
;reset the file write flag to mark as written fcb
|
||
ani (not fwfmsk) and 0ffh ;bit reset
|
||
mov m,a ;fcb(modnum) = fcb(mo$block ;block # to HL
|
||
;arrive here with block# or zero
|
||
mov a,l! ora h! jnz blockok
|
||
;cannot find a block to allocate
|
||
;restore/save write flag (C=2 if new block)
|
||
call wrbuff ;written to disk
|
||
pop b ;C = 2 if a new block was allocated, 0 if notgetblock is the starting
|
||
;position for the disk search, and should be
|
||
;the last allocated block for this file, or
|
||
;the om atran
|
||
lhld buffa! mov d,a ;zero buffa & fill
|
||
fill0: mov m,a! inx h! inr d! jp fill0 ;
|
||
call setdir! lhld arecord1 dnum) and 7fh
|
||
pop psw ;restore vrecord
|
||
noupdate:
|
||
;check for end of extent, if found attempt to open
|
||
;next extent in pred d ;HL = .fcb(nxtrec)
|
||
mov m,a ;sought rec# stored away
|
||
;arrive here with B=mod#, C=ext#, DE=.fcb, rec stored
|
||
;the r/w flmov a,m! ral ;cy=lsb of extent#
|
||
inx h! mov a,m! ral! ani 11111b ;A=ext#
|
||
mov c,a ;C holds extent number, record stacked
|
||
l,5 ;cannot create new extent #5
|
||
lda lret! inr a! jz badseek ;no dir space
|
||
;file make operation successful
|
||
seekok:
|
||
pot time
|
||
nospace:
|
||
mvi m,0 ;lret = 00 for returned value
|
||
diskwr3:
|
||
jmp setfcb ;replace parameters
|
||
;ret
|
||
;
|
||
rseek:
|
||
;ranet! inr a! jz badseek
|
||
lxi h,extnum! dad d! mov m,c ;fcb(extnum)=ext#
|
||
lxi h,modnum! dad d! mov m,b ;fcb(modnum)=mod#
|
||
calparation for next write
|
||
cpi lstrec ;vrecord=lstrec?
|
||
jnz diskwr3 ;skip if not
|
||
;may be random access write, if so we are donag is still stacked. compare fcb values
|
||
lxi h,extnum! dad d! mov a,c ;A=seek ext#
|
||
sub m! jnz ranclose ;tests for = extentmov a,m! rar! rar! rar! rar! ani 1111b ;mod#
|
||
mov b,a ;B holds module#, C holds ext#
|
||
pop psw ;recall sought record #
|
||
;chp b ;discard r/w flag
|
||
xra a! jmp sta$ret ;with zero set
|
||
badseek:
|
||
;fcb no longer contains a valid fcb, mark
|
||
;with 11dom access seek operation, C=0ffh if read mode
|
||
;fcb is assumed to address an active file control block
|
||
;(modnum has been setl open ;is the file present?
|
||
lda lret! inr a! jnz seekok ;open successful?
|
||
;cannot open the file, read mode?
|
||
pop b ;r/we
|
||
;change next
|
||
lda seqio! cpi 1! jnz diskwr3 ;skip next extent open op
|
||
;update current fcb before going to next s
|
||
;extents match, check mod#
|
||
lxi h,modnum! dad d! mov a,b ;B=seek mod#
|
||
;could be overflow at eof, producing module#
|
||
eck to insure that high byte of ran rec = 00
|
||
inx h! mov l,m ;l=high byte (must be 00)
|
||
inr l! dcr l! mvi l,6 ;zero flag, l=00$000b in modnum field so that it
|
||
;appears as overflow with file write flag set
|
||
push h ;save error flag
|
||
call getmodnum to 1100$0000b if previous bad seek)
|
||
xra a! sta seqio ;marked as random access operation
|
||
rseek1:
|
||
push b ;save r/w flag
|
||
lh flag to c (=0ffh if read)
|
||
push b ;everyone expects this item stacked
|
||
mvi l,4 ;seek to unwritten extent #4
|
||
inr c ;becomextent
|
||
call setfcb
|
||
call open$reel ;rmf=false
|
||
;vrecord remains at lstrec causing eof if
|
||
;no more directory space is a;of 90H or 10H, so compare all but fwf
|
||
sub m! ani 7fh! jz seekok ;same?
|
||
ranclose:
|
||
push b! push d ;save seek mod#,ext#, .6
|
||
;produce error 6, seek past physical eod
|
||
jnz seekerr
|
||
;otherwise, high byte = 0, A = sought record
|
||
lxi h,nxtrec! da ;HL = .modnum
|
||
mvi m,1100$0000b
|
||
pop h ;and drop through
|
||
seekerr:
|
||
pop b ;discard r/w flag
|
||
mov a,l! sta lret ;lret=#ld info! xchg ;DE will hold base of fcb
|
||
lxi h,ranrec! dad d ;HL=.fcb(ranrec)
|
||
mov a,m! ani 7fh! push psw ;record number
|
||
es 00 if read operation
|
||
jz badseek ;skip to error if read operation
|
||
;write operation, make new extent
|
||
call make
|
||
mvi vailable
|
||
lxi h,lret! mov a,m! ora a! jnz nospace
|
||
;space available, set vrecord=255
|
||
dcr a! sta vrecord ;goes to 00 nexfcb
|
||
call close ;current extent closed
|
||
pop d! pop b ;recall parameters and fill
|
||
mvi l,3 ;cannot close error #3
|
||
lda lr, nonzero
|
||
;setfwf returns non-zero accumulator for err
|
||
jmp setfwf ;flag set, so subsequent close ok
|
||
;ret
|
||
;
|
||
randiskrea ;ls byte
|
||
mov a,b! sbb m! inx h ;middle byte
|
||
mov a,e! sbb m ;carry if .fcb(ranrec) > directory
|
||
jc getnextsize ;for anote size for current fcb
|
||
mvi c,extnum
|
||
call search
|
||
;zero the receiving ranrec field
|
||
lhld info! lxi d,ranrec! dad d! push h o=curdsk
|
||
mov m,a ;curdsk=info
|
||
jmp select
|
||
;ret
|
||
;
|
||
reselect:
|
||
;check current fcb to see if reselection necessary
|
||
mvi a,t0
|
||
add c! mov c,a! mvi a,0! adc b! mov b,a
|
||
;BC = 0000 000? errrr rrrr
|
||
mov a,m! rrc! ani 0fh! add b! mov b,a
|
||
;BC = 000? eeubsequent input or output ops
|
||
lhld dlog! lda curdsk! mov c,a! call hlrotr
|
||
push h! xchg ;save it for test below, send to seldd:
|
||
;random disk read operation
|
||
mvi c,true ;marked as read operation
|
||
call rseek
|
||
cz diskread ;if seek successful
|
||
ret
|
||
;
|
||
her try
|
||
;fcb is less or equal, fill from directory
|
||
mov m,e! dcx h! mov m,b! dcx h! mov m,c
|
||
getnextsize:
|
||
call searchn
|
||
;save position
|
||
mov m,d! inx h! mov m,d! inx h! mov m,d;=00 00 00
|
||
getsize:
|
||
call end$of$dir
|
||
jz setsize
|
||
;current fcb arue! sta resel ;mark possible reselect
|
||
lhld info! mov a,m ;drive select code
|
||
ani 1$1111b ;non zero is auto drive select
|
||
dcee errrr rrrr
|
||
lxi h,modnum! dad d! mov a,m ;A=XXX? mmmm
|
||
add a! add a! add a! add a ;cy=? A=mmmm 0000
|
||
push psw! add b! mov sk
|
||
call selectdisk! pop h ;recall dlog vector
|
||
cz sel$error ;returns true if select ok
|
||
;is the disk logged in?
|
||
mov a,l! r
|
||
randiskwrite:
|
||
;random disk write operation
|
||
mvi c,false ;marked as write operation
|
||
call rseek
|
||
cz diskwrite ;if seek succ
|
||
jmp getsize
|
||
setsize:
|
||
pop h ;discard .fcb(ranrec)
|
||
ret
|
||
;
|
||
setrandom:
|
||
;set random record from the current file control ddressed by dptr
|
||
call getdptra! lxi d,reccnt ;ready for compute size
|
||
call compute$rr
|
||
;A=0000 000? BC = mmmm eeee errr rr a ;drive code normalized to 0..30, or 255
|
||
sta linfo ;save drive code
|
||
cpi 30! jnc noselect
|
||
;auto select function, save cb,a
|
||
;cy=?, BC = mmmm eeee errr rrrr
|
||
push psw ;possible second carry
|
||
pop h ;cy = lsb of L
|
||
mov a,l ;cy = lsb of A
|
||
pop h ar! rc ;return if bit is set
|
||
;disk not logged in, set bit and initialize
|
||
lhld dlog! mov c,l! mov b,h ;call ready
|
||
call set$essful
|
||
ret
|
||
;
|
||
compute$rr:
|
||
;compute random record position for getfilesize/setrandom
|
||
xchg! dad d
|
||
;DE=.buf(dptr) or .fcb(block
|
||
lhld info! lxi d,nxtrec ;ready params for computesize
|
||
call compute$rr ;DE=info, A=cy, BC=mmmm eeee errr rrrr
|
||
lxi h,rrrr
|
||
;compare with memory, larger?
|
||
pop h! push h ;recall, replace .fcb(ranrec)
|
||
mov e,a ;save cy
|
||
mov a,c! sub m! inx hurdsk
|
||
lda curdsk! sta olddsk ;olddsk=curdsk
|
||
mov a,m! sta fcbdsk ;save drive code
|
||
ani 1110$0000b! mov m,a ;preserve hi b;cy = lsb of L
|
||
ora l ;cy/cy = lsb of A
|
||
ani 1 ;A = 0000 000? possible carry-out
|
||
ret
|
||
;
|
||
getfilesize:
|
||
;compute logical filcdisk! shld dlog ;dlog=set$cdisk(dlog)
|
||
jmp initialize
|
||
;ret
|
||
;
|
||
curselect:
|
||
lda linfo! lxi h,curdsk! cmp m! rz ;skip if linf0), HL = .f(nxtrec/reccnt)
|
||
mov c,m! mvi b,0 ;BC = 0000 0000 ?rrr rrrr
|
||
lxi h,extnum! dad d! mov a,m! rrc! ani 80h ;A=e000 000anrec! dad d ;HL = .fcb(ranrec)
|
||
mov m,c! inx h! mov m,b! inx h! mov m,a ;to ranrec
|
||
ret
|
||
;
|
||
select:
|
||
;select disk info for sits
|
||
call curselect
|
||
noselect:
|
||
;set user code
|
||
lda usrcode ;0...31
|
||
lhld info! ora m! mov m,a
|
||
ret
|
||
;
|
||
; individual eselect
|
||
jmp make
|
||
;ret ;jmp goback
|
||
;
|
||
func23:
|
||
;rename a file
|
||
call reselect
|
||
call rename
|
||
jmp copy$dirloc
|
||
;ret ;jmp gr
|
||
;ret ;jmp goback
|
||
;
|
||
func18:
|
||
;search for next occurrence of a file name
|
||
lhld searcha! shld info
|
||
call reselect! call se
|
||
ani 1fh! sta usrcode
|
||
ret ;jmp goback
|
||
;
|
||
func33:
|
||
;random disk read operation
|
||
call reselect
|
||
jmp randiskread ;to perfole number
|
||
call reselect
|
||
jmp open
|
||
;ret ;jmp goback
|
||
;
|
||
func16:
|
||
;close file
|
||
call reselect
|
||
jmp close
|
||
;ret ;jmp gobackt ;jmp goback
|
||
;
|
||
func29:
|
||
;return r/o bit vector
|
||
lhld rodsk! jmp sthl$ret ;
|
||
; ret ;jmp goback
|
||
;
|
||
func30:
|
||
;set file indifunction handlers
|
||
func12:
|
||
;return version number
|
||
mvi a,dvers! jmp sta$ret ;lret = dvers (high = 00)
|
||
; ret ;jmp goback
|
||
;
|
||
oback
|
||
;
|
||
func24:
|
||
;return the login vector
|
||
lhld dlog! jmp sthl$ret ;
|
||
; ret ;jmp goback
|
||
;
|
||
func25:
|
||
;return selected disarchn
|
||
jmp dir$to$user ;copy directory entry to user
|
||
;ret ;jmp goback
|
||
;
|
||
func19:
|
||
;delete a file
|
||
call reselect
|
||
call delrm the disk read
|
||
;ret ;jmp goback
|
||
;
|
||
func34:
|
||
;random disk write operation
|
||
call reselect
|
||
jmp randiskwrite ;to perform th
|
||
;
|
||
func17:
|
||
;search for first occurrence of a file
|
||
mvi c,0 ;length assuming '?' true
|
||
xchg ;was lhld info
|
||
mov a,m! cpcators
|
||
call reselect
|
||
call indicators
|
||
jmp copy$dirloc ;lret=dirloc
|
||
;ret ;jmp goback
|
||
;
|
||
func31:
|
||
;return address of diskfunc13:
|
||
;reset disk system - initialize to disk 0
|
||
lxi h,0! shld rodsk! shld dlog
|
||
xra a! sta curdsk ;note that usrcode remak number
|
||
lda curdsk! jmp sta$ret ;
|
||
; ret ;jmp goback
|
||
;
|
||
func26:
|
||
;set the subsequent dma address to info
|
||
xchg ;was lhlete
|
||
jmp copy$dirloc
|
||
;ret ;jmp goback
|
||
;
|
||
func20:
|
||
;read a file
|
||
call reselect
|
||
jmp seqdiskread ;
|
||
;jmp goback
|
||
;
|
||
fue disk write
|
||
;ret ;jmp goback
|
||
;
|
||
func35:
|
||
;return file size (0-65536)
|
||
call reselect
|
||
jmp getfilesize
|
||
;ret ;jmp goback
|
||
i '?' ;no reselect if ?
|
||
jz qselect ;skip reselect if so
|
||
;normal search
|
||
call getexta! mov a,m! cpi '?' ;
|
||
cnz clrmodnu parameter block
|
||
lhld dpbaddr
|
||
sthl$ret:
|
||
shld aret
|
||
ret ;jmp goback
|
||
func32:
|
||
;set user code
|
||
lda linfo! cpi 0ffhins unchanged
|
||
lxi h,tbuff! shld dmaad ;dmaad = tbuff
|
||
call setdata ;to data dma address
|
||
jmp select
|
||
;ret ;jmp gobacd info
|
||
shld dmaad ;dmaad = info
|
||
jmp setdata ;to data dma address
|
||
;ret ;jmp goback
|
||
;
|
||
func27:
|
||
;return the login nc21:
|
||
;write a file
|
||
call reselect
|
||
jmp seqdiskwrite ;
|
||
;jmp goback
|
||
;
|
||
func22:
|
||
;make a file
|
||
call clrmodnum
|
||
call r;
|
||
func36: equ setrandom ;
|
||
;set random record
|
||
;ret ;jmp goback
|
||
func37:
|
||
;
|
||
lhld info
|
||
mov a,l! cma! mov e,a! mov a,h! cm ;module number zeroed
|
||
call reselect
|
||
mvi c,namlen
|
||
qselect:
|
||
call search
|
||
jmp dir$to$user ;copy directory entry to use! jnz setusrcode
|
||
;interrogate user code instead
|
||
lda usrcode! jmp sta$ret ;lret=usrcode
|
||
; ret ;jmp goback
|
||
setusrcode:
|
||
k
|
||
;
|
||
func14: equ curselect ;
|
||
;select disk info
|
||
;ret ;jmp goback
|
||
;
|
||
func15:
|
||
;open file
|
||
call clrmodnum ;clear the moduvector address
|
||
lhld alloca! jmp sthl$ret ;
|
||
; ret ;jmp goback
|
||
;
|
||
func28: equ set$ro ;
|
||
;write protect current disk
|
||
;rema
|
||
lhld dlog! ana h! mov d,a! mov a,l! ana e
|
||
mov e,a! lhld rodsk! xchg! shld dlog
|
||
mov a,l! ana e! mov l,a
|
||
mov a,h! ana ds byte ;block shift factor
|
||
blkmsk: ds byte ;block mask
|
||
extmsk: ds byte ;extent mask
|
||
maxall: ds word ;maximum allocation number to cur dir max value
|
||
curtrka:ds word ;current track address
|
||
curreca:ds word ;current record address
|
||
buffa: ds word ;pointer ;address of last logged disk on warm start
|
||
buff equ 0080h ;default buffer address
|
||
retry equ 10 ;max retries on disk i/o beforndom disk write with zero fill of unallocated block
|
||
call reselect
|
||
mvi a,2! sta seqio
|
||
mvi c,false
|
||
call rseek1
|
||
cz diskwre of "true"
|
||
false equ not true ;"false"
|
||
test equ false ;true if test bios
|
||
;
|
||
if test
|
||
bias equ 03400h ;base of CCP in test s! mov h,a
|
||
shld rodsk! ret
|
||
;
|
||
;
|
||
goback:
|
||
;arrive here at end of processing to return to user
|
||
lda resel! ora a! jz retmon
|
||
r
|
||
dirmax: ds word ;largest directory number
|
||
dirblk: ds word ;reserved allocation bits for directory
|
||
chksiz: ds word ;size of to directory dma address
|
||
dpbaddr:ds word ;current disk parameter block address
|
||
checka: ds word ;current checksum vector addree error
|
||
;
|
||
; perform following functions
|
||
; boot cold start
|
||
; wboot warm start (save i/o byte)
|
||
; (boot and wboot are the sameite ;if seek successful
|
||
ret
|
||
;
|
||
;
|
||
; data areas
|
||
;
|
||
; initialized data
|
||
efcb: db empty ;0e5=available dir entry
|
||
rodsk: dw 0 ;ystem
|
||
endif
|
||
if not test
|
||
bias equ 0000h ;generate relocatable cp/m system
|
||
endif
|
||
;
|
||
patch equ 1600h
|
||
;
|
||
org patch
|
||
cpmb e ;reselection may have taken place
|
||
lhld info! mvi m,0 ;fcb(0)=0
|
||
lda fcbdsk! ora a! jz retmon
|
||
;restore disk number
|
||
mchecksum vector
|
||
offset: ds word ;offset tracks at beginning
|
||
dpblist equ $-sectpt ;size of area
|
||
;
|
||
; local variables
|
||
tranv: dss
|
||
alloca: ds word ;current allocation vector address
|
||
addlist equ $-buffa ;address list size
|
||
;
|
||
; sectpt - offset obtained fr for mds)
|
||
; const console status
|
||
; reg-a = 00 if no character ready
|
||
; reg-a = ff if character ready
|
||
; conin console characread only disk vector
|
||
dlog: dw 0 ;logged-in disks
|
||
dmaad: dw tbuff ;initial dma address
|
||
;
|
||
; curtrka - alloca are set upon disqu $-patch ;base of cpm console processor
|
||
bdos equ 806h+cpmb ;basic dos (resident portion)
|
||
cpml equ $-cpmb ;length (in bytes) ov m,a ;fcb(0)=fcbdsk
|
||
lda olddsk! sta linfo! call curselect
|
||
;
|
||
; return from the disk monitor
|
||
retmon:
|
||
lhld entsp! sphl ;u; MDS-800 I/O Drivers for CP/M 2.2
|
||
; (four drive single density version)
|
||
;
|
||
; Version 2.2 February, 1980
|
||
;
|
||
vers equ 22 ;versom disk parm block at dpbaddr
|
||
; (data must be adjacent, do not insert variables)
|
||
sectpt: ds word ;sectors per track
|
||
blkshf: dter in (result in reg-a)
|
||
; conout console character out (char in reg-c)
|
||
; list list out (char in reg-c)
|
||
; punch punch out (chk select
|
||
; (data must be adjacent, do not insert variables)
|
||
; (address of translate vector, not used)
|
||
cdrmaxa:ds word ;pointeof cpm system
|
||
nsects equ cpml/128 ;number of sectors to load
|
||
offset equ 2 ;number of disk tracks used by cp/m
|
||
cdisk equ 0004hser stack restored
|
||
lhld aret! mov a,l! mov b,h ;BA = HL = aret
|
||
ret
|
||
func38: equ func$ret
|
||
func39 equ func$ret
|
||
func40:
|
||
;raion 2.2
|
||
;
|
||
; Copyright (c) 1980
|
||
; Digital Research
|
||
; Box 579, Pacific Grove
|
||
; California, 93950
|
||
;
|
||
;
|
||
true equ 0ffffh ;valuar in reg-c)
|
||
; reader paper tape reader in (result to reg-a)
|
||
; home move to track 00
|
||
;
|
||
; (the following calls set-up the io equ 0f800h ;mds monitor
|
||
rmon80 equ 0ff0fh ;restart mon80 (boot error)
|
||
ci equ 0f803h ;console character to reg-a
|
||
ri equ 0f806
|
||
; are tailored to the particular operating environment, and must
|
||
; be altered for any system which differs from the intel mds.sp,buff+80h
|
||
lxi h,signon
|
||
call prmsg ;print message
|
||
xra a ;clear accumulator
|
||
sta cdisk ;set initially to disk a
|
||
jmp gocindiviual routines
|
||
jmp boot
|
||
wboote: jmp wboot
|
||
jmp const
|
||
jmp conin
|
||
jmp conout
|
||
jmp list
|
||
jmp punch
|
||
jmp reader
|
||
jmp equ 4h ;read function
|
||
writf equ 6h ;write function
|
||
recal equ 3h ;recalibrate drive
|
||
iordy equ 4h ;i/o finished mask
|
||
cr equ 0dparameter block for the
|
||
; mds, which is used to perform subsequent reads and writes)
|
||
; seldsk select disk given by reg-c (0,1,h ;reader in to reg-a
|
||
co equ 0f809h ;console char from c to console out
|
||
po equ 0f80ch ;punch char from c to punch device
|
||
lo e
|
||
;
|
||
; the following code assumes the mds monitor exists at 0f800h
|
||
; and uses the i/o subroutines within the monitor
|
||
;
|
||
; we apm ;go to cp/m
|
||
;
|
||
;
|
||
wboot:; loader on track 0, sector 1, which will be skipped for warm
|
||
; read cp/m from disk - assuming thehome
|
||
jmp seldsk
|
||
jmp settrk
|
||
jmp setsec
|
||
jmp setdma
|
||
jmp read
|
||
jmp write
|
||
jmp listst ;list status
|
||
jmp sectran
|
||
;
|
||
mach ;carriage return
|
||
lf equ 0ah ;line feed
|
||
;
|
||
signon: ;signon message: xxk cp/m vers y.y
|
||
db cr,lf,lf
|
||
if test
|
||
db '32' ;32k 2...)
|
||
; settrk set track address (0,...76) for subsequent read/write
|
||
; setsec set sector address (1,...,26) for subsequent reaqu 0f80fh ;list from c to list device
|
||
csts equ 0f812h ;console status 00/ff to register a
|
||
;
|
||
; disk ports and commands
|
||
base elso assume the mds system has four disk drives
|
||
revrt equ 0fdh ;interrupt revert port
|
||
intc equ 0fch ;interrupt mask port
|
||
icon re is a 128 byte cold start
|
||
; start.
|
||
;
|
||
lxi sp,buff ;using dma - thus 80 thru ff available for stack
|
||
;
|
||
mvi c,retry ;max relib diskdef ;load the disk definition library
|
||
disks 4 ;four disks
|
||
diskdef 0,1,26,6,1024,243,64,64,offset
|
||
diskdef 1,0
|
||
disexample bios
|
||
endif
|
||
if not test
|
||
db '00' ;memory size filled by relocator
|
||
endif
|
||
db 'k CP/M vers '
|
||
db vers/10+'0','.',vd/write
|
||
; setdma set subsequent dma address (initially 80h)
|
||
;
|
||
; (read and write assume previous calls to set up the io paramequ 78h ;base of disk command io ports
|
||
dstat equ base ;disk status (input)
|
||
rtype equ base+1 ;result type (input)
|
||
rbyte equ basequ 0f3h ;interrupt control port
|
||
inte equ 0111$1110b ;enable rst 0(warm boot), rst 7 (monitor)
|
||
;
|
||
; mds monitor equates
|
||
mon80tries
|
||
push b
|
||
wboot0: ;enter here on error retries
|
||
lxi b,cpmb ;set dma address to start of disk system
|
||
call setdma
|
||
mvi ckdef 2,0
|
||
diskdef 3,0
|
||
; endef occurs at end of assembly
|
||
;
|
||
; end of controller - independent code, the remaining subroutines
|
||
ers mod 10+'0'
|
||
db cr,lf,0
|
||
;
|
||
boot: ;print signon message and go to ccp
|
||
; (note: mds boot initialized iobyte at 0003h)
|
||
lxi ters)
|
||
; read read track/sector to preset dma address
|
||
; write write track/sector from preset dma address
|
||
;
|
||
; jump vector for e+3 ;result byte (input)
|
||
;
|
||
ilow equ base+1 ;iopb low address (output)
|
||
ihigh equ base+2 ;iopb high address (output)
|
||
;
|
||
readf ,0 ;boot from drive 0
|
||
call seldsk
|
||
mvi c,0
|
||
call settrk ;start with track 0
|
||
mvi c,2 ;start reading sector 2
|
||
call setsec
|
||
terr:
|
||
pop b ;recall counts
|
||
dcr c
|
||
jz booter0
|
||
; try again
|
||
push b
|
||
jmp wboot0
|
||
;
|
||
booter0:
|
||
; otherwise too many retries
|
||
lxi b,buff
|
||
call setdma
|
||
;
|
||
; reset monitor entry points
|
||
mvi a,jmp
|
||
sta 0
|
||
lxi h,wboote
|
||
shld 1 ;jmp wboot at location 00
|
||
rive
|
||
mvi a,00110000b ;selects drive 1 in bank
|
||
setdrive:
|
||
mov b,a ;save the function
|
||
lxi h,iof ;io function
|
||
mov a,m
|
||
ani,a ;ready for call
|
||
call settrk
|
||
xra a ;clear sector number
|
||
rd1: inr a ;to next sector
|
||
mov c,a ;ready for call
|
||
call setsemds call)
|
||
jmp po
|
||
;
|
||
reader: ;reader character in to reg-a
|
||
; (exactly the same as mds call)
|
||
jmp ri
|
||
;
|
||
home: ;move to home
|
||
;
|
||
; read sectors, count nsects to zero
|
||
pop b ;10-error count
|
||
mvi b,nsects
|
||
rdsec: ;read next sector
|
||
push b ;save sector
|
||
lxi h,bootmsg
|
||
call prmsg
|
||
jmp rmon80 ;mds hardware monitor
|
||
;
|
||
bootmsg:
|
||
db '?boot',0
|
||
;
|
||
;
|
||
const: ;console status to reg
|
||
sta 5
|
||
lxi h,bdos
|
||
shld 6 ;jmp bdos at location 5
|
||
if not test
|
||
sta 7*8 ;jmp to mon80 (may have been changed by ddt)
|
||
lxi 11001111b ;mask out disk number
|
||
ora b ;mask in new disk number
|
||
mov m,a ;save it in iopb
|
||
mov l,c
|
||
mvi h,0 ;HL=disk numberc
|
||
pop b ;recall sector count
|
||
dcr b ;done?
|
||
jnz rdsec
|
||
;
|
||
; done with the load, reset default buffer address
|
||
gocpm: ;(enterposition
|
||
; treat as track 00 seek
|
||
mvi c,0
|
||
jmp settrk
|
||
;
|
||
seldsk: ;select disk given by register c
|
||
lxi h,0000h ;return 000count
|
||
call read
|
||
jnz booterr ;retry if errors occur
|
||
lhld iod ;increment dma address
|
||
lxi d,128 ;sector size
|
||
dad d ;incre-a
|
||
; (exactly the same as mds call)
|
||
jmp csts
|
||
;
|
||
conin: ;console character to reg-a
|
||
call ci
|
||
ani 7fh ;remove parity bit
|
||
h,mon80
|
||
shld 7*8+1
|
||
endif
|
||
; leave iobyte set
|
||
; previously selected disk was b, send parameter to cpm
|
||
lda cdisk ;last log
|
||
dad h ;*2
|
||
dad h ;*4
|
||
dad h ;*8
|
||
dad h ;*16
|
||
lxi d,dpbase
|
||
dad d ;HL=disk header table address
|
||
ret
|
||
;
|
||
;
|
||
settrk: ;set here from cold start boot)
|
||
; enable rst0 and rst7
|
||
di
|
||
mvi a,12h ;initialize command
|
||
out revrt
|
||
xra a
|
||
out intc ;cleared0 if error
|
||
mov a,c
|
||
cpi ndisks ;too large?
|
||
rnc ;leave HL = 0000
|
||
;
|
||
ani 10b ;00 00 for drive 0,1 and 10 10 for drive 2,3
|
||
mented dma address in hl
|
||
mov b,h
|
||
mov c,l ;ready for call to set dma
|
||
call setdma
|
||
lda ios ;sector number just read
|
||
cpi 2ret
|
||
;
|
||
conout: ;console character from c to console out
|
||
jmp co
|
||
;
|
||
list: ;list device out
|
||
; (exactly the same as mds call)
|
||
ged disk number
|
||
mov c,a ;send to ccp to log it in
|
||
ei
|
||
jmp cpmb
|
||
;
|
||
; error condition occurred, print message and retry
|
||
boo track address given by c
|
||
lxi h,iot
|
||
mov m,c
|
||
ret
|
||
;
|
||
setsec: ;set sector number given by c
|
||
lxi h,ios
|
||
mov m,c
|
||
ret
|
||
sec
|
||
mvi a,inte ;rst0 and rst7 bits on
|
||
out intc
|
||
xra a
|
||
out icon ;interrupt control
|
||
;
|
||
; set default buffer address to 80h
|
||
|
||
sta dbank ;to select drive bank
|
||
mov a,c ;00, 01, 10, 11
|
||
ani 1b ;mds has 0,1 at 78, 2,3 at 88
|
||
ora a ;result 00?
|
||
jz setd6 ;read last sector?
|
||
jc rd1
|
||
; must be sector 26, zero and go to next track
|
||
lda iot ;get track to register a
|
||
inr a
|
||
mov c jmp lo
|
||
;
|
||
listst:
|
||
;return list status
|
||
xra a
|
||
ret ;always not ready
|
||
;
|
||
punch: ;punch device out
|
||
; (exactly the same as tran:
|
||
;translate sector bc using table at de
|
||
mvi b,0 ;double precision sector number in BC
|
||
xchg ;translate table addresshigh address for iopb
|
||
jnz iodr1 ;drive bank 1?
|
||
out ilow ;low address to controller
|
||
mov a,b
|
||
out ihigh ;high address
|
||
jm from the current i/o function
|
||
ani 00100000b ;mask the disk select bit
|
||
lxi h,ios ;address the sector select byte
|
||
ora m ;accepted as ok above)
|
||
; 1 - crc error
|
||
; 2 - seek error
|
||
; 3 - address error (hardware malfunction)
|
||
; 4 - data over/under flowret ;may have error set
|
||
;
|
||
;
|
||
; utility subroutines
|
||
prmsg: ;print message at h,l to 0
|
||
mov a,m
|
||
ora a ;zero?
|
||
rz
|
||
; more t retry
|
||
;
|
||
; check i/o error bits
|
||
call inbyte
|
||
ral
|
||
jc wready ;unit not ready
|
||
rar
|
||
ani 11111110b ;any other errors? (de to HL
|
||
dad b ;translate(sector) address
|
||
mov a,m ;translated sector number to A
|
||
sta ios
|
||
mov l,a ;return sector number in p wait0 ;to wait for complete
|
||
;
|
||
iodr1: ;drive bank 1
|
||
out ilow+10h ;88 for drive bank 10
|
||
mov a,b
|
||
out ihigh+10h
|
||
;
|
||
wait0select proper disk bank
|
||
mov m,a ;set disk select bit on/off
|
||
ret
|
||
;
|
||
waitio:
|
||
mvi c,retry ;max retries before perm error
|
||
r (hardware malfunction)
|
||
; 5 - write protect (treated as not ready)
|
||
; 6 - write error (hardware malfunction)
|
||
; 7 - not ready
|
||
o print
|
||
push h
|
||
mov c,a
|
||
call conout
|
||
pop h
|
||
inx h
|
||
jmp prmsg
|
||
;
|
||
setfunc:
|
||
; set function for next i/o (command in reg-cleted data ok)
|
||
jnz werror
|
||
;
|
||
; read or write is ok, accumulator contains zero
|
||
ret
|
||
;
|
||
wready: ;not ready, treat as error foL
|
||
ret
|
||
;
|
||
setdma: ;set dma address given by regs b,c
|
||
mov l,c
|
||
mov h,b
|
||
shld iod
|
||
ret
|
||
;
|
||
read: ;read next disk record (as: call instat ;wait for completion
|
||
ani iordy ;ready?
|
||
jz wait0
|
||
;
|
||
; check io completion ok
|
||
call intype ;must be io compewait:
|
||
; start the i/o function and wait for completion
|
||
call intype ;in rtype
|
||
call inbyte ;clears the controller
|
||
;
|
||
lda d; (accumulator bits are numbered 7 6 5 4 3 2 1 0)
|
||
;
|
||
; it may be useful to filter out the various conditions,
|
||
; but we will ge)
|
||
lxi h,iof ;io function address
|
||
mov a,m ;get it to accumulator for masking
|
||
ani 11111000b ;remove previous command
|
||
ora cr now
|
||
call inbyte ;clear result byte
|
||
jmp trycount
|
||
;
|
||
werror: ;return hardware malfunction (crc, track, seek, etc.)
|
||
; the suming disk/trk/sec/dma set)
|
||
mvi c,readf ;set to read function
|
||
call setfunc
|
||
call waitio ;perform read function
|
||
ret ;maylete (00) unlinked
|
||
; 00 unlinked i/o complete, 01 linked i/o complete (not used)
|
||
; 10 disk status changed 11 (not usebank ;set bank flags
|
||
ora a ;zero if drive 0,1 and nz if 2,3
|
||
mvi a,iopb and 0ffh ;low address for iopb
|
||
mvi b,iopb shr 8 ;t a permanent error message if it is not
|
||
; recoverable. in any case, the not ready condition is
|
||
; treated as a separate condi ;set to new command
|
||
mov m,a ;replaced in iopb
|
||
; the mds-800 controller requires disk bank bit in sector byte
|
||
; mask the bitmds controller has returned a bit in each position
|
||
; of the accumulator, corresponding to the conditions:
|
||
; 0 - deleted data ( have error set in reg-a
|
||
;
|
||
;
|
||
write: ;disk write function
|
||
mvi c,writf
|
||
call setfunc ;set to write function
|
||
call waitio
|
||
d)
|
||
cpi 10b ;ready status change?
|
||
jz wready
|
||
;
|
||
; must be 00 in the accumulator
|
||
ora a
|
||
jnz werror ;some other condition,tion for later improvement
|
||
trycount:
|
||
; register c contains retry count, decrement 'til zero
|
||
dcr c
|
||
jnz rewait ;for another 裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹
|
||
BOOT EQU 0000H ;WARM START
|
||
IOBYTE EQU 0003H ;IO BYTE
|
||
BDISK EQU 0004H ;BOOT DISK #
|
||
BDOS EQU 0005H ;BDOS ENTRY
|
||
MON1 EQU 0005da bdos+1 ;xsub already present?
|
||
cpi 06h ;low address must be 06h
|
||
jnz loaderr
|
||
lhld bdos+1
|
||
inx h
|
||
inx h
|
||
inx h
|
||
lxi d,if drive 2,3
|
||
iopb: ;io parameter block
|
||
db 80h ;normal i/o operation
|
||
iof: db readf ;io function, initial read
|
||
ion: db 1 ;num93950
|
||
;
|
||
org 100h
|
||
db (lxi or (b shl 3)) ;lxi b,module size
|
||
org $+2 ;skip address field
|
||
jmp start
|
||
db ' Extended Submitry
|
||
;
|
||
; cannot recover from error
|
||
mvi a,1 ;error code
|
||
ret
|
||
;
|
||
; intype, inbyte, instat read drive bank 00 or 10
|
||
intype: l裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹H ;BDOS ENTRY
|
||
MON2 EQU 0005H ;BDOS ENTRY
|
||
MON3 EQU 0005H ;BDOS ENTRY
|
||
MAXB EQU 0006H ;MAX MEM BASE
|
||
FCB EQU 005CH ;DEFAULT FCB
|
||
xsubcon
|
||
mvi c,4
|
||
present:
|
||
ldax d
|
||
cmp m
|
||
jnz continue
|
||
inx h
|
||
inx d
|
||
dcr c
|
||
jz loaderr
|
||
jmp present
|
||
;
|
||
loaderr:
|
||
ber of sectors to read
|
||
iot: db offset ;track number
|
||
ios: db 1 ;sector number
|
||
iod: dw buff ;io address
|
||
;
|
||
;
|
||
; define ram aret Vers '
|
||
db version/16+'0','.',version mod 16+'0'
|
||
nogo: db 'Xsub Already Present$'
|
||
badver: db 'Requires CP/M Version 2.0 or da dbank
|
||
ora a
|
||
jnz intyp1 ;skip to bank 10
|
||
in rtype
|
||
ret
|
||
intyp1: in rtype+10h ;78 for 0,1 88 for 2,3
|
||
ret
|
||
;
|
||
inbyte: 裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹
|
||
BUFF EQU 0080H ;DEFAULT BUFFER
|
||
END
|
||
|
||
; bdos or xsub not lowest module in memory, return to ccp
|
||
mvi c,print
|
||
lxi d,nogo ;already present message
|
||
call bdos ;to pas for bdos operation
|
||
endef
|
||
end
|
||
later$'
|
||
;
|
||
bdos equ 0005h ;bdos entry point
|
||
print equ 9 ;bdos print function
|
||
vers equ 12 ;get version number
|
||
ccplen equ 0800lda dbank
|
||
ora a
|
||
jnz inbyt1
|
||
in rbyte
|
||
ret
|
||
inbyt1: in rbyte+10h
|
||
ret
|
||
;
|
||
instat: lda dbank
|
||
ora a
|
||
jnz insta1
|
||
in dsta; xsub relocator version 2.2
|
||
version equ 20h
|
||
; xsub relocator program, included with the module
|
||
; to perform the m裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹rint the message
|
||
pop b ;recall length
|
||
ret ;to the ccp
|
||
;
|
||
continue:
|
||
mvi c,vers
|
||
call bdos ;version number?
|
||
cpi version; PIP INTERFACE TO BDOS (CAN BE USED FOR OTHER TRANSIENTS)
|
||
PUBLIC BOOT,IOBYTE,BDISK,BDOS,MON1,MON2,MON3
|
||
PUBLIC MAXB,FCB,BUFFh ;size of ccp
|
||
module equ 200h ;module address
|
||
;
|
||
start:
|
||
; ccp's stack used throughout
|
||
push b ;save the module's length
|
||
lt
|
||
ret
|
||
insta1: in dstat+10h
|
||
ret
|
||
;
|
||
;
|
||
;
|
||
; data areas (must be in ram)
|
||
dbank: db 0 ;disk bank 00 if drive 0,1
|
||
; 10 ove from 200h to the destination address
|
||
;
|
||
; copyright (c) 1979, 1980
|
||
; digital research
|
||
; box 579
|
||
; pacific grove, ca.
|
||
; ;2.0 or greater
|
||
jnc versok
|
||
;
|
||
; wrong version
|
||
mvi c,print
|
||
lxi d,badver
|
||
call bdos
|
||
pop b
|
||
ret ;to ccp
|
||
;
|
||
versok:
|
||
ion
|
||
pop d ;clear stacked address
|
||
; h has the high order 8-bits of relocated module address
|
||
mvi l,0
|
||
pchl ;go to relocatedyte
|
||
jnz rel1
|
||
; fetch bit map from stacked address
|
||
xthl
|
||
mov a,m ;next 8 bits of map
|
||
inx h
|
||
xthl ;base address goes bacoot saved and restored at end
|
||
;of submit file
|
||
;
|
||
wstart:
|
||
lxi sp,stack
|
||
mvi c,pbuff ;print message
|
||
lxi d,actmsg
|
||
call solute location
|
||
stax d ;place it into the reloc area
|
||
inx d
|
||
inx h
|
||
jmp move
|
||
;
|
||
reloc: ;storage moved, ready for relocatio 19 ;delete file
|
||
dreadf equ 20 ;disk read
|
||
dmaf equ 26 ;set dma function
|
||
;
|
||
;
|
||
org 0000h+bias
|
||
; initialize jmps to include xlxi h,bdos+2;address field of jump to bdos (top memory)
|
||
mov a,m ;a has high order address of memory top
|
||
dcr a ;page directly; xsub 'Extended Submit Facility' version 2.2
|
||
;
|
||
;
|
||
;
|
||
; xsub loads below ccp, and feeds command lines to
|
||
; programs whk to stack
|
||
mov l,a ;l holds the map as we process 8 locations
|
||
rel1: mov a,l
|
||
ral ;cy set to 1 if relocation necessary
|
||
movrbdos
|
||
lxi h,dbuff ;restore default buffer
|
||
shld udma
|
||
call rsetdma
|
||
lxi h,trapjmp
|
||
shld bdosl ;fixup low jump address
|
||
lhn
|
||
; hl addresses beginning of the bit map for relocation
|
||
pop d ;recall base of relocation area
|
||
pop b ;recall module length
|
||
sub module
|
||
jmp start
|
||
ds 3
|
||
trapjmp:
|
||
jmp trap
|
||
db 'xsub'
|
||
start:
|
||
lhld wboot+1
|
||
shld savboot
|
||
lxi h,wstart
|
||
shld wboot below bdos
|
||
sui (ccplen shr 8) ;-ccp pages
|
||
pop b ;recall length of module
|
||
push b ;and save it again
|
||
sub b ;a has high orich read buffered input
|
||
;
|
||
bias equ 0000h ;bias for relocation
|
||
base equ 0ffffh ;no intercepts below here
|
||
wboot equ 0000h
|
||
bdo l,a ;back to l for next time around
|
||
jnc rel2 ;skip relocation if cy=0
|
||
;
|
||
; current address requires relocation
|
||
ldax d
|
||
adld ccpret ;back to ccp
|
||
pchl
|
||
actmsg: db cr,lf,'(xsub active)$'
|
||
;
|
||
trap: ;arrive here at each bdos call
|
||
pop h ;return addres
|
||
push h ;save bit map base in stack
|
||
mov h,d ;relocation bias is in d
|
||
;
|
||
rel0: mov a,b ;bc=0?
|
||
ora c
|
||
jz endrel
|
||
;
|
||
; not e+1
|
||
lhld bdosl
|
||
shld rbdos+1 ;real bdos entry
|
||
lxi h,trapjmp ;address to fill
|
||
shld bdosl ;jmp @0005 leads to trap
|
||
pop h ;der address of reloc area
|
||
mov d,a
|
||
mvi e,0 ;d,e addresses base of reloc area
|
||
push d ;save for relocation below
|
||
;
|
||
lxi h,ms equ 0005h
|
||
bdosl equ bdos+1
|
||
dbuff equ 0080h
|
||
;
|
||
cr equ 0dh ;carriage return
|
||
lf equ 0ah ;line feed
|
||
modnum equ 14 ;module numd h ;apply bias in h
|
||
stax d
|
||
rel2: inx d ;to next address
|
||
jmp rel0 ;for another byte to relocate
|
||
;
|
||
endrel: ;end of relocats
|
||
push h ;back to stack
|
||
mov a,h ;high address
|
||
cpi base shr 8
|
||
jnc rbdos ;skip calls on bdos above here
|
||
mov a,c ;functiond of the relocation, may be into next byte of bit map
|
||
dcx b ;count length down
|
||
mov a,e
|
||
ani 111b ;0 causes fetch of next bccp return address
|
||
shld ccpret
|
||
pchl ;back to ccp
|
||
;
|
||
rbdos: jmp 0000h ;filled in at initialization
|
||
savboot:
|
||
ds 2 ;warm bodule;ready for the move
|
||
move: mov a,b ;bc=0?
|
||
ora c
|
||
jz reloc
|
||
dcx b ;count module size down to zero
|
||
mov a,m ;get next abber position
|
||
pbuff equ 9 ;print buffer
|
||
rbuff equ 10 ;read buffer
|
||
openf equ 15 ;open file
|
||
closef equ 16 ;close file
|
||
delf equn number
|
||
cpi rbuff
|
||
jz rnbuff ;read next buffer
|
||
cpi dmaf ;set dma address?
|
||
jnz rbdos ;skip if not
|
||
xchg ;dma to hl
|
||
sh
|
||
restor:
|
||
lhld savboot
|
||
shld wboot+1
|
||
jmp rbdos
|
||
;
|
||
subfcb:
|
||
db 1 ;a:
|
||
db '$$$ '
|
||
db 'SUB'
|
||
db 0,0,0
|
||
subrc:
|
||
ds 1
|
||
|
||
jc movlin
|
||
mov a,m ;max length
|
||
stax d ;truncate length
|
||
movlin:
|
||
mov c,a ;length to c
|
||
inr c ;+1
|
||
inx h ;to length of lTERALLY '0020H'; /* REQUIRED FOR OPERATION */
|
||
|
||
DECLARE
|
||
IOBYTE BYTE EXTERNAL, /* IOBYTE AT 0003H */
|
||
MAXB ADDRE ;no sub file
|
||
;
|
||
push d
|
||
lda subrc ;length of file
|
||
ora a ;zero?
|
||
jz rbdos ;skip if so
|
||
dcr a ;length - 1
|
||
sta subcr ;ne裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹ld udma ;save it
|
||
xchg
|
||
jmp rbdos
|
||
;
|
||
setdma:
|
||
mvi c,dmaf
|
||
lxi d,combuf
|
||
call rbdos
|
||
ret
|
||
;
|
||
rsetdma:
|
||
mvi c,dmaf
|
||
lhld ds 16 ;map
|
||
subcr: ds 1
|
||
;
|
||
combuf: ds 131
|
||
udma: dw dbuff
|
||
ccpret: ds 2 ;ccp return address
|
||
ds 32 ;16 level stack
|
||
stack:
|
||
ine
|
||
rdloop:
|
||
ldax d ;next char
|
||
mov m,a
|
||
inx h
|
||
inx d
|
||
dcr c
|
||
jnz rdloop ;loop til copied
|
||
mvi c,closef
|
||
lxi d,subfcb
|
||
SS EXTERNAL, /* ADDR FIELD OF JMP BDOS */
|
||
FCB (33) BYTE EXTERNAL, /* DEFAULT FILE CONTROL BLOCK */
|
||
BUFF(128)BYxt to read
|
||
mvi c,dreadf
|
||
lxi d,subfcb
|
||
call fbdos ;read record
|
||
; now print the buffer with cr,lf
|
||
lxi h,combuf
|
||
mov e,m ;裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹udma
|
||
xchg
|
||
call rbdos
|
||
ret
|
||
;
|
||
fbdos:
|
||
push b
|
||
push d
|
||
call setdma
|
||
pop d
|
||
pop b
|
||
call rbdos
|
||
push psw
|
||
call rsetdmaend
|
||
lxi h,modnum
|
||
dad d ;hl=fcb(modnum)
|
||
mvi m,0 ;=0 so acts as if written
|
||
lda subcr ;length of file
|
||
dcr a ;incremented by reTE EXTERNAL; /* DEFAULT BUFFER */
|
||
|
||
DECLARE
|
||
ENDFILE LITERALLY '1AH', /* END OF FILE MARK */
|
||
JMP LITERALLY '0length
|
||
mvi d,0 ;high order 00
|
||
dad d ;to last character position
|
||
inx h
|
||
mvi m,cr
|
||
inx h
|
||
mvi m,lf
|
||
inx h
|
||
mvi m,'$'
|
||
PIPMOD:
|
||
DO;
|
||
/* P E R I P H E R A L I N T E R C H A N G E P R O G R A M
|
||
|
||
COPYRIGHT (C) 1976, 1977, 1978, 1979, 198
|
||
pop psw
|
||
ret
|
||
;
|
||
cksub: ;check for sub file present
|
||
mvi c,openf
|
||
lxi d,subfcb
|
||
call fbdos ;submit file present?
|
||
inr a 裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹ad op
|
||
sta subrc ;decrease file length
|
||
ora a ;at zero?
|
||
jnz fileop
|
||
mvi c,delf ;delete if at end
|
||
fileop: call fbdos
|
||
ret
|
||
C3H', /* 8080 JUMP INSTRUCTION */
|
||
RET LITERALLY '0C9H'; /* 8080 RETURN */
|
||
|
||
/* THE FIRST PORTION OF THE PIP PROGmvi c,pbuff
|
||
lxi d,combuf+1
|
||
call rbdos ;to print it
|
||
pop h ;.max length
|
||
lxi d,combuf
|
||
ldax d ;how long?
|
||
cmp m ;cy if ok0
|
||
DIGITAL RESEARCH
|
||
BOX 579
|
||
PACIFIC GROVE, CA
|
||
93950
|
||
*/
|
||
|
||
DECLARE
|
||
CPMVERSION LI;00 if not present
|
||
ret
|
||
;
|
||
rnbuff:
|
||
push d ;command address
|
||
call cksub ;sub file present?
|
||
pop d
|
||
mvi c,rbuff
|
||
jz restor裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹RAM 'FAKES' THE PAGE ONE
|
||
(100H - 1FFH) SECTION OF PIP WHICH CONTAINS A JUMP TO PIPENTRY, AND
|
||
SPACE FOR CUSTOM I/O DRIVERS (WHIREEMEMORY, FREEMEMORY, FREEMEMORY,
|
||
FREEMEMORY, FREEMEMORY, FREEMEMORY, FREEMEMORY);
|
||
|
||
|
||
|
||
|
||
DECLARE COPYRIGHT(*) BYTE 03H AND 106H BY JMP'S
|
||
; TO THE PROPER LOCATIONS WITHIN THE RESERVED AREA.
|
||
; ALSO, RETURN DATA FROM INP: ENTRY POINT A /* CONSOLE */
|
||
NULP LIT '19', /* NUL: BEFORE INCREMENT */
|
||
EOFP LIT '20', /* EOF: NS THE FOLLOWING
|
||
100H: JMP PIPENTRY ;TO START THE PIP PROGRAM
|
||
103H: RET ;INP: DEFAULTS TO EMPTY INPUT;
|
||
|
||
/* LITERAL DECLARATIONS */
|
||
DECLARE
|
||
LIT LITERALLY 'LITERALLY',
|
||
LPP LIT '60', /* LINES PER PAGE */
|
||
TACH CAN BE 'PATCHED' USING DDT) IN THE
|
||
REMAINING PAGE ONE AREA. THE PIP PROGRAM ACTUALLY STARTS AT 200H */
|
||
|
||
DECLARE JUMP BYTEDATA (
|
||
' COPYRIGHT (C) 1979, DIGITAL RESEARCH, PIP VERS 1.5');
|
||
|
||
DECLARE INPLOC ADDRESS DATA (.INPSUB); /* ADDRESST 109H.
|
||
; THESE DRIVERS ARE MOST EASILY INSERTED WITH THE DDT PROGRAM
|
||
; UNDER CP/M
|
||
*/
|
||
|
||
DECLARE /* 16 BYTE MESSABEFORE INCREMENT */
|
||
HSRDR LIT 'RDR', /* READER DEVICES */
|
||
PRNT LIT '10', /* PRINTER */
|
||
|
||
(DATA 1AH AT 109H)
|
||
104H: NOP
|
||
105H: NOP
|
||
106H: RET ;OUT: DEFAULTS TO EMPTY OUTPUT
|
||
107H: NOP
|
||
B LIT '09H', /* HORIZONTAL TAB */
|
||
FF LIT '0CH', /* FORM FEED */
|
||
LA LIT '05FH', /* LEFT ARROW */
|
||
LB LIT DATA(JMP); /* JMP INSTRUCTION TO */
|
||
/* JMP .PIPENTRY-3 WHERE THE LXI SP,STACK ACTUALLY OCCURS */
|
||
DECLARE JADR ADDRESS DATA(.P OF INP: DEVICE */
|
||
DECLARE OUTLOC ADDRESS DATA (.OUTSUB); /* ADDRESS OF OUT: DEVICE */
|
||
|
||
OUT: PROCEDURE(B);
|
||
DECLARE GE */
|
||
FREEMEMORY LITERALLY '''(INP:/OUT:SPACE)''',
|
||
/* 256 BYTE AREA FOR INP: OUT: PATCHING */
|
||
RESERVED(*) BYTE DA
|
||
|
||
FSIZE LIT '33',
|
||
FRSIZE LIT '36', /* SIZE OF RANDOM FCB */
|
||
NSIZE LIT '8',
|
||
FNSIZE LIT '11',
|
||
MDISK LIT ' 108H: NOP
|
||
109H: 1AH=ENDFILE ;DATA FROM INP: FUNCTION IS STORED HERE ON
|
||
;RETURN FROM T '05BH', /* LEFT BRACKET */
|
||
RB LIT '05DH', /* RIGHT BRACKET */
|
||
XOFF LIT '13H', /* TRANSMIT BUFFER FUNCTION */
|
||
|
||
IPENTRY-3); /* START OF PIP */
|
||
DECLARE INPSUB(3) BYTE DATA(RET,0,0); /* INP: RET NOP NOP */
|
||
DECLARE OUTSUB(3) BYTE DATA(REB BYTE;
|
||
/* SEND B TO OUT: DEVICE */
|
||
CALL OUTLOC;
|
||
END OUT;
|
||
|
||
INP: PROCEDURE BYTE;
|
||
CALL INPLOC;
|
||
RETURN ITA(0,0,0,0,0,0,
|
||
FREEMEMORY, FREEMEMORY, FREEMEMORY,
|
||
FREEMEMORY, FREEMEMORY, FREEMEMORY, FREEMEMORY,
|
||
FREEMEMORY, F1',
|
||
FNAM LIT '8',
|
||
FEXT LIT '9',
|
||
FEXTL LIT '3',
|
||
ROFILE LITERALLY '9', /* READ ONLY FILE FIELD */
|
||
SYSFIHE INP: ENTRY POINT
|
||
10AH: - 1FFH ;SPACE RESERVED FOR SPECIAL PURPOSE
|
||
; DRIVERS - IF INCLUDED, THEN REPLACE 1 RDR LIT '5',
|
||
LST LIT '10',
|
||
PUNP LIT '15', /* POSITION OF 'PUN' + 1 */
|
||
CONP LIT '19', T,0,0); /* OUT: RET NOP NOP */
|
||
DECLARE INPDATA BYTE DATA(ENDFILE); /* RETURNED DATA */
|
||
/* NOTE: PAGE 1 AT 100H CONTAINPDATA;
|
||
END INP;
|
||
|
||
|
||
TIMEOUT: PROCEDURE;
|
||
/* WAIT FOR 50 MSEC */
|
||
CALL TIME(250); CALL TIME(250);
|
||
END TIMEOUTLE LITERALLY '10', /* SYSTEM FILE FIELD */
|
||
FREEL LIT '12', /* REEL NUMBER FIELD OF FCB */
|
||
|
||
HBUFS LIT '80', /* DEST IS 'HEX' FILE IF TRUE */
|
||
SOURCE (FSIZE) BYTE, /* SOURCE FCB */
|
||
SFUB BYTE AT(.SOURCE(13)), /* U DBLEN ADDRESS, /* DEST BUFFER LENGTH */
|
||
SBASE ADDRESS, /* SOURCE BUFFER BASE */
|
||
/* THESET WHEN READY FOR NEXT LINE NUM */
|
||
CONCNT BYTE, /* COUNTER FOR CONSOLE READY CHECK */
|
||
CHAR BYTE, NG */
|
||
MATCHLEN BYTE, /* USED IN MATCHING STRINGS */
|
||
QUITLEN BYTE, /* USED TO TERMINATE */
|
||
HARDEOF ADDRESS, /* SET TO NSOURCE ON REAL EOF */
|
||
NDEST ADDRESS; /* NEXT DESTINATION CH /* "HEX" BUFFER SIZE */
|
||
|
||
ERR LIT '0',
|
||
SPECL LIT '1',
|
||
FILE LIT '2',
|
||
PERIPH LIT '3',
|
||
DISKNAME LIT 'NFILLED BYTES FIELD */
|
||
DEST (FRSIZE) BYTE, /* DESTINATION FCB */
|
||
DESTR ADDRESS AT(.DEST(33)), /* RANDOM REC VECTORS DBUFF AND SBUFF ARE DECLARED WITH DIMENSION
|
||
1024, BUT ACTUALLY VARY WITH THE FREE MEMORY SIZE */
|
||
DBUFF(1024) /* LAST CHARACTER SCANNED */
|
||
TYPE BYTE, /* TYPE OF CHARACTER SCANNED */
|
||
FLEN BYTE;QUIT COMMAND */
|
||
NBUF BYTE, /* NUM BUFFERS-1 IN SBUFF AND DBUFF */
|
||
CDISK BYTE, /* ARACTER */
|
||
|
||
DECLARE
|
||
/* SUBMIT FILE CONTROL BLOCK FOR ERROR DELETE */
|
||
SUBFCB (*) BYTE DATA (0,'$$$ SUB',0,0,0);
|
||
4';
|
||
|
||
DECLARE
|
||
COLUMN BYTE, /* COLUMN COUNT FOR PRINTER TABS */
|
||
LINENO BYTE, /* LINE WITHIN PAGE */
|
||
AMBIGORD POSITION */
|
||
DESTO BYTE AT(.DEST(35)), /* RANDOM OVERFLOW BYTE */
|
||
DFUB BYTE AT (.DEST(13)), /* UNFILLED BYTBYTE AT (.MEMORY), /* DESTINATION BUFFER */
|
||
SBUFF BASED SBASE (1024) BYTE, /* SOURCE BUFFER */
|
||
SDISK BYTE, /* FILE NAME LENGTH */
|
||
|
||
MON1: PROCEDURE(F,A) EXTERNAL;
|
||
DECLARE F BYTE,
|
||
A ADDRESS;
|
||
END MON1;CURRENT DISK */
|
||
BUFFER LITERALLY 'BUFF', /* DEFAULT BUFFER */
|
||
SEARFCB LITERALLY 'FCB', /* SEARCH FCB IN MULT
|
||
DECLARE
|
||
PDEST BYTE, /* DESTINATION DEVICE */
|
||
PSOURCE BYTE; /* CURRENT SOURCE DEV BYTE, /* SET FOR AMBIGUOUS FILE REFS */
|
||
PARSET BYTE, /* TRUE IF PARAMETERS PRESENT */
|
||
ES FIELD */
|
||
DDISK BYTE, /* DESTINATION DISK */
|
||
HBUFF(HBUFS) BYTE, /* HEX FILE BUFFER */
|
||
/* SOURCE DISK */
|
||
(SCOM, DHEX) BYTE, /* SOURCE IS 'COM' FILE IF TRUE */
|
||
|
||
|
||
MON2: PROCEDURE(F,A) BYTE EXTERNAL;
|
||
DECLARE F BYTE,
|
||
A ADDRESS;
|
||
END MON2;
|
||
|
||
MON3: PROCEDURE(F,A) ADDRESS EXTEI COPY */
|
||
MEMSIZE LITERALLY 'MAXB', /* MEMORY SIZE */
|
||
SBLEN ADDRESS, /* SOURCE BUFFER LENGTH */
|
||
ICE */
|
||
|
||
DECLARE
|
||
MULTCOM BYTE, /* FALSE IF PROCESSING ONE LINE */
|
||
PUTNUM BYTE, /* FEEDBASE BYTE, /* USED TO FEED SEARCH CHARACTERS */
|
||
FEEDLEN BYTE, /* LENGTH OF FEED STRI HSOURCE BYTE, /* NEXT HEX SOURCE CHARACTER */
|
||
|
||
NSOURCE ADDRESS, /* NEXT SOURCE CHARACTER RNAL;
|
||
DECLARE F BYTE,
|
||
A ADDRESS;
|
||
END MON3;
|
||
|
||
BOOT: PROCEDURE EXTERNAL;
|
||
/* SYSTEM REBOOT */
|
||
END BOOT;
|
||
ADDRESS;
|
||
RETURN MON2(20,FCB);
|
||
END DISKREAD;
|
||
|
||
DISKWRITE: PROCEDURE(FCB) BYTE;
|
||
DECLARE FCB ADDRESS;
|
||
RETURN M);
|
||
END SELECT;
|
||
|
||
OPEN: PROCEDURE(FCB);
|
||
DECLARE FCB ADDRESS;
|
||
DCNT = MON2(15,FCB);
|
||
END OPEN;
|
||
|
||
CLOSE: PROCED RANDOM RECORD POSITION */
|
||
CALL MON1(36,FCB);
|
||
END SET$RANDOM;
|
||
|
||
DECLARE CBUFF(130) BYTE, /* COMMAND BUFFER */
|
||
CALL PRINTCHAR(CR);
|
||
CALL PRINTCHAR(LF);
|
||
END CRLF;
|
||
|
||
PRINT: PROCEDURE(A);
|
||
DECLARE A ADDRESS;
|
||
/* PRINT THOCEDURE(USER);
|
||
DECLARE USER BYTE;
|
||
CALL MON1(32,USER);
|
||
END SETUSER;
|
||
|
||
SETCUSER: PROCEDURE;
|
||
CALL SETUSER(CUSE
|
||
READRDR: PROCEDURE BYTE;
|
||
/* READ CURRENT READER DEVICE */
|
||
RETURN MON2(3,0);
|
||
END READRDR;
|
||
|
||
READCHAR: PROCEDUREON2(21,FCB);
|
||
END DISKWRITE;
|
||
|
||
MAKE: PROCEDURE(FCB);
|
||
DECLARE FCB ADDRESS;
|
||
DCNT = MON2(22,FCB);
|
||
END MAKE;
|
||
|
||
URE(FCB);
|
||
DECLARE FCB ADDRESS;
|
||
DCNT = MON2(16,FCB);
|
||
END CLOSE;
|
||
|
||
SEARCH: PROCEDURE(FCB);
|
||
DECLARE FCB ADDRESMAXLEN BYTE AT (.CBUFF(0)), /* MAX BUFFER LENGTH */
|
||
COMLEN BYTE AT (.CBUFF(1)), /* CURRENT LENGTH */
|
||
COMBUFF (128) BE STRING STARTING AT ADDRESS A UNTIL THE
|
||
NEXT DOLLAR SIGN IS ENCOUNTERED */
|
||
CALL CRLF;
|
||
CALL MON1(9,A);
|
||
END PR);
|
||
END SETCUSER;
|
||
|
||
SETSUSER: PROCEDURE;
|
||
CALL SETUSER(SUSER);
|
||
END SETSUSER;
|
||
|
||
READ$RANDOM: PROCEDURE(FCB) BYTE; BYTE;
|
||
/* READ CONSOLE CHARACTER */
|
||
RETURN MON2(1,0);
|
||
END READCHAR;
|
||
|
||
DECLARE
|
||
TRUE LITERALLY '1',
|
||
FALSRENAME: PROCEDURE(FCB);
|
||
DECLARE FCB ADDRESS;
|
||
CALL MON1(23,FCB);
|
||
END RENAME;
|
||
|
||
DECLARE
|
||
CUSER BYTE, /* CURRENS;
|
||
DCNT = MON2(17,FCB);
|
||
END SEARCH;
|
||
|
||
SEARCHN: PROCEDURE;
|
||
DCNT = MON2(18,0);
|
||
END SEARCHN;
|
||
|
||
DELETE: PROCEDYTE AT (.CBUFF(2)); /* COMMAND BUFFER CONTENTS */
|
||
DECLARE (TCBP,CBP) BYTE; /* TEMP CBP, COMMAND BUFFER POINTER */
|
||
|
||
READCOM:RINT;
|
||
|
||
DECLARE DCNT BYTE;
|
||
|
||
VERSION: PROCEDURE ADDRESS;
|
||
RETURN MON3(12,0); /* VERSION NUMBER */
|
||
END VERSION;
|
||
|
||
INI
|
||
DECLARE FCB ADDRESS;
|
||
RETURN MON2(33,FCB);
|
||
END READ$RANDOM;
|
||
|
||
WRITE$RANDOM: PROCEDURE(FCB) BYTE;
|
||
DECLARE FCE LITERALLY '0',
|
||
FOREVER LITERALLY 'WHILE TRUE',
|
||
CR LITERALLY '13',
|
||
LF LITERALLY '10',
|
||
WHAT LITERALLY '63';
|
||
T USER NUMBER */
|
||
SUSER BYTE; /* SOURCE USER NUMBER ('G' PARAMETER) */
|
||
|
||
SETIND: PROCEDURE(FCB);
|
||
DECLARE FCB ADDRESS;
|
||
URE(FCB);
|
||
DECLARE FCB ADDRESS;
|
||
CALL MON1(19,FCB);
|
||
END DELETE;
|
||
|
||
DISKREAD: PROCEDURE(FCB) BYTE;
|
||
DECLARE FCB PROCEDURE;
|
||
/* READ INTO COMMAND BUFFER */
|
||
MAXLEN = 128;
|
||
CALL MON1(10,.MAXLEN);
|
||
END READCOM;
|
||
|
||
DECLARE MCBPTIALIZE: PROCEDURE;
|
||
CALL MON1(13,0);
|
||
END INITIALIZE;
|
||
|
||
SELECT: PROCEDURE(D);
|
||
DECLARE D BYTE;
|
||
CALL MON1(14,DB ADDRESS;
|
||
RETURN MON2(34,FCB);
|
||
END WRITE$RANDOM;
|
||
|
||
SET$RANDOM: PROCEDURE(FCB);
|
||
DECLARE FCB ADDRESS;
|
||
/* SET
|
||
|
||
PRINTCHAR: PROCEDURE(CHAR);
|
||
DECLARE CHAR BYTE;
|
||
CALL MON1(2,CHAR AND 7FH);
|
||
END PRINTCHAR;
|
||
|
||
CRLF: PROCEDURE;
|
||
|
||
CALL MON1(30,FCB);
|
||
END SETIND;
|
||
|
||
GETUSER: PROCEDURE BYTE;
|
||
RETURN MON2(32,0FFH);
|
||
END GETUSER;
|
||
|
||
SETUSER: PR BYTE;
|
||
|
||
CONBRK: PROCEDURE BYTE;
|
||
/* CHECK CONSOLE CHARACTER READY */
|
||
RETURN MON2(11,0);
|
||
END CONBRK;
|
||
|
||
DECLARE //ICOM READER INPUT */
|
||
|
||
INTIN: PROCEDURE BYTE;
|
||
/* READ THE INTEL / ICOM READER */
|
||
DECLARE PTRI LITERALLY '3', /* DAT(17)), /* READ SYSTEM FILES */
|
||
STARTS BYTE AT(.CONT(18)), /* START COPY */
|
||
TABS BYTE AT(.CONT(19)), /* TA.SUBFCB);
|
||
CALL CRLF;
|
||
GO TO RETRY;
|
||
END ERROR;
|
||
|
||
MOVE: PROCEDURE(S,D,N);
|
||
DECLARE (S,D) ADDRESS, N BYTE;
|
||
/
|
||
GETU BYTE AT(.CONT(6)), /* GET FILE, USER # */
|
||
HEXT BYTE AT(.CONT(7)), /* HEX FILE TRANSFER */
|
||
IGINTER */
|
||
|
||
ERROR: PROCEDURE(A);
|
||
DECLARE A ADDRESS, I BYTE;
|
||
CALL SETCUSER;
|
||
CALL PRINT(A); CALL PRINTCHAR(':');* CONTROL TOGGLE VECTOR */
|
||
CONT(26) BYTE, /* ONE FOR EACH ALPHABETIC */
|
||
/* 00 01 02 03 04 05 06 07 08 09 10 11 12 13A */
|
||
PTRS LITERALLY '1', /* STATUS */
|
||
PTRC LITERALLY '1', /* COMMAND */
|
||
PTRG LITERALLY B SET */
|
||
UPPER BYTE AT(.CONT(20)), /* UPPER CASE TRANSLATE */
|
||
VERIF BYTE AT(.CONT(21)), /* VERIFY EQUAL FILE DECLARE A BASED S BYTE, B BASED D BYTE;
|
||
DO WHILE (N:=N-1) <> 255;
|
||
B = A; S = S+1; D = D+1;
|
||
END;
|
||
NOR BYTE AT(.CONT(8)), /* IGNORE :00 RECORD ON FILE */
|
||
LOWER BYTE AT(.CONT(11)), /* TRANSLATE TO LOWER CASE */
|
||
CALL PRINTCHAR(' ');
|
||
DO I = TCBP TO CBP;
|
||
IF I < COMLEN THEN CALL PRINTCHAR(COMBUFF(I));
|
||
END;
|
||
/*
|
||
A B C D E F G H I J K L M N
|
||
14 15 16 17 18 19 20 21 22 23 24 25
|
||
O P Q R S T U V '0CH', /* GO */
|
||
PTRN LITERALLY '08H'; /* STOP */
|
||
|
||
/* STROBE THE READER */
|
||
OUTPUT(PTRC) = PTRG;
|
||
OUTPS ONLY */
|
||
WRROF BYTE AT(.CONT(22)), /* WRITE TO R/O FILE */
|
||
ZEROP BYTE AT(.CONT(25)); /* ZERO PARITY ON INPU END MOVE;
|
||
|
||
|
||
FILLSOURCE: PROCEDURE;
|
||
/* FILL THE SOURCE BUFFERS */
|
||
DECLARE (I,J) BYTE;
|
||
NSOURCE = 0;
|
||
CAL NUMB BYTE AT(.CONT(13)), /* NUMBER OUTPUT LINES */
|
||
OBJ BYTE AT(.CONT(14)), /* OBJECT FILE TRANSFER */
|
||
ZERO THE COMLEN IN CASE THIS IS A SINGLE COMMAND */
|
||
COMLEN = 0;
|
||
/* DELETE ANY $$$.SUB FILES IN CASE BATCH PROCESSING W X Y Z */
|
||
BLOCK BYTE AT(.CONT(1)), /* BLOCK MODE TRANSFER */
|
||
DELET BYTE AT(.CONT(3)), /* DELETE CHARUT(PTRC) = PTRN;
|
||
DO WHILE NOT ROL(INPUT(PTRS),3); /* NOT READY */
|
||
END;
|
||
/* DATA READY */
|
||
RETURN INPUTT */
|
||
|
||
SETDMA: PROCEDURE(A);
|
||
DECLARE A ADDRESS;
|
||
CALL MON1(26,A);
|
||
END SETDMA;
|
||
|
||
/* INTELLEC 8 INTELL SELECT(SDISK);
|
||
CALL SETSUSER; /* SOURCE USER NUMBER SET */
|
||
DO I = 0 TO NBUF;
|
||
/* SET DMA ADDRESS TO NEXT PAGCNT BYTE AT(.CONT(15)), /* PAGE LENGTH */
|
||
QUITS BYTE AT(.CONT(16)), /* QUIT COPY */
|
||
RSYS BYTE AT(.CONT*/
|
||
/* DELETE SUB FILE ONLY IF PRESENT (MAY BE R/O DISK) */
|
||
CALL SEARCH(.SUBFCB);
|
||
IF DCNT <> 255 THEN CALL DELETE(ACTERS */
|
||
ECHO BYTE AT(.CONT(4)), /* ECHO CONSOLE CHARACTERS */
|
||
FORMF BYTE AT(.CONT(5)), /* FORM FILTER *(PTRI) AND 7FH;
|
||
END INTIN;
|
||
|
||
|
||
DECLARE ZEROSUP BYTE, /* ZERO SUPPRESSION */
|
||
(C3,C2,C1) BYTE; /* LINE COUNT ON PR BUFFER POSIITION */
|
||
CALL SETDMA(.SBUFF(NSOURCE));
|
||
IF (J := DISKREAD(.SOURCE)) <> 0 THEN
|
||
DO; IF J DATAOK THEN
|
||
CALL ERROR(.('VERIFY ERROR$'));
|
||
END;
|
||
DATAOK = DISKWRITE(.DEST);
|
||
/* ERIF THEN /* VERIFY DATA WRITTEN OK */
|
||
DO;
|
||
NDEST = 0;
|
||
CALL SETDMA(.BUFF); /* FOR COMPARE */
|
||
NOTDEST:
|
||
CALL ERROR(.('NOT A CHARACTER SINK$'));
|
||
/* CASE 7 IS OUT */
|
||
CALL OUT(B);
|
||
*/
|
||
DECLARE (I, J, N) BYTE;
|
||
DECLARE DMA ADDRESS;
|
||
DECLARE DATAOK BYTE;
|
||
IF (N := LOW(SHR(NDEST,7)) - 1) = 255 TION FILE */
|
||
DO;
|
||
IF NDEST >= DBLEN THEN CALL WRITEDEST;
|
||
DBUFF(NDEST) = B;
|
||
ND <> 1 THEN
|
||
CALL ERROR(.('DISK READ ERROR$'));
|
||
/* END - OF - FILE */
|
||
HARDEOF = NSOURCENOW READY TO CONTINUE THE WRITE OPERATION */
|
||
END;
|
||
NDEST = 0;
|
||
END WRITEDEST;
|
||
|
||
PUTDCHAR: PROCEDURE(B);
|
||
DO I = 0 TO N;
|
||
DATAOK = READRANDOM(.DEST) = 0;
|
||
DESTR = DESTR + 1; /* NEXT RANDOM READ */
|
||
/* CASE 8 IS LPT */
|
||
DO; IOBYTE = 1000$0000B; GO TO LSTL;
|
||
END;
|
||
/* CASE 9 IS UL1 */
|
||
THEN RETURN ;
|
||
NDEST = 0;
|
||
CALL SELECT(DDISK);
|
||
CALL SETRANDOM(.DEST); /* SET BASE RECORD FOR VERIFY */
|
||
DO EST = NDEST+1;
|
||
END;
|
||
/* CASE 1 IS ARD (ADDMASTER) */
|
||
GO TO NOTDEST;
|
||
/* CASE 2 IS IRD (; /* SET HARD END-OF-FILE */
|
||
SBUFF(NSOURCE) = ENDFILE; I = NBUF;
|
||
END; ELSE
|
||
NSOURCE = NSOURCE DECLARE (B,IOB) BYTE;
|
||
/* WRITE BYTE B TO THE DESTINATION DEVICE GIVEN BY PDEST */
|
||
IF B >= ' ' THEN
|
||
DO; COLUM J = 0;
|
||
/* PERFORM COMPARISON */
|
||
DO WHILE DATAOK AND J < 80H;
|
||
DATAOK = BUF DO; IOBYTE = 1100$0000B; GO TO LSTL;
|
||
END;
|
||
/* CASE 10 IS PRN (TABS EXPANDED, LINES LISTI = 0 TO N;
|
||
/* SET DMA ADDRESS TO NEXT BUFFER */
|
||
DMA = .DBUFF(NDEST);
|
||
CALL SETDMA(DMA);
|
||
IF DINTEL/ICOM) */
|
||
GO TO NOTDEST;
|
||
/* CASE 3 IS PTR */
|
||
GO TO NOTDEST;
|
||
/* CASE 4 IS UR1 */+ 128;
|
||
END;
|
||
NSOURCE = 0;
|
||
CALL SETCUSER; /* BACK TO CURRENT USER NUMBER */
|
||
END FILLSOURCE;
|
||
|
||
|
||
WRITEDEN = COLUMN + 1;
|
||
IF DELET > 0 THEN /* MAY BE PAST RIGHT SIDE */
|
||
DO; IF COLUMN > DELET THEN RETURN;
|
||
FER(J) = DBUFF(NDEST+J);
|
||
J = J + 1;
|
||
END;
|
||
NDEST = NDEST + 128;
|
||
IF NOTED, CHANGED TO LST) */
|
||
DO; IOBYTE = 1000$0000B; GO TO LSTL;
|
||
END;
|
||
/* CASE 11 IS LST */ISKWRITE(.DEST) <> 0 THEN
|
||
CALL ERROR(.('DISK WRITE ERROR$'));
|
||
NDEST = NDEST + 128;
|
||
END;
|
||
IF V
|
||
GO TO NOTDEST;
|
||
/* CASE 5 IS UR2 */
|
||
GO TO NOTDEST;
|
||
/* CASE 6 IS RDR */
|
||
ST: PROCEDURE;
|
||
/* WRITE OUTPUT BUFFERS UP TO BUT NOT INCLUDING POSITION
|
||
NDEST - THE LOW ORDER 7 BITS OF NDEST ARE ZERO END;
|
||
END;
|
||
IOB = IOBYTE; /* IN CASE IT IS ALTERED */
|
||
DO CASE PDEST;
|
||
/* CASE 0 IS THE DESTINA
|
||
LSTL:
|
||
CALL MON1(5,B);
|
||
/* CASE 12 IS PTP */
|
||
DO; IOBYTE = 0001$0000B; GO TO PINTDIG;
|
||
|
||
NEWLINE: PROCEDURE;
|
||
DECLARE ONE BYTE;
|
||
ONE = 1;
|
||
ZEROSUP = NUMB = 1;
|
||
C1 = DEC(C1+ONE); C2 = DEC(C2 I = I - TABS;
|
||
END;
|
||
I = TABS - I;
|
||
DO WHILE I > 0;
|
||
I = I - 1;
|
||
|
||
IF (I:=PAGCNT) <> 0 THEN /* PAGE EJECT */
|
||
DO; IF I=1 THEN I=LPP;
|
||
IF (LINENO := L IS UC1 */
|
||
DO; IOBYTE = 11B; GO TO CONL;
|
||
END;
|
||
/* CASE 19 IS CON */
|
||
CONL:WRITTEN */
|
||
CALL WRITEDEST; /* CLEARS BUFFERS */
|
||
CALL MOVE(.DBUFF(NA),.DBUFF,I);
|
||
/* DATA MOVED TO BEGINNIUNL;
|
||
END;
|
||
/* CASE 13 IS UP1 */
|
||
DO; IOBYTE = 0010$0000B; GO TO PUNL;
|
||
END;
|
||
PLUS 0); C3 = DEC(C3 PLUS 0);
|
||
CALL PRINTDIG(C3); CALL PRINTDIG(C2); CALL PRINTDIG(C1);
|
||
IF NUMB = 1 THEN /* USUALLY PRI CALL PUTDCHAR(' ');
|
||
END;
|
||
END;
|
||
IF B = CR THEN COLUMN = 0;
|
||
END PUTDESTC;
|
||
|
||
PRINT1: PROCEDUREINENO + 1) >= I THEN
|
||
DO; LINENO = 0; /* NEW PAGE */
|
||
CALL PUTDESTC(FF);
|
||
|
||
CALL MON1(2,B);
|
||
END;
|
||
IOBYTE = IOB;
|
||
END PUTDCHAR;
|
||
|
||
PUTDESTC: PROCEDURE(B);
|
||
DECLARNG OF BUFFER */
|
||
NDEST = I;
|
||
END CLEARBUFF;
|
||
|
||
PUTDEST: PROCEDURE(B);
|
||
DECLARE (I,B) BYTE;
|
||
/* WRITE DESTINATION /* CASE 14 IS UP2 */
|
||
DO; IOBYTE = 0011$0000B; GO TO PUNL;
|
||
END;
|
||
/* CASE 15 IS PUN */
|
||
NTER OUTPUT */
|
||
DO; CALL PUTDESTC(':'); CALL PUTDESTC(' ');
|
||
END; ELSE
|
||
CALL PUTDESTC(TAB);
|
||
END NEW(B);
|
||
DECLARE B BYTE;
|
||
IF (ZEROSUP := ZEROSUP AND B = 0) THEN CALL PUTDESTC(' '); ELSE
|
||
CALL PUTDESTC('0'+B);
|
||
END;
|
||
END;
|
||
IF NUMB > 0 THEN
|
||
CALL NEWLINE;
|
||
PUTNUM = FALSE;
|
||
E (B,I) BYTE;
|
||
/* WRITE DESTINATION CHARACTER, TAB EXPANSION */
|
||
IF B <> TAB THEN CALL PUTDCHAR(B); ELSE
|
||
IF TABS = CHARACTER, CHECK TABS AND LINES */
|
||
IF FORMF THEN /* SKIP FORM FEEDS */
|
||
DO; IF B = FF THEN RETURN;
|
||
END;
|
||
PUNL:
|
||
CALL MON1(4,B);
|
||
/* CASE 16 IS TTY */
|
||
DO; IOBYTE = 0; GO TO CONL;
|
||
LINE;
|
||
|
||
CLEARBUFF: PROCEDURE;
|
||
/* CLEAR OUTPUT BUFFER IN BLOCK MODE TRANSMISION */
|
||
DECLARE NA ADDRESS;
|
||
DECLARE I END PRINT1;
|
||
|
||
PRINTDIG: PROCEDURE(D);
|
||
DECLARE D BYTE;
|
||
CALL PRINT1(SHR(D,4)); CALL PRINT1(D AND 1111B);
|
||
END PR END;
|
||
END;
|
||
IF BLOCK THEN /* BLOCK MODE TRANSFER */
|
||
DO;
|
||
IF B = XOFF AND PDEST = 0 THEN
|
||
0 THEN CALL PUTDCHAR(B); ELSE
|
||
/* B IS TAB CHAR, TABS > 0 */
|
||
DO; I = COLUMN;
|
||
DO WHILE I >= TABS;
|
||
IF PUTNUM THEN /* END OF LINE OR START OF FILE */
|
||
DO;
|
||
IF B <> FF THEN /* NOT FORM FEED */
|
||
DO; END;
|
||
/* CASE 17 IS CRT */
|
||
DO; IOBYTE = 1; GO TO CONL;
|
||
END;
|
||
/* CASE 18BYTE;
|
||
I = LOW(NDEST) AND 7FH; /* REMAINING PARTIAL BUFFER LENGTH */
|
||
NA = NDEST AND 0FF80H; /* START OF SEGMENT NOT DO; CALL CLEARBUFF; /* BUFFERS WRITTEN */
|
||
RETURN; /* DON'T PASS THE X-OFF */
|
||
END;
|
||
EB; GO TO RDRL;
|
||
END;
|
||
/* CASE 5 IS UR2 */
|
||
DO; IOBYTE = 0000$1100B; GO TO RDRL;
|
||
T IS ALTERED */
|
||
DO CASE PSOURCE;
|
||
/* CASE 0 IS SOURCE FILE */
|
||
DO; IF NSOURCE >= SBLEN THEN CALL FISE 19 IS CON */
|
||
CONL:
|
||
DO; CONCHK = FALSE; /* DON'T CHECK CONSOLE STATUS */
|
||
B = MO RETURN B;
|
||
END LTRAN;
|
||
|
||
GETSOURCEC: PROCEDURE BYTE;
|
||
/* READ NEXT SOURCE CHARACTER */
|
||
DECLARE (IOB,B,CONCHK) BYCE;
|
||
/* CASE 14 IS UP2 */
|
||
GO TO NOTSOURCE;
|
||
/* CASE 15 IS PUN */
|
||
NOTSOURCE:
|
||
ND;
|
||
IF B = FF THEN LINENO = 0;
|
||
CALL PUTDESTC(B);
|
||
IF B = LF THEN PUTNUM = TRUE;
|
||
END PUTDEST;
|
||
|
||
|
||
UTRAN: PROC END;
|
||
/* CASE 6 IS RDR */
|
||
RDRL:
|
||
B = MON2(3,0) AND 7FH;
|
||
/* CASE 7 IS OUT */
|
||
LLSOURCE;
|
||
B = SBUFF(NSOURCE);
|
||
NSOURCE = NSOURCE + 1;
|
||
END;
|
||
/* CASE 1 IS INP */
|
||
N2(1,0);
|
||
END;
|
||
END; /* OF CASES */
|
||
IOBYTE = IOB; /* RESTORE IOBYTE */
|
||
IF ECHO THEN /* COPY TOTE;
|
||
|
||
IF PSOURCE - 1 <= RDR THEN /* 1 ... RDR+1 */
|
||
DO; IF (BLOCK OR HEXT) AND CONBRK THEN
|
||
DO;
|
||
DO; CALL ERROR(.('NOT A CHARACTER SOURCE$'));
|
||
END;
|
||
/* CASE 16 IS TTY */
|
||
DO; IOEDURE(B) BYTE;
|
||
DECLARE B BYTE;
|
||
/* TRANSLATE ALPHA TO UPPER CASE */
|
||
IF B >= 110$0001B AND B <= 111$1010B THEN /* L
|
||
GO TO NOTSOURCE;
|
||
/* CASE 8 IS LPT */
|
||
GO TO NOTSOURCE;
|
||
/* CASE 9 IS UL1 */
|
||
B = INP;
|
||
/* CASE 2 IS IRD (INTEL/ICOM) */
|
||
B = INTIN;
|
||
/* CASE 3 IS PTR */
|
||
CONSOLE DEVICE */
|
||
DO; IOB = PDEST; PDEST = CONP; CALL PUTDEST(B);
|
||
PDEST = IOB;
|
||
END;
|
||
IF CONCHK T IF READCHAR = ENDFILE THEN RETURN ENDFILE;
|
||
CALL PRINT(.('READER STOPPING',CR,LF,'$'));
|
||
RETURN XOBYTE = 0; GO TO CONL;
|
||
END;
|
||
/* CASE 17 IS CRT */
|
||
DO; IOBYTE = 01B; GO TO CONL;
|
||
OWER CASE */
|
||
B = B AND 101$1111B; /* TO UPPER CASE */
|
||
RETURN B;
|
||
END UTRAN;
|
||
|
||
LTRAN: PROCEDURE(B) BYTE;
|
||
GO TO NOTSOURCE;
|
||
/* CASE 10 IS PRN */
|
||
GO TO NOTSOURCE;
|
||
/* CASE 11 IS LST */
|
||
GO TO DO; IOBYTE = 0000$0100B; GO TO RDRL;
|
||
END;
|
||
/* CASE 4 IS UR1 */
|
||
DO; IOBYTE = 0000$1000HEN /* TEST FOR CONSOLE CHAR READY */
|
||
DO;
|
||
IF SCOM THEN /* SOURCE IS A COM FILE */
|
||
CONCHK = (CONCNFF;
|
||
END;
|
||
END;
|
||
CONCHK = TRUE; /* CONSOLE STATUS CHECK BELOW */
|
||
IOB = IOBYTE; /* SAVE IT IN CASE I END;
|
||
/* CASE 18 IS UC1 */
|
||
DO; IOBYTE = 11B; GO TO CONL;
|
||
END;
|
||
/* CADECLARE B BYTE;
|
||
/* TRANSLATE TO LOWER CASE ALPHA */
|
||
IF B >= 'A' AND B <= 'Z' THEN B = B OR 10$0000B; /* TO LOWER */
|
||
NOTSOURCE;
|
||
/* CASE 12 IS PTP */
|
||
GO TO NOTSOURCE;
|
||
/* CASE 13 IS UP1 */
|
||
GO TO NOTSOURT := CONCNT + 1) = 0; ELSE /* ASCII */
|
||
CONCHK = B = LF;
|
||
IF CONCHK THEN
|
||
DO; IF CONBRK THEN
|
||
ND; ELSE
|
||
IF QUITS > 0 THEN /* PASS CHARACTERS TIL MATCH */
|
||
DO; IF MATCH(QUITS) THEN
|
||
DO; QUITS = 0; QU FOR START */
|
||
IF FEEDLEN > 0 THEN /* GET SEARCH CHARACTERS */
|
||
DO; FEEDLEN = FEEDLEN - 1;
|
||
CHAR = COMBUFF(FN TRUE;
|
||
END;
|
||
RETURN FALSE;
|
||
END DELIMITER;
|
||
|
||
PUTCHAR: PROCEDURE;
|
||
FCB(FLEN:=FLEN+1) =
|
||
IF (C:=COMBUFF(B:=(B+MATCHLEN))) = ENDFILE THEN /* END MATCH */
|
||
DO; COMBUFF(B) = CHAR; /* SAVE CURRENT CHCBA);
|
||
DECLARE FCBA ADDRESS, /* ADDRESS OF FCB TO FILL */
|
||
FCB BASED FCBA (FSIZE) BYTE; /* FCB TEMPLATE */
|
||
DO;
|
||
IF READCHAR = ENDFILE THEN RETURN ENDFILE;
|
||
CALL ERROR(.('ABORTED$'));
|
||
ITLEN = 2;
|
||
/* SUBSEQUENTLY RETURN CR, LF, ENDFILE */
|
||
RETURN CR;
|
||
END;
|
||
RETURN CHAREEDBASE);
|
||
FEEDBASE = FEEDBASE + 1;
|
||
RETURN CHAR;
|
||
END;
|
||
IF (CHAR := GETSOURCEC) = ENDFILE THEN RETU CHAR;
|
||
IF CHAR = WHAT THEN AMBIG = TRUE; /* CONTAINS AMBIGUOUS REF */
|
||
END PUTCHAR;
|
||
|
||
FILLQ: PROCEDURE(LENARACTER */
|
||
RETURN TRUE;
|
||
END;
|
||
IF C = CHAR THEN MATCHLEN = MATCHLEN + 1; ELSE
|
||
MATC DECLARE (I,J,K) BYTE; /* TEMP COUNTERS */
|
||
|
||
/* SCAN LOOKS FOR THE NEXT DELIMITER, DEVICE NAME, OR FILE NAME.
|
||
THE VALUE END;
|
||
END;
|
||
END;
|
||
IF ZEROP THEN B = B AND 7FH;
|
||
IF UPPER THEN RETURN UTRAN(B);
|
||
IF LO;
|
||
END; ELSE
|
||
RETURN CHAR;
|
||
END; /* OF DO FOREVER */
|
||
END GETSOURCE;
|
||
|
||
DECLARE DISK BYTE; /* SELRN ENDFILE;
|
||
IF STARTS > 0 THEN /* LOOKING FOR START STRING */
|
||
DO; IF MATCH(STARTS) THEN
|
||
DO; FEEDBASE );
|
||
/* FILL CURRENT NAME OR TYPE WITH QUESTION MARKS */
|
||
DECLARE LEN BYTE;
|
||
CHAR = WHAT; /* QUESTION MARHLEN = 0; /* NO MATCH */
|
||
RETURN FALSE;
|
||
END MATCH;
|
||
IF QUITLEN > 0 THEN
|
||
DO; IF (QUITLEN := QUITLEN OF CBP MUST BE 255 UPON ENTRY THE FIRST TIME */
|
||
|
||
DELIMITER: PROCEDURE(C) BYTE;
|
||
DECLARE (I,C) BYTE;
|
||
DECLWER THEN RETURN LTRAN(B);
|
||
RETURN B;
|
||
END GETSOURCEC;
|
||
|
||
GETSOURCE: PROCEDURE BYTE;
|
||
/* GET NEXT SOURCE CHARACTER */ECTED DISK */
|
||
|
||
GNC: PROCEDURE BYTE;
|
||
IF (CBP := CBP + 1) >= COMLEN THEN RETURN CR;
|
||
RETURN UTRAN(COMBUFF(CBP));
|
||
= STARTS; STARTS = 0;
|
||
FEEDLEN = MATCHLEN + 1;
|
||
END; /* OTHERWISE NO MATCH, SKIP CHARACTER */
|
||
EK */
|
||
DO WHILE FLEN < LEN;
|
||
CALL PUTCHAR;
|
||
END;
|
||
END FILLQ;
|
||
|
||
GETFCB: PROCEDUR - 1) = 1 THEN RETURN LF;
|
||
RETURN ENDFILE; /* TERMINATED WITH CR,LF,ENDFILE */
|
||
END;
|
||
DO FOREVER; /* LOOKINGARE DEL(*) BYTE DATA
|
||
(' =.:,<>',CR,LA,LB,RB);
|
||
DO I = 0 TO LAST(DEL);
|
||
IF C = DEL(I) THEN RETUR
|
||
DECLARE CHAR BYTE;
|
||
MATCH: PROCEDURE(B) BYTE;
|
||
/* MATCH START AND QUIT STRINGS */
|
||
DECLARE (B,C) BYTE; END GNC;
|
||
|
||
DEBLANK: PROCEDURE;
|
||
DO WHILE (CHAR := GNC) = ' ';
|
||
END;
|
||
END DEBLANK;
|
||
|
||
SCAN: PROCEDURE(FE(I) BYTE;
|
||
DECLARE I BYTE;
|
||
RETURN FCB(I);
|
||
END GETFCB;
|
||
|
||
SCANPAR: PROCEDURE;
|
||
DECLARE (I,' '; FLEN = 0;
|
||
DO WHILE FLEN < FSIZE-1;
|
||
IF FLEN = FNSIZE THEN CHAR = 0;
|
||
CALL PUTCHAR;
|
||
END;
|
||
CONT(I) = J;
|
||
IF I = 6 THEN /* SET SOURCE USER */
|
||
DO;
|
||
IF J > 31 THE IF (DISK := GETFCB(1) - 'A' + 1) > 26 THEN
|
||
/* ERROR, INVALID DISK NAME */ RETURN;
|
||
C' THEN
|
||
DO; /* START OR QUIT COMMAND */
|
||
J = CBP + 1; /* START OF STRING */
|
||
FLEN = 0;
|
||
DO WHILE NOT DELIMITER(CHAR);
|
||
IF FLEN >= NSIZE THEN /* ERROR, FILE NAME TOO LONG */
|
||
J) BYTE;
|
||
/* SCAN OPTIONAL PARAMETERS */
|
||
PARSET = TRUE;
|
||
SUSER = CUSER; /* SOURCE USER := CURRENT USER
|
||
/* DEBLANK COMMAND BUFFER */
|
||
CALL DEBLANK;
|
||
|
||
/* SAVE STARTING POSITION OF SCAN FOR DIAGNOSTICS */
|
||
TCBP N
|
||
CALL ERROR(.('INVALID USER NUMBER$'));
|
||
SUSER = J;
|
||
END;
|
||
ALL DEBLANK; /* MAY BE DISK NAME ONLY */
|
||
IF DELIMITER(CHAR) THEN
|
||
DO; IF CHAR = LB THEN
|
||
DO WHILE NOT ((CHAR := GNC) = ENDFILE OR CHAR = CR);
|
||
END;
|
||
CHAR=GNC;
|
||
RETURN;
|
||
IF CHAR = '*' THEN CALL FILLQ(NSIZE); ELSE CALL PUTCHAR;
|
||
CHAR = GNC;
|
||
*/
|
||
CHAR = GNC; /* SCAN PAST BRACKET */
|
||
DO WHILE NOT(CHAR = CR OR CHAR = RB);
|
||
IF (I := CHAR - = CBP;
|
||
|
||
/* MAY BE A SEPARATOR */
|
||
IF DELIMITER(CHAR) THEN
|
||
DO; CALL CHKSET;
|
||
TYPE = SPECL; RETURN;
|
||
END;
|
||
END;
|
||
CHAR = GNC;
|
||
END SCANPAR;
|
||
|
||
CHKSET: PROCEDURE;
|
||
IF CHAR = LA T CALL SCANPAR;
|
||
CBP = CBP - 1;
|
||
TYPE = DISKNAME;
|
||
|
||
END; ELSE
|
||
IF (J := (CHAR := GNC) - '0') > 9 THEN J = 1;
|
||
ELSE
|
||
END;
|
||
|
||
/* CHECK FOR DISK NAME OR DEVICE NAME */
|
||
IF CHAR = ':' THEN
|
||
DO; IF DISK <> 0 THEN RET'A') > 25 THEN /* NOT ALPHA */
|
||
DO; IF CHAR = ' ' THEN CHAR = GNC; ELSE
|
||
CALL ERROR(.('BAD PARAM END;
|
||
|
||
/* CHECK PERIPHERALS AND DISK FILES */
|
||
DISK = 0;
|
||
/* CLEAR PARAMETERS */
|
||
DO I = 0 TO 25; CONHEN CHAR = '=';
|
||
END CHKSET;
|
||
|
||
/* INITIALIZE FILE CONTROL BLOCK TO EMPTY */
|
||
AMBIG = FALSE; TYPE = ERR; CHAR = RETURN;
|
||
END;
|
||
END; ELSE
|
||
|
||
/* MAY BE A THREE CHARACTER DEVICE NAME */
|
||
DO WHILE (K := (CHAR := GNC) - '0') <= 9;
|
||
J = J * 10 + K;
|
||
END;
|
||
URN; /* ALREADY SET */
|
||
IF FLEN = 1 THEN
|
||
/* MAY BE DISK NAME A ... Z */
|
||
DO;
|
||
ETER$'));
|
||
END; ELSE
|
||
DO; /* SCAN PARAMETER VALUE */
|
||
IF CHAR = 'S' OR CHAR = 'QT(I) = 0;
|
||
END;
|
||
PARSET = FALSE;
|
||
FEEDLEN,MATCHLEN,QUITLEN = 0;
|
||
/* SCAN NEXT NAME */
|
||
DO FOREVER;
|
||
IF FLEN <> 3 THEN /* ERROR, CANNOT BE DEVICE NAME */
|
||
RETURN; ELSE
|
||
|
||
/* LOOK FOR DEVICE NAM;
|
||
IF CHAR = '.' THEN /* SCAN FILE TYPE */
|
||
DO WHILE NOT DELIMITER(CHAR := GNC);
|
||
RETURN;
|
||
END;
|
||
/* OTHERWISE TRY NEXT DEVICE */ J = J + 3;
|
||
EXT),FEXTL);
|
||
END MOVEXT;
|
||
|
||
EQUAL: PROCEDURE(A,B) BYTE;
|
||
/* COMPARE THE STRINGS AT A AND B UNTIL EITHER A MISMATCH OR
|
||
ESE DEVICES IN THE LIST */
|
||
J = 255;
|
||
DO K = 0 TO M;
|
||
I = 0;
|
||
CB(32) = 0;
|
||
RETURN;
|
||
END;
|
||
END;
|
||
END SCAN;
|
||
|
||
NULLS: PROCEDURE;
|
||
/* SEND 40 NULLS TO NAME */
|
||
DO; DECLARE (I,J,K) BYTE, M LITERALLY '20',
|
||
IO(*) BYTE DATA
|
||
('INPIRDP IF FLEN >= FNSIZE THEN
|
||
/* ERROR, TYPE FIELD TOO LONG */ RETURN;
|
||
IF CHAR = '*' THEN CALL FILLQ END;
|
||
|
||
/* ERROR, NO DEVICE NAME MATCH */ RETURN;
|
||
END;
|
||
IF CHAR = LB THEN / A '$' IS ENCOUNTERED IN STRING B */
|
||
DECLARE (A,B) ADDRESS,
|
||
(SA BASED A, SB BASED B) BYTE;
|
||
DO WHILE SB <> DO WHILE ((I:=I+1) <= 3) AND
|
||
IO(J+I) = GETFCB(I);
|
||
END;
|
||
OUTPUT DEVICE */
|
||
DECLARE I BYTE;
|
||
DO I = 0 TO 39; CALL PUTDEST(0);
|
||
END;
|
||
END NULLS;
|
||
|
||
|
||
DECLARE FEXTRUR1UR2RDROUTLPTUL1PRNLST',
|
||
'PTPUP1UP2PUNTTYCRTUC1CONNULEOF',0);
|
||
/* NOTE THAT ALL READER-LIK(FNSIZE);
|
||
ELSE CALL PUTCHAR;
|
||
END;
|
||
|
||
IF CHAR = LB THEN
|
||
CALL S* PARAMETERS FOLLOW */
|
||
CALL SCANPAR;
|
||
END; ELSE
|
||
|
||
/* CHAR IS NOT ':', SO FILE NAME IS SET.'$';
|
||
IF (SB AND 7FH) <> (SA AND 7FH) THEN RETURN FALSE;
|
||
A = A + 1; B = B + 1;
|
||
END;
|
||
RETURN TRUE;
|
||
IF I = 4 THEN /* COMPLETE MATCH */
|
||
DO; TYPE = PERIPH;
|
||
/* SCAN PARATH(FEXTL) BYTE, /* HOLDS DESTINATION FILE TYPE */
|
||
COPYING BYTE; /* TRUE WHILE COPYING TO DEST FILE */
|
||
E DEVICES MUST BE
|
||
PLACED BEFORE 'RDR', AND ALL LISTING-LIKE DEVICES
|
||
MUST APPEAR BELOW LST, BUTCANPAR;
|
||
/* RESCAN DELIMITER NEXT TIME AROUND */
|
||
CBP = CBP - 1;
|
||
TYPE = FILE;
|
||
SCAN REMAINDER */
|
||
DO; IF FLEN = 0 THEN /* ERROR, NO PRIMARY NAME */
|
||
RETURN;
|
||
FLEN = F
|
||
END EQUAL;
|
||
|
||
READ$EOF: PROCEDURE BYTE;
|
||
/* RETURN TRUE IF END OF FILE */
|
||
CHAR = GETSOURCE;
|
||
IF SCOM THEN RETURMETERS */
|
||
IF GNC = LB THEN CALL SCANPAR;
|
||
CBP = CBP - 1; CHAR = K;
|
||
|
||
|
||
MOVEXT: PROCEDURE(A);
|
||
DECLARE A ADDRESS;
|
||
/* MOVE THREE CHARACTER EXTENT INTO DEST FCB */
|
||
CALL MOVE(A,.DEST(F ABOVE RDR. THE LITERAL
|
||
DECLARATIONS FOR RDR, LST, AND PUNP MUST INDICATE
|
||
THE POSITIONS OF TH/* DISK IS THE SELECTED DISK (1 2 3 ... ) */
|
||
IF DISK = 0 THEN DISK = CDISK + 1; /* DEFAULT */
|
||
FCB(0),FN HARDEOF < NSOURCE;
|
||
RETURN CHAR = ENDFILE;
|
||
END READ$EOF;
|
||
|
||
|
||
HEXRECORD: PROCEDURE BYTE;
|
||
/* READ ONE RECORD INTO
|
||
/* READ TWO HEX DIGITS */
|
||
RETURN SHL(READHEX,4) OR READHEX;
|
||
END READBYTE;
|
||
|
||
READCS: PROCEDURE BRINTERR(.('RECORD TOO LONG$'));
|
||
RETURN I;
|
||
END;
|
||
RETURN ENDFILE; /* ON ERROR FLAG */
|
||
E
|
||
|
||
/* RECORD LENGTH IS NOT ZERO */
|
||
LDA = READADDR; /* LOAD ADDRESS */
|
||
|
||
/* READ WORDS UNTIL RECORD LENGTH EXH
|
||
CHECKXOFF: PROCEDURE;
|
||
IF XOFFSET THEN
|
||
DO; XOFFSET = FALSE;
|
||
CALL CLEARBUFF;
|
||
DO; CALL PRINT(.('END OF FILE, CTL-Z',WHAT,'$'));
|
||
IF READCHAR = ENDFILE THEN RETURN 1;
|
||
SBUFF AND CHECK FOR PROPER FORM
|
||
RETURNS 0 IF RECORD OK
|
||
RETURNS 1 IF END OF TAPE (:00000)
|
||
RETURNS 2 IYTE;
|
||
/* READ BYTE WITH CHECKSUM */
|
||
RETURN CS := CS + READBYTE;
|
||
END READCS;
|
||
|
||
READADDR: PROCEDUREND SAVECHAR;
|
||
|
||
DECLARE (M, RL, CS, RT) BYTE,
|
||
LDA ADDRESS; /* LOAD ADDRESS WHICH FOLLOWS : */
|
||
|
||
READHEX: PROCEAUSTED */
|
||
RT = READCS; /* RECORD TYPE */
|
||
DO WHILE RL <> 0 AND NOERRS; RL = RL - 1;
|
||
M = READCS;
|
||
END;
|
||
END CHECKXOFF;
|
||
|
||
SAVECHAR: PROCEDURE BYTE;
|
||
/* READ CHARACTER AND SAVE IN BUFFER */
|
||
DECLARE ELSE HSOURCE = 0;
|
||
END;
|
||
CALL CHECKXOFF;
|
||
END;
|
||
|
||
/* ':' FOUND */
|
||
F ERROR IN RECORD */
|
||
|
||
|
||
DECLARE XOFFSET BYTE; /* TRUE IF XOFF RECVD */
|
||
DECLARE NOERRS BYTE; /* TRUE IF NO ERROR ADDRESS;
|
||
/* READ DOUBLE BYTE WITH CHECKSUM */
|
||
RETURN SHL(DOUBLE(READCS),8) OR READCS;
|
||
END READADDR;
|
||
DURE BYTE;
|
||
DECLARE H BYTE;
|
||
IF (H := SAVECHAR) - '0' <= 9 THEN RETURN H-'0';
|
||
IF H - 'A' > 5 THEN
|
||
|
||
/* INCREMENT LA HERE FOR EXACT ADDRESS */
|
||
END;
|
||
|
||
/* CHECK SUM */
|
||
IF CS + READBYTE <> 0 THEN I BYTE;
|
||
IF NOERRS THEN
|
||
DO;
|
||
DO WHILE (I := GETSOURCE) = XOFF; XOFFSET = TRUE;
|
||
CS = 0;
|
||
IF (RL := READCS) = 0 THEN /* END OF TAPE */
|
||
DO; DO WHILE (RL := SAVECHAR) <> ENDFILE;
|
||
S IN THIS RECORD */
|
||
|
||
PRINTERR: PROCEDURE(A);
|
||
/* PRINT ERROR MESSAGE IF NOERRS TRUE */
|
||
DECLARE A ADDRESS;
|
||
|
||
NOERRS = TRUE; /* NO ERRORS DETECTED IN THIS RECORD */
|
||
|
||
/* READ NEXT RECORD */
|
||
/* SCAN FOR THE ':' */
|
||
CALL PRINTERR(.('INVALID DIGIT$'));
|
||
RETURN H - 'A' + 10;
|
||
END READHEX;
|
||
|
||
READBYTE: PROCEDURE BYTE;
|
||
CALL PRINTERR(.('CHECKSUM ERROR$'));
|
||
|
||
CALL CHECKXOFF;
|
||
IF NOERRS THEN RETURN 0;
|
||
RETURN 2;
|
||
END END;
|
||
HBUFF(HSOURCE) = I;
|
||
IF (HSOURCE := HSOURCE + 1) >= LAST(HBUFF) THEN
|
||
CALL P CALL CHECKXOFF;
|
||
END;
|
||
IF NOERRS THEN RETURN 1;
|
||
RETURN 2;
|
||
END;
|
||
IF NOERRS THEN
|
||
DO; NOERRS = FALSE;
|
||
CALL PRINT(A);
|
||
END;
|
||
END PRINTERR;
|
||
HSOURCE = 0;
|
||
DO WHILE (CS := SAVECHAR) <> ':';
|
||
HSOURCE = 0;
|
||
IF CS = ENDFILE THEN
|
||
HEXRECORD;
|
||
|
||
READTAPE: PROCEDURE;
|
||
/* READ HEX FILE FROM HIGH SPEED READER TO 'HEX' FILE,
|
||
CHECK EACH RECORD FOR VALID E IMMEDIATE READ */
|
||
SCOM = EQUAL(.SOURCE(FEXT),.('COM$'));
|
||
NSOURCE = SBLEN;
|
||
END SETUPSOURCE;
|
||
|
||
CHECK$STRINGS: PRE OLD $$$ FILE */
|
||
CALL MAKE(.DEST); /* CREATE A NEW ONE */
|
||
IF DCNT = 255 THEN CALL ERROR(.('NO DIRECTORY SPACE$'));
|
||
|
||
IF UTRAN(READCHAR) <> 'Y' THEN
|
||
DO; CALL PRINT(.('**NOT DELETED**$'));
|
||
ORRECT ERROR, TYPE RETURN OR CTL-Z$'));
|
||
CALL CRLF;
|
||
IF READCHAR = ENDFILE THEN RETURN;
|
||
END;
|
||
END RLL CHECK$STRINGS;
|
||
CALL WRITEDEST;
|
||
CALL SELECT(DDISK);
|
||
CALL CLOSE(.DEST);
|
||
IF DCNT = 255 THEN
|
||
CALL ERDIGITS, AND PROPER CHECKSUM */
|
||
DECLARE (I,A) BYTE;
|
||
DO FOREVER;
|
||
DO WHILE (I := HEXRECORD) <= 1;
|
||
OCEDURE;
|
||
IF STARTS > 0 THEN
|
||
CALL ERROR(.('START NOT FOUND$'));
|
||
IF QUITS > 0 THEN
|
||
CALL ERROR(.('QUIT DEST(32),NDEST = 0;
|
||
END SETUPDEST;
|
||
|
||
SETUPSOURCE: PROCEDURE;
|
||
HARDEOF = 0FFFFH;
|
||
CALL SETSUSER; /* SOURCE USER CALL CRLF;
|
||
CALL MOVEXT(.('$$$'));
|
||
CALL DELETE(.DEST);
|
||
RETURN;
|
||
EADTAPE;
|
||
|
||
FORMERR: PROCEDURE;
|
||
CALL ERROR(.('INVALID FORMAT$'));
|
||
END FORMERR;
|
||
|
||
SETUPDEST: PROCEDURE;
|
||
CALL SELEROR(.('CANNOT CLOSE DESTINATION FILE$'));
|
||
CALL MOVEXT(.FEXTH); /* RECALL ORIGINAL TYPTE */
|
||
DEST(12) = 0;
|
||
CALL OPEN( IF NOT (I = 1 AND IGNOR) THEN
|
||
DO A = 1 TO HSOURCE;
|
||
CALL PUTDEST(HBUFF(A-1));
|
||
NOT FOUND$'));
|
||
END CHECK$STRINGS;
|
||
|
||
CLOSEDEST: PROCEDURE(DIRECT);
|
||
DECLARE DIRECT BYTE;
|
||
/* DIRECT IS TRUE IF SEC*/
|
||
CALL SELECT(SDISK);
|
||
CALL OPEN(.SOURCE);
|
||
CALL SETCUSER; /* BACK TO CURRENT USER */
|
||
IF (NOT RSYS) AND ROL(S END;
|
||
CALL CRLF;
|
||
END;
|
||
DEST(ROFILE) = DEST(ROFILE) AND 7FH;
|
||
CT(DDISK);
|
||
DHEX = EQUAL(.DEST(FEXT),.('HEX$'));
|
||
CALL MOVE(.DEST(FEXT),.FEXTH,FEXTL); /* SAVE TYPE */
|
||
DEST(ROFILE).DEST);
|
||
IF DCNT <> 255 THEN /* FILE EXISTS */
|
||
DO;
|
||
IF ROL(DEST(ROFILE),1) THEN /* READ ONLY */
|
||
END;
|
||
CALL PUTDEST(CR); CALL PUTDEST(LF);
|
||
IF I = 1 THEN /* END OF TAPE ENCOUNTERED */
|
||
TOR-BY-SECTOR COPY */
|
||
IF DIRECT THEN
|
||
/* GET UNFILLED BYTES FROM SOURCE BUFFER */
|
||
DFUB = SFUB; ELSE DFUB =OURCE(SYSFILE),1) THEN
|
||
DCNT = 255;
|
||
IF DCNT = 255 THEN CALL ERROR(.('NO FILE$'));
|
||
SOURCE(32) = 0;
|
||
/* CAUS CALL SETIND(.DEST);
|
||
END;
|
||
CALL DELETE(.DEST);
|
||
END;
|
||
CALL MOVE(.DEST,.DEST(16),16); / = DEST(ROFILE) AND 7FH;
|
||
DEST(SYSFILE)= DEST(SYSFILE)AND 7FH;
|
||
CALL MOVEXT(.('$$$'));
|
||
CALL DELETE(.DEST); /* REMOV DO;
|
||
IF NOT WRROF THEN
|
||
DO;
|
||
CALL PRINT (.('DESTINATION IS R/O, DELETE (Y/N)?$')); RETURN;
|
||
END;
|
||
CALL CRLF; HBUFF(HSOURCE) = '$';
|
||
CALL PRINT(.HBUFF);
|
||
CALL PRINT(.('C 0;
|
||
DO WHILE (LOW(NDEST) AND 7FH) <> 0;
|
||
DFUB = DFUB + 1;
|
||
CALL PUTDEST(ENDFILE);
|
||
END;
|
||
CA* READY FOR RENAME */
|
||
CALL MOVEXT(.('$$$'));
|
||
CALL RENAME(.DEST);
|
||
END CLOSEDEST;
|
||
|
||
SIZE$NBUF: PROCEDURE;
|
||
/* ERS */
|
||
DO I = 0 TO 25;
|
||
IF CONT(I) <> 0 THEN
|
||
DO;
|
||
IF NOT(I=6 OR I=14 OR I=17 OR I=21 O NOT READ$EOF;
|
||
CALL PUTDEST(CHAR);
|
||
END;
|
||
IF RESIZED THEN
|
||
DO; CALL CLEARBUFF;
|
||
CALL SIZE$M
|
||
/* FIND A MATCHING ENTRY */
|
||
CALL SETSUSER; /* SOURCE USER */
|
||
CALL SELECT(SDISK);
|
||
CALL SETDMINATION BUFFERS */
|
||
SBASE = .MEMORY + SHR(MEMSIZE - .MEMORY,1);
|
||
SBLEN, DBLEN = SHR((MEMSIZE - .MEMORY) AND 0FF00H,1);
|
||
CLOSEDEST(FASTCOPY);
|
||
END SIMPLECOPY;
|
||
|
||
MULTCOPY: PROCEDURE;
|
||
DECLARE (NEXTDIR, NDCNT, NCOPIED) ADDRESS;
|
||
PRNAME: PCOMPUTE NUMBER OF BUFFERS - 1 FROM DBLEN */
|
||
NBUF = (SHR(DBLEN,7) AND 0FFH) - 1;
|
||
/* COMPUTED AS DBLEN/128-1, WHERE DBLER I=22) THEN
|
||
/* NOT OBJ OR VERIFY */
|
||
FASTCOPY = FALSE;
|
||
END;
|
||
END;
|
||
IF FASTCOPEMORY;
|
||
END;
|
||
END COPYCHAR;
|
||
|
||
SIMPLECOPY: PROCEDURE;
|
||
DECLARE (FASTCOPY,I) BYTE;
|
||
REAL$EOF: PROCEDURE BYTE;A(.BUFFER);
|
||
CALL SEARCH(.SEARFCB);
|
||
NDCNT = 0;
|
||
DO WHILE (DCNT <> 255) AND NDCNT < NEXTDIR;
|
||
CALL SIZE$NBUF;
|
||
END SIZE$MEMORY;
|
||
|
||
COPYCHAR: PROCEDURE;
|
||
/* PERFORM THE ACTUAL COPY FUNCTION */
|
||
DECLARE RESIZROCEDURE;
|
||
/* PRINT CURRENT FILE NAME */
|
||
DECLARE (I,C) BYTE;
|
||
CALL CRLF;
|
||
DO I = 1 TO FNSIZN <= 32K (AND THUS
|
||
NBUF RESULTS IN A VALUE <= 2**15/2**7-1 = 2**8-1 = 255) */
|
||
END SIZE$NBUF;
|
||
|
||
SET$DBLEN: PROCEDURE;
|
||
Y THEN /* COPY DIRECTLY TO DBUFF */
|
||
DO; CALL SET$DBLEN; /* EXTEND DBUFF */
|
||
DO WHILE NOT REAL$EOF;
|
||
|
||
RETURN HARDEOF <> 0FFFFH;
|
||
END REALEOF;
|
||
CALL SIZE$MEMORY;
|
||
TCBP = MCBP; /* FOR ERROR TRACING */
|
||
NDCNT = NDCNT + 1;
|
||
CALL SEARCHN;
|
||
END;
|
||
CALL SETCUSER;
|
||
/* FILE CONTROL BLOCK IN ED BYTE; /* TRUE IF SBUFF AND DBUFF COMBINED */
|
||
IF (RESIZED := (BLOCK AND PSOURCE <> 0)) THEN /* BLOCK MODE */
|
||
CALE;
|
||
IF (C := DEST(I)) <> ' ' THEN
|
||
DO; IF I = FEXT THEN CALL PRINTCHAR('.');
|
||
CA
|
||
/* ABSORB THE SOURCE BUFFER INTO THE DEST BUFFER */
|
||
SBASE = .MEMORY;
|
||
IF DBLEN >= 4000H THEN DBLEN = 7F80H; ELSE
|
||
CALL FILLSOURCE;
|
||
IF REAL$EOF THEN
|
||
NDEST = HARDEOF; ELSE NDEST = DBLEN;
|
||
CALL WRITCALL SETUPDEST;
|
||
CALL SETUPSOURCE;
|
||
/* FILES READY FOR DIRECT COPY */
|
||
FASTCOPY = TRUE;
|
||
/* LOOK FOR PARAMETBUFFER */
|
||
IF DCNT = 255 THEN
|
||
DO; IF NCOPIED = 0 THEN
|
||
CALL ERROR(.('NOT FOUND$')); CALL CRLF;
|
||
L SET$DBLEN; /* ABSORB SOURCE BUFFER */
|
||
IF HEXT OR IGNOR THEN /* HEX FILE */
|
||
CALL READTAPE; ELSE
|
||
DO WHILELL PRINTCHAR(C);
|
||
END;
|
||
END;
|
||
END PRNAME;
|
||
|
||
NEXTDIR,NCOPIED = 0;
|
||
DO FOREVER; DBLEN = DBLEN + SBLEN;
|
||
CALL SIZE$NBUF;
|
||
END SET$DBLEN;
|
||
|
||
SIZE$MEMORY: PROCEDURE;
|
||
/* SET UP SOURCE AND DESTEDEST;
|
||
END;
|
||
CALL SIZE$MEMORY; /* RESET TO TWO BUFFERS */
|
||
END; ELSE
|
||
CALL COPYCHAR;
|
||
CALL
|
||
RETURN;
|
||
END;
|
||
NEXTDIR = NDCNT + 1;
|
||
/* GET THE FILE CONTROL BLOCK NAME TO DEST */
|
||
VERSION < CPMVERSION THEN
|
||
DO;
|
||
CALL PRINT(.('REQUIRES CP/M 2.0 OR NEWER FOR OPERATION.$'));
|
||
CALL BOOT;
|
||
ENLL SET$SDISK;
|
||
CALL CHECK$EOL;
|
||
CALL MOVE(.SOURCE,COPYFCB,33);
|
||
CALL CHECK$DISK;
|
||
END SCANDEST;
|
||
|
||
SCANEQL: PROCURCE);
|
||
/* MAY BE MULTI COPY */
|
||
IF TYPE <> FILE THEN CALL FORMERR;
|
||
IF AMBIG THEN
|
||
DO; CALL
|
||
END SET$SDISK;
|
||
|
||
SET$DDISK: PROCEDURE;
|
||
IF PARSET THEN /* PARAMETERS PRESENT */ CALL FORMERR;
|
||
IF DISK > 0 THEN DNSOLE IF NOT A ONELINER */
|
||
IF MULTCOM THEN
|
||
DO; CALL PRINTCHAR('*'); CALL READCOM;
|
||
CALL CRLF;
|
||
END CALL MOVE(.BUFFER+SHL(DCNT AND 11B,5),.DEST,16);
|
||
DEST(0) = 0;
|
||
DEST(12) = 0;
|
||
CALL MOVE(.DEST,.SOURCE,16); /* FID;
|
||
/* GET CURRENT USER */
|
||
CUSER = GETUSER;
|
||
/* GET CURRENT DISK */
|
||
CDISK = MON2(25,0);
|
||
|
||
RETRY:
|
||
/* ENTER HERE OEDURE;
|
||
CALL SCAN(.SOURCE);
|
||
IF NOT (TYPE = SPECL AND CHAR = '=') THEN CALL FORMERR;
|
||
MCBP = CBP; /* FOR ERROR PRINT SCANDEST(.SEARFCB);
|
||
CALL MULTCOPY;
|
||
END; ELSE
|
||
DO; CALL SCANDEST(.DEST);
|
||
/* FDISK = DISK - 1; ELSE DDISK = CDISK;
|
||
END SET$DDISK;
|
||
|
||
CHECK$DISK: PROCEDURE;
|
||
IF SUSER <> CUSER THEN /* DIFFERENT DISK;
|
||
CBP = 255;
|
||
IF COMLEN = 0 THEN /* SINGLE CARRIAGE RETURN */
|
||
DO; CALL SELECT(CDISK);
|
||
CALL BOOT;
|
||
LL BOTH FCB'S */
|
||
IF RSYS OR NOT ROL(DEST(SYSFILE),1) THEN /* OK TO READ */
|
||
DO;
|
||
IF (NCOPIED :=N ERROR EXIT FROM THE PROCEDURE 'ERROR' */
|
||
CALL SIZE$MEMORY;
|
||
/* MAIN PROCESSING LOOP. PROCESS UNTIL CR ONLY */
|
||
DING */
|
||
END SCANEQL;
|
||
|
||
|
||
PIPENTRY:
|
||
/* BUFFER AT 80H CONTAINS REMAINDER OF LINE TYPED
|
||
FOLLOWING THE COMMAND 'PIP' - IFORM IS A:=B:UFN */
|
||
CALL SIMPLECOPY;
|
||
END;
|
||
GO TO ENDCOM;
|
||
END;
|
||
|
||
|
||
IF TYPE <> FILE OS */
|
||
RETURN;
|
||
IF DDISK = SDISK THEN CALL FORMERR;
|
||
END CHECK$DISK;
|
||
|
||
CHECK$EOL: PROCEDURE;
|
||
CALL DEBLANK;
|
||
END;
|
||
|
||
/* LOOK FOR SPECIAL CASES FIRST */
|
||
DDISK,SDISK,PSOURCE,PDEST = 0;
|
||
CALL SCAN(.DEST);
|
||
IF TYPE = PERIPH NCOPIED + 1) = 1 THEN
|
||
CALL PRINT(.('COPYING -$'));
|
||
CALL PRNAME;
|
||
CALL SIMPLECOPY;
|
||
O FOREVER;
|
||
SUSER = CUSER;
|
||
C1, C2, C3 = 0; /* LINE COUNT = 000000 */
|
||
PUTNUM = TRUE; /* ACTS LIKE LF OCCURRED ON AS ZERO THEN PROMPT TIL CR */
|
||
CALL MOVE(.BUFF,.COMLEN,80H);
|
||
MULTCOM = COMLEN = 0;
|
||
|
||
/* GET CURRENT CP/M VERSION */
|
||
IF R AMBIG THEN CALL FORMERR;
|
||
CALL SET$DDISK;
|
||
CALL SCANEQL;
|
||
CALL SCAN(.SOURCE);
|
||
IF TYPE = DISKNAME THEN
|
||
|
||
IF CHAR <> CR THEN CALL FORMERR;
|
||
END CHECK$EOL;
|
||
|
||
SCANDEST: PROCEDURE(COPYFCB);
|
||
DECLARE COPYFCB ADDRESS;
|
||
CA THEN GO TO SIMPLECOM;
|
||
IF TYPE = DISKNAME THEN
|
||
DO; DDISK = DISK - 1;
|
||
CALL SCANEQL;
|
||
CALL SCAN(.SO END;
|
||
END;
|
||
END MULTCOPY;
|
||
|
||
SET$SDISK: PROCEDURE;
|
||
IF DISK > 0 THEN SDISK = DISK - 1; ELSE SDISK = CDISK;CII FILE */
|
||
CONCNT,COLUMN = 0; /* PRINTER TABS */
|
||
LINENO = 254; /* INCREMENTED TO 255 > PAGCNT */
|
||
/* READ FROM CO DO;
|
||
CALL SET$SDISK; CALL CHECK$DISK;
|
||
CALL MOVE(.DEST,.SOURCE,33);
|
||
CALL CHECK$EOL;
|
||
CALL SIM ERROR(.('CANNOT READ$'));
|
||
|
||
|
||
SCOM = SCOM OR OBJ; /* MAY BE ABSOLUTE COPY */
|
||
PSOURCE = CHAR + 1;
|
||
IF CHAR =OR(.('INVALID PIP FORMAT$'));
|
||
|
||
/* OTHERWISE SCAN AND COPY UNTIL CR */
|
||
COPYING = TRUE;
|
||
DO WHILE COPYING;
|
||
|
||
COMLEN = MULTCOM;
|
||
|
||
END; /* DO FOREVER */
|
||
END;
|
||
ALL ERROR(.('UNRECOGNIZED DESTINATION$'));
|
||
|
||
DHEX = FALSE;
|
||
IF TYPE = FILE THEN
|
||
DO; /* DESTINATION IS A FILE, T SOURCE */
|
||
CALL SCAN(.SOURCE);
|
||
IF TYPE <> SPECL OR (CHAR <> ',' AND CHAR <> CR) THEN
|
||
CALL ERROR(PLECOPY;
|
||
GO TO ENDCOM;
|
||
END;
|
||
/* MAY BE POSSIBLE TO DO A FAST DISK COPY */
|
||
IF TYPE = FILE THEN /* FILE NULP THEN CALL NULLS; ELSE
|
||
IF CHAR = EOFP THEN CALL PUTDEST(ENDFILE); ELSE
|
||
DO; /* DISK COPY */
|
||
IF SUSER = CUSER;
|
||
CALL SCAN(.SOURCE);
|
||
/* SUSER MAY HAVE BEEN RESET */
|
||
SCOM = FALSE;
|
||
IF TYP裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹SAVE EXTENT NAME */
|
||
CALL SET$DDISK;
|
||
CALL SETUPDEST;
|
||
CHAR = 255;
|
||
END; ELSE
|
||
/* PERIPHERAL.('INVALID SEPARATOR$'));
|
||
|
||
COPYING = CHAR <> CR;
|
||
END;
|
||
|
||
/* IF NECESSARY, CLOSE FILE OR PUNCH TRAILER */
|
||
TO FILE */
|
||
DO; CALL DEBLANK; IF CHAR <> CR THEN GO TO SIMPLECOM;
|
||
/* FILE TO FILE */
|
||
CALL SET$SDISK;
|
||
(CHAR < HSRDR AND DHEX) THEN HEXT = 1;
|
||
/* HEX FILE SET IF SOURCE IS RDR AND DEST IS HEX FILE */
|
||
IF PDEST =E = FILE AND NOT AMBIG THEN /* A SOURCE FILE */
|
||
DO;
|
||
CALL SET$SDISK;
|
||
CALL SETUPSOURCE;
|
||
裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹 NAME */
|
||
IF CHAR >= NULP OR CHAR <= RDR THEN CALL ERROR(.('CANNOT WRITE$'));
|
||
|
||
IF (PDEST := CHAR + 1) = PUNP THEN CALL
|
||
IF PDEST = PUNP THEN
|
||
DO; CALL PUTDEST(ENDFILE); CALL NULLS;
|
||
END;
|
||
IF PDEST = 0 THEN /* FILE HAS TO BE
|
||
CALL SIMPLECOPY;
|
||
GO TO ENDCOM;
|
||
END;
|
||
|
||
SIMPLECOM:
|
||
CBP = 255; /* READY FOR RESCAN */
|
||
|
||
/* OT PRNT THEN
|
||
DO; NUMB = 1;
|
||
IF TABS = 0 THEN TABS = 8;
|
||
IF PAGCNT = 0 THEN PAGCNT = 1;
|
||
CHAR = 255;
|
||
END; ELSE
|
||
|
||
IF TYPE <> PERIPH OR (CHAR <= LST AND CHAR > RDR) THEN
|
||
CALL裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹 NULLS;
|
||
|
||
/* NOW SCAN THE DELIMITER */
|
||
CALL SCAN(.SOURCE);
|
||
IF TYPE <> SPECL OR CHAR <> '=' THEN
|
||
CALL ERR CLOSED AND RENAMED */
|
||
CALL CLOSEDEST(FALSE);
|
||
|
||
/* COMLEN SET TO 0 IF NOT PROCESSING MULTIPLE COMMANDS */
|
||
ENDCOM:HERWISE PROCESS SIMPLE REQUEST */
|
||
CALL SCAN(.DEST);
|
||
IF (TYPE < FILE) OR AMBIG THEN /* DELIMITER OR ERROR */
|
||
C
|
||
END;
|
||
CALL COPYCHAR;
|
||
END;
|
||
|
||
CALL CHECK$STRINGS;
|
||
/* READ ENDFILE, GO TO NEX裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹3 0A3D 184
|
||
0A44 185 0A4B 186 0A4E 187 0A4F 188 0A4F 190
|
||
0A55 191 0A5C 192 0A5F 193 0A6E 194 0A7B 195
|
||
0A89 197 0A91 198 0A97 1916 114 091F 115
|
||
091F 116 0923 118 092E 119 092F 120 092F 121
|
||
0936 122 0937 123 0937 124 093E 125 093F 126
|
||
0945 128 094F 129 0D3A 320
|
||
0D44 321 0D4E 322 0D51 323 0D59 324 0D62 325
|
||
0D66 326 0D6B 327 0D6E 328 0D6E 329 0D76 330
|
||
0D7B 331 0D7C 332 0D80 334 42 080A 43 0813 44 0813 45
|
||
0813 46 081C 47 081C 49 0820 51 082D 52
|
||
082E 53 082E 54 0833 55 0838 56 0839 57
|
||
083F 5B 262 0C2E 263
|
||
0C31 264 0C34 265 0C37 266 0C3A 267 0C3D 268
|
||
0C46 269 0C50 270 0C50 271 0C55 272 0C58 273
|
||
0C5B 274 0C5B 275 0C裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹99 0A9D 200 0AA4 201
|
||
0AAA 202 0AAD 203 0AB7 204 0ABE 205 0AC4 206
|
||
0AC7 207 0AC8 208 0AC8 212 0ADA 213 0ADB 214
|
||
0AE1 215 0AE8 094F 130 0955 132 095F 133
|
||
095F 134 0965 136 096E 137 096F 140 096F 141
|
||
0974 142 097C 143 097D 145 097D 146 0986 147
|
||
0986 149 0D91 335 0D99 336
|
||
0DA2 337 0DA3 338 0DA7 340 0DB4 341 0DBD 342
|
||
0DBE 343 0DBE 345 0DC3 346 0DCE 347 0DD6 348
|
||
0DDF 349 0DE8 359 0842 60 084B 61 084C 63 084C 64
|
||
0855 65 0855 66 0855 67 085D 68 085E 69
|
||
0862 71 086D 72 086E 73 0874 75 0880 76
|
||
60 276 0C63 277 0C66 278
|
||
0C66 279 0C6B 280 0C6E 281 0C71 282 0C7F 283
|
||
0C7F 284 0C84 285 0C87 286 0C8A 287 0C8A 288
|
||
0C8F 289 0裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹216 0AEE 217 0AFD 218 0B07 219
|
||
0B0F 220 0B1A 221 0B20 222 0B2A 223 0B31 224
|
||
0B38 226 0B3E 227 0B44 228 0B53 229 0B61 230
|
||
0B68 098C 151 0995 152 0996 153 0996 155
|
||
099A 156 099E 157 09A7 158 09AA 159 09AF 160
|
||
09AF 162 09B5 164 09B8 165 09C0 166 09C5 1670 0DEF 351 0DF6 352 0DFD 353
|
||
0E05 355 0E0A 356 0E0F 357 0E12 358 0E17 359
|
||
0E18 360 0E18 363 0E21 364 0E2A 365 0E2D 366
|
||
0E3C 3
|
||
0881 77 0887 79 0893 80 0894 81 089A 83
|
||
08A6 84 08A7 85 08A7 86 08B2 87 08B3 88
|
||
08B9 90 08C2 91 08C3 92 08C9 94 0C92 290 0C95 291 0C95 292 0C9A 293
|
||
0C9D 294 0CA0 295 0CAE 296 0CAE 297 0CB3 298
|
||
0CB6 299 0CB9 300 0CB9 301 0CBE 302 0CC1 303
|
||
裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹 231 0B6D 232 0B7B 233 0B9B 234 0B9F 235
|
||
0BA2 236 0BAC 237 0BB3 238 0BB9 239 0BC0 240
|
||
0BC9 241 0BC9 242 0BCF 243 0BD0 244 0BD4
|
||
09CA 168 09DA 169 09E4 170 09F1 171 09F8 172
|
||
09FD 173 0A03 174 0A0B 175 0A11 176 0A14 177
|
||
0A17 178 0A18 179 0A27 182 0A33 1867 0E44 368 0E45 369 0E49 371 0E50 373
|
||
0E58 374 0E59 375 0E59 376 0E60 378 0E68 380
|
||
0E73 382 0E7B 383 0E80 384 0E8E 386 0E93 38D3 95
|
||
08D3 96 08D9 98 08E3 99 08E3 100 08E9 102
|
||
08F5 103 08F6 104 08FC 106 0905 107 0906 109
|
||
090C 111 0915 112 0916 113 00CC4 304 0CC4 305 0CC9 306 0CCC 307 0CCF 308
|
||
0CDD 309 0D05 310 0D0B 311 0D0C 312 0D10 314
|
||
0D18 315 0D22 316 0D2A 317 0D34 319 0000 PIP#
|
||
0000 PIPMOD#
|
||
07E6 14 07EA 16 07F2 17 07F3 18 07F3 19
|
||
07FB 20 07FF 21 07FF 22 07FF 23 0804 24
|
||
0809 25 080A 246
|
||
0BDC 248 0BE0 249 0BE9 251 0BF3 252 0BF4 253
|
||
0BF4 254 0BF4 255 0BFA 256 0C0A 257 0C0A 258
|
||
0C16 259 0C19 260 0C24 261 0C287
|
||
0E98 388 0E98 389 0E98 390 0EA1 391 0EA4 392
|
||
0EA9 393 0EA9 394 0EA9 395 0EB0 397 0EC8 399
|
||
0ECB 400 0ECC 401 0ECC 402 0ECC 593 1486 594 1487 595 148B 597 1490 598
|
||
149A 599 149D 600 14A0 601 14A1 602 14A5 604
|
||
14B1 605 14B1 606 14B1 608 14B6 609 14BC
|
||
11EA 527 11EF 528 11F2 529 110D 530 1116 532
|
||
1122 533 1125 534 1128 535 1128 536 1128 537
|
||
1131 539 1135 540 1141 541 1145 5433 1402 734 140A 735 140D 736 1411 737
|
||
1416 738 141E 739 1425 740 1433 741 1434 742
|
||
1434 743 1437 744 15CF 745 15CF 747 15DD 705 464
|
||
1008 465 1008 466 100E 467 1011 468 1011 469
|
||
1016 470 1019 471 101C 472 101C 473 1021 474
|
||
1024 475 1027 476 1027 477 112AA 671 12B5 672 12BD 673 12BE 674 12C6 675
|
||
12CE 676 12D1 677 12D7 678 12DA 679 12E2 681
|
||
12EA 682 12EB 683 12F3 685 1305 686 403 0ED4 404
|
||
0ED9 405 0EE0 406 0EE8 407 0EED 408 0EEE 409
|
||
0EF2 411 0F09 412 0F11 413 0F15 414 0F15 415
|
||
0F19 417 0F30 418 0F38 610
|
||
14C2 611 14DA 612 14E9 614 14F1 615 14FA 616
|
||
1500 617 1503 619 151B 621 1522 622 153D 623
|
||
1540 624 1546 625 1549 626 1552 1146 543
|
||
1146 544 1151 545 1154 546 115D 548 1168 550
|
||
116E 551 1173 552 117A 553 117A 554 117D 555
|
||
1186 557 1191 559 1196 548
|
||
15E2 749 15E9 750 15EA 752 15F0 754 15FC 755
|
||
15FD 756 1607 758 1610 759 1623 760 1626 761
|
||
162D 762 1634 763 1637 764 163A 02C 478 102F 479
|
||
1032 480 1032 481 1037 482 1042 483 1045 484
|
||
106D 485 1073 486 107A 488 1080 489 1085 490
|
||
108C 491 1092 492 1306 687
|
||
1309 688 1314 690 131C 691 131F 692 1323 693
|
||
1328 694 1329 695 1329 696 132C 697 1334 698
|
||
1335 701 133A 702 1346 703 419 0F3C 420 0F3C 421
|
||
0F3C 423 0F47 425 0F59 427 0F61 428 0F64 429
|
||
0F6A 430 0F6D 431 0F6D 432 0F6D 433 0F72 434
|
||
0F78 435 0F8B 627 1563 628
|
||
1575 629 158A 630 158D 631 159A 632 15A2 634
|
||
15AB 635 15B1 636 15B7 637 15B7 638 15B7 639
|
||
15BA 640 15C0 641 1560 119B 561 119E 562
|
||
119E 563 11A2 564 11A5 565 11A9 566 11AC 567
|
||
11F2 569 11F2 570 1200 571 1203 572 1211 573
|
||
1211 574 1211 765 163A 766
|
||
163A 767 1640 768 1647 769 1652 770 165B 771
|
||
165B 772 1712 775 1718 777 171F 779 1724 780
|
||
172C 781 172C 782 172D1092 493 1099 495 10A0 496
|
||
10B2 497 10BD 498 10C4 500 10CB 502 10D3 503
|
||
10D6 504 10DC 505 10DC 506 10DC 507 10DC 508
|
||
10E3 509 134B 704 137B 705
|
||
137E 706 1386 708 138B 709 1393 710 1396 711
|
||
139A 712 13A0 713 13A1 714 13A1 715 13A9 716
|
||
13B0 717 13B1 718 436 0F88 437 0F94 438 0F97 439
|
||
0FA3 440 0FAA 441 0FAD 442 0FB6 443 0FBF 444
|
||
0FBF 445 0FC4 446 0FC7 447 0FCA 448 0FCA 449
|
||
0FC1 642 15C1 643 15C9 644
|
||
15CE 645 1226 646 122B 647 1230 648 1233 649
|
||
1238 650 1240 651 1248 652 124D 653 1250 654
|
||
1253 655 1575 121C 576 121F 577 1220 578
|
||
1438 581 143C 584 144A 585 145A 586 145D 587
|
||
1464 588 1467 589 1467 590 1467 591 1479 592
|
||
1481 783 172D 784 1734 786
|
||
1739 787 173C 788 173C 789 173D 790 173D 792
|
||
1744 794 174F 795 1754 796 1757 797 1764 798
|
||
1770 799 177 10EB 510 10F2 511 10FA 512 1101 513
|
||
1109 514 110D 515 110D 516 11AD 518 11B1 520
|
||
11C9 522 11D6 523 11D9 524 11D9 525 11E3 5268 13B1 719 13B9 720 13BC 721
|
||
13BF 723 13C7 724 13C8 725 13CD 726 13D5 727
|
||
13E3 728 13EB 729 13EC 730 13F4 731 13FC 732
|
||
13FF 7CF 450 0FD2 451 0FD5 452 0FD5 453 0FDA 454
|
||
0FDD 455 0FE0 456 0FF0 457 0FF3 458 0FF6 459
|
||
0FF9 460 0FFC 461 0FFF 462 1002 463 10256 656 125C 657 1267 659 126A 660
|
||
126F 661 1270 662 1270 663 1275 664 1283 665
|
||
128E 666 1295 667 129A 668 12A5 669 12A5 670
|
||
6 800 177A 801 177A 802 177D 803
|
||
177D 805 177D 807 178C 808 1792 809 179E 810
|
||
17A4 811 17AC 812 17AC 813 17AC 814 17BB 815
|
||
1778 994 1AB2 995 1AB5 996
|
||
1ABB 997 1ABE 998 1AC1 999 1AC6 1000 1AD2 1001
|
||
1AE1 1003 1B1D 1004 1B22 1005 1B22 1006 1B29 1007
|
||
1B3931 1988 932 198D 933 1993 934
|
||
199B 936 19A3 938 19AA 940 19B0 941 19BC 943
|
||
19C2 944 19C5 945 19CB 946 19D1 947 19D2 948
|
||
19D216 051A 1117 0525 1118 052A 1119 0532 1120
|
||
0535 1121 053C 1123 0541 1124 0544 1125 0547 1126
|
||
0547 1127 054C 1128 0554 1130 055 184C 875 184F 876 1857 877 1858 878
|
||
185B 879 185C 880 185C 881 1862 882 1863 883
|
||
1863 884 186A 885 1876 886 1882 887 188A 8881064 1C42 1065 1C45 1066 1C45 1067 1C48 1068
|
||
1C88 1069 1C88 1070 1C91 1071 1C9B 1072 1CA1 1073
|
||
1CA2 1074 1CA2 1075 1CA9 1076 1BB 816 17BB 817 17C4 818 17C4 819 17C4 820
|
||
17DA 821 165B 822 1660 823 1665 824 1670 825
|
||
1675 826 167D 828 1683 829 168B 830 160 1009 1B33 1010 1B3A 1011 1B3D 1012 1B44 1013
|
||
1B4D 1014 1B53 1015 1B56 1016 1B59 1017 1B5C 1018
|
||
1B5F 1019 1B62 1020 1B69 1021 949 19D5 950 19D5 951 19DD 952 19E3 953
|
||
19E3 954 19E9 955 19E9 956 19F5 957 19FB 958
|
||
1A01 959 1A02 960 1A02 961 1A15 962 1A16B 1131 055E 1132
|
||
055E 1133 0570 1134 0576 1135 057E 1136 0581 1137
|
||
0589 1139 0590 1140 0593 1141 0599 1142 05A1 1143
|
||
05A4 114
|
||
1892 889 1898 890 189E 891 18A4 892 18AC 893
|
||
18B2 894 18BD 895 18BE 896 18BE 897 18C4 898
|
||
18C7 899 18CE 900 18D4 901 18D7 90CAC 1077 1CB5 1078
|
||
1CBF 1079 1CC5 1080 1CC6 1081 1CC6 1082 1CD0 1083
|
||
1CD1 1084 1CDB 1085 1CDE 1086 1CDF 1087 1CDF 1088
|
||
1CE2 18E 831
|
||
1693 832 1693 833 1696 834 1699 835 169E 836
|
||
16A9 838 16B4 839 16B7 840 16BA 841 16C1 842
|
||
16C4 843 16C7 844 16C7 845 1 1B78 1022 1C49 1024
|
||
1C49 1026 1C4C 1027 1C5A 1028 1C6C 1030 1C74 1031
|
||
1C79 1032 1C80 1033 1C80 1034 1C87 1035 1B78 1036
|
||
1B81 963
|
||
1A16 964 1A1C 965 1A28 966 1A31 967 1A3C 968
|
||
1A3F 969 1A40 970 1A40 971 1A56 972 1A68 973
|
||
1A6B 974 1A6C 975 1A6C 977 1A74 05AB 1146 05B1 1147 05B4 1148 05B7 1150
|
||
05BD 1151 05C0 1152 05C0 1153 05C3 1154 05C3 1155
|
||
05D3 1156 05D6 1157 05D9 1158 05DC2 18E7 903
|
||
18EC 904 18F4 905 18FA 906 18FF 907 190B 908
|
||
1911 909 1912 910 1912 911 191B 912 1921 913
|
||
192A 914 1930 915 1931 9089 1CEA 1090 1CED 1091 1CEE 1092 1CF4 1094
|
||
1CF7 1095 1CFA 1096 1D08 1097 1D0B 1098 1D0C 1099
|
||
1D0C 1100 1D12 1101 1D2A 1102 1D6CD 846 16D3 847
|
||
16E3 848 16E7 849 16ED 850 16F0 851 16FC 852
|
||
1702 853 1705 854 170C 855 170F 856 1712 857
|
||
17DA 858 17DA 860 1037 1B81 1038 1B84 1039 1B8B 1040 1B91 1041
|
||
1B97 1042 1B9D 1043 1BB7 1044 1BBE 1045 1BC1 1046
|
||
1BC4 1047 1BC7 1048 1BCF 1050 F 978 1A82 979
|
||
1A8D 980 1A93 981 1A9A 982 1AA1 983 1AA4 984
|
||
1AAB 986 1AAE 987 1AB1 988 1AB1 989 1AB2 990
|
||
1B6A 992 1B6A 993 1B 1159 05E2 1160
|
||
05EA 1162 05ED 1163 05F0 1164 05FC 1165 05FF 1166
|
||
0602 1167 0605 1168 0605 1169 060D 1171 0610 1172
|
||
0618 117316 1935 918 193C 919
|
||
1945 920 194A 921 1955 922 1959 923 195E 924
|
||
1961 925 1964 926 1967 927 196E 928 1974 929
|
||
197C 930 1982 2D 1103 1D33 1104
|
||
04CE 1105 04DD 1106 04E8 1107 04F4 1109 04FA 1110
|
||
04FD 1111 04FD 1112 0503 1113 050E 1114 0514 1115
|
||
0514 1117DA 861 17E7 862 17F7 863
|
||
1806 864 1815 865 181C 866 1821 867 1826 868
|
||
182E 869 182F 870 1832 871 1835 872 1840 873
|
||
1846 8741BDB 1051 1BE1 1052
|
||
1BE4 1053 1BE5 1054 1BE5 1055 1BEC 1056 1C06 1057
|
||
1C0B 1058 1C10 1059 1C1C 1060 1C29 1062 1C39 1063
|
||
1C3F 061B 1174 061E 1175 0621 1176 0624 1177
|
||
0624 1178 0629 1179 062F 1180 063D 1181 0643 1182
|
||
0648 1183 0650 1185 0653 1186 0656 5) byte initial('001 $'),
|
||
ln1 byte at(.ln(0)),
|
||
ln2 byte at(.ln(1)),
|
||
ln3 byte at(.ln(2)),
|
||
dfcb(33) byte initia(.submit);
|
||
/* jmp to submit is placed at the beginning of the module */
|
||
|
||
boot: procedure external;
|
||
/* system reboot */
|
||
end print;
|
||
|
||
|
||
declare dcnt byte;
|
||
|
||
open: procedure(fcb);
|
||
declare fcb address;
|
||
dcnt = mon2(15,fcb);
|
||
end open;41 07E1 1242
|
||
07E4 1243
|
||
ss',
|
||
ctll lit '0ch',
|
||
lca lit '110$0001b', /* lower case a */
|
||
lcz lit '111$1010b', /* lower case z */
|
||
end1187 065B 1188
|
||
065E 1189 0675 1190 067B 1191 0687 1192 068A 1193
|
||
0690 1194 06A8 1195 06AE 1196 06B3 1197 06BA 1198
|
||
06C0 1199 al(0,'$$$ SUB',0,0,0),
|
||
drec byte at(.dfcb(32)), /* current record */
|
||
buff(128) byte at(dbuff), /* default buffe
|
||
end boot;
|
||
|
||
mon1: procedure(f,a) external;
|
||
declare f byte, a address;
|
||
/* bdos interface, no returned value */
|
||
|
||
|
||
close: procedure(fcb);
|
||
declare fcb address;
|
||
dcnt = mon2(16,fcb);
|
||
end close;
|
||
|
||
delete: procedure(fcb);
|
||
dsub:
|
||
do;
|
||
/* modified 7/26/79 to work with cpm 2.0, module number not zero */
|
||
declare
|
||
wboot literally '0000h', /* warm sfile lit '1ah'; /* cp/m end of file */
|
||
|
||
declare
|
||
true literally '1',
|
||
false literally '0',
|
||
forever literally '06C6 1200 06CB 1201 06DF 1203 06E2 1204
|
||
06E5 1205 06EA 1206 06ED 1207 070D 1208 0713 1209
|
||
071B 1210 0722 1211 072A 1212 0730 1r */
|
||
sfcb(33) byte at(dfcba); /* default fcb */
|
||
|
||
submit: procedure;
|
||
|
||
/* t h e c p / m 's u b m i t' f u end mon1;
|
||
|
||
mon2: procedure(f,a) byte external;
|
||
declare f byte, a address;
|
||
/* bdos interface, return byte value */eclare fcb address;
|
||
call mon1(19,fcb);
|
||
end delete;
|
||
|
||
diskread: procedure(fcb) byte;
|
||
declare fcb address;
|
||
retart entry point */
|
||
bdos literally '0005h', /* jmp bdos */
|
||
dfcba literally '005ch', /* default fcb address */
|
||
while true',
|
||
cr literally '13',
|
||
lf literally '10',
|
||
what literally '63';
|
||
|
||
print: procedure(a);
|
||
declare a ad213 0738 1214
|
||
0740 1216 074E 1217 0753 1218 075B 1220 0760 1221
|
||
0768 1222 076D 1223 0775 1224 077A 1225 077A 1226
|
||
077D 1227 0 n c t i o n
|
||
|
||
copyright (c) 1976, 1977, 1978
|
||
digital research
|
||
box 579
|
||
pacific grove, ca.
|
||
|
||
end mon2;
|
||
|
||
|
||
declare
|
||
copyright(*) byte data
|
||
(' copyright(c) 1977, digital research ');
|
||
|
||
declare
|
||
ln(turn mon2(20,fcb);
|
||
end diskread;
|
||
|
||
diskwrite: procedure(fcb) byte;
|
||
declare fcb address;
|
||
return mon2(21,fcb);
|
||
dbuff literally '0080h'; /* default buffer address */
|
||
|
||
declare jump byte data(0c3h); /* c3 = jmp */
|
||
declare jadr address datdress;
|
||
/* print the string starting at address a until the
|
||
next dollar sign is encountered */
|
||
call mon1(9,a);
|
||
77D 1228 0780 1229 0786 1230 07AA 1231
|
||
07B0 1232 07BB 1233 07BE 1234 07C6 1236 07CB 1237
|
||
07CE 1238 07CE 1239 07D6 1240 07DB 12 93950
|
||
*/
|
||
declare lit literally 'literally',
|
||
dcl lit 'declare',
|
||
proc lit 'procedure',
|
||
addr lit 'addre end diskwrite;
|
||
|
||
make: procedure(fcb);
|
||
declare fcb address;
|
||
dcnt = mon2(22,fcb);
|
||
end make;
|
||
|
||
move: procedure( end;
|
||
end;
|
||
end;
|
||
/* translate to upper case */
|
||
if (b-61h) < 26 then /* lower case alpha */
|
||
|
||
|
||
end setup;
|
||
|
||
|
||
getsource: procedure byte;
|
||
/* read the next source character */
|
||
declare b byte;
|
||
if sbp > 1;
|
||
end;
|
||
end deblankparm;
|
||
|
||
putrbuff: procedure(b);
|
||
declare b byte;
|
||
if (rbp := rbp +te, /* substitute string */
|
||
sbp byte; /* source buffer pointer (0-128) */
|
||
|
||
|
||
setup: procedure;
|
||
/* move botend: procedure byte;
|
||
/* look at next character in sstring, return
|
||
true if not at the end of the string - chas,d,n);
|
||
declare (s,d) address, n byte;
|
||
declare a based s byte, b based d byte;
|
||
do while (n := n - 1) <> 255;
|
||
b = b and 5fh; /* change to upper case */
|
||
return b;
|
||
end getsource;
|
||
|
||
writebuff: procedure;
|
||
/* write the co127 then
|
||
do; if diskread(.sfcb(0)) <> 0 then
|
||
return endfile;
|
||
sbp = 0;
|
||
end;
|
||
if (b := 1) > last(rbuff) then
|
||
call error(.('Command Buffer Overflow$'));
|
||
rbuff(rbp) = b;
|
||
/* len: c1 ... uffer to substitute string */
|
||
call move(.buff(1),.sstring(0),127);
|
||
sstring(buff(0))=0; /* mark end of string */
|
||
cr passed
|
||
back in 's' */
|
||
if not ((s := sstring(ssbp)) = ' ' or s = 0) then
|
||
do;
|
||
ssbp =
|
||
b = a; s = s + 1; d = d + 1;
|
||
end;
|
||
end move;
|
||
|
||
declare oldsp address; /* calling program's stack pointentents of the buffer to disk */
|
||
if diskwrite(.dfcb) <> 0 then /* error */
|
||
call error(.('Disk Write Error$'));
|
||
buff((sbp:=sbp+1)-1)) = cr then
|
||
do; /* increment line */
|
||
if (ln3 := ln3 + 1) > '9' then
|
||
do; ln3 c125 :00:$ = 128 chars */
|
||
if (rlen := rlen + 1) > 125 then
|
||
call error(.('Command Too Long$'));
|
||
enall move(.('SUB'),.sfcb(9),3); /* set file type to sub */
|
||
call open(.sfcb(0));
|
||
if dcnt = 255 then
|
||
call error( ssbp + 1;
|
||
return true;
|
||
end;
|
||
return false;
|
||
end notend;
|
||
|
||
deblankparm: procedurer */
|
||
|
||
error: procedure(a);
|
||
declare a address;
|
||
call print(.(cr,lf,'$'));
|
||
call print(.('Error On Line $'));
|
||
end writebuff;
|
||
|
||
declare rbuff(2048) byte, /* jcl buffer */
|
||
rbp address, /* jcl buffer pointer */
|
||
rlen byte; = '0';
|
||
if (ln2 := ln2 + 1) > '9' then
|
||
do; ln2 = '0';
|
||
ln1 = ln1 + 1;
|
||
d putrbuff;
|
||
|
||
declare (reading,b) byte;
|
||
/* fill the jcl buffer */
|
||
rbuff(0),rbp = 0;
|
||
reading = true;
|
||
.('No ''SUB'' File Present$'));
|
||
/* otherwise file is open - read subsequent data */
|
||
sbp = 128; /* causes read below */;
|
||
/* clear to next non blank substitute string */
|
||
do while sstring(ssbp) = ' ';
|
||
ssbp = ssbp +call print(.ln1);
|
||
call print(a);
|
||
stackptr = oldsp;
|
||
/* return to ccp */
|
||
end error;
|
||
|
||
declare sstring(128) by /* length of current command */
|
||
|
||
fillrbuff: procedure;
|
||
declare (s,ssbp) byte; /* sub string buffer pointer */
|
||
|
||
n do while reading;
|
||
rlen = 0; /* reset command length */
|
||
do while (b:=getsource) <> endfile and b <> cr;
|
||
reading = b = cr;
|
||
call putrbuff(rlen); /* store length */
|
||
end;
|
||
/* entire file has been read and processe end; else /* not a '$' */
|
||
if b = '^' then /* control character */
|
||
do; /* must be ^all fillrbuff;
|
||
call makefile;
|
||
call boot; /* reboot causes commands to be executed */
|
||
end submit;
|
||
end;
|
||
do while b <> 0; b = b - 1;
|
||
/* clear next parameter */
|
||
do buff(0) = i; buff(i+1) = 00; buff(i+2) = '$';
|
||
do while i > 0;
|
||
buff(i) = getrbuff; i=i-1;
|
||
if b <> lf then
|
||
do; if b = '$' then /* copy substitute string */
|
||
do; if (b:=getsd */
|
||
end fillrbuff;
|
||
|
||
makefile: procedure;
|
||
/* write resulting command file */
|
||
declare i byte;
|
||
getrbuff: pro ... ^z */
|
||
if (b:=getsource - 'a') > 25 then
|
||
call error(.('Invalid Control Charact裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹 while notend;
|
||
end;
|
||
call deblankparm;
|
||
end;
|
||
/* buffer filled to $ */
|
||
call writebuff;
|
||
end;
|
||
call close(.dfcb);
|
||
if dcnt = 255 ource) = '$' then
|
||
/* $$ replaced by $ */
|
||
call putrbuff(b); else
|
||
cedure byte;
|
||
return rbuff(rbp := rbp - 1);
|
||
end getrbuff;
|
||
|
||
call delete(.dfcb);
|
||
drec = 0; /* zero theer$'));
|
||
else
|
||
call putrbuff(b+1);
|
||
end; else /* not $ or ^ */
|
||
裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹 end;
|
||
/* ready to copy substitute string from position ssbp */
|
||
do while notthen call error(.('Cannot Close, Read/Only?$'));
|
||
end makefile;
|
||
|
||
/* enter here from the ccp with the fcb set */
|
||
declare if (b := b - '0') > 9 then
|
||
call error(.('Parameter Error$')); else
|
||
do; /* fi next record to write */
|
||
call make(.dfcb);
|
||
if dcnt = 255 then call error(.('Directory Full$'));
|
||
do while (i :
|
||
call putrbuff(b);
|
||
end;
|
||
end; /* of line or input file - compute length */
|
||
裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹end;
|
||
call putrbuff(s);
|
||
end;
|
||
end;
|
||
stack(10) address; /* working stack */
|
||
oldsp = stackptr;
|
||
stackptr = .stack(length(stack));
|
||
|
||
call setup;
|
||
cand string 'b' in sstring */
|
||
ssbp = 0; call deblankparm; /* ready to scan sstring */
|
||
= getrbuff) <> 0;
|
||
/* copy i characters to buffer */
|
||
/* 00 $ at end of line gives 1.3 & 1.4 compatibility */
|
||
0000 SUBMIT#
|
||
0000 SUB#
|
||
01DF 15 01F7 18 01FD 20 0206 21 0207 23
|
||
020D 25 0219 26 021A 27 0220 29 022C 30
|
||
022D 31 0233裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹04FE 168
|
||
057A 170 057A 171 0587 172 04FE 173 0504 174
|
||
0509 175 050F 176 0517 177 051D 178 0528 179
|
||
052E 180 0537 181 0542 182tatus */
|
||
/* status status status status status status */
|
||
/* status status status status status sA 104 0481 106
|
||
0481 107 04A3 109 04A7 110 04AA 111 04AA 112
|
||
04AD 113 04AD 114 04AD 115 04BC 116 04C0 117
|
||
04C3 118 04C4 119 04tatus */
|
||
/* status status status status status status */
|
||
/* status status status status status s 33 023C 34 023D 35 0243 37
|
||
024D 38 024D 39 0253 41 025D 42 025D 43
|
||
0263 45 026F 46 0270 47 027F 50 028B 51
|
||
0295 5裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹 054B 183 0558 184
|
||
055C 185 055F 186 0562 187 0565 188 056B 189
|
||
0573 190 0579 191 01DF 193 01E6 194 01EA 195
|
||
01ED 196 01F0 19tatus */
|
||
/* status status status status status status */
|
||
/* status status status status status sC8 121 04D8 122 04DE 123
|
||
04E9 124 04F7 125 04FD 126 038A 128 0395 129
|
||
039A 130 03A1 131 03A6 132 03C1 133 03C9 135
|
||
03D1 137 0tatus */
|
||
/* status status status status status status */
|
||
/* status status status status status s2 029C 53 02A3 54 02A6 55 02A7 57
|
||
02AD 59 02B3 60 02B9 61 02BF 62 02C7 63
|
||
02CB 64 02CC 66 02CC 67 02D8 68 02E3 69
|
||
裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹7 01F3 198 01F6 199
|
||
0000 MODULE#
|
||
|
||
tatus */
|
||
/* status status status status status status */
|
||
/* status status status status status s3DC 138 03E6 139 03F5 140 03FE 142
|
||
0403 143 0406 144 040E 145 0412 146 0419 147
|
||
041C 148 041F 149 0422 150 0429 151 0430 152
|
||
tatus */
|
||
/* status status status status status status */
|
||
/* status status status status status s
|
||
02EF 70 02F5 71 02FD 72 0303 73 0308 74
|
||
0309 75 0309 77 0312 79 031D 80 0320 81
|
||
0325 82 0325 83 033D 85 034B 87 0stat:
|
||
do;
|
||
declare
|
||
cpmversion literally '20h'; /* requires 2.0 cp/m */
|
||
/* c p / m s t a t u s c o m m a n d (s t a裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹tatus */
|
||
/* status status status status status status */
|
||
/* status status status status status s0433 153 0433 154 0436 155 043E 157 044D 158
|
||
0456 159 045E 160 0461 161 0468 162 0468 163
|
||
046B 164 0476 165 047D 166 0480 167 tatus */
|
||
/* status status status status status status */
|
||
/* status status status status status s350 88
|
||
035B 90 0360 91 0362 92 0362 93 0362 94
|
||
0362 95 036C 96 0374 97 0378 98 0378 99
|
||
0378 100 0383 101 0389 102 038 t) */
|
||
|
||
/* status status status status status status */
|
||
/* status status status status status status */
|
||
/* status status status status status status */
|
||
/* status status status status status s, /* parameter, if sent */
|
||
rreca literally '007dh', /* random record 7d,7e,7f */
|
||
rreco literally '007fh', (2 by) size of directory-1
|
||
dirblk (2 by) reservation bits for directory
|
||
chksiz (2 by) size of procedure external;
|
||
/* reboot */
|
||
end boot;
|
||
|
||
mon1: procedure(f,a) external;
|
||
declare f byte, a address;
|
||
ende under cp/m 2.0 */
|
||
|
||
declare jump byte data(0c3h),
|
||
jadr address data (.status);
|
||
/* jump to status */
|
||
|
||
/* function ss, /* disk parameter block address */
|
||
dpb based dpba structure
|
||
(spt address, bls byte, bms byte, exm btatus */
|
||
/* status status status status status status */
|
||
/* status status status status status s/* high byte of random overflow */
|
||
ioba literally '0003h', /* iobyte address */
|
||
sectorlen literally '128', /* schecksum vector
|
||
offset (2 by) offset for operating system
|
||
*/
|
||
|
||
declare
|
||
/* fixed locations for cp/m */
|
||
mon1;
|
||
|
||
mon2: procedure(f,a) byte external;
|
||
declare f byte, a address;
|
||
end mon2;
|
||
|
||
mon3: procedure(f,a) address extcall 32 returns the address of the disk parameter
|
||
block for the currently selected disk, which consists of:
|
||
scptrk yte, mxa address,
|
||
dmx address, dbl address, cks address, ofs address),
|
||
scptrk literally 'dpb.spt',
|
||
blkshf literatatus */
|
||
/* status status status status status status */
|
||
|
||
/*
|
||
copyright(c) 1975, 1976, 1977, 1978,ector length */
|
||
memsize address at(bdosa), /* end of memory */
|
||
rrec address at(rreca), /* random record addressbdosa literally '0006h', /* bdos base */
|
||
buffa literally '0080h', /* default buffer */
|
||
fcba literally '005ch'ernal;
|
||
declare f byte, a address;
|
||
end mon3;
|
||
|
||
|
||
status: procedure;
|
||
declare copyright(*) byte data (
|
||
' Cop (2 by) number of sectors per track
|
||
blkshf (1 by) log2 of blocksize (2**blkshf=blksize)
|
||
blkmsk (1 blly 'dpb.bls',
|
||
blkmsk literally 'dpb.bms',
|
||
extmsk literally 'dpb.exm',
|
||
maxall literally 'dpb.mxa',
|
||
dirmax li 1979
|
||
digital research
|
||
box 579
|
||
pacific grove, ca
|
||
93950
|
||
*/
|
||
|
||
/* modified */
|
||
rovf byte at(rreco), /* overflow on getfile */
|
||
doll byte at(dolla), /* dollar parameter */
|
||
pa, /* default file control block */
|
||
dolla literally '006dh', /* dollar sign position */
|
||
parma literally '006eh'yright (c) 1979, Digital Research');
|
||
/* dummy outer procedure 'status' will start at 100h */
|
||
/* determine status of cuy) 2**blkshf-1
|
||
extmsk (1 by) logical/physical extents
|
||
maxall (2 by) max alloc number
|
||
dirmaxterally 'dpb.dmx',
|
||
dirblk literally 'dpb.dbl',
|
||
chksiz literally 'dpb.cks',
|
||
offset literally 'dpb.ofs';
|
||
|
||
|
||
boot:10/30/78 to fix the space computation */
|
||
/* modified 01/28/79 to remove despool dependencies */
|
||
/* modified 07/26/79 to operatrm byte at(parma), /* parameter */
|
||
sizeset byte, /* true if displaying size field */
|
||
dpba addrerrently selected disk */
|
||
|
||
declare alloca address,
|
||
/* alloca is the address of the disk allocation vector */
|
||
alloc badma);
|
||
declare dma address;
|
||
call mon1(26,dma);
|
||
end setdma;
|
||
|
||
getalloca: procedure address;
|
||
/* get base addre*/
|
||
return mon2(12,0);
|
||
end version;
|
||
|
||
select: procedure(d);
|
||
declare d byte;
|
||
call mon1(14,d);
|
||
end selecthis program's stack */
|
||
|
||
declare
|
||
fcbmax literally '512', /* max fcb count */
|
||
fcbs literally 'memory',/* remainder of are a address;
|
||
declare s based a byte;
|
||
do while s <> 0;
|
||
call printchar(s);
|
||
a = a + 1;
|
||
e
|
||
set$dpb: procedure;
|
||
/* set disk parameter block values */
|
||
dpba = mon3(31,0); /* base of dpb */
|
||
end set$dpb;
|
||
|
||
sed alloca (1024) byte; /* allocation vector */
|
||
|
||
declare
|
||
true literally '1',
|
||
false literally '0',
|
||
forever litess of alloc vector */
|
||
return mon3(27,0);
|
||
end getalloca;
|
||
|
||
getlogin: procedure address;
|
||
/* get the login vector *;
|
||
|
||
open: procedure(fcb);
|
||
declare fcb address;
|
||
dcnt = mon2(15,fcb);
|
||
end open;
|
||
|
||
search: procedure(fcb);
|
||
dememory */
|
||
fcb(33) byte at (fcba), /* default file control block */
|
||
buff(128) byte at (buffa), /* default buffnd;
|
||
end printx;
|
||
|
||
print: procedure(a);
|
||
declare a address;
|
||
/* print the string starting at address a until the
|
||
getuser: procedure byte;
|
||
/* return current user number */
|
||
return mon2(32,0ffh);
|
||
end getuser;
|
||
|
||
setuser: procedurrally 'while true',
|
||
cr literally '13',
|
||
lf literally '10';
|
||
|
||
printchar: procedure(char);
|
||
declare char byte;
|
||
/
|
||
return mon3(24,0);
|
||
end getlogin;
|
||
|
||
writeprot: procedure;
|
||
/* write protect the current disk */
|
||
call mon1(2clare fcb address;
|
||
dcnt = mon2(17,fcb);
|
||
end search;
|
||
|
||
searchn: procedure;
|
||
dcnt = mon2(18,0);
|
||
end searchn;
|
||
er */
|
||
ioval byte at (ioba); /* io byte */
|
||
|
||
declare bpb address; /* bytes per block */
|
||
|
||
set$bpb: procedure next 0 is encountered */
|
||
call crlf;
|
||
call printx(a);
|
||
end print;
|
||
|
||
break: procedure byte;
|
||
return mon2(11,0e(user);
|
||
declare user byte;
|
||
call mon1(32,user);
|
||
end setuser;
|
||
|
||
getfilesize: procedure(fcb);
|
||
declare fcb addcall mon1(2,char);
|
||
end printchar;
|
||
|
||
crlf: procedure;
|
||
call printchar(cr);
|
||
call printchar(lf);
|
||
end crlf;
|
||
|
||
p8,0);
|
||
end writeprot;
|
||
|
||
getrodisk: procedure address;
|
||
/* get the read-only disk vector */
|
||
return mon3(29,0);
|
||
|
||
cselect: procedure byte;
|
||
/* return current disk number */
|
||
return mon2(25,0);
|
||
end cselect;
|
||
|
||
setdma: procedure(;
|
||
call set$dpb; /* disk parameters set */
|
||
bpb = shl(double(1),blkshf) * sectorlen;
|
||
end set$bpb;
|
||
|
||
select$disk: p); /* console ready */
|
||
end break;
|
||
|
||
declare dcnt byte;
|
||
|
||
version: procedure byte;
|
||
/* returns current cp/m version # ress;
|
||
call mon1(35,fcb);
|
||
end getfilesize;
|
||
|
||
declare oldsp address, /* sp on entry */
|
||
stack(16) address; /* trintb: procedure;
|
||
/* print blank character */
|
||
call printchar(' ');
|
||
end printb;
|
||
|
||
printx: procedure(a);
|
||
decl end getrodisk;
|
||
|
||
setind: procedure;
|
||
/* set file indicators for current fcb */
|
||
call mon1(30,fcba);
|
||
end setind;
|
||
rocedure(d);
|
||
declare d byte;
|
||
/* select disk and set bpb */
|
||
call select(d);
|
||
call set$bpb; /* bytes per block */
|
||
zerosup byte, /* zero suppression flag */
|
||
d byte; /* current decimal digit */
|
||
zerosup = true;
|
||
setacc(b); else /* blank fill */
|
||
call setacc(' ');
|
||
if b <= 1 or b = ',' or b = ':' or
|
||
b = '*' */
|
||
bit byte; /* always 1 if mode = false */
|
||
ka, ba = 0;
|
||
bit = 0;
|
||
do i = 0 to maxall;
|
||
if if s(i) <> accum(i) then return false;
|
||
end;
|
||
return true;
|
||
end compare;
|
||
|
||
scan: procedure;
|
||
/* fill acc kilobyte accum */
|
||
declare baccum based ab address; /* byte accum */
|
||
baccum = baccum + bpb;
|
||
do while baccum >*/
|
||
end select$disk;
|
||
|
||
getalloc: procedure(i) byte;
|
||
/* return the ith bit of the alloc vector */
|
||
declare i addres do while prec <> 0;
|
||
d = v / prec ; /* get next digit */
|
||
v = v mod prec;/* get remainder back to v */
|
||
or b = '.' or b = '>' or
|
||
b = '<' or b = '=' then buff(ibp) = 1;
|
||
else
|
||
ibp = ibp + 1;
|
||
en mode then bit = getalloc(i);
|
||
if not bit then call add$block(.ka,.ba);
|
||
end;
|
||
return ka;
|
||
end count;
|
||
|
||
um with next input value */
|
||
declare (i,b) byte;
|
||
setacc: procedure(b);
|
||
declare b byte;
|
||
accum(i) = b; = 1024;
|
||
baccum = baccum - 1024;
|
||
kaccum = kaccum + 1;
|
||
end;
|
||
end add$block;
|
||
|
||
count: procedure(mods;
|
||
return
|
||
rol(alloc(shr(i,3)), (i and 111b) + 1);
|
||
end getalloc;
|
||
|
||
declare
|
||
accum(4) byte, /* accumulator prec = prec / 10; /* ready for next digit */
|
||
if prec <> 0 and zerosup and d = 0 then call printb; else
|
||
d;
|
||
ibp = ibp + 1;
|
||
end scan;
|
||
|
||
pdecimal: procedure(v,prec);
|
||
/* print value v with precision prec (10,100,1000)
|
||
|
||
abortmsg: procedure;
|
||
call print(.('** Aborted **',0));
|
||
end abortmsg;
|
||
|
||
userstatus: procedure;
|
||
/* display activei = i + 1;
|
||
end setacc;
|
||
/* deblank input */
|
||
do while buff(ibp) = ' '; ibp=ibp+1;
|
||
end;
|
||
/* inie) address;
|
||
declare mode byte; /* true if counting 0's */
|
||
/* count kb remaining, kaccum set upon exit */
|
||
declare
|
||
*/
|
||
ibp byte; /* input buffer pointer */
|
||
|
||
compare: procedure(a) byte;
|
||
/* compare accumulator with four bytes do; zerosup = false; call printchar('0'+d);
|
||
end;
|
||
end;
|
||
end pdecimal;
|
||
|
||
add$block: procedure(ak,a with leading zero suppression */
|
||
declare
|
||
v address, /* value to print */
|
||
prec address, /* precision user numbers */
|
||
declare i byte;
|
||
declare user(32) byte;
|
||
declare ufcb(*) byte data ('????????????',0,0,0);
|
||
catialize accum length */
|
||
i = 0;
|
||
do while i < 4;
|
||
if (b := buff(ibp)) > 1 then /* valid */
|
||
call
|
||
ka address, /* kb accumulator */
|
||
ba address, /* byte accumulator */
|
||
i address, /* local index addressed by a */
|
||
declare a address;
|
||
declare (s based a) (4) byte;
|
||
declare i byte;
|
||
do i = 0 to 3;
|
||
b);
|
||
declare (ak, ab) address;
|
||
/* add one block to the kilobyte accumulator */
|
||
declare kaccum based ak address; /*ll print(.('Active User :',0));
|
||
call pdecimal(getuser,10);
|
||
call print(.('Active Files:',0));
|
||
do i = 0 to last0));
|
||
call pv(offset);
|
||
call printx(.('Reserved Tracks',0));
|
||
call crlf;
|
||
end drivestatus;
|
||
|
||
diskstatus: pr);
|
||
call printx(.('128 Byte Record Capacity',0));
|
||
call pv(count(false));
|
||
call printx(.('Kilobyte Drive Ca
|
||
declare
|
||
devr(*) byte data
|
||
(/* console */ 'TTY:CRT:BAT:UC1:',
|
||
/* reader */ 'TTY:PTR:UR1:UR2:',
|
||
call crlf;
|
||
call pdecimal(v,10000);
|
||
call printchar(':');
|
||
call printb;
|
||
end pv;
|
||
/* vl byte;
|
||
declare (i,j,match,sync) byte;
|
||
j,sync = 0;
|
||
do sync = 1 to vl;
|
||
match = true;
|
||
(user);
|
||
user(i) = false;
|
||
end;
|
||
call setdma(.fcbs);
|
||
call search(.ufcb);
|
||
do while dcnt <> 255;ocedure;
|
||
/* display disk status */
|
||
declare login address, d byte;
|
||
login = getlogin; /* login vector set */
|
||
dpacity',0));
|
||
call pv(dirmax+1);
|
||
call printx(.('32 Byte Directory Entries',0));
|
||
call pv(shl(chksiz,2));
|
||
|
||
/* punch */ 'TTY:PTP:UP1:UP2:',
|
||
/* listing */ 'TTY:CRT:LPT:UL1:');
|
||
|
||
declare
|
||
(i,j,iobyte,iteprint the characteristics of the currently selected drive */
|
||
call print(.(' ',0));
|
||
call printchar(cselect+'A');
|
||
do i = 0 to 3;
|
||
if v(j) <> accum(i) then match=false;
|
||
j = j + 1;
|
||
end;
|
||
if match th
|
||
if (i := fcbs(shl(dcnt and 11b,5))) <> 0e5h then
|
||
user(i and 1fh) = true;
|
||
call searchn;
|
||
= 0;
|
||
do while login <> 0;
|
||
if low(login) then
|
||
do; call select$disk(d);
|
||
call drivesta call printx(.('Checked Directory Entries',0));
|
||
call pv((extmsk+1) * 128);
|
||
call printx(.('Records/ Extent',0))ms) byte;
|
||
|
||
|
||
prname: procedure(a);
|
||
declare a address,
|
||
x based a byte;
|
||
/* print device name call printchar(':');
|
||
call printx(.(' Drive Characteristics',0));
|
||
rpb = shl(double(1),blkshf); /* records/block=2**blen return sync;
|
||
end;
|
||
return 0; /* no match */
|
||
end match;
|
||
|
||
declare devl(*) byte data
|
||
('CON:RDR:PUN:LST:end;
|
||
do i = 0 to last(user);
|
||
if user(i) then call pdecimal(i,10);
|
||
end;
|
||
end userstatus;
|
||
|
||
drivestus;
|
||
end;
|
||
login = shr(login,1);
|
||
d = d + 1;
|
||
end;
|
||
end diskstatus;
|
||
|
||
match: procedure;
|
||
call pv(rpb);
|
||
call printx(.('Records/ Block',0));
|
||
call pv(scptrk);
|
||
call printx(.('Sectors/ Track',at a */
|
||
do while x <> ':';
|
||
call printchar(x); a=a+1;
|
||
end;
|
||
call printchar(':');
|
||
kshf */
|
||
if (rpd := (maxall+1) * rpb) = 0 and (rpb <> 0) then
|
||
call print(.('65536: ',0)); else
|
||
call pv(rpdDEV:VAL:USR:DSK:');
|
||
|
||
devreq: procedure byte;
|
||
/* process device request, return true if found */
|
||
/* device tables */
|
||
tatus: procedure;
|
||
declare
|
||
rpb address,
|
||
rpd address;
|
||
pv: procedure(v);
|
||
declare v address;
|
||
(va,vl) byte;
|
||
/* return index+1 to vector at va if match */
|
||
declare va address,
|
||
v based va (16) byte,
|
||
end prname;
|
||
|
||
items = 0;
|
||
do forever;
|
||
call scan;
|
||
if (i:=match(.devl,8)) = 0 then return ice table */
|
||
do; /* find base of destination */
|
||
j = shl(i:=i-1,4);
|
||
call scan;
|
||
(i,2)));
|
||
call printx(.(' =',0));
|
||
do j = 0 to 12 by 4;
|
||
call printchar((v/k); v = v mod k;
|
||
k = k / 10;
|
||
if zero or k = 0 or d <> 0 then
|
||
do; zero = true; call printchar(en /* list possible assignment */
|
||
do;
|
||
call print(.('Temp R/O Disk: d:=R/O',0));
|
||
call prin
|
||
ioval = (ioval and iobyte) or j;
|
||
end;
|
||
/* end of current item, look for more */
|
||
call tems<>0;
|
||
items = items+1; /* found first/next item */
|
||
if i = 5 then /* device status request */
|
||
d if accum(0) <> '=' then
|
||
do; call print(.('Bad Delimiter',0));
|
||
return true;
|
||
e' ');
|
||
call prname(.devr(shl(i,4)+j));
|
||
end;
|
||
end;
|
||
end; els'0'+d);
|
||
end;
|
||
end;
|
||
call printchar('k');
|
||
call crlf;
|
||
end pvalue;
|
||
|
||
comp$alloc: procedure;
|
||
t(.('Set Indicator: d:filename.typ ',
|
||
'$R/O $R/W $SYS $DIR',0));
|
||
call print(.('Disk Statscan;
|
||
if accum(0) = ' ' then return true;
|
||
if accum(0) <> ',' then
|
||
do; call print(.('Bad Delimitero;
|
||
iobyte = ioval; j = 0;
|
||
do i = 0 to 3;
|
||
call prname(.devl(shl(i,2)));
|
||
nd;
|
||
call scan;
|
||
if (j:=match(.devr(j),4)-1) = 255 then
|
||
do; call print(.('Invalid Assige
|
||
if i = 7 then /* list user status values */
|
||
do; call userstatus;
|
||
return true;
|
||
alloca = getalloca;
|
||
call printchar(cselect+'A');
|
||
call printx(.(': ',0));
|
||
end comp$alloc;
|
||
|
||
prcount: procedureus : DSK: d:DSK:',0));
|
||
call print(.('User Status : USR:',0));
|
||
call print(.('Iobyte Assign:',0));
|
||
',0));
|
||
return true;
|
||
end;
|
||
end; /* of do forever */
|
||
end devreq;
|
||
|
||
pvalue: procedure(v);
|
||
call printx(.(' is ',0));
|
||
call prname(.devr(shl(iobyte and 11b,2)+j));
|
||
j = j + 16; iobynment',0));
|
||
return true;
|
||
end;
|
||
iobyte = 1111$1100b; /* construct mask */
|
||
end; else
|
||
if i = 8 then /* show the disk device status */
|
||
call diskstatus; else
|
||
/* scan item i-1 in devi;
|
||
/* print the actual byte count */
|
||
call pvalue(count(true));
|
||
end prcount;
|
||
|
||
pralloc: procedure;
|
||
/* print a do i = 0 to 3; /* each line shows one device */
|
||
call crlf;
|
||
call prname(.devl(shl declare (d,zero) byte,
|
||
(k,v) address;
|
||
k = 10000;
|
||
zero = false;
|
||
do while k <> 0;
|
||
d = lowte = shr(iobyte,2);
|
||
call crlf;
|
||
end;
|
||
end; else /* not dev: */
|
||
if i = 6 th do while (i:=i-1) <> 255;
|
||
iobyte = rol(iobyte,2);
|
||
j = shl(j,2);
|
||
end;
|
||
llocation for current disk */
|
||
call print (.('Bytes Remaining On ',0));
|
||
call comp$alloc;
|
||
call prcount;
|
||
end pr fcbr(fcbmax) address, /* record count */
|
||
bfcba address, /* index into directory buffer */
|
||
fcbsa addr literally '15',
|
||
fdm literally '16', fdl literally '31',
|
||
ftyp literally '9',
|
||
rofile literally '9a('R/O R/W SYS DIR ');
|
||
if doll = ' ' then return false;
|
||
call move(4,.parm,.accum); /* $???? */
|
||
if acc printchar('W');
|
||
call printx(.(', Space: ',0));
|
||
call prcount;
|
||
end;
|
||
login = shr(l (b,f) byte, /* counters */
|
||
matched byte; /* used during fcbs search */
|
||
|
||
multi16: procedure;
|
||
/* utalloc;
|
||
|
||
prstatus: procedure;
|
||
/* print the status of the disk system */
|
||
declare (login, rodisk) address;
|
||
declareess, /* index into fcbs */
|
||
bfcb based bfcba (32) byte, /* template over directory */
|
||
fcbv based fcbsa (16', /* read/only file */
|
||
infile literally '10'; /* invisible file */
|
||
declare
|
||
fcbn address, /* number ofum(0) = 'S' and accum(1) = ' ' then
|
||
return not (sizeset := true);
|
||
/* must be a parameter */
|
||
if (sogin,1); rodisk = shr(rodisk,1);
|
||
d = d + 1;
|
||
end;
|
||
call crlf;
|
||
end prstatus;
|
||
|
||
setdisk: procedure;
|
||
ility to compute fcbs address from i */
|
||
fcbsa = shl(i,4) + .fcbs;
|
||
end multi16;
|
||
|
||
declare
|
||
scase b d byte;
|
||
login = getlogin; /* login vector set */
|
||
rodisk = getrodisk; /* read only disk vector set */
|
||
d = 0;
|
||
) byte; /* template over fcbs entry */
|
||
declare
|
||
i address, /* fcb counter during collection and display */
|
||
fcb's collected so far */
|
||
finx(fcbmax) address, /* index vector used during sort */
|
||
fcbe(fcbmax) address, /* case := match(.fstat,4)) = 0 then
|
||
call print(.('Invalid File Indicator',0));
|
||
return true;
|
||
end set if fcb(0) <> 0 then call select$disk(fcb(0)-1);
|
||
end setdisk;
|
||
|
||
getfile: procedure;
|
||
/* process file request */
|
||
|
||
yte; /* status case # */
|
||
|
||
declare
|
||
fstatlist(*) byte data('R/O',0,'R/W',0,'SYS',0,'DIR',0);
|
||
|
||
setfilestatus: do while login <> 0;
|
||
if low(login) then
|
||
do; call select$disk(d);
|
||
call comp$alloc;
|
||
l address, /* used during sort and display */
|
||
k address, /* " */
|
||
m address, /* " */
|
||
extent counts */
|
||
fcbb(fcbmax) address, /* byte count (mod kb) */
|
||
fcbk(fcbmax) address, /* kilobyte count */
|
||
filestatus;
|
||
|
||
printfn: procedure;
|
||
declare (k, lb) byte;
|
||
/* print file name */
|
||
do k = 1 to fn declare
|
||
fnam literally '11', fext literally '12',
|
||
fmod literally '14',
|
||
frc literally '15', flnprocedure byte;
|
||
/* eventually, scase set r/o=0,r/w=1,dat=2,sys=3 */
|
||
declare
|
||
fstat(*) byte dat call printx(.('R/',0));
|
||
if low(rodisk) then
|
||
call printchar('O'); else
|
||
call kb byte, /* byte counter */
|
||
lb byte, /* byte counter */
|
||
mb byte, /* byte counter */
|
||
am;
|
||
if (lb := fcbv(k) and 7fh) <> ' ' then
|
||
do; if k = ftyp then call printchar('.');
|
||
ll print(.('** Too Many Files **',0));
|
||
i = 0; fcbn = 1;
|
||
call multi16;
|
||
end;
|
||
bv(kb) then kb = fnam; else
|
||
/* complete match if at end */
|
||
matched = kb = fnam;
|
||
*/
|
||
|
||
display: /* label for debug */
|
||
/* now display the collected data */
|
||
if fcbn = 0 then call print(.('File Not fmod) = '?'; /* question mark matches all */
|
||
call search(fcba); /* fill directory buffer */
|
||
collect: /* label for debu
|
||
countbytes: /* label for debug */
|
||
lb = 1;
|
||
if maxall > 255 then lb = 2; /* double precision inx */
|
||
call printchar(lb);
|
||
end;
|
||
end;
|
||
end printfn;
|
||
|
||
call set$bpb; /* in case default di /* save index to element for later sort */
|
||
finx(i) = i;
|
||
do kb = 0 to fnam;
|
||
end;
|
||
i = i + 1;
|
||
end;
|
||
checkmatched: /* label for debug */
|
||
if matched then i = i - Found',0)); else
|
||
if scase = 255 then /* display collected data */
|
||
do;
|
||
/* sort the file names in ascendingg */
|
||
do while dcnt <> 255;
|
||
/* another item found, compare it for common entry */
|
||
bfcba = shl(dcnt and do kb = fdm to fdl by lb;
|
||
mb = bfcb(kb);
|
||
if lb = 2 then /* double precision inx */
|
||
sk */
|
||
call setdisk;
|
||
sizeset = false;
|
||
scase = 255;
|
||
if setfilestatus then
|
||
do; if scase = 0 then retur fcbv(kb) = bfcb(kb);
|
||
end;
|
||
fcbe(i),fcbb(i),fcbk(i),fcbr(i) = 0;
|
||
end;
|
||
/* 1; else
|
||
do; /* copy to new position in fcbs */
|
||
fcbn = (i := fcbn) + 1;
|
||
call multi16;
|
||
order */
|
||
if fcbn > 1 then /* requires at least two to sort */
|
||
do; l = 1;
|
||
do while l > 0; 11b,5)+buffa; /* dcnt mod 4 * 32 */
|
||
matched = false; i = 0;
|
||
do while not matched and i < fcbn;
|
||
mb = mb or bfcb(kb+1);
|
||
if mb <> 0 then /* allocated */
|
||
call add$block(.fcbk(in;
|
||
scase = scase - 1;
|
||
end; else
|
||
if fcb(1) = ' ' then /* no file named */
|
||
do; call pralloc;
|
||
entry is at, or was placed at location i in fcbs */
|
||
fcbe(i) = fcbe(i) + 1; /* extent incremented */
|
||
/* record /* fcbsa set to next to fill */
|
||
if (fcbn > fcbmax) or (fcbsa + 16) >= memsize then
|
||
do; ca /* bubble sort */
|
||
l = 0;
|
||
do m = 0 to fcbn - 2;
|
||
i = finx(m+1); call m /* compare current entry */
|
||
call multi16;
|
||
do kb = 1 to fnam;
|
||
if bfcb(kb) <> fc),.fcbb(i));
|
||
end;
|
||
call searchn; /* to next entry in directory */
|
||
end; /* of do while dcnt <> 255 return;
|
||
end;
|
||
/* read the directory, collect all common file names */
|
||
fcbn,fcb(0) = 0;
|
||
fcb(fext),fcb(count */
|
||
fcbr(i) = fcbr(i) + bfcb(frc)
|
||
+ (bfcb(fext) and extmsk) * 128;
|
||
/* count kilobytes */ulti16; bfcba = fcbsa; i = finx(m);
|
||
call multi16; /* sets fcbsa, basing fcbv */
|
||
doelse
|
||
call printchar('W');
|
||
call printb;
|
||
call printchar('A'+cselect); call printchar(': call pdecimal(rrec,10000);
|
||
call printb;
|
||
end;
|
||
call pdecimal(fcbr(i),10000)default fcb location */
|
||
call move(16,fcbsa,fcba);
|
||
fcb(0) = 0; /* in case matched user# > 0 */
|
||
nt(.(' Size ',0)); else
|
||
call crlf;
|
||
call printx(.(' Recs Bytes Ext Acc',0));
|
||
l = 0;
|
||
call multi16;
|
||
call crlf;
|
||
call printfn;
|
||
do case scase;
|
||
/* kb = 1 to fnam; /* compare for less or equal */
|
||
if (b:=bfcb(kb)) < (f:=fcbv(kb)) then /* switch */
|
||
');
|
||
/* print filename.typ */
|
||
if (mb:=rol(fcbv(infile),1)) then call printchar('(');
|
||
call ; /* rrrrr */
|
||
call printb; /* blank */
|
||
call pdecimal(fcbk(i),10000); /* bbbbbk */
|
||
call p call setind; /* indicators set */
|
||
call printx(.(' set to ',0));
|
||
call printx(.fstatlist(shl(scase, do while l < fcbn;
|
||
i = finx(l); /* i is the index to next in order */
|
||
call multi16; call crlf;
|
||
set to r/o */
|
||
fcbv(rofile) = fcbv(rofile) or 80h;
|
||
/* set to r/w */
|
||
fcbv(rofil do; k = finx(m); finx(m) = finx(m + 1);
|
||
finx(m + 1) = k; l = l + 1; kb = printfn;
|
||
if mb then call printchar(')');
|
||
l = l + 1;
|
||
end;
|
||
call pralloc;
|
||
rintchar('k'); call printb;
|
||
call pdecimal(fcbe(i),1000); /* eeee */
|
||
call printb;
|
||
call p2)));
|
||
l = l + 1;
|
||
end;
|
||
end;
|
||
end getfile;
|
||
|
||
setdrivestatus: procedure;
|
||
/* handle pos /* print the file length */
|
||
call move(16,.fcbv(0),fcba);
|
||
fcb(0) = 0;
|
||
if sizeset the) = fcbv(rofile) and 7fh;
|
||
/* set to sys */
|
||
fcbv(infile) = fcbv(infile) or 80h;
|
||
fnam;
|
||
end;
|
||
else if b > f then kb = fnam; /* stop compare */
|
||
end; else
|
||
setfileatt: /* label for debug */
|
||
/* set file attributes */
|
||
do;
|
||
l = 0;
|
||
do whirintchar('R');
|
||
call printchar('/');
|
||
if rol(fcbv(rofile),1) then
|
||
call printchar('O'); sible drive status assignment */
|
||
call scan; /* remove drive name */
|
||
call scan; /* check for = */
|
||
if accum(0) = '=en
|
||
do; call getfilesize(fcba);
|
||
if rovf <> 0 then call printx(.('65536',0)); else
|
||
/* set to dir */
|
||
fcbv(infile) = fcbv(infile) and 7fh;
|
||
end;
|
||
/* place name into end;
|
||
end;
|
||
end;
|
||
end;
|
||
if sizeset then
|
||
call prile l < fcbn;
|
||
if break then
|
||
do; call abortmsg; return;
|
||
end;
|
||
i = l;
|
||
' then
|
||
do; call scan; /* get assignment */
|
||
if compare(.('R/O ')) then
|
||
do; call setdisk; /* a: ...裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹ore exit */
|
||
stackptr = oldsp;
|
||
end status;
|
||
end;
|
||
0B 152 0710 153 071C 154 072A 155 0734 156
|
||
0740 157 075B 158 0761 160 0766 161 076F 162
|
||
076F 163 0772 164 0773 165 077D 169 07',0));
|
||
else
|
||
do;
|
||
/* size display if $S set in command */
|
||
ibp = 1; /* initialize buffer pointer */6C 82
|
||
056C 83 0575 84 0575 85 0575 86 057D 87
|
||
057E 88 057E 89 0589 90 058A 91 058A 92
|
||
0593 93 0593 94 0597 96 05A2 */
|
||
call writeprot;
|
||
end; else
|
||
call print(.('Invalid Disk Assignment',0));
|
||
end;
|
||
0000 STAT#
|
||
0000 STAT#
|
||
0433 16 0490 20 0494 22 049F 23 04A0 24
|
||
04A0 25 04A5 26 04AA 27 04AB 28 04AB 29
|
||
04B0 30 04B1 裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹8C 170
|
||
0799 171 07A8 172 07B3 173 07B6 174 07B7 175
|
||
07BB 178 07C4 179 07C8 180 07DF 181 07E6 182
|
||
07F1 183 07F8 184 0801 185 0
|
||
if fcb(0) = 0 and fcb(1) = ' ' then /* stat only */
|
||
call prstatus; else
|
||
do;
|
||
if 97 05A3 98
|
||
05A9 100 05B2 101 05B3 105 05B3 106 05B6 107
|
||
05CB 108 05CC 109 05D0 111 05D7 112 05DA 113
|
||
05DB 114 05E1 116 05FEelse /* not a disk assignment */
|
||
do; call setdisk;
|
||
if match(.devl,8) = 8 then call drive$status; else
|
||
31 04B7 34 04C0 35 04C7 36
|
||
04CE 37 04D1 38 04D2 39 04D8 41 04DB 42
|
||
04E3 43 04E4 44 04E4 45 04ED 46 04ED 48
|
||
04ED 49裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹80E 186 0812 187
|
||
0812 188 0812 189 0818 190 0819 191 0819 195
|
||
081F 196 082B 197 0831 198 083F 199 084A 200
|
||
0851 201 0857 202 fcb(0) <> 0 then
|
||
call setdrivestatus; else
|
||
do;
|
||
if not devreq then /* must be 117 05FE 119 0604 123
|
||
0612 124 062C 125 062F 126 0636 127 0639 128
|
||
0639 129 06EB 131 06EF 133 06FC 134 0700 135
|
||
0639 136 064 call getfile;
|
||
end;
|
||
end setdrivestatus;
|
||
|
||
/* save stack pointer and reset */
|
||
oldsp = stackptr;
|
||
stackptr = 04F6 50 04F6 51 04FA 53 0505 54
|
||
0506 55 050C 57 0518 58 0519 59 051F 61
|
||
052B 62 052C 63 052C 64 0537 65 0538 66
|
||
裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹085D 203 0865 204 087F 205
|
||
088D 206 0890 207 0893 208 08A1 209 08AF 210
|
||
08BB 211 08C2 212 08C3 213 09C0 215 09C6 217
|
||
09C9 218file name */
|
||
call getfile;
|
||
end;
|
||
end;
|
||
end;
|
||
/* restore old stack bef8 137 064C 138 064F 139 0654 140
|
||
065C 141 0670 142 067A 143 067F 144 06D1 145
|
||
06DF 146 06E3 147 06E6 148 06EA 149 0701 150
|
||
07.stack(length(stack));
|
||
/* process request */
|
||
if version < cpmversion then
|
||
call print(.('Wrong CP/M Version (Requires 2.0)0538 67 0541 68 0541 69 0547 71 0550 72
|
||
0551 73 0551 74 055A 75 055A 76 055A 77
|
||
0563 78 0563 79 0563 80 056B 81 05 09D4 219 09D9 220 09DC 221 08C3 222
|
||
08C9 223 08D2 224 08D7 225 08DD 226 08EC 227
|
||
091C 228 0925 229 092D 230 0933 231 093D 2329 0DB9 420 0DBA 421 135D 425
|
||
135D 426 136B 427 136C 430 136C 432 1374 433
|
||
1377 434 1387 435 139F 436 13A7 437 13B7 438
|
||
13BD 4C62 359 0C65 360 0C65 361 0C68 362
|
||
0C8F 363 0C95 365 0C9B 366 0CA0 367 0CAC 368
|
||
0CBA 369 0CC4 370 0CD0 371 0CEB 373 0CF0 374
|
||
11DB 561 11E6 562 11E9 563
|
||
11E9 564 11FA 565 11FD 566 120E 567 1213 568
|
||
1216 569 1227 570 122A 571 122F 572 1234 573
|
||
1241 574 297 0ABA 298 0ABF 299 0ACB 300 0ADC 301
|
||
0AE2 302 0AF9 303 0B01 304 0B0B 305 0B0E 306
|
||
0B15 307 0B18 308 0B20 310 0B26 311 0B2C0 501 0F79 502 0FB9 503 0FBE 504
|
||
0FCD 505 0FD2 506 0FF1 507 0FFF 508 1007 509
|
||
101C 510 1024 511 103A 512 103D 513 1040 514
|
||
10
|
||
0943 233 0951 234 0957 235 0969 236 096F 237
|
||
0986 238 098C 239 0994 240 099A 241 09A3 242
|
||
09A9 243 09B6 244 09BC 245 09BF 2439 13C0 440 13C0 441 13C0 443 13CE 444
|
||
13E3 446 13EB 447 13F0 448 13F7 449 13F7 450
|
||
1401 451 0DBA 452 0DBD 453 0DC0 454 0DC5 40CF9 375 0CF9 376 0CFC 377 0D01 378 0D04 379
|
||
0D05 380 0D05 381 0D0B 382 0D14 383 0D1A 384
|
||
0D1B 385 0D1B 386 0D25 387 0D26 388 1249 575 124E 576 1251 577 125A 578
|
||
125F 579 126F 580 1274 581 1277 582 127E 583
|
||
1283 584 128A 585 128D 586 1290 587 1293 588 312
|
||
0B32 313 0B38 314 0B3E 315 0B4C 316 0B4F 317
|
||
0B60 318 0B66 319 0B85 320 0B8A 321 0BA1 322
|
||
0BA4 323 0BAB 324 0BAE 325 0BB43 515 104F 516 1058 517 1060 519 106B 521
|
||
1071 522 107C 523 1082 524 1097 525 10A6 526
|
||
10A9 527 10AF 528 10BE 529 10C1 530 106 09DD 247
|
||
09DD 249 09E3 250 09E8 251 09F4 252 09FC 254
|
||
0A03 255 0A06 256 0A06 257 0A13 258 0A15 259
|
||
0A18 260 0A19 261 0A21 255
|
||
0DCA 456 0DD1 458 0DD9 459 0DDA 460 0DE1 461
|
||
0DE4 462 0DEC 464 0DEF 465 0DF0 466 0DF0 467
|
||
0DFA 468 0E04 469 0E0A 470 0E12 0D26 389
|
||
0D2C 390 0D2F 391 0D32 392 0D33 393 0D33 396
|
||
0D39 397 0D3F 398 0D44 399 0D50 400 0D58 402
|
||
0D5F 403 0D62 404 0D68 405
|
||
1293 589 1299 590 12A5 591 12AC 593 12AF 594
|
||
12B0 595 12B0 596 12B6 597 12B9 598 12BC 599
|
||
12BF 600 12CF 601 12E1 602 12F3 606 327 0BB9 328
|
||
0BBC 329 0BBF 330 0BC7 331 0BCD 333 0BDB 334
|
||
0BDE 335 0BE6 337 0BEC 338 0BEF 339 0BEF 340
|
||
0BF2 341 0C0B 343 0CCF 531
|
||
10F3 533 1102 534 111B 535 112C 536 1133 537
|
||
1138 538 113B 539 1145 540 114A 541 1154 542
|
||
1161 543 1164 544 1164 545 164 0A2B 265 0A37 266
|
||
0A3C 267 0A4A 268 0A64 269 0A69 270 0A6D 271
|
||
0A72 272 0A79 273 0A7D 274 0A84 275 0A87 276
|
||
0A87 278 0C69 471 0E24 472
|
||
0E29 473 0E2F 474 0E45 475 0E48 476 0E56 477
|
||
0E71 478 0E79 479 0E84 480 0E8E 481 0E95 482
|
||
0E98 483 0E9F 484 0EA9 0D70 406 0D78 407
|
||
0D7D 408 0D83 409 0D86 410 0D86 411 0D93 412
|
||
0DA0 413 0DA2 414 0DA5 415 0DA8 416 0DA9 417
|
||
0DA9 418 0DB1 413 1305 604
|
||
1317 605 131F 606 1333 607 1338 608 133B 609
|
||
1341 610 1352 611 1359 612 135C 613 135C 614
|
||
1402 615 1402 616 1405 611 344 0C14 345 0C14 346
|
||
0C19 347 0C25 348 0C2D 349 0C35 350 0C38 351
|
||
0C46 352 0C46 353 0C49 354 0C51 355 0C54 356
|
||
0C5C 358 016B 546 1174 547
|
||
1177 548 117D 549 1183 550 118F 551 119E 552
|
||
11A1 553 11A4 554 11B8 555 11BD 556 11C4 558
|
||
11CA 559 11D2 560 281 0C6F 283 0C78 284 0C7F 285
|
||
0C86 286 0C89 287 0C8E 288 0A87 289 0A8C 290
|
||
0A8C 291 0A8F 292 0A9F 293 0AA8 294 0AAC 295
|
||
0AB4 486 0EB3 487 0EB6 488
|
||
0ED8 490 0EDE 491 0EE4 492 0EEA 493 0EED 494
|
||
0EED 495 0EFE 496 0F0C 497 0F24 498 0F2E 499
|
||
0F60 500 0F617 1408 618 1410 620
|
||
1413 621 141D 623 1420 624 1423 625 1426 626
|
||
142C 627 142F 629 1432 630 143F 631 1445 632
|
||
1448 633 1448 ke"
|
||
single: ds byte ;set true if single byte allocation map
|
||
resel: ds byte ;reselection flag
|
||
olddsk: ds byte ;disk on entry t裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹*********************************
|
||
;
|
||
jmp ccpstart ;start ccp with possible initial command
|
||
jmp ccpclear ;clear the command b裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹 program
|
||
xsubcon:
|
||
db 'xsub'
|
||
end
|
||
634 0433 635 043A 636 043E 637
|
||
0446 638 044F 640 0454 641 046C 642 0472 644
|
||
047A 645 0480 647 0488 648 048B 649 048B 650
|
||
048Bo bdos
|
||
fcbdsk: ds byte ;disk named in fcb
|
||
rcount: ds byte ;record count in current fcb
|
||
extval: ds byte ;extent number and exts word ;address of translate vector
|
||
fcb$copied:
|
||
ds byte ;set true if copy$fcb called
|
||
rmf: ds byte ;read mode flag for open$ruffer
|
||
maxlen: db 127 ;max buffer length
|
||
comlen: db 0 ;command length (filled in by dos)
|
||
; (command executed initially if coml裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹 * at ccp+8, with the command length at ccp+7. In this *
|
||
; * case, the ccp executes the command before prompting *
|
||
; * the c 651 048B 652 048F 653
|
||
0000 MODULE#
|
||
|
||
msk
|
||
vrecord:ds word ;current virtual record
|
||
arecord:ds word ;current actual record
|
||
arecord1: ds word ;current actual block# *eel
|
||
dirloc: ds byte ;directory flag in rename, etc.
|
||
seqio: ds byte ;1 if sequential i/o
|
||
linfo: ds byte ;low(info)
|
||
dminx: ds en non zero)
|
||
combuf:
|
||
db ' ' ;8 character fill
|
||
db ' ' ;8 character fill
|
||
db 'COPYRIGHT (C) 1979, DIGITAL RESE裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹onsole for input. Note that the command is exe-*
|
||
; * cuted on both warm and cold starts. When the command*
|
||
; * line is initi裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹 blkmsk
|
||
;
|
||
; local variables for directory access
|
||
dptr: ds byte ;directory pointer 0,1,2,3
|
||
dcnt: ds word ;directory counter 0byte ;local for diskwrite
|
||
searchl:ds byte ;search length
|
||
searcha:ds word ;search address
|
||
tinfo: ds word ;temp for info in "maARCH '; 38
|
||
ds 128-($-combuf)
|
||
; total buffer length is 128 characters
|
||
comaddr:dw combuf ;address of next to char to scan
|
||
st裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹alized, a jump to "jmp ccpclear" dis- *
|
||
; * ables the automatic command execution. *
|
||
; ***********************裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹,1,...,dirmax
|
||
drec: ds word ;directory record 0,1,...,dirmax/4
|
||
;
|
||
bios equ ($ and 0ff00h)+100h ;next module
|
||
end
|
||
addr: ds 2 ;starting address of current fillfcb request
|
||
;
|
||
diska equ 0004h ;disk address for current disk
|
||
bdos equ 0005h ;primy for next
|
||
call printchar! pop h ;character printed
|
||
jmp prin0 ;for another character
|
||
;
|
||
initialize:
|
||
mvi c,initf! jmp bdeturn
|
||
lf equ 10 ;line feed
|
||
la equ 5fh ;left arrow
|
||
eofile equ 1ah ;end of file
|
||
;
|
||
; utility procedures
|
||
printchar:
|
||
mov e,a!le given by d,e
|
||
mvi c,renf! jmp bdos
|
||
;
|
||
getuser:
|
||
;return current user code in a
|
||
mvi e,0ffh ;drop through to setuser
|
||
;
|
||
snction
|
||
searnf equ 18 ;search for next file function
|
||
delf equ 19 ;delete file function
|
||
dreadf equ 20 ;disk read function
|
||
dwriom:
|
||
;search for comfcb file
|
||
lxi d,comfcb! jmp search
|
||
;
|
||
delete: ;delete the file given by d,e
|
||
mvi c,delf! jmp bdos
|
||
;
|
||
bdary bdos entry point
|
||
buff equ 0080h ;default buffer
|
||
fcb equ 005ch ;default file control block
|
||
;
|
||
rcharf equ 1 ;read characteros
|
||
;
|
||
select:
|
||
mov e,a! mvi c,self! jmp bdos
|
||
;
|
||
bdos$inr:
|
||
call bdos! sta dcnt! inr a! ret
|
||
;
|
||
open: ;open the file given by mvi c,pcharf! jmp bdos
|
||
;
|
||
printbc:
|
||
;print character, but save b,c registers
|
||
push b! call printchar! pop b! ret
|
||
;
|
||
crlf:
|
||
etuser:
|
||
mvi c,userf! jmp bdos ;sets user number
|
||
;
|
||
saveuser:
|
||
;save user#/disk# before possible ^c or transient
|
||
caltf equ 21 ;disk write function
|
||
makef equ 22 ;file make function
|
||
renf equ 23 ;rename file function
|
||
logf equ 24 ;return login vos$cond:
|
||
call bdos! ora a! ret
|
||
;
|
||
diskread:
|
||
;read the next record from the file given by d,e
|
||
mvi c,dreadf! jmp bdos$cond
|
||
function
|
||
pcharf equ 2 ;print character function
|
||
pbuff equ 9 ;print buffer function
|
||
rbuff equ 10 ;read buffer function
|
||
break d,e
|
||
mvi c,openf! jmp bdos$inr
|
||
;
|
||
openc: ;open comfcb
|
||
xra a! sta comrec ;clear next record to read
|
||
lxi d,comfcb! jmp open mvi a,cr! call printbc
|
||
mvi a,lf! jmp printbc
|
||
;
|
||
blank:
|
||
mvi a,' '! jmp printbc
|
||
;
|
||
print: ;print string starting at b,c unl getuser ;code to a
|
||
add a! add a! add a! add a ;rot left
|
||
lxi h,cdisk! ora m ;4b=user, 4b=disk
|
||
sta diska ;stored away in mector
|
||
cself equ 25 ;return currently selected drive number
|
||
dmaf equ 26 ;set dma address
|
||
userf equ 32 ;set user number
|
||
;
|
||
; s
|
||
;
|
||
diskreadc:
|
||
;read the comfcb file
|
||
lxi d,comfcb! jmp diskread
|
||
;
|
||
diskwrite:
|
||
;write the next record to the file given byf equ 11 ;break key function
|
||
liftf equ 12 ;lift head function (no operation)
|
||
initf equ 13 ;initialize bdos function
|
||
self equ
|
||
;
|
||
close: ;close the file given by d,e
|
||
mvi c,closef! jmp bdos$inr
|
||
;
|
||
search: ;search for the file given by d,e
|
||
mvi c,seartil next 00 entry
|
||
push b! call crlf! pop h ;now print the string
|
||
prin0: mov a,m! ora a! rz ;stop on 00
|
||
inx h! push h ;reademory for later
|
||
ret
|
||
;
|
||
setdiska:
|
||
lda cdisk! sta diska ;user/disk
|
||
ret
|
||
;
|
||
translate:
|
||
;translate character in register A pecial fcb flags
|
||
rofile equ 9 ;read only file
|
||
sysfile equ 10 ;system file flag
|
||
;
|
||
; special characters
|
||
cr equ 13 ;carriage r d,e
|
||
mvi c,dwritf! jmp bdos$cond
|
||
;
|
||
make: ;create the file given by d,e
|
||
mvi c,makef! jmp bdos$inr
|
||
;
|
||
renam: ;rename the fi14 ;select disk function
|
||
openf equ 15 ;open file function
|
||
closef equ 16 ;close file function
|
||
searf equ 17 ;search for file fuf! jmp bdos$inr
|
||
;
|
||
searchn:
|
||
;search for the next occurrence of the file given by d,e
|
||
mvi c,searnf! jmp bdos$inr
|
||
;
|
||
searchcto upper case
|
||
cpi 61h! rc ;return if below lower case a
|
||
cpi 7bh! rnc ;return if above lower case z
|
||
ani 5fh! ret ;translate end of command
|
||
mov m,a ;store a zero
|
||
lxi h,combuf! shld comaddr ;ready to scan to zero
|
||
ret
|
||
;
|
||
break$key:
|
||
;check for all del$sub
|
||
;translate to upper case, store zero at end
|
||
call saveuser ;user # save in case control c
|
||
mvi c,rbuff! lxi d,ma: ;print characters until blank or zero
|
||
mov a,m! cpi ' '! jz comerr1; not blank
|
||
ora a! jz comerr1; not zero, so print it
|
||
|
||
;disk read is ok, transfer to combuf
|
||
lxi d,comlen! lxi h,buff! mvi b,128! call move0
|
||
;line is transferred, close theet to false
|
||
xra a! call select ;on drive a to erase file
|
||
lxi d,subfcb! call delete
|
||
lda cdisk! jmp select ;back to originald to upper case
|
||
;
|
||
readcom:
|
||
;read the next command into the command buffer
|
||
;check for submit file
|
||
lda submit! ora a! jz na character ready at the console
|
||
mvi c,breakf! call bdos
|
||
ora a! rz
|
||
mvi c,rcharf! call bdos ;character cleared
|
||
ora a! retxlen! call bdos
|
||
call setdiska ;no control c, so restore diska
|
||
noread: ;enter here from submit file
|
||
;set the last character push h! call printchar! pop h! inx h
|
||
jmp comerr0; for another character
|
||
comerr1: ;print question mark,and delete sub file file with a
|
||
;deleted record
|
||
lxi h,submod! mvi m,0 ;clear fwflag
|
||
inx h! dcr m ;one less record
|
||
lxi d,subfcb! cal drive
|
||
;
|
||
serialize:
|
||
;check serialization
|
||
lxi d,serial! lxi h,bdosl! mvi b,6 ;check six bytes
|
||
ser0: ldax d! cmp m! jnz baosub
|
||
;scanning a submit file
|
||
;change drives to open and read the file
|
||
lda cdisk! ora a! mvi a,0! cnz select
|
||
;have to
|
||
;
|
||
cselect:
|
||
;get the currently selected drive number to reg-A
|
||
mvi c,cself! jmp bdos
|
||
;
|
||
setdmabuff:
|
||
;set default buffer to zero for later scans
|
||
lxi h,comlen! mov b,m ;length is in b
|
||
readcom0: inx h! mov a,b! ora a ;end of scan?
|
||
jz readcom1!
|
||
mvi a,'?'! call printchar
|
||
call crlf! call del$sub
|
||
jmp ccp ;restart with next command
|
||
;
|
||
; fcb scan and fill subroutinl close! jz nosub
|
||
;close went ok, return to original drive
|
||
lda cdisk! ora a! cnz select
|
||
;print to the 00
|
||
lxi h,cdserial
|
||
inx d! inx h! dcr b! jnz ser0
|
||
ret ;serial number is ok
|
||
;
|
||
comerr:
|
||
;error in command string starting at position open again in case xsub present
|
||
lxi d,subfcb! call open! jz nosub ;skip if no sub
|
||
lda subrc! dcr a ;read ladma address
|
||
lxi d,buff ;(drop through)
|
||
;
|
||
setdma:
|
||
;set dma address to d,e
|
||
mvi c,dmaf! jmp bdos
|
||
;
|
||
del$sub:
|
||
;delete the mov a,m ;get character and translate
|
||
call translate! mov m,a! dcr b! jmp readcom0
|
||
;
|
||
readcom1: ;end of scan, h,l addresse (entry is at fillfcb below)
|
||
;fill the comfcb, indexed by A (0 or 16)
|
||
;subroutines
|
||
delim: ;look for a delimiter
|
||
ldax dombuf! call prin0
|
||
call break$key! jz noread
|
||
call del$sub! jmp ccp ;break key depressed
|
||
;
|
||
nosub: ;no submit file! c
|
||
;'staddr' and ending with first delimiter
|
||
call crlf ;space to next line
|
||
lhld staddr ;h,l address first to print
|
||
comerr0st record(s) first
|
||
sta subcr ;current record to read
|
||
lxi d,subfcb! call diskread ;end of file if last record
|
||
jnz nosub
|
||
submit file, and set submit flag to false
|
||
lxi h,submit! mov a,m! ora a! rz ;return if no sub file
|
||
mvi m,0 ;submit flag is s! ora a! rz ;not the last element
|
||
cpi ' '! jc comerr ;non graphic
|
||
rz ;treat blank as delimiter
|
||
cpi '='! rz
|
||
cpi la! if delimiter
|
||
inx d! jmp trname
|
||
;
|
||
padname: inx h! mvi m,' '! dcr b! jnz padname
|
||
;
|
||
setty: ;set the type field
|
||
mvi;set disk to name in register b
|
||
mov a,b! sta sdisk ;mark as disk selected
|
||
mov m,b! inx d ;past the :
|
||
;
|
||
setname: ;set tnd return with flags set
|
||
mov a,b! ora a! ret
|
||
;
|
||
intvec:
|
||
;intrinsic function names (all are four characters)
|
||
db 'DIR '
|
||
command address in d,e
|
||
call deblank ;to first non-blank character
|
||
xchg! shld staddr ;in case of errors
|
||
xchg! pop h ;d,e hatype field with blanks
|
||
inx h! mvi m,' '! dcr b! jnz padty
|
||
;
|
||
efill: ;end of the filename/filetype fill, save command addrz ;left arrow
|
||
cpi '.'! rz
|
||
cpi ':'! rz
|
||
cpi ';'! rz
|
||
cpi '<'! rz
|
||
cpi '>'! rz
|
||
ret ;delimiter not found
|
||
;
|
||
debla b,3! cpi '.'! jnz padty ;skip the type field if no .
|
||
inx d ;past the ., to the file type field
|
||
setty0: ;set the field frohe file name field
|
||
mvi b,8 ;file name length (max)
|
||
setnam0: call delim! jz padname ;not a delimiter
|
||
inx h! cpi '*'! jndb 'ERA '
|
||
db 'TYPE'
|
||
db 'SAVE'
|
||
db 'REN '
|
||
db 'USER'
|
||
intlen equ ($-intvec)/4 ;intrinsic function length
|
||
sers command, h,l has fcb address
|
||
;look for preceding file name A: B: ...
|
||
ldax d! ora a! jz setcur0 ;use current disk if empty ress
|
||
;fill the remaining fields for the fcb
|
||
mvi b,3
|
||
efill0: inx h! mvi m,0! dcr b! jnz efill0
|
||
xchg! shld comaddr ;senk: ;deblank the input line
|
||
ldax d! ora a! rz ;treat end of line as blank
|
||
cpi ' '! rnz! inx d! jmp deblank
|
||
;
|
||
addh: ;addm the command buffer
|
||
call delim! jz padty! inx h! cpi '*'! jnz setty1
|
||
mvi m,'?' ;since * specified! jmp setty2
|
||
;
|
||
z setnam1 ;must be ?'s
|
||
mvi m,'?'! jmp setnam2 ;to dec count
|
||
;
|
||
setnam1: mov m,a ;store character to fcb! inx d
|
||
setnaial: db 0,0,0,0,0,0
|
||
;
|
||
;
|
||
intrinsic:
|
||
;look for intrinsic functions (comfcb has been filled)
|
||
lxi h,intvec! mvi c,0 ;c countscommand
|
||
sbi 'A'-1! mov b,a ;disk name held in b if : follows
|
||
inx d! ldax d! cpi ':'! jz setdsk ;set disk name if :
|
||
;
|
||
sett new starting point
|
||
;
|
||
;recover the start address of the fcb and count ?'s
|
||
pop h! lxi b,11 ;b=0, c=8+3
|
||
scnq: inx h! a to h,l
|
||
add l! mov l,a! rnc
|
||
inr h! ret
|
||
;
|
||
fillfcb0:
|
||
;equivalent to fillfcb(0)
|
||
mvi a,0
|
||
;
|
||
fillfcb:
|
||
lxi h,comfcbsetty1: ;not a *, so copy to type field
|
||
mov m,a! inx d
|
||
setty2: ;decrement count and go again
|
||
dcr b! jnz setty0
|
||
;
|
||
m2: dcr b ;count down length! jnz setnam0
|
||
;
|
||
;end of name, truncate remainder
|
||
trname: call delim! jz setty ;set type field intrinsics as scanned
|
||
intrin0: mov a,c! cpi intlen ;done with scan?! rnc
|
||
;no, more to scan
|
||
lxi d,comfcb+1 ;beginning ofcur: ;set current disk
|
||
dcx d ;back to first character of command
|
||
setcur0:
|
||
lda cdisk! mov m,a! jmp setname
|
||
;
|
||
setdsk: mov a,m! cpi '?'! jnz scnq0
|
||
;? found, count it in b! inr b
|
||
scnq0: dcr c! jnz scnq
|
||
;
|
||
;number of ?'s in c, move to a a! call addh! push h! push h ;fcb rescanned at end
|
||
xra a! sta sdisk ;clear selected disk (in case A:...)
|
||
lhld comaddr! xchg ;
|
||
;end of type field, truncate
|
||
trtyp: ;truncate type field
|
||
call delim! jz efill! inx d! jmp trtyp
|
||
;
|
||
padty: ;pad the name
|
||
mvi b,4 ;length of match is in b
|
||
intrin1: ldax d! cmp m ;match?
|
||
jnz intrin2 ;skip if no match
|
||
inx d! inx h! ! sta cdisk ;current disk number saved
|
||
call fillfcb0 ;command fcb filled
|
||
cnz comerr ;the name cannot be an ambiguous referen ;proper disk is selected, now check sub files
|
||
;check for initial command
|
||
lda comlen! ora a! jnz ccp0 ;assume typed already
|
||
lxi b,11 ;(b=0, c=11)
|
||
;value accumulated in b, c counts name length to zero
|
||
conv0: mov a,m! cpi ' '! jz conv1
|
||
;more toloader
|
||
lxi sp,stack! push b ;save initial disk number
|
||
;(high order 4bits=user code, low 4bits=disk#)
|
||
mov a,c! rar! xi h,di or (hlt shl 8)
|
||
shld ccploc! lxi h,ccploc! pchl
|
||
;
|
||
;
|
||
;utility subroutines for intrinsic handlers
|
||
readerr:
|
||
dcr b
|
||
jnz intrin1 ;loop while matching
|
||
;
|
||
;complete match on name, check for blank in fcb
|
||
ldax d! cpi ' '! jnz intrice
|
||
lda sdisk! ora a! jnz userfunc
|
||
;check for an intrinsic function
|
||
call intrinsic
|
||
lxi h,jmptab ;index is in the accum
|
||
;
|
||
ccp:
|
||
;enter here on each command or error condition
|
||
lxi sp,stack
|
||
call crlf ;print d> prompt, where d is disk name
|
||
ca scan, convert char to binary and add
|
||
inx h! sui '0'! cpi 10! jnc comerr ;valid?
|
||
mov d,a ;save value! mov a,b ;mult by 1rar! rar! rar! ani 0fh ;user code
|
||
mov e,a! call setuser ;user code selected
|
||
;initialize for this user, get $ flag
|
||
c;print the read error message
|
||
lxi b,rdmsg! jmp print
|
||
rdmsg: db 'READ ERROR',0
|
||
;
|
||
nofile:
|
||
;print no file message
|
||
ln3 ;otherwise matched
|
||
mov a,c! ret ;with intrinsic number in a
|
||
;
|
||
intrin2: ;mismatch, move to end of intrinsic
|
||
inx hulator
|
||
mov e,a! mvi d,0! dad d! dad d ;index in d,e
|
||
mov a,m! inx h! mov h,m! mov l,a! pchl
|
||
;pc changes to the proper inll cselect ;get current disk number
|
||
adi 'A'! call printchar
|
||
mvi a,'>'! call printchar
|
||
call readcom ;command buffer filled
|
||
0
|
||
ani 1110$0000b! jnz comerr
|
||
mov a,b ;recover value
|
||
rlc! rlc! rlc ;*8
|
||
add b! jc comerr
|
||
add b! jc comerr ;*8+all initialize ;0ffh in accum if $ file present
|
||
sta submit ;submit flag set if $ file present
|
||
pop b ;recall usxi b,nofmsg! jmp print
|
||
nofmsg: db 'NO FILE',0
|
||
;
|
||
getnumber: ;read a number from the command line
|
||
call fillfcb0 ;should ! dcr b! jnz intrin2
|
||
;
|
||
intrin3: ;try next intrinsic
|
||
inr c ;to next intrinsic number
|
||
jmp intrin0 ;for another roundtrinsic or user function
|
||
jmptab:
|
||
dw direct ;directory search
|
||
dw erase ;file erase
|
||
dw type ;type file
|
||
dw save
|
||
ccp0: ;(enter here from initialization with command full)
|
||
lxi d,buff! call setdma ;default dma address at buff
|
||
call cselect*2 = *10
|
||
add d! jc comerr ;+digit
|
||
mov b,a! dcr c! jnz conv0 ;for another digit
|
||
ret
|
||
conv1: ;end of digits, check fer code and disk number
|
||
mov a,c! ani 0fh ;disk number in accumulator
|
||
sta cdisk ;clears user code nibble
|
||
call selectbe number
|
||
lda sdisk! ora a! jnz comerr ;cannot be prefixed
|
||
;convert the byte value in comfcb to binary
|
||
lxi h,comfcb+1!
|
||
;
|
||
ccpclear:
|
||
;clear the command buffer
|
||
xra a
|
||
sta comlen
|
||
;drop through to start ccp
|
||
ccpstart:
|
||
;enter here from boot ;save memory image
|
||
dw rename ;file rename
|
||
dw user ;user number
|
||
dw userfunc;user-defined function
|
||
badserial:
|
||
lor all blanks
|
||
mov a,m! cpi ' '! jnz comerr ;blanks?
|
||
inx h! dcr c! jnz conv1
|
||
mov a,b ;recover value! ret
|
||
;
|
||
movene! push d
|
||
;e=0,1,2,3,...new line if mod 4 = 0
|
||
ani 11b! push psw ;and save the test
|
||
jnz dirhdr0 ;header on current linelank request, must be in comfcb
|
||
dir1: mvi e,0! push d ;E counts directory entries
|
||
call searchcom ;first one has been found
|
||
r (mod 4)
|
||
dir6: call break$key ;check for interrupt at keyboard
|
||
jnz endir ;abort directory search
|
||
call searchn! jmp dir2mand
|
||
lda sdisk! ora a! rz ;no action if not selected
|
||
dcr a! lxi h,cdisk! cmp m! rz ;same disk
|
||
lda cdisk! jmp select
|
||
;
|
||
;may be 3rd item
|
||
cpi 3! jnz dirb ;place blank at end if not
|
||
mvi a,9! call addhcf ;first char of type
|
||
ani 7fh! cpi ' ame:
|
||
;move 3 characters from h,l to d,e addresses
|
||
mvi b,3
|
||
move0: mov a,m! stax d! inx h! inx d
|
||
dcr b! jnz move0
|
||
|
||
call crlf
|
||
push b! call cselect! pop b
|
||
;current disk in A
|
||
adi 'A'! call printbc
|
||
mvi a,':'! call printbc
|
||
|
||
cz nofile ;not found message
|
||
dir2: jz endir
|
||
;found, but may be system file
|
||
lda dcnt ;get the location of the element
|
||
;for another entry
|
||
endir: ;end of directory scan
|
||
pop d ;discard directory counter
|
||
jmp retcom
|
||
;
|
||
;
|
||
erase:
|
||
call fillf
|
||
;individual intrinsics follow
|
||
direct:
|
||
;directory search
|
||
call fillfcb0 ;comfcb gets file name
|
||
call setdisk ;change disk '! jz dir5
|
||
;not a blank in the file type field
|
||
dirb: mvi a,' ' ;restore trailing filename chr
|
||
dir4:
|
||
call printbc ;ret
|
||
;
|
||
addhcf: ;buff + a + c to h,l followed by fetch
|
||
lxi h,buff! add c! call addh! mov a,m! ret
|
||
;
|
||
setdisk:
|
||
;changejmp dirhdr1 ;skip current line hdr
|
||
dirhdr0:call blank ;after last one
|
||
mvi a,':'! call printbc
|
||
dirhdr1:
|
||
call blank
|
||
rrc! rrc! rrc! ani 110$0000b! mov c,a
|
||
;c contains base index into buff for dir entry
|
||
mvi a,sysfile! call addhcf ;value cb0 ;cannot be all ???'s
|
||
cpi 11
|
||
jnz erasefile
|
||
;erasing all of the disk
|
||
lxi b,ermsg! call print!
|
||
call readcom
|
||
lxidrives if requested
|
||
lxi h,comfcb+1! mov a,m ;may be empty request
|
||
cpi ' '! jnz dir1 ;skip fill of ??? if not blank
|
||
;set cchar printed
|
||
inr b! mov a,b! cpi 12! jnc dir5
|
||
;check for break between names
|
||
cpi 9! jnz dir3 ;for another char
|
||
; disks for this command, if requested
|
||
xra a! sta comfcb ;clear disk name from fcb
|
||
lda sdisk! ora a! rz ;no action if not s
|
||
;compute position of name in buffer
|
||
mvi b,1 ;start with first character of name
|
||
dir3: mov a,b! call addhcf ;buff+a+c feto A
|
||
ral! jc dir6 ;skip if system file
|
||
;c holds index into buffer
|
||
;another fcb found, new line?
|
||
pop d! mov a,e! inr h,comlen! dcr m! jnz ccp ;bad input
|
||
inx h! mov a,m! cpi 'Y'! jnz ccp
|
||
;ok, erase the entire diskette
|
||
inx h! shld comaddomfcb to all ??? for current disk
|
||
mvi b,11 ;length of fill ????????.???
|
||
dir0: mvi m,'?'! inx h! dcr b! jnz dir0
|
||
;not a bprint a blank between names
|
||
call blank! jmp dir3
|
||
;
|
||
dir5: ;end of current entry
|
||
pop psw ;discard the directory countepecified
|
||
dcr a! lxi h,cdisk! cmp m! rz ;already selected
|
||
jmp select
|
||
;
|
||
resetdisk:
|
||
;return to original disk after comtched
|
||
ani 7fh ;mask flags
|
||
;may delete trailing blanks
|
||
cpi ' '! jnz dir4 ;check for blank type
|
||
pop psw! push psw r ;otherwise error at retcom
|
||
erasefile:
|
||
call setdisk
|
||
lxi d,comfcb! call delete
|
||
inr a ;255 returned if not found
|
||
czunt zero
|
||
mov a,h! ora l! jz save1 ;may be completed
|
||
dcx h ;sector count = sector count - 1
|
||
push h ;save it for next timer
|
||
;
|
||
;should be followed by a file to save the memory image
|
||
call fillfcb0
|
||
jnz comerr ;cannot be ambiguous
|
||
call se! inx h! shld comaddr ;past delimiter
|
||
;proper delimiter found
|
||
call fillfcb0! jnz renerr2
|
||
;check for drive conflict
|
||
nz typeof ;hard end of file
|
||
xra a! mov m,a ;bptr = 0
|
||
type1: ;read character at bptr and print
|
||
inr m ;bptr = bptr + 1
|
||
jmp retcom
|
||
fullmsg: db 'NO SPACE',0
|
||
;
|
||
;
|
||
rename:
|
||
;rename a file on a specific disk
|
||
call fillfcb0! jnz comerr ;must be nofile ;no file message if so
|
||
jmp retcom
|
||
;
|
||
ermsg: db 'ALL (Y/N)?',0
|
||
;
|
||
type:
|
||
call fillfcb0! jnz comerr ;don't allow ?'e around
|
||
lxi h,128! dad d! push h ;next dma address saved
|
||
call setdma ;current dma address set
|
||
lxi d,comfcb! call diskwtdisk ;may be a disk change
|
||
lxi d,comfcb! push d! call delete ;existing file removed
|
||
pop d! call make ;create a new file opop psw! mov b,a ;previous drive number
|
||
lxi h,sdisk! mov a,m! ora a! jz ren2
|
||
;drive name was specified. same one?
|
||
c
|
||
lxi h,buff! call addh ;h,l addresses char
|
||
mov a,m! cpi eofile! jz retcom
|
||
call printchar
|
||
call break$key! jnz retc unambiguous
|
||
lda sdisk! push psw ;save for later compare
|
||
call setdisk ;disk selected
|
||
call searchcom ;is new name already ts in file name
|
||
call setdisk! call openc ;open the file
|
||
jz typerr ;zero flag indicates not found
|
||
;file opened, read 'til erite
|
||
pop d! pop h ;dma address, sector count
|
||
jnz saverr ;may be disk full case
|
||
jmp save0 ;for another sector
|
||
;
|
||
savn disk
|
||
jz saverr ;no directory space
|
||
xra a! sta comrec; clear next record field
|
||
pop psw ;#pages to write is in a, changmp b! mov m,b! jnz renerr2
|
||
ren2: mov m,b ;store the name in case drives switched
|
||
xra a! sta comfcb! call searchcom ;is old om ;abort if break
|
||
jmp type0 ;for another character
|
||
;
|
||
typeof: ;end of file, check for errors
|
||
dcr a! jz retcom
|
||
here?
|
||
jnz renerr3
|
||
;file doesn't exist, move to second half of fcb
|
||
lxi h,comfcb! lxi d,comfcb+16! mvi b,16! call move0
|
||
of
|
||
call crlf! lxi h,bptr! mvi m,255 ;read first buffer
|
||
type0: ;loop on bptr
|
||
lxi h,bptr! mov a,m! cpi 128 ;end buffer
|
||
e1: ;end of dump, close the file
|
||
lxi d,comfcb! call close
|
||
inr a; 255 becomes 00 if error
|
||
jnz retsave ;for another commae to #sectors
|
||
mov l,a! mvi h,0! dad h!
|
||
lxi d,tran ;h,l is sector count, d,e is load address
|
||
save0: ;check for sector cofile there?
|
||
jz renerr1
|
||
;
|
||
;everything is ok, rename the file
|
||
lxi d,comfcb! call renam
|
||
jmp retcom
|
||
;
|
||
renerr1:; call readerr
|
||
typerr: call resetdisk! jmp comerr
|
||
;
|
||
save:
|
||
call getnumber; value to register a
|
||
push psw ;save it for lat ;check for = or left arrow
|
||
lhld comaddr! xchg! call deblank
|
||
cpi '='! jz ren1 ;ok if =
|
||
cpi la! jnz renerr2
|
||
ren1: xchg jc type1! push h ;carry if 0,1,...,127
|
||
;read another buffer full
|
||
call diskreadc! pop h ;recover address of bptr
|
||
jnd
|
||
saverr: ;must be full or read only disk
|
||
lxi b,fullmsg! call print
|
||
retsave:
|
||
;reset dma buffer
|
||
call setdmabuff
|
||
no file on disk
|
||
call nofile! jmp retcom
|
||
renerr2:; ambigous reference/name conflict
|
||
call resetdisk! jmp comerr
|
||
renerr3:umber set to zero
|
||
lxi d,fcb! lxi h,comfcb! mvi b,33! call move0
|
||
;move command line to buff
|
||
lxi h,combuf
|
||
bmove0: mnz load1
|
||
;sector loaded, set new dma address and compare
|
||
pop h! lxi d,128! dad d
|
||
lxi d,tranm ;has the load overflowe裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹h
|
||
lda sdisk! ora a! jz endcom ;no disk name if 0
|
||
dcr a! sta cdisk! call setdiska ;set user/disk
|
||
call select! jmp endcomaded program
|
||
lxi sp,stack ;may come back here
|
||
call setdiska! call select
|
||
jmp ccp
|
||
;
|
||
userer: ;arrive here on com; file already exists
|
||
lxi b,renmsg! call print! jmp retcom
|
||
renmsg: db 'FILE EXISTS',0
|
||
;
|
||
user:
|
||
;set user number
|
||
call ov a,m! ora a! jz bmove1! cpi ' '! jz bmove1
|
||
inx h! jmp bmove0 ;for another scan
|
||
;first blank position found
|
||
bmove1: d?
|
||
mov a,l! sub e! mov a,h! sbb d! jnc loaderr
|
||
jmp load0 ;for another sector
|
||
;
|
||
load1: pop h! dcr a! jnz loaderr ;裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹
|
||
user0: ;file name is present
|
||
lxi d,comfcb+9! ldax d! cpi ' '! jnz comerr ;type ' '
|
||
push d! call setdisk! pop d! lxi h,cmand error
|
||
call resetdisk! jmp comerr
|
||
;
|
||
loaderr:;cannot load the program
|
||
lxi b,loadmsg! call print
|
||
jmp retcomgetnumber; leaves the value in the accumulator
|
||
cpi 16! jnc comerr; must be between 0 and 15
|
||
mov e,a ;save for setuser call
|
||
mvi b,0! lxi d,buff+1! ;ready for the move
|
||
bmove2: mov a,m! stax d! ora a! jz bmove3
|
||
;more to move
|
||
inr b! inx h! inx end file is 1
|
||
call resetdisk ;back to original disk
|
||
call fillfcb0! lxi h,sdisk! push h
|
||
mov a,m! sta comfcb ;drive nu裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹omtype ;.com
|
||
call movename ;file type is set to .com
|
||
call openc! jz userer
|
||
;file opened properly, read it into memory
|
||
裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹 lda comfcb+1! cpi ' '! jz comerr
|
||
call setuser ;new user number set
|
||
jmp endcom
|
||
;
|
||
userfunc:
|
||
call serialize ;check serialid! jmp bmove2
|
||
bmove3: ;b has character count
|
||
mov a,b! sta buff
|
||
call crlf
|
||
;now go to the loaded program
|
||
call smber set
|
||
mvi a,16! call fillfcb ;move entire fcb to memory
|
||
pop h! mov a,m! sta comfcb+16
|
||
xra a! sta comrec ;record n裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹 lxi h,tran ;transient program base
|
||
load0: push h ;save dma address
|
||
xchg! call setdma
|
||
lxi d,comfcb! call diskread! j裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹zation
|
||
;load user function and set up for execution
|
||
lda comfcb+1! cpi ' '! jnz user0
|
||
;no file name, but may be disk switcetdmabuff ;default dma
|
||
call saveuser ;user code saved
|
||
;low memory diska contains user code
|
||
call tran ;gone to the lo |