mirror of
https://github.com/SEPPDROID/Digital-Research-Source-Code.git
synced 2025-10-26 18:04:07 +00:00
Upload
Digital Research
This commit is contained in:
@@ -0,0 +1,94 @@
|
||||
;****************************************************************
|
||||
;* *
|
||||
;* BOOT SECTOR FOR IBM PC *
|
||||
;* *
|
||||
;****************************************************************
|
||||
|
||||
min_mem equ 160 ;minimum memory in K
|
||||
load_track_segment equ 2600H ;at 152K mark
|
||||
|
||||
;Check for at least 160K being present in the IBM PC.
|
||||
;Use last 8K of 160K minimum memory for loader.
|
||||
|
||||
;Since track is 4K we have 4K extra past the Loader for
|
||||
;disk buffer space and other unitialized storage
|
||||
;used by the Loader.
|
||||
|
||||
;Note: that wherever it is decided to place the loader, the IBM PC
|
||||
;cannot read over a 64K page boundary.
|
||||
|
||||
;the command:
|
||||
|
||||
;GENCMD BOOT 8080
|
||||
;is used for this module
|
||||
|
||||
bw_video_ram equ 0b000h ;where to print an
|
||||
color_video_ram equ 0b800h ;error message
|
||||
|
||||
cseg load_track_segment + 20H ;add 20H to get to sector 2
|
||||
loader: ;where the Loader starts
|
||||
|
||||
cseg 0
|
||||
org 0 ;The IBM ROM sets up
|
||||
;SS=30H and SP is 80H: stack is in
|
||||
;the interrupt vectors.
|
||||
int 12H ;get memory size
|
||||
cmp ax,min_mem
|
||||
jnb get_track_0
|
||||
jmps mem_error
|
||||
|
||||
get_track_0:
|
||||
xor bx,bx ;set up call to ROM diskette read
|
||||
mov ax,load_track_segment
|
||||
mov es,ax ;ES:BX transfer location
|
||||
mov ax,0208h ;AH=2=read,AL=8=sectors to read
|
||||
mov cx,0001h ;CH=0=track,CL=1=sector
|
||||
mov dx,0000h ;DH=0=head #,DL=0=drive #
|
||||
int 13H ;call ROM diskette entry
|
||||
jnc track_ok
|
||||
jmps track_error
|
||||
|
||||
track_ok:
|
||||
jmpf loader
|
||||
|
||||
mem_error:
|
||||
mov cx,length mem_msg
|
||||
mov si,offset mem_msg
|
||||
jmps prt_msg
|
||||
|
||||
track_error:
|
||||
mov cx,length trk_msg
|
||||
mov si,offset trk_msg
|
||||
;jmps prt_msg
|
||||
|
||||
prt_msg:
|
||||
mov ax,bw_video_ram
|
||||
int 11H ;get equipment information
|
||||
and al,00110000b ;get video bits
|
||||
cmp al,30H
|
||||
je do_msg
|
||||
mov ax,color_video_ram
|
||||
do_msg:
|
||||
mov es,ax
|
||||
mov ax,cs
|
||||
mov ds,ax
|
||||
xor di,di
|
||||
mov ah,07H ;normal display attribute
|
||||
prt_loop:
|
||||
lodsb
|
||||
stosw
|
||||
loop prt_loop
|
||||
cli
|
||||
hlt
|
||||
|
||||
|
||||
last_code_offset equ offset $
|
||||
dseg
|
||||
org last_code_offset
|
||||
|
||||
mem_msg db 'Not enough memory present for loader'
|
||||
trk_msg db 'Can''t read boot track'
|
||||
|
||||
org 512 - 1 ;force even sector size
|
||||
db 0
|
||||
|
||||
@@ -0,0 +1,9 @@
|
||||
|
||||
/*
|
||||
Copyright (C) 1983
|
||||
Digital Research
|
||||
P.O. Box 579
|
||||
Pacific Grove, CA 93950
|
||||
*/
|
||||
|
||||
|
||||
@@ -0,0 +1,523 @@
|
||||
$compact
|
||||
$title ('DATE: Time and Date utility')
|
||||
DATE:
|
||||
do;
|
||||
|
||||
$include(:f1:copyrt.lit)
|
||||
|
||||
/* Revised:
|
||||
23 Jun 82 by Bill Fitler (CCP/M-86)
|
||||
14 Nov 83 by Vincent Alia (SQUID)
|
||||
*/
|
||||
|
||||
$include(:f1:vaxcmd.lit)
|
||||
|
||||
$include(:f1:vermpm.lit)
|
||||
|
||||
declare dcl literally 'declare';
|
||||
dcl lit literally 'literally';
|
||||
dcl forever lit 'while 1';
|
||||
|
||||
|
||||
mon1:
|
||||
procedure (func,info) external;
|
||||
declare func byte;
|
||||
declare info address;
|
||||
end mon1;
|
||||
|
||||
mon2:
|
||||
procedure (func,info) byte external;
|
||||
declare func byte;
|
||||
declare info address;
|
||||
end mon2;
|
||||
|
||||
mon3:
|
||||
procedure (func,info) address external;
|
||||
declare func byte;
|
||||
declare info address;
|
||||
end mon3;
|
||||
|
||||
mon4:
|
||||
procedure (func,info) pointer external;
|
||||
declare func byte;
|
||||
declare info address;
|
||||
end mon4;
|
||||
|
||||
|
||||
|
||||
declare fcb (1) byte external;
|
||||
declare fcb16 (1) byte external;
|
||||
declare buff (1) byte external;
|
||||
|
||||
|
||||
read$console:
|
||||
procedure byte;
|
||||
return mon2 (1,0);
|
||||
end read$console;
|
||||
|
||||
write$console:
|
||||
procedure (char);
|
||||
declare char byte;
|
||||
call mon1 (2,char);
|
||||
end write$console;
|
||||
|
||||
print$buffer:
|
||||
procedure (buffer$address);
|
||||
declare buffer$address address;
|
||||
call mon1 (9,buffer$address);
|
||||
end print$buffer;
|
||||
|
||||
read$buffer:
|
||||
procedure (buffer$address);
|
||||
declare buffer$address address;
|
||||
call mon1 (10,buffer$address);
|
||||
end read$buffer;
|
||||
|
||||
check$console$status:
|
||||
procedure byte;
|
||||
return mon2 (11,0);
|
||||
end check$console$status;
|
||||
|
||||
version:
|
||||
procedure address;
|
||||
return mon3(12,0);
|
||||
end version;
|
||||
|
||||
terminate:
|
||||
procedure;
|
||||
call mon1 (0,0);
|
||||
end terminate;
|
||||
|
||||
get$sysdat:
|
||||
procedure pointer;
|
||||
return (mon4(154,0));
|
||||
end get$sysdat;
|
||||
|
||||
crlf:
|
||||
procedure;
|
||||
call write$console (0dh);
|
||||
call write$console (0ah);
|
||||
end crlf;
|
||||
|
||||
error:
|
||||
procedure;
|
||||
call print$buffer (.(
|
||||
'Illegal time/date specification.','$'));
|
||||
call terminate;
|
||||
end;
|
||||
|
||||
/*****************************************************
|
||||
|
||||
Time & Date ASCII Conversion Code
|
||||
|
||||
*****************************************************/
|
||||
declare buffer$adr structure (
|
||||
max$chars byte,
|
||||
numb$of$chars byte,
|
||||
console$buffer(21) byte)
|
||||
initial (21,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0);
|
||||
|
||||
declare tod$adr address;
|
||||
declare tod based tod$adr structure (
|
||||
opcode byte,
|
||||
date address,
|
||||
hrs byte,
|
||||
min byte,
|
||||
sec byte,
|
||||
ASCII (21) byte );
|
||||
|
||||
declare string$adr address;
|
||||
declare string based string$adr (1) byte;
|
||||
declare index byte;
|
||||
|
||||
|
||||
emitchar: procedure(c);
|
||||
declare c byte;
|
||||
string(index := index + 1) = c;
|
||||
end emitchar;
|
||||
|
||||
emitn: procedure(a);
|
||||
declare a address;
|
||||
declare c based a byte;
|
||||
do while c <> '$';
|
||||
string(index := index + 1) = c;
|
||||
a = a + 1;
|
||||
end;
|
||||
end emitn;
|
||||
|
||||
emit$bcd: procedure(b);
|
||||
declare b byte;
|
||||
call emitchar('0'+b);
|
||||
end emit$bcd;
|
||||
|
||||
emit$bcd$pair: procedure(b);
|
||||
declare b byte;
|
||||
call emit$bcd(shr(b,4));
|
||||
call emit$bcd(b and 0fh);
|
||||
end emit$bcd$pair;
|
||||
|
||||
emit$colon: procedure(b);
|
||||
declare b byte;
|
||||
call emit$bcd$pair(b);
|
||||
call emitchar(':');
|
||||
end emit$colon;
|
||||
|
||||
emit$bin$pair: procedure(b);
|
||||
declare b byte;
|
||||
call emit$bcd(b/10);
|
||||
call emit$bcd(b mod 10);
|
||||
end emit$bin$pair;
|
||||
|
||||
emit$slant: procedure(b);
|
||||
declare b byte;
|
||||
call emit$bin$pair(b);
|
||||
call emitchar('/');
|
||||
end emit$slant;
|
||||
|
||||
declare chr byte;
|
||||
|
||||
gnc: procedure;
|
||||
/* get next command byte */
|
||||
if chr = 0 then return;
|
||||
if index = 20 then
|
||||
do;
|
||||
chr = 0;
|
||||
return;
|
||||
end;
|
||||
chr = string(index := index + 1);
|
||||
end gnc;
|
||||
|
||||
deblank: procedure;
|
||||
do while chr = ' ';
|
||||
call gnc;
|
||||
end;
|
||||
end deblank;
|
||||
|
||||
numeric: procedure byte;
|
||||
/* test for numeric */
|
||||
return (chr - '0') < 10;
|
||||
end numeric;
|
||||
|
||||
scan$numeric: procedure(lb,ub) byte;
|
||||
declare (lb,ub) byte;
|
||||
declare b byte;
|
||||
b = 0;
|
||||
call deblank;
|
||||
if not numeric then call error;
|
||||
do while numeric;
|
||||
if (b and 1110$0000b) <> 0 then call error;
|
||||
b = shl(b,3) + shl(b,1); /* b = b * 10 */
|
||||
if carry then call error;
|
||||
b = b + (chr - '0');
|
||||
if carry then call error;
|
||||
call gnc;
|
||||
end;
|
||||
if (b < lb) or (b > ub) then call error;
|
||||
return b;
|
||||
end scan$numeric;
|
||||
|
||||
scan$delimiter: procedure(d,lb,ub) byte;
|
||||
declare (d,lb,ub) byte;
|
||||
call deblank;
|
||||
if chr <> d then call error;
|
||||
call gnc;
|
||||
return scan$numeric(lb,ub);
|
||||
end scan$delimiter;
|
||||
|
||||
declare
|
||||
base$year lit '78', /* base year for computations */
|
||||
base$day lit '0', /* starting day for base$year 0..6 */
|
||||
month$size (*) byte data
|
||||
/* jan feb mar apr may jun jul aug sep oct nov dec */
|
||||
( 31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31),
|
||||
month$days (*) word data
|
||||
/* jan feb mar apr may jun jul aug sep oct nov dec */
|
||||
( 000,031,059,090,120,151,181,212,243,273,304,334);
|
||||
|
||||
leap$days: procedure(y,m) byte;
|
||||
declare (y,m) byte;
|
||||
/* compute days accumulated by leap years */
|
||||
declare yp byte;
|
||||
yp = shr(y,2); /* yp = y/4 */
|
||||
if (y and 11b) = 0 and month$days(m) < 59 then
|
||||
/* y not 00, y mod 4 = 0, before march, so not leap yr */
|
||||
return yp - 1;
|
||||
/* otherwise, yp is the number of accumulated leap days */
|
||||
return yp;
|
||||
end leap$days;
|
||||
|
||||
declare word$value word;
|
||||
|
||||
get$next$digit: procedure byte;
|
||||
/* get next lsd from word$value */
|
||||
declare lsd byte;
|
||||
lsd = word$value mod 10;
|
||||
word$value = word$value / 10;
|
||||
return lsd;
|
||||
end get$next$digit;
|
||||
|
||||
bcd:
|
||||
procedure (val) byte;
|
||||
declare val byte;
|
||||
return shl((val/10),4) + val mod 10;
|
||||
end bcd;
|
||||
|
||||
declare (month, day, year, hrs, min, sec) byte;
|
||||
|
||||
set$date: procedure;
|
||||
declare
|
||||
(i, leap$flag) byte; /* temporaries */
|
||||
month = scan$numeric(1,12) - 1;
|
||||
/* may be feb 29 */
|
||||
if (leap$flag := month = 1) then i = 29;
|
||||
else i = month$size(month);
|
||||
day = scan$delimiter('/',1,i);
|
||||
year = scan$delimiter('/',base$year,99);
|
||||
/* ensure that feb 29 is in a leap year */
|
||||
if leap$flag and day = 29 and (year and 11b) <> 0 then
|
||||
/* feb 29 of non-leap year */ call error;
|
||||
/* compute total days */
|
||||
tod.date = month$days(month)
|
||||
+ 365 * (year - base$year)
|
||||
+ day
|
||||
- leap$days(base$year,0)
|
||||
+ leap$days(year,month);
|
||||
end set$date;
|
||||
|
||||
set$time: procedure;
|
||||
tod.hrs = bcd (scan$numeric(0,23));
|
||||
tod.min = bcd (scan$delimiter(':',0,59));
|
||||
if tod.opcode = 2 then
|
||||
/* date, hours and minutes only */
|
||||
do;
|
||||
if chr = ':'
|
||||
then i = scan$delimiter (':',0,59);
|
||||
tod.sec = 0;
|
||||
end;
|
||||
/* include seconds */
|
||||
else tod.sec = bcd (scan$delimiter(':',0,59));
|
||||
|
||||
end set$time;
|
||||
|
||||
bcd$pair: procedure(a,b) byte;
|
||||
declare (a,b) byte;
|
||||
return shl(a,4) or b;
|
||||
end bcd$pair;
|
||||
|
||||
compute$year: procedure;
|
||||
/* compute year from number of days in word$value */
|
||||
declare year$length word;
|
||||
year = base$year;
|
||||
do forever;
|
||||
year$length = 365;
|
||||
if (year and 11b) = 0 then /* leap year */
|
||||
year$length = 366;
|
||||
if word$value <= year$length then
|
||||
return;
|
||||
word$value = word$value - year$length;
|
||||
year = year + 1;
|
||||
end;
|
||||
end compute$year;
|
||||
|
||||
declare
|
||||
week$day byte, /* day of week 0 ... 6 */
|
||||
day$list (*) byte data
|
||||
('Sun$Mon$Tue$Wed$Thu$Fri$Sat$'),
|
||||
leap$bias byte; /* bias for feb 29 */
|
||||
|
||||
compute$month: procedure;
|
||||
month = 12;
|
||||
do while month > 0;
|
||||
if (month := month - 1) < 2 then /* jan or feb */
|
||||
leapbias = 0;
|
||||
if month$days(month) + leap$bias < word$value then return;
|
||||
end;
|
||||
end compute$month;
|
||||
|
||||
declare
|
||||
date$test byte, /* true if testing date */
|
||||
test$value word; /* sequential date value under test */
|
||||
|
||||
get$date$time: procedure;
|
||||
/* get date and time */
|
||||
hrs = tod.hrs;
|
||||
min = tod.min;
|
||||
sec = tod.sec;
|
||||
word$value = tod.date;
|
||||
/* word$value contains total number of days */
|
||||
week$day = (word$value + base$day - 1) mod 7;
|
||||
call compute$year;
|
||||
/* year has been set, word$value is remainder */
|
||||
leap$bias = 0;
|
||||
if (year and 11b) = 0 and word$value > 59 then
|
||||
/* after feb 29 on leap year */ leap$bias = 1;
|
||||
call compute$month;
|
||||
day = word$value - (month$days(month) + leap$bias);
|
||||
month = month + 1;
|
||||
end get$date$time;
|
||||
|
||||
emit$date$time: procedure;
|
||||
call emitn(.day$list(shl(week$day,2)));
|
||||
call emitchar(' ');
|
||||
call emit$slant(month);
|
||||
call emit$slant(day);
|
||||
call emit$bin$pair(year);
|
||||
call emitchar(' ');
|
||||
call emit$colon(hrs);
|
||||
call emit$colon(min);
|
||||
call emit$bcd$pair(sec);
|
||||
end emit$date$time;
|
||||
|
||||
tod$ASCII:
|
||||
procedure (parameter);
|
||||
declare parameter address;
|
||||
declare ret address;
|
||||
|
||||
ret = 0;
|
||||
tod$adr = parameter;
|
||||
string$adr = .tod.ASCII;
|
||||
if tod.opcode = 0 then
|
||||
do;
|
||||
call get$date$time;
|
||||
index = -1;
|
||||
call emit$date$time;
|
||||
end;
|
||||
else
|
||||
do;
|
||||
if (tod.opcode = 1) or
|
||||
(tod.opcode = 2) then
|
||||
do;
|
||||
chr = string(index:=0);
|
||||
call set$date;
|
||||
call set$time;
|
||||
ret = .string(index);
|
||||
end;
|
||||
else
|
||||
do;
|
||||
call error;
|
||||
end;
|
||||
end;
|
||||
end tod$ASCII;
|
||||
|
||||
/********************************************************
|
||||
********************************************************/
|
||||
|
||||
declare tod$pointer pointer;
|
||||
declare tod$ptr structure (
|
||||
offset word,
|
||||
segment word) at (@tod$pointer);
|
||||
declare extrnl$tod based tod$pointer structure (
|
||||
date address,
|
||||
hrs byte, /* in system data area */
|
||||
min byte,
|
||||
sec byte );
|
||||
|
||||
declare lcltod structure ( /* local to this program */
|
||||
opcode byte,
|
||||
date address,
|
||||
hrs byte,
|
||||
min byte,
|
||||
sec byte,
|
||||
ASCII (21) byte );
|
||||
|
||||
declare i byte;
|
||||
declare ret address;
|
||||
|
||||
display$tod:
|
||||
procedure;
|
||||
|
||||
lcltod.opcode = 0; /* read tod */
|
||||
call movb (@extrnl$tod.date,@lcltod.date,5);
|
||||
call tod$ASCII (.lcltod);
|
||||
call write$console (0dh);
|
||||
do i = 0 to 20;
|
||||
call write$console (lcltod.ASCII(i));
|
||||
end;
|
||||
end display$tod;
|
||||
|
||||
|
||||
/*
|
||||
Main Program
|
||||
*/
|
||||
|
||||
declare tod$sd$offset lit '7eh'; /* offset of TOD structure in MP/M-86 */
|
||||
declare vers address;
|
||||
declare last$dseg$byte byte
|
||||
initial (0);
|
||||
|
||||
plmstart:
|
||||
procedure public;
|
||||
vers = version;
|
||||
if low (vers) < Ver$BDOS or (high(vers) and Ver$Mask) = 0 then
|
||||
do;
|
||||
call print$buffer(.(0dh,0ah,Ver$Needs$OS,'$'));
|
||||
call mon1(0,0);
|
||||
end;
|
||||
|
||||
tod$pointer = get$sysdat;
|
||||
tod$ptr.offset = tod$sd$offset;
|
||||
/* new code added for SET option */
|
||||
if (fcb(1) = 'S') then
|
||||
do;
|
||||
lcltod.opcode = 1;
|
||||
call crlf;
|
||||
call print$buffer(.('Enter today''s date (MM/DD/YY): ','$'));
|
||||
call move (21,.(000000000000000000000),.buffer$adr.console$buffer);
|
||||
call read$buffer(.buffer$adr);
|
||||
call crlf;
|
||||
if buffer$adr.numb$of$chars > 0
|
||||
then do;
|
||||
call move(21,.buffer$adr.console$buffer,.lcltod.ASCII);
|
||||
tod$adr = .lcltod;
|
||||
string$adr = .tod.ASCII;
|
||||
chr = string(index := 0);
|
||||
call set$date;
|
||||
call move(2,.lcltod.date,.extrnl$tod);
|
||||
end;
|
||||
call print$buffer(.('Enter the time (HH:MM:SS): ','$'));
|
||||
call move (21,.(000000000000000000000),.buffer$adr.console$buffer);
|
||||
call read$buffer(.buffer$adr);
|
||||
if buffer$adr.numb$of$chars > 0
|
||||
then do;
|
||||
call crlf;
|
||||
call move(21,.buffer$adr.console$buffer,.lcltod.ASCII);
|
||||
tod$adr = .lcltod;
|
||||
string$adr = .tod.ASCII;
|
||||
ret = 0;
|
||||
tod.opcode = 1;
|
||||
chr = string(index := 0);
|
||||
call set$time;
|
||||
call move(3,.lcltod.hrs,extrnl$tod.hrs);
|
||||
/* here set the time with the system */
|
||||
call print$buffer (.('Press any key to set time.$'));
|
||||
ret = read$console;
|
||||
call movb(@lcltod.date,@extrnl$tod.date,5);
|
||||
end;
|
||||
call terminate;
|
||||
end;
|
||||
|
||||
if (fcb(1) <> ' ') and (fcb(1) <> 'C') then
|
||||
do;
|
||||
call move (21,.buff(1),.lcltod.ASCII);
|
||||
lcltod.opcode = 1;
|
||||
call tod$ASCII (.lcltod);
|
||||
call print$buffer (.(
|
||||
'Press any key to set time','$'));
|
||||
ret = read$console;
|
||||
call movb (@lcltod.date,@extrnl$tod.date,5); /* use pl/m-86 move */
|
||||
call crlf;
|
||||
end;
|
||||
do while fcb(1) = 'C';
|
||||
call display$tod;
|
||||
if check$console$status then
|
||||
do;
|
||||
ret = read$console;
|
||||
fcb(1) = 0;
|
||||
end;
|
||||
end;
|
||||
call display$tod;
|
||||
call terminate;
|
||||
end plmstart;
|
||||
|
||||
end DATE;
|
||||
|
||||
2640
CPM OPERATING SYSTEMS/CPM 86/CONCURRENT/CCPM-86 3.1 SOURCE/D8/ED.PLM
Normal file
2640
CPM OPERATING SYSTEMS/CPM 86/CONCURRENT/CCPM-86 3.1 SOURCE/D8/ED.PLM
Normal file
File diff suppressed because it is too large
Load Diff
@@ -0,0 +1,457 @@
|
||||
$compact
|
||||
$title ('ERA: Utility to Erase File for MP/M & CCP/M')
|
||||
erase:
|
||||
do;
|
||||
|
||||
/*
|
||||
Revised:
|
||||
19 Jan 80 by Thomas Rolander (MP/M 1.1)
|
||||
19 July 81 by Doug Huskey (MP/M II )
|
||||
8 Aug 81 by Danny Horovitz (MP/M-86 )
|
||||
31 Jan 83 by Bill Fitler (CCP/M-86 )
|
||||
*/
|
||||
/* ERA checks if files are open by other users */
|
||||
|
||||
$include (:f2:copyrt.lit)
|
||||
|
||||
$include (:f2:vaxcmd.lit)
|
||||
|
||||
$include (:f2:vermpm.lit)
|
||||
|
||||
declare
|
||||
true literally '1',
|
||||
false literally '0',
|
||||
forever literally 'while true',
|
||||
lit literally 'literally',
|
||||
proc literally 'procedure',
|
||||
dcl literally 'declare',
|
||||
addr literally 'address',
|
||||
cr literally '13',
|
||||
lf literally '10',
|
||||
ctrlc literally '3',
|
||||
ctrlx literally '18h',
|
||||
bksp literally '8';
|
||||
|
||||
$include (:f2:proces.lit)
|
||||
|
||||
$include (:f2:uda.lit)
|
||||
|
||||
|
||||
dcl stack$siz lit '16';
|
||||
dcl int3 lit '0CCCCh';
|
||||
dcl plmstack (stack$siz) word public initial(
|
||||
int3,int3,int3,int3, int3,int3,int3,int3,
|
||||
int3,int3,int3,int3, int3,int3,int3,int3);
|
||||
dcl stack$size word public data(stack$siz + stack$siz);
|
||||
|
||||
/**************************************
|
||||
* *
|
||||
* B D O S INTERFACE *
|
||||
* *
|
||||
**************************************/
|
||||
|
||||
|
||||
mon1:
|
||||
procedure (func,info) external;
|
||||
declare func byte;
|
||||
declare info address;
|
||||
end mon1;
|
||||
|
||||
mon2:
|
||||
procedure (func,info) byte external;
|
||||
declare func byte;
|
||||
declare info address;
|
||||
end mon2;
|
||||
|
||||
mon3:
|
||||
procedure (func,info) address external;
|
||||
declare func byte;
|
||||
declare info address;
|
||||
end mon3;
|
||||
|
||||
mon4:
|
||||
procedure (func,info) pointer external;
|
||||
declare func byte;
|
||||
declare info address;
|
||||
end mon4;
|
||||
|
||||
|
||||
|
||||
declare cmdrv byte external; /* command drive */
|
||||
declare fcb (1) byte external; /* 1st default fcb */
|
||||
declare fcb16 (1) byte external; /* 2nd default fcb */
|
||||
declare pass0 address external; /* 1st password ptr */
|
||||
declare len0 byte external; /* 1st passwd length */
|
||||
declare pass1 address external; /* 2nd password ptr */
|
||||
declare len1 byte external; /* 2nd passwd length */
|
||||
declare tbuff (1) byte external; /* default dma buffer */
|
||||
|
||||
|
||||
/**************************************
|
||||
* *
|
||||
* B D O S Externals *
|
||||
* *
|
||||
**************************************/
|
||||
|
||||
read$console:
|
||||
procedure byte;
|
||||
return mon2 (1,0);
|
||||
end read$console;
|
||||
|
||||
|
||||
printchar:
|
||||
procedure(char);
|
||||
declare char byte;
|
||||
call mon1(2,char);
|
||||
end printchar;
|
||||
|
||||
conin:
|
||||
procedure byte;
|
||||
return mon2(6,0fdh);
|
||||
end conin;
|
||||
|
||||
check$con$stat:
|
||||
procedure byte;
|
||||
return mon2(11,0);
|
||||
end check$con$stat;
|
||||
|
||||
print$buf:
|
||||
procedure (buffer$address);
|
||||
declare buffer$address address;
|
||||
call mon1 (9,buffer$address);
|
||||
end print$buf;
|
||||
|
||||
version: procedure address;
|
||||
/* returns current cp/m version # */
|
||||
return mon3(12,0);
|
||||
end version;
|
||||
|
||||
setdma: procedure(dma);
|
||||
declare dma address;
|
||||
call mon1(26,dma);
|
||||
end setdma;
|
||||
|
||||
search:
|
||||
procedure (fcb$address) byte;
|
||||
declare fcb$address address;
|
||||
return mon2 (17,fcb$address);
|
||||
end search;
|
||||
|
||||
searchn:
|
||||
procedure byte;
|
||||
return mon2 (18,0);
|
||||
end searchn;
|
||||
|
||||
delete$file:
|
||||
procedure (fcb$address) address;
|
||||
declare fcb$address address;
|
||||
return mon3 (19,fcb$address);
|
||||
end delete$file;
|
||||
|
||||
get$user$code:
|
||||
procedure byte;
|
||||
return mon2 (32,0ffh);
|
||||
end get$user$code;
|
||||
|
||||
/* 0ff => return BDOS errors */
|
||||
return$errors:
|
||||
procedure;
|
||||
call mon1 (45,0ffh);
|
||||
end return$errors;
|
||||
|
||||
terminate:
|
||||
procedure;
|
||||
call mon1 (143,0);
|
||||
end terminate;
|
||||
|
||||
declare
|
||||
parse$fn structure (
|
||||
buff$adr address,
|
||||
fcb$adr address);
|
||||
declare (saveax,savecx) word external; /* reg return vals, set in mon1 */
|
||||
|
||||
parse: procedure;
|
||||
declare (retcode,errcode) word;
|
||||
|
||||
call mon1(152,.parse$fn);
|
||||
retcode = saveax;
|
||||
errcode = savecx;
|
||||
if retcode = 0ffffh then /* parse returned an error*/
|
||||
do;
|
||||
call print$buf(.('Invalid Filespec$'));
|
||||
if errcode = 23 then call print$buf(.(' (drive)$'));
|
||||
else if errcode = 24 then call print$buf(.(' (filename)$'));
|
||||
else if errcode = 25 then call print$buf(.(' (filetype)$'));
|
||||
else if errcode = 38 then call print$buf(.(' (password)$'));
|
||||
call print$buf(.('.',13,10,'$')); call terminate;
|
||||
end;
|
||||
end parse;
|
||||
|
||||
declare
|
||||
pd$pointer pointer,
|
||||
pd based pd$pointer pd$structure;
|
||||
declare
|
||||
uda$pointer pointer,
|
||||
uda$ptr structure (
|
||||
offset word,
|
||||
segment word) at (@uda$pointer),
|
||||
uda based uda$pointer uda$structure;
|
||||
|
||||
get$uda: procedure;
|
||||
|
||||
pd$pointer = mon4(156,0);
|
||||
uda$ptr.segment = pd.uda;
|
||||
uda$ptr.offset = 0;
|
||||
end get$uda;
|
||||
|
||||
/**************************************
|
||||
* *
|
||||
* GLOBAL VARIABLES *
|
||||
* *
|
||||
**************************************/
|
||||
|
||||
declare xfcb byte initial(0);
|
||||
declare successful lit '0FFh';
|
||||
|
||||
/**************************************
|
||||
* *
|
||||
* S U B R O U T I N E S *
|
||||
* *
|
||||
**************************************/
|
||||
|
||||
|
||||
/* upper case character from console */
|
||||
crlf: proc;
|
||||
call printchar(cr);
|
||||
call printchar(lf);
|
||||
end crlf;
|
||||
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
|
||||
|
||||
|
||||
/* fill string @ s for c bytes with f */
|
||||
fill: proc(s,f,c);
|
||||
dcl s addr,
|
||||
(f,c) byte,
|
||||
a based s byte;
|
||||
|
||||
do while (c:=c-1)<>255;
|
||||
a = f;
|
||||
s = s+1;
|
||||
end;
|
||||
end fill;
|
||||
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
|
||||
|
||||
|
||||
/* error message routine */
|
||||
error: proc(code);
|
||||
declare
|
||||
code byte;
|
||||
|
||||
call printchar(' ');
|
||||
if code=1 then
|
||||
call print$buf(.(cr,lf,'Disk I/O Error.$'));
|
||||
if code=2 then
|
||||
call print$buf(.(cr,lf,'Drive $'));
|
||||
if code = 3 or code = 2 then
|
||||
call print$buf(.('Read Only$'));
|
||||
if code = 4 then
|
||||
call print$buf(.(cr,lf,'Invalid Filespec (drive).$'));
|
||||
if code = 5 then
|
||||
call print$buf(.('Currently Opened$'));
|
||||
if code = 7 then
|
||||
call print$buf(.('Password Error$'));
|
||||
if code < 3 or code = 4 then
|
||||
call terminate;
|
||||
end error;
|
||||
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
|
||||
|
||||
|
||||
/* print file name */
|
||||
print$file: procedure(fcbp);
|
||||
declare k byte;
|
||||
declare typ lit '9'; /* file type */
|
||||
declare fnam lit '11'; /* file type */
|
||||
declare
|
||||
fcbp addr,
|
||||
fcbv based fcbp (32) byte;
|
||||
|
||||
do k = 1 to fnam;
|
||||
if k = typ then
|
||||
call printchar('.');
|
||||
call printchar(fcbv(k) and 7fh);
|
||||
end;
|
||||
end print$file;
|
||||
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
|
||||
|
||||
|
||||
/* try to delete fcb at fcb$address
|
||||
return error code if unsuccessful */
|
||||
delete:
|
||||
procedure(fcb$address) byte;
|
||||
declare
|
||||
fcb$address address,
|
||||
fcbv based fcb$address (32) byte,
|
||||
error$code address,
|
||||
code byte;
|
||||
|
||||
if xfcb then
|
||||
fcbv(5) = fcbv(5) or 80h;
|
||||
call setdma(.fcb16); /* password */
|
||||
fcbv(0) = fcb(0); /* drive */
|
||||
error$code = delete$file(fcb$address);
|
||||
fcbv(5) = fcbv(5) and 7fh; /* reset xfcb bit */
|
||||
if low(error$code) = 0FFh then do;
|
||||
code = high(error$code);
|
||||
if (code=1) or (code=2) or (code=4) then
|
||||
call error(code);
|
||||
return code;
|
||||
end;
|
||||
return successful;
|
||||
end delete;
|
||||
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
|
||||
|
||||
|
||||
/* upper case character from console */
|
||||
ucase: proc byte;
|
||||
dcl c byte;
|
||||
|
||||
if (c:=conin) >= 'a' then
|
||||
if c < '{' then
|
||||
return(c-20h);
|
||||
return c;
|
||||
end ucase;
|
||||
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
|
||||
|
||||
|
||||
/* get password and place at fcb + 16 */
|
||||
getpasswd: proc;
|
||||
dcl (i,c) byte;
|
||||
|
||||
call crlf;
|
||||
call print$buf(.('Password ? ','$'));
|
||||
retry:
|
||||
call fill(.fcb16,' ',8);
|
||||
do i = 0 to 7;
|
||||
nxtchr:
|
||||
if (c:=ucase) >= ' ' then
|
||||
fcb16(i)=c;
|
||||
if c = cr then do;
|
||||
call crlf;
|
||||
goto exit;
|
||||
end;
|
||||
if c = ctrlx then
|
||||
goto retry;
|
||||
if c = bksp then do;
|
||||
if i<1 then
|
||||
goto retry;
|
||||
else do;
|
||||
fcb16(i:=i-1)=' ';
|
||||
goto nxtchr;
|
||||
end;
|
||||
end;
|
||||
if c = 3 then
|
||||
call terminate;
|
||||
end;
|
||||
exit:
|
||||
c = check$con$stat;
|
||||
end getpasswd;
|
||||
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
|
||||
|
||||
|
||||
/* try deleting files one at a time */
|
||||
single$file:
|
||||
procedure;
|
||||
declare (code,dcnt,sav$searchl) byte;
|
||||
declare (fcba,sav$dcnt) addr;
|
||||
|
||||
file$err: procedure;
|
||||
call crlf;
|
||||
call print$buf(.('Not erased: $'));
|
||||
call print$file(fcba);
|
||||
call error(code);
|
||||
end file$err;
|
||||
|
||||
call setdma(.tbuff);
|
||||
dcnt = search(.fcb);
|
||||
do while dcnt <> 0ffh;
|
||||
fcba = shl(dcnt,5) + .tbuff;
|
||||
sav$dcnt = uda.dcnt;
|
||||
sav$searchl = uda.searchl;
|
||||
if (code:=delete(fcba)) = 7 then do;
|
||||
call file$err;
|
||||
call getpasswd;
|
||||
code = delete(fcba);
|
||||
end;
|
||||
if code <> successful then
|
||||
call file$err;
|
||||
call setdma(.tbuff);
|
||||
/* restore dcnt and search length of 11 */
|
||||
uda.dcnt = sav$dcnt;
|
||||
uda.searchl = sav$searchl;
|
||||
dcnt = searchn;
|
||||
end;
|
||||
end single$file;
|
||||
|
||||
/**************************************
|
||||
* *
|
||||
* M A I N P R O G R A M *
|
||||
* *
|
||||
**************************************/
|
||||
|
||||
|
||||
declare (i,response,user,code) byte;
|
||||
declare ver address;
|
||||
declare last$dseg$byte byte
|
||||
initial (0);
|
||||
|
||||
plm$start: procedure public;
|
||||
|
||||
ver = version;
|
||||
if low(ver) < Ver$BDOS or (high(ver) and Ver$Mask) = 0 then do;
|
||||
call print$buf (.(cr,lf,Ver$Needs$OS,'$'));
|
||||
call mon1(0,0);
|
||||
end;
|
||||
|
||||
parse$fn.buff$adr = .tbuff(1);
|
||||
parse$fn.fcb$adr = .fcb;
|
||||
user = get$user$code;
|
||||
call getuda; /* get uda address */
|
||||
call return$errors;
|
||||
if fcb(17) <> ' ' then
|
||||
if fcb(17) = 'X' then
|
||||
xfcb = true;
|
||||
else do;
|
||||
call print$buf (.(
|
||||
'Invalid Command Option.$'));
|
||||
call terminate;
|
||||
end;
|
||||
|
||||
i = 0;
|
||||
do while fcb(i:=i+1) = '?';
|
||||
;
|
||||
end;
|
||||
if i > 11 then
|
||||
if not xfcb then
|
||||
do;
|
||||
call print$buf (.(
|
||||
'Confirm delete all user files (Y/N)?','$'));
|
||||
response = read$console;
|
||||
if not ((response = 'y') or
|
||||
(response = 'Y'))
|
||||
then call terminate;
|
||||
end;
|
||||
call parse;
|
||||
if (code:=delete(.fcb)) <> successful then do;
|
||||
if code = 0 then
|
||||
call print$buf (.(cr,lf,
|
||||
'File Not Found.','$'));
|
||||
else if code < 3 or code = 4 then
|
||||
call error(code); /* fatal errors */
|
||||
else
|
||||
call single$file; /* single file error */
|
||||
end;
|
||||
call terminate;
|
||||
end plm$start;
|
||||
|
||||
end erase;
|
||||
|
||||
@@ -0,0 +1,420 @@
|
||||
$title ('ERAQ: Erase File with Query')
|
||||
eraseq:
|
||||
do;
|
||||
|
||||
/*
|
||||
Revised:
|
||||
19 Jan 80 by Thomas Rolander
|
||||
20 July 81 by Doug Huskey
|
||||
6 Aug 81 by Danny Horovitz
|
||||
31 Jan 83 by Bill Fitler
|
||||
*/
|
||||
|
||||
$include (:f2:copyrt.lit)
|
||||
|
||||
$include (:f2:vaxcmd.lit)
|
||||
|
||||
$include (:f2:vermpm.lit)
|
||||
|
||||
declare
|
||||
true literally '1',
|
||||
false literally '0',
|
||||
forever literally 'while true',
|
||||
lit literally 'literally',
|
||||
proc literally 'procedure',
|
||||
dcl literally 'declare',
|
||||
addr literally 'address',
|
||||
cr literally '13',
|
||||
lf literally '10',
|
||||
ctrlc literally '3',
|
||||
ctrlx literally '18h',
|
||||
bksp literally '8';
|
||||
|
||||
|
||||
/**************************************
|
||||
* *
|
||||
* B D O S INTERFACE *
|
||||
* *
|
||||
**************************************/
|
||||
|
||||
|
||||
mon1:
|
||||
procedure (func,info) external;
|
||||
declare func byte;
|
||||
declare info address;
|
||||
end mon1;
|
||||
|
||||
mon2:
|
||||
procedure (func,info) byte external;
|
||||
declare func byte;
|
||||
declare info address;
|
||||
end mon2;
|
||||
|
||||
mon3:
|
||||
procedure (func,info) address external;
|
||||
declare func byte;
|
||||
declare info address;
|
||||
end mon3;
|
||||
|
||||
|
||||
|
||||
declare cmdrv byte external; /* command drive */
|
||||
declare fcb (1) byte external; /* 1st default fcb */
|
||||
declare fcb16 (1) byte external; /* 2nd default fcb */
|
||||
declare pass0 address external; /* 1st password ptr */
|
||||
declare len0 byte external; /* 1st passwd length */
|
||||
declare pass1 address external; /* 2nd password ptr */
|
||||
declare len1 byte external; /* 2nd passwd length */
|
||||
declare tbuff (1) byte external; /* default dma buffer */
|
||||
|
||||
|
||||
/**************************************
|
||||
* *
|
||||
* B D O S Externals *
|
||||
* *
|
||||
**************************************/
|
||||
|
||||
read$console:
|
||||
procedure byte;
|
||||
return mon2 (1,0);
|
||||
end read$console;
|
||||
|
||||
|
||||
printchar:
|
||||
procedure(char);
|
||||
declare char byte;
|
||||
call mon1(2,char);
|
||||
end printchar;
|
||||
|
||||
conin:
|
||||
procedure byte;
|
||||
return mon2(6,0fdh);
|
||||
end conin;
|
||||
|
||||
print$buf:
|
||||
procedure (buffer$address);
|
||||
declare buffer$address address;
|
||||
call mon1 (9,buffer$address);
|
||||
end print$buf;
|
||||
|
||||
check$con$stat:
|
||||
procedure byte;
|
||||
return mon2(11,0);
|
||||
end check$con$stat;
|
||||
|
||||
version: procedure address;
|
||||
/* returns current cp/m version # */
|
||||
return mon3(12,0);
|
||||
end version;
|
||||
|
||||
setdma: procedure(dma);
|
||||
declare dma address;
|
||||
call mon1(26,dma);
|
||||
end setdma;
|
||||
|
||||
search$first:
|
||||
procedure (fcb$address) byte;
|
||||
declare fcb$address address;
|
||||
return mon2 (17,fcb$address);
|
||||
end search$first;
|
||||
|
||||
search$next:
|
||||
procedure byte;
|
||||
return mon2 (18,0);
|
||||
end search$next;
|
||||
|
||||
delete$file:
|
||||
procedure (fcb$address) address;
|
||||
declare fcb$address address;
|
||||
return mon3 (19,fcb$address);
|
||||
end delete$file;
|
||||
|
||||
get$user$code:
|
||||
procedure byte;
|
||||
return mon2 (32,0ffh);
|
||||
end get$user$code;
|
||||
|
||||
/* 0ff => return BDOS errors */
|
||||
return$errors:
|
||||
procedure;
|
||||
call mon1 (45,0ffh);
|
||||
end return$errors;
|
||||
|
||||
|
||||
terminate:
|
||||
procedure;
|
||||
call mon1 (143,0);
|
||||
end terminate;
|
||||
|
||||
declare
|
||||
parse$fn structure (
|
||||
buff$adr address,
|
||||
fcb$adr address);
|
||||
declare (saveax,savecx) word external; /* reg return vals, set in mon1 */
|
||||
|
||||
parse: procedure;
|
||||
declare (retcode,errcode) word;
|
||||
|
||||
call mon1(152,.parse$fn);
|
||||
retcode = saveax;
|
||||
errcode = savecx;
|
||||
if retcode = 0ffffh then /* parse returned an error */
|
||||
do;
|
||||
call print$buf(.('Invalid Filespec$'));
|
||||
if errcode = 23 then call print$buf(.(' (drive)$'));
|
||||
else if errcode = 24 then call print$buf(.(' (filename)$'));
|
||||
else if errcode = 25 then call print$buf(.(' (filetype)$'));
|
||||
else if errcode = 38 then call print$buf(.(' (password)$'));
|
||||
call print$buf(.('.',13,10,'$')); call terminate;
|
||||
end;
|
||||
end parse;
|
||||
|
||||
|
||||
|
||||
/**************************************
|
||||
* *
|
||||
* GLOBAL VARIABLES *
|
||||
* *
|
||||
**************************************/
|
||||
|
||||
declare xfcb byte initial(0);
|
||||
declare successful lit '0FFh';
|
||||
|
||||
declare dir$entries (128) structure (
|
||||
file (12) byte );
|
||||
|
||||
declare dir$entry$adr address;
|
||||
declare dir$entry based dir$entry$adr (1) byte;
|
||||
|
||||
/**************************************
|
||||
* *
|
||||
* S U B R O U T I N E S *
|
||||
* *
|
||||
**************************************/
|
||||
|
||||
|
||||
/* upper case character from console */
|
||||
crlf: proc;
|
||||
call printchar(cr);
|
||||
call printchar(lf);
|
||||
end crlf;
|
||||
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
|
||||
|
||||
|
||||
/* fill string @ s for c bytes with f */
|
||||
fill: proc(s,f,c);
|
||||
dcl s addr,
|
||||
(f,c) byte,
|
||||
a based s byte;
|
||||
|
||||
do while (c:=c-1)<>255;
|
||||
a = f;
|
||||
s = s+1;
|
||||
end;
|
||||
end fill;
|
||||
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
|
||||
|
||||
|
||||
/* error message routine */
|
||||
error: proc(code);
|
||||
declare
|
||||
code byte;
|
||||
|
||||
call printchar(' ');
|
||||
if code=1 then
|
||||
call print$buf(.(cr,lf,'Disk I/O Error.$'));
|
||||
if code=2 then
|
||||
call print$buf(.(cr,lf,'Drive $'));
|
||||
if code = 3 or code = 2 then
|
||||
call print$buf(.('Read Only$'));
|
||||
if code = 4 then
|
||||
call print$buf(.(cr,lf,'Invalid Filespec (drive).$'));
|
||||
if code = 5 then
|
||||
call print$buf(.('Currently Opened$'));
|
||||
if code = 7 then
|
||||
call print$buf(.('Password Error$'));
|
||||
if code < 3 or code = 4 then
|
||||
call terminate;
|
||||
end error;
|
||||
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
|
||||
|
||||
|
||||
/* try to delete fcb at fcb$address
|
||||
return error code if unsuccessful */
|
||||
delete:
|
||||
procedure(fcb$address) byte;
|
||||
declare
|
||||
fcb$address address,
|
||||
fcbv based fcb$address (32) byte,
|
||||
error$code address,
|
||||
code byte;
|
||||
|
||||
if xfcb then
|
||||
fcbv(5) = fcbv(5) or 80h;
|
||||
call setdma(.fcb16); /* password */
|
||||
fcbv(0) = fcb(0); /* drive */
|
||||
error$code = delete$file(fcb$address);
|
||||
fcbv(5) = fcbv(5) and 7fh; /* reset xfcb bit */
|
||||
if low(error$code) = 0FFh then do;
|
||||
code = high(error$code);
|
||||
if (code=1) or (code=2) then
|
||||
call error(code);
|
||||
return code;
|
||||
end;
|
||||
return successful;
|
||||
end delete;
|
||||
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
|
||||
|
||||
|
||||
/* upper case character from console */
|
||||
ucase: proc byte;
|
||||
dcl c byte;
|
||||
|
||||
if (c:=conin) >= 'a' then
|
||||
if c < '{' then
|
||||
return(c-20h);
|
||||
return c;
|
||||
end ucase;
|
||||
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
|
||||
|
||||
|
||||
/* get password and place at fcb + 16 */
|
||||
getpasswd: proc;
|
||||
dcl (i,c) byte;
|
||||
|
||||
call print$buf(.('Password ? ','$'));
|
||||
retry:
|
||||
call fill(.fcb16,' ',8);
|
||||
do i = 0 to 7;
|
||||
nxtchr:
|
||||
if (c:=ucase) >= ' ' then
|
||||
fcb16(i)=c;
|
||||
if c = cr then
|
||||
goto exit;
|
||||
if c = ctrlx then
|
||||
goto retry;
|
||||
if c = bksp then do;
|
||||
if i<1 then
|
||||
goto retry;
|
||||
else do;
|
||||
fcb16(i:=i-1)=' ';
|
||||
goto nxtchr;
|
||||
end;
|
||||
end;
|
||||
if c = 3 then
|
||||
call terminate;
|
||||
end;
|
||||
exit:
|
||||
c = check$con$stat;
|
||||
end getpasswd;
|
||||
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
|
||||
|
||||
|
||||
/* error on deleting a file */
|
||||
file$err: procedure(code);
|
||||
declare code byte;
|
||||
|
||||
call crlf;
|
||||
call print$buf(.('Not erased, $'));
|
||||
call error(code);
|
||||
call crlf;
|
||||
end file$err;
|
||||
|
||||
|
||||
|
||||
/**************************************
|
||||
* *
|
||||
* M A I N P R O G R A M *
|
||||
* *
|
||||
**************************************/
|
||||
|
||||
|
||||
declare (i,j,k,code,response,user,dcnt) byte;
|
||||
declare ver address;
|
||||
|
||||
declare last$dseg$byte byte
|
||||
initial (0);
|
||||
|
||||
plm$start: procedure public;
|
||||
ver = version;
|
||||
if low(ver) < Ver$BDOS or (high(ver) and Ver$Mask) = 0 then do;
|
||||
call print$buf (.(cr,lf,Ver$Needs$OS,'$'));
|
||||
call mon1(0,0);
|
||||
end;
|
||||
|
||||
if fcb(17) <> ' ' then
|
||||
if fcb(17) = 'X' then
|
||||
xfcb = true;
|
||||
else do;
|
||||
call print$buf (.(
|
||||
'Invalid Command Option.$'));
|
||||
call terminate;
|
||||
end;
|
||||
|
||||
parse$fn.buff$adr = .tbuff(1);
|
||||
parse$fn.fcb$adr = .fcb;
|
||||
call parse;
|
||||
|
||||
if fcb(0) = 0 then
|
||||
fcb(0) = low (mon2 (25,0)) + 1;
|
||||
i = -1;
|
||||
user = get$user$code;
|
||||
call return$errors;
|
||||
dcnt = search$first (.fcb);
|
||||
do while dcnt <> 0ffh;
|
||||
dir$entry$adr = .tbuff(ror(dcnt,3) and 110$0000b);
|
||||
if dir$entry(0) = user then
|
||||
do;
|
||||
if (i:=i+1) = 128 then
|
||||
do;
|
||||
call print$buf (.(
|
||||
'Too many directory entries for query.','$'));
|
||||
call terminate;
|
||||
end;
|
||||
call move (12,.dir$entry(1),.dir$entries(i));
|
||||
end;
|
||||
dcnt = search$next;
|
||||
end;
|
||||
if i = -1 then
|
||||
do;
|
||||
call print$buf (.(
|
||||
'File Not Found.','$'));
|
||||
end;
|
||||
else
|
||||
do j = 0 to i;
|
||||
call printchar ('A'+fcb(0)-1);
|
||||
call printchar (':');
|
||||
call printchar (' ');
|
||||
do k = 0 to 10;
|
||||
if k = 8
|
||||
then call printchar ('.');
|
||||
call printchar (dir$entries(j).file(k) and 07FH);
|
||||
end;
|
||||
call printchar (' ');
|
||||
call printchar ('?');
|
||||
response = read$console;
|
||||
call printchar (0dh);
|
||||
call printchar (0ah);
|
||||
if (response = 'y') or
|
||||
(response = 'Y') then
|
||||
do;
|
||||
call move (12,.dir$entries(j),.fcb(1));
|
||||
if (code:=delete(.fcb)) <> successful then do;
|
||||
if code < 3 or code = 4 then
|
||||
call error(code); /* fatal errors */
|
||||
else if code = 7 then do;
|
||||
call file$err(code);
|
||||
call getpasswd;
|
||||
code = delete(.fcb);
|
||||
end;
|
||||
if code <> successful then
|
||||
call file$err(code);
|
||||
call crlf;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
call terminate;
|
||||
end plm$start;
|
||||
|
||||
end eraseq;
|
||||
|
||||
@@ -0,0 +1,772 @@
|
||||
GENCMD:
|
||||
DO;
|
||||
/* CP/M 8086 CMD file generator
|
||||
|
||||
COPYRIGHT (C) 1983
|
||||
DIGITAL RESEARCH
|
||||
BOX 579 PACIFIC GROVE
|
||||
CALIFORNIA 93950
|
||||
|
||||
*/
|
||||
|
||||
/**** The following commands were used on the VAX to compile GENCMD:
|
||||
|
||||
$ util := GENCMD
|
||||
$ ccpmsetup ! set up environment
|
||||
$ plm86 'util'.plm xref 'p1' optimize(3) debug
|
||||
$ link86 f1:scd.obj, 'util'.obj to 'util'.lnk
|
||||
$ loc86 'util'.lnk od(sm(code,dats,data,stack,const)) -
|
||||
ad(sm(code(0),dats(10000h))) ss(stack(+32)) to 'util'.
|
||||
$ h86 'util'
|
||||
|
||||
**** Followed on the micro by:
|
||||
A>vax gencmd.h86 $fans
|
||||
A>gencmd gencmd data[b1000 m86 xfff]
|
||||
|
||||
****/
|
||||
|
||||
DECLARE
|
||||
digital$code literally '0081h', /*DR code record */
|
||||
digital$data literally '0082h', /* DR data record */
|
||||
digital02 literally '0085h', /* DR 02 records */
|
||||
paragraph literally '16',
|
||||
ex literally '12', /* extent */
|
||||
nr literally '32', /* current record */
|
||||
maxb address external,
|
||||
fcba(33) byte external, /* DEFAULT FILE CONTROL BLOCK */
|
||||
buffa(128) byte external; /* DEFAULT BUFFER ADDRESS */
|
||||
|
||||
|
||||
DECLARE COPYRIGHT(*) BYTE DATA
|
||||
(' COPYRIGHT (C) 1983, DIGITAL RESEARCH ');
|
||||
|
||||
MON1: PROCEDURE(F,A) EXTERNAL;
|
||||
DECLARE F BYTE, A ADDRESS;
|
||||
END MON1;
|
||||
|
||||
MON2: PROCEDURE(F,A) BYTE EXTERNAL;
|
||||
DECLARE F BYTE, A ADDRESS;
|
||||
END MON2;
|
||||
|
||||
DECLARE SP ADDRESS;
|
||||
|
||||
BOOT: PROCEDURE;
|
||||
call mon1 (0,0);
|
||||
END BOOT;
|
||||
|
||||
declare segmts(11) structure (name(5) byte,begin$add address)
|
||||
initial ('CODE ',00h,'DATA ',0ffffh,'EXTRA',0ffffh,'STACK',0,
|
||||
'X1 ',0,'X2 ',0,'X3 ',0,'X4 ',0,'8080 ',0,'NZERO',0,
|
||||
'NHEAD',0);
|
||||
|
||||
|
||||
|
||||
declare header (15) structure
|
||||
(typseg byte,file$length address,absolute$add address,
|
||||
minimum$mem address,
|
||||
maximum$mem address) initial (0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,
|
||||
0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,00,0,0,0,0,0,0,0,0,0,
|
||||
0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0);
|
||||
|
||||
|
||||
plmstart: PROCEDURE public;
|
||||
DECLARE FCB (33) BYTE AT (.FCBA),
|
||||
DFCBA LITERALLY 'FCBA';
|
||||
DECLARE BUFFER (128) BYTE AT (.BUFFA),
|
||||
DBUFF LITERALLY 'BUFFA';
|
||||
DECLARE SFCB(33) BYTE, /* SOURCE FILE CONTROL BLOCK */
|
||||
BSIZE LITERALLY '1024',
|
||||
EOFILE LITERALLY '1AH',
|
||||
SBUFF(BSIZE) BYTE, /* SOURCE FILE BUFFER */
|
||||
RFLAG BYTE, /* READER FLAG */
|
||||
SBP ADDRESS; /* SOURCE FILE BUFFER POINTER */
|
||||
declare tbp address; /* pointer to command tail */
|
||||
declare count$command$tail byte at (.buffa);
|
||||
declare (t8080,nozero) byte;
|
||||
|
||||
|
||||
|
||||
DECLARE
|
||||
TRUE LITERALLY '1',
|
||||
FALSE LITERALLY '0',
|
||||
FOREVER LITERALLY 'WHILE TRUE',
|
||||
CR LITERALLY '13',
|
||||
LF LITERALLY '10',
|
||||
WHAT LITERALLY '63';
|
||||
|
||||
PRINTCHAR: PROCEDURE(CHAR);
|
||||
DECLARE CHAR BYTE;
|
||||
CALL MON1(2,CHAR);
|
||||
END PRINTCHAR;
|
||||
|
||||
CRLF: PROCEDURE;
|
||||
CALL PRINTCHAR(CR);
|
||||
CALL PRINTCHAR(LF);
|
||||
END CRLF;
|
||||
|
||||
PRINTNIB: PROCEDURE(N);
|
||||
DECLARE N BYTE;
|
||||
IF N > 9 THEN CALL PRINTCHAR(N+'A'-10); ELSE
|
||||
CALL PRINTCHAR(N+'0');
|
||||
END PRINTNIB;
|
||||
|
||||
PRINTHEX: PROCEDURE(B);
|
||||
DECLARE B BYTE;
|
||||
CALL PRINTNIB(SHR(B,4)); CALL PRINTNIB(B AND 0FH);
|
||||
END PRINTHEX;
|
||||
|
||||
PRINTADDR: PROCEDURE(A);
|
||||
DECLARE A ADDRESS;
|
||||
CALL PRINTHEX(HIGH(A)); CALL PRINTHEX(LOW(A));
|
||||
END PRINTADDR;
|
||||
|
||||
PRINTM: PROCEDURE(A);
|
||||
DECLARE A ADDRESS;
|
||||
CALL MON1(9,A);
|
||||
END PRINTM;
|
||||
|
||||
PRINT: PROCEDURE(A);
|
||||
DECLARE A ADDRESS;
|
||||
/* PRINT THE STRING STARTING AT ADDRESS A UNTIL THE
|
||||
NEXT DOLLAR SIGN IS ENCOUNTERED WITH PRECEDING CRLF */
|
||||
CALL CRLF;
|
||||
CALL PRINTM(A);
|
||||
END PRINT;
|
||||
|
||||
declare mbuffadr address,
|
||||
LA ADDRESS; /* CURRENT LOAD ADDRESS */
|
||||
declare head byte;
|
||||
|
||||
PERROR: PROCEDURE(A);
|
||||
/* PRINT ERROR MESSAGE */
|
||||
DECLARE A ADDRESS;
|
||||
CALL PRINT(.('ERROR: $'));
|
||||
CALL PRINTM(A);
|
||||
CALL PRINTM(.(', LOAD ADDRESS $'));
|
||||
CALL PRINTADDR(LA);
|
||||
CALL BOOT;
|
||||
END PERROR;
|
||||
|
||||
|
||||
diskerror: procedure;
|
||||
call perror(.('DISK WRITE$'));
|
||||
end diskerror;
|
||||
|
||||
DECLARE DCNT BYTE;
|
||||
|
||||
|
||||
setdma: procedure(a);
|
||||
declare a address;
|
||||
call mon1 (26,a);
|
||||
end setdma;
|
||||
|
||||
OPEN: PROCEDURE(FCB);
|
||||
DECLARE FCB ADDRESS;
|
||||
DCNT = MON2(15,FCB);
|
||||
END OPEN;
|
||||
|
||||
CLOSE: PROCEDURE(FCB);
|
||||
DECLARE FCB ADDRESS;
|
||||
DCNT = MON2(16,FCB);
|
||||
END CLOSE;
|
||||
|
||||
SEARCH: PROCEDURE(FCB);
|
||||
DECLARE FCB ADDRESS;
|
||||
DCNT = MON2(17,FCB);
|
||||
END SEARCH;
|
||||
|
||||
SEARCHN: PROCEDURE;
|
||||
DCNT = MON2(18,0);
|
||||
END SEARCHN;
|
||||
|
||||
DELETE: PROCEDURE(FCB);
|
||||
DECLARE FCB ADDRESS;
|
||||
CALL MON1(19,FCB);
|
||||
END DELETE;
|
||||
|
||||
DISKREAD: PROCEDURE(FCB) BYTE;
|
||||
DECLARE FCB ADDRESS;
|
||||
RETURN MON2(20,FCB);
|
||||
END DISKREAD;
|
||||
|
||||
DISKWRITE: PROCEDURE(FCB) BYTE;
|
||||
DECLARE FCB ADDRESS;
|
||||
RETURN MON2(21,FCB);
|
||||
END DISKWRITE;
|
||||
|
||||
MAKE: PROCEDURE(FCB);
|
||||
DECLARE FCB ADDRESS;
|
||||
DCNT = MON2(22,FCB);
|
||||
END MAKE;
|
||||
|
||||
RENAME: PROCEDURE(FCB);
|
||||
DECLARE FCB ADDRESS;
|
||||
CALL MON1(23,FCB);
|
||||
END RENAME;
|
||||
|
||||
MOVE: PROCEDURE(S,D,N);
|
||||
DECLARE (S,D) ADDRESS, N BYTE,
|
||||
A BASED S BYTE, B BASED D BYTE;
|
||||
DO WHILE (N:=N-1) <> 255;
|
||||
B = A; S=S+1; D=D+1;
|
||||
END;
|
||||
END MOVE;
|
||||
|
||||
|
||||
declare char byte;
|
||||
|
||||
|
||||
|
||||
|
||||
comline$error: procedure;
|
||||
declare i byte;
|
||||
call crlf;
|
||||
do i = 1 to tbp;
|
||||
call printchar (buffer(i));
|
||||
end;
|
||||
call printchar ('?');
|
||||
call crlf;
|
||||
call boot;
|
||||
end comline$error;
|
||||
|
||||
|
||||
|
||||
|
||||
retchar: procedure byte;
|
||||
/* get another character from command tail */
|
||||
if (tbp :=tbp+1) <= count$command$tail then
|
||||
return buffer(tbp);
|
||||
else return (0dh);
|
||||
end retchar;
|
||||
|
||||
tran: procedure(b) byte;
|
||||
declare b byte;
|
||||
if b < ' ' then return 0dh; /* non-graphic */
|
||||
if b - 'a' < ('z' - 'a') then
|
||||
b = b and 101$1111b; /* upper case */
|
||||
return b;
|
||||
end tran;
|
||||
|
||||
|
||||
next$non$blank: procedure;
|
||||
char=tran(retchar);
|
||||
do while char= ' ';
|
||||
char= tran(retchar);
|
||||
end;
|
||||
end next$non$blank;
|
||||
|
||||
|
||||
CHECK$ONE$HEX: PROCEDURE (h) BYTE;
|
||||
/* READ ONE HEX CHARACTER FROM THE INPUT */
|
||||
DECLARE H BYTE;
|
||||
IF H - '0' <= 9 THEN RETURN H - '0';
|
||||
IF H - 'A' > 5 THEN
|
||||
return (0ffh);
|
||||
RETURN H - 'A' + 10;
|
||||
END CHECK$ONE$HEX;
|
||||
|
||||
|
||||
|
||||
MAKE$DOUBLE: PROCEDURE(H,L) ADDRESS;
|
||||
/* CREATE A BOUBLE BYTE VALUE FROM TWO SINGLE BYTES */
|
||||
DECLARE (H,L) BYTE;
|
||||
RETURN SHL(DOUBLE(H),8) OR L;
|
||||
END MAKE$DOUBLE;
|
||||
|
||||
|
||||
|
||||
delimiter: procedure byte; /* logical */
|
||||
declare i byte;
|
||||
declare del (*) byte data (0dh,'[], ');
|
||||
do i = 0 to last(del);
|
||||
if char = del(i) then return true;
|
||||
end;
|
||||
return false;
|
||||
end delimiter;
|
||||
|
||||
|
||||
get$num: procedure address;
|
||||
declare paradd address;
|
||||
paradd = 0;
|
||||
char = retchar;
|
||||
do while not delimiter ;
|
||||
if (char:=check$one$hex(char)) = 0ffh then
|
||||
call comline$error; else
|
||||
paradd = paradd * 16 + char;
|
||||
char = retchar;
|
||||
end;
|
||||
|
||||
return paradd;
|
||||
end get$num;
|
||||
|
||||
|
||||
|
||||
|
||||
GETCHAR: PROCEDURE BYTE;
|
||||
/* GET NEXT CHARACTER FROM DISK BUFFER */
|
||||
DECLARE I BYTE;
|
||||
IF (SBP := SBP+1) <= LAST(SBUFF) THEN
|
||||
RETURN SBUFF(SBP);
|
||||
/* OTHERWISE READ ANOTHER BUFFER FULL */
|
||||
DO SBP = 0 TO LAST(SBUFF) BY 128;
|
||||
IF (I:=DISKREAD(.SFCB)) = 0 THEN
|
||||
CALL MOVE(.buffer,.SBUFF(SBP),80H); ELSE
|
||||
DO;
|
||||
IF I<>1 THEN CALL PERROR(.('DISK READ$'));
|
||||
SBUFF(SBP) = EOFILE;
|
||||
SBP = LAST(SBUFF);
|
||||
END;
|
||||
END;
|
||||
SBP = 0; RETURN SBUFF(0);
|
||||
END GETCHAR;
|
||||
DECLARE
|
||||
STACKPOINTER LITERALLY 'STACKPTR';
|
||||
|
||||
/* INTEL HEX FORMAT LOADER */
|
||||
|
||||
RELOC: PROCEDURE;
|
||||
DECLARE (RL, CS, RT,K) BYTE;
|
||||
declare multi$segments byte;
|
||||
DECLARE
|
||||
tabs address, /* temporary value */
|
||||
TA ADDRESS, /* TEMP ADDRESS */
|
||||
SA ADDRESS, /* PARAGRAPH LOAD ADDRESS */
|
||||
FA ADDRESS, /* FINAL ADDRESS */
|
||||
NB ADDRESS, /* NUMBER OF BYTES LOADED */
|
||||
nxb byte, /* next byte in stream */
|
||||
segadjst address, /* segment adjust */
|
||||
seg$length (8) address, /* length of each segment */
|
||||
write$add address,
|
||||
|
||||
MBUFF based mbuffadr (256) BYTE,
|
||||
P BYTE;
|
||||
declare high$add address;
|
||||
|
||||
SETMEM: PROCEDURE(B);
|
||||
/* set mbuff to b at location la */
|
||||
DECLARE (B) BYTE;
|
||||
if ((.memory+la) < 0) or ((.memory+la) > maxb) then
|
||||
do;
|
||||
call print (.('INSUFFICIENT MEMORY TO CREATE CMD FILE $'));
|
||||
call boot;
|
||||
end;
|
||||
MBUFF(LA) = B;
|
||||
END SETMEM;
|
||||
|
||||
|
||||
zero$mem: procedure;
|
||||
do while (.memory +la) <maxb and not nozero;
|
||||
mbuff(la) = 0;
|
||||
la = la +1;
|
||||
end;
|
||||
end zero$mem;
|
||||
|
||||
|
||||
|
||||
DIAGNOSE: PROCEDURE;
|
||||
|
||||
DECLARE M BASED TA BYTE;
|
||||
|
||||
NEWLINE: PROCEDURE;
|
||||
CALL CRLF; CALL PRINTADDR(TA); CALL PRINTCHAR(':');
|
||||
CALL PRINTCHAR(' ');
|
||||
END NEWLINE;
|
||||
|
||||
/* PRINT DIAGNOSTIC INFORMATION AT THE CONSOLE */
|
||||
CALL PRINT(.('LOAD ADDRESS $')); CALL PRINTADDR(TA);
|
||||
CALL PRINT(.('ERROR ADDRESS $')); CALL PRINTADDR(LA);
|
||||
|
||||
CALL PRINT(.('BYTES READ:$')); CALL NEWLINE;
|
||||
DO WHILE TA < LA;
|
||||
IF (LOW(TA) AND 0FH) = 0 THEN CALL NEWLINE;
|
||||
CALL PRINTHEX(MBUFF(TA)); TA=TA+1;
|
||||
CALL PRINTCHAR(' ');
|
||||
END;
|
||||
CALL CRLF;
|
||||
CALL BOOT;
|
||||
END DIAGNOSE;
|
||||
write$record: procedure;
|
||||
|
||||
call setdma(write$add);
|
||||
if diskwrite(.fcba) <> 0 then call diskerror;
|
||||
p = p+1;
|
||||
end write$record;
|
||||
|
||||
|
||||
|
||||
empty$buffers: procedure;
|
||||
write$add = .memory;
|
||||
do while write$add+127 <= (.memory+fa);
|
||||
call write$record;
|
||||
write$add = write$add+128;
|
||||
end;
|
||||
if not multi$segments then
|
||||
do;
|
||||
call write$record;
|
||||
return;
|
||||
end;
|
||||
call move (write$add,.memory,(la:=.memory+fa+1-write$add));
|
||||
end empty$buffers;
|
||||
|
||||
|
||||
|
||||
READHEX: PROCEDURE BYTE;
|
||||
/* READ ONE HEX CHARACTER FROM THE INPUT */
|
||||
declare khex byte;
|
||||
if (khex := check$one$hex(getchar)) <> 0ffh then return khex;
|
||||
else
|
||||
DO; CALL PRINT(.('INVALID HEX DIGIT$'));
|
||||
CALL DIAGNOSE;
|
||||
end;
|
||||
end readhex;
|
||||
|
||||
READBYTE: PROCEDURE BYTE;
|
||||
/* READ TWO HEX DIGITS */
|
||||
RETURN SHL(READHEX,4) OR READHEX;
|
||||
END READBYTE;
|
||||
|
||||
READCS: PROCEDURE BYTE;
|
||||
/* READ BYTE WHILE COMPUTING CHECKSUM */
|
||||
DECLARE B BYTE;
|
||||
CS = CS + (B := READBYTE);
|
||||
RETURN B;
|
||||
END READCS;
|
||||
|
||||
|
||||
hex$input: procedure;
|
||||
if rt = 2 or rt > 84h then
|
||||
segadjst = make$double(readcs,readcs); else
|
||||
|
||||
do;
|
||||
/* PROCESS EACH BYTE */
|
||||
DO WHILE (RL := RL - 1) <> 255;
|
||||
CALL SETMEM(READCS); LA = LA+1;
|
||||
END;
|
||||
IF LA > FA THEN FA = LA - 1;
|
||||
end;
|
||||
|
||||
|
||||
|
||||
/* NOW READ CHECKSUM AND COMPARE */
|
||||
IF CS + READBYTE <> 0 THEN
|
||||
DO; CALL PRINT(.('CHECK SUM ERROR $'));
|
||||
CALL DIAGNOSE;
|
||||
END;
|
||||
end hex$input;
|
||||
|
||||
|
||||
get$buffer$len: procedure;
|
||||
multi$segments = true;
|
||||
if rt = 84h then rt = 83h;
|
||||
else if rt = 83h then rt = 84h;
|
||||
if seg$length (rt-81h) <= (high$add:=la+rl-1) then
|
||||
do;
|
||||
if high$add=0 then high$add = 1;
|
||||
seg$length (rt-81h) = high$add;
|
||||
header(rt-81h).typseg = rt-80h;
|
||||
end;
|
||||
end get$buffer$len;
|
||||
|
||||
compute$la: procedure (j) address;
|
||||
declare j byte;
|
||||
return (la and 000Fh)+shl((sa-segmts(j).begin$add),4);
|
||||
end compute$la;
|
||||
|
||||
|
||||
|
||||
|
||||
/* INITIALIZE */
|
||||
SA, FA, NB = 0;
|
||||
P = 0; /* PARAGRAPH COUNT */
|
||||
SBUFF(0) = EOFILE;
|
||||
fcb(nr) = 0;
|
||||
if head then fcb(nr) = 1;
|
||||
multi$segments = false;
|
||||
segadjst = 0;
|
||||
do k= 0 to 7;
|
||||
seglength(k) = 0;
|
||||
end;
|
||||
|
||||
call zero$mem;
|
||||
|
||||
ta=0;
|
||||
la=1;
|
||||
/* READ RECORDS UNTIL :00XXXX IS ENCOUNTERED */
|
||||
|
||||
DO FOREVER;
|
||||
/* SCAN THE : */
|
||||
DO WHILE (nxb:=getchar) <> ':';
|
||||
if nxb = eofile then go to second;
|
||||
/* MAY BE THE END OF TAPE */
|
||||
END;
|
||||
|
||||
/* SET CHECK SUM TO ZERO, AND SAVE THE RECORD LENGTH */
|
||||
CS = 0;
|
||||
nb = nb +(rl:=readcs);
|
||||
|
||||
TA, LA = MAKE$DOUBLE(READCS,READCS) ;
|
||||
sa = segadjst + shr(la,4);
|
||||
|
||||
|
||||
/* READ THE RECORD TYPE */
|
||||
|
||||
/* skip all records except type 0 2 81 */
|
||||
if (rt:=readcs) > digital$code and rt < digital02 then
|
||||
do;
|
||||
if not t8080 then
|
||||
call get$buffer$len; else
|
||||
call hex$input;
|
||||
end; else
|
||||
do;
|
||||
if (rt = digital$code) then
|
||||
do;
|
||||
call hex$input;
|
||||
header(0).typseg = 1;
|
||||
end; else
|
||||
do;
|
||||
if (rt = 0 and sa < segmts(1).begin$add and sa >= segmts(0).begin$add)
|
||||
or rt = 2 then
|
||||
do;
|
||||
la = compute$la(0);
|
||||
call hex$input;
|
||||
header(0).typseg = 1;
|
||||
end;
|
||||
if (rt = 0 and sa >= segmts(1).begin$add) then
|
||||
do;
|
||||
multi$segments = true;
|
||||
if seg$length(1) <
|
||||
(high$add:=compute$la(1) +rl-1) then
|
||||
do;
|
||||
seg$length(1) = high$add;
|
||||
header(1).typseg=2;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
|
||||
second:
|
||||
call empty$buffers;
|
||||
ta = (la+paragraph-1) and 0fff0h;
|
||||
header(0).file$length=fa/16+1;
|
||||
if header(0).minimum$mem = 0 then header(0).minimum$mem = fa/16+1;
|
||||
fa=ta;
|
||||
if not multi$segments then go to fin;
|
||||
call zero$mem;
|
||||
multi$segments = false;
|
||||
sfcb(ex),sfcb(nr) = 0;
|
||||
call open(.sfcb);
|
||||
call setdma(.buffer);
|
||||
|
||||
do k = 1 to 7;
|
||||
if seg$length(k) <> 0 then
|
||||
do;
|
||||
seg$length(k) = seg$length(k)+paragraph and 0fff0h;
|
||||
header(k).file$length = seg$length(k)/16;
|
||||
if header(k).minimum$mem=0 then
|
||||
header(k).minimum$mem=seg$length(k)/16;
|
||||
end;
|
||||
end;
|
||||
segadjst = 0;
|
||||
seg$length(0) = ta;
|
||||
sbp=length(sbuff);
|
||||
|
||||
|
||||
DO FOREVER;
|
||||
/* SCAN THE : */
|
||||
DO WHILE (nxb:=getchar) <> ':';
|
||||
if nxb = eofile then go to afin;
|
||||
END;
|
||||
|
||||
cs = 0;
|
||||
rl = readcs;
|
||||
|
||||
la = make$double(readcs,readcs);
|
||||
sa = segadjst + shr(la,4);
|
||||
|
||||
if (rt := readcs) = eofile then go to afin;
|
||||
if rt = 84h then rt = 83h;
|
||||
else if rt = 83h then rt = 84h;
|
||||
if rt > digital$code and rt < digital02 then
|
||||
do;
|
||||
do k = 0 to (rt-82h);
|
||||
la = la + seg$length(k);
|
||||
end;
|
||||
call hex$input;
|
||||
end;
|
||||
if (rt = 0 and sa >= segmts(1).begin$add) or rt = 2 then
|
||||
do;
|
||||
la = compute$la(1) + seg$length(0);
|
||||
call hex$input;
|
||||
end;
|
||||
|
||||
|
||||
END;
|
||||
|
||||
|
||||
afin:
|
||||
call empty$buffers;
|
||||
|
||||
|
||||
FIN:
|
||||
/* PRINT FINAL STATISTICS */
|
||||
CALL PRINT(.('BYTES READ $')); CALL PRINTADDR(NB);
|
||||
CALL PRINT(.('RECORDS WRITTEN $')); CALL PRINTHEX(P+1);
|
||||
CALL CRLF;
|
||||
|
||||
/* write the header record */
|
||||
call close(.fcba);
|
||||
if head then
|
||||
do;
|
||||
fcb(ex),fcb(nr) = 0;
|
||||
call open(.fcba);
|
||||
call move (.header,.buffer,128);
|
||||
call setdma(.buffer);
|
||||
if diskwrite(.fcba) <> 0 then call diskerror;
|
||||
|
||||
end;
|
||||
END RELOC;
|
||||
|
||||
|
||||
declare seg$number byte;
|
||||
|
||||
ignore$filename: procedure;
|
||||
tbp = 0;
|
||||
char = buffer(tbp);
|
||||
call next$non$blank;
|
||||
do while (char:=buffer(tbp)) <> ' ';
|
||||
tbp = tbp +1;
|
||||
end;
|
||||
|
||||
end ignore$filename;
|
||||
|
||||
|
||||
|
||||
parse$tail: procedure;
|
||||
declare seg$index byte;
|
||||
|
||||
get$segmt: procedure byte;
|
||||
/* get the segment name */
|
||||
declare ( kentry, match$flag,j, no$match) byte;
|
||||
declare user$segmt(5) byte;
|
||||
|
||||
do j = 0 to last (user$segmt);
|
||||
if delimiter then
|
||||
user$segmt(j) = ' '; else
|
||||
do;
|
||||
user$segmt(j) = char;
|
||||
char = tran(retchar);
|
||||
end;
|
||||
end;
|
||||
|
||||
|
||||
seg$index = 0;
|
||||
no$match, matchflag = true;
|
||||
|
||||
do while no$match and seg$index < 11;
|
||||
|
||||
match$flag=true;
|
||||
kentry = 0;
|
||||
do while match$flag and kentry <= last (segmts.name);
|
||||
if usersegmt(kentry) <> segmts(seg$index).name(kentry) then
|
||||
matchflag = false; else
|
||||
kentry = kentry +1;
|
||||
end;
|
||||
if matchflag then no$match = false; else
|
||||
seg$index = seg$index +1;
|
||||
end;
|
||||
if no$match then seg$index = 0ffh;
|
||||
return seg$index;
|
||||
end get$segmt;
|
||||
|
||||
get$switches: procedure;
|
||||
do while char <> ']' and char <> cr;
|
||||
call next$non$blank;
|
||||
if char= 'A' then header(seg$index).absolute$add = (get$num);
|
||||
else if
|
||||
char= 'M' then
|
||||
do;
|
||||
header(seg$index).minimum$mem = (get$num);
|
||||
header(seg$index).typseg = seg$index+1;
|
||||
end;
|
||||
else if
|
||||
char= 'X' then header(seg$index).maximum$mem = (get$num);
|
||||
else if
|
||||
char= 'B' then segmts(seg$index).begin$add = (get$num);
|
||||
else do;
|
||||
call comline$error;
|
||||
call boot;
|
||||
end ;
|
||||
end;
|
||||
|
||||
|
||||
end get$switches;
|
||||
|
||||
|
||||
|
||||
do forever;
|
||||
call next$non$blank;
|
||||
if char = cr then return;
|
||||
if get$segmt = 0ffh then
|
||||
do;
|
||||
call comline$error;
|
||||
end;
|
||||
if seg$index < 8 then
|
||||
do;
|
||||
if char = ']' or char = cr then call comline$error;
|
||||
call get$switches;
|
||||
end;
|
||||
else
|
||||
do;
|
||||
if seg$index = 8 then t8080 = true; else
|
||||
do;
|
||||
if seg$index = 9 then nozero = true; else
|
||||
head = false;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
end parse$tail;
|
||||
|
||||
|
||||
|
||||
/* ARRIVE HERE FROM THE SYSTEM MONITOR, READY TO READ THE HEX TAPE */
|
||||
|
||||
/* SET UP STACKPOINTER IN THE LOCAL AREA */
|
||||
DECLARE STACK(64) ADDRESS;
|
||||
SP = STACKPOINTER; STACKPOINTER = .STACK(LENGTH(STACK));
|
||||
LA = 0h;
|
||||
mbuffadr = .memory;
|
||||
t8080 = false;
|
||||
nozero = false;
|
||||
head = true;
|
||||
|
||||
SBP = LENGTH(SBUFF);
|
||||
/* SET UP THE SOURCE FILE */
|
||||
CALL MOVE(.FCBA,.SFCB,33);
|
||||
CALL MOVE(.('H86',0),.SFCB(9),4);
|
||||
CALL OPEN(.SFCB);
|
||||
IF DCNT = 255 THEN CALL PERROR(.('CANNOT OPEN SOURCE$'));
|
||||
|
||||
CALL MOVE(.('CMD'),.FCBA+9,3);
|
||||
|
||||
/* REMOVE ANY EXISTING FILE BY THIS NAME */
|
||||
CALL DELETE(.FCBA);
|
||||
/* THEN OPEN A NEW FILE */
|
||||
CALL MAKE(.FCBA); CALL OPEN(.FCBA);
|
||||
IF DCNT = 255 THEN CALL PERROR(.('NO MORE DIRECTORY SPACE$')); ELSE
|
||||
DO;
|
||||
call ignore$filename;
|
||||
call parse$tail;
|
||||
CALL RELOC;
|
||||
CALL CLOSE(.FCBA);
|
||||
IF DCNT = 255 THEN CALL PERROR(.('CANNOT CLOSE FILE$'));
|
||||
END;
|
||||
CALL CRLF;
|
||||
|
||||
CALL BOOT;
|
||||
END plmstart;
|
||||
END;
|
||||
|
||||
File diff suppressed because it is too large
Load Diff
File diff suppressed because it is too large
Load Diff
File diff suppressed because it is too large
Load Diff
File diff suppressed because it is too large
Load Diff
@@ -0,0 +1,49 @@
|
||||
|
||||
/*
|
||||
Proces Literals MP/M-8086 II
|
||||
*/
|
||||
|
||||
declare pnamsiz literally '8';
|
||||
|
||||
declare pd$hdr literally 'structure
|
||||
(link word,thread word,stat byte,prior byte,flag word,
|
||||
name (8) byte,uda word,dsk byte,user byte,ldsk byte,luser byte,
|
||||
mem word';
|
||||
|
||||
declare pd$structure literally 'pd$hdr,
|
||||
dvract word,wait word,org byte,net byte,parent word,
|
||||
cns byte,abort byte,conmode word,lst byte,sf3 byte,sf4 byte,sf5 byte,
|
||||
reservd (4) byte,pret word,scratch word)';
|
||||
|
||||
declare psrun lit '00',
|
||||
pspoll lit '01',
|
||||
psdelay lit '02',
|
||||
psswap lit '03',
|
||||
psterm lit '04',
|
||||
pssleep lit '05',
|
||||
psdq lit '06',
|
||||
psnq lit '07',
|
||||
psflagwait lit '08',
|
||||
psciowait lit '09';
|
||||
|
||||
declare pf$sys lit '00001h',
|
||||
pf$keep lit '00002h',
|
||||
pf$kernal lit '00004h',
|
||||
pf$pure lit '00008h',
|
||||
pf$table lit '00010h',
|
||||
pf$resource lit '00020h',
|
||||
pf$raw lit '00040h',
|
||||
pf$ctlc lit '00080h',
|
||||
pf$active lit '00100h',
|
||||
pf$tempkeep lit '00200h',
|
||||
pf$ctld lit '00400h',
|
||||
pf$childabort lit '00800h',
|
||||
pf$noctls lit '01000h';
|
||||
|
||||
declare pcm$11 lit '00001h',
|
||||
pcm$ctls lit '00002h',
|
||||
pcm$rout lit '00004h',
|
||||
pcm$ctlc lit '00008h',
|
||||
pcm$ctlo lit '00080h',
|
||||
pcm$rsx lit '00300h';
|
||||
|
||||
@@ -0,0 +1,105 @@
|
||||
;
|
||||
; Concurrent CP/M-86 v2.0 with BDOS version 3.1
|
||||
; Interface for PLM-86 with separate code and data
|
||||
; Code org'd at 0
|
||||
; Created:
|
||||
; October 5, 1981 by Danny Horovitz
|
||||
; Revised:
|
||||
; 28 Mar 83 by Bill Fitler
|
||||
|
||||
name scd
|
||||
|
||||
dgroup group dats,stack
|
||||
cgroup group code
|
||||
|
||||
assume cs:cgroup, ds:dgroup, ss:dgroup
|
||||
|
||||
stack segment word stack 'STACK'
|
||||
stack_base label byte
|
||||
stack ends
|
||||
|
||||
dats segment para public 'DATA' ;CP/M page 0 - LOC86'd at 0H
|
||||
|
||||
org 4
|
||||
bdisk db ?
|
||||
org 6
|
||||
maxb dw ?
|
||||
org 50h
|
||||
cmdrv db ?
|
||||
pass0 dw ?
|
||||
len0 db ?
|
||||
pass1 dw ?
|
||||
len1 db ?
|
||||
org 5ch
|
||||
fcb db 16 dup (?)
|
||||
fcb16 db 16 dup (?)
|
||||
cr db ?
|
||||
rr dw ?
|
||||
ro db ?
|
||||
buff db 128 dup (?)
|
||||
tbuff equ buff
|
||||
buffa equ buff
|
||||
fcba equ fcb
|
||||
|
||||
org 100h ;past CPM data space
|
||||
saveax dw 0 ;save registers for mon functions
|
||||
savebx dw 0
|
||||
savecx dw 0
|
||||
savedx dw 0
|
||||
public bdisk,maxb,cmdrv,pass0,len0
|
||||
public pass1,len1,fcb,fcb16,cr,rr
|
||||
public ro,buff,tbuff,buffa,fcba
|
||||
public saveax,savebx,savecx,savedx
|
||||
|
||||
dats ends
|
||||
|
||||
|
||||
code segment public 'CODE'
|
||||
public xdos,mon1,mon2,mon3,mon4
|
||||
extrn plmstart:near
|
||||
|
||||
org 0h ; for separate code and data
|
||||
jmp pastserial ; skip copyright
|
||||
jmp patch ; store address of patch routine at start
|
||||
db 'COPYRIGHT (C) 1983, DIGITAL RESEARCH '
|
||||
db ' CONCURRENT CP/M-86 2.0, 03/31/83 ' ; db ' MP/M-86 2.0, 10/5/81 '
|
||||
pastserial:
|
||||
pushf
|
||||
pop ax
|
||||
cli
|
||||
mov cx,ds
|
||||
mov ss,cx
|
||||
lea sp,stack_base
|
||||
push ax
|
||||
popf
|
||||
jmp plmstart
|
||||
|
||||
xdos proc
|
||||
push bp
|
||||
mov bp,sp
|
||||
mov dx,[bp+4]
|
||||
mov cx,[bp+6]
|
||||
int 224
|
||||
mov saveax,ax
|
||||
mov savebx,bx
|
||||
mov savecx,cx
|
||||
mov savedx,dx
|
||||
pop bp
|
||||
ret 4
|
||||
xdos endp
|
||||
|
||||
mon1 equ xdos ; no returned value
|
||||
mon2 equ xdos ; returns byte in AL
|
||||
mon3 equ xdos ; returns address or word BX
|
||||
mon4 equ xdos ; returns pointer in BX and ES
|
||||
|
||||
patch:
|
||||
nop
|
||||
nop
|
||||
nop
|
||||
nop
|
||||
org 0100h ; leave room for patch area
|
||||
|
||||
code ends
|
||||
end
|
||||
|
||||
@@ -0,0 +1,239 @@
|
||||
;****************************************************************
|
||||
;* *
|
||||
;* TCOPY - Example program to write the system track *
|
||||
;* for a Concurrent CP/M-86 Boot Disk on the *
|
||||
;* IBM Personel Computer *
|
||||
;* *
|
||||
;****************************************************************
|
||||
|
||||
; This program is used to read a binary image file of
|
||||
; track 0. This track is used to bootstrap Concurrent
|
||||
; CP/M-86. The file TCOPY reads has no CMD header and
|
||||
; must be the same size as the track we are going
|
||||
; to write.
|
||||
|
||||
; This program is intended to serve as an example
|
||||
; to be modified by the OEM for differently sized loaders,
|
||||
; and differently sized system track(s).
|
||||
|
||||
; Note: TCOPY must be run under CP/M-86 and not Concurrent
|
||||
; CP/M-86 since TCOPY performs direct BIOS calls.
|
||||
|
||||
; The command
|
||||
; GENCMD TCOPY
|
||||
; is used to generate the CMD form of this program.
|
||||
|
||||
title 'TCOPY - Copy Track 0'
|
||||
|
||||
;CP/M-86, CCP/M-86 function names
|
||||
|
||||
;console functions
|
||||
c_read equ 1
|
||||
c_writebuf equ 9
|
||||
|
||||
;file functions
|
||||
f_open equ 15
|
||||
f_readrand equ 33
|
||||
f_setdma equ 26
|
||||
f_setdmaseg equ 51
|
||||
|
||||
;drive functions
|
||||
drv_get equ 25
|
||||
|
||||
;system functions
|
||||
s_termcpm equ 0
|
||||
s_dirbios equ 50
|
||||
|
||||
;direct Bios Parameter Block
|
||||
bpb_func equ byte ptr 0
|
||||
bpb_cx equ word ptr 1
|
||||
bpb_dx equ word ptr 3
|
||||
|
||||
|
||||
;ASCII linefeed and carriage return
|
||||
lf equ 10
|
||||
cr equ 13
|
||||
|
||||
;how many 128 byte records to read for a loader image
|
||||
records_to_read equ 8 * 4
|
||||
;8 = number of physical sectors per track
|
||||
;4 = number of 128 sectors per
|
||||
;physical sector
|
||||
|
||||
cseg ;use CCP stack
|
||||
mov cl,c_writebuf ;display sign on message
|
||||
mov dx,offset sign_on_msg
|
||||
int 224
|
||||
mov cl,drv_get ;get default drive number
|
||||
int 224
|
||||
test al,al ;must run on drive A:
|
||||
jz drive_ok
|
||||
mov dx,offset drive_msg
|
||||
|
||||
jmp error
|
||||
|
||||
drive_ok:
|
||||
mov cl,f_open ;open the file given as
|
||||
mov dx,offset fcb ;the 1st command parameter,
|
||||
int 224 ;it is put at 05CH by
|
||||
cmp al,0ffh ;the program load
|
||||
jne file_ok
|
||||
mov dx,offset open_msg
|
||||
jmp error
|
||||
|
||||
file_ok:
|
||||
mov current_dma,offset track0_buffer
|
||||
mov r0,0 ;start with sector 0, assume
|
||||
mov cx,records_to_read ;no CMD header in the file
|
||||
|
||||
|
||||
file_read:
|
||||
push cx ;keep the record count
|
||||
mov cl,f_setdma
|
||||
mov dx,current_dma
|
||||
int 224
|
||||
mov cl,f_readrand ;user r0,r1,r2 for random
|
||||
mov dx,offset fcb ;reads
|
||||
int 224
|
||||
pop cx ;restore the record count
|
||||
test al,al
|
||||
jz read_ok
|
||||
mov dx,offset read_msg
|
||||
jmp error
|
||||
read_ok:
|
||||
add current_dma,128 ;set the DMA for the next sector
|
||||
inc r0 ;add one to the random record field
|
||||
loop file_read
|
||||
|
||||
; We have the Track 0 image in RAM
|
||||
; Ask for destination diskette
|
||||
|
||||
next_diskette:
|
||||
|
||||
mov cl,c_writebuf
|
||||
mov dx,offset new_disk_msg
|
||||
int 224
|
||||
|
||||
mov cl,c_read ;wait for a keystroke
|
||||
int 224
|
||||
|
||||
; Using CP/M-86 function 50, Direct bios call,
|
||||
; write the track image in TRACK0_BUFFER to
|
||||
; track 0, on drive A:.
|
||||
|
||||
call select_disk ;select A:
|
||||
call set_track ;set track to 0
|
||||
call set_dmaseg ;set DMA segment = DS
|
||||
|
||||
mov current_sector,0 ;sectors are relative to 0 in BIOS
|
||||
mov current_dma,offset track0_buffer
|
||||
mov cx,32 ;number of 128 byte sectors to write
|
||||
next_sector:
|
||||
push cx ;save sector count
|
||||
call set_dmaoff
|
||||
call set_sector
|
||||
call write_sector
|
||||
add current_dma,128 ;next area of memory to write
|
||||
inc current_sector ;next sector number
|
||||
pop cx ;restore sector count
|
||||
loop next_sector
|
||||
jmp track_ok
|
||||
|
||||
select_disk:
|
||||
mov al,9 ;BIOS function number of seldsk
|
||||
xor cx,cx ;always drive A:
|
||||
mov dx,cx
|
||||
jmps bios
|
||||
set_track:
|
||||
mov al,10 ;BIOS function number of settrk
|
||||
xor cx,cx ;go to track 0
|
||||
jmps bios
|
||||
set_dmaseg:
|
||||
mov al,17 ;BIOS function number of setdmab
|
||||
mov cx,ds ;dma segment we want to use
|
||||
jmps bios
|
||||
set_dmaoff:
|
||||
mov al,12 ;BIOS function number of setdma
|
||||
mov cx,current_dma
|
||||
jmps bios
|
||||
set_sector:
|
||||
mov al,11 ;BIOS function number of setsec
|
||||
mov cx,current_sector
|
||||
jmps bios
|
||||
write_sector:
|
||||
mov al,14 ;BIOS function number of write sector
|
||||
jmps bios ;error checking can be added here
|
||||
bios:
|
||||
mov bx,offset bpb ;fill in BIOS Paramenter Block
|
||||
mov bpb_func[bx],al
|
||||
mov bpb_cx[bx],cx
|
||||
mov bpb_dx[bx],dx
|
||||
mov cl,s_dirbios
|
||||
mov dx,bx
|
||||
int 224
|
||||
ret
|
||||
|
||||
|
||||
track_ok:
|
||||
mov cl,c_writebuf ;does the user want to write
|
||||
mov dx,offset continue_msg ;to another diskette ?
|
||||
int 224
|
||||
mov cl,c_read ;get response
|
||||
int 224
|
||||
and al,05FH ;make upper case
|
||||
cmp al,'Y'
|
||||
jne done
|
||||
jmp next_diskette
|
||||
|
||||
error:
|
||||
push dx
|
||||
call crlf
|
||||
pop dx
|
||||
mov cl,c_writebuf
|
||||
int 224
|
||||
|
||||
done:
|
||||
mov cx,s_termcpm
|
||||
mov dx,cx
|
||||
int 224
|
||||
|
||||
crlf:
|
||||
mov dx,offset crlf_msg
|
||||
mov cl,c_writebuf
|
||||
int 224
|
||||
ret
|
||||
|
||||
|
||||
|
||||
dseg
|
||||
|
||||
org 5ch
|
||||
fcb rb 33
|
||||
r0 dw 0
|
||||
r3 db 0
|
||||
|
||||
org 100h
|
||||
sign_on_msg db 'Example TCOPY for IBM PC', cr, lf
|
||||
db 'Reads track image file and writes '
|
||||
db 'it on track 0$'
|
||||
new_disk_msg db cr,lf,'Put destination diskette in A:'
|
||||
db cr,lf
|
||||
db 'Strike any key when ready $'
|
||||
continue_msg db cr,lf,'Write another Track 0 (Y/N) ? $'
|
||||
|
||||
crlf_msg db cr,lf,'$'
|
||||
|
||||
|
||||
drive_msg db 'TCOPY runs only on drive A:$'
|
||||
open_msg db 'Give file name containing track 0 '
|
||||
db 'image, after TCOPY command$'
|
||||
read_msg db 'File is not long enough$'
|
||||
write_msg db 'Error writing on track 0$'
|
||||
|
||||
track0_buffer rb 1000H ;4K tracks
|
||||
|
||||
bpb rb 5 ;direct Bios Parameter Block
|
||||
|
||||
current_dma dw 0
|
||||
current_sector dw 0
|
||||
|
||||
@@ -0,0 +1,19 @@
|
||||
|
||||
/* MP/M-86 II User Data Area format - August 8, 1981 */
|
||||
|
||||
declare uda$structure lit 'structure (
|
||||
dparam word,
|
||||
dma$ofst word,
|
||||
dma$seg word,
|
||||
func byte,
|
||||
searchl byte,
|
||||
searcha word,
|
||||
searchabase word,
|
||||
dcnt word,
|
||||
dblk word,
|
||||
error$mode byte,
|
||||
mult$cnt byte,
|
||||
df$password (8) byte,
|
||||
pd$cnt byte)';
|
||||
|
||||
|
||||
@@ -0,0 +1,21 @@
|
||||
|
||||
/**** VAX commands for generation - read the name of this program
|
||||
for PROGNAME below.
|
||||
|
||||
$ util := PROGNAME
|
||||
$ ccpmsetup ! set up environment
|
||||
$ assign 'f$directory()' f1: ! use local dir for temp files
|
||||
$ plm86 'util'.plm xref 'p1' optimize(3) debug
|
||||
$ link86 f2:scd.obj, 'util'.obj to 'util'.lnk
|
||||
$ loc86 'util'.lnk od(sm(code,dats,data,stack,const)) -
|
||||
ad(sm(code(0),dats(10000h))) ss(stack(+32)) to 'util'.
|
||||
$ h86 'util'
|
||||
|
||||
***** Then, on a micro:
|
||||
A>vax progname.h86 $fans
|
||||
A>gencmd progname data[b1000]
|
||||
|
||||
***** Notes: Stack is increased for interrupts. Const(ants) are last
|
||||
to force hex generation.
|
||||
****/
|
||||
|
||||
@@ -0,0 +1,17 @@
|
||||
|
||||
/* This utility requires MP/M or Concurrent function calls */
|
||||
|
||||
/****** commented out for CCP/M-86 :
|
||||
declare Ver$OS literally '11h',
|
||||
Ver$Needs$OS literally '''Requires MP/M-86''';
|
||||
******/
|
||||
|
||||
declare Ver$OS literally '14h',
|
||||
Ver$Needs$OS literally '''Requires Concurrent CP/M-86''';
|
||||
|
||||
|
||||
declare Ver$Mask literally '0fdh'; /* mask out Is_network bit */
|
||||
|
||||
declare Ver$BDOS literally '30h'; /* minimal BDOS version rqd */
|
||||
|
||||
|
||||
Reference in New Issue
Block a user