裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹OS1BOOT ASMOS2CCP ASM OS2CCP ASMHOS3BDOS 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 1880hOS3BDOS ASM./0123456789:;<=OS3BDOS ASM>?@ABCDEFGHIJKLMOS3BDOS ASMNOPQRSTUVWXYZ[\ﾛ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 ;OS5TRINTSRCiXSUB0 ASMjklﾜXSUB1 ASMmnopPIP PLMqrstuvwxyz{|}~裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹裹 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 ;nuPIP PLM≠ヤ�㊧炎旧克署PIP PLM葬灯楓利劒屆撼泛PIP PLM ｡｢PIP LINP｣､･ｦｧｨｩｪｫｬ 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 PLMEｭｮｯｰｱｲｳｴｵSUBMIT LINｶｷSTAT PLMｸｹｺｻｼｽｾｿﾀﾁﾂﾃﾄﾅﾆﾇSTAT PLMdﾈﾉﾊﾋﾌﾍﾎﾏﾐﾑﾒﾓﾔ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