



		    convert_word_.pl1               11/15/82  1912.6rew 11/15/82  1529.7       17775



/* ***********************************************************
   *                                                         *
   * Copyright, (C) Honeywell Information Systems Inc., 1982 *
   *                                                         *
   *********************************************************** */
convert_word_: proc (word, hyphens, word_length, expanded_word, hyphenated_word);
dcl  word (0:*) fixed bin;
dcl  hyphens (0:*) bit (1) aligned;
dcl  word_length fixed bin;
dcl  expanded_word char (*);
dcl  hyphenated_word char (*);
dcl  i fixed bin;
dcl  no_hyphens bit (1) aligned;
dcl  word_index fixed bin init (1);
dcl  hyphenated_index fixed bin init (1);
	%include digram_structure;

	no_hyphens = ""b;

convert_word:
	do i = 1 to word_length;
	     if substr (letters (word (i)), 2, 1) = " "
	     then
		do;
		substr (expanded_word, word_index, 1) = substr (letters (word (i)), 1, 1);
		if ^no_hyphens then
		     do;
		     substr (hyphenated_word, hyphenated_index, 1) = substr (letters (word (i)), 1, 1);
		     hyphenated_index = hyphenated_index + 1;
		end;
		word_index = word_index + 1;
	     end;
	     else
	     do;
		substr (expanded_word, word_index, 2) = letters (word (i));
		if ^no_hyphens then
		     do;
		     substr (hyphenated_word, hyphenated_index, 2) = letters (word (i));
		     hyphenated_index = hyphenated_index + 2;
		end;
		word_index = word_index + 2;
	     end;
	     if ^no_hyphens
	     then
		if hyphens (i)
		then
		     do;
		     substr (hyphenated_word, hyphenated_index, 1) = "-";
		     hyphenated_index = hyphenated_index + 1;
		end;
	end;

	if ^no_hyphens then if hyphenated_index <= length (hyphenated_word) then substr (hyphenated_word, hyphenated_index) = "";
	if word_index <= length (expanded_word) then substr (expanded_word, word_index) = ""; /* fill out with spaces */
	return;

convert_word_$no_hyphens: entry (word, word_length, expanded_word);
	no_hyphens = "1"b;
	goto convert_word;

     end;




		    convert_word_char_.pl1          11/15/82  1912.6rew 11/15/82  1529.7        7479



/* ***********************************************************
   *                                                         *
   * Copyright, (C) Honeywell Information Systems Inc., 1982 *
   *                                                         *
   *********************************************************** */
convert_word_char_: proc (word, hyphens, last, result);
dcl  i fixed bin;
dcl  result char (*) varying;
dcl  word char (*);
dcl  hyphens (*) bit (1) aligned;
dcl  last fixed bin;
	if last < 0
	then
	     do;
	     result = word || "**";
	     return;
	end;
	result = "";
	do i = 0 to length (word);
	     if i ^= 0
	     then
		do;
		result = result || substr (word, i, 1);
		if hyphens (i) then result = result || "-";
	     end;
	     if last > 0 & last = i+1
	     then result = result || "*";
	end;
     end;




		    digram_table.dtc                11/15/82  1912.6rew 11/15/82  1454.0       77580



a,b,c,d,e01,f,g,h,i,j,k,l,m,n,o,p,r,s,t,u,v,w,x1,y,z,ch,gh,ph,rh,sh,th,wh
qu,ck1;
aa+,ab,ac,ad,ae+,af,ag, 11 ah  1,ai,aj,ak,al,am,an,ao+,ap,ar,as,at
au,av,aw,ax,ay,az,ach,agh+,aph,arh+,ash,ath,awh+,  1 aqu  1,ack,ba, 11 bb  1, 11 bc  1, 11 bd  1,be
 11 bf  1, 11 bg  1, 11 bh  1,bi, 11 bj  1, 11 bk  1,1   bl- 1
 11 bm  1, 11 bn  1,bo, 11 bp  1,1   br  1
 1  bs, 11 bt  1,bu, 11 bv  1, 11 bw  1,bx+,by
 11 bz  1, 11 bch  1,bgh+, 11 bph  1,brh+, 11 bsh  1, 11 bth  1,bwh+, 11 bqu  1,bck+
ca, 11 cb  1, 11 cc  1, 11 cd  1,ce, 11 cf  1
 11 cg  1, 11 ch  1,ci, 11 cj  1, 11 ck  1,cl- 1, 11 cm  1, 11 cn  1
co, 11 cp  1,cr  1, 1  cs 1, 1 -ct,cu
 11 cv  1, 11 cw  1,cx+,cy, 11 cz  1,cch+,cgh+, 11 cph  1,crh+, 11 csh  1, 11 cth  1,cwh+, 1  cqu- 1,cck+,da, 11 db  1
 11 dc  1, 1  dd,de, 11 df  1, 11 dg  1, 11 dh  1,di
 11 dj  1, 11 dk  1, 11 dl  1, 11 dm  1, 11 dn  1,do
 11 dp  1,1   dr  1, 1  ds 1, 11 dt  1,du, 11 dv  1
 11 dw  1,dx+,dy, 11 dz  1, 11 dch  1, 11 dgh  1, 11 dph  1,drh+, 1  dsh  1, 1 -dth,dwh+, 11 dqu  1,dck+
ea,eb,ec,ed,ee,ef,eg, 11 eh  1,ei  1
ej,ek,el,em,en,  1 eo,ep,er,es,et,eu,ev
ew,ex,ey,ez,ech, 11 egh  1,eph,erh+,esh,eth,ewh+,  1 equ  1,eck,fa, 11 fb  1, 11 fc  1, 11 fd  1,fe, 1  ff, 11 fg  1, 11 fh  1
fi, 11 fj  1, 11 fk  1,1   fl- 1, 11 fm  1, 11 fn  1,fo, 11 fp  1
1   fr  1, 1  fs, 1  ft,fu, 11 fv  1, 11 fw  1,fx+
 1  fy, 11 fz  1, 11 fch  1, 11 fgh  1, 11 fph  1,frh+, 11 fsh  1, 11 fth  1,fwh+, 11 fqu  1,fck+
ga, 11 gb  1, 11 gc  1, 11 gd  1,ge, 11 gf  1
 1  gg, 11 gh  1,gi, 11 gj  1,gk+,1   gl- 1, 11 gm  1, 11 gn  1,go
 11 gp  1,1   gr  1, 1  gs 1, 11 gt  1,gu, 11 gv  1
 11 gw  1,gx+, 1  gy, 11 gz  1
 11 gch  1,ggh+, 11 gph  1,grh+, 1  gsh, 1  gth,gwh+, 11 gqu  1,gck+
ha, 11 hb  1, 11 hc  1, 11 hd  1,he, 11 hf  1, 11 hg  1,hh+,hi, 11 hj  1
 11 hk  1, 11 hl  1, 11 hm  1, 11 hn  1,ho, 11 hp  1, 11 hr  1
 11 hs  1, 11 ht  1,hu, 11 hv  1, 11 hw  1,hx+,hy, 11 hz  1, 11 hch  1, 11 hgh  1, 11 hph  1
hrh+, 11 hsh  1, 11 hth  1,hwh+, 11 hqu  1,hck+, 11 ia,ib
ic,id, 1  ie,if,ig, 11 ih  1,ii+,ij,ik,il,im,in,  1 io,ip,ir,is,it, 11 iu,iv, 11 iw  1,ix, 11 iy  1,iz
ich, 1  igh,iph,irh+,ish,ith,iwh+,  1 iqu  1,ick
ja, 11 jb  1, 11 jc  1, 11 jd  1,je, 11 jf  1,jg+, 11 jh  1,ji,jj+
 11 jk  1, 11 jl  1, 11 jm  1, 11 jn  1,jo, 11 jp  1, 11 jr  1
 11 js  1, 11 jt  1,ju, 11 jv  1, 11 jw  1,jx+, 1  jy, 11 jz  1
 11 jch  1, 11 jgh  1, 11 jph  1,jrh+, 11 jsh  1, 11 jth  1,jwh+, 11 jqu  1,jck+
ka, 11 kb  1, 11 kc  1, 11 kd  1,ke, 11 kf  1, 11 kg  1, 11 kh  1
ki, 11 kj  1, 11 kk  1,kl- 1, 11 km  1,1   kn- 1,ko, 11 kp  1
kr- 1, 1  ks 1, 11 kt  1,ku, 11 kv  1, 11 kw  1,kx+, 1  ky, 11 kz  1
 11 kch  1, 11 kgh  1, 1 -kph,krh+, 1  ksh, 11 kth  1,kwh+, 11 kqu  1,kck+
la, 1 -lb, 11 lc  1, 1 -ld,le, 1 -lf
 1 -lg, 11 lh  1,li, 1 -lj, 1 -lk, 1 -ll, 1 -lm, 11 ln  1,lo, 1 -lp
 11 lr  1, 1  ls, 1 -lt,lu, 1 -lv, 11 lw  1,lx+,ly, 11 lz  1
 1 -lch, 11 lgh  1, 1 -lph,lrh+, 1 -lsh, 1 -lth,lwh+, 11 lqu  1,lck+
ma, 11 mb  1, 11 mc  1, 11 md  1,me, 11 mf  1, 11 mg  1, 11 mh  1,mi
 11 mj  1, 11 mk  1, 11 ml  1, 1  mm, 11 mn  1,mo, 1  mp
 11 mr  1, 1  ms, 1  mt,mu, 11 mv  1, 11 mw  1,mx+,my, 11 mz  1
 1 -mch, 11 mgh  1, 1  mph,mrh+, 1  msh, 1  mth,mwh+, 11 mqu  1,mck+
na, 11 nb  1, 11 nc  1, 1  nd,ne, 11 nf  1, 1 -ng, 11 nh  1,ni
 11 nj  1, 1 -nk, 11 nl  1, 11 nm  1, 1  nn,no, 11 np  1, 11 nr  1
 1  ns, 1  nt,nu, 11 nv  1, 11 nw  1,nx+, 1  ny, 11 nz  1
 1 -nch, 11 ngh  1, 1 -nph,nrh+, 1  nsh, 1  nth,nwh+, 11 nqu  1, 1 -nck
oa,ob,oc,od,oe+,of,og, 11 oh  1,oi,oj,ok,ol,om,on,oo,op,or,os,ot,ou
ov,ow,ox,oy,oz,och, 1  ogh,oph,orh+,osh,oth,owh+,  1 oqu  1,ock
pa, 11 pb  1, 11 pc  1, 11 pd  1,pe, 11 pf  1, 11 pg  1, 11 ph  1
pi, 11 pj  1, 11 pk  1,pl- 1, 11 pm  1, 11 pn  1,po, 1 -pp
pr  1, 1  ps 1, 1  pt 1,pu, 11 pv  1, 11 pw  1,px+,py, 11 pz  1
 11 pch  1, 11 pgh  1, 11 pph  1,prh+, 11 psh  1, 11 pth  1,pwh+, 11 pqu  1,pck+
ra, 1 -rb, 1 -rc, 1 -rd,re, 1 -rf, 1 -rg, 11 rh  1,ri, 1 -rj, 1 -rk
 1 -rl, 1 -rm, 1 -rn,ro, 1 -rp, 1 -rr, 1 -rs, 1 -rt,ru
 1 -rv, 11 rw  1,rx+,ry, 1 -rz, 1 -rch, 11 rgh  1, 1 -rph,rrh+, 1 -rsh, 1 -rth,rwh+, 1 -rqu  1, 1 -rck
sa, 11 sb  1,sc  1, 11 sd  1,se
 11 sf  1, 11 sg  1, 11 sh  1,si, 11 sj  1,sk,1   sl- 1,sm- 1,   -sn- 1,so,sp, 1  sr  1, 1 -ss
st,su, 11 sv  1,1   sw- 1,sx+,sy, 11 sz  1,1   sch- 1, 11 sgh  1, 11 sph  1,srh+, 11 ssh  1, 11 sth  1,swh+,squ- 1, 1  sck
ta, 11 tb  1, 11 tc  1, 11 td  1
te, 11 tf  1, 11 tg  1, 11 th  1
ti, 11 tj  1, 11 tk  1, 11 tl  1, 11 tm  1, 11 tn  1,to, 11 tp  1
tr  1, 1  ts 1, 1 -tt,tu, 11 tv  1,1   tw- 1,tx+,ty, 11 tz  1
 1  tch, 11 tgh  1, 1  tph 1,trh+, 1  tsh 1, 11 tth  1,twh+, 11 tqu  1,tck+
 11 ua  1,ub,uc,ud, 1  ue,uf,ug, 11 uh  1, 11 ui  1,uj,uk,ul,um,un, 11 uo
up,ur,us,ut,uu+,uv, 11 uw  1,ux, 11 uy  1,uz,uch, 1 -ugh,uph,urh+,ush,uth,uwh+,  1 uqu  1,uck,va, 11 vb  1, 11 vc  1
 11 vd  1,ve, 11 vf  1, 11 vg  1, 11 vh  1,vi, 11 vj  1, 11 vk  1, 11 vl  1
 11 vm  1, 11 vn  1,vo, 11 vp  1, 11 vr  1, 11 vs  1, 11 vt  1,vu
 11 vv  1, 11 vw  1,vx+, 1  vy, 11 vz  1, 11 vch  1, 11 vgh  1, 11 vph  1,vrh+, 11 vsh  1, 11 vth  1,vwh+, 11 vqu  1,vck+
wa, 1 -wb, 11 wc  1, 1 -wd 1
we, 1 -wf, 1 -wg 1, 11 wh  1,wi, 11 wj  1, 1 -wk, 1 -wl-, 1 -wm, 1 -wn
wo, 1 -wp,1   wr- 1, 1 -ws, 1 -wt,wu, 1 -wv, 11 ww  1, 1 -wx,wy
 1 -wz, 1  wch, 11 wgh  1, 1  wph,wrh+, 1  wsh, 1  wth,wwh+, 11 wqu  1, 1  wck
 1  xa, 11 xb  1, 11 xc  1, 11 xd  1, 1  xe, 11 xf  1, 11 xg  1, 11 xh  1
 1  xi, 11 xj  1, 11 xk  1, 11 xl  1, 11 xm  1, 11 xn  1, 1  xo, 11 xp  1
 11 xr  1, 11 xs  1, 11 xt  1, 1  xu, 11 xv  1, 11 xw  1,xx+, 1  xy, 11 xz  1, 11 xch  1, 11 xgh  1, 11 xph  1
xrh+, 11 xsh  1, 11 xth  1,xwh+, 11 xqu  1,xck+,ya, 1  yb
 1  yc  1, 1  yd,ye, 1  yf  1, 1  yg, 11 yh  1,1   yi  1, 1  yj  1, 1  yk, 1  yl  1
 1  ym, 1  yn,yo, 1  yp, 11 yr  1, 1  ys, 1  yt,yu, 1  yv  1, 11 yw  1
 1  yx,yy+, 1  yz, 11 ych  1, 11 ygh  1, 11 yph  1,yrh+, 11 ysh  1, 11 yth  1,ywh+, 11 yqu  1,yck+
za, 11 zb  1, 11 zc  1, 11 zd  1,ze, 11 zf  1
 11 zg  1, 11 zh  1,zi, 11 zj  1, 11 zk  1, 11 zl  1, 11 zm  1, 11 zn  1,zo
 11 zp  1, 1  zr  1, 11 zs  1, 1  zt,zu, 11 zv  1,zw- 1,zx+,zy, 1  zz
 11 zch  1, 11 zgh  1, 11 zph  1,zrh+, 11 zsh  1, 11 zth  1,zwh+, 11 zqu  1,zck+
cha, 11 chb  1, 11 chc  1, 11 chd  1,che, 11 chf  1, 11 chg  1, 11 chh  1
chi, 11 chj  1, 11 chk  1, 11 chl  1, 11 chm  1, 11 chn  1,cho, 11 chp  1
chr  1, 11 chs  1, 11 cht  1,chu, 11 chv  1, 1  chw  1,chx+,chy, 11 chz  1
chch+, 11 chgh  1, 11 chph  1,chrh+, 11 chsh  1, 11 chth  1,chwh+, 11 chqu  1
chck+
gha, 11-ghb  1, 11-ghc  1, 11-ghd  1,ghe, 11-ghf  1, 11-ghg  1, 11-ghh  1
1   ghi  1, 11-ghj  1, 11-ghk  1, 11-ghl  1, 11-ghm  1, 11-ghn  1,1   gho  1
 11 ghp  1, 11-ghr  1, 1 -ghs, 1 -ght, 11-ghu  1, 11-ghv  1, 11-ghw  1,ghx+
 11-ghy  1, 11-ghz  1, 11-ghch  1,ghgh+, 11-ghph  1,ghrh+, 11-ghsh  1, 11-ghth  1
ghwh+, 11-ghqu  1,ghck+
pha, 11 phb  1, 11 phc  1, 11 phd  1,phe, 11 phf  1, 11 phg  1, 11 phh  1,phi
 11 phj  1, 11 phk  1,1   phl- 1, 11 phm  1, 11 phn  1,pho, 11 php  1,phr  1, 1  phs
 1  pht,phu, 1  phv  1, 1  phw  1,phx+, 1  phy, 11 phz  1, 11 phch  1, 11 phgh  1
phph+,phrh+, 11 phsh  1, 11 phth  1,phwh+, 11 phqu  1,phck+
1   rha  1,rhb+,rhc+,rhd+,1   rhe  1,rhf+,rhg+,rhh+,1   rhi  1,rhj+
rhk+,rhl+,rhm+,rhn+,1   rho  1,rhp+,rhr+,rhs+,rht+,1   rhu  1,rhv+,rhw+
rhx+,1   rhy,rhz+,rhch+,rhgh+,rhph+,rhrh+,rhsh+,rhth+,rhwh+,rhqu+,rhck+
sha, 11 shb  1, 11 shc  1, 11 shd  1,she, 11 shf  1, 11 shg  1,shh+,shi
 11 shj  1, 1  shk,1   shl- 1,1   shm- 1,1   shn- 1,sho, 1  shp,1   shr- 1
 11 shs  1,sht-,shu, 11 shv  1,shw- 1,shx+,shy, 11 shz  1, 11 shch  1
 11 shgh  1, 11 shph  1,shrh+,shsh+, 11 shth  1,shwh+, 11 shqu  1,shck+
tha, 11 thb  1, 11 thc  1, 11 thd  1,the, 11 thf  1, 11 thg  1, 11 thh  1,thi
 11 thj  1, 11 thk  1, 11 thl  1, 11 thm  1, 11 thn  1,tho, 11 thp  1,thr  1
 1  ths 1, 11 tht  1,thu, 11 thv  1,thw- 1,thx+,thy, 11 thz  1, 11 thch  1, 11 thgh  1
 11 thph  1,thrh+, 11 thsh  1,thth+,thwh+, 11 thqu  1,thck+
1   wha  1,whb+,whc+,whd+,1   whe  1,whf+,whg+,whh+,1   whi  1,whj+,whk+
whl+,whm+,whn+,1   who  1,whp+,whr+,whs+,wht+,whu+,whv+
whw+,whx+,1   why,whz+,whch+,whgh+,whph+,whrh+,whsh+,whth+,whwh+
whqu+,whck+
qua,qub+,quc+,qud+,que,quf+,qug+,quh+,qui,quj+,quk+,qul+,qum+,qun+,quo
qup+,qur+,qus+,qut+,quu+,quv+,quw+,qux+,quy+,quz+,quch+,qugh+,quph+
qurh+,qush+,quth+,quwh+,ququ+,quck+
 11 cka  1, 11 ckb  1, 11 ckc  1, 11 ckd  1, 11 cke  1, 11 ckf  1, 11 ckg  1
 11 ckh  1, 11 cki  1, 11 ckj  1, 11 ckk  1, 11 ckl  1
 11 ckm  1, 11 ckn  1, 11 cko  1, 11 ckp  1, 11 ckr  1, 1  cks, 11 ckt  1
 11 cku  1, 11 ckv  1, 11 ckw  1,ckx+, 1  cky, 11 ckz  1, 11 ckch  1
 11 ckgh  1, 11 ckph  1,ckrh+, 11 cksh  1, 11 ckth  1,ckwh+, 11 ckqu  1,ckck+
$




		    digram_table_compiler.pl1       11/15/82  1912.6rew 11/15/82  1529.8       60975



/* ***********************************************************
   *                                                         *
   * Copyright, (C) Honeywell Information Systems Inc., 1982 *
   *                                                         *
   *********************************************************** */
/* This command compiles a source segment containing digrams for
   the word generator and puts the compiled output in a segment
   named "digrams".

   Usage: digram_table_compiler pathname -option-

   Where: option may be one of the following:

   -ls, -list  Lists the output on the terminal after compilation.
   -ls, n, -list n  Lists as above, but in n columns.

   Usage: print_digram_table -n-

   n    Lists the output in n columns.  Allow 14 positions for each column.
   This call assuumes that the digrams segment already exists
   and has been compiled correctly.
*/

digram_table_compiler: procedure;
dcl (start, size) fixed bin;
dcl  nrows fixed bin;
dcl  cu_$arg_ptr entry (fixed bin, ptr, fixed bin, fixed bin (35));
dcl  code fixed bin (35);
dcl  codex fixed bin;
dcl  cv_dec_check_ entry (char (*), fixed bin) returns (fixed bin (35));
dcl  hcs_$truncate_seg entry (ptr, fixed bin, fixed bin (35));
dcl  hcs_$terminate_name entry (char (*), fixed bin (35));
dcl  com_err_ entry options (variable);
dcl (error_table_$noarg, error_table_$badopt) external fixed bin (35);
dcl  get_line_length_$switch entry (ptr, fixed bin (35)) returns (fixed bin (17));
dcl  read_table_ entry (ptr, fixed bin (24)) returns (bit (1));
dcl  compile bit (1);
dcl  who char (25) varying;
dcl  list bit (1);
dcl  segptr ptr static init (null);
dcl  dirname char (168) aligned;
dcl  ename char (32) aligned;
dcl  ename_length fixed bin;
dcl  null builtin;
dcl  arg char (length) based (pp);
dcl  hcs_$initiate_count entry (char (*), char (*), char (*),
     fixed bin (24), fixed bin (2), ptr, fixed bin (35));
dcl  hcs_$terminate_noname entry (ptr, fixed bin (35));
dcl  expand_path_ entry (ptr, fixed bin, ptr, ptr, fixed bin (35));
dcl  bc fixed bin (24);
dcl  i fixed;
%include digram_structure;
dcl  pp ptr;
dcl (j, k) fixed;
dcl  max fixed;
dcl  length fixed bin;
dcl  ioa_$nnl entry options (variable);
dcl  argno fixed bin;
dcl (diff, last, ncolumns init (0), remainder, middle, first) fixed;
dcl  ioa_ entry options (variable);

	who = "digram_table_compiler";
	goto start1;

dtc:	entry;
	who = "dtc";

start1:

	compile = "1"b;				/* set switch to compile */
	call cu_$arg_ptr (1, pp, length, code);
	argno = 1;
	if code ^= 0 then goto argerr;
	call expand_path_ (pp, length, addr (dirname), addr (ename), code);
	if code ^= 0 then goto argerr;
	ename_length = index (ename, " ");
	if ename_length = 0
	then ename_length = 32;
	else ename_length = ename_length - 1;
	if ename_length >= 4
	then
	     if substr (ename, ename_length - 3, 4) = ".dtc"
	     then ename_length = ename_length - 4;

	argno = 2;
	call cu_$arg_ptr (2, pp, length, code);		/* get option */
	if code ^= 0
	then list = "0"b;				/* no listing desired */
	else
	if arg = "-ls" | arg = "-list"
	then do;
	     list = "1"b;
	     argno = 3;
	end;
	else do;
	     code = error_table_$badopt;
	     goto argerr;
	end;
	goto get_ncolumns;

pdt:	entry;
	who = "pdt";
	goto start2;

print_digram_table: entry;
	who = "print_digram_table";

start2:

	list = "1"b;
	argno = 1;
	compile = "0"b;

get_ncolumns:
	call cu_$arg_ptr (argno, pp, length, code);
	if code ^= 0
	then do;
	     ncolumns = get_line_length_$switch (null, code);
	     if code ^= 0 then do;
		code = 0;
		ncolumns = 132;
	     end;
	     ncolumns = divide (ncolumns, 14, 17, 0);
	end;
	else do;
	     ncolumns = cv_dec_check_ (arg, codex);
	     if codex ^= 0
	     then do;
		code = error_table_$badopt;
		goto argerr;
	     end;
	end;
	


	if ^compile then goto dont_compile;

/* now initiate the source segment */

	call hcs_$initiate_count ((dirname), substr (ename, 1, ename_length) ||
	     ".dtc", "", bc, 0, segptr, code);
	if segptr = null
	then do;
	     call com_err_ (code, who, "^a>^a.dtc", dirname, substr (ename, 1, ename_length));
	     return;
	end;

/* compile the segment */

	call hcs_$terminate_name ("digrams", code);	/* terminate previous copies */
	if read_table_ (segptr, bc)			/* any error? */
	then
	     do;
	     call com_err_ (0, who, "Error in source segment.");
	     return;
	end;
	


/* terminate the source now */
	


	call hcs_$terminate_noname (segptr, code);
	if ^list then return;			/* if no listing wanted, leave now */
	


dont_compile:
	if compile then call ioa_ ("^/^/^/^/");
	nrows = (n_units-1)/ncolumns + 1;		/* This is the first reference to the digrams segment */
	if ncolumns ^= 0
	then
	     do;
	     do i = 1 to nrows;
		do j = i by nrows while (j <= n_units);
		     call ioa_$nnl ("    ^2d ^2a ^1b^1b^1b^1b", j, letters (j), rules (j).not_begin_syllable,
			rules (j).no_final_split, rules (j).vowel, rules (j).alternate_vowel);
		end;
		call ioa_ ("");
	     end;
	     call ioa_ ("");
	     do start = 1, ncolumns* (59-nrows) + 1 by ncolumns*60
		     while (start<n_units**2);
		if start = 1
		then size = min (n_units*n_units, ncolumns* (59-nrows));
		else size = min (n_units*n_units-start+1, ncolumns*60);
		diff = size/ncolumns;
		remainder = size - diff*ncolumns;
		last = (size + ncolumns - 1)/ncolumns + start - 1;
		do first = start to last;
		     middle = first + remainder* (diff + 1);
		     if first = last & middle ^= first
		     then max = middle - (diff+1);
		     else max = middle + (ncolumns - remainder - 1)*diff;
		     do i = first to middle by diff+1 while (i <= max), middle+diff to max by diff;
			j = (i-1)/n_units + 1;
			k = i - (j-1)*n_units;
			call ioa_$nnl ("   ^1b^1b^1b" || charac () || characc (j) || letters (k) || chara () || "^1b^1b",
			     digrams (j, k).begin, digrams (j, k).not_begin,
			     digrams (j, k).break, digrams (j, k).end, digrams (j, k).not_end);
		     end;
		     call ioa_ ("");
		end;
		if start = 1
		then call ioa_$nnl (copy ("^/", 66-first-nrows));
		else call ioa_$nnl (copy ("^/", start+66-first));
	     end;
	end;
	return;

charac:	proc returns (char (1));
	     if digrams (j, k).prefix then return ("-"); else return (" ");
	end;

chara:	proc returns (char (1));
	     if digrams (j, k).illegal_pair
	     then return ("+");
	     else
	     if digrams (j, k).suffix
	     then return ("-");
	     else return (" ");
	end;

characc:	proc (c) returns (char (2));
dcl  c fixed;
	     if letters_split (c).second = " "
	     then return (" " || letters_split (c).first);
	     else return (letters (c));
	end;

argerr:
	if code = error_table_$noarg
	then call com_err_ (code, who);
	else
	do;
	     call cu_$arg_ptr (argno, pp, length, 0);
	     call com_err_ (code, who, arg);
	end;

     end;




		    generate_word_.pl1              11/15/82  1912.6rew 11/15/82  1529.9       25560



/* ***********************************************************
   *                                                         *
   * Copyright, (C) Honeywell Information Systems Inc., 1982 *
   *                                                         *
   *********************************************************** */
/* This procedure is the subroutine interface to generate random words.
   It is called when the standard distributi?{n of random units (as returned by
   random_unit_) is desired.  The clock value is used as the starting seed unless
   generate_word_$init_seed is called.
*/
generate_word_: procedure (word, hyphenated_word, min, max);
dcl  word char (*);
dcl  hyphenated_word char (*);
dcl  min fixed bin;
dcl  max fixed bin;
dcl (random_unit_, random_unit_$random_vowel) entry (fixed bin);
dcl  convert_word_ entry ((0:*) fixed bin, (0:*) bit (1) aligned,
     fixed bin, char (*), char (*));
dcl  random_word_ entry ((0:*) fixed bin, (0:*) bit (1) aligned,
     fixed bin, fixed bin, entry, entry);
dcl  hyphens (0:20) bit (1) aligned;
dcl  random_word (0:20) fixed bin;
dcl  length_in_units fixed bin;
dcl  random_length fixed bin;
dcl  unique_bits_ entry returns (bit (70));
dcl  encipher_ entry (fixed bin (71), (*) fixed bin (71), (*) fixed bin (71), fixed bin);
dcl  random_unit_stat_$seed (1) fixed bin (71) external;
dcl  first_call bit (1) static aligned init ("1"b);

/* On the very first call to this procedure in a process (if the
   init_seed entry was not called), use unique_bits to get a
   random number to initialize the random seed. */

	if first_call then do;
	     random_unit_stat_$seed (1) = fixed (unique_bits_ ());
	     first_call = "0"b;
	end;

/* Get the length of the word desired.  We use the old value
   of the seed to determine this length so that the length of the word
   will not in some way be correlated with the word itself.
   We calculate this to be a uniformly distributed random number between
   min and max. */

	random_length = mod (abs (fixed (random_unit_stat_$seed (1), 17)), (max - min + 1)) + min;

/* encipher the seed to get a random number and the next value of the seed */

	call encipher_ (random_unit_stat_$seed (1), random_unit_stat_$seed, random_unit_stat_$seed, 1);

/* Get the random word and convert it to characters */

	call random_word_ (random_word, hyphens, random_length, length_in_units, random_unit_, random_unit_$random_vowel);
	call convert_word_ (random_word, hyphens, length_in_units, word, hyphenated_word);
	return;

/* This entry allows the user to set the seed.  If the seed argument is zero, we
   go back to using the clock value.
*/
generate_word_$init_seed: entry (seed);
dcl  seed fixed bin (35);

	if seed = 0 then first_call = "1"b;
	else do;
	     random_unit_stat_$seed (1) = seed;
	     first_call = "0"b;
	end;
	return;
     end;




		    generate_words.pl1              11/15/82  1912.6rew 11/15/82  1530.0       43038



/* ***********************************************************
   *                                                         *
   * Copyright, (C) Honeywell Information Systems Inc., 1982 *
   *                                                         *
   *********************************************************** */
generate_words: gw: procedure;
dcl  cu_$arg_ptr entry (fixed, ptr, fixed, fixed bin (35));
dcl  cu_$arg_ptr_rel entry (fixed bin, ptr, fixed bin, fixed bin (35), ptr);
dcl  cu_$arg_list_ptr entry (ptr);
dcl  argno fixed;
dcl  new_line char (1) init ("
");
dcl  error_table_$badopt external fixed bin (35);
dcl  arglen fixed bin;
dcl  generate_word_ entry (char (*), char (*), fixed bin, fixed bin);
dcl  generate_word_$init_seed entry (fixed bin (35));
dcl  ios_$write_ptr entry (ptr, fixed bin, fixed bin);
dcl  argptr ptr;
dcl  hyphenate bit (1) init ("0"b);
dcl  cv_dec_check_ entry (char (*), fixed bin) returns (fixed bin (35));
dcl  maximum_length fixed bin init (-1);		/* set to maximum length of words */
dcl  minimum_length fixed bin init (-1);		/* minimum length of words */
dcl  seed_value fixed bin (35) init (-1);		/* value of seed typed by user */
dcl  com_err_ entry options (variable);
dcl  i fixed, code fixed bin (35) init (0);
dcl  unique_bits_ entry returns (fixed bin (70));
dcl  result fixed bin;
dcl  nwords fixed init (0);
dcl  max_words fixed init (0);
dcl  arg char (arglen) based (argptr) unaligned;
dcl  maximum_hyphenated fixed bin;
dcl  area char (56);				/* where output line goes */
dcl  output_line_length fixed bin;			/* length of the output line in area */
dcl  unhyphenated_word char (maximum_length) based (addr (area));
dcl  hyphenated_word char (maximum_hyphenated) based (hph_ptr);
dcl  hph_ptr ptr;					/* pointer to position in area where hyphenated word goes */

dcl  arglistptr ptr;

	call cu_$arg_list_ptr (arglistptr);
	do argno = 1 by 1 while (code = 0);
	     call cu_$arg_ptr (argno, argptr, arglen, code);
	     if code = 0
	     then
		if arg = "-hph" | arg = "-hyphenate"
		then hyphenate = "1"b;
		else
		if arg = "-max"
		then maximum_length = value ("maximum");
		else
		if arg = "-min"
		then minimum_length = value ("minimum");
		else
		if arg = "-length" | arg = "-ln"
		then do;
		     maximum_length = value ("length");
		     minimum_length = maximum_length;
		end;
		else
		if arg = "-seed" then do;
		     seed_value = value ("seed");
		     call generate_word_$init_seed (seed_value);
		end;
		else do;
		     nwords = cv_dec_check_ (arg, result); /* look for number of words */
		     if result = 0 & nwords > 0
		     then max_words = nwords;
		     else call ugly (error_table_$badopt, arg);
		end;
	end;

/* Below we decide whether minimum, maximum, both, or none have been specified,
   and set their default values accordingly. */

	if nwords = 0 then max_words = 1;
	if minimum_length = -1
	then if maximum_length = -1
	     then do;
		minimum_length = 6;
		maximum_length = 8;
	     end;
	     else minimum_length = 4;
	else if maximum_length = -1
	then maximum_length = 20;
	if minimum_length < 4 | minimum_length > maximum_length |
	maximum_length > 20 then
	     call ugly (0, "Bad value of lengths: 3<min<max<21 required.");

	maximum_hyphenated = maximum_length + 2*maximum_length/3; /* maximum length of hyphenated word */

	hph_ptr = addr (substr (area, maximum_length + 2)); /* where hyphenated word is put */
						/* even if we're not printing it out, it needs a place to go */
	if hyphenate				/* for efficiency, put newline character in expected place in output string */
	then do;
	     substr (unhyphenated_word, maximum_length + 1, 1) = " ";
	     substr (hyphenated_word, maximum_hyphenated + 1, 1) = new_line;
	     output_line_length = maximum_length + maximum_hyphenated + 2;
	end;
	else do;
	     substr (unhyphenated_word, maximum_length + 1, 1) = new_line;
	     output_line_length = maximum_length + 1;
	end;

/* generate max_words and write them all out */

	do i = 1 to max_words;
	     call generate_word_ (unhyphenated_word, hyphenated_word, minimum_length, maximum_length);
	     call ios_$write_ptr (addr (area), 0, output_line_length);
	end;


ugly:	procedure (codex, message);
dcl (code, codex) fixed bin (35);
dcl  message char (*);
	     call com_err_ (codex, "generate_words", message);
	     goto return;
	end;

value:	procedure (name) returns (fixed bin (35));
dcl  number fixed bin (35);
dcl  name char (*);
	     argno = argno + 1;
	     call cu_$arg_ptr_rel (argno, argptr, arglen, code, arglistptr);
	     if code ^= 0 then call ugly (code, "Value of " || name);
	     number = cv_dec_check_ (arg, result);
	     if result ^= 0 | number < 0
	     then call ugly (0, "Bad " || name || " value. " || arg);
	     return (number);
	end;

return:
     end;




		    hyphen_test.pl1                 11/15/82  1912.6rew 11/15/82  1530.0       13293



/* ***********************************************************
   *                                                         *
   * Copyright, (C) Honeywell Information Systems Inc., 1982 *
   *                                                         *
   *********************************************************** */
hyphen_test: ht: proc;
dcl  cu_$arg_ptr entry (fixed, ptr, fixed, fixed bin (35));
dcl  length fixed bin;
dcl  j fixed bin;
dcl  status fixed bin;
dcl  hyphenate_ entry (char (*), (*) bit (1) aligned, fixed bin);
dcl  hyphenate_$probability entry (char (*), (*) bit (1) aligned, fixed bin, float bin);
dcl  probability float bin;
dcl  hyphens (20) bit (1) aligned;
dcl  ioa_ entry options (variable);
dcl  arg char (length) based (argptr);
dcl  argptr ptr;
dcl  code fixed bin (35);
dcl  i fixed bin;
dcl  convert_word_char_ entry (char (*), (*) bit (1) aligned, fixed bin, char (*) varying);
dcl  result char (30) varying;
dcl  calculate bit (1) aligned init ("0"b);

	do i = 1 by 1;
	     call cu_$arg_ptr (i, argptr, length, code);
	     if code ^= 0 then return;
	     if arg = "-probability" | arg = "-pb" then calculate = "1"b;
	     else do;
		if calculate
		then call hyphenate_$probability (arg, hyphens, status, probability);
		else call hyphenate_ (arg, hyphens, status);
		call convert_word_char_ (arg, hyphens, status, result);
		if calculate
		then call ioa_ ("^a ^f", result, probability);
		else call ioa_ (result);
	     end;
	end;
     end;




		    hyphenate_.pl1                  11/15/82  1912.6rew 11/15/82  1530.1      142011



/* ***********************************************************
   *                                                         *
   * Copyright, (C) Honeywell Information Systems Inc., 1982 *
   *                                                         *
   *********************************************************** */
/* This procedure tries to hyphenate a word supplied by the caller.

   dcl hyphenate_ entry(char(*), (*) bit(1) aligned, fixed bin);

   call hyphenate_ (word, returned_hyphens, code);

   1) word      A word consisting of ASCII letters to be hyphenated.
   The first character may be uppercase or lowercase; the other
   characters may be lowercase only.

   3) returned_hyphens
   A one bit in this array means that the corresponding
   character in word is to have a hyphen after it.

   3) code      Status code: 0  word has been successfully hyphenated.
   -1 word contains illegal characters.
   -2 word was more than 20 or less than 3 characters.
   Any positive value of code means the word couldn't
   be hyphenated.  In this case code is the position of the
   first character that was not accepted.

   The word is hyphenated by using random_word_ and whatever existing digram
   table is in use by random_word_ to determine the syllabification and pronounceability
   of the word supplied.  The standard random_unit_ routine is not used,
   except that random_unit_$probabilities is called by hyphenate_$probability.
*/

hyphenate_: procedure (word, returned_hyphens, code);
dcl  word char (*);
dcl  code fixed bin;
dcl  debug static bit (1) init ("0"b);
dcl  ioa_$nnl entry options (variable);
dcl  word_array (20) fixed bin static;			/* word spread out into units */
dcl  hyphenated_word (0:20) bit (1) aligned;		/* returned hyphens from random_word_ */
dcl  returned_hyphens (*) bit (1) aligned;		/* hyphens to be returned to caller */
dcl  split_point fixed bin;				/* set on internal call at 2-letter unit to be split */
dcl  word_length_in_chars fixed bin static;		/* length of word in characters */
dcl  word_length fixed bin static;			/* length of word_array in units */
dcl  i fixed bin;
dcl  j fixed bin;
dcl  chars char (2);
dcl  char char (1);
dcl  word_index fixed bin static;			/* index into word_array */
dcl  returned_word (0:20) fixed bin;			/* word returned by random_word_ */
dcl  vowel_flag bit (1);				/* 1 when random_vowel is called */
dcl  last_good_unit static fixed bin;			/* word_index of last good unit */
dcl  new_unit fixed bin;
dcl  random_word_ entry ((0:*)fixed bin, (0:*) bit (1) aligned,
     fixed bin, fixed bin, entry, entry);
dcl  random_unit_$probabilities entry ((*) float bin, (*) float bin);
dcl  probability float bin;				/* value of p returned to user */
dcl  calculate bit (1) static;			/* says we're calculating the probability of a word */
dcl  p float bin static;				/* accumulated product of probability for the word */
dcl  total_p_this_unit float bin;			/* total sum of probabilities of units that could be accepted in this position */
dcl  returned_length fixed bin;

/* probabilities of generating each unit at random */
/* obtained from a call to random_unit_$probabilities */

dcl (unit_probabilities based (u_p_ptr), vowel_probabilities based (v_p_ptr)) dim (n_units) float bin;
dcl (u_p_ptr, v_p_ptr) static ptr init (null ());
dcl  first_call static bit (1) init ("1"b);
%include digram_structure;
	split_point = 0;
	calculate = "0"b;				/* we aren't calculating probabilities, just hyphenating */
	goto continue;
						/*  */
						/* This entry is the same as hyphenate_, except that an additional value returned
						   is the probability that the word would have been generated by random_word_
						   using the current digram table and random_unit_ subroutine.  On the first call
						   to this entry, random_unit_$probabilities is called to obtain the probabilities
						   of all units.  If these change within a process, hyphenate_$reset must be called
						   before hyphenate_$probability is called again.
						*/

hyphenate_$probability: entry (word, returned_hyphens, code, probability);
	split_point = 0;
	p = 1;
	calculate = "1"b;
	if first_call then do;
	     allocate unit_probabilities, vowel_probabilities;
	     call random_unit_$probabilities (unit_probabilities, vowel_probabilities);
	     first_call = "0"b;
	end;
	goto continue;

/* This entry is used to reset the probability arrays in case a new
   version of random_unit_ (with different probabilities) is used.
   Note that if a new version of digrams is also supplied, the old
   digrams must be terminated. */

hyphenate_$reset: entry; first_call = "1"b;
	if v_p_ptr ^= null () then free unit_probabilities, vowel_probabilities;
	return;

/* This entry point is called internally as a recursive call to hyphenate_.
   It is referenced when random_word_ did not accept the word because a 2-letter unit
   was illegal.  In this case we call this entry and tell hyphenate_ to split the 2-letter
   unit into 2 separate units.  The splitpoint argument specifies which one to do this with. */

hyphenate_$split: entry (word, returned_hyphens, code, splitpoint);
dcl  splitpoint fixed bin;
	split_point = splitpoint;

continue:
	word_length_in_chars = length (word);
	if word_length_in_chars > 20 | word_length_in_chars < 3
	then
	     do;
	     code = -2;
	     if calculate then probability = 0;
	     return;
	end;

/* Now that we have the word we want to hyphenate, we try to divide it up ino units as defined
   in the digram table.  We start with the first two letters in the word, and see if they are equal to any
   of the 2-letter units.  If they are, we store the index of that unit in the word_array, and increment
   our word_index by 2.  If they are not, we see if the first letter is equal to any of the 1-letter units.
   If it is, we store that unit and increment the word_index by 1.  If still not found, the character is
   not defined as a unit in the digram table and the word is illegal.  Of course, the word may still not be
   "legal" according to random_word_ rules of pronunciation and the digram table, but we'll find that out
   later.
*/

	word_index = 1;
	do i = 1 to word_length_in_chars;
	     chars = substr (word, i, min (2, word_length_in_chars - i + 1));
	     if i = 1 then substr (chars, 1, 1) = translate (substr (chars, 1, 1), "abcdefghijklmnopqrstuvwxyz", "ABCDEFGHIJKLMNOPQRSTUVWXYZ");
	     j = 1;
	     do j = 1 to n_units while (chars ^= letters (j)); /* look for 2-letter unit match */
	     end;
	     if j <= n_units & word_index ^= split_point
	     then					/* match found */
		do;
		word_array (word_index) = j;		/* store 2-letter unit index */
		word_index = word_index + 1;
		i = i + 1;			/* skip over next unit */
	     end;
	     else
	     do;					/* two-letter unit not found, search for 1-letter unit */
		char = substr (chars, 1, 1);
		if i = 1
		then char = translate (char, "abcdefghijklmnopqrstuvwxyz", "ABCDEFGHIJKLMNOPQRSTUVWXYZ");
		char = substr (char, 1, 1);
		j = 1;
		do j = 1 to n_units while (char ^= letters (j));
		end;
		if j <= n_units
		then				/* match found */
		     do;
		     word_array (word_index) = j;	/* store 1-letter unit index */
		     word_index = word_index + 1;
		end;
		else
		do;				/* not found, unit is illegal */
		     code = -1;
		     if calculate then probability = 0;
		     return;
		end;
	     end;
	end;
	word_length = word_index - 1;
	word_index = 0;

/* Now call random_word_, trying to get the word hyphenated.  Special versions of random_unit and
   random_vowel are supplied that return units of the word we are trying to hyphenate rather than
   random units.
*/

	call random_word_ (returned_word, hyphenated_word, word_length_in_chars, returned_length, random_unit, random_vowel);
	goto accepted;

/* If random_unit ever finds that random_word_ did not accept a unit from the word to be hyphenated,
   a nonlocal goto directly to this label (which pops random_word_ off the stack) is made, and we
   abort the whole operation.  If the last unit tried (i.e. the one not accepted) was a 2-letter unit,
   we might be able to make the word legal by splitting that unit up into two 1-letter units and
   starting all over.  Unfortunately, this is a lot of code and complication for a relatively rare case.
*/

not_accepted: word_index = word_index - 1;		/* index of last unit accepted */
	p = 0;					/* zero probability if word was not accepted */

accepted:	if debug then if calculate then call ioa_$nnl ("^/");
	j = 1;
	returned_hyphens = "0"b;
	do i = 1 to word_length;
	     if i > word_index & word_index < word_length /* we never got done with the word */
	     then
		do;
		code = j;				/* word was not accepted */
		if letters_split (word_array (i)).second ^= " " /* was it not accepted because of an illegal */
		& split_point = 0
		then do;				/* 2-letter unit? */
		     p = 1;
		     call hyphenate_$split (word, returned_hyphens, code, i); /* try again with split pair */
		end;				/* Note: in even rarer cases, the unit that might be split to make this word legal is not the
						   unit that was rejected, but a previous unit.  It's too hard to deal with this case, so we'll refuse the word,
						   even though it might be legal.  As an example, using the standard digram table, "preeg-hu-o" is a legal word.
						   However, our first attempt was to supply p-r-e-e-gh-u-o units.  Random_word_ rejects the
						   "u" because it may not follow a "gh" unit in this context.  Since "u" is not a 2-letter
						   unit, we can't try to split it up, so the word is thrown out.  However, p-r-e-e-g-h-u-o
						   would have been acceptable to random_word_.  This is the only case where a
						   word that could have been produced by random_word_ will be rejected by hyphenate_. */
		if calculate then probability = p;
		return;				/* otherwise, return */
	     end;

/* set returned_hyphens bits corresponding to character in word.  Note that
   hyphens returned from random_word_ (hyphenated_word array) point to units,
   not characters. */

	     if letters_split (word_array (i)).second ^= " "
	     then j = j + 2;
	     else j = j + 1;
	     returned_hyphens (j-1) = hyphenated_word (i);
	end;
	code = 0;
	if calculate then probability = p;
	return;
						/*  */
						/* The internal procedures random_unit and random_vowel keep track of the acceptance or rejectance of
						   units they are supplying to random_word_.  Most of the code in the first part is to calculate probabilities
						   when hyphenate_$probability is called.
						*/
random_vowel: proc (returned_unit);
dcl  returned_unit fixed bin;
	     vowel_flag = "1"b;
	     goto generate;

random_unit:   entry (returned_unit);
	     vowel_flag = "0"b;

generate:

/* at this point, we either calculate probabilities or just go for another unit */

/* If probabilities are being calculated, we proceed as follows:
   In every position of the word, we send off to random_word_ all possible units except the one
   that is actually in the word.  We send these as negative numbers so that random_word_ will not actually use
   them, but will tell us whether they are legal.  Since we know the probabiliies of all units, the
   total of the probabilities of the acceptable units can be calculated and normalized to 1 in order
   to determine the probability of the unit we are actually trying.  For example, if "e" is the only legal
   unit in a given position of the word, then its probability of appearing in that position is 1, since
   random_word_ will not accept anything else.

   When all units but the actual unit have been tried, we send off the actual unit with a positive sign.
   It should be accepted by random_word_ if the word is legal, and the ratio of its probability
   to the total probability of the legal units is the probability of the unit being in this word position.
   This multiplied by the product of these probabilities of the previous units gives us a "running product"
   that will eventually yield the probability of the whole word.
*/

	     if calculate then do;			/* we are calculating */
		if debug then
		     if returned_unit < 0 then
			if returned_unit ^= -new_unit then
			     call ioa_$nnl ("^a,", letters (-returned_unit));
		if returned_unit = 0 & word_index = 0 then do; /* this is the first unit of the word */
		     total_p_this_unit = 0;		/* initialize probabilities */
		     word_index = 1;
		end;
		else if returned_unit = 0 & word_index ^= 0 then goto not_accepted; /* it tried to start a word all over on us */
		new_unit = word_array (word_index);	/* get the current unit from the word */
		if returned_unit > 0 then do;		/* was the last unit accepted */
		     if returned_unit = new_unit then do; /* yes, was it the one from this word position? */
			total_p_this_unit = 0;	/* initialize for next word position */
			word_index = word_index + 1;
			new_unit = word_array (word_index); /* get next unit from word, which now becomes current unit */
			returned_unit = 0;
		     end;
		     else do;			/* unit just accepted was not the one at this word position */
			if vowel_flag		/* add its probability to total for this position and keep trying more units */
			then total_p_this_unit = total_p_this_unit + vowel_probabilities (returned_unit);
			else total_p_this_unit = total_p_this_unit + unit_probabilities (returned_unit);
		     end;
		end;
		if -returned_unit = new_unit then goto not_accepted; /* current unit was not accepted */
skip_unit:
		returned_unit = abs (returned_unit) + 1; /* try next unit in unit table */
		if returned_unit = new_unit then returned_unit = returned_unit + 1; /* but skip the current one */
		if returned_unit > n_units
		then do;				/* we've tried all the other units, try the current one now */
						/* If we are trying the current unit for real, we can calculate the probability of
						   of this unit appearing at this position, assuming it will be accepted.
						   Ratio of probability of this unit to total
						   probability for the units accepted at this position gives the probability of this unit
						   having legally been generated at this position */
		     if vowel_flag
		     then p = p * vowel_probabilities (new_unit)/ (vowel_probabilities (new_unit) + total_p_this_unit);
		     else p = p * unit_probabilities (new_unit)/ (unit_probabilities (new_unit) + total_p_this_unit);
		     returned_unit = new_unit;
		end;
		else returned_unit = -returned_unit;	/* if not the current one, make it negative so it won't be used */
		if vowel_flag			/* if vowel was wanted and this isn't one, it can't be used */
		then if ^rules.vowel (abs (returned_unit))
		     then if ^rules.alternate_vowel (abs (returned_unit))
			then
			     if returned_unit < 0	/* if we didn't care to keep it anyway, just ignore */
			     then goto skip_unit;
			     else goto not_accepted;	/* if we wanted to keep it, the word is illegal */
		if debug then
		     if returned_unit > 0 then call ioa_$nnl ("^a^a_; ", letters (returned_unit), "");
	     end;

/* This section of code just supplies the next unit of the word */

	     else do;
		if returned_unit < 0 | (returned_unit = 0 & word_index ^= 0)
		then goto not_accepted;		/* if last unit was not accepted */
		word_index = word_index + 1;
		new_unit = word_array (word_index);	/* get next unit from word */
		if vowel_flag			/* if random_word_ wanted a vowel, and this next unit is not one, */
		then if ^rules.vowel (new_unit)	/* then we have to give up */
		     then if ^rules.alternate_vowel (new_unit) /* I wouldn't dare give random_word_ a non-vowel when it expects a vowel */
			then goto not_accepted;
		returned_unit = new_unit;
		return;
	     end;
	end;

debug_on:	entry; debug = "1"b; return;

debug_off: entry; debug = "0"b; return;
     end;




		    random_unit_.pl1                11/15/82  1912.6rew 11/15/82  1530.1       35739



/* ***********************************************************
   *                                                         *
   * Copyright, (C) Honeywell Information Systems Inc., 1982 *
   *                                                         *
   *********************************************************** */
/* This is the standard random unit generating routine for random_word_.
   It is specified in the call to random_word_ by generate_word_.
   It does not reference the digram table, but assumes that it contains
   34 units in a certain order.  This routine attempts to return
   unit indexes with a distribution approaching that of the distribution
   of the 34 units in English.  In order to do this, a random number
   (supposedly uniformly distributed as returned from encipher_)
   is used to do a table lookup into an array containing unit indexes.
   There are 211 entries in the array for the random_unit_ entry point.
   The probablity of a particular unit being generated is equal to the
   fraction of those 211 entries that contain that unit index.  For example,
   the letter "a" is unit number 1.  Since unit index 1 appears 10 times
   in the array, the probability of selecting an "a" is 10/211.

   Changes may be made to the digram table without affect to this procedure
   providing the letter-to-number correspondence of the units does
   not change.  Likewise, the distribution of the 34 units may be altered
   (and the array size may be changed) in this procedure without affecting
   the digram table or any other programs using the random_word_ subroutine.
*/

random_unit_: procedure (number);
dcl  numbers (0:210) fixed static init ((10)1, (8)2, (12)3, (12)4, (12)5, (8)6,
    (8)7, (6)8, (10)9, (8)10, (8)11, (6)12, (6)13, (10)14, (10)15, (6)16,
    (10)17, (8)18, (10)19, (6)20, (8)21, (8)22, 23, (8)24, 25,
     26, 27, 28, 29, (2)30, (2)31, 32, 33, 34);
dcl  vowel_numbers (0:11) fixed static init (1, 1, 5, 5, 5, 9, 9, 15, 15, 20, 20, 24);
dcl  encipher_ entry (fixed bin (71), (*) fixed bin (71), (*) fixed bin (71), fixed bin);
dcl  random_unit_stat_$seed (1) external fixed bin (71);
dcl  number fixed bin;

	call encipher_ (random_unit_stat_$seed (1), random_unit_stat_$seed, random_unit_stat_$seed, 1);
	number = numbers (mod (abs (fixed (random_unit_stat_$seed (1), 17)), 211));
	return;
random_vowel: entry (number);
	call encipher_ (random_unit_stat_$seed (1), random_unit_stat_$seed, random_unit_stat_$seed, 1);
	number = vowel_numbers (mod (abs (fixed (random_unit_stat_$seed (1), 17)), 12));
	return;

/* This entry returns the probabilities of the 34 units in two arrays.
   The first array contains the probabilities of all units assuming
   the random_unit_ entry was called.  The second array contains the
   probabilities of all units assuming random_vowel was called.
   Of course, there will be a lot of zeros in this second array, since
   most units aren't vowels.

   This entry is used by hyphenate_$probability to find out what the
   probabilities of the different units are.  Hyphenate_ does not know
   how many units there are or what their probabilities are.  It also
   makes no assumption about the unit index - to - letter correspondence
   of the units.  Thus this program can be replaced without changing
   anything in hyphenate_.
*/

probabilities: entry (unit_probs, vowel_probs);
dcl  unit_probs (34) float bin;
dcl  vowel_probs (34) float bin;
dcl  i fixed bin;

	unit_probs, vowel_probs = 0;

/* These probabilities are calculated merely by adding up the number of
   occurances of each of the unit indexes in the numbers array and the
   vowel_numbers array. */

	do i = 0 to 210;
	     unit_probs (numbers (i)) = unit_probs (numbers (i)) + 1;
	     if i < 12
	     then vowel_probs (vowel_numbers (i)) = vowel_probs (vowel_numbers (i)) + 1;
	end;

	unit_probs = unit_probs/211;			/* Normalize these values so they add up to 1.0 */
	vowel_probs = vowel_probs/12;
	return;
     end;




		    random_unit_stat_.alm           11/15/82  1912.6rew 11/15/82  1535.3        3915



" ***********************************************************
" *                                                         *
" * Copyright, (C) Honeywell Information Systems Inc., 1982 *
" *                                                         *
" ***********************************************************
	name  random_unit_stat_
	use   linkc
	join  /link/linkc

	segdef seed
	even
seed:     oct    012345676543,123456765432
	end




		    random_word_.pl1                11/15/82  1912.6rew 11/15/82  1530.2      168102



/* ***********************************************************
   *                                                         *
   * Copyright, (C) Honeywell Information Systems Inc., 1982 *
   *                                                         *
   *********************************************************** */
/* This procedure generates a pronounceable random word of
   caller specified length and returns the
   word and the hyphenated (divided into syllables) form of the word.

   dcl random_word_ entry ((0:*) fixed, (0:*) bit(1) aligned, fixed, fixed, entry, entry);

   call random_word_ (word, hyphens, length, n, random_unit, random_vowel);

   word          random word, 1 unit per array element. (Output)

   hyphens       position of hyphens, bit on indicates hyphen appears after
   corresponding unit in "word". (Input)

   length        length of word to be generated in letters. (Input)

   n             actual length of word in units. (Output)

   random_unit   routine to be called to generate a random unit. (Input)

   random_vowel  routine to be called to generate a random vowel. (Input)

*/

random_word_: procedure (password, hyphenated_word, length, word_length, random_unit, random_vowel);

%include digram_structure;
dcl  debug bit (1) aligned static init ("0"b);		/* set for printout of words that can't be generated */
dcl  password (0:*) fixed bin;
dcl  hyphenated_word (0:*) bit (1) aligned;
dcl  length fixed bin;
dcl  word_length fixed bin;
dcl  number float bin (27);
dcl  nchars fixed;					/* number of characters in password */
dcl  index fixed init (1);				/* index of current unit in password */
dcl  i fixed;
dcl  syllable_length fixed init (1);			/* 1 when next unit is 1st in syllable, 2 if 2nd, etc. */
dcl  cons_count fixed init (0);			/* count of consecutive consonants in syllable preceeding current unit */
dcl  vowel_found aligned bit (1);			/* 1 if vowel was found in syllable before this unit */
dcl  last_vowel_found aligned bit (1);			/* same for previous unit in this syllable */
dcl (first, second) fixed init (1);			/* index into digram table for current pair */
dcl (random_unit, random_vowel) entry (fixed);
dcl  unit fixed bin;
dcl  ioa_$nnl entry options (variable);

	do i = 0 to length;
	     password (i) = 0;
	     hyphenated_word (i) = "0"b;
	end;
	nchars = length;

/* get rest of units in password */

	unit = 0;
	do index = 1 by 1 while (index <= nchars);
	     if syllable_length = 1
	     then
		do;				/* on first unit of a syllable, use any unit */
keep_trying:	unit = abs (unit);			/* last unit was accepted (or first in word), make positive */
		goto first_time;
retry:		unit = -abs (unit);			/* last unit was not accepted, make negative */
first_time:
		if index = nchars			/* if last unit of word must be a syllable, it must be a vowel */
		then call random_vowel (unit);
		else call random_unit (unit);
		password (index) = abs (unit);	/* put actual unit in word */
		if index ^= 1 then if digrams (password (index-1), password (index)).illegal_pair
		     then goto retry;		/* this pair is illegal */
		if rules (password (index)).not_begin_syllable then goto retry;
		if letters_split.second (password (index)) ^= " "
		then
		     if index = nchars
		     then goto retry;
		     else
		     if index = nchars-1 & ^rules (password (index)).vowel & ^rules (password (index)).alternate_vowel
		     then goto retry;		/* last unit was a double-letter unit and not a vowel */
		     else if unit < 0
		     then goto keep_trying;
		     else nchars = nchars - 1;
		else if unit < 0 then goto keep_trying;
		syllable_length = 2;
		if rules (password (index)).vowel | rules (password (index)).alternate_vowel
		then
		     do;
		     cons_count = 0;
		     vowel_found = "1"b;
		end;
		else
		do;
		     cons_count = 1;
		     vowel_found = "0"b;
		end;
		last_vowel_found = "0"b;
	     end;
	     else
	     do;
		call generate_unit;
		if second = 0 then goto all_done;	/* we have word already */
	     end;
	end;

/* enter here at end of word */

all_done:
	word_length = index - 1;
	return;

/* various other entries */

debug_on:	entry;
	debug = "1"b;
	return;

debug_off: entry;
	debug = "0"b;
	return;
						/*
						    */
						/* PROCEDURE GENERATE_UNIT */

/* generate next unit to password, making sure
   that it follows these rules:
   1. Each syllable must contain exactly 1 or 2 consecutive vowels,
   where y is considered a vowel.
   2. Syllable end is determined as follows:
   a. Vowel is generated and previous unit is a consonant and
   syllable already has a vowel.  In this case new syllable is
   started and already contains a vowel.
   b. A pair determined to be a "break" pair is encountered.
   In this case new syllable is started with second unit of this pair.
   c. End of password is encountered.
   d. "begin" pair is encountered legally.  New syllable is started
   with this pair.
   e."end" pair is legally encountered.  New syllable has nothing yet.
   3. Try generating another unit if:
   a. third consecutive vowel and not y.
   b. "break" pair generated but no vowel yet in current syllable
   or previous 2 units are "not_end".
   c. "begin" pair generated but no vowel in syllable preceeding
   begin pair, or both previous 2 pairs are designated "not_end".
   d. "end" pair generated but no vowel in current syllable or in "end" pair.
   e. "not_begin" pair generated but new syllable must begin
   (because previous syllable ended as defined in 2 above).
   f. vowel is generated and 2a is satisfied, but no syllable break is possible in previous 3 pairs.
   g. Second & third units of syllable must begin, and first unit is "alternate_vowel".

   The done routine checks for required prefix vowels & end of word conditions. */

generate_unit: procedure;
dcl 1 x aligned like digrams;
dcl  try_for_vowel bit (1) aligned;
dcl  unit_count fixed init (1);			/* count of tries to generate this unit */
dcl  v bit (1) aligned;
dcl  i fixed;

	     first = password (index-1);

/* on last unit of word and no vowel yet in syllable, or if previous pair
   requires a vowel and no vowel in syllable, then try only for a vowel */

	     if syllable_length = 2			/* this is the second unit of syllable */
	     then try_for_vowel = ^vowel_found & index = nchars; /* last unit of word and no vowel yet, try for vowel */
	     else					/* this is at least the third unit of syllable */
	     if ^vowel_found | digrams (password (index-2), first).not_end
	     then try_for_vowel = digrams (password (index-2), first).suffix;
	     else try_for_vowel = "0"b;
	     goto keep_trying;			/* on first try of a unit, don't make the tests below */

/* come here to try another unit when previous one was not accepted */

try_more:
	     unit = -abs (unit);			/* last unit was not accepted, set sign negative */
	     if unit_count = 100
	     then
		do;
		if debug
		then
		     do;
		     call ioa_$nnl ("100 tries failed to generate unit.^/ password so far is: ");
		     do i = 1 to index;
			call ioa_$nnl ("^a", letters (password (i)));
		     end;
		     call ioa_$nnl ("^/");
		end;
		call random_word_ (password, hyphenated_word, length, index, random_unit, random_vowel);
		second = 0;
		return;
	     end;

/* come here to try another unit whether last one was accepted or not */

keep_trying:
	     if try_for_vowel
	     then call random_vowel (unit);
	     else call random_unit (unit);
	     second = abs (unit);			/* save real value of unit number */
	     if unit > 0 then unit_count = unit_count + 1; /* count number of tries */

/* check if this pair is legal */

	     if digrams (first, second).illegal_pair
	     then goto try_more;
	     else
	     if first = second			/* if legal, throw out 3 in a row */
	     then
		if index >2
		then
		     if password (index-2) = first
		     then goto try_more;
	     if letters_split (second).second ^= " "	/* check if this is 2 letters */
	     then
		if index = nchars			/* then if this is the last unit of word */
		then goto try_more;			/* then a two-letter unit is illegal */
		else nchars = nchars - 1;		/* otherwise decrement number of characters */
	     password (index) = second;
	     if rules (second).alternate_vowel
	     then v = ^rules (first).vowel;
	     else v = rules (second).vowel;
	     x.begin = digrams (first, second).begin;
	     x.not_begin = digrams (first, second).not_begin;
	     x.end = digrams (first, second).end;
	     x.not_end = digrams (first, second).not_end;
	     x.break = digrams (first, second).break;
	     x.prefix = digrams (first, second).prefix;
	     x.suffix = digrams (first, second).suffix;
	     x.illegal_pair = digrams (first, second).illegal_pair;
	     if syllable_length > 2			/* force break if last pair must be followed by a */
	     then					/* vowel and this unit is not a vowel */
		if digrams (password (index-2), first).suffix
		then
		     if ^v then break = "1"b;		/* (if last pair was not_end, new_unit gave us a vowel) */

/* In the notation to the right, the series of letters and dots stands
   for the last n units in this syllable, to be interpreted as follows:
   v stands for a vowel (including alternate_vowel)
   c stands for a consonant
   x stands for any unit
   the dots are interpreted as follows (c is used as example)
   c...c  one or more consecutive consonants
   c..c   zero or more consecutive consonants
   ...c   one or more consecutive consonants from beginning of syllable
   ..c    zero or more consecutive consonants from beginning of syllable
   the vertical line | marks a syllable break.
   The group of symbols indicates what units there are in current
   syllable.  The last symbol is always the current unit.
   The first symbol is not necessarily the first unit in the
   syllable, unless preceeded by dots.  Thus, "vcc..cv" should be
   interpreted as "..xvcc..cv" (i.e., add "..x" to the beginning of all
   syllables unless dots begin the syllable.). */

	     if syllable_length = 2 & not_begin		/* pair may not begin syllable */
	     then goto loop;			/* rule 3e. */
	     if vowel_found
	     then
		if cons_count ^= 0
		then
		     if begin			/* vc...cx */
		     then
			if syllable_length ^= 3 & not_end_ (3) /* vc...cx begin */
			then			/* can we break at vc..c|cx */
			     if not_end_ (2)	/* no, try a break at vc...c|x */
			     then goto loop;	/* rule 3c. */
			     else call done (v, 2);	/* vc...c|x begin, treat as break */
			else call done (v, 3);	/* vc..c|cx begin */
		     else
		     if not_begin			/* vc...cx ^begin */
		     then
			if break			/* vc...cx not_begin */
			then
			     if not_end_ (2)	/* vc...c|x break */
			     then goto loop;	/* rule 3b, can't break */
			     else call done (v, 2);	/* vc...c|x break */
			else
			if v			/* vc...cx ^break not_begin */
			then			/* vc...cv ^break not_begin */
			     if not_end_ (2)	/* try break at vc...c|v */
			     then goto loop;	/* rule 3f, break no good */
			     else call done ("1"b, 2); /* vc...c|v treat as break */
			else
			if end			/* vc...cc ^break not_begin */
			then call done ("0"b, 1);	/* vc...cc| end */
			else call done ("1"b, 0);	/* vc...cc ^break ^end not_begin */
		     else
		     if v				/* vc...cx ^begin ^not_begin */
		     then
			if not_end_ (3) & syllable_length ^= 3 /* vc...cv rule 2a says we must break somewhere */
			then
			     if not_end_ (2)	/* vc..c|cv doesn't work */
			     then
				if cons_count > 1	/* vc...c|v doesn't work */
				then		/* vc...ccv */
				     if not_end_ (4) /* try vc..c|ccv */
				     | digrams (password (index-2), first).not_begin
				     then goto loop; /* rule 3f */
				     else call done ("1"b, 4); /* vc...c|ccv */
				else goto loop;	/* vc...c|v and vc..c|cv are no good */
			     else call done ("1"b, 3); /* vc...c|v treat as break */
			else call done ("1"b, 3);	/* vc..c|cv treat as break */
		     else call done ("1"b, 0);	/* vc...cc ^begin ^not_begin */
		else				/* vowel found and last unit is not consonant => last unit is vowel */
		if v & rules.vowel (password (index-2)) & index > 2
		then goto loop;			/* rule 3a, 3 consecutive vowels non-y */
		else
		if end				/* vx */
		then call done ("0"b, 1);		/* vx end */
		else
		if begin				/* vx ^end */
		then
		     if last_vowel_found		/* vx begin */
		     then
			if v			/* v...vvx begin */
			then
			     if syllable_length = 3	/* v...vvv begin */
			     then
				if rules (password ((index-2))).alternate_vowel /* |vvv begin */
				then goto loop;	/* rule 3g, |"y"|vv is no good */
				else call done ("1"b, 3); /* |v|vv begin */
			     else
			     if not_end_ (3)	/* v...vvv begin */
			     then goto loop;	/* rule 3c, v...v|vv no good */
			     else call done ("1"b, 3); /* v...v|vv begin */
			else
			if syllable_length = 3	/* v...vvc begin */
			then
			     if rules.alternate_vowel (password (index-2)) /* |vvc begin */
			     then goto loop;	/* rule 3g, |"y"|vc is no good */
			     else
			     if rules.vowel (password (index-2)) /* |x|vc begin */
			     then call done ("1"b, 3); /* |v|vc begin */
			     else goto loop;	/* |c|vc begin is illegal */
			else
			if not_end_ (3)		/* v...vvc begin */
			then			/* v...vvc begin try to split pair */
			     if not_end_ (2)	/* v...vvc begin */
			     then goto loop;	/* v...vv|c no good */
			     else call done ("0"b, 2); /* v...vv|c */
			else call done ("1"b, 3);	/* v...v|vc begin */
		     else				/* try splitting begin pair */
		     if syllable_length > 2		/* ..cvx begin */
		     then
			if not_end_ (2)		/* ...cvx begin */
			then goto loop;		/* rule 3c, ...cv|x no good */
			else call done (v, 2);	/* ...cv|x begin */
		     else call done ("1"b, 0);	/* |vx begin */
		else
		if break				/* ..xvx ^begin ^end */
		then
		     if not_end_ (2) & syllable_length > 2 /* ..xvx break */
		     then goto loop;		/* rule 3b, ..xv|x is no good */
		     else call done (v, 2);		/* ..v|x break */
		else call done ("1"b, 0);		/* ..vx ^end ^begin ^break */
	     else
	     if break				/* ...cx */
	     then goto loop;			/* rule 3b, ...c|x break no good */
	     else
	     if end				/* ...cx ^break */
	     then
		if v				/* ...cx end */
		then call done ("0"b, 1);		/* ...cv| end (new syllable) */
		else goto loop;			/* rule 3b, ...cc| end no good */
	     else
	     if v					/* ...cx ^end ^break */
	     then
		if begin & syllable_length > 2	/* ...cv ^end ^break */
		then goto loop;			/* c...c|cv ^end ^break begin, rule 3c */
		else call done ("1"b, 0);		/* ...cv ^end ^break ^begin */
	     else
	     if begin				/* ...cc ^break ^end */
	     then
		if syllable_length > 2		/* ..ccc begin */
		then goto loop;			/* rule 3c, ...ccc begin */
		else call done ("0"b, 3);		/* |cc begin */
	     else call done ("0"b, 0);		/* ..xcc ^end ^break ^begin */

/* ******** return here when unit generated has been accepted ****** */

	     return;

/* ******** enter here when unit generated was good, but we don't want to use it because
   it was supplied as a negative number by random_unit or random_vowel ********* */

accepted_but_keep_trying: if letters_split (second).second ^= " "
	     then nchars = nchars + 1;		/* pretend unit was no good */
	     unit = -unit;				/* make positive to say that it would have been accepted */
	     goto keep_trying;
						/* ******** enter here when unit generated is no good ******* */

loop:	     if letters_split (second).second ^= " " then nchars = nchars + 1;
	     goto try_more;
						/*
						    */
						/* PROCEDURE DONE */

/* this routine is internal to generate_unit because it can return to loop */
/* call done when new unit is generated and determined to be
   legal. Arguments are new values of:
   vf  vowel_found
   mb  syllable_length (number of units in syllable. 0 means increment for this unit)
*/

done:	     procedure (vf, sl);
dcl  vf bit (1) aligned;
dcl  sl fixed;

/* if we are not within first 2 units of syllable, check if
   vowel must precede this pair */

		if sl ^= 2 then if syllable_length ^= 2 then if prefix then if ^rules.vowel (password (index-2))
			     then			/* vowel must precede pair but no vowel precedes pair */
				if vowel_found	/* if there is a vowel in this syllable, */
				then		/* we may be able to break this pair     */
				     if not_end_ (2) /* check if this pair may be treated as break */
				     then goto loop; /* no, previous 2 units can't end */
				     else		/* yes, break can be forced */
				     do;
					call done ("0"b, 2); /* ...cxx or ...cvx */
					return;
				     end;
				else goto loop;	/* no vowel in syllable */

/* Check end of word conditions.  If end of word is reached, then
   1. We must have a vowel in current syllable, and
   2. This pair must be allowed to end syllable
*/

		if sl ^= 1
		then
		     if index = nchars
		     then
			if not_end
			then goto loop;
			else
			if vf = "0"b
			then goto loop;

/* A final "e" may not be the only vowel in the last syllable. */

		if index = nchars
		then
		     if rules (second).no_final_split	/* this bit is on for "e" */
		     then
			if sl ^= 1
			then
			     if rules.vowel (first)	/* e preceded by vowel is ok, however */
			     then;
			     else
			     if ^vowel_found|syllable_length<3 /* otherwise previous 2 letters must be */
			     then goto loop;	/* able to end the syllable */
			     else
			     if unit < 0
			     then goto accepted_but_keep_trying;
			     else sl = 0;
		if unit < 0 then goto accepted_but_keep_trying;
		if v | sl = 1
		then cons_count = 0;		/* this unit is a vowel or new syllable is to begin */
		else
		if sl = 0
		then cons_count = cons_count + 1;	/* this was a consonant, increment count */
		else				/* a new syllable was started some letters back, cons_count gets */
		cons_count = min (sl-1, cons_count+1);	/* incremented, but no more than number of units in syllable */
		if sl = 0
		then syllable_length = syllable_length + 1;
		else syllable_length = sl;
		if syllable_length > 3
		then last_vowel_found = vowel_found;
		else last_vowel_found = "0"b;
		vowel_found = vf;
		if index - syllable_length + 1 ^= nchars
		then hyphenated_word (index - syllable_length + 1) = "1"b;

	     end done;

	end generate_unit;
						/*
						    */
						/* PROCEDURE NOT_END_ */
						/* not_end_(i) returns "1"b when ( password(index-i), password(index-i+1) )
						   may not end a syllable, or when password(index-i+2) may not begin a syllable */

not_end_:	procedure (i) returns (bit (1));
dcl  i fixed;
	     if i = index
	     then return (^rules.vowel (password (1)));
	     if i ^= 1
	     then
		if rules.not_begin_syllable (password (index-i+2)) then return ("1"b);
	     return (digrams (password (index-i), password (index-i+1)).not_end);
	end;

     end;




		    read_table_.pl1                 11/15/82  1912.6rew 11/15/82  1530.3      120087



/* ***********************************************************
   *                                                         *
   * Copyright, (C) Honeywell Information Systems Inc., 1982 *
   *                                                         *
   *********************************************************** */
/* This subroutine compiles the digram table, given a pointer to the
   segment containing the source.  It returns a flag if compiling was
   unsuccessful */

read_table_: procedure (source_table_ptr, bc) returns (bit (1));

dcl  source_table char (1048575) based (source_table_ptr);
dcl  source_table_ptr ptr;
%include digram_structure;
dcl (i, j, k, l) fixed bin;
dcl  errflag bit (1) init ("0"b);
dcl  fatal_flag bit (1) init ("0"b);
dcl  neither_is_vowel bit (1);
dcl  p ptr;
dcl 1 x based (p) like digrams;
dcl  letters_ (0:90) aligned char (2);			/* storage for letters until we know how many units there are */
dcl 1 rules_ (90) aligned like rules;			/* ditto for rules */
dcl  code fixed bin (35);
dcl  flag bit (1);
dcl  char char (1) init (" ");
dcl  bc fixed bin (24);
dcl  bitcount fixed bin (24);
dcl  cleanup condition;
dcl  term_$seg_ptr entry (ptr, fixed bin (35));
dcl  get_group_id_ entry returns (char (32) aligned);
dcl  hcs_$delentry_seg entry (ptr, fixed bin (35));
dcl  hcs_$make_seg entry (char (*), char (*), char (*), fixed bin (5), ptr, fixed bin (35));
dcl (hcs_$add_acl_entries, hcs_$delete_acl_entries) entry
    (char (*), char (*), ptr, fixed bin, fixed bin (35));
dcl 1 acl aligned,
    2 user_name char (32),
    2 modes bit (36),
    2 pad bit (36),
    2 code fixed bin (35);
dcl  null builtin;
dcl  loc fixed init (1);
dcl  end bit (1);
dcl  new_line char (1) init ("
");
dcl  com_err_$suppress_name entry options (variable);
dcl  hcs_$set_bc_seg entry (ptr, fixed bin (24), fixed bin (35));
dcl  get_pdir_ entry returns (char (168) aligned);
dcl  get_wdir_ entry returns (char (168) aligned);
dcl  alm entry options (variable);
dcl  alm_prog based (prog_ptr) char (262144);
dcl  prog_ptr ptr static init (null);
dcl  seg_index init (1) fixed bin;

/* This procedure creates an ALM program containing empty blocks of storage.
   After finding out how many units there are, the size of each of these
   blocks can be determined.  The ALM program is then assembled, and
   segdef's are thus created which point to the beginning of each of
   these blocks.

   The first statement of the ALM program will be:

   equ n,xxxxx

   where xxxxx will be the number of units determined.  The rest of
   the statements are below:  */

dcl  alm_statements (9) char (30) varying init (
     "segdef digrams",
     "segdef n_units",
     "segdef letters",
     "segdef rules",
     "bss n_units,1",				/* n_units fixed bin */
     "bss digrams,(n*n+3)/4",				/* digrams(n_units,n_units) bit(9) */
     "bss letters,n+1",				/* letters(0:n_units) char(2) aligned */
     "bss rules,4*n",				/* 1 rules(n_units) aligned, 2 (b1,b2,b3,b4) bit(1) */
     "end");




dcl  ioa_ entry options (variable);
dcl  ioa_$nnl entry options (variable);

/* check if a dollar sign ends segment */

	if substr (source_table, bc/9 - 1, 1) ^= "$"
	then goto dollar_error;

/* first read all the different letters or pairs to be defined */

	do i = 1 to 90 while (char ^= ";");		/* read until semicolon */
	     char = substr (source_table, loc, 1);
	     loc = loc + 1;
	     if char < "a" | char > "z"
	     then
		do;
		call ioa_$nnl ("alpha character expected");
fatal_error:
		fatal_flag = "1"b;
		goto err;
	     end;
	     substr (letters_ (i), 1, 1) = char;
	     char = substr (source_table, loc, 1);
	     loc = loc + 1;
	     substr (letters_ (i), 2, 1) = " ";
	     if char < "a" | char > "z"
	     then					/* second character is not alphabetic */

try_bits:

		if char = "1" | char = "0" | char = " "
		then				/* second character is a bit */
		     do;
		     rules_ (i).not_begin_syllable = char = "1";
		     char = substr (source_table, loc, 1);
		     loc = loc + 1;
		     if char = "1" | char = "0" | char = " "
		     then				/* another "rules" bit */
			do;
			rules_ (i).no_final_split = char = "1";
			char = substr (source_table, loc, 1);
			loc = loc + 1;
		     end;
		     else				/* no second "rules" bit */
		     do;
			rules_ (i).no_final_split = "0"b;
		     end;
		end;
		else				/* second character is not a bit and not alphabetic */
		rules_ (i).not_begin_syllable, rules_ (i).no_final_split = "0"b;
	     else					/* second character is alphabetic */
	     do;
		substr (letters_ (i), 2, 1) = char;
		char = substr (source_table, loc, 1);
		loc = loc + 1;
		goto try_bits;
	     end;

/* check character following for comma, new_line, or semicolon */

	     if char ^= ";" & char ^= "," & char ^= new_line
	     then
		do;
		call ioa_$nnl ("comma, blank, zero, one, or letter expected");
		goto fatal_error;
	     end;

/* check if this unit is already defined */

	     if i ^= 1
	     then
		do j = 1 to i - 1;
		if letters_ (j) = letters_ (i)
		then do;
		     call ioa_$nnl ("duplicate unit specification ""^a""", letters_ (j));
		     goto fatal_error;
		end;
	     end;

/* set vowel flags */

	     rules_ (i).vowel = letters_ (i) = "a " | letters_ (i) = "e " | letters_ (i) = "i " | letters_ (i) = "o " | letters_ (i) = "u ";
	     rules_ (i).alternate_vowel = letters_ (i) = "y ";
	end;

	if i > 90
	then
	     do;
	     call ioa_ ("Too many units defined");	/* more than 90 units */
	     return ("1"b);
	end;

/* this is the on unit for aborted compilation
   It deletes the temporary segment containing the alm program, and
   deletes the acl entry of digrams that references this process's id. */

	on condition (cleanup)
	     begin;
	     if prog_ptr ^= null
	     then call hcs_$delentry_seg (prog_ptr, code);
	     call hcs_$delete_acl_entries (get_wdir_ (), "digrams", addr (acl), 1, code);
	end;

/* now that we know how many units, we can create the ALM program */

/* first create the source segment in the process directory */

	call hcs_$make_seg ("", "digrams.alm", "", 01010b, prog_ptr, code);
	if prog_ptr = null
	then do;
error_in_alm_prog:
	     call com_err_$suppress_name (code, "digram_table_compiler", "digrams.alm in process directory");
	     return ("1"b);
	end;

	call addline ("equ n," || substr (character (i-1), verify (character (i-1), " "))); /* first line of ALM program */
	do j = 1 to hbound (alm_statements, 1);		/* all the rest of the lines */
	     call addline (alm_statements (j));
	end;

/* set the bit count of the source segment */

	call hcs_$set_bc_seg (prog_ptr, (seg_index - 1)*9, code);
	if code ^= 0 then goto error_in_alm_prog;

/* assemble the ALM program */

	call alm (before (get_pdir_ (), " ") || ">digrams");

/* Hopefully we got no errors.  If we did, we can't tell */
/* Delete the alm program, and set the acl of the object program
   to rw for this process */

	call hcs_$delentry_seg (prog_ptr, code);	/* ignore code */
	prog_ptr = null ();				/* just to be clean */
	acl.user_name = get_group_id_ ();
	acl.modes = "101"b;
	acl.pad = ""b;
	call hcs_$add_acl_entries (get_wdir_ (), "digrams", addr (acl), 1, code);
	if code ^= 0
	then do;
	     call com_err_$suppress_name (code, "digram_table_compiler", "digrams");
	     return ("1"b);
	end;

/* Store stuff into the object segment */

	n_units = i - 1;				/* This is the first reference to the object segment */
	letters (0) = "";
	do i = 1 to n_units;
	     letters (i) = letters_ (i);
	     rules (i) = rules_ (i);
	end;

/* digram table is compiled now */

	do i = 1 to n_units;
	     do j = 1 to n_units;
		p = addr (digrams (i, j));
		x.begin, x.not_begin, x.end, x.not_end, x.break, x.prefix, x.suffix = "0"b;
		char = substr (source_table, loc, 1);
		do while (char = new_line);
		     loc = loc + 1;
		     char = substr (source_table, loc, 1);
		end;
		if char = "$" then do; call ioa_ ("illegal $ -- premature end"); return ("1"b); end;
		if char = " " | char = "1"
		then
		     do;
		     x.begin = char = "1";
		     loc = loc + 1;
		     call next_char_bit;
		     x.not_begin = char = "1";
		     call next_char_bit;
		     x.break = char = "1";
		     call next_char;
		     x.prefix = char = "-";
		end;
		call next_char;
		if char = " " | char = "-" then goto erra;
		if char ^= letters_split (i).first then goto errb;
		call next_letter (i);
		call next_char;
		if char = " " | char = "-" then goto erra;
		if char ^= letters_split (j).first
		then
		     do;

/* in case the second unit of a digram pair specification is illegal,
   this sequence attempts to get in sync again so that messages will not
   be printed indefinitely.  If the first lunit is illegal,
   no attempt is made to get in sync. */
		     k = 1;
errb1:		     do k = max (k, 1) to n_units while (char ^= letters_split (k).first);
		     end;				/* this takes care of skipping some units or duplicating the last unit */
		     if k <= n_units
		     then
			do;
			if letters_split (k).second ^= " "
			then
			     do;
			     char = substr (source_table, loc, 1);
			     if char ^= letters_split (k).second
			     then
				do;
				k = k + 1;
				goto errb1;
			     end;
			end;
			j = k + 1;
		     end;
		     else j = j + 1;		/* if the unit can't be found, assume it's there but spelled wrong */
errb:		     j = j - 1;			/* if there is an extra digram that can't be found, we'll get another message */
		     call ioa_$nnl ("out of order or illegal letter"); goto err;
		end;
		call next_letter (j);
		char = substr (source_table, loc, 1);
		loc = loc + 1;
		if char ^= "," & char ^= new_line & char ^= "$"
		then
		     do;
		     if char ^= " " & char ^= "-" & char ^= "+"
		     then
erra:			do;
			call ioa_$nnl ("alpha character expected");
			goto err;
		     end;
		     if char = "-"
		     then x.suffix = "1"b;
		     else
		     if char = "+"
		     then x.illegal_pair = "1"b;
		     call next_bit;
		     if end then goto loop;
		     x.end = char = "1";
		     call next_bit;
		     if end then goto loop;
		     x.not_end = char = "1";
		     char = substr (source_table, loc, 1);
		     if char ^= new_line & char ^= ","
		     then do; call ioa_$nnl ("end of line expected"); goto err; end;
		     loc = loc + 1;
		end;
loop:
		neither_is_vowel = ^rules.vowel (i) & ^rules.vowel (j) & ^rules.alternate_vowel (i) & ^rules.alternate_vowel (j);
		if (x.begin & (x.not_begin| (x.end & neither_is_vowel)| (^x.not_end & neither_is_vowel)| (x.break & ^rules.vowel (i)))) |
		(rules.not_begin_syllable (j) & x.break) |
		(x.end & (x.not_end| (^x.not_begin & neither_is_vowel)| (x.break & ^rules.vowel (j)))) |
		(x.break & (^x.not_begin & ^rules.vowel (i) | ^x.not_end & ^rules.vowel (j))) |
		(x.begin|x.not_begin|x.end|x.not_end|x.break|x.prefix|x.suffix)&x.illegal_pair
		then
		     do;
		     call ioa_$nnl ("consistency error");
err:		     do k = 1 to loc-1 while (substr (source_table, loc-k, 1) ^= new_line);
		     end;
		     do l = 0 to bc/9-loc while (substr (source_table, loc+l, 1) ^= new_line);
		     end;
		     if ^errflag then
			call ioa_$nnl (" before * on following line");
		     call ioa_ (":^/    " || substr (source_table, loc-k+1, k-1) ||
			"*" || substr (source_table, loc, l));
		     if fatal_flag then return ("1"b);	/* fatal error, can't continue */
		     char = substr (source_table, loc-1, 1);
		     do loc = loc by 1 while (char ^= "," &
			     char ^= new_line & char ^= "$");
			char = substr (source_table, loc, 1);
		     end;
		     errflag = "1"b;
		end;
	     end;
	end;

	call hcs_$delete_acl_entries (get_wdir_ (), "digrams", addr (acl), 1, code);

/* at end of table, make sure "$" follows and terminate segment */

	if substr (source_table, loc, 1) ^= "$"
	then do;
dollar_error:
	     call ioa_ ("$ not found at end of segment");
	     return ("1"b);
	end;
	call term_$seg_ptr (source_table_ptr, code);
	return (errflag);

/* get next letter, space, or "-" */

next_char: procedure;
	     char = substr (source_table, loc, 1);
	     loc = loc + 1;
	     if (char<"a" | char>"z") & char ^= " " & char ^= "-"
	     then do; call ioa_$nnl ("alpha character expected"); goto err; end;
	end;

/* get next space or "1" */

next_char_bit: procedure;
	     char = substr (source_table, loc, 1);
	     if char ^= " " & char ^= "1"
	     then
		do;
		call ioa_$nnl ("space or 1 expected");
		goto err;
	     end;
	     loc = loc + 1;
	end;

/* get next space, "1", ",", or new_line */

next_bit:	procedure;
	     char = substr (source_table, loc, 1);
	     string (end) = "0"b;			/* fool indent */
	     loc = loc + 1;
	     if char ^= " "
	     then
		if char = "," | char = new_line
		then end = "1"b;
		else
		if char ^= "1"
		then
		     do;
		     call ioa_$nnl ("space, 1, comma, or new line expected");
		     goto err;
		end;
	end;

/* get next letter if this unit is a 2-letter unit */

next_letter: proc (i);
dcl  i fixed bin;
	     if letters_split (i).second ^= " "
	     then
		do;
		call next_char;
		if char ^= letters_split (i).second
		then
		     do;
		     call ioa_$nnl ("""" || letters_split (i).second || """ expected");
		     goto err;
		end;
	     end;
	end;

/* Add a line to ALM program */

addline:	proc (string);
dcl  string char (30) varying;
	     substr (alm_prog, seg_index, length (string) + 1) = string || "
";
	     seg_index = seg_index + length (string) + 1;
	end;

     end;




		    bull_copyright_notice.txt       08/30/05  1008.4r   08/30/05  1007.3    00020025

                                          -----------------------------------------------------------


Historical Background

This edition of the Multics software materials and documentation is provided and donated
to Massachusetts Institute of Technology by Group Bull including Bull HN Information Systems Inc. 
as a contribution to computer science knowledge.  
This donation is made also to give evidence of the common contributions of Massachusetts Institute of Technology,
Bell Laboratories, General Electric, Honeywell Information Systems Inc., Honeywell Bull Inc., Groupe Bull
and Bull HN Information Systems Inc. to the development of this operating system. 
Multics development was initiated by Massachusetts Institute of Technology Project MAC (1963-1970),
renamed the MIT Laboratory for Computer Science and Artificial Intelligence in the mid 1970s, under the leadership
of Professor Fernando Jose Corbato.Users consider that Multics provided the best software architecture for 
managing computer hardware properly and for executing programs. Many subsequent operating systems
incorporated Multics principles.
Multics was distributed in 1975 to 2000 by Group Bull in Europe , and in the U.S. by Bull HN Information Systems Inc., 
as successor in interest by change in name only to Honeywell Bull Inc. and Honeywell Information Systems Inc. .

                                          -----------------------------------------------------------

Permission to use, copy, modify, and distribute these programs and their documentation for any purpose and without
fee is hereby granted,provided that the below copyright notice and historical background appear in all copies
and that both the copyright notice and historical background and this permission notice appear in supporting
documentation, and that the names of MIT, HIS, Bull or Bull HN not be used in advertising or publicity pertaining
to distribution of the programs without specific prior written permission.
    Copyright 1972 by Massachusetts Institute of Technology and Honeywell Information Systems Inc.
    Copyright 2006 by Bull HN Information Systems Inc.
    Copyright 2006 by Bull SAS
    All Rights Reserved
