--- Merging r29821 into '.':

U    compiler/cgobj.pas
--- Recording mergeinfo for merge of r29821 into '.':
 U   .
--- Merging r30947 into '.':
C    compiler/nmem.pas
U    compiler/jvm/njvmmem.pas
C    compiler/objcutil.pas
--- Recording mergeinfo for merge of r30947 into '.':
 G   .
--- Merging r31202 into '.':
U    compiler/utils/gppc386.pp
--- Recording mergeinfo for merge of r31202 into '.':
 G   .
--- Merging r31245 into '.':
U    compiler/symtype.pas
U    compiler/symdef.pas
--- Recording mergeinfo for merge of r31245 into '.':
 G   .
--- Merging r31289 into '.':
U    rtl/inc/aliases.inc
--- Recording mergeinfo for merge of r31289 into '.':
 G   .
--- Merging r31447 into '.':
U    compiler/aasmtai.pas
--- Recording mergeinfo for merge of r31447 into '.':
 G   .
--- Merging r31457 into '.':
C    compiler/msgtxt.inc
U    compiler/msg/errore.msg
C    compiler/msgidx.inc
--- Recording mergeinfo for merge of r31457 into '.':
 G   .
--- Merging r31909 into '.':
U    utils/rstconv.pp
--- Recording mergeinfo for merge of r31909 into '.':
 G   .
--- Merging r32087 into '.':
U    tests/webtbs/tw22376.pp
--- Recording mergeinfo for merge of r32087 into '.':
 G   .
--- Merging r32412 into '.':
G    compiler/symtype.pas
G    compiler/symdef.pas
--- Recording mergeinfo for merge of r32412 into '.':
 G   .
--- Merging r32516 into '.':
U    compiler/ncgmem.pas
A    tests/webtbs/tw29064.pp
--- Recording mergeinfo for merge of r32516 into '.':
 G   .
--- Merging r32548 into '.':
U    tests/Makefile
A    tests/createlst.mak
U    tests/utils/gparmake.pp
U    tests/Makefile.fpc
--- Recording mergeinfo for merge of r32548 into '.':
 G   .
--- Merging r32593 into '.':
U    compiler/pparautl.pas
--- Recording mergeinfo for merge of r32593 into '.':
 G   .
--- Merging r32617 into '.':
U    compiler/symsym.pas
C    compiler/ppu.pas
U    compiler/utils/ppuutils/ppudump.pp
A    tests/webtbs/uw28964.pp
A    tests/webtbs/tw28964.pp
--- Recording mergeinfo for merge of r32617 into '.':
 G   .
--- Merging r32619 into '.':
U    compiler/nmat.pas
A    tests/webtbs/tw28702.pp
--- Recording mergeinfo for merge of r32619 into '.':
 G   .
--- Merging r32627 into '.':
U    rtl/inc/ustrings.inc
--- Recording mergeinfo for merge of r32627 into '.':
 G   .
--- Merging r32632 into '.':
G    compiler/symsym.pas
--- Recording mergeinfo for merge of r32632 into '.':
 G   .
--- Merging r32633 into '.':
G    compiler/cgobj.pas
--- Recording mergeinfo for merge of r32633 into '.':
 G   .
--- Merging r32634 into '.':
U    compiler/powerpc/cpupara.pas
--- Recording mergeinfo for merge of r32634 into '.':
 G   .
--- Merging r32636 into '.':
A    tests/webtbs/tw29153.pp
U    compiler/ngtcon.pas
--- Recording mergeinfo for merge of r32636 into '.':
 G   .
--- Merging r32745 into '.':
G    compiler/pparautl.pas
U    compiler/ncal.pas
--- Recording mergeinfo for merge of r32745 into '.':
 G   .
--- Merging r32781 into '.':
G    compiler/symdef.pas
--- Recording mergeinfo for merge of r32781 into '.':
 G   .
--- Merging r33004 into '.':
U    packages/rtl-extra/src/unix/ipc.pp
--- Recording mergeinfo for merge of r33004 into '.':
 G   .
--- Merging r33112 into '.':
G    compiler/nmem.pas
--- Recording mergeinfo for merge of r33112 into '.':
 G   .
--- Merging r33157 into '.':
U    rtl/java/justrings.inc
--- Recording mergeinfo for merge of r33157 into '.':
 G   .
--- Merging r33161 into '.':
G    rtl/java/justrings.inc
--- Recording mergeinfo for merge of r33161 into '.':
 G   .
--- Merging r33167 into '.':
U    packages/numlib/tests/invgente.pas
U    packages/numlib/tests/sleglste.pas
U    packages/numlib/tests/eiggg1te.pas
U    packages/numlib/tests/roof1rte.pas
U    packages/numlib/tests/roopolte.pas
U    packages/numlib/tests/eigbs3te.pas
U    packages/numlib/tests/slegente.pas
U    packages/numlib/tests/eiggs3te.pas
U    packages/numlib/tests/spege1te.pas
U    packages/numlib/tests/invgpdte.pas
U    packages/numlib/tests/spemaxte.pas
U    packages/numlib/tests/eigts3te.pas
U    packages/numlib/tests/detgsyte.pas
U    packages/numlib/tests/slegbalt.pas
U    packages/numlib/tests/detgpbte.pas
U    packages/numlib/tests/slegsylt.pas
U    packages/numlib/tests/slegpdte.pas
U    packages/numlib/tests/slegpblt.pas
U    packages/numlib/tests/odeiv2te.pas
U    packages/numlib/tests/intge3te.pas
U    packages/numlib/tests/sledtrte.pas
U    packages/numlib/tests/eigsv1te.pas
U    packages/numlib/tests/slegtrte.pas
U    packages/numlib/tests/eigge1te.pas
U    packages/numlib/tests/eiggg4te.pas
U    packages/numlib/tests/eigbs2te.pas
U    packages/numlib/tests/eiggs2te.pas
U    packages/numlib/tests/timer.pas
U    packages/numlib/tests/eigts2te.pas
U    packages/numlib/tests/spepolte.pas
U    packages/numlib/tests/roofnrt1.pas
U    packages/numlib/tests/test.pas
U    packages/numlib/tests/odeiv1te.pas
U    packages/numlib/tests/intge2te.pas
U    packages/numlib/tests/speentte.pas
U    packages/numlib/tests/sleglslt.pas
U    packages/numlib/tests/eiggg3te.pas
U    packages/numlib/tests/eigbs1te.pas
U    packages/numlib/tests/turte.pas
U    packages/numlib/tests/invgsyte.pas
U    packages/numlib/tests/eiggs1te.pas
U    packages/numlib/tests/slegenlt.pas
U    packages/numlib/tests/eigts1te.pas
U    packages/numlib/tests/slegbate.pas
U    packages/numlib/tests/roofnrte.pas
U    packages/numlib/tests/slegsyte.pas
U    packages/numlib/tests/detgpdte.pas
U    packages/numlib/tests/slegpbte.pas
U    packages/numlib/tests/spepowte.pas
U    packages/numlib/tests/slegpdlt.pas
U    packages/numlib/tests/intge1te.pas
U    packages/numlib/tests/detgtrte.pas
U    packages/numlib/tests/eigsv3te.pas
U    packages/numlib/tests/eigge3te.pas
U    packages/numlib/tests/eiggg2te.pas
U    packages/numlib/tests/iomwrmte.pas
U    packages/numlib/tests/eigbs4te.pas
U    packages/numlib/tests/eiggs4te.pas
U    packages/numlib/tests/spesgnte.pas
U    packages/numlib/tests/eigts4te.pas
--- Recording mergeinfo for merge of r33167 into '.':
 G   .
--- Merging r33191 into '.':
U    compiler/cutils.pas
A    tests/webtbs/tw29620.pp
--- Recording mergeinfo for merge of r33191 into '.':
 G   .
--- Merging r33193 into '.':
U    compiler/symtable.pas
--- Recording mergeinfo for merge of r33193 into '.':
 G   .
--- Merging r33202 into '.':
U    compiler/options.pas
--- Recording mergeinfo for merge of r33202 into '.':
 G   .
--- Merging r33203 into '.':
U    rtl/inc/flt_core.inc
--- Recording mergeinfo for merge of r33203 into '.':
 G   .
--- Merging r33268 into '.':
U    compiler/pinline.pas
A    tests/test/tw29833.pp
--- Recording mergeinfo for merge of r33268 into '.':
 G   .
--- Merging r33270 into '.':
U    tests/test/units/sysutils/tfexpand2.pp
U    tests/test/units/system/tdir2.pp
--- Recording mergeinfo for merge of r33270 into '.':
 G   .
--- Merging r33271 into '.':
U    rtl/objpas/sysutils/sysuni.inc
A    tests/test/units/sysutils/twstralloc.pp
--- Recording mergeinfo for merge of r33271 into '.':
 G   .
--- Merging r33382 into '.':
A    tests/webtbs/tw29923.pp
G    compiler/cgobj.pas
--- Recording mergeinfo for merge of r33382 into '.':
 G   .
--- Merging r33413 into '.':
C    compiler/ncnv.pas
A    tests/webtbs/tw29930.pp
--- Recording mergeinfo for merge of r33413 into '.':
 G   .
--- Merging r33480 into '.':
U    compiler/pdecsub.pas
A    tests/webtbs/tw29992.pp
--- Recording mergeinfo for merge of r33480 into '.':
 G   .
--- Merging r33536 into '.':
U    compiler/systems.pas
--- Recording mergeinfo for merge of r33536 into '.':
 G   .
--- Merging r33539 into '.':
U    compiler/powerpc/nppcadd.pas
A    tests/webtbs/tw30035a.pp
A    tests/webtbs/tw30035.pp
--- Recording mergeinfo for merge of r33539 into '.':
 G   .
--- Merging r33567 into '.':
U    rtl/jvm/jvm.inc
--- Recording mergeinfo for merge of r33567 into '.':
 G   .

git-svn-id: branches/fixes_3_0@33584 -

.gitattributes

@@ -9526,6 +9526,7 @@ tests/bench/shortbench.pp svneol=native#text/plain
 tests/bench/stream.pp svneol=native#text/plain
 tests/bench/timer.pas svneol=native#text/plain
 tests/bench/whet.pas svneol=native#text/plain
+tests/createlst.mak svneol=native#text/plain
 tests/dbdigest.cfg.example -text
 tests/readme.txt svneol=native#text/plain
 tests/tbf/tb0001.pp svneol=native#text/plain
@@ -12370,6 +12371,7 @@ tests/test/tutf8cpl.pp svneol=native#text/plain
 tests/test/tvarpropsetter1.pp svneol=native#text/plain
 tests/test/tvarpropsetter2.pp svneol=native#text/plain
 tests/test/tvarset1.pp svneol=native#text/plain
+tests/test/tw29833.pp svneol=native#text/plain
 tests/test/twarn1.pp svneol=native#text/pascal
 tests/test/tweaklib1.pp svneol=native#text/plain
 tests/test/tweaklib2.pp svneol=native#text/plain
@@ -12664,6 +12666,7 @@ tests/test/units/sysutils/tstrcmp.pp svneol=native#text/plain
 tests/test/units/sysutils/tstrtobool.pp svneol=native#text/plain
 tests/test/units/sysutils/tunifile.pp svneol=native#text/plain
 tests/test/units/sysutils/tuplow.pp svneol=native#text/plain
+tests/test/units/sysutils/twstralloc.pp svneol=native#text/plain
 tests/test/units/sysutils/twstrcmp.pp svneol=native#text/plain
 tests/test/units/ucomplex/tcsqr1.pp svneol=native#text/pascal
 tests/test/units/variants/tcustomvariant.pp svneol=native#text/plain
@@ -14320,6 +14323,7 @@ tests/webtbs/tw2859.pp svneol=native#text/plain
 tests/webtbs/tw28593.pp svneol=native#text/plain
 tests/webtbs/tw2865.pp svneol=native#text/plain
 tests/webtbs/tw28674.pp svneol=native#text/pascal
+tests/webtbs/tw28702.pp svneol=native#text/plain
 tests/webtbs/tw28718a.pp svneol=native#text/plain
 tests/webtbs/tw28718b.pp svneol=native#text/plain
 tests/webtbs/tw28718c.pp svneol=native#text/plain
@@ -14334,15 +14338,18 @@ tests/webtbs/tw2886.pp svneol=native#text/plain
 tests/webtbs/tw2891.pp svneol=native#text/plain
 tests/webtbs/tw2892.pp svneol=native#text/plain
 tests/webtbs/tw28934.pp svneol=native#text/plain
+tests/webtbs/tw28964.pp svneol=native#text/plain
 tests/webtbs/tw2897.pp svneol=native#text/plain
 tests/webtbs/tw2899.pp svneol=native#text/plain
 tests/webtbs/tw29030.pp svneol=native#text/plain
 tests/webtbs/tw2904.pp svneol=native#text/plain
 tests/webtbs/tw29040.pp svneol=native#text/plain
+tests/webtbs/tw29064.pp svneol=native#text/plain
 tests/webtbs/tw2908.pp svneol=native#text/plain
 tests/webtbs/tw2911.pp svneol=native#text/plain
 tests/webtbs/tw2912.pp svneol=native#text/plain
 tests/webtbs/tw2913.pp svneol=native#text/plain
+tests/webtbs/tw29153.pp svneol=native#text/plain
 tests/webtbs/tw2916.pp svneol=native#text/plain
 tests/webtbs/tw2920.pp svneol=native#text/plain
 tests/webtbs/tw2923.pp svneol=native#text/plain
@@ -14361,6 +14368,7 @@ tests/webtbs/tw29547.pp svneol=native#text/plain
 tests/webtbs/tw2956.pp svneol=native#text/plain
 tests/webtbs/tw2958.pp svneol=native#text/plain
 tests/webtbs/tw29609.pp svneol=native#text/pascal
+tests/webtbs/tw29620.pp svneol=native#text/plain
 tests/webtbs/tw2966.pp svneol=native#text/plain
 tests/webtbs/tw29745.pp svneol=native#text/pascal
 tests/webtbs/tw2975.pp svneol=native#text/plain
@@ -14368,8 +14376,13 @@ tests/webtbs/tw2976.pp svneol=native#text/plain
 tests/webtbs/tw29792.pp svneol=native#text/pascal
 tests/webtbs/tw2983.pp svneol=native#text/plain
 tests/webtbs/tw2984.pp svneol=native#text/plain
+tests/webtbs/tw29923.pp svneol=native#text/plain
+tests/webtbs/tw29930.pp svneol=native#text/plain
 tests/webtbs/tw2998.pp svneol=native#text/plain
 tests/webtbs/tw2999.pp svneol=native#text/plain
+tests/webtbs/tw29992.pp svneol=native#text/plain
+tests/webtbs/tw30035.pp svneol=native#text/plain
+tests/webtbs/tw30035a.pp svneol=native#text/plain
 tests/webtbs/tw3004.pp svneol=native#text/plain
 tests/webtbs/tw3005.pp svneol=native#text/plain
 tests/webtbs/tw3010.pp svneol=native#text/plain
@@ -15045,6 +15058,7 @@ tests/webtbs/uw2731.pp svneol=native#text/plain
 tests/webtbs/uw27320.defaults.pp svneol=native#text/pascal
 tests/webtbs/uw2738.pp svneol=native#text/plain
 tests/webtbs/uw2834.pp svneol=native#text/plain
+tests/webtbs/uw28964.pp svneol=native#text/plain
 tests/webtbs/uw2920.pp svneol=native#text/plain
 tests/webtbs/uw2956.pp svneol=native#text/plain
 tests/webtbs/uw2984.pp svneol=native#text/plain

compiler/aasmtai.pas

@@ -298,7 +298,7 @@ interface
                    ,ait_directive
                    ,ait_varloc,
 {$ifdef JVM}
-                   ait_jvar, ait_jcatch,
+                   ait_jvar,
 {$endif JVM}
                    ait_seh_directive];
 

compiler/cgobj.pas

@@ -1120,8 +1120,12 @@ implementation
                cgsize:=paraloc.size;
                if paraloc.shiftval>0 then
                  a_op_const_reg_reg(list,OP_SHL,OS_INT,paraloc.shiftval,paraloc.register,paraloc.register)
+               { in case the original size was 3 or 5/6/7 bytes, the value was
+                 shifted to the top of the to 4 resp. 8 byte register on the
+                 caller side and needs to be stored with those bytes at the
+                 start of the reference -> don't shift right }
                else if (paraloc.shiftval<0) and
-                       (sizeleft in [1,2,4]) then
+                       ((-paraloc.shiftval) in [1,2,4]) then
                  begin
                    a_op_const_reg_reg(list,OP_SHR,OS_INT,-paraloc.shiftval,paraloc.register,paraloc.register);
                    { convert to a register of 1/2/4 bytes in size, since the
@@ -1333,8 +1337,10 @@ implementation
                       dec(tmpref.offset)
                     else
                       inc(tmpref.offset);
-                    a_load_ref_reg(list,OS_8,OS_16,tmpref,register);
-                    a_op_reg_reg(list,OP_OR,OS_16,tmpreg,register);
+                    tmpreg2:=makeregsize(list,register,OS_16);
+                    a_load_ref_reg(list,OS_8,OS_16,tmpref,tmpreg2);
+                    a_op_reg_reg(list,OP_OR,OS_16,tmpreg,tmpreg2);
+                    a_load_reg_reg(list,fromsize,tosize,tmpreg2,register);
                   end;
               OS_32,OS_S32:
                 if ref.alignment=2 then
@@ -1348,8 +1354,10 @@ implementation
                       dec(tmpref.offset,2)
                     else
                       inc(tmpref.offset,2);
-                    a_load_ref_reg(list,OS_16,OS_32,tmpref,register);
-                    a_op_reg_reg(list,OP_OR,OS_32,tmpreg,register);
+                    tmpreg2:=makeregsize(list,register,OS_32);
+                    a_load_ref_reg(list,OS_16,OS_32,tmpref,tmpreg2);
+                    a_op_reg_reg(list,OP_OR,OS_32,tmpreg,tmpreg2);
+                    a_load_reg_reg(list,fromsize,tosize,tmpreg2,register);
                   end
                 else
                   begin
@@ -1368,7 +1376,7 @@ implementation
                         a_load_ref_reg(list,OS_8,OS_32,tmpref,tmpreg2);
                         a_op_reg_reg(list,OP_OR,OS_32,tmpreg2,tmpreg);
                       end;
-                    a_load_reg_reg(list,OS_32,OS_32,tmpreg,register);
+                    a_load_reg_reg(list,fromsize,tosize,tmpreg,register);
                   end
               else
                 a_load_ref_reg(list,fromsize,tosize,tmpref,register);

compiler/cutils.pas

@@ -103,6 +103,7 @@ interface
        exponent value is returned in power.
     }
     function ispowerof2(value : int64;out power : longint) : boolean;
+    function ispowerof2(value : Tconstexprint;out power : longint) : boolean;
     function nextpowerof2(value : int64; out power: longint) : int64;
 {$ifdef VER2_6}  { only 2.7.1+ has a popcnt function in the system unit }
     function PopCnt(AValue : Byte): Byte;
@@ -866,6 +867,22 @@ implementation
       end;
 
 
+    function ispowerof2(value: Tconstexprint; out power: longint): boolean;
+      begin
+        if value.signed or
+           (value.uvalue<=high(int64)) then
+          result:=ispowerof2(value.svalue,power)
+        else if not value.signed and
+            (value.svalue=low(int64)) then
+          begin
+            result:=true;
+            power:=63;
+          end
+        else
+          result:=false;
+      end;
+
+
     function nextpowerof2(value : int64; out power: longint) : int64;
     {
       returns the power of 2 >= value

compiler/jvm/njvmmem.pas

@@ -47,6 +47,7 @@ interface
        end;
 
        tjvmloadvmtaddrnode = class(tcgloadvmtaddrnode)
+         function pass_1: tnode; override;
          procedure pass_generate_code; override;
        end;
 
@@ -291,6 +292,28 @@ implementation
                          TJVMLOADVMTADDRNODE
 *****************************************************************************}
 
+    function tjvmloadvmtaddrnode.pass_1: tnode;
+      var
+        vs: tsym;
+      begin
+        result:=nil;
+        if is_javaclass(left.resultdef) and
+           (left.nodetype<>typen) and
+           (left.resultdef.typ<>classrefdef) then
+          begin
+            { call java.lang.Object.getClass() }
+            vs:=search_struct_member(tobjectdef(left.resultdef),'GETCLASS');
+            if not assigned(vs) or
+               (tsym(vs).typ<>procsym) then
+              internalerror(2011041901);
+            result:=ccallnode.create(nil,tprocsym(vs),vs.owner,left,[]);
+            inserttypeconv_explicit(result,resultdef);
+            { reused }
+            left:=nil;
+          end;
+      end;
+
+
     procedure tjvmloadvmtaddrnode.pass_generate_code;
       begin
         current_asmdata.CurrAsmList.concat(taicpu.op_sym(a_ldc,current_asmdata.RefAsmSymbol(

compiler/msg/errore.msg

@@ -2200,7 +2200,7 @@ sym_w_experimental_unit=05079_W_Unit "$1" is experimental
 % declared as \var{experimental} is used. Experimental units
 % might disappear or change semantics in future versions. Usage of this unit
 % should be avoided as much as possible.
-sym_e_formal_class_not_resolved=05080_E_No complete definition of the formally declared class "$1" is in scope
+sym_e_formal_class_not_resolved=05080_E_No full definition of the formally declared class "$1" is in scope. Add the unit containing its full definition to the uses clause.
 % Objecive-C and Java classes can be imported formally, without using the the unit in which it is fully declared.
 % This enables making forward references to such classes and breaking circular dependencies amongst units.
 % However, as soon as you wish to actually do something with an entity of this class type (such as

compiler/msgidx.inc

@@ -1001,7 +1001,7 @@ const
   option_info=11024;
   option_help_pages=11025;
 
-  MsgTxtSize = 74524;
+  MsgTxtSize = 74585;
 
   MsgIdxMax : array[1..20] of longint=(
     26,99,339,123,96,57,126,27,202,64,

compiler/ncal.pas

@@ -1754,7 +1754,7 @@ implementation
                 begin
                   maybe_load_in_temp(p);
                   hightree:=caddnode.create(subn,geninlinenode(in_length_x,false,p.getcopy),
-                                            cordconstnode.create(1,sinttype,false));
+                                            cordconstnode.create(1,ptrsinttype,false));
                   loadconst:=false;
                 end;
            end;
@@ -1762,13 +1762,13 @@ implementation
           len:=0;
         end;
         if loadconst then
-          hightree:=cordconstnode.create(len,sinttype,true)
+          hightree:=cordconstnode.create(len,ptrsinttype,true)
         else
           begin
             if not assigned(hightree) then
               internalerror(200304071);
             { Need to use explicit, because it can also be a enum }
-            hightree:=ctypeconvnode.create_internal(hightree,sinttype);
+            hightree:=ctypeconvnode.create_internal(hightree,ptrsinttype);
           end;
         result:=hightree;
       end;

compiler/ncgmem.pas

@@ -938,8 +938,10 @@ implementation
            begin
               { may happen in case of function results }
               case left.location.loc of
+                LOC_CSUBSETREG,
                 LOC_CREGISTER,
                 LOC_CMMREGISTER,
+                LOC_SUBSETREG,
                 LOC_REGISTER,
                 LOC_MMREGISTER:
                   hlcg.location_force_mem(current_asmdata.CurrAsmList,left.location,left.resultdef);

compiler/ncnv.pas

@@ -2510,8 +2510,11 @@ implementation
                 result:=
                   (docheckremove64bittypeconvs(tbinarynode(n).left) and
                    docheckremove64bittypeconvs(tbinarynode(n).right)) or
-                  ((n.nodetype=andn) and wasoriginallyint32(tbinarynode(n).left)) or
-                  ((n.nodetype=andn) and wasoriginallyint32(tbinarynode(n).right));
+                  { in case of div/mod, the result of that division/modulo can
+                    usually be different in 32 and 64 bit }
+                  (not gotdivmod and
+                   (((n.nodetype=andn) and wasoriginallyint32(tbinarynode(n).left)) or
+                    ((n.nodetype=andn) and wasoriginallyint32(tbinarynode(n).right))));
               end;
           end;
         end;

compiler/ngtcon.pas

@@ -436,7 +436,6 @@ function get_next_varsym(def: tabstractrecorddef; const SymList:TFPHashObjectLis
       var
         strlength : aint;
         strval    : pchar;
-        strch     : char;
         ll        : tasmlabofs;
         ca        : pchar;
         winlike   : boolean;
@@ -445,7 +444,8 @@ function get_next_varsym(def: tabstractrecorddef; const SymList:TFPHashObjectLis
         strval:='';
         { load strval and strlength of the constant tree }
         if (node.nodetype=stringconstn) or is_wide_or_unicode_string(def) or is_constwidecharnode(node) or
-          ((node.nodetype=typen) and is_interfacecorba(ttypenode(node).typedef)) then
+          ((node.nodetype=typen) and is_interfacecorba(ttypenode(node).typedef)) or
+          is_constcharnode(node) then
           begin
             { convert to the expected string type so that
               for widestrings strval is a pcompilerwidestring }
@@ -472,14 +472,6 @@ function get_next_varsym(def: tabstractrecorddef; const SymList:TFPHashObjectLis
                   CGMessage(parser_e_widestring_to_ansi_compile_time);
               end;
           end
-        else if is_constcharnode(node) then
-          begin
-            { strval:=pchar(@tordconstnode(node).value);
-              THIS FAIL on BIG_ENDIAN MACHINES PM }
-            strch:=chr(tordconstnode(node).value.svalue and $ff);
-            strval:=@strch;
-            strlength:=1
-          end
         else if is_constresourcestringnode(node) then
           begin
             hsym:=tconstsym(tloadnode(node).symtableentry);

compiler/nmat.pas

@@ -133,6 +133,16 @@ implementation
                 { recover }
                 tordconstnode(right).value := 1;
               end;
+            { the following simplification is also required for correctness
+              on x86, as its transformation of divisions by constants to
+              multiplications and shifts does not handle -1 correctly }
+            if (rv=-1) and
+               (nodetype=divn) then
+              begin
+                result:=cunaryminusnode.create(left);
+                left:=nil;
+                exit;
+              end;
             if (nf_isomod in flags) and
               (rv<=0) then
                begin

compiler/nmem.pas

@@ -145,7 +145,7 @@ implementation
       globtype,systems,constexp,
       cutils,verbose,globals,
       symconst,symbase,defutil,defcmp,
-      nbas,nutils,
+      nbas,ninl,nutils,objcutil,
       wpobase,
 {$ifdef i8086}
       cpuinfo,
@@ -240,39 +240,27 @@ implementation
            include(current_procinfo.flags,pi_needs_got);
          if left.nodetype<>typen then
            begin
-             if is_objcclass(left.resultdef) and
-                (left.nodetype<>typen) then
+             if (is_objc_class_or_protocol(left.resultdef) or
+                 is_objcclassref(left.resultdef)) then
                begin
-                 { don't use the ISA field name, assume this field is at offset
-                   0 (just like gcc/clang) }
-                 result:=ctypeconvnode.create_internal(left,voidpointertype);
-                 result:=cderefnode.create(result);
-                 inserttypeconv_internal(result,resultdef);
-                 { reused }
-                 left:=nil;
-               end
-             else if is_javaclass(left.resultdef) and
-                (left.nodetype<>typen) and
-                (left.resultdef.typ<>classrefdef) then
-               begin
-                 { call java.lang.Object.getClass() }
-                 vs:=search_struct_member(tobjectdef(left.resultdef),'GETCLASS');
-                 if not assigned(vs) or
-                    (tsym(vs).typ<>procsym) then
-                   internalerror(2011041901);
-                 result:=ccallnode.create(nil,tprocsym(vs),vs.owner,left,[]);
-                 inserttypeconv_explicit(result,resultdef);
+                 { on non-fragile ABI platforms, the ISA pointer may be opaque
+                   and we must call Object_getClass to obtain the real ISA
+                   pointer }
+                 if target_info.system in systems_objc_nfabi then
+                   begin
+                     result:=ccallnode.createinternfromunit('OBJC','OBJECT_GETCLASS',ccallparanode.create(left,nil));
+                     inserttypeconv_explicit(result,resultdef);
+                   end
+                 else
+                   result:=objcloadbasefield(left,'ISA');
                  { reused }
                  left:=nil;
                end
              else
-               firstpass(left)
+               firstpass(left);
            end
          else if not is_objcclass(left.resultdef) and
-                 not is_objcclassref(left.resultdef) and
-                 not is_javaclass(left.resultdef) and
-                 not is_javaclassref(left.resultdef) and
-                 not is_javainterface(left.resultdef) then
+                 not is_objcclassref(left.resultdef) then
            begin
              if not(nf_ignore_for_wpo in flags) and
                 (not assigned(current_procinfo) or

compiler/objcutil.pas

@@ -45,6 +45,10 @@ interface
     { Exports all assembler symbols related to the obj-c class }
     procedure exportobjcclass(def: tobjectdef);
 
+    { loads a field of an Objective-C root class (such as ISA) }
+    function objcloadbasefield(n: tnode; const fieldname: string): tnode;
+
+
 implementation
 
     uses
@@ -112,12 +116,23 @@ end;
       var
         vs         : tsym;
       begin
-        result:=cderefnode.create(ctypeconvnode.create_internal(n,objc_idtype));
         vs:=tsym(tabstractrecorddef(objc_objecttype).symtable.Find(fieldname));
         if not assigned(vs) or
            (vs.typ<>fieldvarsym) then
           internalerror(200911301);
-        result:=csubscriptnode.create(vs,result);
+        if fieldname='ISA' then
+          result:=ctypeconvnode.create_internal(
+            cderefnode.create(
+              ctypeconvnode.create_internal(n,
+                getpointerdef(getpointerdef(voidpointertype))
+              )
+            ),tfieldvarsym(vs).vardef
+          )
+        else
+          begin
+            result:=cderefnode.create(ctypeconvnode.create_internal(n,objc_idtype));
+            result:=csubscriptnode.create(vs,result);
+          end;
       end;
 
 
@@ -147,7 +162,7 @@ end;
 {$endif onlymacosx10_6 or arm}
                   result:=cloadvmtaddrnode.create(ctypenode.create(tobjectdef(tclassrefdef(def).pointeddef).childof.childof));
                 tloadvmtaddrnode(result).forcall:=true;
-                result:=objcloadbasefield(result,'ISA');
+                result:=cloadvmtaddrnode.create(result);
                 typecheckpass(result);
                 { we're done }
                 exit;

compiler/options.pas

@@ -3079,7 +3079,7 @@ end;
                               Callable Routines
 ****************************************************************************}
 
-function check_configfile(const fn:string;var foundfn:string):boolean;
+function check_configfile(fn:string; var foundfn:string):boolean;
 
   function CfgFileExists(const fn:string):boolean;
   begin

compiler/pdecsub.pas

@@ -255,7 +255,7 @@ implementation
                vs:=tparavarsym(sc[0]);
                if sc.count>1 then
                  Message(parser_e_default_value_only_one_para);
-               if not(vs.varspez in [vs_value,vs_const]) then
+               if not(vs.varspez in [vs_value,vs_const,vs_constref]) then
                  Message(parser_e_default_value_val_const);
                bt:=block_type;
                block_type:=bt_const;

compiler/pinline.pas

@@ -519,6 +519,7 @@ implementation
       var
         paras, strpara, pcharpara: tnode;
         procname: string;
+        cp: tstringencoding;
       begin
         consume(_LKLAMMER);
         paras:=parse_paras(false,false,_RKLAMMER);
@@ -538,7 +539,12 @@ implementation
                   ( = paras.right.right) is an ansistring, add a codepage
                   parameter }
                 if is_ansistring(strpara.resultdef) then
-                  paras:=ccallparanode.create(genintconstnode(tstringdef(strpara.resultdef).encoding),paras);
+                  begin
+                    cp:=tstringdef(strpara.resultdef).encoding;
+                    if (cp=globals.CP_NONE) then
+                      cp:=0;
+                    paras:=ccallparanode.create(genintconstnode(cp),paras);
+                  end;
                 procname:='fpc_setstring_'+tstringdef(strpara.resultdef).stringtypname;
                 { decide which version to call based on the second parameter }
                 if not is_shortstring(strpara.resultdef) then

compiler/powerpc/cpupara.pas

@@ -497,9 +497,9 @@ unit cpupara;
                         registers is left-aligned }
                       if (target_info.system in systems_aix) and
                          (paradef.typ = recorddef) and
-                         (tcgsize2size[paraloc^.size] <> sizeof(aint)) then
+                         (paralen < sizeof(aint)) then
                         begin
-                          paraloc^.shiftval := (sizeof(aint)-tcgsize2size[paraloc^.size])*(-8);
+                          paraloc^.shiftval := (sizeof(aint)-paralen)*(-8);
                           paraloc^.size := OS_INT;
                           paraloc^.def := u32inttype;
                         end;

compiler/powerpc/nppcadd.pas

@@ -473,7 +473,8 @@ interface
           end
         else
           begin
-            if is_signed(resultdef) then
+            if is_signed(left.resultdef) and
+               is_signed(right.resultdef) then
               begin
                 case nodetype of
                   addn:

compiler/pparautl.pas

@@ -115,7 +115,9 @@ implementation
             { Generate frame pointer. It can't be put in a register since it
               must be accessable from nested routines }
             if not(target_info.system in systems_fpnestedstruct) or
-               { in case of errors, prevent invalid type cast }
+               { in case of errors or declared procvardef types, prevent invalid
+                 type cast and possible nil pointer dereference }
+               not assigned(pd.owner.defowner) or
                (pd.owner.defowner.typ<>procdef) then
               begin
                 vs:=cparavarsym.create('$parentfp',paranr,vs_value
@@ -316,7 +318,7 @@ implementation
            { needs high parameter ? }
            if paramanager.push_high_param(varspez,vardef,pd.proccalloption) then
              begin
-               hvs:=cparavarsym.create('$high'+name,paranr+1,vs_const,sinttype,[vo_is_high_para,vo_is_hidden_para]);
+               hvs:=cparavarsym.create('$high'+name,paranr+1,vs_const,ptrsinttype,[vo_is_high_para,vo_is_hidden_para]);
                hvs.symoptions:=[];
                owner.insert(hvs);
                { don't place to register if it will be accessed from implicit finally block }

compiler/ppu.pas

@@ -43,7 +43,7 @@ type
 {$endif Test_Double_checksum}
 
 const
-  CurrentPPUVersion = 172;
+  CurrentPPUVersion = 173;
 
 { buffer sizes }
   maxentrysize = 1024;

compiler/symdef.pas

@@ -64,7 +64,11 @@ interface
 
        tstoreddef = class(tdef)
        private
+{$ifdef symansistr}
+          _fullownerhierarchyname : ansistring;
+{$else symansistr}
           _fullownerhierarchyname : pshortstring;
+{$endif symansistr}
           procedure writeentry(ppufile: tcompilerppufile; ibnr: byte);
        protected
           typesymderef  : tderef;
@@ -100,9 +104,9 @@ interface
           function  alignment:shortint;override;
           function  is_publishable : boolean;override;
           function  needs_inittable : boolean;override;
-          function  rtti_mangledname(rt:trttitype):string;override;
+          function  rtti_mangledname(rt:trttitype):TSymStr;override;
           function  OwnerHierarchyName: string; override;
-          function  fullownerhierarchyname:string;override;
+          function  fullownerhierarchyname:TSymStr;override;
           function  needs_separate_initrtti:boolean;override;
           function  in_currentunit: boolean;
           { regvars }
@@ -427,7 +431,7 @@ interface
           function  is_publishable : boolean;override;
           function  needs_inittable : boolean;override;
           function  needs_separate_initrtti : boolean;override;
-          function  rtti_mangledname(rt:trttitype):string;override;
+          function  rtti_mangledname(rt:trttitype):TSymStr;override;
           function  vmt_mangledname : TSymStr;
           procedure check_forwards; override;
           procedure insertvmt;
@@ -462,7 +466,7 @@ interface
           function getcopy:tstoreddef;override;
           function GetTypeName:string;override;
           function is_publishable : boolean;override;
-          function rtti_mangledname(rt:trttitype):string;override;
+          function rtti_mangledname(rt:trttitype):TSymStr;override;
           procedure register_created_object_type;override;
        end;
        tclassrefdefclass = class of tclassrefdef;
@@ -1708,7 +1712,9 @@ implementation
             dispose(pderef(genericparaderefs[i]));
         genericparaderefs.free;
         genconstraintdata.free;
+{$ifndef symansistr}
         stringdispose(_fullownerhierarchyname);
+{$endif not symansistr}
         inherited destroy;
       end;
 
@@ -1776,7 +1782,7 @@ implementation
       end;
 
 
-    function tstoreddef.rtti_mangledname(rt : trttitype) : string;
+    function tstoreddef.rtti_mangledname(rt : trttitype) : TSymStr;
       var
         prefix : string[4];
       begin
@@ -1815,25 +1821,29 @@ implementation
         until tmp=nil;
       end;
 
-    function tstoreddef.fullownerhierarchyname: string;
+    function tstoreddef.fullownerhierarchyname: TSymStr;
       var
+        lastowner: tsymtable;
         tmp: tdef;
       begin
+{$ifdef symansistr}
+        if _fullownerhierarchyname<>'' then
+          exit(_fullownerhierarchyname);
+{$else symansistr}
         if assigned(_fullownerhierarchyname) then
-          begin
-            result:=_fullownerhierarchyname^;
-            exit;
-          end;
+          exit(_fullownerhierarchyname^);
+{$endif symansistr}
         { the def can only reside inside structured types or
           procedures/functions/methods }
         tmp:=self;
         result:='';
         repeat
+          lastowner:=tmp.owner;
           { can be not assigned in case of a forwarddef }
-          if not assigned(tmp.owner) then
+          if not assigned(lastowner) then
             break
           else
-            tmp:=tdef(tmp.owner.defowner);
+            tmp:=tdef(lastowner.defowner);
           if not assigned(tmp) then
             break;
           if tmp.typ in [recorddef,objectdef] then
@@ -1842,7 +1852,15 @@ implementation
             if tmp.typ=procdef then
               result:=tprocdef(tmp).customprocname([pno_paranames,pno_proctypeoption])+'.'+result;
         until tmp=nil;
+        { add the unit name }
+        if assigned(lastowner) and
+           assigned(lastowner.realname) then
+          result:=lastowner.realname^+'.'+result;
+{$ifdef symansistr}
+        _fullownerhierarchyname:=result;
+{$else symansistr}
         _fullownerhierarchyname:=stringdup(result);
+{$endif symansistr}
       end;
 
 
@@ -3250,7 +3268,7 @@ implementation
       end;
 
 
-    function tclassrefdef.rtti_mangledname(rt: trttitype): string;
+    function tclassrefdef.rtti_mangledname(rt: trttitype): TSymStr;
       begin
         if (tobjectdef(pointeddef).objecttype<>odt_objcclass) then
           result:=inherited rtti_mangledname(rt)
@@ -6587,7 +6605,7 @@ implementation
         result:=not (objecttype in [odt_interfacecom,odt_interfacecorba,odt_dispinterface]);
       end;
 
-    function tobjectdef.rtti_mangledname(rt: trttitype): string;
+    function tobjectdef.rtti_mangledname(rt: trttitype): TSymStr;
       begin
         if not(objecttype in [odt_objcclass,odt_objcprotocol]) then
           result:=inherited rtti_mangledname(rt)

compiler/symsym.pas

@@ -2417,6 +2417,7 @@ implementation
            conststring,
            constresourcestring :
              begin
+               ppufile.getderef(constdefderef);
                value.len:=ppufile.getlongint;
                getmem(pc,value.len+1);
                ppufile.getdata(pc^,value.len);
@@ -2439,10 +2440,12 @@ implementation
              end;
            constguid :
              begin
+               ppufile.getderef(constdefderef);
                new(pguid(value.valueptr));
                ppufile.getdata(value.valueptr^,sizeof(tguid));
              end;
-           constnil : ;
+           constnil :
+             ppufile.getderef(constdefderef);
            else
              Message1(unit_f_ppu_invalid_entry,tostr(ord(consttyp)));
          end;
@@ -2471,15 +2474,27 @@ implementation
 
     procedure tconstsym.buildderef;
       begin
-        if consttyp in [constord,constreal,constpointer,constset] then
-          constdefderef.build(constdef);
+        case consttyp  of
+          constnil,constord,constreal,constpointer,constset,conststring,constresourcestring,constguid:
+            constdefderef.build(constdef);
+          constwstring:
+            ;
+          else
+            internalerror(2015120802);
+        end;
       end;
 
 
     procedure tconstsym.deref;
       begin
-        if consttyp in [constord,constreal,constpointer,constset] then
-          constdef:=tdef(constdefderef.resolve);
+        case consttyp of
+          constnil,constord,constreal,constpointer,constset,conststring,constresourcestring,constguid:
+            constdef:=tdef(constdefderef.resolve);
+          constwstring:
+            constdef:=getarraydef(cwidechartype,getlengthwidestring(pcompilerwidestring(value.valueptr)));
+          else
+            internalerror(2015120801);
+        end
       end;
 
 
@@ -2488,7 +2503,8 @@ implementation
          inherited ppuwrite(ppufile);
          ppufile.putbyte(byte(consttyp));
          case consttyp of
-           constnil : ;
+           constnil :
+             ppufile.putderef(constdefderef);
            constord :
              begin
                ppufile.putderef(constdefderef);
@@ -2501,12 +2517,14 @@ implementation
              end;
            constwstring :
              begin
+               { no need to store the def, we can reconstruct it }
                ppufile.putlongint(getlengthwidestring(pcompilerwidestring(value.valueptr)));
                ppufile.putdata(pcompilerwidestring(value.valueptr)^.data^,pcompilerwidestring(value.valueptr)^.len*sizeof(tcompilerwidechar));
              end;
            conststring,
            constresourcestring :
              begin
+               ppufile.putderef(constdefderef);
                ppufile.putlongint(value.len);
                ppufile.putdata(pchar(value.valueptr)^,value.len);
              end;
@@ -2521,7 +2539,10 @@ implementation
                ppufile.putnormalset(value.valueptr^);
              end;
            constguid :
-             ppufile.putdata(value.valueptr^,sizeof(tguid));
+             begin
+               ppufile.putderef(constdefderef);
+               ppufile.putdata(value.valueptr^,sizeof(tguid));
+             end;
          else
            internalerror(13);
          end;

compiler/symtable.pas

@@ -3298,7 +3298,7 @@ implementation
                        (for id.randommethod), so only check category methods here
                     }
                     defowner:=tobjectdef(tprocdef(tprocsym(srsym).procdeflist[i]).owner.defowner);
-                    if (oo_is_classhelper in defowner.objectoptions) and
+                    if is_objccategory(defowner) and
                        def_is_related(pd,defowner.childof) then
                       begin
                         { we need to know if a procedure references symbols

compiler/symtype.pas

@@ -73,9 +73,9 @@ interface
          function  typesymbolprettyname:string;virtual;
          function  mangledparaname:string;
          function  getmangledparaname:TSymStr;virtual;
-         function  rtti_mangledname(rt:trttitype):string;virtual;abstract;
+         function  rtti_mangledname(rt:trttitype):TSymStr;virtual;abstract;
          function  OwnerHierarchyName: string; virtual; abstract;
-         function  fullownerhierarchyname:string;virtual;abstract;
+         function  fullownerhierarchyname:TSymStr;virtual;abstract;
          function  size:asizeint;virtual;abstract;
          function  packedbitsize:asizeint;virtual;
          function  alignment:shortint;virtual;abstract;

compiler/systems.pas

@@ -819,7 +819,7 @@ begin
 {$endif alpha}
 
 {$ifdef powerpc}
-  {$ifdef cpupowerpc}
+  {$ifdef cpupowerpc32}
     default_target(source_info.system);
     {$define default_target_set}
   {$else cpupowerpc}

compiler/utils/gppc386.pp

@@ -22,6 +22,9 @@
 
  ****************************************************************************}
 
+{$mode objfpc}
+{ Use ansitrings for long PATH variables }
+{$H+}
 program fpc_with_gdb;
 
 {
@@ -39,6 +42,7 @@ program fpc_with_gdb;
 }
 
 uses
+  sysutils,
   dos;
 
 const
@@ -77,7 +81,8 @@ end;
 
 var
    fpcgdbini : text;
-   CompilerName,Dir,Name,Ext : String;
+   CompilerName : String;
+   Dir,Name,Ext : ShortString;
    GDBError,GDBExitCode,i : longint;
 
 begin
@@ -88,7 +93,7 @@ begin
   else
     CompilerName:=DefaultCompilerName;
 
-  CompilerName:=fsearch(CompilerName,Dir+PathSep+GetEnv('PATH'));
+  CompilerName:=filesearch(CompilerName,Dir+PathSep+GetEnvironmentVariable('PATH'));
 
   { support for info functions directly : used in makefiles }
   if (paramcount=1) and (pos('-i',Paramstr(1))=1) then
@@ -157,9 +162,9 @@ begin
   flush(stderr);
   {$endif}
 
-  GDBExeName:=fsearch(GDBExeName,Dir+PathSep+GetEnv('PATH'));
+  GDBExeName:=filesearch(GDBExeName,Dir+PathSep+GetEnvironmentVariable('PATH'));
   if GDBExeName='' then
-    GDBExeName:=fsearch(GDBAltExeName,Dir+PathSep+GetEnv('PATH'));
+    GDBExeName:=filesearch(GDBAltExeName,Dir+PathSep+GetEnvironmentVariable('PATH'));
 
   AdaptToGDB(CompilerName);
   AdaptToGDB(GDBIniTempName);

compiler/utils/ppuutils/ppudump.pp

@@ -2312,7 +2312,9 @@ begin
                  end;
                conststring,
                constresourcestring :
-                 begin
+               begin
+                   write ([space,'   StringType : ']);
+                   readderef('',constdef.TypeRef);
                    len:=getlongint;
                    getmem(pc,len+1);
                    getdata(pc^,len);
@@ -2382,7 +2384,8 @@ begin
                  end;
                constnil:
                  begin
-                   writeln([space,' NIL pointer.']);
+                   write([space,'   NIL pointer :']);
+                   readderef('',constdef.TypeRef);
                    constdef.ConstType:=ctPtr;
                    constdef.VInt:=0;
                  end;
@@ -2436,8 +2439,10 @@ begin
                  end;
                constguid:
                  begin
+                    write ([space,'     IntfType : ']);
+                    readderef('',constdef.TypeRef);
                     getdata(guid,sizeof(guid));
-                    write ([space,'     IID String: {',hexstr(guid.d1,8),'-',hexstr(guid.d2,4),'-',hexstr(guid.d3,4),'-']);
+                    write ([space,'    IID String: {',hexstr(guid.d1,8),'-',hexstr(guid.d2,4),'-',hexstr(guid.d3,4),'-']);
                     for i:=0 to 7 do
                       begin
                          write(hexstr(guid.d4[i],2));

packages/numlib/tests/detgpbte.pas

@@ -86,92 +86,3 @@ begin
   Close(input);
   Close(output);
 end.
-program detgpbte;
-
-{
-
-1: 260
-2: 64
-3:
-
-}
-uses
-  typ,
-  iom,
-  det;
-
-const
-  pmin = -10;
-  pmax = 100;
-var
-  l, i, ind, rw, n, k, term, p, vb, nvb: ArbInt;
-  f: ArbFloat;
-  a: array[pmin..pmax] of ArbFloat;
-begin
-  iom.npos := 1000;        {max. width of output to 1000, since this is piped}
-  Assign(input, ParamStr(1));
-  reset(input);
-  Assign(output, ParamStr(2));
-  rewrite(output);
-  Write(' program results detgpbte');
-  case sizeof(ArbFloat) of
-    4: writeln('(single)');
-    6: writeln('(real)');
-    8: writeln('(double)');
-    10: writeln('(extended)');
-  end;
-  Read(nvb);
-  writeln;
-  writeln(' number of examples:', nvb: 3);
-  for vb := 1 to nvb do
-  begin
-    writeln;
-    writeln('example', vb: 2);
-    Read(p, n, l);
-    ind := p;
-    writeln;
-    writeln('  n=', n: 1, '  l=', l: 1);
-    for i := 1 to n do
-    begin
-      if i <= l then
-        rw := i
-      else
-        rw := l + 1;
-      iomrev(input, a[ind], rw);
-      Inc(ind, rw);
-    end;
-    detgpb(n, l, a[p], f, k, term);
-    ind := p;
-    writeln;
-    writeln(' A (left-under) =');
-    for i := 1 to n do
-    begin
-      if i <= l then
-        rw := i
-      else
-        rw := l + 1;
-      if i > l + 1 then
-        Write('': (i - l - 1) * (numdig + 2));
-      iomwrv(output, a[ind], rw, numdig);
-      Inc(ind, rw);
-    end;
-    writeln;
-    writeln('term=', term: 2);
-    writeln;
-    if term = 3 then
-      writeln(' wrong input')
-    else
-    if term = 2 then
-      writeln(' matrix not pos-def.')
-    else
-    begin
-      Write(' determinant of A =', f: numdig);
-      {      if k <> 0 then } Write(' * 8**', k: 3);
-      writeln;
-    end; {term=1}
-    writeln('---------------------------------------------');
-  end; {vb}
-  Close(input);
-  Close(output);
-end.
-

packages/numlib/tests/detgpdte.pas

@@ -60,66 +60,3 @@ begin
   Close(input);
   Close(output);
 end.
-program detgpdte;
-
-uses
-  typ,
-  iom,
-  det;
-
-const
-  n1  = -5;
-  n2  = 10;
-  rwa = n2 - n1 + 1;
-var
-  e, t, aantal, i, j, k, l, n, term: ArbInt;
-  d: ArbFloat;
-  a: array[n1..n2, n1..n2] of ArbFloat;
-begin
-  iom.npos := 1000;        {max. width of output to 1000, since this is piped}
-  Write(' program results detgpdte');
-  case sizeof(ArbFloat) of
-    4: writeln('(single)');
-    6: writeln('(real)');
-    8: writeln('(double)');
-    10: writeln('(Extended)');
-  end;
-  Read(aantal);
-  writeln;
-  writeln('  number of examples : ', aantal: 3);
-  for t := 1 to aantal do
-  begin
-    writeln;
-    writeln('       example nr ', t: 3);
-    Read(k, l, n);
-    for i := 1 to n do
-      for j := 1 to i do
-        Read(a[k + i - 1, l + j - 1]);
-    detgpd(n, rwa, a[k, l], d, e, term);
-    writeln;
-    writeln(' A =');
-    for i := 1 to n do
-      for j := 1 to i - 1 do
-        a[k + j - 1, l + i - 1] := a[k + i - 1, l + j - 1];
-    iomwrm(output, a[k, l], n, n, n2 - n1 + 1, numdig);
-    writeln;
-    writeln('term=', term: 2);
-    writeln;
-    if term = 3 then
-      writeln(' wrong input')
-    else
-    if term = 2 then
-      writeln(' matrix not pos-def')
-    else
-    begin
-      Write(' det =', d: numdig);
-      if e <> 0 then
-        Write(' * 8**', e: 3);
-      writeln;
-    end; {term=1}
-    writeln('------------------------------------------------------');
-  end; {t}
-  Close(input);
-  Close(output);
-end.
-

packages/numlib/tests/detgsyte.pas

@@ -58,64 +58,3 @@ begin
   Close(input);
   Close(output);
 end.
-program detgsyte;
-
-uses
-  typ,
-  iom,
-  det;
-
-const
-  n1  = -5;
-  n2  = 10;
-  rwa = n2 - n1 + 1;
-var
-  e, t, aantal, i, j, k, l, n, term: ArbInt;
-  d: ArbFloat;
-  a: array[n1..n2, n1..n2] of ArbFloat;
-begin
-  iom.npos := 1000;        {max. width of output to 1000, since this is piped}
-
-  Write(' program results detgsyte');
-  case sizeof(ArbFloat) of
-    4: writeln('(single)');
-    6: writeln('(real)');
-    8: writeln('(double)');
-    10: writeln('(Extended)');
-  end;
-  Read(aantal);
-  writeln;
-  writeln('  number of examples : ', aantal: 3);
-  for t := 1 to aantal do
-  begin
-    writeln;
-    writeln('       example nr ', t: 3);
-    Read(k, l, n);
-    for i := 1 to n do
-      for j := 1 to i do
-        Read(a[k + i - 1, l + j - 1]);
-    detgsy(n, rwa, a[k, l], d, e, term);
-    writeln;
-    writeln(' A =');
-    for i := 1 to n do
-      for j := 1 to i - 1 do
-        a[k + j - 1, l + i - 1] := a[k + i - 1, l + j - 1];
-    iomwrm(output, a[k, l], n, n, n2 - n1 + 1, numdig);
-    writeln;
-    writeln('term=', term: 2);
-    writeln;
-    if term = 3 then
-      writeln(' wrong input')
-    else
-    begin
-      Write(' det =', d: numdig);
-      if e <> 0 then
-        Write(' * 8**', e: 3);
-      writeln;
-    end; {term=1}
-    writeln('------------------------------------------------------');
-  end; {t}
-  Close(input);
-  Close(output);
-end.
-

packages/numlib/tests/detgtrte.pas

@@ -61,67 +61,3 @@ begin
   Close(input);
   Close(output);
 end.
-program detgtrte;
-
-uses
-  typ,
-  iom,
-  det;
-
-const
-  c1 = -10;
-  c2 = 10;
-var
-  k, p, n, term, vb, nvb: ArbInt;
-  l, d, u: array[c1..c2] of ArbFloat;
-  f: ArbFloat;
-begin
-  iom.npos := 1000;        {max. width of output to 1000, since this is piped}
-  Write(' program results detgtrte');
-  case sizeof(ArbFloat) of
-    4: writeln('(single)');
-    6: writeln('(real)');
-    8: writeln('(double)');
-    10: writeln('(Extended)');
-  end;
-  Read(nvb);
-  writeln;
-  writeln(' number of examples:', nvb: 4);
-  for vb := 1 to nvb do
-  begin
-    writeln;
-    writeln('example nr', vb: 2);
-    Read(p, n);
-    writeln;
-    writeln(' n=', n: 2);
-    iomrev(input, l[p + 1], n - 1);
-    iomrev(input, d[p], n);
-    iomrev(input, u[p], n - 1);
-    detgtr(n, l[p + 1], d[p], u[p], f, k, term);
-    writeln;
-    writeln('lower diagonal of A =');
-    iomwrv(output, l[p + 1], n - 1, numdig);
-    writeln;
-    writeln('diagonal of A =');
-    iomwrv(output, d[p], n, numdig);
-    writeln;
-    writeln('upper diagonal of A =');
-    iomwrv(output, u[p], n - 1, numdig);
-    writeln;
-    writeln('term=', term: 2);
-    writeln;
-    if term = 3 then
-      writeln(' wrong input')
-    else
-    begin
-      Write(' determinant of A =', f: numdig);
-      if k <> 0 then
-        Write(' * 8**', k: 3);
-      writeln;
-    end; {term=1}
-    writeln('----------------------------------------------------');
-  end;  {vb}
-  Close(input);
-  Close(output);
-end.
-

packages/numlib/tests/eigbs1te.pas

@@ -49,54 +49,3 @@ begin
   Close(input);
   Close(output);
 end.
-program eigbs1te;
-
-uses
-  typ,
-  iom,
-  eig;
-
-const
-  n1 = -100;
-  n2 = 100;
-var
-  ex, nex, nel, p, q, n, b, term: ArbInt;
-  a:   array[n1..n2] of ArbFloat;
-  lam: array[n1..n2] of ArbFloat;
-begin
-  Write(' program results eigbs1te');
-  case sizeof(ArbFloat) of
-    4: writeln('(single)');
-    6: writeln('(real)');
-    8: writeln('(double)');
-  end;
-  Read(nex);
-  writeln;
-  writeln('number of examples', nex: 2);
-  writeln;
-  for ex := 1 to nex do
-  begin
-    writeln('example number', ex: 2);
-    writeln;
-    Read(p, q, n, b);
-    nel := n * (b + 1) - (b * (b + 1)) div 2;
-    iomrev(input, a[p], nel);
-    eigbs1(a[p], n, b, lam[q], term);
-    writeln(' A = ');
-    iomwrv(output, a[p], nel, numdig);
-    writeln;
-    writeln('term=', term: 2);
-    if term = 1 then
-    begin
-      writeln;
-      writeln('lambda=');
-      iomwrv(output, lam[q], n, numdig);
-    end
-    else
-      writeln(' wrong input');
-    writeln;
-    writeln('-------------------------------------------');
-  end;
-  Close(input);
-  Close(output);
-end.

packages/numlib/tests/eigbs2te.pas

@@ -49,54 +49,3 @@ begin
   Close(input);
   Close(output);
 end.
-program eigbs2te;
-
-uses
-  typ,
-  iom,
-  eig;
-
-const
-  n1 = -100;
-  n2 = 100;
-var
-  ex, nex, nel, p, q, n, b, k1, k2, term: ArbInt;
-  a:   array[n1..n2] of ArbFloat;
-  lam: array[n1..n2] of ArbFloat;
-begin
-  Write(' program results eigbs2te');
-  case sizeof(ArbFloat) of
-    4: writeln('(single)');
-    6: writeln('(real)');
-    8: writeln('(double)');
-  end;
-  Read(nex);
-  writeln;
-  writeln('number of examples', nex: 2);
-  writeln;
-  for ex := 1 to nex do
-  begin
-    writeln('example number', ex: 2);
-    writeln;
-    Read(p, q, n, b, k1, k2);
-    nel := n * (b + 1) - (b * (b + 1)) div 2;
-    iomrev(input, a[p], nel);
-    eigbs2(a[p], n, b, k1, k2, lam[q], term);
-    writeln(' A = ');
-    iomwrv(output, a[p], nel, numdig);
-    writeln;
-    writeln('term=', term: 2);
-    if term = 1 then
-    begin
-      writeln;
-      writeln('lambda=');
-      iomwrv(output, lam[q], k2 - k1 + 1, numdig);
-    end
-    else
-      writeln(' wrong input');
-    writeln;
-    writeln('-------------------------------------------');
-  end;
-  Close(input);
-  Close(output);
-end.

packages/numlib/tests/eigbs3te.pas

@@ -78,83 +78,3 @@ begin
   Close(input);
   Close(output);
 end.
-program eigbs3te;
-
-uses
-  typ,
-  iom,
-  eig,
-  omv;
-
-const
-  n1  = -100;
-  n2  = 100;
-  i1  = -10;
-  i2  = 10;
-  rwx = i2 - i1 + 1;
-var
-  ex, nex, nel, ind, p, q, r, s, n, i, j, b, term: ArbInt;
-  a:   array[n1..n2] of ArbFloat;
-  lam: array[i1..i2] of ArbFloat;
-  x, mat, e: array[i1..i2, i1..i2] of ArbFloat;
-begin
-  Write(' program results eigbs3te');
-  case sizeof(ArbFloat) of
-    4: writeln('(single)');
-    6: writeln('(real)');
-    8: writeln('(double)');
-  end;
-  Read(nex);
-  writeln;
-  writeln('number of examples', nex: 2);
-  writeln;
-  for ex := 1 to nex do
-  begin
-    writeln('example number', ex: 2);
-    writeln;
-    Read(p, q, r, s, n, b);
-    nel := n * (b + 1) - (b * (b + 1)) div 2;
-    iomrev(input, a[p], nel);
-    eigbs3(a[p], n, b, lam[q], x[r, s], rwx, term);
-    writeln(' A = ');
-    iomwrv(output, a[p], nel, numdig);
-    writeln;
-    writeln('term=', term: 2);
-    if term = 1 then
-    begin
-      writeln;
-      writeln('lambda=');
-      iomwrv(output, lam[q], n, numdig);
-      writeln;
-      writeln('X=');
-      iomwrm(output, x[r, s], n, n, rwx, numdig);
-      ind := p;
-      for i := 1 to n do
-        for j := 1 to i do
-          if j < i - b then
-            mat[i + r - 1, j + s - 1] := 0
-          else
-          begin
-            mat[i + r - 1, j + s - 1] := a[ind];
-            ind := ind + 1;
-          end;
-      for i := 1 to n do
-        for j := i + 1 to n do
-          mat[i + r - 1, j + s - 1] := mat[j + r - 1, i + s - 1];
-      writeln;
-      writeln(' matrix A =');
-      iomwrm(output, mat[r, s], n, n, rwx, numdig);
-      writeln;
-      writeln('Ax-lambda.x = ');
-      omvmmm(mat[r, s], n, n, rwx, x[r, s], n, rwx, e[r, s], rwx);
-      for j := 1 to n do
-        for i := 1 to n do
-          e[i + r - 1, j + s - 1] := e[i + r - 1, j + s - 1] - lam[q + j - 1] * x[i + r - 1, j + s - 1];
-      iomwrm(output, e[r, s], n, n, rwx, numdig);
-    end;
-    writeln;
-    writeln('-------------------------------------------');
-  end;
-  Close(input);
-  Close(output);
-end.

packages/numlib/tests/eigbs4te.pas

@@ -83,88 +83,3 @@ begin
   Close(input);
   Close(output);
 end.
-program eigbs4te;
-
-uses
-  typ,
-  iom,
-  omv,
-  eig;
-
-const
-  n1  = -100;
-  n2  = 100;
-  i1  = -10;
-  i2  = 10;
-  rwx = i2 - i1 + 1;
-var
-  ex, nex, nel, p, q, r, s, i, j, ind, n, b, k1, k2, m2, term: ArbInt;
-  a:   array[n1..n2] of ArbFloat;
-  lam: array[i1..i2] of ArbFloat;
-  x, e, mat: array[i1..i2, i1..i2] of ArbFloat;
-begin
-  Assign(input, ParamStr(1));
-  reset(input);
-  Write(' program results eigbs4te');
-  case sizeof(ArbFloat) of
-    4: writeln('(single)');
-    6: writeln('(real)');
-    8: writeln('(double)');
-  end;
-  Read(nex);
-  writeln;
-  writeln('number of examples', nex: 2);
-  writeln;
-  for ex := 1 to nex do
-  begin
-    writeln('example number', ex: 2);
-    writeln;
-    Read(p, q, r, s, n, b, k1, k2);
-    nel := n * (b + 1) - (b * (b + 1)) div 2;
-    iomrev(input, a[p], nel);
-    eigbs4(a[p], n, b, k1, k2, lam[q], x[r, s], rwx, m2, term);
-    writeln(' n =', n: 2, '   b =', b: 2, '   k1 =', k1: 2, '   k2 =', k2: 2);
-    writeln(' A = ');
-    iomwrv(output, a[p], nel, numdig);
-    writeln;
-    writeln('term=', term: 2);
-    if term < 3 then
-    begin
-      writeln;
-      writeln('lambda=');
-      iomwrv(output, lam[q], k2 - k1 + 1, numdig);
-      writeln;
-      writeln(' m2 =', m2: 2);
-      writeln;
-      writeln('X=');
-      iomwrm(output, x[r, s], n, m2 - k1 + 1, rwx, numdig);
-      ind := p;
-      for i := 1 to n do
-        for j := 1 to i do
-          if j < i - b then
-            mat[i + r - 1, j + s - 1] := 0
-          else
-          begin
-            mat[i + r - 1, j + s - 1] := a[ind];
-            ind := ind + 1;
-          end;
-      for i := 1 to n do
-        for j := i + 1 to n do
-          mat[i + r - 1, j + s - 1] := mat[j + r - 1, i + s - 1];
-      writeln;
-      writeln(' matrix A =');
-      iomwrm(output, mat[r, s], n, n, rwx, numdig);
-      writeln;
-      writeln('Ax-lambda.x = ');
-      omvmmm(mat[r, s], n, n, rwx, x[r, s], m2 - k1 + 1, rwx, e[r, s], rwx);
-      for j := 1 to m2 - k1 + 1 do
-        for i := 1 to n do
-          e[i + r - 1, j + s - 1] := e[i + r - 1, j + s - 1] - lam[q + j - 1] * x[i + r - 1, j + s - 1];
-      iomwrm(output, e[r, s], n, m2 - k1 + 1, rwx, numdig);
-    end;
-    writeln;
-    writeln('-------------------------------------------');
-  end;
-  Close(input);
-  Close(output);
-end.

packages/numlib/tests/eigge1te.pas

@@ -52,57 +52,3 @@ begin
   Close(input);
   Close(output);
 end.
-program eigge1te;
-
-uses
-  typ,
-  iom,
-  eig;
-
-const
-  m1 = -9;
-  m2 = 5;
-  n1 = -10;
-  n2 = 8;
-
-var
-  i, l, nex, i1, j1, n, term: ArbInt;
-  a:   array[m1..m2, n1..n2] of ArbFloat;
-  lam: array[m1..m2] of complex;
-begin
-  Write(' program results eigge1te');
-  case sizeof(ArbFloat) of
-    4: writeln('(single)');
-    6: writeln('(real)');
-    8: writeln('(double)');
-  end;
-  Read(nex);
-  writeln;
-  writeln('number of examples', nex: 2);
-  writeln;
-  for l := 1 to nex do
-  begin
-    writeln('example number', l: 2);
-    writeln;
-    Read(i1, j1, n);
-    iomrem(input, a[i1, j1], n, n, n2 - n1 + 1);
-    eigge1(a[i1, j1], n, n2 - n1 + 1, lam[i1], term);
-    writeln;
-    writeln('A=');
-    writeln;
-    iomwrm(output, a[i1, j1], n, n, n2 - n1 + 1, numdig);
-    writeln('term=', term: 2);
-    writeln;
-    if term = 1 then
-    begin
-      writeln('lambda=');
-      writeln(' ': 8, 'Re', ' ': 14, 'Im');
-      for i := 1 to n do
-        writeln(lam[i1 + i - 1].re: numdig, '  ', lam[i1 + i - 1].im: numdig);
-      writeln;
-    end;
-    writeln('-------------------------------------------');
-  end;
-  Close(input);
-  Close(output);
-end.

packages/numlib/tests/eigge3te.pas

@@ -94,99 +94,3 @@ begin
   Close(input);
   Close(output);
 end.
-program eigge3te;
-
-uses
-  typ,
-  iom,
-  eig;
-
-const
-  m1  = -9;
-  m2  = 5;
-  m3  = -11;
-  m4  = 8;
-  n1  = -10;
-  n2  = 8;
-  n3  = -9;
-  n4  = 7;
-  rwa = n2 - n1 + 1;
-  rwx = n4 - n3 + 1;
-var
-  i, j, l, nex, n, term, i1, j1, i2, j2, k: ArbInt;
-  r:   ArbFloat;
-  a:   array[m1..m2, n1..n2] of ArbFloat;
-  x:   array[m3..m4, n3..n4] of complex;
-  lam: array[m1..m2] of complex;
-begin
-  Write(' program results eigge3te');
-  case sizeof(ArbFloat) of
-    4: writeln('(single)');
-    6: writeln('(real)');
-    8: writeln('(double)');
-  end;
-  Read(nex);
-  writeln;
-  writeln('number of examples', nex: 2);
-  writeln;
-  for l := 1 to nex do
-  begin
-    writeln('example number', l: 2);
-    writeln;
-    Read(i1, j1, i2, j2, n);
-    iomrem(input, a[i1, j1], n, n, rwa);
-    eigge3(a[i1, j1], n, rwa, lam[i1], x[i2, j2], rwx, term);
-    writeln;
-    writeln('A=');
-    writeln;
-    iomwrm(output, a[i1, j1], n, n, rwa, numdig);
-    writeln;
-    writeln('term=', term: 2);
-    writeln;
-    if term = 1 then
-    begin
-      writeln('lambda=');
-      writeln(' ': 10, 'Re', ' ': 10, 'Im');
-      for i := 1 to n do
-        writeln(lam[i1 + i - 1].re: numdig, ' ', lam[i1 + i - 1].im: numdig);
-      writeln;
-      writeln('eigenvectors:');
-      for j := 1 to n do
-      begin
-        writeln('eig. vect. nr', j: 2);
-        writeln(' ': 10, 'Re', ' ': 10, 'Im');
-        for i := 1 to n do
-        begin
-          Write(x[i2 + i - 1, j2 + j - 1].re: numdig, ' ');
-          writeln(x[i2 + i - 1, j2 + j - 1].im: numdig);
-        end;  {i}
-        writeln;
-      end; {j}
-      writeln('residuals:');
-      for j := 1 to n do
-      begin
-        writeln('residual nr', j: 2);
-        writeln(' ': 10, 'Re', ' ': 10, 'Im');
-        for i := 1 to n do
-        begin
-          r := 0;
-          for k := 1 to n do
-            r := r + a[i1 + i - 1, j1 + k - 1] * x[i2 + k - 1, j2 + j - 1].re;
-          r := r - lam[i1 + j - 1].re * x[i2 + i - 1, j2 + j - 1].re;
-          r := r + lam[i1 + j - 1].im * x[i2 + i - 1, j2 + j - 1].im;
-          Write(r: numdig, ' ');
-          r := 0;
-          for k := 1 to n do
-            r := r + a[i1 + i - 1, j1 + k - 1] * x[i2 + k - 1, j2 + j - 1].im;
-          r := r - lam[i1 + j - 1].re * x[i2 + i - 1, j2 + j - 1].im;
-          r := r - lam[i1 + j - 1].im * x[i2 + i - 1, j2 + j - 1].re;
-          writeln(r: numdig);
-        end; {i}
-        writeln;
-      end; {j}
-    end; {term=1}
-    writeln('-------------------------------------------');
-  end; {l}
-  Close(input);
-  Close(output);
-end.

packages/numlib/tests/eiggg1te.pas

@@ -64,69 +64,3 @@ begin
   Close(input);
   Close(output);
 end.
-program eiggg1te;
-
-uses
-  typ,
-  eig,
-  iom;
-
-const
-  m1 = -9;
-  m2 = 5;
-  n1 = -10;
-  n2 = 8;
-  n3 = -7;
-  n4 = 6;
-var
-  i, j, l, nex, i1, j1, i2, j2, n, term: ArbInt;
-  a:   array[m1..m2, n1..n2] of ArbFloat;
-  b:   array[m1..m2, n3..n4] of ArbFloat;
-  lam: array[m1..m2] of ArbFloat;
-begin
-  Write(' program results eiggg1te');
-  case sizeof(ArbFloat) of
-    4: writeln('(single)');
-    6: writeln('(real)');
-    8: writeln('(double)');
-  end;
-  Read(nex);
-  writeln;
-  writeln('number of examples', nex: 2);
-  writeln;
-  for l := 1 to nex do
-  begin
-    writeln('example number', l: 2);
-    writeln;
-    Read(i1, j1, i2, j2, n);
-    for i := 1 to n do
-      for j := 1 to i do
-        Read(a[i1 + i - 1, j1 + j - 1]);
-    for i := 1 to n do
-      for j := 1 to i do
-        Read(b[i2 + i - 1, j2 + j - 1]);
-    eiggg1(a[i1, j1], n, n2 - n1 + 1, b[i2, j2], n4 - n3 + 1, lam[i1], term);
-    writeln;
-    writeln('A=');
-    writeln;
-    for i := 1 to n do
-      iomwrv(output, a[i1 + i - 1, j1], i, numdig);
-    writeln;
-    writeln('B=');
-    writeln;
-    for i := 1 to n do
-      iomwrv(output, b[i2 + i - 1, j2], i, numdig);
-    writeln;
-    writeln('term=', term: 2);
-    writeln;
-    if term = 1 then
-    begin
-      writeln('lambda=');
-      iomwrv(output, lam[i1], n, numdig);
-      writeln;
-    end;
-    writeln('-------------------------------------------');
-  end;
-  Close(input);
-  Close(output);
-end.

packages/numlib/tests/eiggg2te.pas

@@ -65,70 +65,3 @@ begin
   Close(input);
   Close(output);
 end.
-program eiggg2te;
-
-uses
-  typ,
-  eig,
-  iom;
-
-const
-  m1 = -9;
-  m2 = 5;
-  n1 = -10;
-  n2 = 8;
-  n3 = -7;
-  n4 = 6;
-var
-  i, j, l, nex, k1, k2, i1, j1, i2, j2, n, term: ArbInt;
-  a:   array[m1..m2, n1..n2] of ArbFloat;
-  b:   array[m1..m2, n3..n4] of ArbFloat;
-  lam: array[m1..m2] of ArbFloat;
-begin
-  Write(' program results eiggg2te');
-  case sizeof(ArbFloat) of
-    4: writeln('(single)');
-    6: writeln('(real)');
-    8: writeln('(double)');
-  end;
-  Read(nex);
-  writeln;
-  writeln('number of examples', nex: 2);
-  writeln;
-  for l := 1 to nex do
-  begin
-    writeln('example number', l: 2);
-    writeln;
-    Read(i1, j1, i2, j2, n, k1, k2);
-    for i := 1 to n do
-      for j := 1 to i do
-        Read(a[i1 + i - 1, j1 + j - 1]);
-    for i := 1 to n do
-      for j := 1 to i do
-        Read(b[i2 + i - 1, j2 + j - 1]);
-    eiggg2(a[i1, j1], n, n2 - n1 + 1, k1, k2, b[i2, j2], n4 - n3 + 1,
-      lam[i1 + k1 - 1], term);
-    writeln;
-    writeln('A=');
-    writeln;
-    for i := 1 to n do
-      iomwrv(output, a[i1 + i - 1, j1], i, numdig);
-    writeln;
-    writeln('B=');
-    writeln;
-    for i := 1 to n do
-      iomwrv(output, b[i2 + i - 1, j2], i, numdig);
-    writeln;
-    writeln('term=', term: 2);
-    writeln;
-    if term = 1 then
-    begin
-      writeln('lambda', k1: 2, ' t/m', k2: 2, ' = ');
-      iomwrv(output, lam[i1 + k1 - 1], k2 - k1 + 1, numdig);
-    end;
-    writeln;
-    writeln('-------------------------------------------');
-  end;
-  Close(input);
-  Close(output);
-end.

packages/numlib/tests/eiggg3te.pas

@@ -109,114 +109,3 @@ begin
   Close(input);
   Close(output);
 end.
-program eiggg3te;
-
-uses
-  typ,
-  iom,
-  omv,
-  eig;
-
-const
-  m1  = -10;
-  m2  = 10;
-  m3  = -4;
-  m4  = 15;
-  m5  = -5;
-  m6  = 11;
-  n1  = -5;
-  n2  = 10;
-  n3  = -3;
-  n4  = 10;
-  n5  = -7;
-  n6  = 12;
-  rwa = n2 - n1 + 1;
-  rwb = n4 - n3 + 1;
-  rwx = n6 - n5 + 1;
-
-var
-  i, j, l, nex, n, k, term, i1, j1, i2, j2, i3, j3: ArbInt;
-  r, s: ArbFloat;
-  a:    array[m1..m2, n1..n2] of ArbFloat;
-  b:    array[m3..m4, n3..n4] of ArbFloat;
-  x, xt, xtb, xtbx: array[m5..m6, n5..n6] of ArbFloat;
-  lam:  array[m1..m2] of ArbFloat;
-
-begin
-  Write(' program results eiggg3te');
-  case sizeof(ArbFloat) of
-    4: writeln('(single)');
-    6: writeln('(real)');
-    8: writeln('(double)');
-  end;
-  Read(nex);
-  writeln;
-  writeln('number of examples', nex: 2);
-  writeln;
-  for l := 1 to nex do
-  begin
-    writeln('example number', l: 2);
-    writeln;
-    Read(i1, j1, i2, j2, i3, j3, n);
-    for i := 1 to n do
-      for j := 1 to i do
-        Read(a[i1 + i - 1, j1 + j - 1]);
-    for i := 1 to n do
-      for j := 1 to i do
-        Read(b[i2 + i - 1, j2 + j - 1]);
-    eiggg3(a[i1, j1], n, rwa, b[i2, j2], rwb, lam[i1], x[i3, j3], rwx, term);
-    writeln;
-    writeln('A=');
-    writeln;
-    for i := 1 to n do
-      iomwrv(output, a[i1 + i - 1, j1], i, numdig);
-    writeln;
-    writeln('B=');
-    writeln;
-    for i := 1 to n do
-      iomwrv(output, b[i2 + i - 1, j2], i, numdig);
-    writeln;
-    writeln('term=', term: 2);
-    writeln;
-    if term = 1 then
-    begin
-      writeln('lambda=');
-      iomwrv(output, lam[i1], n, numdig);
-      writeln;
-      writeln('eigenvectors:');
-      iomwrm(output, x[i3, j3], n, n, rwx, numdig);
-      writeln;
-      for i := 1 to n do
-        for j := 1 to i - 1 do
-          a[i1 + j - 1, j1 + i - 1] := a[i1 + i - 1, j1 + j - 1];
-      for i := 1 to n do
-        for j := 1 to i - 1 do
-          b[i2 + j - 1, j2 + i - 1] := b[i2 + i - 1, j2 + j - 1];
-      writeln('residuals:');
-      for j := 1 to n do
-      begin
-        writeln('residual nr', j: 2);
-        for i := 1 to n do
-        begin
-          r := 0;
-          for k := 1 to n do
-            r := r + a[i1 + i - 1, j1 + k - 1] * x[i3 + k - 1, j3 + j - 1];
-          s := 0;
-          for k := 1 to n do
-            s := s + b[i2 + i - 1, j2 + k - 1] * x[i3 + k - 1, j3 + j - 1];
-          r := r - s * lam[i1 + j - 1];
-          Write(r: numdig, ' ');
-        end; {i}
-        writeln;
-      end; {j}
-      writeln('xtbx =');
-      omvtrm(x[i3, j3], n, n, rwx, xt[i3, j3], rwx);
-      omvmmm(xt[i3, j3], n, n, rwx, b[i2, j2], n, rwb, xtb[i3, j3], rwx);
-      omvmmm(xtb[i3, j3], n, n, rwx, x[i3, j3], n, rwx, xtbx[i3, j3], rwx);
-      iomwrm(output, xtbx[i3, j3], n, n, rwx, 17);
-    end;
-    writeln('--------------------------------------------------------');
-  end;
-  Close(input);
-  Close(output);
-end.

packages/numlib/tests/eiggg4te.pas

@@ -117,122 +117,3 @@ begin
   Close(input);
   Close(output);
 end.
-program eiggg4te;
-
-uses
-  typ,
-  iom,
-  omv,
-  eig;
-
-const
-  p1  = -9;
-  p2  = 5;
-  n1  = -10;
-  n2  = 8;
-  p3  = -10;
-  p4  = 7;
-  n3  = -11;
-  n4  = 9;
-  p5  = -8;
-  p6  = 11;
-  n5  = -12;
-  n6  = 12;
-  rwa = n2 - n1 + 1;
-  rwb = n4 - n3 + 1;
-  rwx = n6 - n5 + 1;
-var
-  i, j, l, m2, k1, k2, nex, n, term, k, m, i1, j1, i2, j2, i3, j3: ArbInt;
-  r, s: ArbFloat;
-  a:    array[p1..p2, n1..n2] of ArbFloat;
-  b:    array[p3..p4, n3..n4] of ArbFloat;
-  x, xt, xtb, xtbx: array[p5..p6, n5..n6] of ArbFloat;
-  lam:  array[p1..p2] of ArbFloat;
-begin
-  Write(' program results eiggg4te');
-  case sizeof(ArbFloat) of
-    4: writeln('(single)');
-    6: writeln('(real)');
-    8: writeln('(double)');
-  end;
-  Read(nex);
-  writeln;
-  writeln('number of examples', nex: 2);
-  writeln;
-  for l := 1 to nex do
-  begin
-    writeln('example number', l: 3);
-    Read(i1, j1, i2, j2, i3, j3, n, k1, k2);
-    for i := 1 to n do
-      for j := 1 to i do
-        Read(a[i1 + i - 1, j1 + j - 1]);
-    for i := 1 to n do
-      for j := 1 to i do
-        Read(b[i2 + i - 1, j2 + j - 1]);
-    eiggg4(a[i1, j1], n, rwa, k1, k2, b[i2, j2], rwb, lam[i1 + k1 - 1],
-      x[i3, j3 + k1 - 1], rwx, m2, term);
-    writeln;
-    writeln('A=');
-    writeln;
-    for i := 1 to n do
-      iomwrv(output, a[i1 + i - 1, j1], i, numdig);
-    writeln;
-    writeln('B=');
-    writeln;
-    for i := 1 to n do
-      iomwrv(output, b[i2 + i - 1, j2], i, numdig);
-    writeln;
-    writeln(' k1=', k1: 2, '   k2=', k2: 2);
-    writeln;
-    writeln('term=', term: 2);
-    writeln;
-    if (term = 1) or (term = 4) then
-    begin
-      writeln('lambda=', k1: 2, ' t/m', k2: 2, ' = ');
-      iomwrv(output, lam[i1 + k1 - 1], k2 - k1 + 1, numdig);
-      writeln;
-      writeln(' m2 =', m2: 2);
-      writeln;
-      if m2 = k1 - 1 then
-        writeln(' eigenvectors can not be determined')
-      else
-      begin
-        writeln('eigenvectors', k1: 2, ' t/m', m2: 2, ':');
-        iomwrm(output, x[i3, j3 + k1 - 1], n, m2 - k1 + 1, rwx, numdig);
-        for i := 1 to n do
-          for j := 1 to i - 1 do
-            a[i1 + j - 1, j1 + i - 1] := a[i1 + i - 1, j1 + j - 1];
-        for i := 1 to n do
-          for j := 1 to i - 1 do
-            b[i2 + j - 1, j2 + i - 1] := b[i2 + i - 1, j2 + j - 1];
-        writeln('residuals:');
-        for j := k1 to m2 do
-        begin
-          writeln('residual nr', j: 2);
-          for i := 1 to n do
-          begin
-            r := 0;
-            for k := 1 to n do
-              r := r + a[i1 + i - 1, j1 + k - 1] * x[i3 + k - 1, j3 + j - 1];
-            s := 0;
-            for k := 1 to n do
-              s := s + b[i2 + i - 1, j2 + k - 1] * x[i3 + k - 1, j3 + j - 1];
-            r := r - s * lam[i1 + j - 1];
-            Write(r: numdig, ' ');
-          end; {i}
-          writeln;
-        end; {j}
-        m := m2 - k1 + 1;
-        writeln('xtbx =');
-        omvtrm(x[i3, j3 + k1 - 1], n, m, rwx, xt[i3, j3], rwx);
-        omvmmm(xt[i3, j3], m, n, rwx, b[i2, j2], n, rwb, xtb[i3, j3], rwx);
-        omvmmm(xtb[i3, j3], m, n, rwx, x[i3, j3 + k1 - 1], m, rwx,
-          xtbx[i3, j3], rwx);
-        iomwrm(output, xtbx[i3, j3], m, m, rwx, numdig);
-      end; {m2 > k1-1}
-    end; {term=1 or term=4}
-    writeln('----------------------------------------------------------');
-  end; {l}
-  Close(input);
-  Close(output);
-end.

packages/numlib/tests/eiggs1te.pas

@@ -52,57 +52,3 @@ begin
   Close(input);
   Close(output);
 end.
-program eiggs1te;
-
-uses
-  typ,
-  eig,
-  iom;
-
-const
-  m1 = -9;
-  m2 = 5;
-  n1 = -10;
-  n2 = 8;
-var
-  i, j, ex, nex, i1, j1, n, term: ArbInt;
-  a:   array[m1..m2, n1..n2] of ArbFloat;
-  lam: array[m1..m2] of ArbFloat;
-begin
-  Write(' program results eiggs1te');
-  case sizeof(ArbFloat) of
-    4: writeln('(single)');
-    6: writeln('(real)');
-    8: writeln('(double)');
-  end;
-  Read(nex);
-  writeln;
-  writeln('number of examples', nex: 2);
-  writeln;
-  for ex := 1 to nex do
-  begin
-    writeln('example number', ex: 2);
-    writeln;
-    Read(i1, j1, n);
-    for i := 1 to n do
-      for j := 1 to i do
-        Read(a[i1 + i - 1, j1 + j - 1]);
-    eiggs1(a[i1, j1], n, n2 - n1 + 1, lam[i1], term);
-    writeln;
-    writeln('A=');
-    writeln;
-    for i := 1 to n do
-      iomwrv(output, a[i1 + i - 1, j1], i, numdig);
-    writeln;
-    writeln('term=', term: 2);
-    if term = 1 then
-    begin
-      writeln;
-      writeln('lambda=');
-      iomwrv(output, lam[i1], n, numdig);
-    end;
-    writeln('-----------------------------------------------------');
-  end;
-  Close(input);
-  Close(output);
-end.

packages/numlib/tests/eiggs2te.pas

@@ -56,61 +56,3 @@ begin
   Close(input);
   Close(output);
 end.
-program eiggs2te;
-
-uses
-  typ,
-  iom,
-  eig;
-
-const
-  m1 = -9;
-  m2 = 7;
-  n1 = -10;
-  n2 = 8;
-
-var
-  i, j, ex, nex, k1, k2, i1, j1, n, term: ArbInt;
-  a:   array[m1..m2, n1..n2] of ArbFloat;
-  lam: array[m1..m2] of ArbFloat;
-
-begin
-  Write(' program results eiggs2te');
-  case sizeof(ArbFloat) of
-    4: writeln('(single)');
-    6: writeln('(real)');
-    8: writeln('(double)');
-  end;
-  Read(nex);
-  writeln;
-  writeln('number of examples', nex: 2);
-  writeln;
-  for ex := 1 to nex do
-  begin
-    writeln('example number', ex: 2);
-    writeln;
-    Read(i1, j1, n, k1, k2);
-    for i := 1 to n do
-      for j := 1 to i do
-        Read(a[i1 + i - 1, j1 + j - 1]);
-    eiggs2(a[i1, j1], n, n2 - n1 + 1, k1, k2, lam[i1 + k1 - 1], term);
-    writeln;
-    writeln('A=');
-    writeln;
-    for i := 1 to n do
-      iomwrv(output, a[i1 + i - 1, j1], i, numdig);
-    writeln;
-    writeln('k1 =', k1: 2, '    k2 =', k2: 2);
-    writeln;
-    writeln('term=', term: 2);
-    if term = 1 then
-    begin
-      writeln;
-      writeln('lambda=');
-      iomwrv(output, lam[i1 + k1 - 1], k2 - k1 + 1, numdig);
-    end;
-    writeln('----------------------------------------------------');
-  end;
-  Close(input);
-  Close(output);
-end.

packages/numlib/tests/eiggs3te.pas

@@ -70,75 +70,3 @@ begin
   Close(input);
   Close(output);
 end.
-program eiggs3te;
-
-uses
-  typ,
-  iom,
-  omv,
-  eig;
-
-const
-  m1 = -10;
-  m2 = 10;
-  m3 = -4;
-  m4 = 15;
-  n1 = -5;
-  n2 = 10;
-  n3 = -3;
-  n4 = 10;
-var
-  i, j, ex, nex, i1, j1, i2, j2, n, term: ArbInt;
-  a:    array[m1..m2, n1..n2] of ArbFloat;
-  x, e: array[m3..m4, n3..n4] of ArbFloat;
-  lam:  array[m1..m2] of ArbFloat;
-begin
-  Write(' program results eiggs3te');
-  case sizeof(ArbFloat) of
-    4: writeln('(single)');
-    6: writeln('(real)');
-    8: writeln('(double)');
-  end;
-  Read(nex);
-  writeln;
-  writeln('number of examples', nex: 2);
-  writeln;
-  for ex := 1 to nex do
-  begin
-    writeln('example number', ex: 2);
-    writeln;
-    Read(i1, j1, i2, j2, n);
-    for i := 1 to n do
-      for j := 1 to i do
-        Read(a[i1 + i - 1, j1 + j - 1]);
-    eiggs3(a[i1, j1], n, n2 - n1 + 1, lam[i1], x[i2, j2], n4 - n3 + 1, term);
-    for i := 1 to n do
-      for j := 1 to i - 1 do
-        a[i1 + j - 1, j1 + i - 1] := a[i1 + i - 1, j1 + j - 1];
-    writeln;
-    writeln('A=');
-    iomwrm(output, a[i1, j1], n, n, n2 - n1 + 1, numdig);
-    writeln;
-    writeln('term=', term: 2);
-    if term = 1 then
-    begin
-      writeln;
-      writeln('lambda=');
-      iomwrv(output, lam[i1], n, numdig);
-      writeln;
-      writeln('X=');
-      iomwrm(output, x[i2, j2], n, n, n4 - n3 + 1, numdig);
-      writeln;
-      writeln('AX-lambda.X = ');
-      omvmmm(a[i1, j1], n, n, n2 - n1 + 1, x[i2, j2], n, n4 - n3 + 1,
-        e[i2, j2], n4 - n3 + 1);
-      for j := 1 to n do
-        for i := 1 to n do
-          e[i + i2 - 1, j + j2 - 1] := e[i + i2 - 1, j + j2 - 1] - lam[i1 + j - 1] * x[i + i2 - 1, j + j2 - 1];
-      iomwrm(output, e[i2, j2], n, n, n4 - n3 + 1, numdig);
-    end;
-    writeln('-------------------------------------------------------');
-  end;
-  Close(input);
-  Close(output);
-end.

packages/numlib/tests/eiggs4te.pas

@@ -76,81 +76,3 @@ begin
   Close(input);
   Close(output);
 end.
-program eiggs4te;
-
-uses
-  typ,
-  iom,
-  omv,
-  eig;
-
-const
-  p1  = -9;
-  p2  = 5;
-  n1  = -10;
-  n2  = 8;
-  p3  = -10;
-  p4  = 7;
-  n3  = -11;
-  n4  = 9;
-  rwa = n2 - n1 + 1;
-  rwx = n4 - n3 + 1;
-var
-  i, j, ex, nex, m2, k1, k2, i2, j2, i1, j1, n, term: ArbInt;
-  a:    array[p1..p2, n1..n2] of ArbFloat;
-  x, e: array[p3..p4, n3..n4] of ArbFloat;
-  lam:  array[p1..p2] of ArbFloat;
-begin
-  Write(' program results eiggs4te');
-  case sizeof(ArbFloat) of
-    4: writeln('(single)');
-    6: writeln('(real)');
-    8: writeln('(double)');
-  end;
-  Read(nex);
-  writeln;
-  writeln('number of examples', nex: 2);
-  writeln;
-  for ex := 1 to nex do
-  begin
-    writeln('example number', ex: 2);
-    writeln;
-    Read(i1, j1, i2, j2, n, k1, k2);
-    for i := 1 to n do
-      for j := 1 to i do
-        Read(a[i1 + i - 1, j1 + j - 1]);
-    eiggs4(a[i1, j1], n, rwa, k1, k2, lam[i1 + k1 - 1], x[i2, j2 + k1 - 1],
-      rwx, m2, term);
-    writeln;
-    writeln('A=');
-    for i := 1 to n do
-      for j := 1 to i - 1 do
-        a[i1 + j - 1, j1 + i - 1] := a[i1 + i - 1, j1 + j - 1];
-    iomwrm(output, a[i1, j1], n, n, n2 - n1 + 1, numdig);
-    writeln;
-    writeln('k1=', k1: 2, '  k2=', k2: 2);
-    writeln;
-    writeln('term=', term: 2);
-    if term < 3 then
-    begin
-      writeln('lambda=');
-      iomwrv(output, lam[i1 + k1 - 1], k2 - k1 + 1, numdig);
-      writeln;
-      writeln(' m2 =', m2: 2);
-      writeln;
-      writeln('X=');
-      iomwrm(output, x[i2, j2 + k1 - 1], n, m2 - k1 + 1, rwx, numdig);
-      writeln;
-      writeln('AX-lambda.X = ');
-      omvmmm(a[i1, j1], n, n, n2 - n1 + 1, x[i2, j2 + k1 - 1], m2 - k1 + 1, n4 - n3 + 1,
-        e[i2, j2 + k1 - 1], n4 - n3 + 1);
-      for j := k1 to m2 do
-        for i := 1 to n do
-          e[i + i2 - 1, j + j2 - 1] := e[i + i2 - 1, j + j2 - 1] - lam[i1 + j - 1] * x[i + i2 - 1, j + j2 - 1];
-      iomwrm(output, e[i2, j2 + k1 - 1], n, m2 - k1 + 1, n4 - n3 + 1, numdig);
-    end;
-    writeln('---------------------------------------------------------');
-  end;
-  Close(input);
-  Close(output);
-end.

packages/numlib/tests/eigsv1te.pas

@@ -61,66 +61,3 @@ begin
   Close(input);
   Close(output);
 end.
-program eigsv1te;
-
-uses
-  typ,
-  iom,
-  eig;
-
-const
-  m1 = -2;
-  m2 = 40;
-  n1 = -3;
-  n2 = 30;
-  l1 = -2;
-  l2 = 30;
-  rw = n2 - n1 + 1;
-var
-  ex, nex, k, i, j, m, n, p, term, l: ArbInt;
-  a: array[m1..m2, n1..n2] of ArbFloat;
-  q: array[l1..l2] of ArbFloat;
-begin
-  Write(' program results eigsv1te');
-  case sizeof(ArbFloat) of
-    4: writeln('(single)');
-    6: writeln('(real)');
-    8: writeln('(double)');
-  end;
-  Read(nex);
-  writeln;
-  writeln('number of examples', nex: 2);
-  writeln;
-  for ex := 1 to nex do
-  begin
-    writeln;
-    writeln('  example number :', ex: 2);
-    Read(k, p, l, m, n);
-    if ex < nex then
-      iomrem(input, a[k, p], m, n, rw)
-    else
-      for i := 1 to m do
-        for j := 1 to n do
-          if i > j then
-            a[k - 1 + i, p - 1 + j] := 0
-          else
-          if i = j then
-            a[k - 1 + i, p - 1 + j] := 1
-          else
-            a[k - 1 + i, p - 1 + j] := -1;
-    eigsv1(a[k, p], m, n, rw, q[l], term);
-    writeln;
-    writeln(' A =');
-    iomwrm(output, a[k, p], m, n, rw, numdig);
-    writeln;
-    writeln('term=', term: 2);
-    if term = 1 then
-    begin
-      writeln;
-      writeln('q=');
-      iomwrv(output, q[l], n, numdig);
-    end;
-  end;
-  Close(input);
-  Close(output);
-end.

packages/numlib/tests/eigsv3te.pas

@@ -89,94 +89,3 @@ begin
   Close(input);
   Close(output);
 end.
-program eigsv3te;
-
-uses
-  typ,
-  iom,
-  omv,
-  eig;
-
-const
-  m1  = -4;
-  m2  = 20;
-  n1  = -5;
-  n2  = 10;
-  r1  = -3;
-  r2  = 18;
-  s1  = -2;
-  s2  = 18;
-  x1  = -5;
-  x2  = 22;
-  y1  = -3;
-  y2  = 21;
-  l1  = -2;
-  l2  = 17;
-  rwa = n2 - n1 + 1;
-  rwu = s2 - s1 + 1;
-  rwv = y2 - y1 + 1;
-var
-  ex, nex, k, i, j, m, n, p, term, l, r, s, x, y: ArbInt;
-  a, usvt, e: array[m1..m2, n1..n2] of ArbFloat;
-  u, ut, utu, us: array[r1..r2, s1..s2] of ArbFloat;
-  v, vt, vtv: array[x1..x2, y1..y2] of ArbFloat;
-  q: array[l1..l2] of ArbFloat;
-begin
-  Write(' program results eigsv3te');
-  case sizeof(ArbFloat) of
-    4: writeln('(single)');
-    6: writeln('(real)');
-    8: writeln('(double)');
-  end;
-  Read(nex);
-  writeln;
-  writeln('number of examples', nex: 2);
-  writeln;
-  for ex := 1 to nex do
-  begin
-    writeln;
-    writeln('  example number :', ex: 2);
-    Read(k, p, l, r, s, x, y, m, n);
-    iomrem(input, a[k, p], m, n, rwa);
-    eigsv3(a[k, p], m, n, rwa, q[l], u[r, s], rwu, v[x, y], rwv, term);
-    writeln;
-    writeln(' a =');
-    iomwrm(output, a[k, p], m, n, rwa, 17);
-    writeln;
-    writeln(' term=', term: 2);
-    if term = 1 then
-    begin
-      writeln;
-      writeln(' q =');
-      iomwrv(output, q[l], n, numdig);
-      writeln;
-      writeln(' u =');
-      iomwrm(output, u[r, s], m, n, rwu, numdig);
-      writeln;
-      writeln(' v =');
-      iomwrm(output, v[x, y], n, n, rwv, numdig);
-      writeln;
-      writeln(' u(t) x u =');
-      omvtrm(u[r, s], m, n, rwu, ut[r, s], rwu);
-      omvmmm(ut[r, s], n, m, rwu, u[r, s], n, rwu, utu[r, s], rwu);
-      iomwrm(output, utu[r, s], n, n, rwu, numdig);
-      writeln;
-      writeln(' v(t) x v =');
-      omvtrm(v[x, y], n, n, rwv, vt[x, y], rwv);
-      omvmmm(vt[x, y], n, n, rwv, v[x, y], n, rwv, vtv[x, y], rwv);
-      iomwrm(output, vtv[x, y], n, n, rwv, numdig);
-      writeln;
-      writeln(' a - u x sigma x v(t) = ');
-      for i := 1 to m do
-        for j := 1 to n do
-          us[r - 1 + i, s - 1 + j] := u[r - 1 + i, s - 1 + j] * q[l - 1 + j];
-      omvmmm(us[r, s], m, n, rwu, vt[x, y], n, rwv, usvt[k, p], rwa);
-      for i := 1 to m do
-        for j := 1 to n do
-          e[k - 1 + i, p - 1 + j] := a[k - 1 + i, p - 1 + j] - usvt[k - 1 + i, p - 1 + j];
-      iomwrm(output, e[k, p], m, n, rwa, numdig);
-    end;
-  end;
-  Close(input);
-  Close(output);
-end.

packages/numlib/tests/eigts1te.pas

@@ -64,69 +64,3 @@ begin
   Close(input);
   Close(output);
 end.
-program eigts1te;
-
-uses
-  typ,
-  iom,
-  eig;
-
-const
-  m1 = -9;
-  m2 = 37;
-var
-  i, ex, nex, i1, j1, n, term: ArbInt;
-  t: ArbFloat;
-  d, cd, lam: array[m1..m2] of ArbFloat;
-begin
-  Write(' program results eigts1te');
-  case sizeof(ArbFloat) of
-    4: writeln('(single)');
-    6: writeln('(real)');
-    8: writeln('(double)');
-  end;
-  Read(nex);
-  writeln;
-  writeln('number of examples', nex: 2);
-  writeln;
-  for ex := 1 to nex do
-  begin
-    writeln('example number', ex: 2);
-    writeln;
-    if ex < nex then
-    begin
-      Read(i1, j1, n);
-      iomrev(input, d[i1], n);
-      iomrev(input, cd[j1 + 1], n - 1);
-    end
-    else
-    begin
-      i1 := 1;
-      j1 := 1;
-      n  := 30;
-      for i := 1 to n do
-      begin
-        t    := i;
-        d[i] := sqr(t * t);
-      end;
-      for i := 2 to n do
-        cd[i] := i - 1;
-    end;
-    eigts1(d[i1], cd[j1 + 1], n, lam[j1], term);
-    writeln('diag =');
-    iomwrv(output, d[i1], n, numdig);
-    writeln('codiag =');
-    iomwrv(output, cd[j1 + 1], n - 1, numdig);
-    writeln;
-    writeln('term=', term: 2);
-    if term = 1 then
-    begin
-      writeln;
-      writeln('lambda=');
-      iomwrv(output, lam[j1], n, numdig);
-    end;
-    writeln('------------------------------------------------------');
-  end;
-  Close(input);
-  Close(output);
-end.

packages/numlib/tests/eigts2te.pas

@@ -67,72 +67,3 @@ begin
   Close(input);
   Close(output);
 end.
-program eigts2te;
-
-uses
-  eig,
-  iom,
-  typ;
-
-const
-  m1 = -9;
-  m2 = 37;
-var
-  t: ArbFloat;
-  i, ex, nex, k1, k2, i1, j1, n, term: ArbInt;
-  d, cd, lam: array[m1..m2] of ArbFloat;
-begin
-  Write(' program results eigts2te');
-  case sizeof(ArbFloat) of
-    4: writeln('(single)');
-    6: writeln('(real)');
-    8: writeln('(double)');
-  end;
-  Read(nex);
-  writeln;
-  writeln('number of examples', nex: 2);
-  writeln;
-  for ex := 1 to nex do
-  begin
-    writeln('example number', ex: 2);
-    writeln;
-    if ex < nex then
-    begin
-      Read(i1, j1, n, k1, k2);
-      iomrev(input, d[i1], n);
-      iomrev(input, cd[j1 + 1], n - 1);
-    end
-    else
-    begin
-      i1 := 1;
-      j1 := 1;
-      n  := 30;
-      k1 := 5;
-      k2 := 8;
-      for i := 1 to n do
-      begin
-        t    := i;
-        d[i] := sqr(t * t);
-      end;
-      for i := 2 to n do
-        cd[i] := i - 1;
-    end;
-    eigts2(d[i1], cd[j1 + 1], n, k1, k2, lam[j1 + k1 - 1], term);
-    writeln('diag =');
-    iomwrv(output, d[i1], n, numdig);
-    writeln('codiag =');
-    iomwrv(output, cd[j1 + 1], n - 1, numdig);
-    writeln;
-    writeln('k1=', k1: 2, '  k2=', k2: 2);
-    writeln;
-    writeln('term=', term: 2);
-    if term = 1 then
-    begin
-      writeln('lambda=');
-      iomwrv(output, lam[j1 + k1 - 1], k2 - k1 + 1, numdig);
-    end;
-    writeln('------------------------------------------------------');
-  end;
-  Close(input);
-  Close(output);
-end.

packages/numlib/tests/eigts3te.pas

@@ -71,76 +71,3 @@ begin
   Close(input);
   Close(output);
 end.
-program eigts3te;
-
-uses
-  typ,
-  iom,
-  omv,
-  eig;
-
-const
-  m1  = -10;
-  m2  = 10;
-  rwx = m2 - m1 + 1;
-  rwa = rwx;
-var
-  ex, nex, i1, j1, i2, j2, n, i, j, term: ArbInt;
-  d, cd, lam: array[m1..m2] of ArbFloat;
-  a, x, e:    array[m1..m2, m1..m2] of ArbFloat;
-begin
-  Write(' program results eigts3te');
-  case sizeof(ArbFloat) of
-    4: writeln('(single)');
-    6: writeln('(real)');
-    8: writeln('(double)');
-  end;
-  Read(nex);
-  writeln;
-  writeln('number of examples', nex: 2);
-  for ex := 1 to nex do
-  begin
-    writeln;
-    writeln('example number', ex: 2);
-    Read(i1, j1, i2, j2, n);
-    iomrev(input, d[i1], n);
-    iomrev(input, cd[j1 + 1], n - 1);
-    eigts3(d[i1], cd[j1 + 1], n, lam[i1], x[i2, j2], rwx, term);
-    writeln;
-    writeln('diag =');
-    iomwrv(output, d[i1], n, numdig);
-    writeln;
-    writeln('codiag =');
-    iomwrv(output, cd[j1 + 1], n - 1, numdig);
-    writeln;
-    writeln('term=', term: 2);
-    if term = 1 then
-    begin
-      writeln;
-      writeln('lambda=');
-      iomwrv(output, lam[i1], n, numdig);
-      writeln;
-      writeln('X=');
-      iomwrm(output, x[i2, j2], n, n, rwx, numdig);
-      for i := i1 to i1 + n - 1 do
-        for j := j1 to j1 + n - 1 do
-          a[i, j] := 0;
-      for i := 1 to n do
-        a[i1 + i - 1, j1 + i - 1] := d[i1 + i - 1];
-      for i := 1 to n - 1 do
-        a[i1 + i, j1 + i - 1] := cd[j1 + i];
-      for i := 1 to n - 1 do
-        a[i1 + i - 1, j1 + i] := cd[j1 + i];
-      writeln;
-      writeln('AX-lambda.X = ');
-      omvmmm(a[i1, j1], n, n, rwa, x[i2, j2], n, rwx, e[i2, j2], rwx);
-      for j := 1 to n do
-        for i := 1 to n do
-          e[i + i2 - 1, j + j2 - 1] := e[i + i2 - 1, j + j2 - 1] - lam[i1 + j - 1] * x[i + i2 - 1, j + j2 - 1];
-      iomwrm(output, e[i2, j2], n, n, rwx, numdig);
-    end;
-    writeln('-------------------------------------------------------');
-  end;
-  Close(input);
-  Close(output);
-end.

packages/numlib/tests/eigts4te.pas

@@ -78,83 +78,3 @@ begin
   Close(input);
   Close(output);
 end.
-program eigts4te;
-
-uses
-  iom,
-  typ,
-  omv,
-  eig;
-
-const
-  n1  = -10;
-  n2  = 8;
-  n3  = -11;
-  n4  = 9;
-  rwx = n4 - n3 + 1;
-  rwa = rwx;
-var
-  i, j, ex, nex, m2, k1, k2, n, term: ArbInt;
-  d, cd:   array[n1..n2] of ArbFloat;
-  a, e, x: array[n1..n2, n3..n4] of ArbFloat;
-  lam:     array[n1..n2] of ArbFloat;
-begin
-  Write(' program results eigts4te');
-  case sizeof(ArbFloat) of
-    4: writeln('(single)');
-    6: writeln('(real)');
-    8: writeln('(double)');
-  end;
-  Read(nex);
-  writeln;
-  writeln('number of examples', nex: 2);
-  for ex := 1 to nex do
-  begin
-    writeln;
-    writeln('example number', ex: 2);
-    Read(n, k1, k2);
-    iomrev(input, d[1], n);
-    iomrev(input, cd[2], n - 1);
-    eigts4(d[1], cd[2], n, k1, k2, lam[k1], x[1, k1], rwx, m2, term);
-    writeln;
-    writeln('diag = ');
-    iomwrv(output, d[1], n, numdig);
-    writeln;
-    writeln('codiag = ');
-    iomwrv(output, cd[2], n - 1, numdig);
-    writeln;
-    writeln('k1=', k1: 2, '  k2=', k2: 2);
-    writeln;
-    writeln('term=', term: 2);
-    if term = 1 then
-    begin
-      writeln;
-      writeln('lambda=');
-      iomwrv(output, lam[k1], k2 - k1 + 1, numdig);
-      writeln;
-      writeln(' m2 =', m2: 2);
-      writeln;
-      writeln(' X=');
-      iomwrm(output, x[1, k1], n, m2 - k1 + 1, rwx, numdig);
-      for i := 1 to n do
-        for j := 1 to n do
-          a[i, j] := 0;
-      for i := 1 to n do
-        a[i, i] := d[i];
-      for i := 1 to n - 1 do
-        a[1 + i, i] := cd[i + 1];
-      for i := 1 to n - 1 do
-        a[i, i + 1] := cd[i + 1];
-      writeln;
-      writeln('AX-lambda.X = ');
-      omvmmm(a[1, 1], n, n, rwa, x[1, k1], m2 - k1 + 1, rwx, e[1, k1], rwx);
-      for j := 1 to m2 - k1 + 1 do
-        for i := 1 to n do
-          e[i, j + k1 - 1] := e[i, j + k1 - 1] - lam[k1 + j - 1] * x[i, j + k1 - 1];
-      iomwrm(output, e[1, k1], n, m2 - k1 + 1, rwx, numdig);
-    end;
-    writeln('-----------------------------------------------------');
-  end;
-  Close(input);
-  Close(output);
-end.

packages/numlib/tests/intge1te.pas

@@ -496,501 +496,3 @@ begin
     Showresults;
   end;
 end.
-program intge1te;
-
-uses
-  typ,
-  spe,
-  int;
-
-const
-  e      = 2.71828182845905;
-  fnames = 'KI A0 A1 A2 A3 A4 SS SL SE V1 V2 ';
-  ogs: array[1..11] of ArbFloat = (0, 0, 1, e, 0, 1, 0, 1, 1, 1, 1);
-  integraaltekst: array[1..11, 1..5] of string[60] =
-    (('  ì                                                       ',
-    ' ô  -àcosh(x)                                             ',
-    {k0}  ' ³ e         dx  = k0(à), mits à > 0.                     ',
-    ' õ                                                        ',
-    '0                                                         '),
-    ('  ì                                                       ',
-    ' ô  sin x     àcos x                                      ',
-    {a0}  ' ³ ------- + ---------- dx  =  1, mits  à>0               ',
-    ' õ (x+1)à   (x+1)(à+1)                                  ',
-    '0                                                         '),
-    ('  ì                                                       ',
-    ' ô   1                                                    ',
-    {a1}  ' ³ ---- dx   =  1/(à-1), mits  à>1                        ',
-    ' õ  xà                                                   ',
-    '1                                                         '),
-    ('  ì                                                       ',
-    ' ô     dx                                                 ',
-    {a2}  ' ³  ---------    =  1/(à-1), mits  à>1                    ',
-    ' õ  x.ln(x)à                                             ',
-    'e                                                         '),
-    ('  ì                                                       ',
-    ' ô Ú àùxàùsin(xà)    cos(xà)¿                          ',
-    {a3}  ' ³ ³ -------------- + ---------³ dx = 1, mits  à>0        ',
-    ' õ À    x(x+1)          (x+1)ý Ù                          ',
-    '0                                                         '),
-    ('  ì                                                       ',
-    ' ô Ú 2sin(«ãùxà)       xàùcos(«ãùxà) ¿                 ',
-    {a4}  ' ³ ³-------------- + ãà-----------------³ dx = 1, mits àò0',
-    ' õ À   (x+1)ý                x(x+1)     Ù                 ',
-    '1                                                         '),
-    ('  ss(n)=2*(n+1)(à-1)/n  (n=1,2,3...), àò0                ',
-    {ss}  '  ss(x)=0 als min(|n-x|) ò 0.5/(n+1)à                    ',
-    '  ss lineair interpoleren als min(|n-x|) ó 0.5/(n+1)à    ',
-    '  int. 0:ì = ä [1:ì] 1/(n(n+1)) = 1                       ',
-    '                                                          '),
-    ('  ì                                                       ',
-    ' ô  sin(ln(x))          1                                 ',
-    {sl}  ' ³  --------- dx =  ---------,   mits  à>1                ',
-    ' õ     xà          (à-1)ý+1                              ',
-    '1                                                         '),
-    (' ì                                                        ',
-    ' ô  sin(xà)-à.x(à-1).cos(xà)       sin(1)              ',
-    {se}  ' ³  --------------------------- dx =  ------              ',
-    ' õ            ex                       e                 ',
-    '1                                                         '),
-    ('  ì                                                       ',
-    '  ô    à.|x|(à-1)                                        ',
-    {v1}  '  ³  ---------------- dx =  1, mits à > 0                 ',
-    '  õ  ã.(|x|(2à) + 1)                                     ',
-    '-ì                                                        '),
-    ('  ì            0           ì                              ',
-    '  ô            ô  àx      ô  -x/à                         ',
-    {v2}  '  ³ v2(x)dx =  ³ e   dx + ³ e    dx =  à + 1/à, mits à > 0',
-    '  õ            õ          õ                               ',
-    '-ì           -ì          0                                '));
-
-var
-  alfa, ond, inte, int1: ArbFloat;
-  u, i:  ArbInt;
-  s:     string;
-  q:     char;
-  f:     rfunc1r;
-  scale: boolean;
-
-  function Ki(x: ArbFloat): ArbFloat;
-  var
-    kk: ArbFloat;
-  begin
-    if abs(x) < ln(100 / alfa) then
-      kk := Exp(-alfa * Specoh(x))
-    else
-      kk := 0;
-    if scale then
-      ki := kk / int1
-    else
-      ki := kk;
-  end;
-
-  function uki(u: ArbFloat): ArbFloat;   {u=1/(x+1), of x=1/u-1}
-  begin
-    if u > 0 then
-      uki := ki((1 - u) / u) / sqr(u)
-    else
-      uki := 0;
-  end;
-
-  function a0(x: ArbFloat): ArbFloat;
-  begin
-    a0 := ((x + 1) * sin(x) + alfa * cos(x)) * spepow(x + 1, -alfa - 1);
-  end;
-
-  function ua0(u: ArbFloat): ArbFloat;   {u=1/(x+1), of x=1/u-1}
-  begin
-    if u > 0 then
-      ua0 := a0((1 - u) / u) / sqr(u)
-    else
-      ua0 := 0;
-  end;
-
-  function a1(x: ArbFloat): ArbFloat;
-  var
-    a: ArbFloat;
-  begin
-    a := spepow(x, -alfa);
-    if scale then
-      a1 := (alfa - 1) * a
-    else
-      a1 := a;
-  end;
-
-  function ua1(u: ArbFloat): ArbFloat;  {u=ond/x of x=ond/u}
-  begin
-    if u > 0 then
-      ua1 := a1(ond / u) * ond / sqr(u)
-    else
-      ua1 := 0;
-  end;
-
-  function a2(x: ArbFloat): ArbFloat;
-  var
-    a: ArbFloat;
-  begin
-    a := spepow(ln(x), -alfa) / x;
-    if scale then
-      a2 := (alfa - 1) * a
-    else
-      a2 := a;
-  end;
-
-  function ua2(u: ArbFloat): ArbFloat;  {u=ond/x of x=ond/u}
-  begin
-    if u > 0 then
-      ua2 := a2(ond / u) * ond / sqr(u)
-    else
-      ua2 := 0;
-  end;
-
-  function a3(x: ArbFloat): ArbFloat;
-  var
-    y: ArbFloat;
-  begin
-    if x = 0 then
-      a3 := 0
-    else
-    begin
-      y  := spepow(x, alfa);
-      a3 := alfa * y * sin(y) / (x * (x + 1)) + cos(y) / sqr(x + 1);
-    end;
-  end;
-
-  function ua3(u: ArbFloat): ArbFloat;   {u=1/(x+1), of x=1/u-1}
-  begin
-    if u > 0 then
-      ua3 := a3((1 - u) / u) / sqr(u)
-    else
-      ua3 := 0;
-  end;
-
-  function a4(x: ArbFloat): ArbFloat;
-  var
-    y, z: ArbFloat;
-  begin
-    y  := spepow(x, alfa);
-    z  := y * pi / 2;
-    a4 := 2 * sin(z) / sqr(x + 1) - pi * alfa * y * cos(z) / (x * (x + 1));
-  end;
-
-  function ua4(u: ArbFloat): ArbFloat;  {u=ond/x of x=ond/u}
-  begin
-    if u > 0 then
-      ua4 := a4(ond / u) * ond / sqr(u)
-    else
-      ua4 := 0;
-  end;
-
-  function ss(x: ArbFloat): ArbFloat;
-  var
-    d, eps, r: ArbFloat;
-  begin
-    if x > 0.5 then
-    begin
-      d := frac(x);
-      r := x - d;
-      if d > 0.5 then
-      begin
-        d := 1 - d;
-        r := r + 1;
-      end;
-      eps := 0.5 / spepow(r + 1, alfa);
-      if d > eps then
-        ss := 0
-      else
-        ss := (1 - d / eps) / (r * (r + 1) * eps);
-    end
-    else
-      ss := 0;
-  end;
-
-  function uss(u: ArbFloat): ArbFloat;  {u=ond/x of x=ond/u}
-  begin
-    if u > 0 then
-      uss := ss(ond / u) * ond / sqr(u)
-    else
-      uss := 0;
-  end;
-
-  function sl(x: ArbFloat): ArbFloat;
-  var
-    sl1: ArbFloat;
-  begin
-    sl1 := sin(ln(x)) * spepow(x, -alfa);
-    if scale then
-      sl := sl1 / int1
-    else
-      sl := sl1;
-  end;
-
-  function usl(u: ArbFloat): ArbFloat;  {u=ond/x of x=ond/u}
-  begin
-    if u > 0 then
-      usl := sl(ond / u) * ond / sqr(u)
-    else
-      usl := 0;
-  end;
-
-  function se(x: ArbFloat): ArbFloat;
-  var
-    y, se1: ArbFloat;
-  begin
-    y   := spepow(x, alfa);
-    se1 := (sin(y) - alfa * (y / x) * cos(y)) * exp(-x);
-    if scale then
-      se := se1 / int1
-    else
-      se := se1;
-  end;
-
-  function use(u: ArbFloat): ArbFloat;  {u=ond/x of x=ond/u}
-  begin
-    if u > 0 then
-      use := se(ond / u) * ond / sqr(u)
-    else
-      use := 0;
-  end;
-
-  function v1(x: ArbFloat): ArbFloat;
-  var
-    a, y: ArbFloat;
-  begin
-    x    := abs(x);
-    alfa := abs(alfa);
-    if x = 0 then
-    begin
-      if alfa = 1 then
-        v1 := alfa / pi
-      else
-        v1 := 0;
-    end
-    else
-    begin
-      if x > 1 then
-        a := -alfa - 1
-      else
-        a := alfa - 1;
-      y := spepow(x, a);
-      v1 := alfa * y / (pi * (sqr(x * y) + 1));
-    end;
-  end;
-
-  function uv1(u: ArbFloat): ArbFloat;  { u=«((2/ã)arctan(x)+1) of x=tan(«ã(2u-1)) }
-  var
-    y: ArbFloat;                         { 0 ó u ó 1 }
-  begin
-    if (u = 0) or (u = 1) then
-      uv1 := 0
-    else
-    begin
-      y   := 1 / sqr(cos(pi * (u - 0.5)));
-      uv1 := pi * v1(sqrt(y - 1)) * y;
-    end;
-  end;
-
-  function v2(x: ArbFloat): ArbFloat;
-  var
-    v: ArbFloat;
-  begin
-    alfa := abs(alfa);
-    if x > 0 then
-      v := exp(-x / alfa)
-    else
-    if x < 0 then
-      v := exp(x * alfa)
-    else
-      v := 1;
-    if scale then
-      v2 := v / (alfa + 1 / alfa)
-    else
-      v2 := v;
-  end;
-
-  function uv2(u: ArbFloat): ArbFloat;  { u=«((2/ã)arctan(x)+1) of x=tan(«ã(2u-1)) }
-  var
-    y: ArbFloat;                         { 0 ó u ó 1 }
-  begin
-    if (u = 0) or (u = 1) then
-      uv2 := 0
-    else
-    begin
-      y := 1 / sqr(cos(pi * (u - 0.5)));
-      if u > 0.5 then
-        uv2 := pi * v2(sqrt(y - 1)) * y
-      else
-        uv2 := pi * v2(-sqrt(y - 1)) * y;
-    end;
-  end;
-
-var
-  integral, ae, err: ArbFloat;
-  term, num2:   ArbInt;
-  intex, First: boolean;
-
-  procedure Header;
-  var
-    i: ArbInt;
-  begin
-    for i := 1 to 5 do
-      if i = 3 then
-        writeln(s: 3, ': ', Integraaltekst[u, i])
-      else
-        writeln('': 5, Integraaltekst[u, i]);
-  end;
-
-  procedure ShowResults;
-  var
-    f: ArbFloat;
-  begin
-    if First then
-      writeln('alfa': num2, '': numdig - num2, 'ae': 7, ' ': 4, 'int': num2,
-        '': numdig - num2, ' ', 'err': 7, ' ': 4, 'f': 6);
-    First := False;
-    if intex then
-      f := inte - integral;
-    case term of
-      1:
-      begin
-        Write(alfa: numdig, ae: 10, integral: numdig, ' ', err: 10, ' ');
-        if intex then
-          writeln(f: 10)
-        else
-          writeln;
-      end;
-      2:
-      begin
-        Write(alfa: numdig, ae: 10, integral: numdig, ' ', err: 10, ' ');
-        if intex then
-          writeln(f: 10)
-        else
-          writeln;
-        Writeln('    process afgebroken, te hoge nauwkeurigheid?');
-      end;
-      3: Writeln('Verkeerde waarde ae (<=0) bij aanroep: ', ae: 8);
-      4:
-      begin
-        Write(alfa: numdig, ae: 10, integral: numdig, ' ', err: 10, ' ');
-        if intex then
-          writeln(f: 10)
-        else
-          writeln;
-        writeln('    process afgebroken, moeilijk, mogelijk divergent?');
-      end;
-    end;
-  end;
-
-const
-  fint: array[boolean, 1..11] of rfunc1r =
-    ((@ki, @a0, @a1, @a2, @a3, @a4, @ss, @sl, @se, @v1, @v2),
-    (@uki, @ua0, @ua1, @ua2, @ua3, @ua4, @uss, @usl, @use, @uv1, @uv2));
-begin
-  s := ParamStr(1);
-  if s = '' then
-  begin
-    writeln(' Vergeten  functienaam mee te geven!');
-    writeln(' Kies uit: ', fnames);
-    halt;
-  end;
-  for i := 1 to length(s) do
-    s[i] := Upcase(s[i]);
-  u := (Pos(s, fnames) + 2) div 3;
-  if u = 0 then
-  begin
-    writeln(' Commandlineparameter ', s, ' bestaat niet');
-    writeln(' Kies uit: ', fnames);
-    halt;
-  end;
-
-  Write('program results int1fr function ' + s);
-  case SizeOf(ArbFloat) of
-    4: writeln('(single)');
-    8: writeln('(double)');
-    6: writeln('(real)');
-  end;
-  num2 := numdig div 2;
-  if Pos(s, 'a0 a4 a3 ss v1') > 0 then
-    scale := True
-  else
-  begin
-    Write(' scale ? (y or n)');
-    readln(q);
-    scale := Upcase(q) = 'Y';
-  end;
-  Write('Transformatie naar 0 => 1 ? (y or n)');
-  readln(q);
-  ond := ogs[u];
-  f   := fint[Upcase(q) = 'Y'][u];
-  Header;
-  Writeln('à en ae: ');
-  First := True;
-  while not eoln do
-  begin
-    Read(alfa, ae);
-    intex := True;
-    case u of
-      1: int1 := spebk0(alfa);
-      2:
-      begin
-        int1  := 1;
-        intex := alfa > 0;
-      end;
-      3:
-      begin
-        if alfa > 1 then
-          int1 := 1 / (alfa - 1);
-        intex := alfa > 1;
-      end;
-      4:
-      begin
-        if alfa > 1 then
-          int1 := 1 / (alfa - 1);
-        intex := alfa > 1;
-      end;
-      5:
-      begin
-        if alfa > 0 then
-          int1 := 1
-        else
-          int1 := cos(1);
-        intex := alfa > 0;
-      end;
-      6:
-      begin
-        int1  := 1;
-        intex := alfa > 0;
-      end;
-      7: int1 := 1;
-      8:
-      begin
-        if alfa > 1 then
-          int1 := 1 / (sqr(alfa - 1) + 1);
-        intex := alfa > 1;
-      end;
-      9: int1 := sin(1) / e;
-      10:
-      begin
-        int1  := 1;
-        intex := alfa <> 0;
-      end;
-      11:
-      begin
-        if alfa <> 0 then
-          int1 := abs(alfa) + 1 / abs(alfa);
-        intex := alfa <> 0;
-      end;
-    end;
-    if scale then
-      inte := 1
-    else
-      inte := int1;
-    if Upcase(q) = 'Y' then
-      int1fr(f, 0, 1, ae, integral, err, term)
-    else if u < 10 then
-      int1fr(f, ond, infinity, ae, integral, err, term)
-    else
-      int1fr(f, -infinity, infinity, ae, integral, err, term);
-    Showresults;
-  end;
-end.

packages/numlib/tests/intge2te.pas

@@ -424,429 +424,3 @@ begin
   Header;
   ShowResults;
 end.
-program InitInfEx;
-
-uses
-  Typ,
-  Spe,
-  Int;
-
-var
-  num2: ArbInt;
-  inte: ArbFloat;
-const
-  e = 2.71828182845905;
-
-  function cx(x: ArbFloat): ArbFloat;
-  begin
-    cx := cos(x) / (sqr(x) + 1);
-  end;
-
-  function pcx(x: ArbFloat): ArbFloat;
-  begin
-    pcx := 2 * x * sin(x) / sqr(sqr(x) + 1);
-  end;
-
-  function ppcx(x: ArbFloat): ArbFloat;
-  var
-    s: ArbFloat;
-  begin
-    s    := sqr(x);
-    ppcx := cos(x) * (2 - 6 * s) / ((s + 1) * sqr(s + 1));
-  end;
-
-  function cc2(x: ArbFloat): ArbFloat;
-  var
-    x2: ArbFloat;
-  begin
-    x2  := sqr(x);
-    cc2 := cos(x) / (sqr(x2) + x2 + 1);
-  end;
-
-  function ucx(x: ArbFloat): ArbFloat;
-  begin
-    if x = 0 then
-      ucx := 0
-    else
-      ucx := cx((1 - x) / x) / sqr(x);
-  end;
-
-  function ucc2(x: ArbFloat): ArbFloat;
-  begin
-    if x = 0 then
-      ucc2 := 0
-    else
-      ucc2 := cc2((1 - x) / x) / sqr(x);
-  end;
-
-  function uz(x: ArbFloat): ArbFloat;
-  begin
-    uz := sin(x) * exp(-x);
-  end;
-
-  function ss1(x: ArbFloat): ArbFloat;    { f(«n(n-1))=0 (n=1,2,3,...) }
-  var
-    n, s, c: ArbFloat;                    { f(«ný)=2/(ný(n+1))  }
-  begin                                   { overigens: f linear interpoleren}
-    s := sqrt(2 * x);
-    n := trunc(s);
-    if n * (n + 1) / 2 <= x then
-      n := n + 1;  { n z.d.d. «n(n-1) ó x ó «n(n-1) }
-    c := 4 / (n * sqr(n) * (n + 1));
-    if s < n then
-      ss1 := c * (x - n * (n - 1) / 2)
-    else
-      ss1 := c * (n * (n + 1) / 2 - x);
-  end;
-
-  function ss2(x: ArbFloat): ArbFloat;   { als ss1 met f(«ný)=2/(n.2ü)  }
-  var
-    n, s, c: ArbFloat;
-  begin
-    s := sqrt(2 * x);
-    n := trunc(s);
-    if n * (n + 1) / 2 <= x then
-      n := n + 1;
-    c := spepow(2, 2 - n) / sqr(n);
-    if s < n then
-      ss2 := c * (x - n * (n - 1) / 2)
-    else
-      ss2 := c * (n * (n + 1) / 2 - x);
-  end;
-
-  function ss3(x: ArbFloat): ArbFloat;       { x  z.d.d. «.2ü ó x+1 ó 2ü  s=2ü}
-  var
-    s, c, f, x1: ArbFloat;
-    n: ArbInt;        {n even: f(n)=-4/(n.2ü)}
-  begin                                  {n oneven: f(n) = 4/(n.2ü)}
-    n  := 0;
-    s  := 1;
-    x1 := x + 1;               { overigens: f lineair interpol.}
-    repeat
-      n := n + 1;
-      s := s * 2
-    until s > x1;
-    c := 16 / (n * sqr(s));
-    if x1 < 0.75 * s then
-      f := c * (x1 - s / 2)
-    else
-      f := c * (s - x1);
-    if odd(n) then
-      ss3 := f
-    else
-      ss3 := -f;
-  end;
-
-  function ss4(x: ArbFloat): ArbFloat;        { 0 ó x ó 1}
-  var
-    y, h:  ArbFloat;                        { zij x = ä [1:ì] c(n)/3ü c(n)=0,1,2}
-    ready: boolean;                         { zoek kleinste k met c(k)=1}
-  begin                                     { dan geldt f(x)=u(y)/3k }
-    y     := 3 * x;
-    h     := 1 / 3;
-    ready := False;         { met u(y)=|y-1«|, 1 ó y ó 2}
-    repeat                                { en y =  ä [k:ì] (c(n)/3ü)*3k }
-      if (y < 1) or (y > 2) then
-      begin
-        if y < 1 then
-          y := 3 * y
-        else
-          y := 3 * (y - 2);
-        h := h / 3;
-        if h < macheps then
-        begin
-          ready := True;
-          ss4   := 0;
-        end;
-      end
-      else
-      begin
-        ready := True;
-        if y < 1.5 then
-          ss4 := h * (y - 1)
-        else
-          ss4 := h * (2 - y);
-      end
-    until ready;
-  end;
-
-  function ss5(x: ArbFloat): ArbFloat;   { uitbreiding ss4}
-  var
-    y, h:  ArbFloat;                   {functiewaarden op 'volgend' interval}
-    ready: boolean;                    { [n, n+1] telkens halveren}
-  begin
-    y     := 3 * frac(x);
-    h     := spepow(0.5, trunc(x)) / 3;
-    ready := False;
-    repeat
-      if (y < 1) or (y > 2) then
-      begin
-        if y < 1 then
-          y := 3 * y
-        else
-          y := 3 * (y - 2);
-        h := h / 3;
-        if h < macheps then
-        begin
-          ready := True;
-          ss5   := 0;
-        end;
-      end
-      else
-      begin
-        ready := True;
-        if y < 1.5 then
-          ss5 := h * (y - 1)
-        else
-          ss5 := h * (2 - y);
-      end
-    until ready;
-  end;
-
-  function ss6(x: ArbFloat): ArbFloat;   { 0 ó x ó 1, 'gladdere' variant van ss4}
-  var
-    y, h:  ArbFloat;
-    ready: boolean;
-
-    function f(y: ArbFloat): ArbFloat; { 1 ó y ó 2, 1 x cont. diff, symm. max in 1.5}
-    begin
-      if y > 1.5 then
-        y := 3 - y;
-      if y < 1.25 then
-        f := sqr(y - 1)
-      else
-        f := 0.125 - sqr(1.5 - y);
-    end;
-
-  begin
-    y     := 3 * x;
-    h     := 1 / 3;
-    ready := False;
-    repeat
-      if (y < 1) or (y > 2) then
-      begin
-        if y < 1 then
-          y := 3 * y
-        else
-          y := 3 * (y - 2);
-        h := h / 3;
-        if h < macheps then
-        begin
-          ready := True;
-          ss6   := 0;
-        end;
-      end
-      else
-      begin
-        ready := True;
-        ss6   := h * f(y);
-      end
-    until ready;
-  end;
-
-  function bb(x: ArbFloat): ArbFloat;
-  begin
-    bb := spepow(x, -x) * (ln(x) + 1);
-  end;
-
-var
-  integral, ae, err: ArbFloat;
-  term:  ArbInt;
-  intex: boolean;
-
-  procedure Header;
-  begin
-    Write('int': num2, '': numdig - num2, ' ', 'err': 7, ' ': 4);
-    if intex then
-      Write('f': 6);
-    writeln;
-  end;
-
-  procedure ShowResults;
-  var
-    f: ArbFloat;
-  begin
-    if intex then
-      f := inte - integral;
-    case term of
-      1:
-      begin
-        Write(integral: numdig, ' ', err: 10, ' ');
-        if intex then
-          writeln(f: 10)
-        else
-          writeln;
-      end;
-      2:
-      begin
-        Write(integral: numdig, ' ', err: 10, ' ');
-        if intex then
-          writeln(f: 10)
-        else
-          writeln;
-        Writeln('    process afgebroken, te hoge nauwkeurigheid?');
-      end;
-      3: Writeln('Verkeerde parameterwaarde (<=0) bij aanroep: ', ae: 8);
-      4:
-      begin
-        Write(integral: numdig, ' ', err: 10, ' ');
-        if intex then
-          writeln(f: 10)
-        else
-          writeln;
-        writeln('    process afgebroken, moeilijk, mogelijk divergent?');
-      end;
-    end;
-  end;
-
-begin
-  num2 := numdig div 2;
-
-  Writeln('     ì   ');
-  Writeln('    ô  cos x           ã ');
-  Writeln('    ³ ------- dx   =   -- ');
-  Writeln('  0 õ  xý+ 1           2e ');
-  writeln;
-  ae := 1e-8;
-  Writeln('   Gevraagde nauwkeurigheid', ae: 12);
-  writeln;
-  inte  := 0.5 * pi / e;
-  intex := True;
-  writeln(inte: numdig, ' is ''exacte'' oplossing');
-  Int1fr(@cx, 0, infinity, ae, integral, err, term);
-  Header;
-  ShowResults;
-  writeln;
-  Writeln('berekend met Int1fr via transformatie x=(1-t)/t');
-  writeln;
-  Int1fr(@ucx, 0, 1, ae, integral, err, term);
-  Header;
-  ShowResults;
-  Writeln('     ì   ');
-  Writeln('    ô  2x sin x           ã ');
-  Writeln('    ³ --------- dx   =    -- ');
-  Writeln('  0 õ  (xý+ 1)ý           2e ');
-  writeln;
-  ae := 1e-8;
-  Writeln('   Gevraagde nauwkeurigheid', ae: 12);
-  writeln;
-  Int1fr(@pcx, 0, infinity, ae, integral, err, term);
-  Header;
-  ShowResults;
-  Writeln('     ì   ');
-  Writeln('    ô (2-6xý)cos x            ã ');
-  Writeln('    ³ ------------ dx   =    -- ');
-  Writeln('  0 õ  (xý+ 1)3             2e ');
-  writeln;
-  ae := 1e-8;
-  Writeln('   Gevraagde nauwkeurigheid', ae: 12);
-  writeln;
-  Int1fr(@ppcx, 0, infinity, ae, integral, err, term);
-  Header;
-  ShowResults;
-
-  Writeln('     ì   ');
-  Writeln('    ô     cos x ');
-  Writeln('    ³ ------------ dx   =  (ã/û3) exp(-«û3) sin(ã/6+«) ');
-  Writeln('  0 õ  (xý)ý+xý+ 1 ');
-  writeln;
-  writeln;
-  ae := 1e-8;
-  Writeln('   Gevraagde nauwkeurigheid', ae: 12);
-  writeln;
-  inte := (pi / sqrt(3)) * exp(-sqrt(0.75)) * sin(pi / 6 + 0.5);
-  writeln(inte: numdig, ' is ''exacte'' oplossing');
-  Int1fr(@cc2, 0, infinity, ae, integral, err, term);
-  Header;
-  ShowResults;
-  writeln;
-  Writeln('berekend met Int1fr via transformatie x=(1-t)/t');
-  writeln;
-  writeln;
-  writeln(inte: numdig, ' is ''exacte'' oplossing');
-  Int1fr(@ucc2, 0, 1, ae, integral, err, term);
-  Header;
-  ShowResults;
-
-  Writeln('     ì   ');
-  Writeln('    ô sin u                ');
-  Writeln('    ³ ------ du   =  « ');
-  Writeln('    õ exp(u)            ');
-  writeln('   0 ');
-  ae    := 1e-8;
-  intex := True;
-  inte  := 0.5;
-  Writeln('   Gevraagde nauwkeurigheid', ae: 12);
-  writeln;
-  Int1fr(@uz, 0, infinity, ae, integral, err, term);
-  Header;
-  ShowResults;
-
-  writeln(' functie ss1;  int = ä {1:ì}1/n(n+1)  =  1');
-  ae    := 1e-8;
-  intex := True;
-  inte  := 1;
-  Writeln('   Gevraagde nauwkeurigheid', ae: 12);
-  int1fr(@ss1, 0, infinity, ae, integral, err, term);
-  Header;
-  Showresults;
-
-  writeln(' functie ss2;  int = ä {1:ì} («)ü  =  1');
-  ae    := 1e-8;
-  intex := True;
-  inte  := 1;
-  Writeln('   Gevraagde nauwkeurigheid', ae: 12);
-  int1fr(@ss2, 0, infinity, ae, integral, err, term);
-  Header;
-  Showresults;
-
-  writeln(' functie ss3;  int = ä {1:ì} (-1)ü/n  =  ln(2)');
-  ae    := 1e-8;
-  intex := True;
-  inte  := ln(2);
-  Writeln('   Gevraagde nauwkeurigheid', ae: 12);
-  int1fr(@ss3, 0, infinity, ae, integral, err, term);
-  Header;
-  Showresults;
-
-  writeln(' functie ss4 (op [0,1]); int = 1/28 ');
-  ae    := 1e-8;
-  intex := True;
-  inte  := 1 / 28;
-  Writeln('   Gevraagde nauwkeurigheid', ae: 12);
-  int1fr(@ss4, 0, 1, ae, integral, err, term);
-  Header;
-  Showresults;
-
-  writeln(' functie ss5 (op [0,ì)); int = 1/14 ');
-  ae    := 1e-8;
-  intex := True;
-  inte  := 1 / 14;
-  Writeln('   Gevraagde nauwkeurigheid', ae: 12);
-  int1fr(@ss5, 0, infinity, ae, integral, err, term);
-  Header;
-  Showresults;
-
-  writeln(' functie ss6 (op [0,1]); int = 1/112 ');
-  ae    := 1e-8;
-  intex := True;
-  inte  := 1 / 112;
-  Writeln('   Gevraagde nauwkeurigheid', ae: 12);
-  int1fr(@ss6, 0, 1, ae, integral, err, term);
-  Header;
-  Showresults;
-
-  Writeln('     ì   ');
-  Writeln('    ô  ln(x)+1         ');
-  Writeln('    ³ ---------- dx   = 1  ');
-  Writeln('    õ     xx            ');
-  writeln('   1 ');
-  ae    := 1e-8;
-  intex := True;
-  inte  := 1;
-  Writeln('   Gevraagde nauwkeurigheid', ae: 12);
-  writeln;
-  Int1fr(@bb, 0, infinity, ae, integral, err, term);
-  Header;
-  ShowResults;
-end.

packages/numlib/tests/intge3te.pas

@@ -87,92 +87,3 @@ begin
       err: 12, '   ', term: 1);
   end;
 end.
-program Intge3te;
-
-uses
-  Typ,
-  Int;
-
-const
-  ae: ArbFloat = 1e-5;
-var
-  a, b, integral, err: ArbFloat;
-  i, term, nd: ArbInt;
-
-  function cx(x: ArbFloat): ArbFloat;
-  begin
-    cx := 1 / (sqr(x) + 1);
-  end;
-
-begin
-  nd := numdig div 2;
-  for i := 1 to 11 do
-  begin
-    case i of
-      1:
-      begin
-        a := -infinity;
-        b := 0;
-      end;
-      2:
-      begin
-        a := infinity;
-        b := 0;
-      end;
-      3:
-      begin
-        a := -infinity;
-        b := infinity;
-      end;
-      4:
-      begin
-        a := infinity;
-        b := -infinity;
-      end;
-      5:
-      begin
-        a := 0;
-        b := 1;
-      end;
-      6:
-      begin
-        a := 1;
-        b := 1;
-      end;
-      7:
-      begin
-        a := 1;
-        b := 0;
-      end;
-      8:
-      begin
-        a := infinity;
-        b := infinity;
-      end;
-      9:
-      begin
-        a := 0;
-        b := infinity;
-      end;
-      10:
-      begin
-        a := 0;
-        b := -infinity;
-      end;
-      11:
-      begin
-        a := -infinity;
-        b := -infinity;
-      end;
-    end;
-    Int1fr(@cx, a, b, ae, integral, err, term);
-    if i = 1 then
-    begin
-      writeln(' ae =', ae: numdig);
-      writeln('': nd, 'a', '': numdig, 'b', '': numdig, 'int', '': nd + 3,
-        'err', '': nd - 2, 'term');
-    end;
-    Writeln(a: numdig, ' ', b: numdig, ' ', integral: numdig, '  ',
-      err: 12, '   ', term: 1);
-  end;
-end.

packages/numlib/tests/invgente.pas

@@ -59,64 +59,3 @@ begin
   Close(input);
   Close(output);
 end.
-program invgente;
-
-uses
-  typ,
-  iom,
-  inv;
-
-const
-  m1 = -10;
-  m2 = 10;
-  n1 = -5;
-  n2 = 10;
-var
-  t, aantal, kk, ii, jj, k, j, n, term: ArbInt;
-  s: ArbFloat;
-  u, h, a: array[m1..m2, n1..n2] of ArbFloat;
-begin
-  Write(' program results invgente');
-  case sizeof(ArbFloat) of
-    4: writeln('(single)');
-    6: writeln('(real)');
-    8: writeln('(double)');
-  end;
-  Read(aantal);
-  writeln;
-  writeln(' number of examples:', aantal: 3);
-  for t := 1 to aantal do
-  begin
-    writeln;
-    writeln('       example nr ', t: 3);
-    Read(k, j, n);
-    iomrem(input, a[k, j], n, n, n2 - n1 + 1);
-    writeln;
-    writeln('a =');
-    iomwrm(output, a[k, j], n, n, n2 - n1 + 1, numdig);
-    for ii := 1 to n do
-      for jj := 1 to n do
-        h[k - 1 + ii, j - 1 + jj] := a[k - 1 + ii, j - 1 + jj];
-    invgen(n, n2 - n1 + 1, a[k, j], term);
-    writeln;
-    writeln('term=', term: 2);
-    if term = 1 then
-    begin
-      writeln('inv(a)=');
-      iomwrm(output, a[k, j], n, n, n2 - n1 + 1, numdig);
-      for ii := 1 to n do
-        for jj := 1 to n do
-        begin
-          s := 0;
-          for kk := 1 to n do
-            s := s + h[k - 1 + ii, j - 1 + kk] * a[k - 1 + kk, j - 1 + jj];
-          u[ii, jj] := s;
-        end; {ii,jj}
-      writeln;
-      writeln('a x inv(a) =');
-      iomwrm(output, u[1, 1], n, n, n2 - n1 + 1, numdig);
-    end; {term=1}
-  end; {t}
-  Close(input);
-  Close(output);
-end.

packages/numlib/tests/invgpdte.pas

@@ -59,64 +59,3 @@ begin
   Close(input);
   Close(output);
 end.
-program invgpdte;
-
-uses
-  typ,
-  iom,
-  inv;
-
-const
-  m1 = -10;
-  m2 = 10;
-  n1 = -5;
-  n2 = 10;
-var
-  t, aantal, kk, ii, jj, k, j, n, term: ArbInt;
-  s: ArbFloat;
-  u, h, a: array[m1..m2, n1..n2] of ArbFloat;
-begin
-  Write(' program results invgpdte');
-  case sizeof(ArbFloat) of
-    4: writeln('(single)');
-    6: writeln('(real)');
-    8: writeln('(double)');
-  end;
-  Read(aantal);
-  writeln;
-  writeln(' number of examples:', aantal: 3);
-  for t := 1 to aantal do
-  begin
-    writeln;
-    writeln('       example nr ', t: 3);
-    Read(k, j, n);
-    iomrem(input, a[k, j], n, n, n2 - n1 + 1);
-    writeln;
-    writeln('a =');
-    iomwrm(output, a[k, j], n, n, n2 - n1 + 1, numdig);
-    for ii := 1 to n do
-      for jj := 1 to n do
-        h[k - 1 + ii, j - 1 + jj] := a[k - 1 + ii, j - 1 + jj];
-    invgpd(n, n2 - n1 + 1, a[k, j], term);
-    writeln;
-    writeln('term=', term: 2);
-    if term = 1 then
-    begin
-      writeln('inv(a)=');
-      iomwrm(output, a[k, j], n, n, n2 - n1 + 1, numdig);
-      for ii := 1 to n do
-        for jj := 1 to n do
-        begin
-          s := 0;
-          for kk := 1 to n do
-            s := s + h[k - 1 + ii, j - 1 + kk] * a[k - 1 + kk, j - 1 + jj];
-          u[ii, jj] := s;
-        end; {ii,jj}
-      writeln;
-      writeln('a x inv(a) =');
-      iomwrm(output, u[1, 1], n, n, n2 - n1 + 1, numdig);
-    end; {term=1}
-  end; {t}
-  Close(input);
-  Close(output);
-end.

packages/numlib/tests/invgsyte.pas

@@ -59,64 +59,3 @@ begin
   Close(input);
   Close(output);
 end.
-program invgsyte;
-
-uses
-  typ,
-  iom,
-  inv;
-
-const
-  m1 = -10;
-  m2 = 10;
-  n1 = -5;
-  n2 = 10;
-var
-  t, aantal, kk, ii, jj, k, j, n, term: ArbInt;
-  s: ArbFloat;
-  u, h, a: array[m1..m2, n1..n2] of ArbFloat;
-begin
-  Write(' program results invgsyte');
-  case sizeof(ArbFloat) of
-    4: writeln('(single)');
-    6: writeln('(real)');
-    8: writeln('(double)');
-  end;
-  Read(aantal);
-  writeln;
-  writeln(' number of examples:', aantal: 3);
-  for t := 1 to aantal do
-  begin
-    writeln;
-    writeln('       example nr ', t: 3);
-    Read(k, j, n);
-    iomrem(input, a[k, j], n, n, n2 - n1 + 1);
-    writeln;
-    writeln('a =');
-    iomwrm(output, a[k, j], n, n, n2 - n1 + 1, numdig);
-    for ii := 1 to n do
-      for jj := 1 to n do
-        h[k - 1 + ii, j - 1 + jj] := a[k - 1 + ii, j - 1 + jj];
-    invgsy(n, n2 - n1 + 1, a[k, j], term);
-    writeln;
-    writeln('term=', term: 2);
-    if term = 1 then
-    begin
-      writeln('inv(a)=');
-      iomwrm(output, a[k, j], n, n, n2 - n1 + 1, numdig);
-      for ii := 1 to n do
-        for jj := 1 to n do
-        begin
-          s := 0;
-          for kk := 1 to n do
-            s := s + h[k - 1 + ii, j - 1 + kk] * a[k - 1 + kk, j - 1 + jj];
-          u[ii, jj] := s;
-        end; {ii,jj}
-      writeln;
-      writeln('a x inv(a) =');
-      iomwrm(output, u[1, 1], n, n, n2 - n1 + 1, numdig);
-    end; {term=1}
-  end; {t}
-  Close(input);
-  Close(output);
-end.

packages/numlib/tests/iomwrmte.pas

@@ -41,46 +41,3 @@ begin
   end;
   Close(output);
 end.
-program iomwrmte;
-
-uses
-  typ,
-  iom;
-
-const
-  n1 = -5;
-  n2 = 10;
-  m1 = -3;
-  m2 = 20;
-  r  = m2 - m1 + 1;
-  p  = 3;
-  q  = 2;
-  n  = 7;
-  m  = 15;
-
-var
-  i, j, f, s: ArbInt;
-  a: array[n1..n2, m1..m2] of ArbFloat;
-begin
-  Assign(output, ParamStr(2));
-  rewrite(output);
-
-  Write(output, ' program results iomwrmte');
-  s := sizeof(ArbFloat);
-  case s of
-    4: writeln(output, '(single)');
-    6: writeln(output, '(real)');
-    8: writeln(output, '(double)')
-  end;
-  writeln(output);
-  for i := 1 to n do
-    for j := 1 to m do
-      a[i + p - 1, j + q - 1] := i + j * 1e-3;
-  for f := minform to maxform do
-  begin
-    writeln(output, 'A = (form=', f: 2, ')');
-    iomwrm(output, a[p, q], n, m, r, f);
-    writeln(output);
-  end;
-  Close(output);
-end.

packages/numlib/tests/odeiv1te.pas

@@ -89,94 +89,3 @@ begin
   Close(input);
   Close(output);
 end.
-program odeiv1te;
-
-uses
-  typ,
-  ode;
-
-var
-  ex, nv, i, term:     ArbInt;
-  a, b, d, ya, yb, ae: ArbFloat;
-
-  function f(x, y: ArbFloat): ArbFloat;
-  begin
-    f := -10 * (y - sqr(x));
-  end; {f}
-
-  function g(x, y: ArbFloat): ArbFloat;
-  begin
-    g := -100 * (y - sin(x)) + cos(x);
-  end; {g}
-
-  function h(x, y: ArbFloat): ArbFloat;
-  begin
-    h := 15 * y;
-  end; {h}
-
-  function phi(x: ArbFloat): ArbFloat;
-  begin
-    phi := -exp(-10 * x) * 0.02 + sqr(x) - x * 0.2 + 0.02;
-  end; {phi}
-
-begin
-  Write(' program results odeiv1te');
-  case sizeof(ArbFloat) of
-    4: writeln('(single)');
-    6: writeln('(real)');
-    8: writeln('(double)');
-  end;
-  Read(nv);
-  writeln('program results odeiv1te');
-  writeln;
-  writeln('   number of examples: ', nv: 2);
-  for ex := 1 to nv do
-  begin
-    writeln;
-    writeln('  example number :', ex: 2);
-    Read(a, b, ya, ae);
-    d := b - a;
-    writeln('a': 3, 'b': 5, 'yb': 12, 'phi(b)': 20, 'ae': 10, 'term': 9);
-    for i := 1 to 5 do
-    begin
-      odeiv1(@f, a, ya, b, yb, ae, term);
-      writeln(a: 5: 2, b: 5: 2, ' ', yb: numdig, ' ', phi(b): numdig, ae: 9, term: 3);
-      a  := b;
-      ya := yb;
-      b  := b + d;
-    end; {i}
-    writeln(' -------------------------------------------------');
-  end; {ex}
-  a  := 0;
-  ya := 1;
-  b  := 1;
-  ae := 1e-6;
-  odeiv1(@g, a, ya, b, yb, ae, term);
-  writeln(a: 5: 2, b: 5: 2, ' ', yb - sin(1): numdig, ' ', ae: 9, term: 3);
-  a  := 0;
-  ya := 1e-3;
-  b  := 1;
-  ae := 1e-4;
-  odeiv1(@h, a, ya, b, yb, ae, term);
-  writeln(a: 5: 2, b: 5: 2, ' ', yb: numdig, ' ', 1e-3 * exp(15): numdig, ae: 9, term: 3);
-  a  := 0;
-  ya := 1e-3;
-  b  := 1;
-  ae := 1e-6;
-  odeiv1(@h, a, ya, b, yb, ae, term);
-  writeln(a: 5: 2, b: 5: 2, ' ', yb: numdig, ' ', 1e-3 * exp(15): numdig, ae: 9, term: 3);
-  a  := 0;
-  ya := 1e-3;
-  b  := a;
-  ae := 1e-6;
-  odeiv1(@h, a, ya, b, yb, ae, term);
-  writeln(a: 5: 2, b: 5: 2, ' ', yb: numdig, ' ', 1e-3 * exp(15): numdig, ae: 9, term: 3);
-  a  := 0;
-  ya := 1e-3;
-  b  := a;
-  ae := 0;
-  odeiv1(@h, a, ya, b, yb, ae, term);
-  writeln(a: 5: 2, b: 5: 2, ' ', yb: numdig, ' ', 1e-3 * exp(15): numdig, ae: 9, term: 3);
-  Close(input);
-  Close(output);
-end.

packages/numlib/tests/odeiv2te.pas

@@ -74,79 +74,3 @@ begin
   Close(input);
   Close(output);
 end.
-program odeiv2te;
-
-uses
-  typ,
-  ode;
-
-const
-  n1 = 3;
-  n2 = 4;
-  n3 = 6;
-  n  = n2 - n1 + 1;
-  n4 = n3 + n - 1;
-var
-  ex, nv, i, j, k, h, term: ArbInt;
-  a, b, d, ae: ArbFloat;
-  ya: array[n1..n2] of ArbFloat;
-  yb: array[n3..n4] of ArbFloat;
-
-  procedure f(x: ArbFloat; var y, y1: ArbFloat);
-  var
-    yloc:  array[1..n] of ArbFloat absolute y;
-    y1loc: array[1..n] of ArbFloat absolute y1;
-  begin
-    y1loc[1] := 2 * x * yloc[1] + yloc[2];
-    y1loc[2] := -yloc[1] + 2 * x * yloc[2];
-  end; {f}
-
-  function phi1(x: ArbFloat): ArbFloat;
-  begin
-    phi1 := exp(x * x) * sin(x);
-  end; {phi1}
-
-  function phi2(x: ArbFloat): ArbFloat;
-  begin
-    phi2 := exp(x * x) * cos(x);
-  end; {phi2}
-
-begin
-  Write(' program results odeiv2te');
-  case sizeof(ArbFloat) of
-    4: writeln('(single)');
-    6: writeln('(real)');
-    8: writeln('(double)');
-  end;
-  Read(nv);
-  writeln;
-  writeln('   number of examples: ', nv: 2);
-  k := numdig;
-  h := k div 2;
-  for ex := 1 to nv do
-  begin
-    writeln;
-    writeln('  example number :', ex: 2);
-    Read(a, b);
-    for j := n1 to n2 do
-      Read(ya[j]);
-    Read(ae);
-    d := b - a;
-    writeln;
-    writeln(' ae =', ae: 10);
-    writeln;
-    writeln('b': 3, 'yb1': h + 4, 'yb2': k, 'phi1(x)': k + 3, 'phi2(x)': k - 2, 'term': h + 2);
-    for i := 1 to 5 do
-    begin
-      odeiv2(@f, a, ya[n1], b, yb[n3], n, ae, term);
-      writeln(b: 5: 2, yb[n3]: k, yb[n3 + 1]: k, phi1(b): k, phi2(b): k, term: 3);
-      a := b;
-      for j := n1 to n2 do
-        ya[j] := yb[n3 - n1 + j];
-      b := b + d;
-    end; {i}
-    writeln(' -------------------------------------------------');
-  end; {ex}
-  Close(input);
-  Close(output);
-end.

packages/numlib/tests/roof1rte.pas

@@ -61,66 +61,3 @@ begin
   Close(input);
   Close(output);
 end.
-program roof1rte;
-
-uses
-  typ,
-  spe,
-  roo;
-
-const
-  num = 4;
-var
-  term, i, j, n, p: ArbInt;
-  a, b, ae, re, x:  ArbFloat;
-
-  function f(x: ArbFloat): ArbFloat;
-  begin
-    case i of
-      1: f := spepow(x - 1, 3);
-      2: f := cos(x);
-      3: f := sin(x) - x / 2;
-      4: f := exp(x) - sqr(sqr(x))
-    end;
-  end;
-
-begin
-  Write(' program results roof1rte');
-  case sizeof(ArbFloat) of
-    4: writeln('(single)');
-    6: writeln('(real)');
-    8: writeln('(double)');
-  end;
-  writeln;
-  writeln(' number of examples:', num: 3);
-  writeln;
-  if sizeof(ArbFloat) = 6 then
-    p := 8
-  else
-    p := 10;
-  writeln(' ': 2, 'a', ' ': 5, 'b', ' ': 5, 'ae', ' ': p, 're',
-    ' ': p - 2, 'term', ' ': 2, 'root', ' ': numdig - 2, 'f(root)');
-  for i := 1 to num do
-  begin
-    Write('Locating the root of the equation ');
-    case i of
-      1: writeln('(x-1)**3 = 0');
-      2: writeln('cos(x) = 0');
-      3: writeln('sin(x) = x/2');
-      4: writeln('exp(x)=x**4');
-    end;
-    Read(n);
-    for j := 1 to n do
-    begin
-      Read(a, b, ae, re);
-      roof1r(@f, a, b, ae, re, x, term);
-      Write(a: 4: 1, ' ': 2, b: 4: 1, ' ': 2, ae: p, ' ': 2, re: p, ' ': 2, term: 1);
-      if term < 3 then
-        writeln(' ': 2, x: numdig, ' ': 2, f(x): numdig)
-      else
-        writeln;
-    end;
-  end;
-  Close(input);
-  Close(output);
-end.

packages/numlib/tests/roofnrt1.pas

@@ -228,233 +228,3 @@ begin
   Writeln('   ', t: 20);
 
 end.
-program Roofnrte;
-
-uses
-  typ,
-  roo;
-
-type
-  maxarray = array[1..128] of ArbFloat;
-var
-  n: ArbInt;
-  a: ArbFloat;
-  ah2: ArbFloat;
-
-  procedure PraktikumEx(var x, fx: ArbFloat; var deff: boolean);
-  var
-    xloc: maxarray absolute x;
-    floc: maxarray absolute fx;
-    i:    ArbInt;
-  begin
-    floc[1] := 2 * (xloc[1] - xloc[2]) - ah2 * exp(xloc[1]);
-    for i := 2 to n - 1 do
-      floc[i] := -xloc[i - 1] + 2 * xloc[i] - xloc[i + 1] - ah2 * exp(xloc[i]);
-    floc[n] := -xloc[n - 1] + 2 * xloc[n] - ah2 * exp(xloc[n]);
-  end;
-
-const
-  m = 9;
-
-  procedure NagExample(var x, fx: ArbFloat; var deff: boolean);
-  var
-    xloc: array[1..m] of ArbFloat absolute x;
-    floc: array[1..m] of ArbFloat absolute fx;
-    k:    ArbInt;
-  begin
-    floc[1] := 1 + (3 - 2 * xloc[1]) * xloc[1] - 2 * xloc[2];
-    for k := 2 to m - 1 do
-      floc[k] := 1 + (3 - 2 * xloc[k]) * xloc[k] - xloc[k - 1] - 2 * xloc[k + 1];
-    floc[m] := 1 + (3 - 2 * xloc[m]) * xloc[m] - xloc[m - 1];
-  end;
-
-  procedure MatlabEx(var x, fx: ArbFloat; var deff: boolean);
-  var
-    xloc: array[1..3] of ArbFloat absolute x;
-    floc: array[1..3] of ArbFloat absolute fx;
-  begin
-    floc[1] := sin(xloc[1]) + sqr(xloc[2]) + ln(xloc[3]) - 7;
-    floc[2] := 3 * xloc[1] + exp(xloc[2] * ln(2)) - xloc[3] * sqr(xloc[3]) + 1;
-    floc[3] := xloc[1] + xloc[2] + xloc[3] - 5;
-  end;
-
-  procedure TPNumlibEx(var x, fx: ArbFloat; var deff: boolean);
-  begin
-    fx := cos(x);
-  end;
-
-  procedure JdeJongEx(var x, fx: ArbFloat; var deff: boolean);
-  begin
-    if (x >= 0) and (x <= 1) then
-      fx   := x - 2
-    else
-      deff := False;
-  end;
-
-  procedure Uitvoer(var x1: ArbFloat; n, step: ArbInt);
-  var
-    i:    ArbInt;
-    xloc: maxarray absolute x1;
-  begin
-    i := 1;
-    while (i <= n) do
-    begin
-      writeln(i: 5, ' ', xloc[i]: 20);
-      Inc(i, step);
-    end;
-    writeln;
-  end;
-
-var
-  x: ^maxarray;
-  t, residu: ArbFloat;
-  i, term: ArbInt;
-begin
-
-  { praktikum sommetje }
-
-  n := 8;
-  a := 0.50;
-  repeat
-    ah2 := a / sqr(n);
-    GetMem(x, n * SizeOf(ArbFloat));
-
-    for i := 1 to n do
-      x^[i] := 0;
-
-    writeln('Voorbeeld programma ''praktikum'',  resultaten voor n= ', n: 2);
-    writeln;
-
-    roofnr(@PraktikumEx, n, x^[1], residu, 1e-4, term);
-    if term = 1 then
-      writeln('    Norm van de residuen', residu: 20, #13#10,
-        '    Berekende oplossing')
-    else
-      writeln('  Proces afgebroken term = ', term, #13#10,
-        '  Laatst berekende waarden');
-    writeln;
-    Uitvoer(x^[1], n, n div 8);
-    FreeMem(x, n * SizeOf(ArbFloat));
-    n := n * 2
-  until n = 128;
-
-  { Nag procedure bibliotheek voorbeeld }
-
-  GetMem(x, m * SizeOf(ArbFloat));
-
-  for i := 1 to m do
-    x^[i] := -1;
-
-  writeln('Voorbeeld programma ''NAG-bibliotheek'' met m= ', m: 2);
-  writeln;
-
-  roofnr(@NagExample, m, x^[1], residu, 1e-6, term);
-  if term = 1 then
-    writeln('    Norm van de residuen', residu: 20, #13#10,
-      '    Berekende oplossing')
-  else
-    writeln('  Proces afgebroken term = ', term, #13#10,
-      '  Laatst berekende waarden');
-  writeln;
-  Uitvoer(x^[1], m, 1);
-  FreeMem(x, m * SizeOf(ArbFloat));
-
-  { Matlab voorbeeld uit handleiding }
-
-  n := 3;
-
-  GetMem(x, n * SizeOf(ArbFloat));
-
-  for i := 1 to n do
-    x^[i] := 1;
-
-  writeln('Voorbeeld programma ''MATLAB handleiding'',  resultaten voor n= ', n: 2);
-  writeln;
-
-  roofnr(@MatlabEx, n, x^[1], residu, 1e-6, term);
-  if term = 1 then
-    writeln('    Norm van de residuen', residu: 20, #13#10,
-      '    Berekende oplossing')
-  else
-    writeln('  Proces afgebroken term = ', term, #13#10,
-      '  Laatst berekende waarden');
-  writeln;
-  Uitvoer(x^[1], n, 1);
-  FreeMem(x, n * SizeOf(ArbFloat));
-
-  { 1-dimensionaal voorbeeld uit TPNumlib }
-
-  writeln('Voorbeeld programma ''TPNumlib'' voor ‚‚n dimensie');
-  writeln;
-
-  t := 1;
-  roofnr(@TPNumlibEx, 1, t, residu, 1e-6, term);
-  if term = 1 then
-    writeln('    Norm van de residuen', residu: 20, #13#10,
-      '    Berekende oplossing')
-  else
-    writeln('  Proces afgebroken term = ', term, #13#10,
-      '  Laatst berekende waarden');
-  writeln;
-  Writeln('   ', t: 20);
-
-  { Matlab voorbeeld uit handleiding }
-  { dit moet fout gaan               }
-
-  n := 3;
-
-  GetMem(x, n * SizeOf(ArbFloat));
-
-  for i := 1 to n do
-    x^[i] := 1;
-
-  writeln;
-  writeln('Voorbeeld programma ''MATLAB handleiding'',  resultaten voor n= ', n: 2);
-  writeln('Gaat niet goed want de relatieve fout is gelijk aan 0 gekozen');
-  writeln;
-
-  roofnr(@MatlabEx, n, x^[1], residu, 0, term);
-  if term = 1 then
-    writeln('    Norm van de residuen', residu: 20, #13#10,
-      '    Berekende oplossing')
-  else
-    writeln('  Proces afgebroken term = ', term, #13#10,
-      '  Laatst berekende waarden');
-  writeln;
-  Uitvoer(x^[1], n, 1);
-
-  writeln;
-  writeln('Voorbeeld programma ''MATLAB handleiding'',  resultaten voor n= ', n: 2);
-  writeln;
-
-  for i := 1 to n do
-    x^[i] := 1;
-
-  roofnr(@MatlabEx, n, x^[1], residu, 1e-8, term);
-  if term = 1 then
-    writeln('    Norm van de residuen', residu: 20, #13#10,
-      '    Berekende oplossing')
-  else
-    writeln('  Proces afgebroken term = ', term, #13#10,
-      '  Laatst berekende waarden');
-  writeln;
-  Uitvoer(x^[1], n, 1);
-  FreeMem(x, n * SizeOf(ArbFloat));
-
-  { 1-dimensionaal voorbeeld voor deff }
-
-  writeln('Voorbeeld programma in ‚‚n dimensie, voor domein [0..1]');
-  writeln;
-
-  t := 0.5;
-  roofnr(@JdeJongEx, 1, t, residu, 1e-6, term);
-  if term = 1 then
-    writeln('    Norm van de residuen', residu: 20, #13#10,
-      '    Berekende oplossing')
-  else
-    writeln('  Proces afgebroken term = ', term, #13#10,
-      '  Laatst berekende waarden');
-  writeln;
-  Writeln('   ', t: 20);
-
-end.

packages/numlib/tests/roofnrte.pas

@@ -111,116 +111,3 @@ begin
   Close(input);
   Close(output);
 end.
-program roofnrte;
-
-uses
-  typ,
-  spe,
-  roo;
-
-const
-  num  = 3;
-  nmax = 3;
-var
-  term, i, j, k, l, n: ArbInt;
-  re, residu: ArbFloat;
-  x: array[1..nmax] of ArbFloat;
-
-  procedure f(var x0, fx: ArbFloat; var deff: boolean);
-  var
-    xloc: array[1..nmax] of ArbFloat absolute x0;
-    f:    array[1..nmax] of ArbFloat absolute fx;
-    x, y, z: ArbFloat;
-  begin
-    x := xloc[1];
-    y := xloc[2];
-    if n = 3 then
-      z := xloc[3];
-    case i of
-      1:
-      begin
-        if j * 2 <= k then
-          deff := x >= 0
-        else
-          deff := y >= 0;
-        f[1] := x * x - y * y - 2;
-        f[2] := x + y - 1;
-      end;
-      2:
-      begin
-        f[1] := exp(x) + exp(y) - exp(z);
-        f[2] := sin(x) + cos(y) - z;
-        f[3] := x * y - sqr(z);
-      end;
-      3: if (x > 0) and (y > 0) then
-        begin
-          f[1] := spepow(x, y) - spepow(y, x);
-          f[2] := sin(x) - cos(y);
-        end
-        else
-          deff := False
-    end;
-  end;
-
-begin
-  Write(' program results roofnrte');
-  case sizeof(ArbFloat) of
-    4: writeln('(single)');
-    6: writeln('(real)');
-    8: writeln('(double)');
-  end;
-  writeln;
-  writeln(' number of examples:', num: 3);
-  for i := 1 to num do
-  begin
-    writeln;
-    writeln('Locating the root of the equations ');
-    case i of
-      1:
-      begin
-        n := 2;
-        writeln('x + y = 1');
-        writeln('xý + yý = 2');
-      end;
-      2:
-      begin
-        n := 3;
-        writeln('exp(x) + exp(y) = exp(z)');
-        writeln('sin(x) + cos(y) = z');
-        writeln('xy = zý');
-      end;
-      3:
-      begin
-        n := 2;
-        writeln('xy = yx');
-        writeln('sin(x) = cos(y)');
-      end
-    end;
-    Read(k);
-    for j := 1 to k do
-    begin
-      for l := 1 to n do
-        Read(x[l]);
-      Read(re);
-      writeln(' starting values: (n=', n: 1, ')');
-      for l := 1 to n do
-        Write(x[l]: numdig, ' ');
-      writeln(' re =', re: 8);
-      roofnr(@f, n, x[1], residu, re, term);
-      writeln;
-      writeln(' term =', term: 2);
-      if term < 3 then
-      begin
-        writeln(' solution vector');
-        for l := 1 to n do
-          Write(x[l]: numdig, ' ');
-        writeln;
-        writeln(' residu = ', residu: 8);
-      end;
-      writeln('-------------------------------------------------');
-    end;
-    writeln('======================================================');
-  end;
-  Close(input);
-  Close(output);
-end.

packages/numlib/tests/roopolte.pas

@@ -49,54 +49,3 @@ begin
   Close(input);
   Close(output);
 end.
-program roopolte;
-
-uses
-  typ,
-  roo;
-
-const
-  nn = 30;
-var
-  i, j, num, n, k, term: ArbInt;
-  a: array[1..nn] of ArbFloat;
-  z: array[1..nn] of complex;
-begin
-  Write(' program results roopolte');
-  case sizeof(ArbFloat) of
-    4: writeln('(single)');
-    6: writeln('(real)');
-    8: writeln('(double)');
-  end;
-  Read(num);
-  writeln;
-  writeln(' number of examples:', num: 3);
-  for i := 1 to num do
-  begin
-    Read(n);
-    writeln;
-    writeln('n =', n: 2);
-    writeln;
-    writeln(' j    a[j]');
-    writeln;
-    for j := 1 to n do
-    begin
-      Read(a[j]);
-      writeln(j: 2, ' ': 2, a[j]: numdig);
-    end; {j}
-    roopol(a[1], n, z[1], k, term);
-    writeln;
-    Write('term =', term: 2);
-    if term = 1 then
-    begin
-      writeln('  k =', k: 2);
-      writeln;
-      writeln(' j', ' ': 4, 'Re(z[j])', ' ': 11, 'Im(z[j])');
-      writeln;
-      for j := 1 to k do
-        writeln(j: 2, ' ': 2, z[j].Re: numdig, ' ': 2, z[j].imag: numdig);
-    end; {term=1}
-  end; {i}
-  Close(input);
-  Close(output);
-end.

packages/numlib/tests/sledtrte.pas

@@ -67,72 +67,3 @@ begin
   Close(input);
   Close(output);
 end.
-program sledtrte;
-
-uses
-  typ,
-  iom,
-  sle;
-
-const
-  m1 = -10;
-  m2 = 10;
-
-type
-  array1dr = array[m1..m2] of ArbFloat;
-
-var
-  k, nex, ex, i, n, term: ArbInt;
-  l, d, u, b, x: array1dr;
-
-begin
-  Write('program results sledtrte ');
-  case SizeOf(ArbFloat) of
-    4: writeln('(single)');
-    8: writeln('(double)');
-    6: writeln('(real)');
-  end;
-  Read(nex);
-  writeln;
-  writeln('  number of examples : ', nex: 2);
-  for ex := 1 to nex do
-  begin
-    writeln;
-    writeln(' example number :', ex: 2);
-    writeln;
-    Read(n, k);
-    iomrev(input, l[k + 1], n - 1);
-    iomrev(input, d[k], n);
-    iomrev(input, u[k], n - 1);
-    iomrev(input, b[k], n);
-    sledtr(n, l[k + 1], d[k], u[k], b[k], x[k], term);
-    writeln;
-    writeln(' A =');
-    for i := 1 to n do
-    begin
-      if i > 1 then
-        Write('': (i - 2) * (numdig + 2), l[k + i - 1]: numdig, '': 2);
-      Write(d[k + i - 1]: numdig, '': 2);
-      if i < n then
-        Write(u[k + i - 1]: numdig);
-      writeln;
-    end;
-    writeln;
-    writeln(' b =');
-    iomwrv(output, b[k], n, numdig);
-    writeln;
-    writeln('term=', term: 2);
-    case term of
-      1:
-      begin
-        writeln('x=');
-        iomwrv(output, x[k], n, numdig);
-      end;
-      2: writeln('solution not possible');
-      3: writeln(' wrong value of n');
-    end;
-    writeln('-----------------------------------------------');
-  end; {example}
-  Close(input);
-  Close(output);
-end.

packages/numlib/tests/slegbalt.pas

@@ -93,98 +93,3 @@ begin
     writeln('---------------------------------------------');
   end; {vb}
 end.
-program slegbalt;
-
-uses
-  typ,
-  iom,
-  sle;
-
-const
-  c = 0;
-  d = 10;
-
-var
-  l, r, i, p, q, n, term, rw, vb, nvb: ArbInt;
-  ca:   ArbFloat;
-  a:    array[c..d] of ^ArbFloat;
-  b, x: array[c..d] of ArbFloat;
-begin
-  Write(' program results slegbalt');
-  case sizeof(ArbFloat) of
-    4: writeln('(single)');
-    6: writeln('(real)');
-    8: writeln('(double)');
-  end;
-  Read(randseed);
-  writeln;
-  writeln('   randseed =', randseed: 6);
-  writeln;
-  Read(nvb);
-  writeln(' number of examples:', nvb: 3);
-  writeln;
-  for vb := 1 to nvb do
-  begin
-    writeln('example', vb: 2);
-    Read(p, q, n, l, r);
-    writeln;
-    writeln('   n=', n: 1, '   l=', l: 1, '   r=', r: 1);
-    for i := 1 to n do
-    begin
-      if i <= l + 1 then
-        if i <= n - r then
-          rw := r + i
-        else
-          rw := n
-      else
-      if i <= n - r then
-        rw := r + l + 1
-      else
-        rw := n - i + l + 1;
-      GetMem(a[i + p - 1], rw * sizeof(ArbFloat));
-      iomrev(input, a[i + p - 1]^, rw);
-    end;
-    iomrev(input, b[q], n);
-    slegbal(n, l, r, a[p], b[q], x[q], ca, term);
-    writeln;
-    writeln(' A =  ');
-    for i := 1 to n do
-    begin
-      if i <= l + 1 then
-      begin
-        if i <= n - r then
-          rw := r + i
-        else
-          rw := n;
-      end
-      else
-      begin
-        if i <= n - r then
-          rw := r + l + 1
-        else
-          rw := n - i + l + 1;
-        Write('': (i - l - 1) * (numdig + 2));
-      end;
-      iomwrv(output, a[i + p - 1]^, rw, numdig);
-      FreeMem(a[i + p - 1], rw * sizeof(ArbFloat));
-    end;
-    writeln;
-    writeln('b=');
-    iomwrv(output, b[q], n, numdig);
-    writeln;
-    writeln('term=', term: 2);
-    case term of
-      1:
-      begin
-        writeln;
-        writeln('x=');
-        iomwrv(output, x[q], n, numdig);
-        writeln;
-        writeln(' ca=', ca: 12);
-      end;
-      2: writeln('solution not possible');
-      3: writeln(' wrong input (l<0, r<0, l>n-1 or r>n-1)')
-    end;
-    writeln('---------------------------------------------');
-  end; {vb}
-end.

packages/numlib/tests/slegbate.pas

@@ -99,104 +99,3 @@ begin
     writeln('---------------------------------------------');
   end; {vb}
 end.
-program slegbate;
-
-uses
-  iom,
-  sle,
-  typ;
-
-const
-  c = 0;
-  d = 100;
-  e = 0;
-  f = 10;
-
-var
-  l, r, i, p, q, n, term, ind, rw, vb, nvb: ArbInt;
-  ca:   ArbFloat;
-  a:    array[c..d] of ArbFloat;
-  b, x: array[e..f] of ArbFloat;
-begin
-  Write(' program results slegbate');
-  case sizeof(ArbFloat) of
-    4: writeln('(single)');
-    6: writeln('(real)');
-    8: writeln('(double)');
-  end;
-  Read(randseed);
-  writeln;
-  writeln('   randseed =', randseed: 6);
-  writeln;
-  Read(nvb);
-  writeln(' number of examples:', nvb: 3);
-  writeln;
-  for vb := 1 to nvb do
-  begin
-    writeln('example', vb: 2);
-    Read(p, q, n, l, r);
-    ind := p;
-    writeln;
-    writeln('   n=', n: 1, '   l=', l: 1, '   r=', r: 1);
-    for i := 1 to n do
-    begin
-      if i <= l + 1 then
-      begin
-        if i <= n - r then
-          rw := r + i
-        else
-          rw := n;
-      end
-      else
-      if i <= n - r then
-        rw := r + l + 1
-      else
-        rw := n - i + l + 1;
-      iomrev(input, a[ind], rw);
-      ind := ind + rw;
-    end;
-    iomrev(input, b[q], n);
-    slegba(n, l, r, a[p], b[q], x[q], ca, term);
-    ind := p;
-    writeln;
-    writeln(' A =  ');
-    for i := 1 to n do
-    begin
-      if i <= l + 1 then
-      begin
-        if i <= n - r then
-          rw := r + i
-        else
-          rw := n;
-      end
-      else
-      begin
-        if i <= n - r then
-          rw := r + l + 1
-        else
-          rw := n - i + l + 1;
-        Write('': (i - l - 1) * (numdig + 2));
-      end;
-      iomwrv(output, a[ind], rw, numdig);
-      ind := ind + rw;
-    end;
-    writeln;
-    writeln('b=');
-    iomwrv(output, b[q], n, numdig);
-    writeln;
-    writeln('term=', term: 2);
-    case term of
-      1:
-      begin
-        writeln;
-        writeln('x=');
-        iomwrv(output, x[q], n, numdig);
-        writeln;
-        writeln(' ca=', ca: 12);
-      end;
-      2: writeln('solution not possible');
-      3: writeln(' wrong input (l<0, r<0, l>n-1 or r>n-1)')
-    end;
-    writeln('---------------------------------------------');
-  end; {vb}
-end.

packages/numlib/tests/slegenlt.pas

@@ -62,67 +62,3 @@ begin
     writeln('-----------------------------------------------');
   end; {example}
 end.
-program slegenlt;
-
-uses
-  typ,
-  iom,
-  sle;
-
-const
-  n1 = -10;
-  n2 = 10;
-
-var
-  i, n, k, v, nv, term: ArbInt;
-  ca:   ArbFloat;
-  b, x: array[n1..n2] of ArbFloat;
-  p:    array[n1..n2] of ^ArbFloat;
-begin
-  Write('program results slegenlt ');
-  case SizeOf(ArbFloat) of
-    4: writeln('(single)');
-    8: writeln('(double)');
-    6: writeln('(real)');
-  end;
-  Read(nv);
-  writeln;
-  writeln('   number of examples: ', nv: 2);
-  for v := 1 to nv do
-  begin
-    writeln;
-    writeln('  example number :', v: 2);
-    Read(k, n);
-    for i := k to n + k - 1 do
-    begin
-      Getmem(p[i], n * sizeOf(ArbFloat));
-      iomrev(input, p[i]^, n);
-    end;
-    iomrev(input, b[k], n);
-    slegenl(n, p[k], b[k], x[k], ca, term);
-    writeln;
-    writeln(' A =');
-    for i := k to n + k - 1 do
-      iomwrv(output, p[i]^, n, numdig);
-    for i := n + k - 1 downto k do
-      Freemem(p[i], n * sizeOf(ArbFloat));
-    writeln;
-    writeln('b=');
-    iomwrv(output, b[k], n, numdig);
-    writeln;
-    writeln('term=', term: 2);
-    writeln;
-    case term of
-      1:
-      begin
-        writeln('x=');
-        iomwrv(output, x[k], n, numdig);
-        writeln;
-        writeln(' ca = ', ca: 12);
-      end;
-      2: writeln('solution not possible');
-      3: writeln(' wrong value of n');
-    end;
-    writeln('-----------------------------------------------');
-  end; {example}
-end.

packages/numlib/tests/slegente.pas

@@ -61,66 +61,3 @@ begin
     writeln('-----------------------------------------------');
   end; {example}
 end.
-program slegente;
-
-uses
-  typ,
-  iom,
-  sle;
-
-const
-  m1 = -10;
-  m2 = 10;
-  n1 = -10;
-  n2 = 10;
-
-type
-  array1dr = array[m1..m2] of ArbFloat;
-  array2dr = array[m1..m2, n1..n2] of ArbFloat;
-
-var
-  v, nv, k, j, n, term: ArbInt;
-  ca:   ArbFloat;
-  a:    array2dr;
-  b, x: array1dr;
-begin
-  Write('program results slegente ');
-  case SizeOf(ArbFloat) of
-    4: writeln('(single)');
-    8: writeln('(double)');
-    6: writeln('(real)');
-  end;
-  Read(nv);
-  writeln;
-  writeln('   number of examples: ', nv: 2);
-  for v := 1 to nv do
-  begin
-    writeln;
-    writeln('  example number :', v: 2);
-    Read(k, j, n);
-    iomrem(input, a[k, j], n, n, n2 - n1 + 1);
-    iomrev(input, b[k], n);
-    slegen(n, n2 - n1 + 1, a[k, j], b[k], x[k], ca, term);
-    writeln;
-    writeln(' A =');
-    iomwrm(output, a[k, j], n, n, n2 - n1 + 1, numdig);
-    writeln;
-    writeln('b=');
-    iomwrv(output, b[k], n, numdig);
-    writeln;
-    writeln('term=', term: 2);
-    writeln;
-    case term of
-      1:
-      begin
-        writeln('x=');
-        iomwrv(output, x[k], n, numdig);
-        writeln;
-        writeln(' ca = ', ca: 12);
-      end;
-      2: writeln('solution not possible');
-      3: writeln(' wrong value of n');
-    end;
-    writeln('-----------------------------------------------');
-  end; {example}
-end.

packages/numlib/tests/sleglslt.pas

@@ -72,77 +72,3 @@ begin
     writeln(' --------------------------------------------------');
   end;
 end.
-program sleglslt;
-
-uses
-  typ,
-  iom,
-  sle;
-
-const
-  mbov = 10;
-  nbov = 8;
-
-type
-  ar1n = array[1..nbov] of ArbFloat;
-
-var
-  i, j, ii, m, n, k, nex, term: ArbInt;
-  s:    ArbFloat;
-  p:    array[1..mbov] of ^ar1n;
-  b, e: array[1..mbov] of ArbFloat;
-  x:    array[1..nbov] of ArbFloat;
-begin
-  Write(' program results sleglslt ');
-  case sizeof(ArbFloat) of
-    4: writeln('(single)');
-    6: writeln('(real)');
-    8: writeln('(double)');
-  end;
-  Read(nex);
-  writeln;
-  writeln(' number of examples:', nex: 2);
-  for ii := 1 to nex do
-  begin
-    Read(k, m, n);
-    for i := k to m + k - 1 do
-    begin
-      getmem(p[i], n * sizeof(ArbFloat));
-      iomrev(input, p[i]^[1], n);
-    end;
-    iomrev(input, b[k], m);
-    sleglsl(p[k], m, n, b[k], x[k], term);
-    writeln;
-    writeln(' A =');
-    for i := k to m + k - 1 do
-      iomwrv(output, p[i]^[1], n, numdig);
-    writeln;
-    writeln(' b =');
-    iomwrv(output, b[k], m, numdig);
-    writeln;
-    writeln('term=', term: 2);
-    case term of
-      1:
-      begin
-        writeln;
-        writeln(' x =');
-        iomwrv(output, x[k], n, numdig);
-        writeln;
-        writeln('Ax - b =');
-        for i := k to m + k - 1 do
-        begin
-          s := 0;
-          for j := 1 to n do
-            s := s + p[i]^[j] * x[j + k - 1];
-          e[i] := s - b[i];
-        end;
-        iomwrv(output, e[k], m, numdig);
-      end;
-      2: writeln(' A is (nearly) singular');
-      3: writeln('wrong input (m<n or n<1)');
-    end;
-    for i := m + k - 1 downto k do
-      freemem(p[i], n * sizeof(ArbFloat));
-    writeln(' --------------------------------------------------');
-  end;
-end.

packages/numlib/tests/sleglste.pas

@@ -66,71 +66,3 @@ begin
     writeln(' -------------------------------------------');
   end;
 end.
-program sleglste;
-
-uses
-  typ,
-  iom,
-  omv,
-  sle;
-
-const
-  k1  = -20;
-  k2  = 20;
-  l1  = -10;
-  l2  = 10;
-  r1  = -10;
-  r2  = 18;
-  v1  = -8;
-  v2  = 18;
-  rwa = l2 - l1 + 1;
-var
-  ex, nv, i, m, n, term, k, l, r, v: ArbInt;
-  a:    array[k1..k2, l1..l2] of ArbFloat;
-  b, e: array[r1..r2] of ArbFloat;
-  x:    array[v1..v2] of ArbFloat;
-begin
-  Write('program results sleglste ');
-  case SizeOf(ArbFloat) of
-    4: writeln('(single)');
-    8: writeln('(double)');
-    6: writeln('(real)');
-  end;
-  Read(nv);
-  writeln;
-  writeln(' number of examples: ', nv: 2);
-  for ex := 1 to nv do
-  begin
-    writeln;
-    writeln('  example number :', ex: 2);
-    Read(k, l, r, v, m, n);
-    iomrem(input, a[k, l], m, n, rwa);
-    iomrev(input, b[r], m);
-    slegls(a[k, l], m, n, rwa, b[r], x[v], term);
-    writeln;
-    writeln(' A =');
-    iomwrm(output, a[k, l], m, n, rwa, numdig);
-    writeln;
-    writeln(' b =');
-    iomwrv(output, b[r], m, numdig);
-    writeln;
-    writeln(' term=', term: 2);
-    case term of
-      1:
-      begin
-        writeln;
-        writeln(' x =');
-        iomwrv(output, x[v], n, numdig);
-        writeln;
-        writeln(' Ax - b =');
-        omvmmv(a[k, l], m, n, rwa, x[v], e[r]);
-        for i := 1 to m do
-          e[r - 1 + i] := e[r - 1 + i] - b[r - 1 + i];
-        iomwrv(output, e[r], m, numdig);
-      end;
-      2: writeln(' A is (nearly) singular');
-      3: writeln('wrong input (n<1 or m<n)')
-    end;
-    writeln(' -------------------------------------------');
-  end;
-end.

packages/numlib/tests/slegpblt.pas

@@ -84,89 +84,3 @@ begin
     writeln('---------------------------------------------');
   end; {vb}
 end.
-program slegpblt;
-
-uses
-  typ,
-  iom,
-  sle;
-
-const
-  c = 0;
-  d = 10;
-
-var
-  l, i, p, q, n, term, rw, vb, nvb: ArbInt;
-  ca:   ArbFloat;
-  a:    array[c..d] of ^ArbFloat;
-  b, x: array[c..d] of ArbFloat;
-begin
-  Assign(input, ParamStr(1));
-  Reset(input);
-  Assign(output, ParamStr(2));
-  Rewrite(output);
-
-  Write(' program results slegpblt');
-  case sizeof(ArbFloat) of
-    4: writeln('(single)');
-    6: writeln('(real)');
-    8: writeln('(double)');
-  end;
-  Read(randseed);
-  writeln;
-  writeln('   randseed =', randseed: 6);
-  writeln;
-  Read(nvb);
-  writeln(' number of examples:', nvb: 3);
-  writeln;
-  for vb := 1 to nvb do
-  begin
-    writeln('example', vb: 2);
-    Read(p, q, n, l);
-    writeln;
-    writeln('   n=', n: 1, '   l=', l: 1);
-    for i := 1 to n do
-    begin
-      if i <= l + 1 then
-        rw := i
-      else
-        rw := l + 1;
-      GetMem(a[i + p - 1], rw * sizeof(ArbFloat));
-      iomrev(input, a[i + p - 1]^, rw);
-    end;
-    iomrev(input, b[q], n);
-    slegpbl(n, l, a[p], b[q], x[q], ca, term);
-    writeln;
-    writeln(' A (left-under part) =  ');
-    for i := 1 to n do
-    begin
-      if i <= l + 1 then
-        rw := i
-      else
-      begin
-        rw := l + 1;
-        Write('': (i - l - 1) * (numdig + 2));
-      end;
-      iomwrv(output, a[i + p - 1]^, rw, numdig);
-      FreeMem(a[i + p - 1], rw * sizeof(ArbFloat));
-    end;
-    writeln;
-    writeln('b=');
-    iomwrv(output, b[q], n, numdig);
-    writeln;
-    writeln('term=', term: 2);
-    case term of
-      1:
-      begin
-        writeln;
-        writeln('x=');
-        iomwrv(output, x[q], n, numdig);
-        writeln;
-        writeln(' ca=', ca: 12);
-      end;
-      2: writeln('solution not possible');
-      3: writeln(' wrong input (l<0, r<0, l>n-1 or r>n-1)')
-    end;
-    writeln('---------------------------------------------');
-  end; {vb}
-end.

packages/numlib/tests/slegpbte.pas

@@ -84,89 +84,3 @@ begin
     writeln('---------------------------------------------');
   end; {vb}
 end.
-program slegpbte;
-
-uses
-  iom,
-  sle,
-  typ;
-
-const
-  c = 0;
-  d = 100;
-  e = 0;
-  f = 10;
-
-var
-  l, i, p, q, n, term, ind, rw, vb, nvb: ArbInt;
-  ca:   ArbFloat;
-  a:    array[c..d] of ArbFloat;
-  b, x: array[e..f] of ArbFloat;
-begin
-  Write(' program results slegpbte');
-  case sizeof(ArbFloat) of
-    4: writeln('(single)');
-    6: writeln('(real)');
-    8: writeln('(double)');
-  end;
-  Read(randseed);
-  writeln;
-  writeln('   randseed =', randseed: 6);
-  writeln;
-  Read(nvb);
-  writeln(' number of examples:', nvb: 3);
-  writeln;
-  for vb := 1 to nvb do
-  begin
-    writeln('example', vb: 2);
-    Read(p, q, n, l);
-    ind := p;
-    writeln;
-    writeln('   n=', n: 1, '   l=', l: 1);
-    for i := 1 to n do
-    begin
-      if i <= l + 1 then
-        rw := i
-      else
-        rw := l + 1;
-      iomrev(input, a[ind], rw);
-      ind := ind + rw;
-    end;
-    iomrev(input, b[q], n);
-    slegpb(n, l, a[p], b[q], x[q], ca, term);
-    ind := p;
-    writeln;
-    writeln(' left-under part of A =  ');
-    writeln;
-    for i := 1 to n do
-    begin
-      if i <= l + 1 then
-        rw := i
-      else
-      begin
-        rw := l + 1;
-        Write('': (i - l - 1) * (numdig + 2));
-      end;
-      iomwrv(output, a[ind], rw, numdig);
-      ind := ind + rw;
-    end;
-    writeln;
-    writeln('b=');
-    iomwrv(output, b[q], n, numdig);
-    writeln;
-    writeln('term=', term: 2);
-    case term of
-      1:
-      begin
-        writeln;
-        writeln('x=');
-        iomwrv(output, x[q], n, numdig);
-        writeln;
-        writeln(' ca=', ca: 12);
-      end;
-      2: writeln('solution not possible');
-      3: writeln(' wrong input (l<0 or l>n-1)')
-    end;
-    writeln('---------------------------------------------');
-  end; {vb}
-end.

packages/numlib/tests/slegpdlt.pas

@@ -77,82 +77,3 @@ begin
     writeln('-----------------------------------------------');
   end; {example}
 end.
-program slegpdlt;
-
-uses
-  typ,
-  iom,
-  sle;
-
-const
-  m1   = -8;
-  m2   = 12;
-  nmax = 10;
-
-type
-  row = array[1..nmax] of ArbFloat;
-
-var
-  i, j, n, k, l, v, nv, term: ArbInt;
-  ca:   ArbFloat;
-  b, x: array[m1..m2] of ArbFloat;
-  a:    array[m1..m2] of ^row;
-begin
-  Assign(input, ParamStr(1));
-  Reset(input);
-  Assign(output, ParamStr(2));
-  Rewrite(output);
-
-  Write('program results slegpdlt ');
-  case SizeOf(ArbFloat) of
-    4: writeln('(single)');
-    8: writeln('(double)');
-    6: writeln('(real)');
-  end;
-  writeln;
-  Read(randseed);
-  writeln('  randseed = ', randseed: 15);
-  Read(nv);
-  writeln;
-  writeln('   number of examples: ', nv: 2);
-  for v := 1 to nv do
-  begin
-    writeln;
-    writeln('  example number :', v: 2);
-    Read(k, l, n);
-    for i := 1 to n do
-    begin
-      Getmem(a[i + k - 1], n * sizeOf(ArbFloat));
-      iomrev(input, a[i + k - 1]^[1], i);
-    end;
-    iomrev(input, b[l], n);
-    slegpdl(n, a[k], b[l], x[l], ca, term);
-    writeln;
-    writeln(' A =');
-    for i := 1 to n do
-      for j := i + 1 to n do
-        a[i + k - 1]^[j] := a[j + k - 1]^[i];
-    for i := 1 to n do
-      iomwrv(output, a[i + k - 1]^[1], n, numdig);
-    for i := n downto 1 do
-      Freemem(a[i + k - 1], n * sizeOf(ArbFloat));
-    writeln;
-    writeln('b=');
-    iomwrv(output, b[l], n, numdig);
-    writeln;
-    writeln('term=', term: 2);
-    writeln;
-    case term of
-      1:
-      begin
-        writeln('x=');
-        iomwrv(output, x[l], n, numdig);
-        writeln;
-        writeln(' ca = ', ca: 12);
-      end;
-      2: writeln('solution not possible');
-      3: writeln(' wrong value of n');
-    end;
-    writeln('-----------------------------------------------');
-  end; {example}
-end.

packages/numlib/tests/slegpdte.pas

@@ -70,75 +70,3 @@ begin
   Close(input);
   Close(output);
 end.
-program slegpdte;
-
-uses
-  typ,
-  iom,
-  sle;
-
-const
-  m1 = -10;
-  m2 = 10;
-  n1 = -5;
-  n2 = 10;
-
-type
-  array1dr = array[m1..m2] of ArbFloat;
-  array2dr = array[m1..m2, n1..n2] of ArbFloat;
-
-var
-  t, nex, i, j, k, l, n, term: ArbInt;
-  ca:   ArbFloat;
-  a:    array2dr;
-  b, x: array1dr;
-
-begin
-  Write('program results slegpdte ');
-  case SizeOf(ArbFloat) of
-    4: writeln('(single)');
-    8: writeln('(double)');
-    6: writeln('(real)');
-  end;
-  writeln;
-  Read(randseed);
-  writeln('  randseed = ', randseed: 15);
-  Read(nex);
-  writeln;
-  writeln(' number of examples:', nex: 2);
-  for t := 1 to nex do
-  begin
-    writeln;
-    writeln(' example number : ', t: 1);
-    Read(k, l, n);
-    for i := 1 to n do
-      iomrev(input, a[i + k - 1, l], i);
-    iomrev(input, b[k], n);
-    slegpd(n, n2 - n1 + 1, a[k, l], b[k], x[k], ca, term);
-    writeln;
-    writeln('A=');
-    for i := 1 to n do
-      for j := i + 1 to n do
-        a[i + k - 1, j + l - 1] := a[j + k - 1, i + l - 1];
-    iomwrm(output, a[k, l], n, n, n2 - n1 + 1, numdig);
-    writeln;
-    writeln('b=');
-    iomwrv(output, b[k], n, numdig);
-    writeln;
-    writeln('term=', term: 2);
-    case term of
-      1:
-      begin
-        writeln('x=');
-        iomwrv(output, x[k], n, numdig);
-        writeln;
-        writeln(' ca = ', ca: 12);
-      end;
-      2: writeln('solution not possible');
-      3: writeln(' wrong value of n');
-    end;
-    writeln('-----------------------------------------------');
-  end; {example}
-  Close(input);
-  Close(output);
-end.

packages/numlib/tests/slegsylt.pas

@@ -77,82 +77,3 @@ begin
     writeln('-----------------------------------------------');
   end; {example}
 end.
-program slegsylt;
-
-uses
-  typ,
-  iom,
-  sle;
-
-const
-  m1   = -8;
-  m2   = 12;
-  nmax = 10;
-
-type
-  row = array[1..nmax] of ArbFloat;
-
-var
-  i, j, n, k, l, v, nv, term: ArbInt;
-  ca:   ArbFloat;
-  b, x: array[m1..m2] of ArbFloat;
-  a:    array[m1..m2] of ^row;
-begin
-  Assign(input, ParamStr(1));
-  Reset(input);
-  Assign(output, ParamStr(2));
-  Rewrite(output);
-
-  Write('program results slegsylt ');
-  case SizeOf(ArbFloat) of
-    4: writeln('(single)');
-    8: writeln('(double)');
-    6: writeln('(real)');
-  end;
-  writeln;
-  Read(randseed);
-  writeln('  randseed = ', randseed: 15);
-  Read(nv);
-  writeln;
-  writeln('   number of examples: ', nv: 2);
-  for v := 1 to nv do
-  begin
-    writeln;
-    writeln('  example number :', v: 2);
-    Read(k, l, n);
-    for i := 1 to n do
-    begin
-      Getmem(a[i + k - 1], n * sizeOf(ArbFloat));
-      iomrev(input, a[i + k - 1]^[1], i);
-    end;
-    iomrev(input, b[l], n);
-    slegsyl(n, a[k], b[l], x[l], ca, term);
-    writeln;
-    writeln(' A =');
-    for i := 1 to n do
-      for j := i + 1 to n do
-        a[i + k - 1]^[j] := a[j + k - 1]^[i];
-    for i := 1 to n do
-      iomwrv(output, a[i + k - 1]^[1], n, numdig);
-    for i := n downto 1 do
-      Freemem(a[i + k - 1], n * sizeOf(ArbFloat));
-    writeln;
-    writeln('b=');
-    iomwrv(output, b[l], n, numdig);
-    writeln;
-    writeln('term=', term: 2);
-    writeln;
-    case term of
-      1:
-      begin
-        writeln('x=');
-        iomwrv(output, x[l], n, numdig);
-        writeln;
-        writeln(' ca = ', ca: 12);
-      end;
-      2: writeln('solution not possible');
-      3: writeln(' wrong value of n');
-    end;
-    writeln('-----------------------------------------------');
-  end; {example}
-end.

packages/numlib/tests/slegsyte.pas

@@ -70,75 +70,3 @@ begin
   Close(input);
   Close(output);
 end.
-program slegsyte;
-
-uses
-  typ,
-  iom,
-  sle;
-
-const
-  m1 = -10;
-  m2 = 10;
-  n1 = -5;
-  n2 = 10;
-
-type
-  array1dr = array[m1..m2] of ArbFloat;
-  array2dr = array[m1..m2, n1..n2] of ArbFloat;
-
-var
-  t, nex, i, j, k, l, n, term: ArbInt;
-  ca:   ArbFloat;
-  a:    array2dr;
-  b, x: array1dr;
-
-begin
-  Write('program results slegsyte ');
-  case SizeOf(ArbFloat) of
-    4: writeln('(single)');
-    8: writeln('(double)');
-    6: writeln('(real)');
-  end;
-  writeln;
-  Read(randseed);
-  writeln('  randseed = ', randseed: 15);
-  Read(nex);
-  writeln;
-  writeln(' number of examples:', nex: 2);
-  for t := 1 to nex do
-  begin
-    writeln;
-    writeln(' example number : ', t: 1);
-    Read(k, l, n);
-    for i := 1 to n do
-      iomrev(input, a[i + k - 1, l], i);
-    iomrev(input, b[k], n);
-    slegsy(n, n2 - n1 + 1, a[k, l], b[k], x[k], ca, term);
-    writeln;
-    writeln('A=');
-    for i := 1 to n do
-      for j := i + 1 to n do
-        a[i + k - 1, j + l - 1] := a[j + k - 1, i + l - 1];
-    iomwrm(output, a[k, l], n, n, n2 - n1 + 1, numdig);
-    writeln;
-    writeln('b=');
-    iomwrv(output, b[k], n, numdig);
-    writeln;
-    writeln('term=', term: 2);
-    case term of
-      1:
-      begin
-        writeln('x=');
-        iomwrv(output, x[k], n, numdig);
-        writeln;
-        writeln(' ca = ', ca: 12);
-      end;
-      2: writeln('solution not possible');
-      3: writeln(' wrong value of n');
-    end;
-    writeln('-----------------------------------------------');
-  end; {example}
-  Close(input);
-  Close(output);
-end.

packages/numlib/tests/slegtrte.pas

@@ -79,84 +79,3 @@ begin
   Close(input);
   Close(output);
 end.
-program slegtrte;
-
-uses
-  typ,
-  iom,
-  sle;
-
-const
-  m1 = -10;
-  m2 = 10;
-
-type
-  array1dr = array[m1..m2] of ArbFloat;
-
-var
-  k, nex, ex, i, n, term: ArbInt;
-  ca: ArbFloat;
-  l, d, u, b, x: array1dr;
-
-begin
-  Write('program results slegtrte ');
-  case SizeOf(ArbFloat) of
-    4: writeln('(single)');
-    8: writeln('(double)');
-    6: writeln('(real)');
-  end;
-  Read(nex);
-  writeln;
-  writeln('  number of examples : ', nex: 2);
-  for ex := 1 to nex do
-  begin
-    writeln;
-    writeln(' example number :', ex: 2);
-    writeln;
-    Read(n, k);
-    iomrev(input, l[k + 1], n - 1);
-    iomrev(input, d[k], n);
-    iomrev(input, u[k], n - 1);
-    iomrev(input, b[k], n);
-    slegtr(n, l[k + 1], d[k], u[k], b[k], x[k], ca, term);
-    writeln;
-    writeln(' l (lower diagonal of A) = ');
-    iomwrv(output, l[k + 1], n - 1, numdig);
-    writeln;
-    writeln(' d (main diagonal of A) =');
-    iomwrv(output, d[k], n, numdig);
-    writeln;
-    writeln(' u (upper diagonal of A) =');
-    iomwrv(output, u[k], n - 1, numdig);
-    writeln;
-    writeln(' A =');
-    for i := 1 to n do
-    begin
-      if i > 1 then
-        Write('': (i - 2) * (numdig + 2), l[k + i - 1]: numdig, '': 2);
-      Write(d[k + i - 1]: numdig, '': 2);
-      if i < n then
-        Write(u[k + i - 1]: numdig);
-      writeln;
-    end;
-    writeln;
-    writeln(' b =');
-    iomwrv(output, b[k], n, numdig);
-    writeln;
-    writeln('term=', term: 2);
-    case term of
-      1:
-      begin
-        writeln('x=');
-        iomwrv(output, x[k], n, numdig);
-        writeln;
-        writeln(' ca = ', ca: 12);
-      end;
-      2: writeln('solution not possible');
-      3: writeln(' wrong value of n');
-    end;
-    writeln('-----------------------------------------------');
-  end; {example}
-  Close(input);
-  Close(output);
-end.

packages/numlib/tests/speentte.pas

@@ -32,37 +32,3 @@ begin
   end;
 
 end.
-program speentte;
-
-uses
-  spe,
-  typ;
-
-var
-  x: ArbFloat;
-  h: string;
-  t: ArbInt;
-begin
-  Write('program results speentte');
-
-  case SizeOf(ArbFloat) of
-    4: writeln('(single)');
-    8: writeln('(double)');
-    6: writeln('(real)');
-  end;
-
-  x := pi;
-  Str(x, h);
-  t := Length(h) - 1;
-
-  writeln;
-  writeln('': t div 2, 'x', '': t - 3, 'speent(x)');
-  writeln;
-
-  while not EOF do
-  begin
-    readln(x);
-    writeln(x, speent(x): t div 2);
-  end;
-
-end.

packages/numlib/tests/spege1te.pas

@@ -50,55 +50,3 @@ begin
   end;
 
 end.
-program spege1te;
-
-uses
-  typ,
-  spe;
-
-const
-  fspe: array[1..20] of rfunc1r = (@speach, @spearc, @spears, @speash, @speath, @spebi0, @spebi1, @spebj0, @spebj1, @spebk0, @spebk1, @speby0, @speby1, @specoh, @speefc, @speerf, @spegam, @spelga, @spesih, @spetah);
-
-  fnames =
-    'speachspearcspearsspeashspeathspebi0spebi1spebj0spebj1spebk0' +
-    'spebk1speby0speby1specohspeefcspeerfspegamspelgaspesihspetah';
-
-var
-  x:    ArbFloat;
-  t, u: ArbInt;
-  s, h: string;
-  f:    rfunc1r;
-
-begin
-  s := ParamStr(1);
-  u := (Pos(s, fnames) + 5) div 6;
-  if u = 0 then
-  begin
-    writeln(s, ' (commandlineparameter 1) bestaat niet in SPE');
-    halt;
-  end;
-
-  f := fspe[u];
-
-  Write('program results ' + s + 'te ');
-  case SizeOf(ArbFloat) of
-    4: writeln('(single)');
-    8: writeln('(double)');
-    6: writeln('(real)');
-  end;
-
-  x := pi;
-  Str(x, h);
-  t := Length(h) - 1;
-
-  writeln;
-  writeln('': t div 2, 'x', '': t - length(s) div 2, s + '(x)');
-  writeln;
-
-  while not EOF do
-  begin
-    readln(x);
-    writeln(x, ' ': 2, f(x));
-  end;
-
-end.

packages/numlib/tests/spemaxte.pas

@@ -32,37 +32,3 @@ begin
   end;
 
 end.
-program spemaxte;
-
-uses
-  typ,
-  spe;
-
-var
-  x, y: ArbFloat;
-  h:    string;
-  t:    ArbInt;
-begin
-  Write('program results spemaxte');
-
-  case SizeOf(ArbFloat) of
-    4: writeln('(single)');
-    8: writeln('(double)');
-    6: writeln('(real)');
-  end;
-
-  x := pi;
-  Str(x, h);
-  t := Length(h) - 1;
-
-  writeln;
-  writeln('': t div 2, 'x', '': t, 'y', '': t - 2, 'spemax(x, y)');
-  writeln;
-
-  while not EOF do
-  begin
-    readln(x, y);
-    writeln(x, ' ': 2, y, ' ': 2, spemax(x, y));
-  end;
-
-end.

packages/numlib/tests/spepolte.pas

@@ -36,41 +36,3 @@ begin
   Write('x = ', x: t, '  ');
   writeln(' P(x) = ', spepol(x, a[0], n): t);
 end.
-program spepolte;
-
-uses
-  spe,
-  iom,
-  typ;
-
-const
-  n1 = 0;
-  n2 = 10;
-
-var
-  n, t: ArbInt;
-  x: ArbFloat;
-  h: string;
-  a: array[n1..n2] of ArbFloat;
-begin
-  Write('program results spepolte');
-
-  case SizeOf(ArbFloat) of
-    4: writeln('(single)');
-    8: writeln('(double)');
-    6: writeln('(real)');
-  end;
-
-  x := pi;
-  Str(x, h);
-  t := Length(h) + 1;
-
-  Read(n);
-  iomrev(input, a[0], n + 1);
-  Read(x);
-  Write('coefficients of P:');
-  iomwrv(output, a[0], n + 1, t);
-  writeln;
-  Write('x = ', x: t, '  ');
-  writeln(' P(x) = ', spepol(x, a[0], n): t);
-end.

packages/numlib/tests/spepowte.pas

@@ -36,41 +36,3 @@ begin
     writeln;
   end;
 end.
-program spepowte;
-
-uses
-  typ,
-  spe;
-
-var
-  x, y: ArbFloat;
-  t:    ArbInt;
-  s, h: string;
-
-begin
-  s := 'spepow';
-  Write('program results ' + s + 'te ');
-  case SizeOf(ArbFloat) of
-    4: writeln('(single)');
-    8: writeln('(double)');
-    6: writeln('(real)');
-  end;
-
-  x := pi;
-  Str(x, h);
-  t := Length(h) - 1;
-
-  while not EOF do
-  begin
-    readln(x);
-    writeln;
-    writeln('   x =  ', x);
-    writeln('': t div 2, 'y', '': t - length(s) div 2, s + '(x, y)');
-    while not eoln do
-    begin
-      Read(y);
-      writeln(y, '  ', spepow(x, y));
-    end;
-    writeln;
-  end;
-end.

packages/numlib/tests/spesgnte.pas

@@ -32,37 +32,3 @@ begin
   end;
 
 end.
-program spesgnte;
-
-uses
-  spe,
-  typ;
-
-var
-  x: ArbFloat;
-  h: string;
-  t: ArbInt;
-begin
-  Write('program results spesgnte');
-
-  case SizeOf(ArbFloat) of
-    4: writeln('(single)');
-    8: writeln('(double)');
-    6: writeln('(real)');
-  end;
-
-  x := pi;
-  Str(x, h);
-  t := Length(h) - 1;
-
-  writeln;
-  writeln('': t div 2, 'x', '': t - 3, 'spesgn(x)');
-  writeln;
-
-  while not EOF do
-  begin
-    readln(x);
-    writeln(x, ' ': t div 2, spesgn(x));
-  end;
-
-end.

packages/numlib/tests/test.pas

@@ -5,10 +5,3 @@ BEGIN
  writeln(og);
  writeln(bg);
 END.
-
-Uses det,typ;
-
-BEGIN
- writeln(og);
- writeln(bg);
-END.

packages/numlib/tests/timer.pas

@@ -112,117 +112,3 @@ begin  {unit initialization}
   exitproc := @myexit;
   InitTimer
 end.
-unit timer;
-
-{$r-,s-}
-
-INTERFACE
-
-var
-  timeractive: boolean;
-  exacttime, mstime: longint;
-
-function timervalue: longint;          {Return time in 10 usec units}
-function mstimer: longint;             {Return time in ms}
-
-IMPLEMENTATION
-
-uses dos, crt;
-
-var
-  lowbyte, highbyte, ref: word;
-  timerid: integer;
-  saveint, exitsave: pointer;
-
-function inport(x: integer): byte;     {Read i/o port}
-  inline($5a/$eb/$00/$ec);
-
-{$F+}
-procedure clock(p: pointer); interrupt;
-{$F-}
-  {Interrupt service routine to update timer reference values}
-
-  const
-    incr = 5493;                       {Timer increment per interrupt}
-
-  begin
-    port[$43] := $00;                  {Latch timer 0}
-    lowbyte := inport($40);
-    highbyte := inport($40);
-    ref := (highbyte shl 8) + lowbyte; {Base for subsequent readings
-                                          within current clock interval}
-    exacttime := exacttime + incr;     {New 10 usec timer value}
-    mstime := mstime + 55;             {New ms timer value}
-    inline($9c/$ff/$1e/saveint);       {Chain to old interrupt}
-  end;
-
-function timervalue: longint;
-
-  {Get value of 10-usec timer}
-
-  var
-    dif, low, high: word;
-    t: longint;
-
-  begin
-    inline($fa);                         {Disable interrupts}
-    port[$43] := $00;                    {Latch timer}
-    low := inport($40);                  {Timer LSB}
-    high := inport($40);                 {MSB}
-    dif := ref - ((high shl 8) + low);   {Delta from last sync}
-    timervalue := exacttime + (longint(dif)*100 div 1193);
-    inline($fb);                         {Re-enable interrupts}
-  end;
-
-function mstimer: longint;
-
-  {Get value of millisecond timer}
-
-  var
-    dif, low, high: word;
-    t: longint;
-
-  begin
-    inline($fa);
-    port[$43] := $00;
-    low := inport($40);
-    high := inport($40);
-    inline($fb);
-    dif := ref - ((high shl 8) + low);
-    mstimer := mstime + (dif div 1193);
-  end;
-
-procedure inittimer;
-
-  begin
-    exacttime := 0;
-    mstime := 0;
-    if not timeractive then
-      begin
-        port[$43] := $34;   {Mode 2 - countdown
-                             (approx .84 microsecond ticks)}
-        port[$40] := $ff;   {Initialize timer value}
-        port[$40] := $ff;
-        getintvec(8, saveint);         {Save old interrupt address}
-        setintvec(8, @clock);          {Install new service routine}
-        timeractive := true;
-        delay(60);                     {Allow for first tick}
-      end;
-  end;
-
-{$f+} procedure myexit; {$f-}
-
-  {Assure timer interrupt restored before exit}
-
-  begin
-    if timeractive then
-      setintvec(8, saveint);
-    exitproc := exitsave;             {Restore TP exit chain}
-  end;
-
-begin  {unit initialization}
-  timeractive := false;
-  exitsave := exitproc;               {Insert exit routine}
-  exitproc := @myexit;
-  InitTimer
-end.

packages/numlib/tests/turte.pas

@@ -54,59 +54,3 @@ begin
   x := midget * 0.75;
   writeln(' resultaat van x:= midget*0.75 =', x);
 end.
-program TurTe;
-
-uses
-  typ;
-
-  function Tweelog(x: real): integer;
-  var
-    i: integer;
-  begin
-    i := 0;
-    if x > 1 then
-      Tweelog := -Tweelog(1 / x)
-    else
-    begin
-      while x < 1 do
-      begin
-        Dec(i);
-        x := 2 * x;
-      end;
-      if x <> 1 then
-        Tweelog := 0
-      else
-        Tweelog := i;
-    end;
-  end;
-
-var
-  x: real;
-
-begin
-
-  { Test op macheps }
-  Writeln('Macheps = 2', Tweelog(macheps));
-  Writeln('Hoe wordt er afgerond?');
-  x := 1 + macheps;
-  Writeln('(1 + macheps     ) - 1 = ', x - 1);
-  x := 1 + 0.75 * macheps;
-  Writeln('(1 + 0.75*macheps) - 1 = ', x - 1);
-  x := 1 + 0.5 * macheps;
-  Writeln('(1 + 0.5*macheps ) - 1 = ', x - 1);
-  x := 1 + 0.25 * macheps;
-  Writeln('(1 + 0.25*macheps) - 1 = ', x - 1);
-
-  {test op giant }
-  writeln(' giant = ', giant);
-  x := giant / 2;
-  writeln(' resultaat van x:= giant / 2 =', x);
-  {test op midget}
-  writeln(' midget = ', midget);
-  x := midget / 2;
-  writeln(' resultaat van x:= midget/2 =', x);
-  x := midget / 3;
-  writeln(' resultaat van x:= midget/3 =', x);
-  x := midget * 0.75;
-  writeln(' resultaat van x:= midget*0.75 =', x);
-end.

packages/rtl-extra/src/unix/ipc.pp

@@ -656,7 +656,7 @@ const
   MAX_SOPS = 5;
 {$endif}
 
-{$if not defined(aix) and not defined(darwin)}
+{$if not defined(aix)}
   SEM_GETNCNT = 3;   { Return the value of sempid (READ)  }
   SEM_GETPID  = 4;   { Return the value of semval (READ)  }
   SEM_GETVAL  = 5;   { Return semvals into arg.array (READ)  }

rtl/inc/aliases.inc

@@ -27,7 +27,7 @@
 Procedure int_Finalize (Data,TypeInfo: Pointer); [external name 'FPC_FINALIZE'];
 Procedure int_Addref (Data,TypeInfo : Pointer); [external name 'FPC_ADDREF'];
 Procedure int_Initialize (Data,TypeInfo: Pointer); [external name 'FPC_INITIALIZE'];
-procedure int_FinalizeArray(data,typeinfo : pointer;count : longint); [external name 'FPC_FINALIZE_ARRAY'];
+procedure int_FinalizeArray(data,typeinfo : pointer;count : SizeInt); [external name 'FPC_FINALIZE_ARRAY'];
 
 {$if defined(FPC_HAS_FEATURE_RTTI) and not defined(cpujvm)}
 type

rtl/inc/flt_core.inc

@@ -755,7 +755,7 @@ type
  | to the sequence of byte-sized decimal digits.
  |
  *-------------------------------------------------------*)
-function gen_digits_32( out buf: TAsciiDigits; pos: integer; x: dword; pad_9zero: boolean = false ): integer;
+function gen_digits_32( var buf: TAsciiDigits; pos: integer; x: dword; pad_9zero: boolean = false ): integer;
 const
     digits: array [ 0 .. 9 ] of dword = (
               0,
@@ -803,7 +803,7 @@ begin
 end;
 
 {$ifndef VALREAL_32}
-function gen_digits_64( out buf: TAsciiDigits; pos: integer; const x: qword; pad_19zero: boolean = false ): integer;
+function gen_digits_64( var buf: TAsciiDigits; pos: integer; const x: qword; pad_19zero: boolean = false ): integer;
 var
     n_digits: integer;
     temp: qword;

rtl/inc/ustrings.inc

@@ -2240,8 +2240,8 @@ function UCS4StringToWideString(const s : UCS4String) : WideString;
 
 {$ifndef FPC_HAS_BUILTIN_WIDESTR_MANAGER}
 const
-  SNoUnicodestrings = 'This binary has no unicodestrings support compiled in.';
-  SRecompileWithUnicodestrings = 'Recompile the application with a unicodestrings-manager in the program uses clause.';
+  SNoUnicodestrings = 'This binary has no string conversion support compiled in.';
+  SRecompileWithUnicodestrings = 'Recompile the application with a unit that installs a unicodestring manager in the program uses clause.';
 
 procedure unimplementedunicodestring;
   begin

rtl/java/justrings.inc

@@ -18,6 +18,10 @@
 { unicodestring is a plain java.lang.String }
 {$define FPC_UNICODESTRING_TYPE_DEFINED}
 
+{ helpers for converting between Windows and Java code page identifiers }
+
+{$i jwin2javacharset.inc}
+
 {$define FPC_HAS_DEFAULT_UNICODE_2_ANSI_MOVE}
 procedure DefaultUnicode2AnsiMove(source:punicodechar;var dest:RawByteString;cp : TSystemCodePage;len:SizeInt);
 var
@@ -421,12 +425,16 @@ procedure fpc_unicodestr_to_chararray(out res: array of AnsiChar; const src: Uni
 var
   len: longint;
   temp: array of jbyte;
+  csname: unicodestring;
 begin
   len:=length(src);
   { make sure we don't dereference src if it can be nil (JM) }
   if len>0 then
     begin
-      temp:=JLString(src).getBytes;
+      csname:=win2javacs(DefaultSystemCodePage);
+      if csname='<unsupported>' then
+        csname:='US-ASCII';
+      temp:=JLString(src).getBytes(csname);
       len:=length(temp);
       if len>length(res) then
         len:=length(res);
@@ -794,18 +802,15 @@ function UTF8Encode(const s : UnicodeString) : RawByteString;
 function UTF8Decode(const s : RawByteString): UnicodeString;
   var
     i : SizeInt;
-    hs : UnicodeString;
     chars: array of widechar;
   begin
     result:='';
     if s='' then
       exit;
-    SetLength(chars,length(s));
-    i:=Utf8ToUnicode(pwidechar(chars),length(hs)+1,pchar(s),length(s));
+    SetLength(chars,length(s)+1);
+    i:=Utf8ToUnicode(pwidechar(chars),length(s)+1,pchar(s),length(s));
     if i>0 then
-      begin
-        result:=JLString.Create(chars,0,i);
-      end;
+      result:=JLString.Create(chars,0,i-1);
   end;
 
 
@@ -915,10 +920,6 @@ Begin
 End;
 
 
-{ helpers for converting between Windows and Java code page identifiers }
-
-{$i jwin2javacharset.inc}
-
 { *************************************************************************** }
 { ************************* Collator threadvar ****************************** }
 { *************************************************************************** }

rtl/jvm/jvm.inc

@@ -188,8 +188,8 @@ function  IndexByte(const buf: array of jbyte;len:SizeInt;b:jbyte):SizeInt;
     i: SizeInt;
   begin
     if len<0 then
-      len:=high(buf);
-    for i:=0 to len do
+      len:=high(buf)+1;
+    for i:=0 to len-1 do
       if buf[i]=b then
         exit(i);
     IndexByte:=-1;
@@ -201,8 +201,8 @@ var
   i: SizeInt;
 begin
   if len<0 then
-    len:=high(buf);
-  for i:=0 to len do
+    len:=high(buf)+1;
+  for i:=0 to len-1 do
     if jbyte(buf[i])=b then
       exit(i);
   IndexByte:=-1;
@@ -227,8 +227,8 @@ function  IndexWord(const buf: array of jshort;len:SizeInt;b:jshort):SizeInt;
     i: SizeInt;
   begin
     if len<0 then
-      len:=high(buf);
-    for i:=0 to len do
+      len:=high(buf)+1;
+    for i:=0 to len-1 do
       if buf[i]=b then
         exit(i);
     IndexWord:=-1;
@@ -240,8 +240,8 @@ function  IndexWord(const buf: array of jchar;len:SizeInt;b:jchar):SizeInt;
     i: SizeInt;
   begin
     if len<0 then
-      len:=high(buf);
-    for i:=0 to len do
+      len:=high(buf)+1;
+    for i:=0 to len-1 do
       if buf[i]=b then
         exit(i);
     IndexWord:=-1;
@@ -254,8 +254,8 @@ function  IndexWord(const buf: array of jchar;len:SizeInt;b:jshort):SizeInt;
   begin
     c:=jchar(b);
     if len<0 then
-      len:=high(buf);
-    for i:=0 to len do
+      len:=high(buf)+1;
+    for i:=0 to len-1 do
       if buf[i]=c then
         exit(i);
     IndexWord:=-1;

rtl/objpas/sysutils/sysuni.inc

@@ -468,14 +468,14 @@ function strnew(p : pwidechar) : pwidechar; overload;
 function WideStrAlloc(Size: cardinal): PWideChar;
   begin
     getmem(result,size*2+sizeof(cardinal));
-    cardinal(pointer(result)^):=size*2+sizeof(cardinal);
-    inc(result,sizeof(cardinal));
+    PCardinal(result)^:=size*2+sizeof(cardinal);
+    result:=PWideChar(PByte(result)+sizeof(cardinal));
   end;
 
 function StrBufSize(str: pwidechar): cardinal;
   begin
     if assigned(str) then
-      result:=cardinal(pointer(str-sizeof(cardinal))^)-sizeof(cardinal)
+      result:=(PCardinal(PByte(str)-sizeof(cardinal))^)-sizeof(cardinal)
     else
       result := 0;
   end;
@@ -484,8 +484,8 @@ procedure StrDispose(str: pwidechar);
 begin
   if assigned(str) then
    begin
-     dec(str,sizeof(cardinal));
-     freemem(str,cardinal(pointer(str)^));
+     str:=PWideChar(PByte(str)-sizeof(cardinal));
+     freemem(str,PCardinal(str)^);
    end;
 end;
 

tests/Makefile

@@ -2339,7 +2339,8 @@ MAKEINC=$(TEST_OUTPUTDIR)/MakeChunks-$(TEST_TARGETSUFFIX).inc
 $(GPARMAKE): $(COMPILER_UNITTARGETDIR) utils/gparmake.pp
 	$(FPC) $(FPCOPT) -FE. utils/gparmake.pp $(OPT)
 $(MAKEINC): $(GPARMAKE) $(TEST_OUTPUTDIR)
-	$(Q)$(GPARMAKE) $(MAKEINC) test 1 $(CHUNKSIZE) $(sort $(wildcard $(addsuffix /t*.pp,$(TESTDIRS))))
+	$(MAKE) -s -f createlst.mak "TESTDIRS=$(TESTDIRS)" > testfilelist.lst
+	$(Q)$(GPARMAKE) $(MAKEINC) test 1 $(CHUNKSIZE) @testfilelist.lst
 	$(Q)$(GPARMAKE) -a $(MAKEINC) tbs 10000 $(CHUNKSIZE) $(sort $(wildcard tbs/t*.pp))
 	$(Q)$(GPARMAKE) -a $(MAKEINC) tbf 15000 $(CHUNKSIZE) $(sort $(wildcard tbf/t*.pp))
 	$(Q)$(GPARMAKE) -a $(MAKEINC) webtbs 20000 $(CHUNKSIZE) $(sort $(wildcard webtbs/t*.pp))

tests/Makefile.fpc

@@ -508,7 +508,8 @@ $(MAKEINC): $(GPARMAKE) $(TEST_OUTPUTDIR)
 # used subdirectory. Note also that the index must be increasing for each
 # new call with a gap insuring that all the previous files have lower index
 # even if CHUNKSIZE is equal to 1.
-	$(Q)$(GPARMAKE) $(MAKEINC) test 1 $(CHUNKSIZE) $(sort $(wildcard $(addsuffix /t*.pp,$(TESTDIRS))))
+	$(MAKE) -s -f createlst.mak "TESTDIRS=$(TESTDIRS)" > testfilelist.lst
+	$(Q)$(GPARMAKE) $(MAKEINC) test 1 $(CHUNKSIZE) @testfilelist.lst
 	$(Q)$(GPARMAKE) -a $(MAKEINC) tbs 10000 $(CHUNKSIZE) $(sort $(wildcard tbs/t*.pp))
 	$(Q)$(GPARMAKE) -a $(MAKEINC) tbf 15000 $(CHUNKSIZE) $(sort $(wildcard tbf/t*.pp))
 	$(Q)$(GPARMAKE) -a $(MAKEINC) webtbs 20000 $(CHUNKSIZE) $(sort $(wildcard webtbs/t*.pp))

tests/createlst.mak

@@ -0,0 +1,4 @@
+FILES=$(sort $(wildcard $(addsuffix /t*.pp,$(TESTDIRS))))
+$(foreach filename,$(FILES),$(info $(filename)))
+
+all: ;

tests/test/tw29833.pp

@@ -0,0 +1,9 @@
+var
+  aURI,Server:rawbytestring;
+
+begin
+  aURI:='abcdefg';
+  SetString(Server,@aURI[1],Length(aURI));
+  if stringcodepage(server)=CP_NONE then
+    halt(1);
+end.