mirror of
https://github.com/SEPPDROID/Digital-Research-Source-Code.git
synced 2025-10-25 17:34:06 +00:00
492 lines
12 KiB
Plaintext
492 lines
12 KiB
Plaintext
$title('FILE AND I/O MODULE')
|
|
file:
|
|
do;
|
|
|
|
/*
|
|
|
|
modified 3/26/81 R. Silberstein
|
|
modified 3/28/81 R. Silberstein
|
|
modified 3/30/81 R. Silberstein
|
|
modified 4/7/81 R. Silberstein
|
|
modified 4/16/81 R. Silberstein
|
|
modified 6/16/81 R. Silberstein
|
|
modified 9/14/81 R. Silberstein
|
|
|
|
*/
|
|
|
|
/*
|
|
This is the modules to perform BYTE i/o to
|
|
the following 5 logical devices:
|
|
|
|
source - file
|
|
include - file
|
|
hex - file
|
|
symbol - file
|
|
print - file
|
|
|
|
Each of the logical files may be assigned to the
|
|
following physical devices :
|
|
|
|
null (not legal for source and include file)
|
|
console
|
|
printer (not legal for source and include file)
|
|
disk
|
|
|
|
The module defines the following set
|
|
of public subroutines:
|
|
|
|
INSOURCEBYTE - read 1 byte from source file
|
|
ININCLUDEBYTE - read 1 byte from include file
|
|
OUTHEXBYTE (ch) - write 1 byte to hex file
|
|
OUTSYMBOLBYTE (ch) - write 1 byte to symbol file
|
|
OUTPRINTBYTE (ch) - write 1 byte to print file
|
|
|
|
OPENSOURCE - open source file
|
|
OPENINCLUDE - open include file
|
|
OPENHEX - open hex file
|
|
OPENSYMBOL - open symbol file
|
|
OPENPRINT - open print file
|
|
REWINDSOURCE - rewind source file
|
|
|
|
CLOSESOURCE - close source file
|
|
CLOSEINCLUDE - close include file
|
|
CLOSEHEX - close hex file
|
|
CLOSESYMBOL - close symbol file
|
|
CLOSEPRINT - close print file
|
|
|
|
In addition, 2 subroutines to set up the correct
|
|
file names and routing to correct physical device
|
|
are included. These are:
|
|
|
|
FILESETUP
|
|
I$FILESETUP
|
|
|
|
The "filesetup" routine sets up the source, hex, symbol
|
|
and print files by scanning the user command tail of the
|
|
program activating line. The format of the command line
|
|
is described in the program format section of the user's
|
|
manual. The routine also initiates the global string array
|
|
"SOURCENAME" with the source file name, this array to be
|
|
used later by the printout module.
|
|
|
|
The "ifilesetup" sets up the format of the include file
|
|
given by the INCLUDE command of the assembler.
|
|
|
|
*/
|
|
|
|
$include (:f1:macro.lit)
|
|
$include (:f1:struc.lit)
|
|
$include (:f1:dev.lit)
|
|
$include (:f1:io.ext)
|
|
$include (:f1:subr1.ext)
|
|
$include (:f1:subr2.ext)
|
|
$INCLUDE (:F1:TEXT.EXT)
|
|
$include (:f1:global.ext)
|
|
|
|
dcl
|
|
diskunit byte,
|
|
|
|
nulltype lit '0', /* subroutine "devicetype" */
|
|
consoletype lit '1',
|
|
printertype lit '2',
|
|
disktype lit '3',
|
|
|
|
dr lit '0', /* drive code in fcb block */
|
|
fn lit '1', /* filename in fcb block */
|
|
ft lit '9', /* filetype in fcb block */
|
|
ex lit '12', /* file extension number */
|
|
s2 lit '14',
|
|
nr lit '32', /* file record number */
|
|
dollar lit '''$''',
|
|
|
|
asmdefault(3) byte data ('A86'), /* different file types */
|
|
hexdefault(3) byte data ('H86'),
|
|
lstdefault(3) byte data ('LST'),
|
|
symdefault(3) byte data ('SYM'),
|
|
|
|
sourcefile file$i$structure,
|
|
includefile file$i$structure,
|
|
hexfile file$o$structure,
|
|
printfile file$o$structure,
|
|
symbolfile file$o$structure;
|
|
|
|
clearfcb: proc(fcbpt,defaultpt);
|
|
dcl
|
|
(fcbpt,defaultpt) addr,
|
|
dest based fcbpt (1) byte;
|
|
CALL FILL (0, 33, FCBPT);
|
|
CALL FILL (' ', 8, FCBPT+FN);
|
|
call copy(3,defaultpt,.dest(ft));
|
|
end clearfcb;
|
|
|
|
clearcontrol: procedure(point,defaultptr);
|
|
dcl (point,defaultptr) addr,
|
|
x based point file$o$structure;
|
|
call clearfcb(.x.fcbblock,defaultptr);
|
|
x.disk=diskunit;
|
|
end clearcontrol;
|
|
|
|
devicetype: proc(ch) byte;
|
|
dcl ch byte;
|
|
if ch=null then return nulltype;
|
|
if ch=console then return consoletype;
|
|
if ch=printer then return printertype;
|
|
return disktype;
|
|
end devicetype;
|
|
|
|
disk$select: procedure(disk);
|
|
dcl disk byte;
|
|
if diskunit <> disk then$do
|
|
diskunit=disk;
|
|
call select$disk(diskunit);
|
|
end$if;
|
|
end disk$select;
|
|
|
|
inbyte: proc (ptr) byte;
|
|
dcl ptr addr,
|
|
x based ptr file$i$structure,
|
|
ch byte,
|
|
i addr;
|
|
|
|
i=x.bufptr;
|
|
if i=length(x.buffer) then$do
|
|
i=0;
|
|
call disk$select(x.disk);
|
|
do while i < length(x.buffer);
|
|
call SET$DMA$ADDRESS (.x.buffer(i));
|
|
IF (CH := READ$RECORD (.X.FCBBLOCK)) <> 0 THEN$DO
|
|
IF CH = 1 THEN$DO
|
|
X.BUFFER (I) = END$OF$FILE;
|
|
I = LENGTH (X.BUFFER);
|
|
ELSE$DO
|
|
CALL FILEABORT (.X, .DISKREADERRTEXT);
|
|
END$IF;
|
|
else$do
|
|
i=i+128;
|
|
end$if;
|
|
end$while;
|
|
i=0;
|
|
end$if;
|
|
ch=x.buffer(i);
|
|
x.bufptr=i+1;
|
|
return ch;
|
|
end inbyte;
|
|
|
|
FLUSHBUFFER: PROCEDURE (PTR);
|
|
DECLARE (PTR, I) ADDRESS, X BASED PTR FILE$O$STRUCTURE;
|
|
|
|
call disk$select(x.disk);
|
|
i=0;
|
|
do while i < x.bufptr;
|
|
call SET$DMA$ADDRESS (.x.buffer(i));
|
|
IF WRITE$RECORD (.X.FCBBLOCK) > 0 THEN
|
|
CALL FILEABORT (.X, .DISKWRITEERRTXT);
|
|
i=i+128;
|
|
end$while;
|
|
END FLUSHBUFFER;
|
|
|
|
outbyte: proc(ch,ptr);
|
|
dcl ch byte,
|
|
ptr addr,
|
|
x based ptr file$o$structure,
|
|
i addr;
|
|
|
|
do case devicetype(x.disk);
|
|
|
|
/* null */
|
|
do; end; /* do nothing */
|
|
|
|
/* console */
|
|
call write$console(ch);
|
|
|
|
/* printer */
|
|
call write$list(ch);
|
|
|
|
/* disk file */
|
|
do;
|
|
i=x.bufptr;
|
|
if i=length(x.buffer) then$do
|
|
CALL FLUSHBUFFER (PTR);
|
|
i=0;
|
|
end$if;
|
|
x.buffer(i)=ch;
|
|
x.bufptr=i+1;
|
|
end;
|
|
end$case;
|
|
end outbyte;
|
|
|
|
open$input: proc (ptr);
|
|
dcl ptr addr,
|
|
x based ptr file$i$structure;
|
|
|
|
x.bufptr=length(x.buffer);
|
|
call disk$select(x.disk);
|
|
IF LOW (VERSION) >= 30H THEN$DO
|
|
IF OPEN$RO$FILE (.X.FCBBLOCK) <> 0FFH THEN RETURN;
|
|
ELSE$DO
|
|
IF OPEN$FILE (.X.FCBBLOCK) <> 0FFH THEN RETURN;
|
|
END$IF;
|
|
CALL FILEABORT (.X, .OPENERRTEXT);
|
|
end open$input;
|
|
|
|
open$output: proc(ptr);
|
|
dcl ptr addr,
|
|
x based ptr file$o$structure;
|
|
|
|
if devicetype(x.disk)=disktype then$do
|
|
x.bufptr=0;
|
|
call disk$select(x.disk);
|
|
CALL delete$file(.x.fcbblock);
|
|
if create$file(.x.fcbblock) = 0ffh then
|
|
CALL FILEABORT (.X, .MAKEERRTEXT);
|
|
end$if;
|
|
end open$output;
|
|
|
|
outputclose: proc(ptr);
|
|
dcl ptr addr,
|
|
x based ptr file$o$structure;
|
|
|
|
if devicetype(x.disk)=disktype then$do
|
|
call outbyte(end$of$file,.x);
|
|
CALL FLUSHBUFFER (PTR);
|
|
IF CLOSE$FILE (.X.FCBBLOCK) = 0FFH THEN
|
|
CALL FILEABORT (.X, .CLOSEERRTEXT);
|
|
end$if;
|
|
end outputclose;
|
|
|
|
INPUT$CLOSE: PROCEDURE (PTR);
|
|
DECLARE PTR ADDRESS, X BASED PTR FILE$I$STRUCTURE;
|
|
CALL DISK$SELECT (X.DISK);
|
|
CALL SET$DMA$ADDRESS (.X.BUFFER);
|
|
IF CLOSE$FILE (.X.FCBBLOCK) THEN;
|
|
END INPUT$CLOSE;
|
|
|
|
outhexbyte: proc(ch) public;
|
|
dcl ch byte;
|
|
call outbyte(ch,.hex$file);
|
|
end outhexbyte;
|
|
|
|
outprintbyte: proc(ch) public;
|
|
dcl ch byte;
|
|
if printfile.disk=console then$do
|
|
call write$console(ch);
|
|
else$do
|
|
if error$printed then call write$console(ch);
|
|
call outbyte(ch,.printfile);
|
|
end$if;
|
|
end outprintbyte;
|
|
|
|
outsymbolbyte: proc(ch) public;
|
|
dcl ch byte;
|
|
call outbyte(ch,.symbolfile);
|
|
end outsymbolbyte;
|
|
|
|
insourcebyte: proc byte public;
|
|
return inbyte(.sourcefile);
|
|
end insourcebyte;
|
|
|
|
inincludebyte: proc byte public;
|
|
return inbyte(.includefile);
|
|
end inincludebyte;
|
|
|
|
opensource: proc public;
|
|
CALL open$input(.sourcefile);
|
|
end opensource;
|
|
|
|
openinclude: proc public;
|
|
CALL open$input(.includefile);
|
|
end openinclude;
|
|
|
|
openhex: proc public;
|
|
CALL open$output(.hexfile);
|
|
end openhex;
|
|
|
|
openprint: proc public;
|
|
CALL open$output(.printfile);
|
|
end openprint;
|
|
|
|
opensymbol: proc public;
|
|
CALL open$output(.symbolfile);
|
|
end opensymbol;
|
|
|
|
close$source: proc public;
|
|
call input$close (.source$file);
|
|
end close$source;
|
|
|
|
rewindsource: proc public;
|
|
sourcefile.fcbblock(nr)=0;
|
|
sourcefile.bufptr=length(sourcefile.buffer);
|
|
if sourcefile.fcbblock(ex) <> 0 then$do
|
|
sourcefile.fcbblock(ex)=0;
|
|
sourcefile.fcbblock(s2)=0;
|
|
CALL opensource;
|
|
end$if;
|
|
end rewindsource;
|
|
|
|
close$include: proc public;
|
|
call input$close (.include$file);
|
|
end close$include;
|
|
|
|
closehex: proc public;
|
|
call outputclose(.hexfile);
|
|
end closehex;
|
|
|
|
closeprint: proc public;
|
|
call outputclose(.printfile);
|
|
end closeprint;
|
|
|
|
closesymbol: proc public;
|
|
call outputclose(.symbolfile);
|
|
end closesymbol;
|
|
|
|
i$file$setup: proc(dev,filnam,filtyp) public;
|
|
dcl dev byte,(filnam,filtyp) addr;
|
|
call clearcontrol(.includefile,filtyp);
|
|
includefile.disk=dev;
|
|
call copy(8,filnam,.includefile.fcbblock(fn));
|
|
end i$file$setup;
|
|
|
|
filesetup: proc byte public;
|
|
dcl
|
|
|
|
ch byte, /* pick up character */
|
|
i byte, /* counter */
|
|
noleft byte, /* no of characters left in tbuff */
|
|
bpt byte, /* index of tbuff */
|
|
exitvalue byte, /* exitvalue of subroutine */
|
|
flag byte; /* program logic flag */
|
|
|
|
nextch: proc byte;
|
|
if noleft > 0 then$do
|
|
ch=tbuff(bpt);
|
|
noleft=noleft-1;
|
|
bpt=bpt+1;
|
|
else$do
|
|
ch=cr;
|
|
end$if;
|
|
return ch;
|
|
end nextch;
|
|
|
|
getdsk: procedure (p);
|
|
declare p address, dsk based p byte;
|
|
ch=upper(nextch); /* test selected disk drive */
|
|
if letter(ch) then$do
|
|
dsk=ch-'A';
|
|
if dsk > validdisk then
|
|
if dsk < console then
|
|
exitvalue = false; /* invalid drive */
|
|
else$do
|
|
exitvalue=false;
|
|
noleft=0;
|
|
end$if;
|
|
end getdsk;
|
|
|
|
exitvalue=true;
|
|
|
|
/* save current disk */
|
|
default$drive,diskunit=interrogate$disk;
|
|
/* enter user selected disk */
|
|
if fcb(dr) <> 0 then$do
|
|
call selectdisk(diskunit:=fcb(dr)-1);
|
|
end$if;
|
|
|
|
/* clear control blocks */
|
|
call clearcontrol(.sourcefile,.asmdefault);
|
|
call clearcontrol(.hexfile,.hexdefault);
|
|
call clearcontrol(.printfile,.lstdefault);
|
|
call clearcontrol(.symbolfile,.symdefault);
|
|
call copy(8,.fcb(fn),.sourcefile.fcbblock(fn));
|
|
call copy(8,.fcb(fn),.hexfile.fcbblock(fn));
|
|
call copy(8,.fcb(fn),.printfile.fcbblock(fn));
|
|
call copy(8,.fcb(fn),.symbolfile.fcbblock(fn));
|
|
|
|
if FCB (FT) <> SPACE then$do /* pick up specified source file type */
|
|
call copy(3,.fcb(ft),.sourcefile.fcbblock(ft));
|
|
end$if;
|
|
|
|
/* Move source file name to SOURCENAME */
|
|
|
|
CALL FILL (SPACE, LENGTH (SOURCENAME), .SOURCENAME);
|
|
i=0;
|
|
do while i<8 and (sourcename(i):=sourcefile.fcbblock(fn+i)) <> space;
|
|
i=i+1;
|
|
end$while;
|
|
sourcename(i)='.';
|
|
i=i+1;
|
|
call copy(3,.sourcefile.fcbblock(ft),.sourcename(i));
|
|
|
|
/* Test if file parameters */
|
|
|
|
noleft=tbuff(0);
|
|
bpt=1;
|
|
FLAG = FALSE;
|
|
IF FCB16 (1) <> SPACE THEN$DO
|
|
IF FCB16 (1) <> DOLLAR THEN$DO
|
|
EXITVALUE = FALSE;
|
|
ELSE$DO
|
|
DO WHILE (NOLEFT > 0) AND (NEXTCH <> DOLLAR);
|
|
END$WHILE;
|
|
FLAG = TRUE;
|
|
END$IF;
|
|
END$IF;
|
|
|
|
if flag then$do
|
|
|
|
/* file parameters present - pick them up */
|
|
|
|
do while noleft > 0;
|
|
if (ch:=upper(nextch)) <> space then$do
|
|
|
|
/* A-parameter */
|
|
IF CH = 'A' THEN call getdsk(.sourcefile.disk);
|
|
|
|
/* H-parameter */
|
|
ELSE IF CH = 'H' THEN call getdsk(.hexfile.disk);
|
|
|
|
/* P-parameter */
|
|
ELSE IF CH = 'P' THEN call getdsk(.printfile.disk);
|
|
|
|
/* S-parameter */
|
|
ELSE IF CH = 'S' THEN call getdsk(.symbolfile.disk);
|
|
|
|
/* F-parameter */
|
|
ELSE IF CH = 'F' THEN$DO
|
|
if (ch:=upper(nextch)) = 'I' then$do
|
|
intel$hex$on=true;
|
|
else$do
|
|
if ch= 'D' then$do
|
|
intel$hex$on=false;
|
|
else$do
|
|
exitvalue=false;
|
|
noleft=0;
|
|
endif;
|
|
endif;
|
|
END$IF;
|
|
|
|
/* error,no legal parameter */
|
|
ELSE
|
|
DO;
|
|
exitvalue=false;
|
|
noleft=0;
|
|
END$DO;
|
|
|
|
end$if;
|
|
end$while;
|
|
end$if;
|
|
|
|
printdevice=printfile.disk; /* set global printdevice flag */
|
|
SYMBOLDEVICE = SYMBOLFILE.DISK;
|
|
INCLUDE$DEFAULT = SOURCEFILE.DISK;
|
|
|
|
/* input must be from a disk file */
|
|
|
|
if devicetype(sourcefile.disk) <> disktype then$do
|
|
exitvalue=false;
|
|
end$if;
|
|
|
|
return exitvalue;
|
|
|
|
end filesetup;
|
|
|
|
end file;
|