curzon@kaoa01.dec.com (Richard Curzon KAO4-3/7A DTN 621-2196) (07/30/87)
Further to Marc Appelbaum's question: since I am sending this
to somebody today, I may as well send it to the newsgroup.
This is the entire unexpurgated (but still short) working code
of Bruce Langdon's, which does basically what Marc wants: checks
if a file exists and reprompts if not. Allows an exit to Dos.
Also has a neat block read function:
-------------------------------------------------------------
; PRINT 8/27/85, A. B. Langdon
; Print a text file, replacing unprintable
; characters by ^M, etc.
;SET $491=$4000 SET 14=$491^
BYTE rts=[$60] ;
;INCLUDE "D:SYSLIB.ACT"
;INCLUDE "D:SYSIO.ACT"
; Using channel 1, Close caused "system error" with DOS 2.1 but not DOS XL.
; First global ARRAY, other than BYTE ARRAY of length less than 257,
; is placed AFTER rest of program (undocumented?).
BYTE ARRAY buffer(257) ; locate the buffer.
CARD FLen, ; File length up to 64K
i, Nbuf
BYTE OpOK, b
BYTE CIO_status ; global for CIO return value (per ACS convention)
CARD FUNC GetAD(BYTE chan CARD addr, len) ; Block read
TYPE IOCB=[BYTE hid,dno,com,sta
CARD badr,put,blen
BYTE aux1,aux2,aux3,aux4,aux5,aux6]
IOCB POINTER ic
BYTE chan16
BYTE POINTER b
chan16 = (chan&$07) LSH 4
ic = $340+chan16
ic.com = 7 ; read
ic.blen = len
ic.badr = addr
[$AE chan16 $20 $E456 $8C CIO_status] ; LDX chan, JSR CIO; STY CIO_status
FLen ==+ ic.blen ; this to RETURN is special to this application.
IF CIO_status = $88 THEN
EOF(chan)=1
IF (FLen&$FF) = 0 THEN ; likely last sector of
b = addr+ic.blen-1 ; a DOS 4 file.
WHILE b^ = 0 DO
b ==- 1
ic.blen ==- 1
FLen == -1
OD
FI
FI
RETURN (ic.blen)
PROC FixFlSp(BYTE ARRAY FileSpec)
IF FileSpec(2)<>': AND FileSpec(3)<>': THEN ; prefix "D:" to file name
FileSpec^==+2
i=FileSpec^
WHILE i>2 DO
FileSpec(i)=FileSpec(i-2)
i==-1
OD
FileSpec(1)='D FileSpec(2)=':
FI
; Could also convert to upper case: if >$60 then subtract $20.
RETURN
PROC SysErr(BYTE errno)
PROC MyError(BYTE errno)
IF errno=$80 THEN Error=SysErr Error(errno) FI ; break quits
PrintF("error %I. Try again%E",errno)
OpOK=0
RETURN
PROC End=*() [$68$AA$68$CD$2E8$90$5$CD$2E6$90$F3 $48$8A$48$60]
; entry: PLA; TAX; PLA; CMP MEMLO+1; BCC lab; CMP MEMTOP+1; BCC entry;
; lab: PHA; TXA; PHA; RTS
; Trace back thru RTS's and return to cartridge or DOS.
; From ACS bulletin board.
PROC PrintFile()
CHAR ARRAY FileSpec(20)
BYTE b, SHFLOK=$2BE
CARD fwa, lwa, BufLen, MEMTOP=$2E5, MEMLO=$2E7
BufLen=MEMTOP-$80-buffer
SysErr=Error
DO
Print("File Spec=")
SHFLOK=$40 ; upper case
InputS(FileSpec)
IF FileSpec^=0 THEN END() FI
FixFlSp(FileSpec)
Close(2)
OpOK=1 Error=MyError Open(2,FileSpec,4,0)
UNTIL OpOK OD
Error=SysErr
Close(3)
Open(3,"P:",8,0)
FLen=0
; With DOS 4, this artifice ensures
; that each GetAD reads one byte into
; next sector, to anticipate EOF.
BufLen ==& $FF00
GetAD(2,buffer,1)
IF buffer(0) = $FF THEN
PrintE("Not a text file.")
Close(2)
RETURN
ELSE
PutD(3,buffer(0))
FI
WHILE EOF(2) = 0 DO
Nbuf = GetAD(2,buffer,BufLen)
FOR i=0 TO Nbuf-1 DO
b = buffer(i) & $7F
IF buffer(i) = $9B THEN
PutD(3,$9B)
ELSEIF b < ' THEN
PutD(3,'^) PutD(3,b+$40)
ELSEIF b=$7F THEN
PutD(3,'^) PutD(3,'_)
ELSE PutD(3,b) FI
OD
OD
Close(2)
RETURN
PROC Main()
device=0 ; in case MAC/65 has been here
DO
PrintFile()
Close(3)
PrintE(" (RETURN to end)")
OD
RETURN
---------------------------------------------------------------------------
Feel free to share.