Files
Digital-Research-Source-Code/CPM OPERATING SYSTEMS/CPM 68K/cpm68k_pgms/snobol4/RSELECT.C
Sepp J Morris 31738079c4 Upload
Digital Research
2020-11-06 18:50:37 +01:00

1 line
4.4 KiB
C
Raw Blame History

This file contains invisible Unicode characters

This file contains invisible Unicode characters that are indistinguishable to humans but may be processed differently by a computer. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.

/* -*-c,save-*- */
/*
* rselect.c - Random select function (Program 16.7 in Algorithms In SNOBOL4)
* Robert Heller. Created: Sat Feb 22, 1986 11:46:53.85
* Last Mod:
*
*/
#include <stdio.h>
#include "patdef.h"
#define LOCAL static
/* #define DEBUG /* debug hackery */
typedef struct selelt {
short int wts;
char *strng;
struct selelt *nxtelt;
} SELELT;
#define MAXRSEL 100
LOCAL SELELT *rsel_tbl[MAXRSEL];
LOCAL int rsel_cnt = 0;
char *malloc(),*calloc();
LOCAL PATTERN_NODE *rsel_wt,*rsel_alt,*rsel_l1,*rsel_bc;
LOCAL STRING_DESCR BC,WT,ALT;
LOCAL int rsel_init = FALSE;
#define WTCHAR "#"
rselect(string,outbuff)
char *string,*outbuff;
{
register SELELT *item;
SELELT *fndrsel(),*newrsel();
register int irnd;
if (!rsel_init) rs_init();
item = fndrsel(string);
if (item == NULL) item = newrsel(string);
if (item == NULL) {
*outbuff = '\0';
return;
}
irnd = (rand() % item->wts) + 1;
#ifdef DEBUG
printf("***In rselect: irnd=%d\n",irnd);
#endif
item = item->nxtelt;
while ((item != NULL) && (irnd > item->wts)) {
#ifdef DEBUG
printf("*** item->wts=%d\n",item->wts);
#endif
item = item->nxtelt;
}
if (item == NULL) *outbuff = '\0';
else strcpy(outbuff,item->strng);
}
LOCAL rs_init()
{
register PATTERN_NODE *temp1,*temp2,*temp3;
ARG_DESCR *acons();
temp1 = len(1);
rsel_l1 = cassign(temp1,acons(STRING,&BC));
rsel_bc = lit_string(&BC);
temp1 = c_lit_string(WTCHAR);
temp2 = breakk_c(WTCHAR);
temp2 = cassign(temp2,acons(STRING,&WT));
temp3 = concat(temp2,temp1);
temp3 = concat(temp1,temp3);
temp2 = pos(0);
rsel_wt = concat(temp2,temp3);
temp1 = alt(breakk(&BC),REM);
rsel_alt = cassign(temp1,acons(STRING,&ALT));
rsel_init = TRUE;
}
SELELT *newrsel(string)
register char *string;
{
STRING_DESCR matched;
char *ssaved;
register int wt,weights;
register SELELT *code,**c1;
SELELT *head;
register char *altstr;
#ifdef DEBUG
register int status;
#endif
#ifdef DEBUG
printf("***In newrsel: string=%s\n",string);
#endif
ssaved = string;
weights = 0;
head = malloc(sizeof(SELELT));
c1 = (&head->nxtelt);
if (pmatch(string,rsel_l1,&matched) == MATCH_FAIL) return(NULL);
do {
string += matched.length;
wt = 1;
if (pmatch(string,rsel_wt,&matched) == MATCH_SUCCESS) {
string += matched.length;
wt = atoi(WT.base+WT.offset);
}
#ifdef DEBUG
printf("*** wt=%d\n",wt);
printf("*** string=%s\n",string);
status =
#endif
pmatch(string,rsel_alt,&matched);
string += matched.length;
#ifdef DEBUG
printf("*** match status is %d\n",status);
printf("*** string=%s\n",string);
#endif
weights += wt;
code = malloc(sizeof(SELELT));
altstr = malloc(ALT.length+1);
code->wts = weights;
code->strng = altstr;
strncpy(altstr,ALT.base+ALT.offset,ALT.length);
altstr[ALT.length] = '\0';
#ifdef DEBUG
printf("*** code->wts=%d,code->strng=%s\n",code->wts,
code->strng);
#endif
*c1 = code;
c1 = (&code->nxtelt);
} while(pmatch(string,rsel_bc,&matched) == MATCH_SUCCESS);
*c1 = NULL;
head->wts = weights;
altstr = malloc(strlen(ssaved)+1);
strcpy(altstr,ssaved);
head->strng = altstr;
#ifdef DEBUG
printf("*** head->wts=%d,head->strng=%s\n",head->wts,
head->strng);
#endif
rselins(head);
return(head);
}
rselins(elt)
register SELELT *elt;
{
int eltcmp();
if (rsel_cnt >= MAXRSEL) {
fprintf(stderr,"rselect: too many items (> %d)\n",MAXRSEL);
abort();
}
rsel_tbl[rsel_cnt] = elt;
rsel_cnt++;
if (rsel_cnt > 1) qsort(rsel_tbl,rsel_cnt,sizeof(SELELT *),eltcmp);
}
SELELT *fndrsel(str)
register char *str;
{
register int first,last,indx,cmp;
register SELELT *item;
first = 0; last = rsel_cnt;
while (first < last) {
indx = ((last - first) >> 1) + first;
item = rsel_tbl[indx];
cmp = strcmp(str,item->strng);
if (cmp == 0) return(item);
else if (cmp < 0) last = indx;
else first = indx+1;
}
return(NULL);
}
LOCAL eltcmp(a,b)
SELELT **a,**b;
{
register SELELT *aa,*bb;
aa = *a; bb = *b;
return(strcmp(aa->strng,bb->strng));
}