|
DataMuseum.dkPresents historical artifacts from the history of: CP/M |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about CP/M Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - download
Length: 19456 (0x4c00)
Types: TextFile
Names: »FILEX.ASM«
└─⟦149f13eca⟧ Bits:30005349 SW1311/I5 RC703 CP/M System diskette
└─ ⟦this⟧ »FILEX.ASM«
└─⟦453bf3224⟧ Bits:30003070 RC703 - 56K CP/M 2.2 rel 1.2
└─⟦453bf3224⟧ Bits:30004758 SW1311 CP/M ver. 2.2 rel 1.2 til RC703
└─ ⟦this⟧ »FILEX.ASM«
└─⟦693a7a378⟧ Bits:30003305 COMPAS, RcTekst, RcKalk, RCComal80 til RC703
└─ ⟦this⟧ »FILEX.ASM«
;FILEX program version 1.0 19 jan 83
;
boot equ 0000h ; warmboot entry
bdos equ 0005h ; bdos entry
;
false equ 0 ;
true equ 1 ;
;
reader equ 3 ; bdos functions
punch equ 4 ;
print equ 9 ;
readco equ 10 ;
open equ 15 ;
close equ 16 ;
delete equ 19 ;
read equ 20 ;
write equ 21 ;
make equ 22 ;
setdma equ 26 ;
;
ok equ 0 ; result values
nexist equ 1 ;
full equ 2 ;
eof equ 3 ;
transm equ 4 ;
;
dc1 equ 11h ;
dc3 equ 13h ;
;
;
org 0100h ;
;
start: lxi sp,stack ;
lxi d,0080h ;
lxi h,conslen ; move program call parameters
ldax d ; to cons buffer
mov b,a ;
mov m,a ;
inx h ;
inx d ;
m1: mov a,b ;
ora a ;
jz mm ;
ldax d ;
mov m,a ;
inx h ;
inx d ;
dcr b ;
jmp m1 ;
mm: lxi d,0080h ;
ldax d ;
cpi 0 ;
jnz m2 ;
lxi h,readcons ; readcons:=no parameters specified
mvi m,true ; after program name
m2: lxi d,sttext ; write('FILEX - ver x.x');
mvi c,print ;
call bdos ;
;
act: lxi sp,stack ;
call getnextitem ; getnextitem;
lxi h,itemlen ;
lxi d,receive ;
call comp ;
jz sleep ; if item='REMOTE' then goto sleep;
lda itemlen ;
cpi 0 ;
jz endprog ; if item='' then goto endprog;
lxi h,itemlen ;
lxi d,noend ;
call comp ;
jz boot ; if item='NOEND' then goto boot;
act2: call buildname ; name:=buildname(item)
lxi d,unitnr ;
lda remote ;
sta lhandside ; lhandside:= (Rx: specified)
cpi true ;
jz act3 ; if not Rx: specified then
xra a ; begin
sta sfcbcr ; sfcbrc:=0;
lxi h,sfcb ; sfcbname:=name
jmp act4 ; end
act3: lxi h,bufname ; else
act4: call movename ; begin
call getnextitem ; buf.name:=name
lxi h,itemlen ; end;
lxi d,equal ; getnextitem;
call comp ; if item<>'=' then goto parameter-rror;
jnz parmerr ; getnextitem;
call getnextitem ; buildname(item);
call buildname ; if lhandside=(Rx: specified)
lda remote ; then goto parameter-error;
lxi h,lhandside ; if Rx: specified then goto rtol;
cmp m ;
jz parmerr ;
cpi true ;
jz rtol ; sfcbname:=name;
lxi d,unitnr ; sfcbrc:=0;
lxi h,sfcb ;
call movename ;
xra a ;
sta sfcbcr ;
;
; LOCAL -> REMOTE
ltor: mvi c,open ; open(source);
lxi d,sfcb ;
call bdos ;
cpi 0ffh ; if open-error then abort
jz openerr ;
lda bufname+1 ; if buf.name='' then
cpi ' ' ;
jnz ltor1 ; begin
lxi d,name ; buf.name:=name (except unitno)
lxi h,bufname+1 ; end;
call moveonlyname ;
ltor1: mvi a,2 ;
sta bufop ; buf.operation:=2; (*make*)
lxi h,antal ;
mvi m,19 ;
inx h ;
mvi m,0 ; antal:=19;
call outandin ; outline(buf,antal);
; inline(buf,antal);
lda bufst ;
cpi transm ; if transmission error then abort
jz trxerr ;
cpi ok ; if make-error then abort
jnz makeerr ;
mvi c,setdma ;
lxi d,bufarea ;
call bdos ; setdma(buf.area);
mvi a,4 ;
sta bufop ; buf.operation:=4; (* write *)
ltor2: lxi d,sfcb ; while not eof(source) do
; begin
mvi c,read ; read(source);
call bdos ;
ora a ;
jnz closefiles ;
lxi h,antal ;
mvi m,131 ; antal:=131;
inx h ;
mvi m,0 ;
call outandin ; outline(buf,antal);
; inline(buf,antal);
lda bufst ;
cpi transm ; if transmission-error then abort
jz trxerr ;
cpi ok ; if write-error then abort
jnz writeerr ;
jmp ltor2 ; end;
;
;
; REMOTE -> LOCAL
rtol: lxi d,unitnr ; buf.name:=name
lxi h,bufname ;
call movename ;
xra a ;
sta sfcbcr ; sfcbcr:=0;
lda sfcb+1 ; if destname='' then
cpi ' ' ; begin
jnz rtol1 ; sfcbname:=name;
lxi d,name ;
lxi h,sfcb+1 ;
call moveonlyname ; end;
rtol1: mvi a,1 ;
sta bufop ; buf.operation:=1; (*open*)
lxi h,antal ;
mvi m,19 ; antal:=19;
inx h ;
mvi m,0 ;
call outandin ; outline(buf,antal);
; inline(buf,antal);
lda bufst ;
cpi transm ; if transmission-error then abort
jz trxerr ;
cpi ok ; if open-error then abort
jnz openerr ;
mvi c,delete ; delete(destination);
lxi d,sfcb ;
call bdos ;
mvi c,make ; make(destination);
lxi d,sfcb ;
call bdos ;
cpi 0ffh ; if make-error then abort
jz makeerr ;
mvi c,setdma ;
lxi d,bufarea ; setdma(buf.area);
call bdos ;
mvi a,3 ; buf.operation:=3; (* read *)
sta bufop ;
rtol2: lxi h,antal ;
mvi m,3 ;
inx h ;
mvi m,0 ; antal:=0;
call outandin ; outline(buffer,antal);
; inline(buffer,antal);
lda status ;
ora a ; if receive_status=error or
jnz trxerr ; buffer_status=transm_error
lda bufst ; then exit to transmission_error
cmp transm ; else
jz trxerr ; begin
ora a ; if buffer_status<>0
jnz closefiles ; then close files
lxi d,sfcb ; end;
mvi c,write ;
call bdos ;
ora a ; if write-error then abort
jnz writeerr ;
jmp rtol2 ;
;
closefiles: ;
mvi a,5 ;
sta bufop ; buf.operation:=5 (* close *)
lxi h,antal ;
mvi m,3 ; antal:=3;
call outandin ; outline(buf,antal);
; inline(buf,antal);
lda bufst ;
cpi transm ; if transmission-error then abort
jz trxerr ;
cpi ok ;
jnz clsrerr ; if close-error on remote then abort
mvi c,close ;
lxi d,sfcb ;
call bdos ; close(source/destination);
cpi 0ffh ;
jz clslerr ; if close-error on local then abort
jmp act ; goto start:
;
endprog: ;
mvi a,6 ;
sta bufop ; buf.operation:=6 (* end *)
lxi h,antal ;
mvi m,3 ; antal:=3;
call outandin ; outline(buf,antal);
; inline(buf,antal);
jmp boot ; warmboot;
;end.
;
**********************************************************************
* *
* sleeping partner *
* *
**********************************************************************
; sleep:
sleep: lxi d,oktext ; write('REMOTE OPERATION');
mvi c,print ;
call bdos ;
sleep1: lxi h,result ;
mvi m,ok ;
call inline ; repeat
lda status ; inline(buffer,antal)
cpi ok ; if ok then
jnz transerr ; begin
lda bufop ; case buf.operation of
lxi h,jmptable-3 ;
mov b,a ;
add b ;
add b ;
mov c,a ;
xra a ;
mov b,a ;
dad b ;
pchl ;
jmptable: ;
jmp openf ; 1: openfile(buf.name);
jmp makef ; 2: makefile(buf.name);
jmp readf ; 3: readfile;
jmp writef ; 4: writefile;
jmp closef ; 5: closefile;
jmp endf ; 6: endsession;
;
;
transerr: ;
lxi h,result ;
mvi m,transm ;
jmp senda3 ;
openf: lxi d,bufname ;
lxi h,sfcb ;
call movename ; 1: begin (* open *)
sub a ;
sta sfcbcr ;
mvi c,open ; movename;
lxi d,sfcb ;
call bdos ; open(buf.name)
inr a ;
jnz open1 ;
lxi h,result ;
mvi m,nexist ;
jmp senda3 ;
open1: mvi c,setdma ; setdma(buf.area)
lxi d,bufarea ;
call bdos ;
jmp senda3 ; end;
;
makef: lxi d,bufname ;
lxi h,sfcb ;
call movename ; 2: begin (* make *)
sub a ;
sta sfcbcr ;
mvi c,delete ; movename;
lxi d,sfcb ;
call bdos ; delete(buf.name);
mvi c,make ; make(buf.name);
lxi d,sfcb ;
call bdos ;
inr a ;
jnz make1 ;
lxi h,result ;
mvi m,full ;
jmp senda3 ;
make1: mvi c,setdma ; setdma(buf.area);
lxi d,bufarea ;
call bdos ;
jmp senda3 ; end;
;
readf: lxi d,sfcb ; 3: begin (* read *)
mvi c,read ; read;
call bdos ;
ora a ;
jz senda131 ;
lxi h,result ;
mvi m,eof ;
jmp senda3 ; end;
;
writef: lxi d,sfcb ; 4: begin (* write *)
mvi c,write ; write;
call bdos ;
ora a ;
jz senda3 ;
lxi h,result ;
mvi m,full ;
jmp senda3 ; end;
;
closef: lxi d,sfcb ; 5: begin (* close *)
mvi c,close ; close;
call bdos ;
inr a ;
jnz senda3 ;
lxi h,result ;
mvi m,full ;
jmp senda3 ; end;
;
endf: ; 6: begin (* end *)
;
; end;
; end;
;
senda3: lxi h,antal ;
mvi m,3 ;
jmp senda ;
;
senda131: ;
lxi h,antal ;
mvi m,131 ;
;
senda: inx h ;
mvi m,0 ;
lda result ;
sta bufst ;
call outline ; outline(buffer,antal);
lda bufop ;
cpi 6 ; until bufop=6;
jnz sleep1 ;
;
jmp boot ;
;
;
openerr: ;
lxi d,mopen ;
jmp printerr ;
;
makeerr: ;
lxi d,mmake ;
jmp printerr ;
;
writeerr: ;
lxi d,mwrite ;
jmp printerr ;
;
clsrerr: ;
lxi d,mremclose ;
jmp printerr ;
;
clslerr: ;
lxi d,mlocclose ;
jmp printerr ;
;
trxerr: ;
lxi d,mtxmerr ;
jmp printerr ;
;
parmerr: ;
lxi d,mparmerr ;
jmp printerr ;
;
;
printerr: ;
mvi c,print ;
call bdos ; write error message to console
lda readcons ; if read-from-console=false
cpi false ; then goto cpm
jz boot ; else
xra a ; begin
sta conslen ; len(cons):=0
jmp act ; end;
; goto start;
;
;
getnextitem: ; procedure getnextitem
lxi h,conspil ; begin
mvi b,0 ; while conspil<=len(cons) and
mov c,m ; cons(conspil)=' ' do
lxi h,cons ; begin
dcx h ;
dad b ; conspil:=conspil+1;
getn2: lda conslen ; end;
cmp c ;
jm getn3 ;
mov a,m ;
cpi ' ' ;
jnz getn5 ;
inr c ;
inx h ;
jmp getn2 ;
getn3: lda readcons ; if conspil>len(cons) then
cpi 0 ; begin
jz getn10 ; if readcons then
lxi d,star ; begin
mvi c,print ; write('* ');
call bdos ; readln(cons);
lxi d,consmax ;
mvi c,readco ;
call bdos ;
lxi d,crnl ; writeln;
mvi c,print ;
call bdos ;
lda conslen ;
mov c,a ; for i=1 to len(cons) do
mvi b,32 ; begin
lxi h,cons ; if consÆiÅ>='a' then
getnn: mov a,m ; consÆiÅ:=consÆiÅ-('a'-'A');
cpi 'a' ; (* convert lower case
jm getn ; to upper case *)
sub b ; end;
mov m,a ;
getn: inx h ;
dcr c ;
jnz getnn ;
mvi b,0 ;
mvi c,1 ; pil := 1;
lxi h,cons ;
dad b ;
dcx h ;
getn4: lda conslen ;
cmp c ; while conspil<=len(cons) and
jm getn10 ; cons(conspil)=' ' do
mov a,m ; begin
cpi ' ' ; conspil:=conspil+1;
jnz getn5 ; end;
inr c ;
inx h ;
jmp getn4 ; end
getn10: lxi h,itemlen ; else
mvi m,0 ; begin
ret ; itemlen:=0;
; return;
; end;
getn5: lxi d,item ;
mvi b,1 ; i := 1;
mov a,m ;
cpi '=' ; if consÆpilÅ='=' then
jnz getn6 ; begin
stax d ; itemÆ1Å:='=';
lxi h,itemlen ;
mvi m,1 ; itemlen:=1;
inr c ;
lxi h,conspil ; pil:=pil+1;
mov m,c ; return;
ret ; end;
getn6: lda conslen ; while pil<=len(cons) and
cmp c ; cons(pil)<>' ' and
jm getn7 ; cons(pil)<>'=' do
mov a,m ; begin
cpi ' ' ;
jz getn7 ;
cpi '=' ;
jz getn7 ;
push b ;
push h ;
lxi h,badchar ; if pos('<>,;?*ÆÅ',consÆpilÅ)<>0
mvi b,m ;
getchk: inx h ; (* check for illegal characters *)
cmp m ;
jz parmerr ; then exit to parameter-error
dcr b ;
jnz getchk ; else
pop h ; begin
pop b ; nameÆiÅ:=consÆpilÅ;
stax d ; i:=i+1;
inr b ; pil:=pil+1;
inr c ; end;
inx d ;
inx h ; end;
jmp getn6 ;
getn7: lxi d,itemlen ; itemlen:=i-1;
mov a,b ;
dcr a ;
stax d ;
lxi h,conspil ;
mov m,c ;
ret ;end;
;
buildname: ; procedure buildname;
lxi h,fejl ; begin
mvi m,false ; fejl:=false;
lxi h,remote ;
mvi m,false ; remote:=false;
mvi b,11 ;
lxi h,name ;
build1: mvi m,' ' ; name:= ' ';
inx h ; name2:=' ';
dcr b ;
jnz build1 ;
lxi h,item+1 ;
mov a,m ;
cpi ':' ; if itemÆ2Å=':' then
jnz build2 ; begin
dcx h ;
mov a,m ;
mvi c,'A'-1 ;
sub c ;
lxi h,unitnr ;
mov m,a ; unitnr:=ord(itemÆ1Å)-(ord('A')-1);
lxi h,item+2 ; pos := 3;
mvi c,3 ;
jmp build4 ; end;
build2: inx h ; else
mov a,m ; begin
cpi ':' ; if itemÆ3Å=':' and
jnz build3 ;
lxi h,item ;
mov a,m ;
cpi 'R' ; itemÆ1Å='R' then
jnz build3 ;
lxi h,remote ; begin
mvi m,true ;
lxi h,item+1 ; remote:=true;
mov a,m ;
mvi c,'A'-1 ;
sub c ;
lxi h,unitnr ;
mov m,a ; unitnr:=ord(itemÆ2Å)-(ord('A')-1);
lxi h,item+3 ;
mvi c,4 ; end;
jmp build4 ; else
build3: lxi h,unitnr ; begin
mvi m,0 ; (* no disk specified *)
lxi h,item ; end;
mvi c,1 ; end;
build4: mvi b,1 ; pil :=1;
lxi d,name ;
build5: lda itemlen ; while pos<=itemlen and
cmp c ; pil<=8 and
rm ; itemÆposÅ<>'.' do
mvi a,8 ; begin
cmp b ; nameÆpilÅ:=itemÆposÅ;
jm build6 ; pil:=pil+1;
mov a,m ; pos:=pos+1;
cpi '.' ; end;
jz build7 ;
mov a,m ;
stax d ;
inr b ;
inr c ;
inx d ;
inx h ;
jmp build5 ;
build6: lda itemlen ; while pos<=itemlen and
cmp c ; itemÆposÅ<>'.' do
rm ; begin
mov a,m ; pos:=pos+1;
cpi '.' ; end;
jz build7 ;
inr c ;
inx h ;
jmp build6 ;
build7: inr c ; while pos<=itemlen and
inx h ; pil<=3 do
mvi b,1 ;
lxi d,name2 ; begin
build8: lda itemlen ; name2ÆpilÅ:=itemÆposÅ;
cmp c ; pil:=pil+1;
rm ; pos:=pos+1;
mvi a,3 ; end;
cmp b ;
rm ;
mov a,m ;
cpi '.' ;
jz parmerr ;
stax d ;
inr b ;
inr c ;
inx d ;
inx h ;
jmp build8 ;
;
;
movename: ; procedure movename;
mvi c,16 ; begin
move1: ldax d ;
mov m,a ;
inx d ;
inx h ;
dcr c ;
jnz move1 ;
ret ; end;
;
moveonlyname: ; procedure moveonlyname;
mvi c,15 ; begin
jmp move1 ; end;
;
comp: ldax d ; function compare:boolean;
cmp m ; begin
rnz ; if len(s1)<>len(s2) then return;
mov b,a ;
cmp1: inx d ; for i:=1 to len(s1) do
inx h ; begin
ldax d ; if s1ÆiÅ<>s2ÆiÅ then return;
cmp m ;
rnz ; end;
dcr b ;
jnz cmp1 ;
ret ; return;
;end;
;
;
;
outandin: ;procedure outandin;
call outline ;begin
call inline ; outline(buf,antal);
ret ; inline(buf,antal);
;end;
;
;
inline: ;procedure inline(buf,antal);
;begin
inl1: call rec ; repeat
cpi 35 ; rec(ch);
jnz inl1 ; until ord(ch)<>35;
lxi h,antal ;
inx h ;
call rdata ; rdata(right);
dcx h ;
call rdata ; rdata(left);
lhld antal ; antal:=left shift 8 + right;
mov b,h ;
mov c,l ;
lxi h,buffer ;
inl2: ; i:=0;
mov a,b ; while antal>0 do
ora c ; begin
jz inl3 ;
call rdata ; rdata(buf.area(i));
inx h ; i:=i+1;
dcx b ; antal:=antal-1;
jmp inl2 ; end;
inl3: lxi h,checksum ; rdata(checksum);
call rdata ;
call rec ; if rec(ch)=13 then
cpi 13 ;
jnz inl6 ; begin
mvi a,0 ;
lhld antal ; calc_check:=0;
mov b,h ; i:=0;
mov c,l ;
lxi h,buffer ;
inl4: mov d,a ; while antal>0 do
mov a,b ; begin
ora c ;
mov a,d ;
jz inl5 ;
add m ; calc_check:=calc_check+buf.area(i)
in h ; i:=i+1;
dcx b ; antal:=antal-1;
jmp inl4 ; end;
inl5: lxi h,checksum ; if calck_check+checksum=0 then
add m ; status:=ok
jnz inl6 ; else
sub a ; status:=error;
sta status ; end;
ret ; else
inl6: mvi a,1fh ; status:=error;
sta status ;
ret ; end;
;
rdata: push h ; procedure rdata(ch);
push b ;
call rec ; begin
ani 0fh ; rec(ch1);
rlc ; ch1:=(ch1 and 1111B) shift 4;
rlc ;
rlc ;
rlc ;
mov e,a ;
push d ;
call rec ; rec(ch2);
pop d ;
ani 0fh ; ch2:=ch2 and 1111B;
ora e ; ch:=ch1+ch2;
pop b ;
pop h ;
mov m,a ;
ret ; end;
;
rec: mvi c,reader ; procedure rec(ch);
; begin
call bdos ; goto readerinput(ch);
ani 7fh ; end;
ret ;
;
; procedure outline(buf,antal)
outline: ; begin
mvi a,35 ; write(chr(35));
call xmt ;
lxi h,antal+1 ;
call xdata ; xdata(antal div 256);
dcx h ;
call xdata ; xdata(antal mod 256);
lhld antal ;
mov b,h ;
mov c,l ;
lxi h,buffer ; i:=0;
outl1: mov a,b ; while antal>0 do
ora c ; begin
jz outl2 ;
call xdata ; xdata(buffer(i));
inx h ; i:=i+1;
dcx b ; antal:=antal-1;
jmp outl1 ; end;
outl2: sub a ; checksum:=0;
lhld antal ;
mov b,h ;
mov c,l ;
lxi h,buffer ; i:=0;
outl3: mov d,a ; while antal>0 do
mov a,b ; begin
ora c ;
mov a,d ;
jz outl4 ;
add m ; checksum:=checksum+buffer(i);
inx h ; i:=i+1;
dcx b ; antal:=antal-1;
jmp outl3 ; end;
outl4: mov d,a ;
sub a ;
sub d ; checksum:=0-checksum;
sta checksum ;
lxi h,checksum ;
call xdata ;
mvi a,13 ; xmt(13);
call xmt ;
mvi a,10 ; xmt(10);
call xmt ;
ret ; end;
;
xdata: mov a,m ; procedure xdata(i:integer);
rrc ; begin
rrc ; xmt((i div 256)+32);
rrc ;
rrc ;
ani 0fh ;
ori 40h ;
call xmt ;
mov a,m ;
ani 0fh ;
ori 40h ;
call xmt ; xmt((i mod 256)+32);
ret ; end;
;
xmt: push psw ;
push b ;
push d ;
push h ;
mov e,a ; procedure xmt(c:char);
push d ;
xmt1: lhld 0001 ; begin
mvi c,4ah ; while buffer(reader)<>empty do
mvi b,0 ; begin
dad b ;
call phl ; read(reader,ch);
ora a ;
jz xmt3 ;
mvi c,reader ;
call bdos ;
cpi dc3 ;
jnz xmt1 ; if ch=dc3 then
; begin
xmt2: mvi c,reader ; repeat
call bdos ; read(reader,ch);
cpi dc1 ;
jnz xmt2 ; until ch=dc1;
jmp xmt1 ; end;
; end;
xmt3: pop d ;
mvi c,punch ; write(punch,c);
call bdos ;
pop h ;
pop d ;
pop b ;
pop psw ;
ret ;
;
phl: pchl ;
; end;
;
receive: ;
db 6,'REMOTE' ;
noend:
db 5,'NOEND' ;
equal:
db 1,'=' ;
badchar:
db 8,'<>,;?*ÆÅ' ;
star: db '* $' ;
oktext: db 'Remote operation' ;
db 13,10,'$'
sttext: db 'FILEX vers. 1.0 83.01.19' ;
crnl: db 13,10,'$' ;
;
mopen:
db 'Cannot open source file'
db 13,10,'$'
mmake:
db 'Directory full on destination disk'
db 13,10,'$'
mwrite:
db 'No space on destination disk'
db 13,10,'$'
mremclose:
db 'Cannot close file on remote disk'
db 13,10,'$'
mlocclose:
db 'Cannot close file on local disk'
db 13,10,'$'
mtxmerr:
db 'Transmission error'
db 13,10,'$'
mparmerr:
db '*** Parameter error ***'
db 13,10,'$'
ds 32 ;
stack: ;
fejl: db false ;
status: db 0 ;
result: db ok ;
lhandside: ;
db false ;
checksum: ;
db 0 ;
;
buffer: ds 131 ;
bufop equ buffer ;
bufref equ bufop+1 ;
bufst equ bufref+1 ;
bufarea equ bufst+1 ;
bufname equ bufst+1 ;
antal: dw 0 ;
;
sfcb: ds 36 ;
sfcbcr equ sfcb+32 ;
;
conspil:db 1 ;
consmax:db 80 ;
conslen:db 0 ;
cons: ds 80 ;
;
itemlen:db 0 ;
item: ds 20 ;
;
remote: db false ;
;
unitnr: db 0 ;
name: ds 8 ;
name2: ds 3 ;
blanks: db 0,0,0,0 ;
;
readcons: ;
db false ;
end start ;
«eof»