mirror of
https://github.com/SEPPDROID/Digital-Research-Source-Code.git
synced 2025-10-25 09:24:19 +00:00
339 lines
8.8 KiB
Plaintext
339 lines
8.8 KiB
Plaintext
$title('GENCPM Token File parser')
|
||
get$sys$defaults:
|
||
do;
|
||
|
||
/*
|
||
Copyright (C) 1982
|
||
Digital Research
|
||
P.O. Box 579
|
||
Pacific Grove, CA 93950
|
||
*/
|
||
|
||
/*
|
||
Revised:
|
||
20 Sept 82 by Bruce Skidmore
|
||
*/
|
||
|
||
declare true literally '0FFH';
|
||
declare false literally '0';
|
||
declare forever literally 'while true';
|
||
declare boolean literally 'byte';
|
||
declare cr literally '0dh';
|
||
declare lf literally '0ah';
|
||
declare tab literally '09h';
|
||
|
||
/*
|
||
D a t a S t r u c t u r e s
|
||
*/
|
||
|
||
declare data$fcb (36) byte external;
|
||
|
||
declare quest (156) boolean external;
|
||
|
||
declare display boolean external;
|
||
|
||
declare symbol (8) byte;
|
||
|
||
declare lnbfr (14) byte external;
|
||
|
||
declare buffer (128) byte at (.memory);
|
||
|
||
declare symtbl (20) structure(
|
||
token(8) byte,
|
||
len byte,
|
||
flags byte,
|
||
qptr byte,
|
||
ptr address) external;
|
||
|
||
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;
|
||
|
||
/*
|
||
B D O S P r o c e d u r e & F u n c t i o n C a l l s
|
||
*/
|
||
|
||
system$reset:
|
||
procedure external;
|
||
end system$reset;
|
||
|
||
write$console:
|
||
procedure (char) external;
|
||
declare char byte;
|
||
end write$console;
|
||
|
||
print$console$buffer:
|
||
procedure (buffer$address) external;
|
||
declare buffer$address address;
|
||
end print$console$buffer;
|
||
|
||
open$file:
|
||
procedure (fcb$address) byte external;
|
||
declare fcb$address address;
|
||
declare fcb based fcb$address (1) byte;
|
||
end open$file;
|
||
|
||
close$file:
|
||
procedure (fcb$address) external;
|
||
declare fcb$address address;
|
||
end close$file;
|
||
|
||
set$DMA$address:
|
||
procedure (DMA$address) external;
|
||
declare DMA$address address;
|
||
end set$DMA$address;
|
||
|
||
crlf:
|
||
procedure external;
|
||
end crlf;
|
||
|
||
dsply$dec$adr:
|
||
procedure (val) external;
|
||
declare val address;
|
||
end dsply$dec$adr;
|
||
|
||
/*
|
||
M a i n G E T D E F P r o c e d u r e
|
||
*/
|
||
getdef:
|
||
procedure public;
|
||
|
||
declare buffer$index byte;
|
||
declare index byte;
|
||
declare end$of$file byte;
|
||
declare line$count address;
|
||
|
||
err:
|
||
procedure(term$code,msg$adr);
|
||
declare (term$code,save$display) byte;
|
||
declare msg$adr address;
|
||
|
||
save$display = display;
|
||
display = true;
|
||
call print$console$buffer(.('ERROR: $'));
|
||
call print$console$buffer(msg$adr);
|
||
call print$console$buffer(.(' at line $'));
|
||
call dsply$dec$adr(line$count);
|
||
if term$code then
|
||
call system$reset;
|
||
call crlf;
|
||
display = save$display;
|
||
end err;
|
||
|
||
inc$ptr:
|
||
procedure;
|
||
|
||
if buffer$index = 127 then
|
||
do;
|
||
buffer$index = 0;
|
||
if mon2(20,.data$fcb) <> 0 then
|
||
end$of$file = true;
|
||
end;
|
||
else
|
||
buffer$index = buffer$index + 1;
|
||
end inc$ptr;
|
||
|
||
get$char:
|
||
procedure byte;
|
||
declare char byte;
|
||
|
||
call inc$ptr;
|
||
char = buffer(buffer$index);
|
||
do while (char = ' ') or (char = tab) or (char = lf);
|
||
if char = lf then
|
||
line$count = line$count + 1;
|
||
call inc$ptr;
|
||
char = buffer(buffer$index);
|
||
end;
|
||
if (char >= 'a') and (char <= 'z') then
|
||
char = char and 0101$1111b; /* force upper case */
|
||
if char = 1ah then
|
||
end$of$file = true;
|
||
return char;
|
||
end get$char;
|
||
|
||
get$sym:
|
||
procedure;
|
||
declare (i,sym$char) byte;
|
||
declare got$sym boolean;
|
||
|
||
got$sym = false;
|
||
do while (not got$sym) and (not end$of$file);
|
||
do i = 0 to 7;
|
||
symbol(i) = ' ';
|
||
end;
|
||
sym$char = get$char;
|
||
i = 0;
|
||
do while (i < 8) and (sym$char <> '=') and
|
||
(sym$char <> cr) and (not end$of$file);
|
||
symbol(i) = sym$char;
|
||
sym$char = get$char;
|
||
i = i + 1;
|
||
end;
|
||
do while (sym$char <> '=') and (sym$char <> cr) and (not end$of$file);
|
||
sym$char = get$char;
|
||
end;
|
||
if not end$of$file then
|
||
do;
|
||
if (sym$char = '=') and (i > 0) then
|
||
got$sym = true;
|
||
else
|
||
do;
|
||
if (sym$char = '=') then
|
||
call err(false,.('Missing parameter variable$'));
|
||
else
|
||
if i <> 0 then
|
||
call err(false,.('Equals (=) delimiter missing$'));
|
||
do while (sym$char <> cr) and (not end$of$file);
|
||
sym$char = get$char;
|
||
end;
|
||
end;
|
||
end;
|
||
end;
|
||
end get$sym;
|
||
|
||
get$val:
|
||
procedure;
|
||
declare (flags,i,val$char) byte;
|
||
declare val$adr address;
|
||
declare val based val$adr byte;
|
||
declare (base,inc,lnbfr$index) byte;
|
||
|
||
val$char = get$char;
|
||
i = 0;
|
||
do while (i < lnbfr(0)) and (val$char <> cr) and (not end$of$file);
|
||
lnbfr(i+2) = val$char;
|
||
i = i + 1;
|
||
lnbfr(1) = i;
|
||
val$char = get$char;
|
||
end;
|
||
do while (val$char <> cr) and (not end$of$file);
|
||
val$char = get$char;
|
||
end;
|
||
inc = 0;
|
||
lnbfr$index = 2;
|
||
if i > 0 then
|
||
do;
|
||
val$adr = symtbl(index).ptr;
|
||
flags = symtbl(index).flags;
|
||
if (flags and 8) <> 0 then
|
||
do;
|
||
if (flags and 10h) <> 0 then
|
||
inc = symbol(7) - 'A';
|
||
else
|
||
if (symbol(7) >= '0') and (symbol(7) <= '9') then
|
||
inc = symbol(7) - '0';
|
||
else
|
||
inc = 10 + (symbol(7) - 'A');
|
||
val$adr = val$adr + (inc * symtbl(index).len);
|
||
end;
|
||
if lnbfr(lnbfr$index) = '?' then
|
||
do;
|
||
quest(inc+symtbl(index).qptr) = true;
|
||
display = true;
|
||
lnbfr$index = lnbfr$index + 1;
|
||
lnbfr(1) = lnbfr(1) - 1;
|
||
end;
|
||
if lnbfr(1) > 0 then
|
||
do;
|
||
if (flags and 1) <> 0 then
|
||
do;
|
||
if (lnbfr(lnbfr$index) >= 'A') and
|
||
(lnbfr(lnbfr$index) <= 'P') then
|
||
val = lnbfr(lnbfr$index) - 'A';
|
||
else
|
||
call err(false,.('Invalid drive ignored$'));
|
||
end;
|
||
else
|
||
if (flags and 2) <> 0 then
|
||
do;
|
||
val = (lnbfr(lnbfr$index) = 'Y');
|
||
end;
|
||
else
|
||
do;
|
||
base = 16;
|
||
val = 0;
|
||
do i = 0 to lnbfr(1) - 1;
|
||
val$char = lnbfr(i+lnbfr$index);
|
||
if val$char = ',' then
|
||
do;
|
||
val$adr = val$adr + 1;
|
||
val = 0;
|
||
base = 16;
|
||
end;
|
||
else
|
||
do;
|
||
if val$char = '#' then
|
||
base = 10;
|
||
else
|
||
do;
|
||
val$char = val$char - '0';
|
||
if (base = 16) and (val$char > 9) then
|
||
do;
|
||
if val$char > 16 then
|
||
val$char = val$char - 7;
|
||
else
|
||
val$char = 0ffh;
|
||
end;
|
||
if val$char < base then
|
||
val = val * base + val$char;
|
||
else
|
||
call err(false,.('Invalid character$'));
|
||
end;
|
||
end;
|
||
end;
|
||
end;
|
||
end;
|
||
end;
|
||
end get$val;
|
||
|
||
compare$sym:
|
||
procedure byte;
|
||
declare (i,j) byte;
|
||
declare found boolean;
|
||
|
||
found = false;
|
||
i = 0;
|
||
do while ((i < 22) and (not found));
|
||
j = 0;
|
||
do while ((j < 7) and (symtbl(i).token(j) = symbol(j)));
|
||
j = j + 1;
|
||
end;
|
||
if j = 7 then
|
||
found = true;
|
||
else
|
||
i = i + 1;
|
||
end;
|
||
if not found then
|
||
return 0ffh;
|
||
else
|
||
return i;
|
||
end compare$sym;
|
||
|
||
line$count = 1;
|
||
call set$dma$address(.buffer);
|
||
buffer$index = 127;
|
||
end$of$file = false;
|
||
do while (not end$of$file);
|
||
call get$sym;
|
||
if not end$of$file then
|
||
do;
|
||
index = compare$sym;
|
||
if index <> 0ffh then
|
||
call get$val;
|
||
else
|
||
call err(false,.('Invalid parameter variable$'));
|
||
end;
|
||
end;
|
||
|
||
end getdef;
|
||
end get$sys$defaults;
|
||
|