' JJJJ ?\>' L-=l>  ԠéԠˠ#~?  xDIR ERA TYPESAVEREN USERY!yO#< Ty#O 3ǯ21y_͸2y2ͽ:ķ˜1͘A͌>>͌92^ :˷¥.!_~#fow]ɭʎʥ!v"!çREAD ERRORçNO FILE^:˷#͘*~ "Ʒ"͌#>?͌͘ =_.:;<> Oƅo$>!Y2*O"ʉ@G:ʐ:wÖx2p0ʹ#*©6?ëw˜0ï#6 ¹.0#*6?w0#6 #6"  Ň!˶2:2a{_:˷ʖ:˷>Ľʖ:=2–!B!6#5ʖ:˷Ľ!ͬʧ )!F#xʺ~0wëw!" !~6ͽ:ý(!\X COPYRIGHT (C) 1979, DIGITAL RESEARCH _͌> ͒> Ò> Ò͘~#͌ì _2<į2: :):>:(y2E!|"*wɍ`JX)^>EE??++ ԩ  [\ ĭ ?  JL ``LLL $Lq<`ΧԠĠڸčԠԠ͠Ԡ؍2>o:= gw8H<8H=` }Hx / hJ Leh<> > @A @A>i =<>+ LeÍڍh@(L>*// -П( ( $8` %  ZNx`. }x$50x.$50xL JJJJ`Hjf5 }h $50x`  Ȍ` Hx  -(hL(h8֩`Lx (`H݌hHhHh݌>?F؅G(jf5(  ;  R( FGj 0x j $xxH` ( Rh RL.xxH h  !"#$%&'()*+,-./0123456789:;<=>?x&& 8 , P ; ' / \ ; & ; x)*++`FGG8`0($ p,&" cI꽌ɪVɭ&Y & &Y &   꽌ɪ\8`&&꽌ɪɖ'*&%&,E'зЮ꽌ɪФ`V0 ^ *^ *>`+*xS&x'8*3IxiU ,>J>V J>V `8'x0| &HhHh V Y V '&Y V x ꪽV ' `Hh` ! ~ 3#0 Wx x ƀ Ƃ G ~ # 3x~#B!Y~ɯ2:˷=!˾ý:˷=!˾:ý^T!~  6?#ˆ:`O> K{͘A͒>:͒͢>:͒͢xK > K > ͒x  ͢ØÆ^ BRͧ9!5‚#~Y‚#"T<ÆALL (Y/N)?^ Tʧ͘!6!~ڇ ɯw4!Y~ʆ͌†t=ʆf ^ T ɯ2o&)|+!<ͧЯ2*C!!~~#~O~G#n,-.‹! w! yG!x͢.:E<ʄ! q!pQ:E<. ʄ$.:E<ʄi6}2ExN! ~态O>G~G!~G} *C!r#r#r ^ͥ_y#x#{2>2T*CGͻ:ẅ́n>2;O ^DM;}H>"*C :ٷ:ddslO s#r:EϷ͊:==»y==»*Ww#*"͸*:G#š"͸:!پw4!iw:Z!E~=26 w ~>2!E5T*C!"C"C!w# F! w͌xѯ2͢*C ~<wʃG:٠!٦ʎì 4~ʶ¬:<ʶ$ʶïZͻЯx>2>2ͻ:!پZկ2:EϷẅ́͊Ͳ> *C ^OT *C~wD -'  -@ͦ~^*C Ox! N!Fwyxʋ>ڋ>*Cw~#+w#w+ɯ2E22i^ *C :ٷ~w~͔͔# # ::/GyO>2!q*C"͡ʔ*JҔ^:Oyʃ?|x | sӖ-|N-# S:2E!~Яw>T D^6k-äPYy 5*{zBK5:AϾ#~$=2Ek͌ ):BO!yoxg*:BO}!N#F "*#*s#r^ ~!J! J*:مo$*C~i6iw**{#zr+s{ozg**͕** Ѿ,w͜͸Ͳ!!N#F$**O!~#O: \зSЀ*C :ٷqn& ^#V>O^"*}:*)=":O:١o"*C *C!ͮ~2~2ͦ:٦2ͮ:ЯO:فw:w |g}o*ٯ# 2E>! ^#V w#P:BO|^#V#"##"##"##"!O*!O*|!6ʝ6>گ*w#w*w#w'û*ڷ! J*""!N#F*^#V*~#foyx*{_zW+*x: 2 p&x~+é7ͯ2 H! >w_: ! Ͼ5ͤNkͱ¦ͱxʊ#Nx: Ϸ! ϖ2 ͤ! 5™#wO~x½p Hy<< ڷʑ :!qMD# O͐  :ϷE B 2>: Ϸb# : Ϸy! 4 5~yy5 6yҐ^H@Oy H H: –ͬ  #H: ! Ͼ Hù H H $O͐: 2 *CN# ʽY̙̥̫̱"C{2!"E9"1Aϯ22!ty)K!G_^#V*Cΐ~؃E؜إث ,&-AGMSϛ!!ô!ô!Bdos Err On : $Bad Sector$Select$File R/O$:BA2!~6=qf^!~2>`~2˯2\!!B!~> >#0~O#Cx2͘1)ͽÂf zͧÆBAD LOADCOMf^: !˶ Â$$$ SUBÆNO SPACE^ :Ty!B*O=?_s#"^sG!~Yʸpsp2mÆÆf ͧÆFILE EXISTS _: É: :˷ʉ=2)ͽÉ T!@k!}|qs+p+q-*C ͥ!!q#p#w*:BOYG}*MD "ã:!BϾw!>2*C~=2u:B2~2wE:A*C϶w>"!""ٯ2B!"!rQQQâ~?ͦ~?rQ*"CQ-Q͜QüQrQ$Q*):B"*)*)Q;*"E:;:A2AQÓQÜQ*C}/_|/*٤W}_*"}o|g":ٷʑ*C6:ٷʑw:2E**E}DQ>2C0T"I !>"H>2J: !͢:d::d!s~B#1!P!J߇o~,foɷp:BB Apple ][ CP/M 56K Ver. 2.20B (C) 1980 Microsoft ;ۯ2>EE??++B#1!P!J߇o~,foɷp;ۯ2:޷;ۯ2e ]~6(*} *:޽ y(3:޷s:2G<2x/a2:oa":޷zޯ2{![:޷ <2:>sɯ2>!>2!;:*     1>2>2*"?ۯ2:08 !"Y"BT"->2:8Y"/:8Y"F~!xq!;`~0,~!M;!x~1.~8[q>:޷ 2y2!!{o!:=8 ~y!3w.y2Cɯ2>!w#w#wOa."y .:g"*"!~((5:# :*޽ :޼ $| 8g,"ޯ2!"_!ޅoN!޷((+! ~O#O:x >2ޯ2:޷*(*D*:wk*(:$_"~28 ?@wx( !;!܅ony 2$8!2E!y>>?22!ɯog"$2E!.B...X&*}(8.|8&"$պ`~(,qy2E[22G: 2:O*:P!O#~#'۹~y/:02?"2O: K*:*(0**:8'(*:08* *: 8(*7!w˹#~(=5:!( +_ywɷ+ͱ*:]lc_O{- OMG!~_ :( 6>83! ~èCfuÇKmVÉÎÓãݯ`iޓښ:ޓڦJޓڲZޓھjޓzޓߊ / !~ `66= !; !{g1:Q!͢گ22>2!"2!"͎>2OPTIMISTPLI ACK PLIDUMP PLIFIB PLINET PLI0 REPORT PLI FACT PLIEPOLY PLItive (1:nwords) char(10) var static initial (' always',' all',' something','',' some'), upper char(28) static initial ('ABCDEFGHIJKLMNOPQRSTUVWXYZ. '), lower char(28) static initial ('abcdefghijklmnoMACASM PLI"-./01CHESS PLI23456789:;<=>?@ACHESS PLIbBCDEFGHIJKLMNMATSIZE LIBOINVERT2 PLIPNETASM PLI2QRSTUVWREV PLI XYPOLY PLIZ put list('Actually,'!!sent); put skip; end; end optimist; Y+:+*W~ ڤ*#"9 ~ ¸6+#" !    w!a4DIORAND PLIRECORD DCLUPDATE PLIENTER PLI GRADE PLIKEYFILE PLIDIOMOD DCLACKTST PLI ength(sent)) ^= '.'); get list (word); sent = sent !! ' ' !! word; end; sent = translate(sent,lower,upper); if verify(sent,lower) ^= 0 then sent = ' that''s an interesting idea.'; pqrstuvwxyz. '); dcl sent char(254) var, word char(32) var; dcl (i,j) fixed; do while(true); put skip list('What''s up? '); sent = ' '; do while (substr(sent,lDPOLY PLI[MATSIZ LIB\FCB DCL]DIOCOPY PLI^_`ACK RELaDUMP RELboptimist: proc options(main); %replace true by '1'b, false by '0'b, nwords by 5; dcl negative (1:nwords) char(8) var static initial (' never',' none',' nothing',' not',' no'), posiPLANT2 EMPPLANT1 EMP ALLTST PLI!INVERT1 PLI"#RANDOM PLI $%DFACT PLI&TITLE PLI('()*+FFACT PLI, do i = 1 to nwords; j = index(sent,negative(i)); if j ^= 0 then sent = substr(sent,1,j-1) !! positive(i) !! substr(sent,j+length(negative(i))); end; ack: procedure options(main,stack(2000)); dcl (m,maxm,n,maxn) fixed; put skip list('Type max m,n: '); get list(maxm,maxn); put skip list(' ',(decimal(n,4) do n=0 to maxn)); do m = 0 to maxm; proc; dcl dist fixed, (city1, city2) char(citysize) var; on endfile(sysin) go to eof; city_head = null; put skip list('Type "City1, Dist, City2"'); put skip; do while( return(1); return(fib(n-1) + fib(n-2)); end fib; end fibonacci;  stop; do while('1'b); read file(input) into(ibuff); do i = 1 to length(ibuff); ize) var, 2 total_dist fixed, 2 investigate bit, 2 city_list ptr, 2 route_head ptr; dcl 1 route_node based, 2 next_city ptr, 2 route_dist fixed, 2 route_list put skip list(decimal(m,4),':'); do n = 0 to maxn; put list(decimal(ackermann(m,n),4)); end; end; stop; ackermann: procedure(m,n) returns(fixed) recursive; dcl (m,n) fixed; dump: proc options(main); /* dump file in hex at terminal */ dcl sysprint file, input file; dcl bit(254) bit(8), c char, i fixed, ibuff char(254) varying; open file(input) strea ptr; dcl city_head ptr; do while(true); call setup(); if city_head = null then stop; call print_all(); call print_paths(); call free_all(); end; setup: fibonacci: proc options(main); dcl i fixed; do i = 0 to 100; put list(fib(i)); end; fib: proc(n) returns(fixed) recursive; dcl n fixed; if n = 0 then return(1); if n = 1 then if m = 0 then return(n+1); if n = 0 then return(ackermann(m-1,1)); return(ackermann(m-1,ackermann(m,n-1))); end ackermann; end ack; graph: proc options(main); %replace true by '1'b, false by '0'b, citysize by 20, infinite by 32767; dcl sysin file; dcl 1 city_node based, 2 city_name char(citys c = substr(ibuff,i,1); bit(i) = unspec(c); end; put edit((bit(i) do i = 1 to length(ibuff))) (b4(2)); end; end dump; m title('$1.$1'); open file(sysprint) stream output linesize(78) pagesize(0) title('$con'); on endfile(input) stop; do while('1'b); read file(input) into(ibuff); do i = 1 to length(ibuff); true); get list(city1, dist, city2); call connect(city1, dist, city2); call connect(city2, dist, city1); end; eof: end setup; connect: proc(source_city, dist, dest_city); (t, d) fixed; p = find(city); do while(true); t = p->total_dist; if t = infinite then do; put skip list('(No Connection)'); return; city char(citysize) var; dcl bestp ptr, (d, bestd) fixed, (p, q, r) ptr; do p = city_head repeat(p->city_list) while(p^=null); p->total_dist = infinite; var; dcl (p, q) ptr; do p = city_head repeat(p->city_list) while(p^=null); if city = p->city_name then return(p); end; allocate city_node set(p); repeat(q->route_list) while(q^=null); r = q->next_city; d = bestd + q->route_dist; if d < r->total_dist then do; r->total_dist = d; while(true); put skip list('Type Destination '); get list(city); call shortest_dist(city); on endfile(sysin) go to eol; do while(true); put skip list('Type Start '); dcl source_city char(citysize) var, dist fixed, dest_city char(citysize) var; dcl (r, s, d) ptr; s = find(source_city); d = find(dest_city); allocate route_ repeat(p->city_list) while(p^=null); if p->investigate then do; if p->total_dist < bestd then do; bestd = p->total_dist; p->investigate = false; end; p = find(city); p->total_dist = 0; p->investigate = true; do while(true); bestp = null; bestd = infinite; do p = city_head p->city_name = city; p->city_list = city_head; city_head = p; p->total_dist = infinite; p->route_head = null; return(p); end find; print_all: proc; dcl (p, r->investigate = true; end; end; end; end shortest_dist; print_route: proc(city); dcl city char(citysize) var; dcl (p, q) ptr, get list(city); call print_route(city); end; eol: revert endfile(sysin); end; eof: end print_paths; shortest_dist: proc(city); dcl node set (r); r->route_dist = dist; r->next_city = d; r->route_list = s->route_head; s->route_head = r; end connect; find: proc(city) returns(ptr); dcl city char(citysize) bestp = p; end; end; end; if bestp = null then return; bestp->investigate = false; do q = bestp->route_head ,'miles to', q->next_city->city_name); end; end; end print_all; print_paths: proc; dcl city char(citysize) var; on endfile(sysin) go to eof; do q) ptr; do p = city_head repeat(p->city_list) while(p^=null); put skip list(p->city_name,':'); do q = p->route_head repeat(q->route_list) while(q^=null); put skip list(q->route_dist end; if t = 0 then return; put skip list(t,'miles remain,'); q = p->route_head; do while(q^=null); p = q->next_city; d = q->route_dist; while (substr(buff,i,1) = ' '); end; i = i - 1; substr(buff,1,i) = substr(dashes,1,i); write file (repfile) from(buff); end; end report; _list) while(q^=null); free q->route_node; end; free p->city_node; end; end free_all; end graph;  free p->city_node; eif i = 0 then return (1); return (i * fact(i-1)); end fact; end f; , 2 hours fixed dec(5,1); dcl dashes character(15) static initial ('$--------------epfile) stream print title('$2.$2') environment(b(2000)); put list('Set Top of Forms, Type Return'); get skip; do while('1'b); read file(empfile) into(employee); if name = 'EOF' then stop; if t = d + p->total_dist then do; put list(d,'miles to',p->city_name); q = null; end; else q = q->route_list; end; endreport: procedure options(main); dcl 1 employee static, 2 name character(30) varying, 2 addr, 3 street character(30) varying, 3 city character(10) varying, 3 state cha put file(repfile) skip(2); buff = '[' !! name !! ']^m^j'; write file(repfile) from (buff); grosspay = wage * hours; withhold = grosspay * .15; buff = grosspay - withhold; do i = 1 to 15 ; end print_route; free_all: proc; dcl (p, q) ptr; do p = city_head repeat(p->city_list) while(p^=null); do q = p->route_head repeat(q->routef: proc options(main); dcl i fixed; do i = 0 repeat(i+1); put skip list('factorial(',i,')=',fact(i)); end; stop; fact: procedure(i) returns(fixed) recursive; dcl i fixed; , buff character(20) varying; dcl i fixed, (grosspay, withhold) fixed dec(7,2); dcl (repfile, empfile) file; open file(empfile) keyed env(f(100),b(4000)) title ('$1.EMP'); open file(rracter(7) varying, 3 zip fixed dec(5), 2 age fixed dec(3), 2 wage fixed dec(5,2), 2 hours fixed dec(5,1); dcl dashes character(15) static initial ('$--------------')poly: procedure options(main); /* evaluate polynomial */ %replace false by '0'b, true by '1'b; dcl (x,y,z) float binary; dcl eofile bit(1) static initial(false), sysin file; then do; if close(addr(database)) = -1 then put skip list('Read/Only'); stop; end; end; end diorand;  do; put skip list('Bad Drive Name'); stop; end; fn = substr(fn,i+1); end; /* get file name and optional type */ i = index(fn,'.'); if i = 0 then do; /* no file type specified, use .DAT */ fname = fn; ftype = 'DAT'; = rdran(addr(database)); if code = 0 then do; if bitbuf(1) = '00'b4 then put skip list('Zero Record'); else put skip list(buffer); end; else put skip list('Return Code',code); end; else if mode = 1 thesion 2'); stop; end; put skip list('Zero Record Fill?'); get list(c); zerofill = (c = 'Y' ! c = 'y') & substr(version,9,8) >= '22'b4; /* read and process file name */ put skip list('Data Base Name: '); get list(fn); fn = translate( on endfile(sysin) eofile = true; do while(true); put skip(2) list('Type x,y,z: '); get list(x,y,z); if eofile then stop; put skip list(' 2'); put skip list(' x do; put skip list('No Directory Space'); stop; end; end; else do; call filsiz(addr(database)); put skip list('File Size:',rrec,' Records'); end; /* main processing loop */ do while('1'b); call setrec(addr(database)) end; else do; fname = substr(fn,1,i-1); ftype = substr(fn,i+1); end; /* clear the extent field */ fext = 0; if open(addr(database)) = -1 then do; put skip list('Creating New Database'); if make(addr(database)) = -1 then diorand: proc options(main); /* random access tests for 2.0 and 2.2 */ %include 'diomod.dcl'; dcl 1 database, %include 'fcb.dcl'; dcl lower char(26) static initial ('abcdefghijklmnopqrstuvwxyz'), upper char(26) static initial n do; put skip list('Data: '); get list(buffer); if zerofill then code = wrranz(addr(database)); else code = wrran (addr(database)); if code ^= 0 then put skip list('Return Code',code); end; else if mode = 2fn,upper,lower); /* process optional drive prefix */ i = index(fn,':'); if i = 0 then drive = 0; else if i = 2 then do; /* convert character to drive code */ drive = index(upper,substr(fn,1,1)); if drive = 0 ! drive > 16 then + 2y + z =',p(x,y,z)); end; p: proc (x,y,z) returns (float binary); dcl (x,y,z) float binary; return (x * x + 2 * y + z); end p; end poly; ; put skip list('Current Record',rrec); put skip list('Read(0),Write(1),Quit(2)? '); get list(mode); if mode < 2 then do; put skip list('Record Number? '); get list(rrec); rovf = 0; end; if mode = 0 then do; code / bitbuf (128) bit(8) based(dbuff()), buffer char(127) var based(dbuff()); put skip list('Random Access Test'); /* check version number for 2.0 */ version = vers(); if substr(version,9,8) < '20'b4 then do; put skip list('You Need Ver ('ABCDEFGHIJKLMNOPQRSTUVWXYZ'); dcl /* simple variables */ i fixed, fn char(20), c char(1), code fixed(7), mode fixed(2), zerofill bit(1), version bit(16); dcl /* overlays on default buffer * dcl 1 record, 2 name character(30) varying, 2 addr character(30) varying, 2 city character(20) varying, 2 state character(10) varying, 2 zip fixed decimal(6), 2 phone chara initial(00000); dcl emp file; open file(emp) keyed output environment(f(100),b(8000)) title ('$1.EMP'); do while(true); put list('Employee: '); get list(name); if name = 'EOF' then Address: ', street, city, state, zip); put skip list(' '); get list(street, city, state, zip); put list('Hours:',hours,': '); get list(hours); char(10) varying, 3 state char(7) varying, 3 zip fixed dec(5), 2 age fixed dec(3), 2 wage fixed dec(5,2), 2 hours fixed dec(5,1); dcl 1 default static, y'); do i = 1 to 100 while(^eolist); get file(keys) list(keyname(i),keyval(i)); eolist = keyname(i) = 'EOF'; end; do while('1'b); put skip list('Employee: '); get list(matchname); cter(12) varying;  code fixed(7), mode fixed(2), zerofill bit(1), version bit(16); dcl /* overlays on default buffer write file(emp) from (employee) keyfrom(keyval(i)); end; end; end; end update; update: proc options(main); dcl 1 employee static, 2 name char(30) var, 2 addr, 3 street char(30) var, 3 city char(10) var, 3 state char(7) var, 3 zip f 2 street char (30) varying initial('(no street)'), 2 city char(10) varying initial('(no city)'), 2 state char(7) varying initial('(no st)'), 2 zip fixed dec(5) if matchname = 'EOF' then stop; do i = 1 to 100; if matchname = keyname(i) then do; read file(emp) into(employee) key(keyval(i)); put skip list('enter: proc options(main); %replace true by '1'b, false by '0'b; dcl 1 employee static, 2 name char(30) varying, 2 addr, 3 street char(30) varying, 3 city d binary; dcl (i, endlist) fixed, eolist bit(1) static initial('0'b), matchname char(30) var; open file(emp) update direct env(f(100)) title ('$1.EMP'); open file(keys) stream env(b(4000)) title('$1.keixed dec(5), 2 age fixed dec(3), 2 wage fixed dec(5,2), 2 hours fixed dec(5,1); dcl (emp, keys) file; dcl 1 keylist (100), 2 keyname char(30) var, 2 keyval fixe do; call write(); stop; end; addr = default; put list (' Age, Wage: '); get list (age,wage); hours = 0; call write(); end; write: proced entry returns (bit(16)), reset entry, select entry (fixed(7)), open entry (ptr) returns (fixed(7)), close entry (ptr) returns (fixed(7)), sear entry (ptr) returns (fixed(7)), searn entry returns (fixe env(f(100),b(10000)) file(input); open file (keys) stream output linesize (60) title('$1.key'); do while('1'); read file(input) into(employee) keyto(k); put skip list(k,name); put file(keys) list(naboot entry, rdcon entry returns (char(1)), wrcon entry (char(1)), rdrdr entry returns (char(1)), wrpun entry (char(1)), wrlst entry (char(1)), coninp entry returns (char(1)), conout ure; write file(emp) from(employee); end write; end enter; st(street, city, state, zip); put list('Hours:',hours,': '); get list(hours); me,k); if name = 'EOF' then stop; end; end keypr; no city)'), 2 state char(7) varying initial('(no st)'), 2 zip fixed dec(5) average: proc options (main); /* grade averaging program */ dcl sysin file, (grade,total,n) fixed; on error (1) /* conversion */ begin; put skip list('Bad Value, Try Again.'); get skip; go to retry; end; on endfile (entry (char(1)), rdstat entry returns (bit(1)), getio entry returns (bit(8)), setio entry (bit(8)), wrstr entry (ptr), rdbuf entry (ptr), break entry returns (bit(1)), vers keypr: proc options(main); /* create key from employee file */ dcl 1 employee static, 2 name char(30) varying; dcl (input, keys) file; dcl k fixed; open title('$1.emp') keyed dcl memptr entry returns (ptr), memsiz entry returns (fixed(15)), memwds entry returns (fixed(15)), dfcb0 entry returns (ptr), dfcb1 entry returns (ptr), dbuff entry returns (ptr), re = total + grade; n = n + 1; end; end average; no city)'), 2 state char(7) varying initial('(no st)'), 2 zip fixed dec(5) sysin) begin; if n ^= 0 then put skip list ('Average is',total/n); stop; end; put skip list ('Type a List of Grades, End with Ctl-Z'); total = 0; n = 0; retry: put skip; do while('1'b); get list (grade); totald(7)), delete entry (ptr), rdseq entry (ptr) returns (fixed(7)), wrseq entry (ptr) returns (fixed(7)), make entry (ptr) returns (fixed(7)), rename entry (ptr), logvec entry returns (bit(16)), curdsk entry EOFgmirezer (no street) (no city) (no st)#0 if m = 0 then return(n+1); if n = 0 then return(ackermann(m-1,1)); return(ackeEggbertther (no street) (no city) (no st)EP Willowander (no street) (no city) (no st)'P ncalls = ncalls + 1; curstack = stksiz(); if curstack > stacksize then stacksize = curstack; if m = 0 then return(n+1); if n = 0 then return(ackermann(m-1,1)); return(ackereturns (fixed(7)), setdma entry (ptr), allvec entry returns (ptr), wpdisk entry, rovec entry returns (bit(16)), filatt entry (ptr), getdpb entry returns (ptr), getusr entry returns (fixack: procedure options(main,stack(2000)); dcl (m,n) fixed, (maxm,maxn) fixed, ncalls decimal(6), (curstack, stacksize) fixed, stksiz entry returns(fixed); put skip list('Type max m,n: '); g Millywatzer (no street) (no city) (no st)' Quagmirezer (no street) (no city) (no st)#0rmann(m-1,ackermann(m,n-1))); end ackermann; end ack;  entry (ptr) returns (fixed(7)), rename entry (ptr), logvec entry returns (bit(16)), curdsk entry ed(7)), setusr entry (fixed(7)), rdran entry (ptr) returns (fixed(7)), wrran entry (ptr) returns (fixed(7)), filsiz entry (ptr), setrec entry (ptr), resdrv entry (bit(16)), wrranz entry (ptr) returns (fixed(7)); Abercrombie (no street) (no city) (no st)%p Fairweather (no street) (no city) (no st)2ncalls,' Calls,',stacksize,' Stack Bytes') (skip,a,2(f(2),a),f(6),f(7),a,f(4),a); end; end; stop; ackermann: procedure(m,n) returns(fixed) recursive; dcl (m,n) fixed; et list(maxm,maxn); do m = 0 to maxm; do n = 0 to maxn; ncalls = 0; curstack = 0; stacksize = 0; put edit ('Ack(',m,',',n,')=',ackermann(m,n), Abercrombie (no street) (no city) (no st)%pg Fairweather 345-W-8th#304 Bloomberg Wao st)U42 ('abcdefghijklmnopqrstuvwxyz'); dcl invert entry ((maxrow,maxcol) float(24), fixed(6), fixed(6)); put list('Solution of Simultaneous Equations'); do while(true); put skip(2) list('Type rows, colEOFgmirezer (no street) (no city) (no st)#0 if m = 0 then return(n+1); if n = 0 then return(ackermann(m-1,1)); return(ackeSolutions:'); do i = 1 to n; put skip list(substr(var,i,1),'='); put edit((mat(i,j) do j = 1 to m-n)) (f(8,2)); end; put skip(2) list('Inverse Matrix isEggbertther (no street) (no city) (no st)EP Willowander (no street)w (no city) (no st)'Ptrix of Coefficients'); put skip; do i = 1 to n; put list('Row',i,':'); get list((mat(i,j) do j = 1 to n)); end; put skip list('Type Solution Vectors'); umns: '); get list(n); if n = 0 then stop; get list(m); if n > maxrow ! m > maxcol then put skip list('Matrix is Too Large'); else do; put skip list('Type Maalltst: proc options(main); /* assembly language interface to dynamic storage allocation module */ dcl totwds returns(fixed(15)), maxwds returns(fixed(15)), allwds entry(fixed(15)) returns(ptr); dcl allreq fixed(15), memptr ptr, '); do i = 1 to n; put skip edit ((mat(i,j) do j = m-n+1 to m)) (x(3),6f(8,2),skip); end; end; end; end inv; inv: procedure options(main); %replace true by '1'b, false by '0'b; %include 'matsize.lib'; dcl mat(maxrow,maxcol) float (24); dcl (i,j,n,m) fixed(6); dcl var char(26) static initial Millywatzer 345 6th St) Mipviley) Ca. st)D ' Quagmirezer 321 W Q st) Quincyty) Ca. st)" #0t put skip; do j = n + 1 to m; put list('Variable',substr(var,j-n,1),':'); get list((mat(i,j) do i = 1 to n)); end; call invert(mat,n,m); put skip(2) list('lwds(allreq); put edit('Allocated',allreq, ' Words at ',unspec(memptr)) (skip,a,f(6),a,b4); /* clear memory as example */ do meminx = 0 to allreq-1; memory(meminx) = '0000'b4; end; end; end alltst;  meminx fixed(15), memory (0:0) bit(16) based(memptr); do while('1'b); put edit (totwds(),' Total Words Available', maxwds(),' Maximum Segment Size', 'Allocation Size? ') (2(skip,f(6),a),skip,a); get list(allreq); memptr = alrandom: procedure options(main); /* test random number generator */ %replace dseed by 899, /* default seed */ clear by '^z', /* clear screen character */ width by 70, /* histogram width */ nslots by 20; /* length of histogram */ a comma, if default values are to be used), along * * with the name of a file which, in turn, lists the names of * * files to be scanned. This file, called the command file, * * is read with a GET LIST statement, and normally contains the * * nathen return (1); return (decimal(i,15) * fact(i-1)); end fact; end f;  RAND Calls: '); get list(max); put list('Seed Value (or comma) '); xseed = dseed; get list(xseed); do k = lbound(sogram(); end; call histogram(); stop; histogram: procedure; dcl largest decimal, (i, j) fixed; largest = 0; do i = lbound(slot,1) to hbound(slot,1); if slot(i) > largest then largest = slot(i); end; if largeor headings of the form: * * aa.bb.cc.ee. xxxxxxxxxxxxxxxxxxxxxxx. * * where aa through ee represent one or more heading digits * * and xxxxx represents a heading title, optionally followed by * * a period. Heading dcl xseed fixed static initial(899); dcl k fixed, (n, max) decimal, slot(nslots) decimal; put list('Number of RAND Calls: '); get list(max); put list('Seed Value (or comma) '); xseed = dseed; get list(xseed); do k = lbound(slost = 0 then return; put skip list(clear,'Largest Value',largest); if largest < width then largest = width; do i = lbound(slot,1) to hbound(slot,1); put edit(slot(i), ('*' do j = 1 to slot(i)*width/largest)) (skip,f(7),x(1),ws of the form: * * aa. XXXXXXXXXX * * are taken as chapter titles, and are preceded by a blank * * line. The operator enters the page size and starting page * * number (orf: proc options(main); dcl i fixed; do i = 0 repeat(i+1); put skip list('Factorial(',i,')=',fact(i)); end; stop; fact: proc (i) returns(fixed dec(15,0)) recursive; dcl i fixed; dcl f fixed dec(15,0); if i = 0 t,1) to hbound(slot,1); slot(k) = 0; end; do n = 1 to max; k = rand(xseed) * nslots + 1; if k < lbound(slot,1) | k > hbound(slot,1) then put skip list(k,'Out of Range'); slot(k) = slot(k) + 1; if mod(n,100) = 0 then call histtitle: proc options(main); /*************************************************************** * This program prepares a title page from a series of print * * files constructed using the TEX Text formatter. This program* * scans the files, looking fidth(a)); end; end histogram; rand: proc (seed) returns(float); dcl seed fixed; seed = seed * 899; unspec(seed)=unspec(seed) & '7FFF'b4; return (float(seed)/32768.); end rand; end random; mes of TEX files with the extension PRN. The output from * * this program appears as: * * 10. MAJOR TITLE . . . . . . . . . . . . . . . . . . . 100 * * 10.1. Minor Title . . . . . . . . . . . . . . . . 102 d heading; deblank: proc; dcl i fixed; i = verify(line,' '); if i = 0 then return; line = substr(line,i); end deblank; end title;  go to nextfile; do while(true); get file(input) edit(line) (a); call deblank(); linc = linc + 1; if linc > lpp then do; linc = 1; page = page + 1; end; title = ''; fv = 0; fn = fw; do while(numer /* max field width */ lpp by 66, /* lines per page */ true by '1'b, false by '0'b; dcl blanks char(30) static initial (' '), dots char(80) var static initial ('. . . . . . . . . . . . . . . . . . . . false); if verify(substr(line,1,i-1),'0123456789') = 0 then do; pref = substr(line,1,i); line = substr(line,i+1); return (true); end; return (false); end numeric; heading: proc returns (char(254) var); dcl i fixed','.sp 2','.li') (a,skip); on endfile(commd) begin; put file(output) edit('.br') (skip,a); put file(output) skip; stop; end; on undefinedfile(input) begin; put skip list(title,'Not Found, Continue? (Y/N)'); get list(title); * * 10.1.1. Paragraph Title . . . . . . . . . 103 * * * * The Table of Contents shown in the "PL/I-80 Reference Manual"* * was prepared using this program, so it provides a gotitle = substr(blanks,1,fv) || title; fv = fv + fn; if length(title) < fv then title = title || substr(blanks,1,fv-length(title)); title = title || heading(); line = title || substr(dots,length(title)+1); put filic()); title = title || pref; fn = fn + fi; fv = fv + fn; end; if title ^= '' then if fv <= fm then if substr(line,1,1) = ' ' then do; fv = fv - fn; if fv = 0 then put file(output) skip; else . . . . . . . . . . . . '); dcl (commd, input, output) file, page decimal(3), fv fixed, fn fixed, lppv fixed, linc fixed, line char(254) var, pref char(254) var, title char(254) var; put list ('Output File Name ?; call deblank(); i = index(line,'.'); if i ^= 0 then line = substr(line,1,i-1); i = index(line,' '); do while (i ^= 0); line = substr(line,1,i) || substr(line,i+2); i = index(line,' '); end; return (line || ' '); en if title = 'y' | title = 'Y' then go to retry; stop; end; retry: do while(true); get file(commd) list(title); open file (input) title(title) stream input env(b(1000)); put skip list('Processing: ',title); on endfile(input) od exam- * * of the input and output forms. * ***************************************************************/ %replace fw by 3, /* starting field width */ fi by 2, /* field increment */ fm by 30, e(output) edit(line,page) (skip,a,f(3)); end; end; nextfile: linc = lpp; revert endfile(input); close file(input); end; numeric: proc returns(bit(1)); dcl i fixed; i = index(line,'.'); if i <= 1 then return (le (commd) title(title) stream input; lppv = lpp; put list ('Lines Per Page ? '); get list (lppv); page = 1; put list ('Start Page Number? '); get list (page); page = page - 1; linc = lppv; put file(output) edit('.ce','TABLE OF CONTENTS '); get list(title); open file (output) title(title) stream output env (b(1000)); put list ('Command File Name? '); get list (title); on undefinedfile(commd) begin; put list (title,'command file not present'); stop; end; open fif: proc options(main); dcl i fixed; do i = 0 repeat(i+1); put skip list('factorial(',i,')=',fact(i)); end; stop; fact: procedure(i) returns(float) recursive; dcl i fixed; i end; put file(output) edit(line) (a); put file(output) skip; end; nextfile: put skip(3) file(listing); revert endfile(input); close file(input); close file(output); end; translate: proc returns(bit); /* traplaced on drive B (this can be easily * * generalized by making simple changes to the * * program). Note that the listing file can be * * $LST which sends output to the printer. * * ; on endfile(input) go to nextfile; do lineno = 1 by 1; get file(input) edit(line) (a); if translate() then do; put skip file(listing) list(lineno,':'); column = 1; do i = 1 to length(line); c = substr(liase outside of string * * quotes. The program is initiated by typing: * * MACASM commandfile listing * * where "commandfile" is a file containing a * * list of file names to process, with the filf i = 0 then return(1); return (i * fact(i-1)); end fact; end f; present one or more heading digits * * and xxxxx represents a heading title, optionally followed by * * a period. Headied, title char (254) var; open file (listing) print title('$2.$2'); open file (command) title('$1.$1'); on endfile(command) stop; on undefinedfile(input) begin; put skip list('***** file not found *****'); go to retry; end; re * ************************************************/ %replace true by '1'b, false by '0'b; dcl (input, output, command, listing) file, i fixed, column fixed, c char, line char(254) var, lineno fixxl: proc options(main); /************************************************ * (Another Sample Program....) * * * * this program aids in the translation of fine,i,1); if c = '^i' then do while(mod(column,8)^=0); put file(listing) edit(' ')(a); column = column + 1; end; else do; put file(listing) edit(c) (a); column = column + 1; end; end;e * * type MAC, and "listing" is the name of a * * file to receive a listing of the changes. * * the source files must be on drive A, and the * * resulting files, with the new file type ASM * * are try: do while('1'b); get file(command) list(title); open file (input) title('a:'||title||'.mac') env(b(5000)); open file (output) stream output title('b:'||title||'.asm') env(b(5000)); put file(listing) skip list('Processing:',title)rand of the NAME pseudo-op. Although these* * differences only produce warnings, this pro- * * gram can be used to automatically change these* * elements. Note that upper case letters are * * also changed to lower cles * * in the microsoft assembly language format, to * * a form acceptable by RMAC. In particular, * * RMAC requires quotes around the title string * * and does not allow parentheses around the * * openslate current line */ dcl (i,j) fixed, xl bit, linelen fixed; xl = lowercase(); i = index(line,'name^i'); if i ^= 0 then do; /* look for ('xxx') */ i = i + 5; if substr(line,i,1) = '(' then do; line = subsght initial (3), white_bishop initial (4), white_rook initial (5), white_queen initial (6), white_king initial (7), black_pawn initial (8), black_knight initial (9), black_bishop initial (10), black_rment. We expect that this program will be * * extensively changed as various programmers work with it - * * if you make any great improvements, let us know and we'll * * send your updated version with our next release (you'll * * also c char, lc bit; lc = false; q = false; do i = 1 to length(line); c = substr(line,i,1); if c = '''' then q = ^q; rc = rank(c) - rank('A'); if ^q then if rc >= 0 then if rc <= 25 then do; lc = true; * * (P.S., in its current state, this program takes 1:58 to * * compile on a 4-mhz Z-80 with a hard disk attached, and 1:45 * * if the $Q compile toggle is enabled.) * ***************************tr(line,1,length(line)-1); line = substr(line,1,i-1) || substr(line,i+1); end; xl = true; end; i = index(line,'title^i'); if i ^= 0 then do; /* look for missing parens */ i = i + 6; if substr(line,i,1) ^= '''' * * value to determine the search depth (don't make the value * * too large, or you'll wait quite a while for the moves). * * * * Programmer Address Da go in line in the list below, for eternal fame). * * Feel free to distribute this program, or altered versions * * thereof, but please keep the list of names intact. Oh, by * * the way, CHESS currently plays against itself, and reads a substr(line,i,1) = ascii(rc+rank('a')); end; end; return (lc); end lowercase; end xl; input); end; numeric: proc returns(bit(1)); dcl i fixed; i = index(line,'.'); if i <= 1 then return (*************************************/ declare (white initial (1), none initial (0), black initial (-1)) static fixed (1); declare (empty_square initial (0), illegal_square initial (1), white_pawn initial (2), white_knichess: procedure options(main); /**************************************************************** * * * This program has served as a timing test case throughout * * the PL/I developthen line = substr(line,1,i-1) || '''' || substr(line,i) || ''''; xl = true; end; return (xl); end translate; lowercase: proc returns(bit); /* translate to lower case */ dcl q bit, i fixed, rc fixed, te * * ---------- ------------------- ------ * * JWB Digital Research 3/79 * * * * ook initial (11), black_queen initial (12), black_king initial (13)) static fixed (4); declare piece_value (0 : 13) static fixed initial (0,0,100,290,310,500,900,8000,-100,-290,-310,-500,-900,-8000); declare p*********** * * * * * * ******************************************0, 0, 0, 0, 0, 0, 0, 0, 0, 0); declare (((max_stage,max_cap) initial (3), ply, max_ply) fixed (3), ((move_index, best_move, first_move, last_move) fixed, (stage_lim, stage_lst) fixed (3), move_color fixed (1), cur_01,01,01,01,01, 01,01,01,01,01,01,01,01,01,01, 01,11,09,10,12,13,10,09,11,01, 01,08,08,08,08,08,08,08,08,01, 01,00,00,00,00,00,00,00,00,01, 01,00,00,00,00,00,00,00,00,01, 01,00,00,00,00,00,00,00,0 spaces static varying character (9) initial (' |'); put skip(2); do i = 20 to 90 by 10; write from(dashes); put skip; write from(spaces); do j = 1 to 8; declare bonus (0 : 119) static fixed (4) initial ( 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 3, 2, 1,-9, 3, 4, 1, 0, 0, 1, 1, 1, 6, 7, 1, 1, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, iece_picture (0 : 13) static char (4) varying initial (' |','___|',' P |',' N |',' B |',' R |',' Q |',' K |', '

|','|','|','|','|','|'); declare bishop_like (0 : 13) static bit initial ('0',********************************************************* * * * * * piece fixed (4), move_bonus fixed (4)) (0 : 5), next fixed, /* index to next available of */ ((est_score, move_score) fixed, (move_from, move_to, move_dir) fixed (7)) (0 : 350)) static; /*******0,01, 01,00,00,00,00,00,00,00,00,01, 01,02,02,02,02,02,02,02,02,01, 01,05,03,04,06,07,04,03,05,01, 01,01,01,01,01,01,01,01,01,01, 01,01,01,01,01,01,01,01,01,01); declare center (0 : 119) static fixed write from(piece_picture (board (i + j))); end; put skip; end; write from(dashes); put skip(2); end display; /***************************************************** 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 1, 1, 6, 7, 1, 1, 1, 0, 0, 1, 3, 2, 1,-9, 3, 4, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, '0','0','0','1','0','1','0','0','0','1','0','1','0'); declare rook_like (0 : 13) static bit initial ('0','0','0','0','0','1','1','0','0','0','0','1','1','0'); declare board (0 : 119) static fixed (4) initial (01,01,01,01,01, * ****************************************************************/ display: procedure; declare (i, j) fixed; declare dashes static varying character (41) initial (' +---+---+---+---+---+---+---+---+'), 0, 00,00,01,02,03,03,02,01,00,00, 00,00,01,02,02,02,02,01,00,00, 00,00,01,01,01,01,01,01,00,00, 00,00,00,00,00,00,00,00,00,00, 00,00,00,00,00,00,00,00,00,00, 00,00,00,00,00,00,00,00,00,00); (2) initial (00,00,00,00,00,00,00,00,00,00, 00,00,00,00,00,00,00,00,00,00, 00,00,00,00,00,00,00,00,00,00, 00,00,01,01,01,01,01,01,00,00, 00,00,01,02,02,02,02,01,00,00, 00,00,01,02,03,03,02,01,00,0**********************/ display_move: procedure (move); declare move fixed; declare spaces varying character (6) static initial (' '), dash varying character (1) static initial ('-'), takes varybest_move (ply) = first_move (ply); end sort_moves; /**************************************************************** * * * * * * ****************************************************************/ sort_moves: procedure; declare ((i, j, t) fixed, s fixed (',' ', ' ','a4','b4','c4','d4','e4','f4','g4','h4',' ', ' ','a3','b3','c3','d3','e3','f3','g3','h3',' ', ' ','a2','b2','c2','d2','e2','f2','g2','h2',' ', ' ','a1','b1','c1','d1 s = move_from (i); move_from (i) = move_from (j); move_from (j) = s; s = move_to (i); move_to (i) = move_to (j); move_to (j) = s; * ****************************************************************/ color: procedure (square) returns (fixed (1)); declare square fixed (7); if board (square) >= black_pawn then return (black); if board (ing character (1) static initial ('x'), names (0 : 119) varying character (2) static initial (' ',' ',' ',' ',' ',' ',' ',' ',' ',' ', ' ',' ',' ',' ',' ',' ',' ',' ',' ',' ', < last_move (ply)); j = i + 1; t = move_score (i) - move_score (j); if t < 0 & color = white | t > 0 & color = black then do; switched = '1'; 7), color fixed (1), switched bit) static; color = move_color (ply); do switched = '1' while (switched); switched = '0'; do i = first_move (ply) repeat (j) while (i','e1','f1','g1','h1',' ', ' ',' ',' ',' ',' ',' ',' ',' ',' ',' ', ' ',' ',' ',' ',' ',' ',' ',' ',' ',' '); write from(spaces); write from(names (move_from (move))); s = move_dir (i); move_dir (i) = move_dir (j); move_dir (j) = s; if i > first_move (ply) then j = j - 2; end; end; end; square) <= illegal_square then return (none); return (white); end color; /**************************************************************** * * * ' ','a8','b8','c8','d8','e8','f8','g8','h8',' ', ' ','a7','b7','c7','d7','e7','f7','g7','h7',' ', ' ','a6','b6','c6','d6','e6','f6','g6','h6',' ', ' ','a5','b5','c5','d5','e5','f5','g5','h5 t = est_score (i); est_score (i) = est_score (j); est_score (j) = t; t = move_score (i); move_score (i) = move_score (j); move_score (j) = t; /**************************************************************** * * * * * if cur_piece (ply) = empty_square then write from(dash); if cur_piece (ply) ~= empty_square then write from(takes); write from(names (move_to (move))); end display_move; * * * ****************************************************************/ generate_moves: procedure; declare (move_piece fixed (4), from_square fixed (7), if board (from_square + 10) = empty_square then do; call add_move (from_square + 10, 10); if board (from_square + 20) = empty_square then if bonus (from_square) ~= 0 then declare ts fixed (7) static; do ts = from_square + dir repeat (ts + dir) while (board (ts) = empty_square); call add_move (ts, dir); end; call add_move (ts declare (current_piece fixed (4), score fixed) static; current_piece = board (to_square); if current_piece = illegal_square then return; if color (to_square) = move_color (ply) then return; move if bonus (from_square) ~= 0 then call add_move (from_square - 20, -10); end; if color (from_square - 9) = -move_color (ply) then call add_move (from_s last_move (ply) = next; next = next + 1; end add_move; /**************************************************************** * * * castle_bonus fixed (4), move fixed) static; /**************************************************************** * * * * * * * * ****************************************************************/ generate_piece_moves: procedure; move_piece = board (from_square); if, dir); /* adds captures */ end multi_move; /**************************************************************** * * * _from (next) = from_square; move_to (next) = to_square; move_dir (next) = direction; score = center (to_square) - center (from_square) + bonus (from_square); if color (from_square) = blacquare - 9, -9); if color (from_square-11) = -move_color (ply) then call add_move (from_square - 11, -11); end; else if move_piece = black_pawn then do; * * * ****************************************************************/ multi_move: procedure (dir); declare dir fixed (5); * ****************************************************************/ add_move: procedure (to_square, direction); declare to_square fixed (7), direction fixed (5); move_piece = white_pawn then do; if board (from_square - 10) = empty_square then do; call add_move (from_square - 10, -10); if board (from_square - 20) = empty_square then move_score (best_move (ply)) then best_move (ply) = next; end; else do; if score < move_score (best_move (ply)) then best_move (ply) = next; end; k then score = - score; score = score - piece_value (current_piece); est_score (next) = score; move_score (next) = score; if move_color (ply) = white then do; if score > call add_move (from_square + 20, 10); end; if color (from_square + 9) = -move_color (ply) then call add_move (from_square + 9, 9); if color (from_square+11) = -move_co call multi_move (1); call multi_move (-1); end; end; end generate_piece_moves; /**************************************************************** * do; call add_move (from_square + 2, 2); est_score (next - 1) = est_score (next - 1) + castle_bonus; move_score (next - 1) = ll add_move (from_square + 12, 12); call add_move (from_square + 19, 19); call add_move (from_square + 21, 21); end; else if move_piece = white_king | move_piece = black_k end; end; else do; if bishop_like (move_piece) then do; call multi_move (-11); call multi_move (-9); call if move_piece = black_king then if from_square = 25 then castle_bonus = -15; end; if castle_bonus ~= 0 then do; ilor (ply) then call add_move (from_square + 11, 11); end; else if move_piece = white_knight | move_piece = black_knight then do; call add_move (from_spty_square then if board (from_square - 2) = empty_square then if board (from_square - 1) = empty_square then do; call add_move (from_square - 2, -2); move_score (next - 1) + castle_bonus; end; if bonus (from_square - 4) ~= 0 then if board (from_square - 4) = move_piece-2 then if board (from_square - 3) = eming then do; call add_move (from_square - 11, -11); call add_move (from_square - 10, -10); call add_move (from_square - 9, -9); call add_move (from_square - 1, -1); multi_move (9); call multi_move (11); end; if rook_like (move_piece) then do; call multi_move (-10); call multi_move (10); f bonus (from_square + 3) ~= 0 then if board (from_square + 3) = move_piece-2 then if board (from_square + 1) = empty_square then if board (from_square + 2) = empty_square then quare - 21, -21); call add_move (from_square - 19, -19); call add_move (from_square - 12, -12); call add_move (from_square - 8, -8); call add_move (from_square + 8, 8); ca est_score (next - 1) = est_score (next - 1) + castle_bonus; move_score (next - 1) = move_score (next - 1) + castle_bonus; end; if bonus (from_square) ~= 0 then do; if move_piece = white_king then if from_square = 95 then castle_bonus = 15; end; else do; call add_move (from_square + 1, 1); call add_move (from_square + 9, 9); call add_move (from_square + 10, 10); call add_move (from_square + 11, 11); castle_bonus = 0; * * * * * ****************************************************************/ bonus (from) = 0; if board (to) = white_king | board (to) = black_king then do; if to = from + 2 then do; board (to - 1) = board (to) - 2; board (to + 1) = emptyocedure (move) returns (bit); declare move fixed (7); declare score fixed static; if ply = 0 then return ('0'); if move_index (ply - 1) = first_move (ply - 1) then return ('0'); if move_index (p move_prohibited; first_move (ply) = next; best_move (ply) = next; move_index (ply) = next - 1; move = best_move (ply - 2); if ply >= max_ply then if ply >= 2 then if move if alpha_beta_cutoff (move_index (ply)) then return ('0'); move_index (ply) = move_index (ply) + 1; if move_index (ply) > last_move (ply) then return ('0'); to = move_to (move_index (ply)); from = move_from (move_index last_move (ply) = next - 1; return; end; end; return; end generate_moves; /**************************************************************** * move_prohibited: procedure (best_move, move) returns (bit); declare (best_move, move) fixed; declare to_sq fixed (7) static; do to_sq = move_from (best_move) repeat (to_sq + move_dir (; return (score < 0); end alpha_beta_cutoff; /**************************************************************** * * * ly) < first_move (ply) then return ('0'); score = move_score (move) + move_score (move_index (ply - 1)) - move_score (best_move (ply - 1)); if move_color (ply) = white then return (score > 0)_from (move_index (ply - 2)) ~= move_from (move) then if move_from (move) ~= move_to (move_index (ply - 1)) then if move_to (move) ~= move_from (move_index (ply - 1)) then if ~ move_prohibited (move, move_index (ply - 1)) then (ply)); cur_piece (ply) = board (to); if ply >= max_cap & cur_piece (ply) = empty_square then return ('0'); board (to) = board (from); board (from) = empty_square; move_bonus (ply) = bonus (from); * * * * * ****************************************************************/ alpha_beta_cutoff: prbest_move)) while (to_sq ~= move_to (best_move)); if move_to (move) = to_sq then return ('1'); end; if move_to (move) = to_sq then return ('1'); return ('0'); end * * * ****************************************************************/ select_next_move: procedure returns (bit); declare (to, from) fixed (7) static; re = 21 to 98; if color (from_square) = move_color (ply) then call generate_piece_moves(); if ply >= max_ply then if alpha_beta_cutoff (best_move (ply)) then do; if ~ move_prohibited (move, move_index (ply - 2)) then do; from_square = move_from (move); call add_move (move_to (move), move_dir (move)); return; end; do from_squa_square; end; else if to = from - 2 then do; board (to + 1) = board (to) - 2; board (to - 2) = empty_square; end; end; return ('1'); (i) = est_score (i); end; move_index (ply) = first_move (ply) - 1; call score_ply_moves(); call sort_moves(); end; next = first_move (ply); max_ply = stage_lst (ply); if move_score (move_index (ply)) < move_score (best_move (ply)) then best_move (ply) = move_index (ply); end; call retract_move(); end; end score_ply_moves; e_from (move_index (ply)); board (from) = board (to); board (to) = cur_piece (ply); bonus (from) = move_bonus (ply); if board (from) = white_king | board (from) = black_king then do; if to = frong | cur_piece (ply - 1) = black_king then do; move_score (best_move (ply)) = 0; next = first_move (ply); ply = ply - 1; return; end; if ply < max_ply t do while (select_next_move ()); call stage(); move_score (move_index (ply)) = move_score (move_index (ply)) + move_score (best_move (ply + 1)); if move_color (ply) = wh end select_next_move; /**************************************************************** * * * * * * ****************************************************************/ stage: procedure recursive; declare i fixed static; ply = ply + 1; if ply ~= 0 then move_color (ply) = -move_color (ply - 1); /**************************************************************** * * * * * m + 2 then do; board (to + 1) = board (from) - 2; board (to - 1) = empty_square; end; else if to = from - 2 then do; board (to - 2) = board (hen do max_ply = stage_lim (ply) repeat (stage_lim (ply) + 1) while (max_ply <= stage_lst (ply)); stage_lim (ply) = max_ply; do i = first_move (ply) to last_move (ply); move_scoreite then do; if move_score (move_index (ply)) > move_score (best_move (ply)) then best_move (ply) = move_index (ply); end; else do; * ****************************************************************/ retract_move: procedure; declare (to, from) fixed (7) static; to = move_to (move_index (ply)); from = mov stage_lst (ply) = max_ply; stage_lim (ply) = ply + 2; if stage_lim (ply) > max_stage then stage_lim (ply) = max_stage; call generate_moves(); if ply ~= 0 then if cur_piece (ply - 1) = white_ki * * * * * ****************************************************************/ score_ply_moves: procedure recursive; from) - 2; board (to + 1) = empty_square; end; end; end retract_move; /**************************************************************** * ply = ply - 1; end stage; /**************************************************************** * * * * * board (to) = board (from); board (from) = empty_square; bonus (from) = 0; bonus (to) = 0; if board (to) = white_king | board (to) = black_king then do; if to = from + 2 then _display); do while ('1'); call make_move (white); call make_move (black); put skip; move_number = move_number + 1; if move_number > move_display then do; move_number = 1; * ****************************************************************/ make_move: procedure (color); declare color fixed (1); declare (to, from) fixed static; nedo; board (to - 1) = board (to) - 2; board (to + 1) = empty_square; bonus (to + 1) = 0; end; else if to = from - 2 then do; board (to + 1) = call display(); end; end; end chess; 0\Hxt = 0; ply = -1; max_ply = max_stage; move_color (0) = color; call stage(); ply = 0; to = move_to (best_move (0)); from = move_from (best_move (0)); cur_piece (0) = board (to); %replace maxrow by 26, maxcol by 40;  * * This program has served as a timing test case throughout * * the PL/I develot fixed (7) static initial(1); put skip list('Chess Program Version 1.0'); put skip list('Type Search Depth '); get list(max_cap); max_stage = max_cap; put list('Type Number of Moves Between Displays '); get list(moveboard (to) - 2; board (to - 2) = empty_square; bonus (to - 2) = 0; end; end; call display_move (best_move (0)); end make_move; declare (move_number, move_display) invert: proc (a,r,c); %include 'matsize.lib'; dcl (d, a(maxrow,maxcol)) float (24), (i,j,k,l,r,c) fixed (6); do i = 1 to r; d = a(i,1); do j = 1 to c - 1; a(i,j) = a(i,j+1)/d; end; a(i, q->next_city->city_name); end; end; end print_all; print_paths: proc; dcl city char(citysize) var; on endfile(sysin) go to eof; do while(true); get list(city1, dist, city2); call connect(city1, dist, city2); call connect(city2, dist, city1); end; eof: end setup; connect: proc(source_city, dist, dest_city); dcl city; p->city_list = city_head; city_head = p; p->total_dist = infinite; p->route_head = null; return(p); end find; print_all: proc; dcl (p, q) ptr; (2(column(10),a,f(6),a,skip),skip(4)); call setup(); if city_head = null then stop; call print_all(); call print_paths(); call free_all(); end; setup: proc; c) = 1/d; do k = 1 to r; if k ^= i then do; d = a(k,1); do l = 1 to c - 1; a(k,l) = a(k,l+1) - a(i,l) * d; end; a(k,c) = - a(i,c) * d; r->route_dist = dist; r->next_city = d; r->route_list = s->route_head; s->route_head = r; end connect; find: proc(city) returns(ptr); dcl city char(citysize) var; dcl source_city char(citysize) var, dist fixed, dest_city char(citysize) var; dcl (r, s, d) ptr; s = find(source_city); d = find(dest_city); allocate route_node set (r); graph: proc options(main); %replace true by '1'b, false by '0'b, citysize by 20, infinite by 32767; dcl (twords, mwords) entry returns(fixed); dcl sysin file; dcl do p = city_head repeat(p->city_list) while(p^=null); put skip list(p->city_name,':'); do q = p->route_head repeat(q->route_list) while(q^=null); put skip list(q->route_dist,'miles to', dcl dist fixed, (city1, city2) char(citysize) var; on endfile(sysin) go to eof; city_head = null; put skip list('Type "City1, Dist, City2"'); put skip; do while(true); end; end; end; end invert;  thereof, but please keep the list of names intact. Oh, by * * the way, CHESS currently plays against itself, and reads a (p, q) ptr; do p = city_head repeat(p->city_list) while(p^=null); if city = p->city_name then return(p); end; allocate city_node set(p); p->city_name = 2 route_dist fixed, 2 route_list ptr; dcl city_head ptr; do while(true); put skip edit ('^gTotal Storage = ',twords(),' Words', 'Max Available = ',mwords(),' Words') 1 city_node based, 2 city_name char(citysize) var, 2 total_dist fixed, 2 investigate bit, 2 city_list ptr, 2 route_head ptr; dcl 1 route_node based, 2 next_city ptr, put skip list('Type Destination '); get list(city); call shortest_dist(city); on endfile(sysin) go to eol; do while(true); put skip list('Type Start '); get if t = 0 then return; put skip list(t,'miles remain,'); q = p->route_head; do while(q^=null); p = q->next_city; d = q->route_dist; if t = d + ate = false; end; p = find(city); p->total_dist = 0; p->investigate = true; do while(true); bestp = null; bestd = infinite; do p = city_head ate = true; end; end; end; end shortest_dist; print_route: proc(city); dcl city char(citysize) var; dcl (p, q) ptr, (t, d) list(city); call print_route(city); end; eol: revert endfile(sysin); end; eof: end print_paths; shortest_dist: proc(city); dcl city char(citnt_route; free_all: proc; dcl (p, px, q, qx) ptr; do p = city_head repeat(px) while(p^=null); do q = p->route_head repeat(qx) while(q^=null); qx = q->route_list; p->total_dist then do; put list(d,'miles to',p->city_name); q = null; end; else q = q->route_list; end; end; end pri repeat(p->city_list) while(p^=null); if p->investigate then do; if p->total_dist < bestd then do; bestd = p->total_dist; fixed; p = find(city); do while(true); t = p->total_dist; if t = infinite then do; put skip list('(No Connection)'); return; end; ysize) var; dcl bestp ptr, (d, bestd) fixed, (p, q, r) ptr; do p = city_head repeat(p->city_list) while(p^=null); p->total_dist = infinite; p->investig free q->route_node; end; px = p->city_list; free p->city_node; end; end free_all; end graph; peat(q->route_list) while(q^=null); r = q->next_city; d = bestd + q->route_dist; if d < r->total_dist then do; r->total_dist = d; r->investig bestp = p; end; end; end; if bestp = null then return; bestp->investigate = false; do q = bestp->route_head rereverse: proc options(main); dcl sentence ptr, 1 wordnode based (sentence), 2 word char(30) varying, 2 next ptr; do while('1'b); call read(); if sentence = null then list(x,y,z); if x = 0 & y = 0 & z = 0 then stop; put skip list(' 2'); put skip list(' x + 2y + z =',p(x,y,z)); end; p: proc (x,y,z) returns (float binary); dcl end; end read; write: proc; dcl p ptr; put skip list('Actually, '); do while (sentence ^= null); put list(word); p = sentence; sentence = next; if x = 0 & y = 0 & z = 0 then stop; put skip list(' 2'); put skip list(' x + 2y + z =',p(x,y,z)); end; p: proc (x,y,z) returns (fixed decimal(15,4)); dcl (x,y stop; call write(); end; read: proc; dcl newword char(30) varying, newnode ptr; sentence = null; put skip list('What''s up? '); do while('1'b); (x,y,z) float binary; return (x * x + 2 * y + z); end p; end poly;  newnode->next = sentence; sentence = newnode; word = newword; free p->wordnode; end; put list('.'); put skip; end write; end reverse; ,z) fixed decimal(15,4); return (x * x + 2 * y + z); end p; end poly;  newnode->next = sentence; sentence = newnode; word = newword; poly: procedure options(main); /* evaluate polynomial */ %replace false by '0'b, true by '1'b; dcl (x,y,z) float binary; do while(true); put skip(2) list('Type x,y,z: '); get get list(newword); if newword = '.' then return; allocate wordnode set (newnode); newnode->next = sentence; sentence = newnode; word = newword; poly: procedure options(main); /* evaluate polynomial */ %replace true by '1'b; dcl (x,y,z) fixed decimal(15,4); do while(true); put skip(2) list('Type x,y,z: '); get list(x,y,z); %replace maxrow by 26, maxcol by 40; ,y,z) fixed decimal(15,4); do while(true); put skip(2) list('Type x,y,z: '); get list(x,y,z); t do; put skip list('No Directory Space'); call reboot(); end; /* $$$ temp file created, now copy from source */ eofile = false; do while (^eofile); m = 0; /* fill buffers */ do i = 0 repeat (i+1) while (inext = sentence; sentence = newnode; word = newword; ed in rename */ 3 drive2 fixed(7), 3 fname2 char(8), 3 ftype2 char(3), 3 fext2 fixed(7), 3 space2 (3) bit(8), 2 crec fixed(7), /* current record */ 2 rrec fixed(15), /* random record */ 2 rovf fixema(addr(memory(m))); m = m + bufwds; if rdseq(addr(sourcefile)) ^= 0 then do; eofile = true; /* truncate buffer */ nbuffs = i; end; end; m = 0; /* write buffers */ do i = 0 to nbuffs-1; call setdma(addr(m end diocopy; proc; dcl city char(citysize) var; on endfile(sysin) go to eof; do while(true); emory(m))); m = m + bufwds; if wrseq(addr(destfile)) ^= 0 then do; put skip list('Disk Full'); call reboot(); end; end; end; /* close destination file and rename */ if close(addr(destfile)) = -1 then do; put s'(a< pA.@ K@ermann(m-1,ackermann(m,n-1))); end ackermann; end ack;  " \ $1w2u2Ĩ2;jHGm  <<i(u(Ĩ(;j  R kip list('Disk R/O'); call reboot(); end; /* destination file closed, erase old file */ call delete(addr(renfile)); /* now rename $$$ file to old file name */ destfile.name2 = renfile.name1; call rename(addr(destfile)); call reboot();