mirror of
https://github.com/SEPPDROID/Digital-Research-Source-Code.git
synced 2025-10-23 08:24:18 +00:00
573 lines
16 KiB
C
573 lines
16 KiB
C
/********************************************************/
|
||
/* */
|
||
/* Usual filename: SIDFUN.C */
|
||
/* Remarks: Functions specific to DDT68K */
|
||
/* Author: Timothy M. Benson */
|
||
/* Control: 19 MAY 83 17:36 (TMB) */
|
||
/* */
|
||
/********************************************************/
|
||
|
||
#include "lgcdef.h"
|
||
#include "cputype.h"
|
||
#include "siddef.h"
|
||
#include "ddtinc.h"
|
||
#include "stdio.h"
|
||
#include "bdosfunc.h"
|
||
#include "disas.h"
|
||
|
||
/************************************************/
|
||
/* Load and initialize symbol table, returning */
|
||
/* int sized index to last valid symbol aut */
|
||
/* negative error code. */
|
||
/************************************************/
|
||
|
||
simz(fcbp,hwer)
|
||
struct fcb *fcbp;
|
||
long hwer;
|
||
{
|
||
extern struct lmhedr *caput;
|
||
extern int nomo;
|
||
U32 rano(); /* Returns second argument incremented by one */
|
||
struct asymbl *icon;
|
||
int goods; /* # symbol bytes in first symbol record */
|
||
int i;
|
||
int irate; /* Zero iff no input errors */
|
||
int junk; /* # bytes preceding symbols in first symbol record */
|
||
register long kount; /* Scratch loop counter */
|
||
char *oint; /* Scratch byte pointer */
|
||
U32 randy; /* Current random record number */
|
||
int zulu; /* Index to last symbol in current table */
|
||
int relocate; /* Logical -- whether or not file is relocatable */
|
||
|
||
randy = 0;
|
||
BDOS(SETDMA,caput);
|
||
rano(fcbp,&randy);
|
||
irate = BDOS(OPEN,fcbp) AND 0xFFFFFFFCL;
|
||
irate ORWITH (int) BDOS(READRND,fcbp);
|
||
caput AT tceps = hwer;
|
||
If caput AT lmkind EQ CONTIG then BEGIN
|
||
caput AT dceps = caput AT tceps;
|
||
caput AT dceps INCBY caput AT lmtlen;
|
||
caput AT bceps = caput AT dceps;
|
||
caput AT bceps INCBY caput AT lmdlen;
|
||
randy = 28; /* # bytes in contiguous header */
|
||
END
|
||
otherwise randy = 36; /* # bytes in noncontiguous header */
|
||
if(relocate = !*((unsigned *)((long)caput+0x1A)))
|
||
stout("File is relocatable\n");
|
||
If NOT(caput AT symlen) then BEGIN
|
||
stout("No symbols\n");
|
||
/**temp** Need to allot space for added symbols */
|
||
/**temp** Need to deallocate extra space */
|
||
nomo = -1;
|
||
return(-1);
|
||
END
|
||
randy INCBY caput AT lmtlen + caput AT lmdlen;
|
||
/* I.e., compute # bytes preceding symbols */
|
||
junk = randy % 128;
|
||
goods = 128 - junk;
|
||
randy /= 128;
|
||
oint = caput AT sump;
|
||
icon = oint; /* Save addr of symbol table. */
|
||
BDOS(SETDMA,icon);
|
||
randy = rano(fcbp,&randy);
|
||
irate ORWITH (int) BDOS(READRND,fcbp);
|
||
/* Move wanted info to head of array. */
|
||
for (i = 0; i LT goods; i++) *oint++ = *(oint + junk);
|
||
/* Now oint points to icon + goods. */
|
||
zulu = HMSYMS * sizeof(struct asymbl);
|
||
If caput AT symlen GT zulu then BEGIN
|
||
kount = (zulu - goods) / 128;
|
||
If (zulu - goods) % 128 then ++kount;
|
||
zulu = HMSYMS - 1;
|
||
END
|
||
otherwise BEGIN
|
||
kount = (caput AT symlen - goods) / 128;
|
||
If (caput AT symlen - goods) % 128 then ++kount;
|
||
zulu = caput AT symlen / sizeof(struct asymbl) - 1;
|
||
END
|
||
|
||
/**temp** May want to compute end of symbol table here */
|
||
/**temp** and/or deallocate unused storage */
|
||
|
||
while (kount-- GT 0) BEGIN
|
||
BDOS(SETDMA,oint);
|
||
randy = rano(fcbp,&randy);
|
||
If (i = BDOS(READRND,fcbp)) then
|
||
If i EQ 1 or i EQ 4 then kount = 0;
|
||
else irate ORWITH i;
|
||
oint INCBY 128;
|
||
END
|
||
If irate then BEGIN
|
||
stout("Symbol table disaster\n");
|
||
return(-1);
|
||
END
|
||
|
||
|
||
/**temp** When symbol table allocated dynamically, make */
|
||
/**temp** sure zulu still reflects subscript of */
|
||
/**temp** last symbol at this point in program */
|
||
|
||
If caput AT lmkind EQ CONTIG then
|
||
for(i = 0; i LE zulu; i++)
|
||
If (icon+i) AT symtyp IS SEGREF and relocate then
|
||
(icon+i) AT symval INCBY caput AT tceps;
|
||
|
||
|
||
/**temp** May later need different test for full symbol table */
|
||
If zulu GE HMSYMS - 1 then stout("Symbol table full\n");
|
||
return(zulu);
|
||
}
|
||
|
||
|
||
/************************************************/
|
||
/* Install random record number in fcb and */
|
||
/* return next higher random record number */
|
||
/************************************************/
|
||
|
||
U32 rano(fcbp,rand)
|
||
struct fcb *fcbp;
|
||
union slimy BLOCK
|
||
U32 recno;
|
||
char tail[4];
|
||
UNBLOCK *rand;
|
||
{
|
||
int i;
|
||
|
||
for (i = 0; i LE 2; i++)
|
||
fcbp AT r[i] = rand AT tail[i+1];
|
||
return(rand AT recno + 1);
|
||
}
|
||
|
||
deluge(tabula,zulu)
|
||
struct asymbl tabula[];
|
||
register int zulu;
|
||
{
|
||
register int i;
|
||
register int j;
|
||
register char litt;
|
||
register int reply;
|
||
U16 simbl;
|
||
|
||
for(i = 0, reply = 2; i LE zulu and reply; i++) BEGIN
|
||
putchar('\n');
|
||
puthexw(i);
|
||
putchar('(');
|
||
If (simbl = tabula[i].symtyp) IS TREL then putchar('T');
|
||
else If simbl IS DREL then putchar('D');
|
||
else If simbl IS BREL then putchar('B');
|
||
else putchar('A');
|
||
stout(")(");
|
||
If simbl IS GONE then putchar('H');
|
||
otherwise putchar('V');
|
||
stout("): ");
|
||
puthexl(tabula[i].symval);
|
||
stout(" = ");
|
||
/**temp** Call to kobold in next line may need parameters */
|
||
If simbl IS TLONG then kobold();
|
||
otherwise for(j = 0; j LT 8; j++)
|
||
If litt = tabula[i].namae[j] then putchar(litt);
|
||
else putchar(' ');
|
||
If reply EQ 2 then reply = 1;
|
||
otherwise If NOT (i % 10) then reply = pause();
|
||
END
|
||
putchar('\n');
|
||
}
|
||
|
||
kobold()
|
||
{
|
||
/* Will handle printing long symbols here; for now print message */
|
||
stout("** Long COBOL-style symbol **");
|
||
}
|
||
|
||
pause()
|
||
{
|
||
register char mor;
|
||
|
||
stout("\n Continue listing? (y/n)");
|
||
mor = getchar();
|
||
mor = toupper(mor);
|
||
putchar('\n');
|
||
return(mor NE 'N');
|
||
}
|
||
|
||
/****************************************************************/
|
||
/* For a given numerical value, find and print corresponding */
|
||
/* symbols in indicated table, with certain options. Return */
|
||
/* int number of symbols found. */
|
||
/****************************************************************/
|
||
|
||
spell(value,table,scope,class,orient)
|
||
U32 value;
|
||
struct asymbl table[];
|
||
int scope; /* If zero, then find all; otherwise find first. */
|
||
char class; /* 'm' implies only want segment references. */
|
||
char orient; /* 'h' or 'H' horizontal, anything else vertical: */
|
||
/* If 'H' then prefix '.'; if 'h' then append ':'.*/
|
||
{
|
||
extern int omega;
|
||
int hmany; /* Counter for # of symbols with given value */
|
||
register int i;
|
||
char it; /* Hold char while deciding what to do. */
|
||
register int j;
|
||
register U16 simbol; /* Hold symtyp here for inspection. */
|
||
|
||
hmany = 0; /* Alcyon compiler does not allow this */
|
||
/* to be initialized in declaration: */
|
||
/* I protest! */
|
||
for(i = 0; i LE omega; i++) BEGIN
|
||
If table[i].symval NE value then IGNORE;
|
||
simbol = table[i].symtyp;
|
||
If class EQ 'm' and NOT (simbol IS SEGREF)
|
||
then IGNORE;
|
||
/* I.e. ignore e.g. stack references */
|
||
If simbol IS GONE then IGNORE;
|
||
/* I.e. ignore hidden symbol */
|
||
/* Next line is dummy call to routine to handle long symbols */
|
||
If simbol IS TLONG then roam();
|
||
If orient EQ 'H' then putchar('.');
|
||
for(j = 0; j LT 8 and (it = table[i].namae[j]); j++)
|
||
putchar(it);
|
||
If orient NE 'H' then putchar(':');
|
||
If orient EQ 'H' or orient EQ 'h' then putchar(' ');
|
||
otherwise putchar('\n');
|
||
hmany++;
|
||
If scope then break;
|
||
END
|
||
If hmany and orient EQ 'h' then putchar('\n');
|
||
return(hmany);
|
||
}
|
||
|
||
roam()
|
||
{
|
||
/* dummy routine: will later handle symbols longer than 8 chars */
|
||
}
|
||
|
||
/************************************************/
|
||
/* For given string of given length find first */
|
||
/* corresponding symbol table entry, updating */
|
||
/* value and putting subscript at *whence. */
|
||
/* Return int 1 if found, 0 if not found, */
|
||
/* -1 if the bizarre happens, and -2 if an */
|
||
/* attempt is made to utilize a feature not */
|
||
/* yet implemented. */
|
||
/************************************************/
|
||
|
||
indica(leqth,logos,tesoro,phylum,value,whence)
|
||
int leqth;
|
||
char logos[]; /* String containing name */
|
||
struct asymbl tesoro[]; /* Short symbol table */
|
||
char phylum; /* Type of symbol wanted */
|
||
U32 *value; /* Place to stick value if and when found */
|
||
int *whence; /* Place to stick subscript to symbol table */
|
||
{
|
||
extern int omega;
|
||
register int i; /* To sweep symbol table */
|
||
register int j; /* To sweep string */
|
||
register short match; /* 1 iff strings equivalent */
|
||
register char nxch; /* Next char in logos */
|
||
U16 symbol; /* Type of last symbol considered */
|
||
|
||
for(i = 0; i LE omega; i++) BEGIN
|
||
symbol = tesoro[i].symtyp;
|
||
switch(phylum) BLOCK
|
||
case 'M': /* Address value wanted */
|
||
If NOT (symbol IS SEGREF) then IGNORE;
|
||
break;
|
||
case 'A': /* Nonaddress numerical value wanted */
|
||
If symbol IS SEGREF then IGNORE;
|
||
break;
|
||
case 'B':
|
||
break; /* Accept any kind of symbol */
|
||
default:
|
||
return(-1); /* This shouldn't happen */
|
||
UNBLOCK
|
||
If symbol IS GONE then IGNORE;
|
||
/**temp** Call in next statement will require parameters. */
|
||
/**temp** For now just returns (int) -2. */
|
||
If symbol IS TLONG then return(trek());
|
||
for(j = 0, match = 1; j LT 8 and match; j++) BLOCK
|
||
If j LT leqth then nxch = logos[j];
|
||
otherwise nxch = '\0';
|
||
If nxch NE toupper(tesoro[i].namae[j]) then match = 0;
|
||
UNBLOCK
|
||
If match then BLOCK
|
||
*whence = i;
|
||
*value = tesoro[i].symval;
|
||
return(1);
|
||
UNBLOCK
|
||
END
|
||
return(0);
|
||
}
|
||
|
||
trek()
|
||
{
|
||
/* dummy routine: will later handle symbols longer than 8 chars */
|
||
|
||
return(-2);
|
||
|
||
}
|
||
|
||
/****************************************/
|
||
/* K command: Play with symbol table */
|
||
/****************************************/
|
||
|
||
koax(cx)
|
||
char *cx;
|
||
{
|
||
extern struct lmhedr *caput;
|
||
extern int omega;
|
||
extern int main();
|
||
struct asymbl *galaxy;
|
||
int seqno; /* Subscript to symbol table */
|
||
long spot; /* Symbol value input */
|
||
char task;
|
||
char uppr; /* For entering new name */
|
||
|
||
galaxy = caput AT sump;
|
||
If nomore(cx) then BEGIN
|
||
stout("DDT begins at: ");
|
||
puthexl(main);
|
||
putchar('\n');
|
||
stout("Symbol table at: ");
|
||
puthexl(galaxy);
|
||
putchar('\n');
|
||
If omega LT 0 then BLOCK
|
||
stout("No symbols");
|
||
If caput then begin
|
||
stout("; file header at: ");
|
||
puthexl(caput);
|
||
end
|
||
putchar('\n');
|
||
UNBLOCK
|
||
return;
|
||
END
|
||
deblank(&cx);
|
||
task = *++cx;
|
||
switch(task) BEGIN
|
||
case 'A':
|
||
/* Add a symbol; e.g. KAname,value,type */
|
||
/* where name is converted to upper case and */
|
||
/* comma after it is obligatory, as is value. */
|
||
If nomore(cx) then BLOCK bad(); return; UNBLOCK
|
||
otherwise BLOCK
|
||
If omega GE HMSYMS then begin
|
||
stout("\nSymbol table full\n");
|
||
return;
|
||
end
|
||
deblank(&cx);
|
||
uppr = *++cx;
|
||
If uppr EQ ',' then begin bad(); return; end
|
||
++omega;
|
||
for(seqno = 0; seqno LT 8; seqno++) begin
|
||
(galaxy+omega) AT namae[seqno] = uppr;
|
||
If *++cx NE ',' and uppr then uppr = *cx;
|
||
else uppr = '\0';
|
||
end
|
||
cx--;
|
||
If NOT (getsep(&cx) and gethex(&cx,&spot)) then begin
|
||
omega--;
|
||
bad();
|
||
return;
|
||
end
|
||
(galaxy+omega) AT symval = spot;
|
||
If getsep(&cx) and gethex(&cx,&spot) then
|
||
seqno = (int)spot;
|
||
else seqno = 0xA700; /* Default symbol type */
|
||
If NOT nomore(cx) then begin
|
||
omega--;
|
||
bad();
|
||
return;
|
||
end
|
||
(galaxy+omega) AT symtyp = seqno;
|
||
UNBLOCK
|
||
break;
|
||
case 'H': /* Hide symbols */
|
||
/* KH hide symbol most recently sought by name*/
|
||
/* KHvalue hide first symbol with given value */
|
||
/* KH*value hide symbol with sequence number equal */
|
||
/* to given value, if in range */
|
||
seqno = findsn(cx,omega,galaxy);
|
||
If seqno LT 0 then begin bad(); return; end
|
||
otherwise (galaxy+seqno) AT symtyp ORWITH GONE;
|
||
break;
|
||
case 'R': /* Recover hidden symbols */
|
||
/* KR recover all hidden symbols */
|
||
/* KRvalue recover first symbol with given value */
|
||
/* KR*value recover symbol with sequence number */
|
||
/* equal to given value, if in range */
|
||
If nomore(cx) then
|
||
for(seqno = 0; seqno LE omega; seqno++)
|
||
(galaxy+seqno) AT symtyp ANDWITH ~GONE;
|
||
otherwise BLOCK
|
||
seqno = findsn(cx,omega,galaxy);
|
||
If seqno LT 0 then begin bad(); return; end
|
||
else (galaxy+seqno) AT symtyp ANDWITH ~GONE;
|
||
UNBLOCK
|
||
break;
|
||
default:
|
||
bad();
|
||
return;
|
||
break;
|
||
END
|
||
putchar('\n');
|
||
}
|
||
|
||
/************************************************/
|
||
/* Find serial number of symbol entry, parsing */
|
||
/* rest of command line */
|
||
/************************************************/
|
||
|
||
findsn(spear,zedd,arcade)
|
||
char *spear; /* Scanner for command line */
|
||
int zedd; /* Highest symbol table subscript */
|
||
struct asymbl *arcade; /* Addr of symbol table */
|
||
{
|
||
extern int nomo; /* Last entry sought by name */
|
||
int ix; /* To sweep symbol table */
|
||
int script; /* Int subscript to be returned */
|
||
long werth; /* Numerical value of symbol */
|
||
|
||
script = -1; /* Preset to illegal value */
|
||
If nomore(spear) then script = nomo;
|
||
otherwise BLOCK
|
||
deblank(&spear);
|
||
If *(spear+1) EQ '*' then begin
|
||
++spear;
|
||
If gethex(&spear,&werth) and nomore(spear) then
|
||
script = (int) werth;
|
||
end
|
||
else If gethex(&spear,&werth) and nomore(spear)
|
||
then for(ix = 0; ix LE zedd and script LT 0; ix++)
|
||
If (arcade+ix) AT symval EQ werth then script = ix;
|
||
UNBLOCK
|
||
If script GT zedd then script = -1;
|
||
return(script);
|
||
}
|
||
|
||
passpt(pcx)
|
||
char *pcx;
|
||
{
|
||
extern U16 pkawnt[HMPPTS];
|
||
extern U16 *plocus[HMPPTS];
|
||
extern U16 ancien[HMPPTS];
|
||
extern int minus;
|
||
extern int omega;
|
||
extern int scope;
|
||
extern struct lmhedr *caput;
|
||
int jp;
|
||
int reply; /* Operator's response */
|
||
int plain; /* plain iff no tail */
|
||
char *nupt; /* Value of new pass point */
|
||
/* N.b.: "char" required so bitwise "&" */
|
||
/* will work properly. */
|
||
long cntdn; /* New pass count (initially long) */
|
||
|
||
cntdn = 1; /* Set to default pass count */
|
||
If NOT (plain = nomore(pcx)) then BEGIN
|
||
If NOT gethex(&pcx,&nupt) then goto chide;
|
||
/* Warning: The following bitwise "&" statement */
|
||
/* requires nupt to be declared "char" pointer.*/
|
||
If nupt & 1 then BLOCK
|
||
stout("\nNo change--Address must be even!\n");
|
||
return;
|
||
UNBLOCK
|
||
If getsep(&pcx) then If NOT gethex(&pcx,&cntdn)
|
||
or minus then goto chide;
|
||
If NOT nomore(pcx) then goto chide;
|
||
END
|
||
If NOT cntdn then goto chide;
|
||
If minus then BEGIN
|
||
If plain then zappas();
|
||
else BLOCK
|
||
for (jp = 0; jp LT HMPPTS; jp++)
|
||
If pkawnt[jp] and plocus[jp] EQ nupt then begin
|
||
pkawnt[jp] = 0;
|
||
minus = 0;
|
||
end
|
||
If minus then goto chide;
|
||
UNBLOCK
|
||
END
|
||
otherwise BEGIN
|
||
If plain then BLOCK
|
||
for(jp=0,reply=1;jp LT HMPPTS and reply;jp++) begin
|
||
If pkawnt[jp] then {
|
||
If ++minus GT 16 and jp LT HMPPTS then BEGIN
|
||
reply = pause();
|
||
minus = 0;
|
||
END
|
||
If reply then BEGIN
|
||
putchar('\n');
|
||
puthexw(pkawnt[jp]);
|
||
stout(" ");
|
||
puthexl(plocus[jp]);
|
||
stout(" ");
|
||
If omega GE 0 then
|
||
spell((U32) plocus[jp],caput AT sump
|
||
,scope,'m','H');
|
||
END
|
||
}
|
||
end
|
||
putchar('\n');
|
||
UNBLOCK
|
||
else BLOCK
|
||
for (jp = 0; jp LT HMPPTS; jp++)
|
||
If pkawnt[jp] and plocus[jp] EQ nupt then begin
|
||
If pkawnt[jp] EQ cntdn then stout("\nAlready set\n");
|
||
otherwise pkawnt[jp] = cntdn;
|
||
return;
|
||
end
|
||
minus = 1;
|
||
for (jp = 0; jp LT HMPPTS; jp++)
|
||
If NOT pkawnt[jp] then begin
|
||
pkawnt[jp] = (U16) cntdn;
|
||
plocus[jp] = nupt;
|
||
jp = HMPPTS;
|
||
minus = 0;
|
||
end
|
||
If minus then begin
|
||
stout("\nToo many pass points--limit is: ");
|
||
SAYMAX
|
||
end
|
||
UNBLOCK
|
||
END
|
||
return;
|
||
chide:
|
||
bad();
|
||
}
|
||
|
||
qotbyt(nnnn)
|
||
long nnnn;
|
||
{
|
||
If nnnn LT 0x20 or nnnn GT 0x7E then return(0);
|
||
putchar('\'');
|
||
BDOS(CONOUT,nnnn);
|
||
putchar('\'');
|
||
return(1);
|
||
}
|
||
|
||
vecina(cxp,sought)
|
||
char **cxp;
|
||
char sought;
|
||
{
|
||
/* Check if next char in command is a specified char, advancing */
|
||
/* pointer if it is. */
|
||
++*cxp;
|
||
If **cxp EQ sought then return(1);
|
||
--*cxp;
|
||
return(0);
|
||
}
|
||
|
||
zappas()
|
||
{
|
||
extern U16 pkawnt[HMPPTS];
|
||
int jz;
|
||
|
||
for (jz = 0; jz LT HMPPTS; jz++) pkawnt[jz] = 0;
|
||
}
|
||
ern U16 pkawnt[HMPPTS];
|
||
int jz;
|
||
|
||
for (jz = 0; jz LT HMPPTS; jz++) pkawnt[jz] = 0;
|
||
}
|
||
|