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 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 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