QSORT COM6QSORT LIB QSORT PAS RCPDAT MST RCPDAT XXX RCPDAT YYYRECIPE COMxRECIPE PAS !"#$%&'()*+,-./ˆ#w+> ###8(G+++ˆ ˎ#Np+y ++Nwy+!AuRead beyond EO!PY9G!ݾ Afn( ~^(Vfnůw^ ѯݾ> z() ,F* ̕ k ̯ Z  r+sFfnJ8(|( statementFloating point overflow/underflo ͺw6nfV+^`Ҷnf' )!! V+^<nfmW_R–n(͋ʞ͢4# 4F!ͺn f tunf tunf^V͖' )!^Vr+snfW_R8! nf<4# 4F66ydaeR!!9!W !trats ot ydaer nehw nruter sserP ! !9!{ $<͡!!e3TRATS!!9!!nfRECIPE PAS0123SHELL COM6456789:SHELL LIB;SHELL PAS<=>SNOOPY81CAL%?@ABCXREF COMnDEFGHIJKLMNOPQXREF PASIRSTUVWXYZ[ZCOMPAR COM8\]^_`ab' )!^Vr+snf#tunf+tunf^Vtn f ^Ven f nfnf^V ҈nfnf ! !ر9!!9Rctros ot smeti fo rebmun retnE!!9!!000,01 =< n =< 01 !)!V+^rsnf' )!V+^nfLnf#tunf' )!V+^nft҅nf+tuLnf^Vj0nf' )!V+^rsnf' )!^V!')!V+^r+snf!!e3!!!ENOD!!9!?)N/Y( yarra eht tnirP!!9!B<͡gn}Y|ʗgn}y|š.éP կN;T]F(###8;86+++ (*+*+w!*w##w!( F##NͲ ͲÎ^#V!{!! !!! !!!ÞString too lonCall by reference precision erroIndex or value out of rangAttempted divide by zerMultiply overfloStack overflo --ZCOMPAR PAScdSIG/M IB efUGFORM IBghijQQSORT PAS klmn!9!!!?e3< ͡n(͋ʞ͢nf `ҥnf'jҥ .pu tes I elihw yb dnats esaelP!!9!w#w6qw6+nfV+^`Enf͟#tunf' 0n({(ͺ8 ͺw+6 +ͺT( F( (z X X fnpGͺE ,JOG J8x8s(\Ì ͺ (] (Y (U (Q (M#(1_(-$(){8 [8:8W a8A8 0W WW zW>( (ͺ3 ͺu ʉ fn~!! !5 !>uDisk erroError in extending filDisk fulDirectory fulBad filename *^#~ 84 Q#6*6O  Ͳ ͢Q*6#~P( 4^qQ5 Ͳ7Q~O͢#W WE_G #~-   60 +A~8 ( W ͗ N͗++++!9ѯɯR0 >0w+ G fnN++ͣ| z 4  ͢>+++######a8^7ͺ+++ˎ˞˦80 ###ͭ+++go80 | }! K DM#4 fnr+s+p+q@ H ͺ3\-(+ ͺ394 ~+.(:e(DE(@ (85< #~0! 6+w+w+w+w EL66=O~- O+ +~0ڃ ҃G+~ (0ڃ ҃WxGxA(DG~ݦ (G< ww##ݯ`iGO6# 6 #6#͝(8#AG͝0> :(*55*+Fx8 !L7Qw ͝8(.(w#H (#QZa8{0_ +++f###%(6Qy%4x ygoR_F j###goͿ ͗ ͗#_F jˆ###pgoͿ!9 PY FfnV go8| }~^(Vfn>wf(zȯF+D̽~ Fng)))V^Ny9 G_~((BW>__{(+#ܯ>(#> + ٯgk9~fnw z z OfnF+ J88ͺ ( ( xOw+G #qF (z ! fnqG fnp+qG!Dͺ (- + ͺ:0%08!)  \:0h`ijhjhPY`h *~+ڐ^#~ ʐÔFʔÍʔNÔgi#9AZ NͲ+ Ͳ#`i###^(?"!5~< #5 #5'"x<(  S_xDM!=()8 )0 0)uToo many open output file!$uBad output file nam#}( ##|#(}#7Z0!9G ANͲ+ Ͳ"Z }r+sPYO>xZ0#fn##|###ĭ!d !,/ R0â` DG* !9K K ! !c | !  44L4P!9w ! 3ʃ~ݮ w~<ݖ w !9w#+! +8 +#8+K8!I! w#!fʰ###"!5~< #5~< #5'"! 6!'!44~0#4 #4!!4 #4 #4! 6!!%66Q)~6<(3' " ^##wQ!  (#͗( ͗F~+++N͗+G ͗++ݾ~u8 AO͗G ͗TRUEFALSEF~+++N ( +N͗y(G++G ͗V^!9 z(6-+goGRw+O'WWd00⯸x/Gy/Oɯ e! Z !T]jjZj_ZfnV^J;###++Fwx+0w+z  z ! uType error on inpuError in number, try again 9ͺ (-(+̺ĺ3ͺ0z :z ͺ3\.(7e(;E(708:8>+} E˸$}($0##0""L$q#s#r!(F!#6!*!!4 #4 #4!!%p  6++w+(Q˞Qݮ w !9w !3(@! 3~( ! # ~( !#~ݖ (GO8y! yG(!4+~>! 4+~>!4+~>! 4+~>!  +! #%~#? P~U   76<+w_##~Q Q>QQYQ%6#6JJ := JJ - 1 END UNTIL II > JJ; IF left < JJ THEN QSORT( left, JJ ); IF II < right THEN QSORT( II, right ) END;{of QSORT} {$C+,M+,F+} BEGIN (* MAIN *) repeat writeln; writeln('Enter number of items to sort'); writelnl +} {+ program. +} {+ +} {+ Average sorting times in seconds * +} {+ No. of items Shellsort Quicksort QQuicksort +} {+ 1000 15 8 7 +} {+ 2000 34 20 14 +} {+ Quicksort method by C.A.R Hoare. Presented here in Pascal. } { GLOBAL TYPE Index = 1..N; Scalar = VAR A : array [Index] of Scalar; } VAR II, JJ : integer; Pivot, temp : Scalar; BEGIN {$C-,M-,F-} xQ$^|R?|7R|7R?|Rb$ɯ7|z(z/W{/_|(|/g}/o# ((!= goRW_= DM(go*7ɯt <) VAR A : array [Index] of Scalar; } VAR II, JJ II := left; JJ := right; Pivot := A[(II+JJ) DIV 2]; REPEAT WHILE A[II] < Pivot DO II := II + 1; WHILE A[JJ] > Pivot DO JJ := JJ - 1; IF II <= JJ THEN BEGIN temp := A[II]; A[II] := A[JJ]; A[JJ] := temp; II := II + 1; {++++++++++++++++++++++++++++++++++++++++++++++++++++++++} {+ PROGRAM TITLE: Quicksort Test +} {+ +} {+ WRITTEN BY: Raymond E. Penley +} {+ DATE WRITTEN: October 6, 1980 +} {+ +} {+ Show use of the quicksort algorithm in a Pasca! B |( ͖goR͖~/w#~/+~w+ #~wɯ(#~+*^W#~!OG F+N ngOG F+N F+n`OG F+N+~=(ۯOG F+N+~ =(rW+sɯRɯRORA ORG ORI OUT OUTD OUTDR Scalar; {THE array to be sorted} Procedure Show; var i: index; begin for i:=1 to N do begin write(A[i]); if i mod 8 = 0 then writeln; end; writeln; end; PROCEDURE QSORT( left,right: INTEGER ); { The classicp := A[II]; A[II] := A[JJ]; A[JJ] := temp; II := II + 1; JJ := JJ - 1 END UNTIL II > JJ; IF left < JJ THEN QSORT( left, JJ ); IF II < right THEN QSORT( II, right ) END;{of QSORT} {$C+,M+,F+}  : integer; Pivot, temp : Scalar; BEGIN {$C-,M-,F-} II := left; JJ := right; Pivot := A[(II+JJ) DIV 2]; REPEAT WHILE A[II] < Pivot DO II := II + 1; WHILE A[JJ] > Pivot DO JJ := JJ - 1; IF II <= JJ THEN BEGIN tem(' 10 <= n <= 10,000'); write('?'); readln(N); until (N >= 10) and (N <= Max_N); writeln; writeln('Please stand by while I set up.'); ix := 113; {$C-,M-,F- [ctrl-c OFF]} FOR i := 1 TO N DO BEGIN ix := (131*ix+1) mo sour cream. Heat thru, and|sprinkle with parsely. Serve with noodles. Serves 4 to 6 serv.| 35 BEEF'N TATER SQUARES - Combine 1.5 lb lean gr. beef, 1C bread crumbs|1 EGG, 1/2C Chopped Onion, 1/2C Ketchup, 1 tsp Salt, 1/8 tsp pepper. Pat|meat into 8" sqd 221; A[i] := ix; if (i mod 1000 = 0) then write(i); END; writeln; A[0] := -maxint; {$C+,M+,F+ [ctrl-c ON]} writeln('Ready'); WRITE('Press return when ready to start'); readln(cix); writeln( CHR(7), 'START'); {}s, 1 can(17 oz) Lima|Beans, 1/2C spaghetti sauce/mushrooms, 1 sm. onion, 1C Cheddar cheese|in 1.5 qt casserole. Arrange 4-6 frankfurters on top. Bake uncovered in|375 deg oven or until bean mixture is bubbly and frankfurters are light|brown. Serves 4 to 6.uare baking dish.Bake 350 deg for 30 min.Drain excess fat|Spread 3C hot mashed Potatoes and 3/4C grated cheese over meat.Top with|1/4C grated cheese. Bake 20 min. Cut into squares. Makes 6 servings| 1919 FRANK-BEAN BAKE - Mix 1 can(12 oz) Red Kidney BeanKRCPDAT.XXX RCPDAT.YYY 80/06/06  1289 BEEF STROGANOFF-saute 1/2C. onions, 1 clove garlic, in 1 qt casserole|over med. heat. Add 1 lb gr. beef and brown. add 2 tbsp. flour, salt,|pepper, and 1 lb. mushrooms, Cook 5 min. Stir in 10-oz can cream o'|chicken soup. Simmer 10 min. Stir in 1C. QSORT( 1, N ); {} WRITELN( CHR(7), 'DONE!!!' ); writeln; write('Print the array (Y/N)?'); readln(cix); If (cix='Y') or (cix='y') then Show; END. |kfurters on top. Bake uncovered in|375 deg oven or until bean mixture is bubbly and frankfurters are light|brown. Serves 4 to 6. 1289 BEEF STROGANOFF-saute 1/2C. onions, 1 clove garlic, in 1/|over med. heat. add 1 lb gr. beef and brown. add 2 tbsp. flour, salt,|pepper, and 1 lb. mushrooms, cook 5 min. stir in 10-oz can cream o'|chicken soup. Simmer 10 min. Stir in 1C. sour cream.!9! //!! e3 sdooF erbiF ! !9!1  //!! e3)ruolf( daerB .1!!9!o /!! e3 staO .2!!9! /!! e3 eciR .3!!9! 4# 4! 65f n W_go!f n 'w6!V+^͟:Ґf n nfJ4Q͍/!<4# 4O! 65wwnf#tunfJ4! OGV3+͘4# 4d  /!65/ # epiceR!!9! !! ;// -! >OGV3+!ͨ / !! 6eseht fo enoN ]nfI;:Vf n W_go!'nf#tuf n!Pgn$!]&Z6nf^V͟:~nftuóf n!P!|!]&nf+tunf^VR~f n ͉40<_W!;4s! 65wwnf#tunfPJ Heat thru, and|sprinkle with parsely. Serve with noodles (4 to 6 serv.).| 35 BEEF'N TATER SQUARES - Combine 1.5 lb lean gr. beef, 1C bread crumbs|1 EGG, 1/2C Chopped Onion, 1/2C Ketchup, 1 tsp Salt, 1/8 tsp pepper. Pat|meat into 8" square baking dish.B/!V/&gn#J4u76!! ;^×!656+ 'gn}Y(yq6N(nww!gne3 'N' ro 'Y' rewsna esaelP!!9!"/ݾH!65!!e3*0!6||nfIR¦/!6SCANNINGFOUND NOTFOUND5go! ;^fn >OGV3+&n f ͳ:Ґ!! ;^fn n f &w6gn}|:gnfn >OGV3+&ͳ:67gnPJ4fn RW^!9w#!~ RM!*+*+w!<*w##w!( F##N8 8 #^#V!{!! !!! !!!&93String too lonCall by reference precision erroIndex or value out of rangAttempted divide by zerMultiply overfloStack overflo --5/ot 1( eciohC retnE!!9! !nf  )!!9!?  *0++J&!gne3*0gn!0Rtuͭ9(939nf͟: nf^V ͩ: nftu! 65/: eciohc fo rebmun retnE !4f nRW^!;4sgn}||Of n gogo!!gne3 *0gn}||infIRf n gogo!!!|e3 *0! 65f n gogo!!! ; /w6!V+^͟:f n nfJ4Q͍/!O  >O  >O  !go!1! 1!9 1=*0!65wwwf ngo&f n ͉4]W^{|z statementFloating point overflow/underflo TSM.TADPCR 5!9!.   ͠2 go!1 1'nftunftu >O  >O  >O !6/!! e3 nroC .4!!9! /!! e3 inoracaM .5 ! !9!L  /!! e3 seldooN .6 ! !9!  /!! e3ittehgapS .7 ! !9!  /!! e3 .8!͖V 6ͭ9(939gn}|k >O  >O  >O !6ABSENT FOUND SEARCHIN5>NFݾ nf^Vͳ:>NFݾ wf>NF'>NFݾ  !H &39>NFݾ  >OGV3+&goͳ:gnW_R>NFݾ  !P!|!]&>NFݾ nfJ4Q͍/!<>NFݾ  P>POQg/! rs͐ /!! e3yriaD!!9!-//!! e3 kliM .1!!9!e/!! e3 eseehC .2 ! !9! /!! e3eseehC egattoC .3!!9!/!9!#//w6+++!V+^͟:!!>e3*0 go& P' !H &39gn!9 w#O!!/O!!/!"V/Ngn}tupnier esaelp ,htgnel dilavnI!!9!"reht erA$enil eht retneeR ro tcerroc fi nruter >rc< retnE05͐ !gne3nf:&! e3EPICER RUOY SI EREH!!9!s!// /!$!9!$(/@0NFݾ u>N!9! ! !9!  /! rs͐ /!! e3nietorP!!9!T//!! e3 feeB .1!!9!/!! e3 yrtluoP .2 ! !9! /!! e3 hsiF rͭ9(939>NFݾ ݾB!6 ?seipicer DDA ot tnaw uoy oD5S ͐ !!9!8!*0@0POQͭ9(9394# 40:nf#tuo  &3Fݾ ݾ͐ !0!9! 04//>NFݾ w6>NFݾ +!V+^͟:>NFݾ nfJ4Q͍/!<>OGV3+͘>NFݾ  go&>NFݾ  P .3!!9!/!! e3 sggE .4!!9!0/!! e3 snaeB .5 ! !9!e /!! e3 stuN .6!!9!/!! e3 .7!!9!! !9!  C ͠2C ͉4kwwnf^V;:knf#tuC  &3o  &3͖nf^Vͳ:҄6 & tsriF .serutaef htiw epiceR yfitnedI%!%!9!%)/ &3 ͐  epicer eht fo senil 5 retnE woN!sdeR & swolleY .5!!9!/!! e3 .6!!9!@! !9!  /! rsnf͍/^V!$͍/^V!͍/^V! ;^! 6ABSENT DONE ADDING edam eb ot snoitcerroc yna e!//!! e3 surtiC .1 ! !9!& /!! e3 noleM .2 ! !9!] /!! e3 seciuJ .3 ! !9! /!! e3 sneerG .4 ! !9! /!! e3ݾ nf#>NFݾ tu>NFݾ   &3 &3q S ͭ9(939>NFݾ gn}|ʱ!65>NFݾ +&3 >NFݾ nf^Vͳ:>NFݾ w+w ͸.Ϳ-66=O~- O+ +~0. .G+~ (0. .WxGxA(DG~ݦx,(Gͯ, DG͝,!9;+;+! !,,!  4.4.Ϳ-4P!9w ! ̀;.~ݮ w!gne3*06ͭ9(939W%ͭ9(939#3U&w*!9N#F V+^++~+ AN+둾OyFwyHB+O#!9!O~82G>+ (<+(~<#_5!~w!65!  XXX.TADPCR!   YYY.TADPCR!2  w!65!9!.   ͠2 ͉4҂ ! go!1 1'nftunftu >O  >O G #qF ?*(*!+&9fnqG?*fnp+qG!D-' (- + -':0%08!͜**ͩ;:000⯸x/Gy/Oɯ e!+&9͙8 !T]jjZj_ZfnV^͉4ڮ'###59++Fwx+0w+z  z O(!*uType error on3+nf :ͨ !!! e3:gniwollof eht fo enO tceleS!!9!,$%//!! e3sepiceR tupn(I!!9!{$/!! e3sepiceR lla tuptu(O!!9!$/!! e3epiceR a dwå>NFݾ nf#>NFݾ tu>NFݾ   &3nf>NFݾ ^VR¥ &3q S >NFݾ gn}|!65w9!9  ͠2VfnůͶ4^ ѯݾ±*z() ,F̝(*](("+) r+sFfn͉48(|(]40n({(-']48 -'w+6 +-'T( F( (*((fnpG-'E ,͉4OG ͉48x]48s(ͩ;(-'f n Nq! 6'<']48-'|͉4-'| ͙8:'.3-8͙83 > կN®'T]F(###598;5986+++ (ˆ#w+> ###598(G+++ˆ ˎ#Np+y ++Nwy+!'uRead beyond EO!PY9G!ݾ Afn( ~^( >O !% saw elif atad epiceR fo etadpu tsaL$!$!9!%!$!!9 ;/ fo stsisnoc yltnerruc eliF!!9!!!nf seipiceR ! !9!! 0//& >DD/MM/YY< etad inpuError in number, try again 9-' (-(+-'-'3-'0*:*-'3ͩ;.(7e(;E(708:8> ;+DM#4 fnr+s+p+q@ H -'3ͩ;-(+ -'394 ~+.(:e(DE(@ (85ͯ,#~0! 6+w+w+ni(F!!9!$/!! e3pot(S!!9!1%/61&w/!! e3 eciohc retnE!!9!v%*0 J&!gne3*0gn}I(i%͠&O( o( F(f%&S(s&6& ͉4OnfW_R!wO6w6gn}O(oAͩOF(fN͟gn}|š͐ eliF no sepiceR eht lla s'tahT!!9!_"/S !65!J4uw6Pw6Hw6Iw6Kww DD/MM/YY!  (] (Y (U (Q (M#(1_(-$(){8 [8:8)a8A8 0)W)zW>( (-'3 -'((fn~!9 G_~((BW>__{(+#ܯ>(#> + ٯgk9~fnw **OfnF+ ͉48]48-' ( ( xOw+/!6!9!OGV3+nf :ͨ /!! e3metsyS epiceR ehT!!9!p#// ************ !#>OGV3+nf :ͨ M wG& ************ !#>OGV syadot retne esaelP%!%!9!!%)*0 !A" w6 !V+^͟:"nfRʏ"nfR–"6/á" J&!gne3*0nfJ4!ݮ w !9w !̀;(@! ̀;{.~( ! p; ~( !p;~ݖ (GO-~ =(rW+sɯRɯR _*3M <gnRU!ͪgnW^RU!ͪ03nf[%gn}|V _   Kw!9 q: 3͛gne3nf[%ݾpVnf[$Tgn R´V 4%rs03nf[%nf[$T9շȯGO2RѯRc#fn|(R0 ###6ww##ݯ`iGO6# 6 #6#6(8#AG60> :(*55*+Fx8 !8&97Ð:w 68(.(w#H (#Ð:͙8a8{0_ +++0F X0###goͭ0 ͅ2 ͅ2#M0F X0ˆ###^2goͭ0!9 PY FfnV gow3=3| }~^(Vfn>Ͷ4f(zȯF+21̫1 10l1 Fng)))V^Ny (#ͅ2(Q:88%6#6Q:xÐ:$^Q:|:R?|:7R|:7R?|:Rb$ɯ7|z(z/W{/_|(|/g}/o# ((!= ;g!&9/4d/4 /4/4!,&9/ R09͟:h`iͩ:hͩ:hPY͟:h *~+:^#~ ::F:::N::gi#9A͙8 N8+ 8#`i###Q:^(?"!5~< #5 #58y{.! {.yG(!4.+~͋;! 4.+~͋;!4.+~͋;! 4.+~͋;!  ͞.{.! p;{. ͸.ѯݾ !9#ɯ#ɯw~(4+́; 6v +͘;5.5ɯݾ ' " ^##wÐ:!S8 !]8 !t8 !}8uDisk erroError in extending filDisk fulDirectory fulBad filename *^#~ 84 Ð:#6*6O  8 9Ð:f###%(6&777Ð:y%4.8f7###Q:"!5~< #5~< #5'"! 6!'!44~0#4 #4!!4 #4 #4! 6!!%66Ð:)~6<(3Q: ͅ2F~+++Nͅ2+G ͅ2++ݾ~c18 AOͅ2G ͅ2TRUEFALSEF~+++N ( +Nͅ2y(G++G ͅ2V^!9 z(6-+goGRw+O'E2E2dE2 E2EM2G oRW_= DM(go*7ɯt <)(33(7>b;+9(  SxDM!=)#0 |z(z/W{/_|(|/g}/o#  -# zBKgo(0|r#x ygoRM*6#~P( 4^qÐ:5 87Ð:~O9#%~#? P~Ҕ9Q:   76<+w_##~Ð: ʐ:>Ð:Ð:YÐ:v:9+++ˎ˞˦w30 ###6+++gow30 | }!C3uToo many open output file!c3uBad output file nam#}( ##|#(}#7͙80!9G AN8+ 8a6͙8 }r+sPYO>x4͙80#fn##|###6#~-   60 +A~8 ( W ͅ2 Nͅ2++++!9ѯɯR0 >0w+ G fnN++͑2| z "0  9&7>+++###w30 ###6 ###͠38&:859O8 ( (++q+6++++++ˎ#q#3###͠38^{++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ ** PROGRAM TITLE THE RECIPE SYSTEM ** ** Translated by: Raymond E. Penley from the BASIC ** version into Pascal. ** ** DATE WRITTEN: 23 FEB 1980 ** ** WRITTEN FOR: Computer hob buffer length exceeded. End_of_File = true if EOF INBUFF = input buffer } VAR CH : CHAR; ix, length : integer; begin length := 0; End_of_Text := FALSE; SETLENGTH(INBUFF,0); WHILE NOT EOF(fx) AND (CH <> EOS) DO begin records allowed *) TTY_width (* Width of teletype device *) : integer; Last_update : string 14; (* date of last file update *) matrix : packed array[1..5] of LINE; (* File Identifiers *) current_ID, (* Current file ID *) backuwritten for Pascal/Z v 3.0 ** 8 Jun 80 -Rewrote SCAN ** ** ORIGINAL PROGRAM: ** T.G.LEWIS, 'THE MIND APPLIANCE' ** HAYDEN BOOK COMPANY ** ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++} PROGRAM RECIPE; CONST default = 80; last_update := date end(* with *) end; Procedure UPDATE_MASTER; begin (* OPEN file RECIPE.MST for WRITE assign stats *) REWRITE(master, stats); with data do begin MR := MaxRecords; CR := Curr_Rcds; F1 := current_ID ; g, (* Command mode flag *) done (* Program execution flag *) : boolean; bell, (* ASCII bell char *) ch, command : char; data : datatype; End_of_File, (* End of File flag *) End_of_Text (* End of Text flag *) : boolean; byists ** ** PROGRAM SUMMARY: ** ** The recipe system stores recipes and retrives recipies ** by means of a numeric key that represents the foods ** used in the meal. Foods are divided into four ** categories according to their nutritional valstring functions---*) FUNCTION LENGTH(X: S$255): INTEGER; EXTERNAL; PROCEDURE SETLENGTH(VAR X :S$0; Y :INTEGER); EXTERNAL; (*----------------------------------------------*) (* DISK I/O *) (*----------------------------------------------*) p_ID :string 14; (* Back up file ID *) (* File descriptor *) stats :FILE of datatype; {$C- [ctrl-c checking OFF]} {$F- [floating point error checking OFF]} {$M- [integer mult & divd checking OFF]} (*---Required for Pascal/Z supplied (* Default length for strings *) str_len = 73; (* Length of a recipe line plus one char *) StrMax = 255; (* Max Length of strings allowed *) EOS = '|'; (* End of String marker *) Master = 'RCPDAT.MST'; Tab20 = 20 ; Tab15 = 15 F2 := backup_ID ; date := last_update end(* with *); WRITE(stats, data ) end; Procedure GETLINE(VAR fx : TEXT; VAR INBUFF : LINE ); { This Procedure gets a line of text from a disk file. Returns: End_of_Text = true if the input error_flag : BYTE; CRT_width, (* Width of video display *) Curr_Rcds, (* No. of current active records *) Hash, (* Computed Index value of Recipe *) ix, (* global indexer *) Last, (* length of last line read *) MaxRecords, (* Maximum ue. ** For more comments see the original program. ** ** INPUT AND OUTPUT FILES: ** RCPDAT.XXX and RCPDAT.YYY ** - the DATA and the backup files ** RCPDAT.MST - the statistics file ** ** MODIFICATION RECORD: ** 28 Feb 80 - ** 2 Jun 80 -Re Procedure OPEN_MASTER; begin (* OPEN file RECIPE.MST for READ assign stats *) RESET(master, stats); READ(stats, data ); with data do begin MaxRecords := MR; Curr_Rcds := CR; current_ID := F1; backup_ID := F2; current_ID *) F2, (* backup_ID *) date : string 14 (* last_update *) end; S$0 = STRING 0 ; { zero length string } S$255 = STRING 255 ; { max string length } VAR adding_recipies, (* adding recipies state flag *) comandin; INPUT = 0; (***** PASCAL/Z ver 3.n *****) TYPE ALFA = STRING 10 ; BYTE = 0..255; LINE = string default; Mstring = string 255 ; DataType = record MR, (* MaxRecords *) CR : integer; (* Curr_Rcds *) F1, (* If length < str_len then begin(* valid *) READ(fx, CH ); length := SUCC(length); APPEND(INBUFF,CH) end(* If *) ELSE End_of_Text := TRUE; end(* WHILE *); If length >= last then last:=length Else REPEAcase} Until valid{response} End(*---of YORN---*); Procedure CLEAR; (* Device dependent procedure *) begin Write( CHR(26) ) end; Procedure SKIP(L1 : integer); VAR ix : integer; begin FOR ix:=1 to L1 do Writeln end; Procedure PAUSE; are the ASCII char set starting at the space [ CHR(32) ] and ending at the tilde [ CHR(126) ]. *----------------------------------------------* GLOBAL StrMax = 255; BYTE = 0..255; LINE = STRING Default; *----------------------------ure PUT_RECORD( VAR fx : TEXT; VAR Index : integer ); VAR jx : integer; begin Writeln(fx, Index:5); For jx:=1 to 5 do PUTLINE(fx,matrix[jx] ); end(*---of PUT_RECORD---*); Procedure GET_RECORD(VAR fx : TEXT; VAR Index : int-----------------------------*) (* UTILITY ROUTINES *) (*----------------------------------------------*) Function YORN : boolean ; { YES/NO INPUT MODULE Returns: TRUE FOR 'Y' or 'y' INPUT FALSE FOR 'N' or 'n' INPUT } VAR ans : ALFA; ----------------------------------------------*) (* version: 3.1 /8 JUN 80/ by R.E.Penley *) (*----------------------------------------------* ** Scan will scan your input line and return: STATUS: 0 -OK, valid inputs 1 -an attempt was made to T APPEND(INBUFF,EOS); last := PRED(last) UNTIL last=length; End_of_File := EOF(fx) end(*---of GetLine---*); Procedure PUTLINE( VAR fx : TEXT; VAR this : LINE ); { This Procedure puts a line of text to a disk file } VAR CH : cha status := 1; SETLENGTH(arg_string,count) end; loop := scanning; ix := 1; While (loop=scanning) do { return status = 2 if any invalid chars found } begin If ix > LENGTH(arg_string) then loop := notfound{excellent------------------*) VAR loop : (scanning, found, notfound); ix : 1..StrMax; begin { return status = 0 if no errors detected. } status := 0; { return status = 1 if requested length is exceeded } If LENGTH(arg_string) > count then begineger ); VAR JJ : integer; begin READLN (fx, Index); FOR JJ := 1 to 5 DO GETLINE(fx,matrix[JJ]); end(*---of GET_RECORD---*); (*----------------------------------------------*) (* CONSOLE I/O *) (*----------------------------------- valid : boolean; begin REPEAT valid := true; READ(ans); CASE ans[1] of 'Y','y': YORN := true; 'N','n': YORN := false; Else: begin valid := false; Writeln(BELL, 'Please answer ''Y'' or ''N'' ') end end{exceed "count" characters - so I truncated the string at count chars for you. 2 -an invalid character was detected. You figure out what to do with it! LENGTH(arg string) = 0 means a null string input. ** Valid Alphanumeric chars r; pos : integer; begin pos := 0; REPEAT pos := SUCC(pos); CH := this[ pos ]; If CH <> EOS then Write(fx, CH) UNTIL (CH = EOS) OR (pos = str_len); Write(fx, EOS) (* Mark the End of String *) end(*---of PUTLINE---*); Proced - no invalid chars} Else If arg_string[ix] IN [' '..'~'] then{good show - keep going} ix := SUCC(ix) Else begin loop := found{invalid char}; status := 2 end end{while} End(*---of SCAN 3.1---*); (*-----------------PEAT pos := SUCC(pos); CH := this[ pos ]; If CH <> EOS then Write(CH) UNTIL (CH = EOS) OR (pos = str_len); Writeln end(*---of PRINT---*); Procedure SCAN( VAR Arg_string : LINE ; count : integer ; VAR status : BYTE ); (*-----------*) Procedure KEYIN(VAR CIX : char); EXTERNAL; (*---Single char input directly from keyboard---*) Procedure PRINT(this : Mstring); (* Print the string 'this' until EOS *) VAR CH : CHAR; pos : integer; begin pos := 0; RE CONST sign = 'Type return to continue:'; VAR dummy : char; begin SKIP(4); Write(sign); Readln(dummy) end; Procedure BREAK; begin CLEAR; SKIP(5) end; Procedure DRAW(picture : Mstring; count : integer ); { Draw a picture count timIV 2) -10, 'HERE IS YOUR RECIPE'); Writeln; ShowRecipe; Writeln; Writeln(question); YES := YORN; If YES then begin BREAK; Writeln(msg1); Writeln; For ix:=1 to 5 do begin REPEAT PRriteln; Writeln( ' ':Tab15, '1. Milk'); Writeln( ' ':Tab15, '2. Cheese' ); Writeln( ' ':Tab15, '3. Cottage Cheese'); Writeln( ' ':Tab15, '4. Cream' ); Writeln( ' ':Tab15, '5. Sour Cream'); Writeln( ' ':Tab15, '6. ', Msg1 ); D := MODULE * *----------------------------------------------*) {$C+ [ctrl-c checking ON]} Procedure InputFeatures(VAR I : integer); (****************************************** * Input Features of Recipe * ************************************ipies * *---------------------------------------*) LABEL 99; (*---EXIT---*) CONST prompt = '>'; VAR state : (absent, done, adding) ; ix, jx : integer; temp : STRING 14; One_Line : LINE; YES : boolean; (* File descriptors *) current, backup : TEXT; PROCEDURE CORRECT; CONST question = 'Are there any corrections to be made'; msg1 = 'Enter return if correct or Reenter the line'; begin REPEAT BREAK; Writeln(bell,' ':(TTY_width Dln( ' ':Tab15, '3. Fish'); Writeln( ' ':Tab15, '4. Eggs' ); Writeln( ' ':Tab15, '5. Beans'); Writeln( ' ':Tab15, '6. Nuts' ); Writeln( ' ':Tab15, '7. ', Msg1 ); P := QUIRY(7); BREAK; Writeln; Writeln( ' ':Tab15, 'Dairy' ); We Display_One(VAR Index : integer); begin Writeln; Writeln( 'Recipe #', Index:5 ); Writeln; DRAW( '- ', 20); Writeln; ShowRecipe; skip(4) end(*---of Display_One---*); (*----------------------------------------------* * ADD*****************************************} I := 252*F + 36*P + 6*D + V - 295 {******************************************} end{of InputFeatures}; Procedure InputRecipe; (*---------------------------------------* * Input individual recre Foods' ); Writeln; Writeln( ' ':Tab15, '1. Bread (flour)'); Writeln( ' ':Tab15, '2. Oats' ); Writeln( ' ':Tab15, '3. Rice'); Writeln( ' ':Tab15, '4. Corn' ); Writeln( ' ':Tab15, '5. Macaroni'); Writeln( ' ':Tab15, '6. Noodles''Enter Choice (1 to', X2:2, ') '); KEYIN(cix);write(cix); ix := (ORD(cix) - ORD('0')) UNTIL (ix>=1) AND (ix<=X2) ; QUIRY := ix end; begin Writeln; Writeln( ' Enter number of choice :'); Writeln; Writeln( ' ':Tab15, 'FibINT(matrix[ix]); SETLENGTH(one_line,0); READLN(one_Line); SCAN(one_Line, str_len - 1, error_flag); If (LENGTH(one_Line) > 0) AND (error_flag=0) then begin APPEND(one_Line,EOS); matrix[ix] := one_Line end; If error_flag IN begin CLEAR; Display_One(hash); PAUSE end end(* else *) Until state<>searching end(*--of Lookup--*); {$C+ [ctrl-c checking ON]} begin(*---File_Scan---*) CLEAR; state := absent; If adding_recipies then{re= done; end(*---add more recipies---*) UNTIL state<>adding; (*--------------------------------------------*) (* SWAP file ID`s *) (* Back Up file is now the Current file *) (*--------------------------------------------*) temp := ba{EXIT}goto 99; adding_recipies := true ; state := adding ; (* OPEN file backup_ID for WRITE assign backup *) REWRITE(backup_ID, backup); (* OPEN file current_ID for READ assign current *) RESET(current_ID, current); {$C- [ctrl-c checkinRcds := SUCC(Rcds); GET_RECORD(fa,hash); Display_One(hash); PAUSE end(* else *) UNTIL state<>searching end(*--of DUMP--*); Procedure FIND; (************************************) (* Lookup recipes from file *) (**********(one_line,0); READLN(one_line); SCAN(one_Line, str_len - 1, error_flag); If error_flag IN [1,2] then CASE error_flag of 1: writeln('Invalid length, please reinput'); 2: writeln('Alpha numerics only, please rein [1,2] then CASE error_flag of 1: writeln('Invalid length, please reinput'); 2: writeln('Alpha numerics only, please reinput') End{case} Until error_flag=0; end{for} end(* If *) Until not YES end(*---of Corre-------------------------------------*) PROCEDURE FILE_SCAN ; (* GLOBAL MaxRecords = maximum allowed records Curr_Rcds = # of recipes in file *) VAR state : (absent, found, searching) ; Rcds, index : integer; fa : TEXT; (* FCB. Fickup_ID; backup_ID := current_ID; current_ID := temp; UPDATE_MASTER;(*--status file--*) 99:(* Come here if do not desire to add *) End{*--of InputRecipe--*}; (*--------------------------------------*) (* DUMP/FIND MODULE *) (*-g OFF]} If NOT EOF(current) then begin(* COPY current to back_up *) ix := 0 ; While ix < Curr_Rcds do begin ix := SUCC(ix); GET_RECORD(current,hash); PUT_RECORD(backup,hash) end(* while *) end(* COPY current to **************************) begin {$C- [ctrl-c checking OFF]} InputFeatures(Index); REPEAT If Rcds > Curr_Rcds then state := absent Else begin Rcds := SUCC(Rcds); GET_RECORD(fa,hash); If HASH=Index then put') End{case} Until error_flag=0; APPEND(one_Line,EOS); matrix[jx] := one_Line end{For}; Correct(* if required *); Curr_Rcds := SUCC(Curr_Rcds); PUT_RECORD(backup,hash); If not adding_desired then state :ct---*); Function adding_desired : boolean ; CONST addquest = 'Do you want to ADD recipies? '; begin PAUSE; BREAK; Write(addquest); adding_desired := YORN; CLEAR end; begin(*---InputRecipe---*) If not adding_desired thenle descriptor *) Procedure DUMP; (**********************************) (* OUTPUT all Recipes from file *) (**********************************) begin REPEAT If Rcds > Curr_Rcds then state := absent Else begin es---*) Writeln('Identify Recipe with features. First '); InputFeatures(HASH); BREAK; Writeln('Now Enter 5 lines of the recipe'); Writeln; For jx := 1 to 5 DO begin REPEAT write(prompt); SETLENGTHback_up *); {$C+ [ctrl-c checking ON]} (*---Input/Enter additional recipies until done---*) (*---or curr_records > Max_Records allowed ---*) REPEAT If Curr_Rcds > MaxRecords then state := done Else begin(*---add more recipiad in new stats} OPEN_MASTER; (* OPEN file current_ID for READ assign fa *) RESET(current_ID, fa); If NOT EOF(fa) then If Curr_rcds=0 then state := absent Else begin state := searching ; Rcds := 1 ; CASE commandteln; Writeln( ' ':22, 'The Recipe System'); Writeln; DRAW('************',TTY_width DIV 12); INIT2; (* finish init now *) { Now execute the program until done } done := false; While not done do begin CLEAR; DRAW('*******rds = # BYTES per Record times # of records # BYTES per record = # chars per line + overhead per line times # of lines. ***) Curr_Rcds := 0 ; Last_Update := 'YY/MM/DD '; current_ID := 'RCPDAT.XXX '; backup_ID := 'RCPDA last_update := ' ';{<<<=== 14 spaces required ===} For ix:=1 to 8 do begin if (ix=3) or (ix=6) then ch := '/' else KEYIN(ch); write(ch); last_update[ix] := ch end{for}; writeln end(*--of INIT of 'O', 'o': DUMP; 'F', 'f': FIND End{case commmand of} end(* else *); If state=absent then begin BREAK; Writeln('That''s all the Recipes on File') end; PAUSE end(*---of File_Scan---*); (*--------------------iteln( ' ':Tab20, 'S(top'); comanding := true; WHILE comanding do begin comanding := false; Writeln; Write(' ':(Tab15), 'Enter choice ' ); KEYIN(command);write(command); CASE command of 'I', 'i': InputRe*****',TTY_width DIV 12); SKIP(3); Writeln( ' ':Tab15, 'Select One of the following:'); Writeln; Writeln( ' ':Tab20, 'I(nput Recipes'); Writeln( ' ':Tab20, 'O(utput all Recipes'); Writeln( ' ':Tab20, 'F(ind a Recipe'); WrT.YYY '; adding_recipies := false; end; Procedure INIT2; begin (* OPEN file `RECIPE.MST` for READ assign stats *) RESET(master, stats); If EOF(stats) then(* not found *) (* OPEN file `RECIPE.MST` for WRITE assign stats *) UPD2---*); (*----------------------------------------------* * MAIN PROGRAM * *----------------------------------------------*) BEGIN INIT1; (* start the initialization process here *) CLEAR; DRAW('************',TTY_width DIV 12); Wri------------------*) (* INITIALIZATION *) (*--------------------------------------*) Procedure INIT1; begin bell := CHR(7) ; CRT_width := 80 ; TTY_width := 72 ; last := str_len ; MaxRecords := 75 ; (* maximum number of recocipe; 'O', 'o', 'F', 'f': File_Scan; 'S', 's': done := true; Else: begin Write(BELL); comanding := true end End{ case } end{while comanding} end{ while not done } End{---of Program Recipe---}. d(* with *) end(* READ in data record *); SKIP(5); Writeln('Last update of Recipe data file was ', last_update); Writeln('File currently consists of ', Curr_Rcds:4, ' Recipies'); Writeln; Write('Please enter todays date '); ATE_MASTER Else begin(* READ in data record *) READ(stats, data ); with data do begin MaxRecords := MR; Curr_Rcds := CR; current_ID := F1; backup_ID := F2; last_update := date en*+*+w!*w##w!( F##N͑ ͑i^#V!{!! !!! !!!}String too lonCall by reference precision erroIndex or value out of rangAttempted divide by zerMultiply overfloStack overflo --##go͞ v v#>F Iˆ###Ogo͞!9 PY FfnV go| }~^(Vfn>Vf(zȯF+#̜] Fng)))V^Ny (#v( vF~{(+#ܯ>(#> + ٯgk9~fnw Y Y OfnF+ )88͙ ( ( xOw+G #qF ͫ (Y !r fnqGͫ fnp+qG!D͙ (- + ͙:0%08! ;:000⯸x/Gy/Oɯ e!r 9^V')f n R^Vr+snf^VRtunf^Qݾ;4# 4_!! ÿ!ر9!!9Rctros ot smeti fo rebmun retnE!!9!!000,01 =< n =< 01 !!9!!!?e9w >ݮ w !9w !(@! ~( !  ~( !~ݖ (GOj8y! yG(!4b+~! 4b+~!4b+~! 4b+~!  !  $ѯݾ ˎ#Np+y ++Nwy+! uRead beyond EO!PY9G!ݾ Afn( ~^(VfnůV^ ѯݾ z() ,F t J ̎ 9  r+sFfn)8(|(0n({(͙8 ͙w+ statementFloating point overflow/underflo ͙w6nfV+^?Ҷnf')!ͧ! V+^nfmW_R–M(j}́4# 4F!ÿ͙nf tunfW_Rcnfutunf ^@ H ͙3;-(+ ͙394 ~+.(:e(DE(@ (85 #~0! 6+w+w+w+w $+66=O~- O+ +~0b bG+~ (0b bWxGxA(DG~ݦ (G  DG !9* !T]jjZj_ZfnV^)###++Fwx+0w+z  z û!_ uType error on inpuError in number, try again 9͙ (-(+̙ę3͙0Y :Y ͙3;.(7e(;E(708:8> * DM#4 fnr+s+p+q3 ̀M(j}́nf ?Ҁnf'IҀ .pu tes I elihw yb dnats esaelP!!9!R#w6qw6+nfV+^? nf~#tunf')!ͧ^Vr+snfW_R!9#ɯ#ɯw~(4+ 6v +*5b5ɯݾ T! 9!7(  SxDM!=)#0 |z(z/W{/_|(|/g}/o#  -# zBKgo(0|r#x ygoR>F I#6 +͙T( F( (Y 7 7 fnpG͙E ,)OG )8x8s(;k ͙ (] (Y (U (Q (M#(1_(-$(){8 [8:86 a8A8 06 W6 zW>( (͙3 ͙T h fn~!9 G_~((BW>__VRtuw6++nfV+^?^nftuwnf^V')f n RV+^nf')f n RV+^?ҏ6<nf')f n RV+^rsnf')f n R^Vnf')f n RV+^r+snf * ! !B [ !  4b4b+4P!9w ! b~ݮ w~<ݖ bw !9w#+! +8 +#+*8!(! w#!9~!!9!?)N/Y( yarra eht tnirP!!9!!̀gn}Y|vgn}y|y.È/ կNT]F(###8;86+++ (ˆ#w+> ###8(G+++ˆ ! nf4# 4!è66ydaeR!!9!2 !trats ot ydaer nehw nruter sserP ! !9!V $̀!!e3TRATS!!9! nf!!e3!!!ENOD!+++Nv+G v++ݾ~T8 AOvG vTRUEFALSEF~+++N ( +Nvy(G++G vV^!9 z(6-+goGRw+O'66d6 6E>G #~-   $^|gR?|h7R|g7R?|hRb$ɯ7|z(z/W{/_|(|/g}/o# ((!= goRW_= DM(go*7ɯt <) 0 do begin m := m DIV 2; k := n - m; for j:=1 to k do begin i := j; done := FALSE; repeat or in extending filDisk fulDirectory fulBad filename *^#~ 84 0#6*6O  ͑ ́0*6#~P( 4^q05 ͑70~Ó#%~#? P~460 +A~8 ( W v Nv++++!9ѯɯR0 >0w+ G fnN++͂| z   ́>+++###͵###@8^͙+++ˎ˞˦0 ###͌+++go0 | }!uToo many open output file!~/w#~/+~w+ #~wɯ(#~+*^W#~!OG F+N ngOG F+N F+n`OG F+N+~=(ۯOG F+N+~ =(rW+sɯRɯR 'NMLIST,NMTLIS.NOP NOT ORA ORG ORI OUT OUTD OUTDR #0""L$q#s#r!(F!#6!*!!4 #4 #4!!%p  6++w+(0˞0= A[i] then done := TRUE else begin temp := A[i]; A[i] := A[i+m]; A[i+m] := temp; i := i - m; end; until (i<1) OR ( done ); end{for j}; end{While}; end;{Shellsort}{$C+,M+,F+}    76<+w_##~0 0>00Y0%6#6x0uBad output file nam#}( ##|#(}#790!9G AN͑+ ͑9 }r+sPYO>xģ90#fn##|###Č!d !,/ R0Á?h`iIhIhPY?hPROCEDURE Shellsort(VAR A : ScalarTyp; n : INDEX); { The array A[1..n] is sorted in ascending order. The method is that of D.A. Shell, (A high-speed sorting procedure, Comm. ACM 2 (1959), 30-32) with subsequences chosen as suggested by T.N. Hibberd!5~< #5~< #5'"! 6!'!44~0#4 #4!!4 #4 #4! 6!!%660)~6<(3' " ^##w0! ! ! !uDisk erroErr6# 6 #6#|(8#AG|0> :(*55*+Fx8 !+70w |8(.(w#H (#09a8{0_ +++f###%(6ʼï0y%4fʏ###"{++++++++++++++++++++++++++++++++++++++++++++++++++++++++} {+ PROGRAM TITLE: Shell Sort Test +} {+ +} {+ WRITTEN BY: Raymond E. Penley +} {+ DATE WRITTEN: 5 October 1980 +} {+ +} {+ SUMMARY: +} {+ This program demonstrates X X XX X X X X X XXX XX X XXX X X X X X X X X X XX X XXXX X X DO BEGIN ix := (131*ix+1) mod 221; A[i] := ix; if (i mod 1000 = 0) then write(i); END; writeln; A[0] := -maxint; {$C+,M+,F+ [ctrl-c ON]} writeln('Ready'); WRITE('Press return when ready to start'); readln(hellsorttest; CONST Max_N = 10000; TYPE INDEX = 0..Max_N; SCALAR = INTEGER; ScalarTyp = ARRAY [ INDEX ] OF SCALAR; VAR cix : char; {Global temp for char inputs} A : ScalarTyp; N, {The number of numbers to be sorted.} i, ix XX XX X ****** XXXXXXXXX XX XXX XX X **** X X** X X XX XX X X***X X //XXXX X begin temp := A[i]; A[i] := A[i+m]; A[i+m] := temp; i := i - m; end; until (i<1) OR ( done ); end{for j}; end{While}; end;{Shellsort}{$C+,M+,F+} BEGIN (* Main program SHELLSORT*) Repeat writeln; writeln('En the Shell sort +} {+ algorithm. +} {+ +} {+ Average sorting times in seconds * +} {+ No. of items Shellsort Quicksort QQuicksort +} {+ 1000 15 8 7 +} {+ 2000 34 20 14 cix); writeln( CHR(7), 'START'); {} Shellsort(A, N ); {} WRITELN( CHR(7), 'DONE!!!' ); writeln; write('Print the array (Y/N)?'); readln(cix); If (cix='Y') or (cix='y') then Show; END. : INTEGER; {Global indexer} Procedure Show; var i: index; begin for i:=1 to N do begin write(A[i]); if i mod 8 = 0 then writeln; end; writeln; end; PROCEDURE Shellsort(VAR A : ScalarTyp; n : INDEX); { T XXXX X // X XX X // X XXXXXXXXXXXXXXXXXX/ X XXX// X X X X X X X X X X X X X X Xter number of items to sort'); writeln(' 10 <= n <= 10,000'); write('?'); readln(N); Until (N >= 10) and (N <= Max_N); writeln; writeln('Please stand by while I set up.'); ix := 113; {$C-,M-,F- [ctrl-c OFF]} FOR i := 1 TO N +} {+ 5000 112 50 37 +} {+ 10,000 213 106 78 +} {+ +} {+ * Z80 CPU operating at 2 mcps +} {+ +} {++++++++++++++++++++++++++++++++++++++++++++++++++++++++} PROGRAM S THE Z--USERS GROUP 1981 XXXXX X XX X *** X XXXXX X ***** X XXX XX XXXX ******* XXX XXXX emp : SCALAR; begin (*$C-,M-,F-*) m := n; While m <> 0 do begin m := m DIV 2; k := n - m; for j:=1 to k do begin i := j; done := FALSE; repeat if A[i+m] >= A[i] then done := TRUE else he array A[1..n] is sorted in ascending order. The method is that of D.A. Shell, (A high-speed sorting procedure, Comm. ACM 2 (1959), 30-32) with subsequences chosen as suggested by T.N. Hibberd. } VAR i, j, k, m : integer; done : BOOLEAN; t XXXXXXXX\ XX XX X XX XX X X X XX XX XXXX XXXXXX/ X XXXX XXX XX*** X X XXXXXXXXXXXXX * * X 8 9 10 11 12 13 12 13 14 15 16 17 18 10 11 12 13 14 15 16 14 15 16 17 18 19 20 19 20 21 22 23 24 25 17 18 19 20 21 22 23 21 22 23 24 25 26 27 26 27 28 29 30 24 25 26 27 28 29 30 28 29 30 * * X** X XXXX X * * X** XX X X * ** X** X XX X * ** X* XXX X X * ** XX 6 7 8 9 10 11 12 11 12 13 14 15 16 17 15 16 17 18 19 20 21 13 14 15 16 17 18 19 18 19 20 21 22 23 24 22 23 24 25 26 27 28 20 21 22 23 24 25 26 25 26 27 28 29 30 31 29 30 27 28 29 30 17 18 19 20 21 15 16 17 18 19 20 21 18 19 20 21 22 23 24 22 23 24 25 26 27 28 22 23 24 25 26 27 28 25 26 27 28 29 30 31 29 30 31 X *---* X X X *-* * XXX X X *- * XXX X *- *X XXX *- *X X 7 8 9 10 11 12 12 13 14 15 16 17 18 9 10 11 12 13 14 15 13 14 15 16 17 18 19 19 20 21 22 23 24 25 16 17 18 19 20 21 22 20 21 22 23 24 25 26 26 27 28 29 30 31 23 24 25 26 27 28 29 27 28 29 30 31 JULY AUGUST SEPTEMBER 1 2 3 4 1 1 2 3 4 5 5 6 7 8 9 10 11 2 3 4 5 6 7 8 6 XXXX XXX * * * XXXX X X * * * X X X =======******* * * X X XXXXXXXX\ * * * /XXXXX XXXXXXXX\ 31 courtesy of Charlie Foster  22 23 24 25 26 27 28 20 21 22 23 24 25 26 25 26 27 28 29 30 31 29 30 27 28 29 30 APRIL MAY JUNE 1 2 3 4 1 2 1 2 3 4 5 6 5 6 7 8 9 10 11 3 4 5 6 7 8 9 7 XXX *- *X X XX *- *XX X X * *X* X X X * *X * X X X 30 31 OCTOBER NOVEMBER DECEMBER 1 2 3 1 2 3 4 5 6 7 1 2 3 4 5 4 5 6 7 8 9 10 8 9 10 11 12 13 14 FEBRUARY MARCH 1 2 3 1 2 3 4 5 6 7 1 2 3 4 5 6 7 4 5 6 7 8 9 10 8 9 10 11 12 13 14 8 9 10 11 12 13 14 11 12 13 14 15 16 17 15 16 ) =====********** * X ) \ ) ====* * X \ \ )XXXXX =========********** XXXXXXXXXXXXXXXXXXXXXX Happy New Year, PASCAL/Z! JANUARY *+*+w!7* w##w!( F##N3 3Ó ^#V!{!!!!! !!!3&*String too lonCall by reference precision erroIndex or value out of rangAttempted divide by zerMultiply overfloStack overfloFlo4&*4R *gڽhw6!V+^̀5Ҡinf͕*ѯjrjrjr!ͼ7 }!u4(4&*44# 41jwwkwwl6m dna!9!0 mn yarra!9!Hnf#tuInftunf #V+^͊5\ JKnf͕*ѯjrjrjr!ͼ7nf+͕*ѯjrjrjr!ͼ7Lnf͕*ѯjr!cͼ7^V!͆*jr!cͼ7V+^r+sMnf͕*~ 5+ nf#! ͜7Ygn͕*u! ñ0͋0mnf#tuR ͨ*0n f ͕*ѯjr!cͼ7V+^! 6m#tu?n f ͕*ѯjr!cͼ7^ V !͆*ating point overflow/underflo -- statement ͋0w6nftuwnf^VR#W6m^Vtu!9~ nf͕*ѯjrjrjr!ͼ7#95nf+tuw*ѯjrjrjr!ͼ7 ! ñ0͋0U  V&37V0OGV3+!.!9M brscnfW_Rʃd% nf+ͬ de% !2sap.!9!! ef% ~_+#92{OG!1B96 R 2)fg4(jr!cͼ7V+^r+s@! F+n` F+n`W_Rh A! F+n` F+n`tu4(4&*4 BnfR CDfn6DE! F+n` F+n`tuFfnw+wGnf ͕*ѯjrfnR^V r+s! ñ0͋0!9~ nf͕*ѯjrjrjr!ͼ7#9Ϳ5n nf#tuw 64(4&*4ݾڢnf^V͔5i nf! ͜7Y ݾ+nf͕*ѯjrjrjr!ͼ7#9!9O!Z)! O!Z)! O!Z)!9 !9[!9w#! O!Z) O!Z):O!Z),O!Z)+O!Z)-O!Z)/O!Z)*O!Z)(O!Z))O!Z)=O!Z).O!Z)>O!Z)<O!Z){O!Z)}O!Z)[O!Z)]O!Z)'O!4gn}*|gn}}|4(4&*4͠2{)zHgn}}|34(4&*4gn!9 !͞)ҕR *3\4w5!5 67gn#͕*u8gn} | 9gn͕*!ͼ7W^͕*u%gn͕*u&6'gn͕*u(!ñ0͋0)*H*+gn}'|±,-.H.4(4&*4gn}'|ƒH/gn}(|͠/{*zgn}{|H012H24(4&*0 no nigeb!9!0 op esac!9!:0 pq tsnoc!9!`0 qr vid!9!0 rs od!9!0 st otnwod!9!0 tu esle 2*!9N#F ~(!V+^++~+ AN+둾OyFwyHB+O#!9!O~82G>+ (<+(~<#_͋0!~w!ñ0͋0! f n Nq! ñ0͌!ɹ (<͌!ͨ*8 |* | ͂3 .&*rfnR!V+^ /+nf 6mW_Rnf͕*ѯjr!cͼ7V+^nf͔5& gogo!+& gogo! ! !9! /+nf 6mW_R! fo!9! 0  ro!9!20  dekcap!9!X0  rudecorp!9!~0  margorp!9!0  drocer!9!0  taeper!9!nf͕*ѯjr!?ͼ7V+^rsw6nf͕*ѯjr!cͼ7V+^V+^̀5& gogo!nf+ 6m# ͕*ѯjrfnR!V+^ /+nf 6mW_R~nf͕*ѯjr!cͼ7V+ = sreifitnedi latoT!!9!nf!$+w6++nfV+^̀5nf͕*ѯjr!?ͼ7F+n`++V+^goRʢ& gogo!!! e3 +& gogo!nf!9!0 uv dne!9!0 vw lanretxe!9!D0 wx elif!9!j0 xy rof!9!0 yz drawrof!9!0 z{ noitcnuf!9!0 {|  gn!9w#YO!Z)yO!Z)!͞) & gogo!+& gogo!+& gogo!:sdrow devreseR!!9!+w6++ F+n` F+n`tu4(4&*44# 4;ønf͕*ѯjr!cͼ7V+^!R& gogo!!!*e3 /+4(4&*44# 4e ?sdrow devreser edulcnI!!9!/+0  tes!9!0  gnirts!9!<0  neht!9!b0  ot!9!0  epyt!9!0  litnu!9!0  r^nf͔5~& gogo!+& gogo! ! !9!R /+nf 6mW_R¸! F+n` F+n`tu4(4&*44# 4[4(4&*44# 4͕*ѯjrjrjr!ͼ7!#9 !!9!7/+nf͕*ѯjr!?ͼ7V+^rsw6nf͕*ѯjr!cͼ7V+^V+^̀5:& gogo!nf+ 6m# ͕*ѯj otog!9!0 |} fi!9!(0 }~ ni!9!N0 ~ lebal!9!t0  dom!9!0  lin!9!0  ton!9!0 nfV+^̀5 nf͕*ѯjr!?ͼ7F+n`++V+^goR& gogo!!! e3 +& gogo!nf͕*ѯjrjrjr!ͼ7!#9 !!9!/+nf 4(4&*4j% >OGV3+!.!9M rs% nf+ͬ % !2frx.!9!! % ~_+#92{OG!1B96 & 2͕/& gogo!av!9!0  elihw!9! 0  htiw!9!F0 R **O!9~ !9!.ͺ5 &37nfnf^-̣3͂3&* > կNw!T]F('###38C(?38:(6+++ (ˆ#w+> ###38(G+++ˆ ˎ#Np+y ++Nwy+!}!uRead beyond EO!PY9G!ݾ Afn( ~^(Vfnů-^ ѯݾ$z() ,Fl"F$ output file!0uBad output file nam#}( ##|#(}#7͂30!9G AN3+ 30͂3 r+{PY_>)+~27! 4>)+~27!4>)+~27! 4>)+~27!  ((! 7( )ѯݾ !9#ɯ#&"̸"_%# r+sFfn*w!|(ͨ*0n({( *8ͨ*8 w+6 + T(t(F(f( (+%͢"͢"fnpG Ee ,*OG *8xͨ*8s(P7" (] (Y (U (Q (M#(1_(-$(){8 [8(8 PG ͡-BN͡-#F~++( 8 G ͡-F+N͡-+++ݾ~},8 (8 Gy ͡-OAO͡-TRUEFALSEF~+++N Ő( 8G ͡-( +N͡-y(G++V^!9 z(6-+goGRw+O'R+F ]+###go͵+ ͡- ͡-#R+F ]+ˆ###z-go͵+!9 PY FfnV go'0/| }~^(Vfn>-f(zȯF+H,,,+̆, Nng)))V^G~ (#X(y*w!###3++Fwx+0w+z  z "!1%uType error on inpuError in input, try again 9 (-(+  3 0+%:+% 3P7.(7e(;E(708:8> %DM#4 fnr+s+p+q@ H  3P7-(+ 3!(F!#6!*!!4 #4 #4!!+F&( 6##Nq+'6p 3 6w+(]5˞]5###Q08o+++v ~ /###O54+++ˎ˞˦'00 ###1+++go'00 | }!/uToo many openw~(4+(7 6v +?75>)5ɯݾ c! 9!7 (9;;;Ry(G#A~#0w+~w6~w+99Ny+999BG>(33(7>6+9'00 ###1 6###Q08583O:8á#a8A8 0ڡ#Wҡ#zW>( ( 3  ""fn~!9 G_~((GW>__{(+#ܯ>(#> + ٯgk9~fnw !!9G ᯼+%!D%3͂3 ý"+%OfnF+*w!|(ͨ*0#w*8Gͨ*8B a-a-da- a-Ei-G #~-   60 +A~8 ( W ͡- N͡-++++!9ѯɯR0 >0w+ G fnN++ͭ-| z '+  4+++~(4###v###-l5Y]5 2>+++###l5`i###65V(f 8###'>)4>)'4P!9w ! '7>)~ݮ w~<ݖ >)w !9w#+! +8 +#(+?78!=7! w#!9~((!9w >ݮ w !9w !94 ~+.(:e(DE(@ (85&#~0! 6+w+w+w+w )'66=O~- O+ +~0>) >)G+~ (0>) >)WxGxA(DG~ݦ&(G& DG&!9%%! !','!  4  6 #6#1(8N*>_~:(DAG*>_~ > :(*5*+~1x8I!t337]5L(C 1O 1N  1S 1T  1]5w 18(.(w#H (#͂3a8{0_ l5+++f###%(6 22boolean; one_ahead, curch: char; { the latest symbol extracted from the Pascal program } current_symbol: array[ 1..symlen ] of char; { input/output files } pasprog, xrefout: text; { for constructing file names gram to do Pascal cross reference listings } { without regard to Pascal scoping rules. It has a minimum of comments and} { was intended for internal use only } { This program may die terribly if your program is not of correct Pascal } { syntax. ~#?¿4fo4###654~0#4 #4!4~0#4 #4!ÿ4~ҵ465   76<+w_##~]5l5 ]5>]5l5]5l5Y]5l565e is a list of references, this table has a } { pointer to the start of the list } xreftable: array[ 1..tabsize ] of ^xreflist; { count the number of references for the corresponding symbol } xctr: array[ 1..tabsize ] of in1]5l5y%43f2###65"!5~< #5~< #5'"! 6!'+Fˆ"(w#w#w 44~0#4 #4!!4 #4 #4! 6!!%663)~6<(365' "xreflist = record nextlist: ^xreflist; xreflines: array[ 1..listsize ] of integer; end; $string255 = string 255; $string0 = string 0; byte = 0..255; var i, j, linepos, symcnt: integer; caps, good_ctrlEach symbol which only occurs once is marked with an '*'. } const tab = 9; cr = 13; lf = 10; blanks = ' '; symlen = 8; tabsize = 750; listsize = 10; type symbol = array[ 1..symlen ] of char; !3l5%6#665x]5l5$^l565|5R?|57R|57R?|5Rb$ɯ755?66?1616?!9 ~# 57 teger; { it is important to know the line number in order to xref } linectr: integer; firstchar: boolean; { is this the first character on this line } answer: char; { used in reading the Pascal program } already_read: (****************************************************** * * Donated to the Pascal/Z Users Group by Ithaca * Intersystems, Dec 1980. ******************************************************) Program xref; {$i+,e+,l- } { This is a quick and dirty pro ^##w]5!<3 !F3 !]3 !f3uDisk erroError in extending filDisk fulDirectory fulBad filename l5*^#~ 84 ]5#6l5*6O  3 4]5l5*6#~P( 4^q]55 37]5~O4#l5%, { set of acceptable control characters } stop, stoppnum: set of char; tab_index: integer; entry: ^xreflist; { save all of the symbols in alphabetical order } symbols: array[ 1..tabsize ] of symbol; { for each symbol therRTr+sV+^~/w#~/+~w+ #~wɯ(#~+*^W#~!OG F+N ngOG F+N F+n`OG F+N+~=(ۯOG F+N+~ =(rW+sɯRɯRr+snf++^Vr+skTnf^VnfV+^r+s!9 ~ݾ++8  ##!9 ~ݾ++8 |z(z/W{/_|(|/g}/o# ((!= 6goRW_= DM(go*7ɯt <) symbols[ k ] then i : entry := entry^.nextlist; if ptrnum = 1 then begin new( entry^.nextlist ); entry := entry^.nextlist; entry^.nextlist := nil end; entry^.xreflines[ptrnum] := ref_line end; { add the current symbol to the symbol table able } procedure add_xref( sym_index, ref_line: integer ); var ptrnum: integer; begin entry := xreftable[ sym_index ]; ptrnum := xctr[sym_index] mod listsize + 1; xctr[sym_index] := xctr[sym_index]+1; while (entry^.nextlist <> nil) dose if not eof( pasprog ) then begin read( pasprog, curch ); { convert ugly control chars to spaces } if (curch < ' ') and not(curch in good_ctrl) then curch := ' '; { convert upper to lower case } if curch in caps then curch := chr( ord( curch ) ies are the } { Pascal/Z reserved words. } procedure init( res: symbol ); var i: integer; junk: boolean; begin current_symbol := res; junk := bsearch( i ); add_symbol( i ) end; function index( x, y: $string255 ): integech = '{') then repeat repeat nextch until (curch = '*') or (curch='}') until (lookahead = ')') or (curch='}'); until not (curch in stoppnum) or eof( pasprog ); i := 0; current_symbol := blanks; { read the identifier in= k + 1 else done := true until done or (i > j ); index := k; if not done and (symbols[k] < current_symbol) then index := k + 1; bsearch := done end; { get the next character } { convert ugly control control characters to spaces t position 'index' } procedure add_symbol( index: integer ); var i: integer; begin symcnt := symcnt + 1; for i := symcnt downto index+1 do begin symbols[ i ] := symbols[ i-1 ]; xctr[ i ] := xctr[ i-1 ]; xreftable[ i ] := xreftable[ i-1 kahead := curch; already_read := true; curch := temp end; end; { find the next symbol skipping over quoted strings, comments, numbers and } { special symbols (i.e. <> ) } procedure parse; var i: byte; begin { skip characters + 32 ); end; end; { return the look-a-head character from the input stream } function lookahead: char; var temp: char; begin if already_read then lookahead := one_ahead else begin temp := curch; nextch; one_ahead := curch; loo ),' ',':',',','+','-','/','*','(',')','=','.','>', '<','{','}','[',']', '''', '^', ';' ]; stoppnum := stop + [ '0'..'9' ]; caps := [ 'A'..'Z' ]; repeat if eoln( 0 ) then write( 'File name -- ' ); readln( filnam ); linepos := out, ' ' ) end; if i mod listsize = 0 then entry := entry^.nextlist; end; if xctr[ j ] = 1 then write( xrefout, '*' ); end; write( 'Include reserved words? ' ); readln( answer ); if answer in [ 'Y', 'y' ] then be init( 'end ' ); init( 'external' ); init( 'file ' ); init( 'for ' ); init( 'forward ' ); init( 'function' ); init( 'goto ' ); init( 'if ' ); init( 'in ' ); init( 'label ' ); init(nam, '.xrf' ); rewrite( filnam, xrefout ); writeln( xrefout, 'Total identifiers = ', symcnt-38:1 ); for j := 1 to symcnt do if xreftable[ j ]^.xreflines[ 1 ] <> 0 then begin writeln( xrefout, ' ' ); write( xrefout, symbols[ j ]index( filnam, '.' ); if linepos <> 0 then setlength( filnam, linepos-1 ); append( filnam, '.pas' ); reset( filnam, pasprog ); until not eof( pasprog ); for i := 1 to tabsize do symbols[ i ] := '} '; symcnt := 0; linectr := able[ j ]; for i := 2 to xctr[ j ] do begin write( xrefout, entry^.xreflines[(i-1) mod listsize + 1]:6 ); if (i mod 10 = 0) and (xctr[ j ] > i ) then begin writeln( xrefout ); write( xrefout, ' ' ) end; gin writeln( xrefout ); writeln( xrefout ); writeln( xrefout, 'Reserved words:' ); for j := 1 to symcnt do if xreftable[ j ]^.xreflines[ 1 ] = 0 then begin writeln( xrefout, ' ' ); write( xrefout, symbols[ j ], ' ' ); entry := xreft 'mod ' ); init( 'nil ' ); init( 'not ' ); init( 'of ' ); init( 'or ' ); init( 'packed ' ); init( 'procedur' ); init( 'program ' ); init( 'record ' ); init( 'repeat ' ); init( 'set , ' ' ); entry := xreftable[ j ]; for i := 1 to xctr[ j ] do begin write( xrefout, entry^.xreflines[(i-1) mod listsize + 1]:6 ); if (i mod 10 = 0) and (xctr[ j ] > i ) then begin writeln( xrefout ); write( xref0; firstchar := true; init( 'and ' ); init( 'array ' ); init( 'begin ' ); init( 'case ' ); init( 'const ' ); init( 'div ' ); init( 'do ' ); init( 'downto ' ); init( 'else ' ); if i mod listsize = 0 then entry := entry^.nextlist; end; end; end; end.  if (i mod 10 = 0) and (xctr[ j ] > i ) then begin writeln( xrefout ); write( xrefout, ' ' ) end; parse; if current_symbol <> blanks then begin if bsearch( tab_index ) then add_xref( tab_index, linectr ) else add_symbol( tab_index ) end; end; linepos := index( filnam, '.' ); setlength( filnam, linepos-1 ); append( fil ' ); init( 'string ' ); init( 'then ' ); init( 'to ' ); init( 'type ' ); init( 'until ' ); init( 'var ' ); init( 'while ' ); init( 'with ' ); while not eof( pasprog ) do begin *+*+w!* w##w!( F##N ^#V!{!!!!! !!!6String too lonCall by reference precision erroIndex or value out of rangAttempted divide by zerMultiply overfloStack overfloFlo+ #bF m###go ͱ ͱ#bF mˆ###Šgo!9 PY FfnV go7| }~^(Vfn>f(zȯF+X-̖ Nng)))V^p+qG!Dy (- + y:0%08!e M ͌:000⯸x/Gy/Oɯ e! ͒ !T]jjZj_ZfnV^### ++Fwx+0w+z  z ã! uType error on inpuError in input, try again 9y (-(!9! TAD.2F!9! -2RHC-1RHC 2B-1B-CED 2B-1B-XEH RDDA-XEH,!,!9!@,0---------------------------------------------,!,!9!,06w go!V! 4+~n!4+~n! 4+~n!  qN! SN ͋ѯݾ !9#ɯ#ɯw~(4+d 6v +{55ɯݾ c! 9!770 ### 6#(F(f( (ö --fnpGyEe ,OG 8x͸8s(͌dy (] (Y (U (Q (M#(1_(-$(){8 [8:8, a8A8 0, W, zW>( (y3 yMafn~!9 G_~((GW>__{(+ating point overflow/underflo -- statement ͛w6!V+^͐Ҷnfͥѯjrgo^V !@mr+snf mt u(64# 4Cw6!V+^͚҈nfͥѯjrgoV+^! ͤ:!A^ G+~ (0 WxGxA(DG~ݦ@ (Gw  DGe !9͆ ͆ ! ! ÷ !  44͇ 4P!9w ! c~ݮ w~<ݖ w !9w#+! ++yy3y0ڶ :Ҷ y3͌.(7e(;E(708:8> ͆ DM#4 fnr+s+p+q@ H y3͌-(+ y394 ~+.(:e(DE(@ (85w #~0! 6+w+w+w+w ͇͋ 66=O~- O+ +~0 go!+VgnW^Rnf.!! e3?gn.gn. !!9!Z!gn !!9!!gn? !!9!gne3ͤ!e3 !!9!gne3ͤ##a8'8 O8 ( (++q+++++++ˎ#q#x^͒0#fn##|###!͊d͊ ͊͊!,/ R0͐^`i͚^͚^PY͐^ *~+^#~ FýN½gi#9A͒ N#ܯ>(#> + ٯgk9~fnw !!9G ᯼¶ ! ͒ Hö OfnF+|(͸0#w8G͸8By (; (7(3 x8w+᯼O!{ ! ͒͸0ͳY G #qF  (¶ ! fnqG fnV!͖jrgoV+^!e3?fnfͥѯjrgo!V+^?(65F# 5!! e3?! ͛gn} |gn>~|6.gnͥu! !9!!9RhTAD.1F8 +#~+{8!y! w#!9~NN!9w >ݮ w !9w !c( ! cN~ݖ ( O 8yN! N~(! S ~( !S('yG(!4+~n!uRead beyond EO!PY9G!ݾ Afn( ~^(Vfnů^ ѯݾz z() ,F ̱C Y  r+sFfn|(͸0n({(y8͸8 yw+6 +yT(t!e3?nf#tu(6 S Bɹ (<͸8y|y| ͒.6-̳͒6 > կNT]F('### 8C(? 8:(6+++ (ˆ#w+> ### 8(G+++ˆ ˎ#Np+y ++Nwy+G~ (#X(y(8 PG ͱBNͱ#F~++( 8 G ͱF+Nͱ+++ݾ~8 (8 Gy ͱOAOͱTRUEFALSEF~+++N Ő( 8G ͱ( +Nͱy(G++V^!9 z(6-+go PROGRAM COMPAREFILES; TYPE BYTE=0..255; VAR F1,F2 : FILE OF BYTE; B1,B2 : BYTE; COUNT : INTEGER; PROCEDURE HEX(N: INTEGER); VAR I : INTEGER; HEXDIGIT : ARRAY [1..4] OF INTEGER; BEGIN FOR I := 1 TO 4 DO BEGINm|F1|%6#6Fxm|$^|F|R?|7R|7R?|Rb$ɯ7|z(z/W{/_|(|/g}/o# ((!= goRW_= DM($q#s#r!(F!#6!*!!4 #4 #4!!+F&( 6##Nq+'6p   6w+(m˞m###a8o+++v ~ ###_+++ˎ˞˦70 ###+++go70 | }!Donated to the Pascal/Z Users Group, Oct 1980 * Modified by Charlie Foster ***************************************************** * * INSTRUCTIONS * * The two files that you want to compare need to * have their names changed to F1.DAT and F2.DAT. T " ^##wm!L !V !m !vuDisk erroError in extending filDisk fulDirectory fulBad filename |*^#~ 84 m#6|*6O   m|*6#~P( 4^qm5 7m~GRw+O'qqdq qEyG #~-   60 +A~8 ( W ͱ Nͱ++++!9ѯɯR0 >0w+ G fnN++ͽ| z 7  +++~(###v###|Ym>+++###|`i###F RNC RNV RNZ RP RPE RPO RRA RRAR RRC RRCR RRD gRST RV RZ S 0SBB SBCD CSBI SDED SSET SHLD "SIXD "SIYD "SLAR SP 0SPHL SPIX SPIY SRAR (SRLR 8SSPD sSTA go*7ɯt <)m|m|YV(f 8###'11+++(C^(?"!5~< #5 #5'"xz## Ư"w#w#wˆ++`i(  S_xDM!=()8 )0 0)+} E˸$}($0##0""L(**************************************************** * * CHAR COMPARE PROGRAM * * Written by Bob Harsch during a debugging * excercise. It was done hastily but it was such a * good idea that I cleaned it and now its part of our * utilities. * * 6m|y%4'f###F"!5~< #5~< #5'"! 6!'+Fˆ"(w#w#w 44~0#4 #4!!4 #4 #4! 6!!%66')~6<(3F'GO|6+++6  6 #6#(8N*>_~:(DAG*>_~ > :(*5*+~x8I!7mL(C O N  S T  mw 8(.(w#H (#͒a8{0_ |+++f###%( HEXDIGIT[I] := N MOD 16; N := N DIV 16 END; FOR I:= 4 DOWNTO 1 DO IF HEXDIGIT[I] > 9 THEN WRITE(CHR( ORD('A')+HEXDIGIT[I]-10 ):1) ELSE WRITE(HEXDIGIT[I]:1); WRITE(' '); END; (* OF HEX *) FUNCTION CHRCHK(B: BYTE): for each !! program. (You may group similar programs together). !! All lines starting !! are comments which should be !! deleted from the form. Remember to keep an original !! of the form around for submitting more than one program. !! !! This for........ DATE.................................. SIG/M USER GROUP C/O AMATEUR COMPUTER GROUP OF NEW JERSEY UCTI 1776 RARITAN ROAD SCOTCH PLAINS, NJ 07076  ',CHRCHK(B1),' ',CHRCHK(B2)); WRITELN; END; COUNT := COUNT + 1; UNTIL EOF(F1) OR EOF(F2); END.B2 THEN BEGIN HEX(COUNT); WRITE(' ':5); HEX(B1); HEX(B2); WRITE(' ',B1:3,' ',B2:3); WRITE(' !! cataloging of the disks, and in helping people choose !! which programs they might be interested in. !! !! Send the contributions with the completed forms to: !! !! CP/M Users Group !! 1651 Third Avenue !! New York, NY 10028 !! !! (If you don .BAS, .Z80, .FOR, .COB, ETC .DOC .DOCUMENTATION .COM .OBJECT CODE THE SUBMITTED FILES ARE IN THEIR PRESENT REVISION LEVEL, .... TO THE BEST OF MY KNOWLEDGE CURRENTLY IN PUBLIC DOMAIN .... UNDER MYCHAR; BEGIN IF (B < 32) OR (B > 126) THEN CHRCHK := '.' ELSE CHRCHK := CHR(B) END; (* OF CHRCHK *) BEGIN (* MAIN PROGRAM *) RESET('F1.DAT',F1); RESET('F2.DAT',F2); WRITELN('HEX-ADDR HEX-B1-B2 DEC-B1-B2 CHR1-CHR2'); W CONTRIBUTION FORM FOR SIG/M LIBRARY NAME ...........................DATE..../..../.... ADDRESS .......................................... CITY .......................STATE .....ZIP ....... PHONE .....................AFFILIATION .......'t mind, there are still a lot of us out here !! with 64 wide displays. We would appreciate your limiting !! your lines to 63 characters. <>) !! !! It is intended that this form be filled out with an !! editor, and left on the submitted disk DIRECT CONTROL HEREBY PLACED INTO PUBLIC DOMAIN. PERMISSION IS HEREBY GRANTED TO SIG/M TO DISTRIBUTE THE FILES FREELY FOR NON-COMMERCIAL PERSONAL USE. SIGNED........................RITELN('--------------------------------------------'); COUNT := 256; REPEAT READ(F1,B1); READ(F2,B2); IF B1 <> B2 THEN BEGIN HEX(COUNT); WRITE(' ':5); HEX(B1); HEX(B2); WRITE(' ',B1:3,' ',B2:3); WRITE(' !! Created 02/21/80 WLC !! Last Rev. 02/22/80 WLC !! !! If you have any comments on this form please pass !! them on to the CP/M users group. !! !! Please fill out this form for all material submitted !! to the CP/M users group. It will aid in the TTACH ALL RELEVANT DOCUMENTATION AND A DISKETTE CONTAINING THE SOURCE, ASSEMBLY/COMPILATION/LINKAGE COMMAND FILES, OBJECT CODE, AND ANY OTHER MACHINE READABLE DOCUMENTATION. PLEASE USE THE FOLLOWING FILE EXTENSIONS: .ASM .SOURCE FILE OR.... NAME OF PROGRAM, PROCEDURE, OR MODULE (CIRCLE ONE) SOURCE LANGUAGE ...........SYSTEM REQUIRED ....... MEMORY REQUIRED .........OTHER ................... DESCRIPTION OF WHAT IT DOES: HOW TO USE IT: PLEASE Am is most easily filled out with a full screen !! editor. You may do a "macro next colon" (mn:$v) to locate !! the fields which have to be filled in. !! !! Save this file as "filename.CPM" !! !! You can then delete all comments lines via... bmn!!$0l+++++++++++++++++++++++++++++++} PROGRAM QuickerQuickSortTest; CONST Max_N = 10000; TYPE index = 0..Max_N; Scalar = INTEGER; VAR cix : char; N, i, ix : Scalar; A : ARRAY [index] OF Scalar; Procedure Show; var i: index; bede to modify: !! E.G. "COM file only" !! "Well commented .ASM file" !! "Poorly commented .ASM file" etc. Does the software "drop in": !! i.e. what type of modifications are required to make !! it run? How easy is the cot that author). Also include address !! and phone if different. This program is public domain because: !! E.G. Submitted by author; author's approval, !! approval from magazine in which it was published, etc. Who would this program be useful toam to show the speed of the quick sort +} {+ with minimal storage algorithm. +} {+ +} {+ Average sorting times in seconds * +} {+ No. of items Shellsort Quicksort QQuicksort +} {+ 1000 15 8 7 +} {+ required !! which is NOT on this disk? Timing dependencies? !! !! "STANDARD CP/M" means it runs with 8" disks (or similarly !! behaving ones like Northstar), 24K or more memory, CP/M 1.4. !! !! Do you think/know it works with: CP/M 2.0? Source prtk National CP/M Users Group - Program Submission Form Submission Date: File name: !! (or names). Include a 1 line description of each !! !! examples... !! !! MORSE.ASM Sends Morse code from ASCII file to port. !! SAMPLE.DAT Sample data fi: !! e.g. "All CP/M users" or "People with Tarbell floppy !! controllers" or "People with one-disk systems" etc. Briefly describe the program function: !! Include run instructions only if not included in !! some other .DOC file on this disk. Wh 2000 34 20 14 +} {+ 5000 112 50 37 +} {+ 10,000 213 106 78 +} {+ +} {+ * Z80 CPU operating at 2 mcps +} {+ +} {+++++++++++++++++++++++++ocessor: !! I.E. if this is a source program, what do you "run it !! with"... MAC, ASM, Microsoft BASIC version x.y, TDL ASM etc. Does the software "drop in": !! i.e. what type of modifications are required to make !! it run? How easy is the cole for MORSE. Author: !! Please include address and phone number. If either !! is not to be published, so indicate, but include !! them for the Users Group disk cataloging process, !! in case there are questions. Submitted by: !! (if differen{++++++++++++++++++++++++++++++++++++++++++++++++++++++++} {+ PROGRAM TITLE: Quick sort with minimal storage +} {+ Test Program +} {+ +} {+ WRITTEN BY: Raymond E. Penley +} {+ DATE WRITTEN: October 5, 1980 +} {+ +} {+ A progr Hardware dependencies: !! E.G. specific processor, disk controller, plotter, printer, !! modem, viedo board, etc. Software dependencies: !! E.G. I/O via PROM calls, or hard-coded ports; JMPS/CALLS !! to specific machine-size BIOS; Other software ere is further documentation available: !! E.G. name the appropriate .DOC files on this disk; !! Was anything published in a magazine, etc. !! Is this a modification of a previous Users Group program, !! and if so, what was its "name" (e.g. 23.05) gin for i:=1 to N do begin write(A[i]); if i mod 8 = 0 then writeln; end; writeln; end; PROCEDURE QQSORT( left, right : INTEGER ); { + WRITTEN BY: Richard C. Singleton + DATE WRITTEN: Sept 17, 1968 + + This proc writeln(' 10 <= n <= 10,000'); write('?'); readln(N); until (N >= 10) and (N <= Max_N); writeln; writeln('Please stand by while I set up.'); {$C-,M-,F- [ctrl-c OFF]} ix := 113; FOR i := 1 TO N DO BEGIN ix := (131i, j, ix : integer; alldone, d : BOOLEAN; BEGIN {$C-,M-,F-} i := left; j := right; m := 0; ii := i; alldone := FALSE; REPEAT If ((j-i) > 10) OR ( (i = ii) and (i < j) ) then BEGIN ij := (i+j) DIV 2; t := A[ij := (i+1) to j do begin t := A[ix]; k := ix - 1; If A[k] > t then begin REPEAT A[k+1] := A[k]; k := k - 1; UNTIL A[k] <= t; A[k+1] := t; end; end;{For ix} m := m - 1; If m >= 0 edure sorts the elements of array A[1..n] into ascending order. The method used is similar to QUICKERSORT by R.S. Scowen, which in turn is similar to an algorithm given by Hibbard and to Hoare's QUICKSORT. + + Modified 6 Oct 1980 for Pascal/Z. '); {} QQSORT( 1, N ); {} WRITELN( CHR(7), 'DONE!!!' ); writeln; write('Print the array (Y/N)?'); readln(cix); If (cix='Y') or (cix='y') then Show; END. *ix+1) mod 221; A[i] := ix; if (i mod 1000 = 0) then write(i); END; writeln; A[0] := -maxint; {$C+,M+,F+ [ctrl-c ON]} writeln('Ready'); WRITE('Press return when ready to start'); readln(cix); writeln( CHR(7), 'START]; k := i; L := j; If (A[i] > t) then begin A[ij] := A[i]; A[i] := t; t := A[ij] end; If (A[j] < t) then begin A[ij] := A[j]; A[j] := t; t := A[ij]; If (A[i] > t) then begin A[ij] := A[i]; Athen begin i := IL[m]; j := IU[m]; end Else alldone := TRUE; END; UNTIL alldone; END;{of QQSORT} {$C+,M+,F+} BEGIN (* MAIN *) repeat writeln; writeln('Enter number of items to sort'); +} { GLOBAL TYPE Index = 1..N; Scalar = VAR A : array [Index] of Scalar; } VAR t, tt: Scalar; ii, ij, k, L, m : integer; IL, IU : array [0..20] of integer;{Permit sorting up to 2**(K+1)-1 elements} := tt; end Else d := TRUE; UNTIL d; If (L-i) > (j-k) then begin IL[m] := i; IU[m] := L; i := k end Else begin IL[m] := k; IU[m] := j; j := L end; m := m + 1; END Else BEGIN For ix[i] := t; t := A[ij] end; end; d := FALSE; REPEAT REPEAT L := L - 1; UNTIL A[L] <= t; REPEAT k := k + 1; UNTIL A[k] >= t; If (k <= L) then begin tt := A[L]; A[L] := A[k]; A[k]