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

1 line
6.3 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-*- */
/*
* rsent.c - random sentence (prog. 16.8 of Algorithms in SNOBOL4)
* Robert Heller. Created: Sat Feb 22, 1986 15:52:57.06
* Last Mod:
*
*/
#include <stdio.h>
#include "patdef.h"
#define LOCAL static
/* #define DEBUG /* debug hackery */
#ifdef DEBUG
#define LOCAL /* static */
#endif
LOCAL PATTERN_NODE *syn_var,*asgn_var,*exp_var,*lit_text;
#define MAXVAR 10
LOCAL STRING_DESCR VAR,CODE,N,TEXT;
LOCAL char *VARS[MAXVAR];
#define MAXLINE 4096
#define TMPLINE 256
typedef struct {
char *synname;
char *synval;
} SYNVAR;
#define MAXSYN 512
LOCAL SYNVAR rsent_tbl[MAXSYN];
LOCAL int rsent_cnt = 0;
char *calloc(),*malloc(),*fgets(),*index();
FILE *fopen();
ARG_DESCR *acons();
rsent_init(filename)
char *filename;
{
register FILE *syndeffl;
static char buffer[MAXLINE],aline[TMPLINE];
register char *p,*q;
register PATTERN_NODE *ec,*getnm;
register int n;
STRING_DESCR NM,matched;
int syncmp();
pattern_init();
ec = cassign(breakk_c(">"),acons(STRING,&VAR));
ec = concat(ec,c_lit_string(">"));
ec = concat(c_lit_string("<"),ec);
syn_var = concat(pos(0),ec);
ec = cassign(breakk_c("\\"),acons(STRING,&VAR));
ec = concat(ec,c_lit_string("\\"));
ec = concat(ec,cassign(breakk_c("="),acons(STRING,&N)));
ec = concat(ec,c_lit_string("="));
ec = concat(c_lit_string("="),ec);
asgn_var = concat(pos(0),ec);
ec = cassign(breakk_c(")"),acons(STRING,&N));
ec = concat(ec,c_lit_string(")"));
ec = concat(cassign(any_c("@?/"),acons(STRING,&CODE)),ec);
ec = concat(c_lit_string("("),ec);
exp_var = concat(pos(0),ec);
lit_text = cassign(breakk_c("<=("),acons(STRING,&TEXT));
for (n=0;n<MAXVAR;n++) VARS[n] = NULL;
ec = concat(c_lit_string("END"),rpos(0));
ec = alt(c_lit_string("<"),ec);
ec = concat(pos(0),ec);
getnm = cassign(breakk_c(">"),acons(STRING,&NM));
getnm = concat(getnm,c_lit_string(">::="));
getnm = concat(c_lit_string("<"),getnm);
syndeffl = fopen(filename,"r");
if (syndeffl == NULL) {
perror("rsent_init (fopen)");
abort(0);
}
p = fgets(buffer,MAXLINE,syndeffl);
if (p == NULL) {
perror("rsent_init (fgets)");
abort(0);
}
q = index(p,'\n');
if (q != NULL) *q = '\0';
trim(buffer);
for (;;) {
for (;;) {
p = fgets(aline,TMPLINE,syndeffl);
if (p == NULL) break;
q = index(p,'\n');
if (q != NULL) *q = '\0';
trim(aline);
if (pmatch(aline,ec,&matched) == MATCH_SUCCESS) break;
strcat(buffer,aline);
}
if (p == NULL) strcpy(aline,"END");
pmatch(buffer,getnm,&matched);
p = (&buffer[matched.length-1]);
*p = '|';
q = malloc(strlen(p)+1);
strcpy(q,p);
p = NM.base+NM.offset;
rsent_tbl[rsent_cnt].synval = q;
q = malloc(NM.length+1);
strncpy(q,p,NM.length);
q[NM.length] = '\0';
rsent_tbl[rsent_cnt].synname = q;
rsent_cnt++;
if (strcmp(aline,"END") == 0) break;
strcpy(buffer,aline);
}
fclose(syndeffl);
qsort(rsent_tbl,rsent_cnt,sizeof(SYNVAR),syncmp);
}
syncmp(a,b)
register SYNVAR *a,*b;
{
return(strcmp(a->synname,b->synname));
}
trim(s)
register char *s;
{
register char *p;
p = s+strlen(s);
p--;
while (*p <= ' ' && p > s) *p-- = '\0';
}
rsentence(stack,s)
register char *stack,*s;
{
char temp1[MAXLINE],temp2[MAXLINE],syn[TMPLINE];
register int n;
STRING_DESCR matched;
register SYNVAR *svar;
register char *p;
SYNVAR *rsen_lkp();
*s = '\0';
strcpy(temp1,stack);
#ifdef DEBUG
printf("***In rsentence: temp1 = %s\n",temp1);
#endif
for (;;) {
#ifdef DEBUG
printf("*** temp1 = %s\n",temp1);
printf("*** s = %s\n",s);
#endif
if (pmatch(temp1,syn_var,&matched) == MATCH_SUCCESS) {
strncpy(syn,VAR.base+VAR.offset,VAR.length);
syn[VAR.length] = '\0';
svar = rsen_lkp(syn);
if (svar != NULL) {
rselect(svar->synval,temp2);
strcat(temp2,temp1+matched.length);
strcpy(temp1,temp2);
continue;
}
else {
strcpy(temp2,temp1+matched.length);
strcpy(temp1,temp2);
}
}
else if (pmatch(temp1,exp_var,&matched) == MATCH_SUCCESS) {
n = atoi(N.base+N.offset);
switch(*(CODE.base+CODE.offset)) {
case '@' :
if (n < 0 || n >= MAXVAR) {
fprintf(stderr,
"rsentence: var# out of range (%d)\n",n);
abort(n);
}
if (VARS[n] != NULL) strcpy(temp2,VARS[n]);
else temp2[0] = '\0';
break;
case '?' : sprintf(temp2,"%d",(rand() % n)+1); break;
case '/' :
if (n < 0 || n >= MAXVAR) {
fprintf(stderr,
"rsentence: var# out of range (%d)\n",n);
abort(n);
}
if (VARS[n] != NULL) sprintf(temp2,"%d",strlen(VARS[n]));
else strcpy(temp2,"0");
break;
}
strcat(s,temp2);
strcpy(temp2,temp1+matched.length);
strcpy(temp1,temp2);
}
else if (pmatch(temp1,asgn_var,&matched) == MATCH_SUCCESS) {
n = atoi(N.base+N.offset);
strncpy(syn+1,VAR.base+VAR.offset,VAR.length);
syn[0] = '<';
syn[VAR.length+1] = '>';
syn[VAR.length+2] = '\0';
rsentence(syn,temp2);
VARS[n] = malloc(strlen(temp2)+1);
strcpy(VARS[n],temp2);
strcat(s,temp2);
strcpy(temp2,temp1+matched.length);
strcpy(temp1,temp2);
}
else if (pmatch(temp1,lit_text,&matched) == MATCH_SUCCESS) {
p = s+strlen(s);
strncat(s,TEXT.base+TEXT.offset,TEXT.length);
p[TEXT.length] = '\0';
strcpy(temp1,temp1+matched.length);
}
else {
strcat(s,temp1);
break;
}
}
}
s_rsentv(n,str)
register int n;
register char *str;
{
VARS[n] = str;
}
char *g_rsentv(n)
register int n;
{
return(VARS[n]);
}
f_rsentv(n)
register int n;
{
if (VARS[n] != NULL) free(VARS[n]);
}
SYNVAR *rsen_lkp(synn)
register char *synn;
{
register first,last,indx,cmp;
first = 0; last = rsent_cnt;
while (first < last) {
indx = ((last - first) >> 1) + first;
cmp = strcmp(synn,rsent_tbl[indx].synname);
if (cmp == 0) return(&rsent_tbl[indx]);
else if (cmp < 0) last = indx;
else first = indx+1;
}
return(NULL);
}