home *** CD-ROM | disk | FTP | other *** search
/ Crawly Crypt Collection 1 / crawlyvol1.bin / program / compiler / m2posx14 / test / tlib.mpp < prev    next >
Encoding:
Text File  |  1994-05-29  |  24.2 KB  |  893 lines
  1. MODULE Tlib;
  2. __IMP_SWITCHES__
  3. __DEBUG__
  4. #if (defined HM2) || (defined HM2_OLD)
  5. (*$E+ Prozeduren als Parameter moeglich *)
  6. #endif
  7. #ifdef HM2
  8. #ifdef __LONG_WHOLE__
  9. (*$!i+: Modul muss mit $i- uebersetzt werden! *)
  10. (*$!w+: Modul muss mit $w- uebersetzt werden! *)
  11. #else
  12. (*$!i-: Modul muss mit $i+ uebersetzt werden! *)
  13. (*$!w-: Modul muss mit $w+ uebersetzt werden! *)
  14. #endif
  15. #endif
  16. (* 29-Mai-94, Holger Kleinschmidt *)
  17.  
  18. #if (defined MM2) && (defined __DEBUG_CODE__)
  19. IMPORT Debug;
  20. #endif
  21.  
  22. CAST_IMPORT
  23. VAL_INTRINSIC
  24. PTR_ARITH_IMPORT
  25. REGISTER_IMPORT
  26.  
  27. FROM SYSTEM IMPORT
  28. (* TYPE *) ADDRESS,
  29. (* PROC *) TSIZE, ADR;
  30.  
  31. FROM PORTAB IMPORT
  32. (* TYPE *) UNSIGNEDLONG, SIGNEDLONG, UNSIGNEDWORD, SIGNEDWORD;
  33.  
  34. FROM types IMPORT
  35. (* CONST*) NULL,
  36. (* TYPE *) StrPtr;
  37.  
  38. FROM pSTRING IMPORT
  39. (* PROC *) EQUAL;
  40.  
  41. FROM jump IMPORT
  42. (* TYPE *) JmpBuf,
  43. (* PROC *) setjmp, longjmp;
  44.  
  45. FROM lib IMPORT
  46. (* TYPE *) CompareProc,
  47. (* PROC *) lfind, bsearch, qsort, ltoa, ultoa, rand;
  48.  
  49. FROM OSCALLS IMPORT
  50. (* PROC *) Malloc, Mfree;
  51.  
  52. FROM MEMBLK IMPORT
  53. (* PROC *) memswap, memmove, memset, memchr, memcmp, memalloc, memdealloc;
  54.  
  55. FROM InOut IMPORT
  56. (* PROC *) Read, Write, WriteInt, WriteString, WriteLn;
  57.  
  58. (*~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~*)
  59.  
  60. TYPE
  61.   FillProc = PROCEDURE(SIGNEDWORD,SIGNEDWORD): UNSIGNEDLONG;
  62.  
  63. CONST
  64.   BEFORE = 10;
  65.   AFTER  = 10;
  66.   MAXLEN = 100;
  67.  
  68. CONST
  69.   MINLINT  = 80000000H;
  70.   MAXLINT  = 7FFFFFFFH;
  71.   MAXLCARD = 0FFFFFFFFH;
  72.  
  73. CONST
  74.   CPATTERN = 377C;
  75.   LPATTERN = 5E5E5E5EH;
  76.   MAXCBUF  = 499;
  77.   MAXLBUF  = 299;
  78.  
  79. CONST
  80.   LONGJUMPVAL = 42;
  81.   GLOBALVAL   = 12345678H;
  82.   LOCALVAL    = 87654321H;
  83.  
  84. TYPE LBuf = ARRAY [0..MAXLBUF] OF UNSIGNEDLONG;
  85.      CBuf = ARRAY [0..MAXCBUF] OF CHAR;
  86.  
  87. VAR cbuf      : CBuf;
  88.     lbuf      : LBuf;
  89.     lbuf2     : LBuf;
  90.     test      : UNSIGNEDLONG;
  91.     found     : POINTER TO UNSIGNEDLONG;
  92.     i         : UNSIGNEDWORD;
  93.     BusyBuf   : ARRAY [0..4] OF CHAR;
  94.     BusyIdx   : [0..4];
  95.     ch        : CHAR;
  96.     ERROR     : BOOLEAN;
  97.     jmpbuf    : JmpBuf;
  98.     globalvar : UNSIGNEDLONG;
  99.  
  100. (*~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~*)
  101.  
  102. PROCEDURE OK (REF proc : ARRAY OF CHAR);
  103. BEGIN
  104.  IF NOT ERROR THEN
  105.    WriteString(proc); WriteString(": OK"); WriteLn;
  106.  END;
  107. END OK;
  108.  
  109. (*---------------------------------------------------------------------------*)
  110.  
  111. PROCEDURE Busy;
  112. BEGIN
  113.  Write(CHR(8));
  114.  Write(BusyBuf[BusyIdx]);
  115.  BusyIdx := (BusyIdx + 1) MOD 4;
  116. END Busy;
  117.  
  118. (*---------------------------------------------------------------------------*)
  119.  
  120. PROCEDURE ClearBusy;
  121. BEGIN
  122.  Write(CHR(8));
  123.  Write(' ');
  124.  Write(CHR(8));
  125. END ClearBusy;
  126.  
  127. (*---------------------------------------------------------------------------*)
  128.  
  129. PROCEDURE fillinc ((* EIN/ -- *) i   : SIGNEDWORD;
  130.                    (* EIN/ -- *) max : SIGNEDWORD ): UNSIGNEDLONG;
  131. BEGIN
  132.  RETURN(VAL(UNSIGNEDLONG,i));
  133. END fillinc;
  134.  
  135. (*---------------------------------------------------------------------------*)
  136.  
  137. PROCEDURE filldec ((* EIN/ -- *) i   : SIGNEDWORD;
  138.                    (* EIN/ -- *) max : SIGNEDWORD ): UNSIGNEDLONG;
  139. BEGIN
  140.  RETURN(VAL(UNSIGNEDLONG,max - i));
  141. END filldec;
  142.  
  143. (*---------------------------------------------------------------------------*)
  144.  
  145. PROCEDURE fillrnd ((* EIN/ -- *) i   : SIGNEDWORD;
  146.                    (* EIN/ -- *) max : SIGNEDWORD ): UNSIGNEDLONG;
  147. BEGIN
  148.  RETURN(VAL(UNSIGNEDLONG,rand()));
  149. END fillrnd;
  150.  
  151. (*---------------------------------------------------------------------------*)
  152.  
  153. PROCEDURE cmp ((* EIN/ -- *) a : ADDRESS;
  154.                (* EIN/ -- *) b : ADDRESS ): INTEGER;
  155.  
  156. VAR __REG__ A , B : POINTER TO UNSIGNEDLONG;
  157. BEGIN
  158.  A := a;
  159.  B := b;
  160.  IF A^ > B^ THEN
  161.    RETURN(1);
  162.  ELSIF A^ < B^ THEN
  163.    RETURN(-1);
  164.  ELSE
  165.    RETURN(0);
  166.  END;
  167. END cmp;
  168.  
  169. (*---------------------------------------------------------------------------*)
  170.  
  171. PROCEDURE SlowSort ((* EIN/ -- *)     from : UNSIGNEDWORD;
  172.                     (* EIN/ -- *)     to   : UNSIGNEDWORD;
  173.                     (* EIN/AUS *) VAR buf  : ARRAY OF UNSIGNEDLONG );
  174. (* langsam, aber durchschaubar...zum testen von "qsort()".
  175.  * Es wird der Reihe nach fuer jedes Element ausser dem letzten das
  176.  * Minimum von diesem Element und allen rechts von ihm stehenden
  177.  * Elementen gesucht, und dann das Element und das Minimum ausgetauscht.
  178.  *)
  179. VAR __REG__ i    : UNSIGNEDWORD;
  180.     __REG__ j    : UNSIGNEDWORD;
  181.     __REG__ min  : UNSIGNEDWORD;
  182.     __REG__ tmp  : UNSIGNEDLONG;
  183.  
  184. BEGIN
  185.  FOR i := from TO to - 1 DO
  186.    min := i;
  187.    FOR j := i + 1 TO to DO
  188.      IF buf[j] < buf[min] THEN
  189.        min := j;
  190.      END;
  191.    END;
  192.    IF i <> min THEN
  193.      tmp      := buf[i];
  194.      buf[i]   := buf[min];
  195.      buf[min] := tmp;
  196.    END;
  197.  END;
  198. END SlowSort;
  199.  
  200. (*---------------------------------------------------------------------------*)
  201.  
  202. PROCEDURE tmemchr ((* EIN/ -- *) REF proc : ARRAY OF CHAR );
  203.  
  204. CONST MEMSIZE = 10020H; (* > 64kB *)
  205.  
  206. TYPE CHARPTR = POINTER TO CHAR;
  207.  
  208. VAR mem  : CHARPTR;
  209.     res  : INTEGER;
  210.     void : BOOLEAN;
  211.  
  212. PROCEDURE test (offset : UNSIGNEDLONG; len : UNSIGNEDLONG; exp : CHARPTR): BOOLEAN;
  213. VAR tmp1 : CHARPTR;
  214.     tmp2 : CHARPTR;
  215. BEGIN
  216.  tmp1  := ADDADR(mem, offset);
  217.  tmp1^ := CPATTERN;
  218.  tmp2  := memchr(mem, ORD(CPATTERN), len);
  219.  tmp1^ := 0C;
  220.  RETURN(tmp2 = exp);
  221. END test;
  222.  
  223. BEGIN
  224.  IF Malloc(MEMSIZE, mem) THEN
  225.    WriteString(proc); Write(' ');
  226.    memset(mem, 0, MEMSIZE); (* Annahme: "memset()" funktioniert *)
  227.    (* Ein paar Stichproben an den Raendern genuegen *)
  228.    IF NOT test(0, 0, NULL) THEN
  229.      WriteString("*** 1");
  230.      RETURN;
  231.    END;
  232.    IF NOT test(0, 1, mem) THEN
  233.      WriteString("*** 2");
  234.      RETURN;
  235.    END;
  236.    IF NOT test(1, 1, NULL) THEN
  237.      WriteString("*** 3");
  238.      RETURN;
  239.    END;
  240.    IF NOT test(1, 10, CAST(CHARPTR,ADDADR(mem, 1))) THEN
  241.      WriteString("*** 4");
  242.      RETURN;
  243.    END;
  244.    IF NOT test(10000H, 10000H, NULL) THEN
  245.      WriteString("*** 5");
  246.      RETURN;
  247.    END;
  248.    IF NOT test(10000H, 10001H, CAST(CHARPTR,ADDADR(mem, 10000H))) THEN
  249.      WriteString("*** 6");
  250.      RETURN;
  251.    END;
  252.    IF NOT test(10010H, 10010H, NULL) THEN
  253.      WriteString("*** 7");
  254.      RETURN;
  255.    END;
  256.    IF NOT test(10010H, 10011H, CAST(CHARPTR,ADDADR(mem, 10010H))) THEN
  257.      WriteString("*** 8");
  258.      RETURN;
  259.    END;
  260.    void := Mfree(mem, res);
  261.    WriteString("OK");
  262.    WriteLn;
  263.  END;
  264. END tmemchr;
  265.  
  266. (*---------------------------------------------------------------------------*)
  267.  
  268. PROCEDURE tmemswap ((* EIN/ -- *) REF proc   : ARRAY OF CHAR;
  269.                     (* EIN/ -- *)     blk1   : SIGNEDWORD;
  270.                     (* EIN/ -- *)     blk2   : SIGNEDWORD;
  271.                     (* EIN/ -- *)     maxlen : SIGNEDWORD );
  272.  
  273. VAR __REG__ len : SIGNEDWORD;
  274.     __REG__ i   : SIGNEDWORD;
  275.  
  276. PROCEDURE WriteMsg (i, len : SIGNEDWORD; exp : CHAR; REF msg : ARRAY OF CHAR);
  277. BEGIN
  278.  ClearBusy;
  279.  WriteLn;
  280.  WriteString(msg); WriteLn;
  281.  WriteString("blk1: "); WriteInt(INT(blk1), 0); WriteLn;
  282.  WriteString("blk2: "); WriteInt(INT(blk2), 0); WriteLn;
  283.  WriteString(" len: "); WriteInt(INT(len), 0); WriteLn;
  284.  WriteString("cbuf["); WriteInt(INT(i), 0); WriteString("]: ");
  285.  WriteInt(INT(cbuf[i]),0); WriteString(" (expected: ");
  286.  WriteInt(INT(exp),0); Write(')');
  287.  WriteLn;
  288.  Read(ch);
  289. END WriteMsg;
  290.  
  291.  
  292. BEGIN
  293.  WriteString(proc); Write(' ');
  294.  FOR len := 0 TO maxlen DO
  295.    Busy;
  296.    FOR i := 0 TO MAXCBUF DO
  297.      cbuf[i] := 0C;
  298.    END;
  299.    FOR i := blk1 TO blk1+len-1 DO
  300.      cbuf[i] := CHR(i);
  301.    END;
  302.    FOR i := blk2 TO blk2+len-1 DO
  303.      cbuf[i] := CHR(i);
  304.    END;
  305.    memswap(ADR(cbuf[blk1]), ADR(cbuf[blk2]), VAL(UNSIGNEDLONG,len));
  306.    FOR i := 0 TO blk1-1 DO
  307.      IF cbuf[i] <> 0C THEN
  308.        WriteMsg(i, len, 0C,"*** cbuf[i=0..blk1-1]:");
  309.        RETURN;
  310.      END;
  311.    END;
  312.    FOR i := blk1 TO blk1+len-1 DO
  313.      (* Steht Block2 an der Stelle des ehemaligen Block1? *)
  314.      IF cbuf[i] <> CHR(blk2+i-blk1) THEN
  315.        WriteMsg(i, len, CHR(blk2+i-blk1),"*** cbuf[i=blk1..blk1+len-1]:");
  316.        RETURN;
  317.      END;
  318.    END;
  319.    FOR i := blk1+len TO blk2-1 DO
  320.      IF cbuf[i] <> 0C THEN
  321.        WriteMsg(i, len, 0C,"*** cbuf[i=blk1+len..blk2-1]:");
  322.        RETURN;
  323.      END;
  324.    END;
  325.    FOR i := blk2 TO blk2+len-1 DO
  326.      (* Steht Block1 an der Stelle des ehemaligen Block2? *)
  327.      IF cbuf[i] <> CHR(blk1+i-blk2) THEN
  328.        WriteMsg(i, len, CHR(blk1+i-blk2),"*** cbuf[i=blk2..blk2+len-1]:");
  329.        RETURN;
  330.      END;
  331.    END;
  332.    FOR i := blk2+len TO MAXCBUF DO
  333.      IF cbuf[i] <> 0C THEN
  334.        WriteMsg(i, len, 0C,"*** cbuf[i=blk2+len..CMAXBUF]:");
  335.        RETURN;
  336.      END;
  337.    END;
  338.  END;
  339.  ClearBusy;
  340.  WriteString("OK");
  341.  WriteLn;
  342. END tmemswap;
  343.  
  344. (*---------------------------------------------------------------------------*)
  345.  
  346. PROCEDURE tmemcmp ((* EIN/ -- *) REF proc   : ARRAY OF CHAR;
  347.                    (* EIN/ -- *)     blk1   : SIGNEDWORD;
  348.                    (* EIN/ -- *)     blk2   : SIGNEDWORD;
  349.                    (* EIN/ -- *)     maxlen : SIGNEDWORD );
  350.  
  351. VAR __REG__ len : SIGNEDWORD;
  352.     __REG__ i   : SIGNEDWORD;
  353.             res : INTEGER;
  354.  
  355. PROCEDURE WriteMsg (len : SIGNEDWORD; REF exp : ARRAY OF CHAR);
  356. BEGIN
  357.  ClearBusy;
  358.  WriteLn;
  359.  WriteString("**********"); WriteLn;
  360.  WriteString("blk1: "); WriteInt(INT(blk1), 0); WriteLn;
  361.  WriteString("blk2: "); WriteInt(INT(blk2), 0); WriteLn;
  362.  WriteString(" len: "); WriteInt(INT(len), 0); WriteLn;
  363.  WriteString("cmp: "); WriteInt(res, 0);
  364.  WriteString(" (expected: "); WriteString(exp); Write(')');
  365.  WriteLn;
  366.  Read(ch);
  367. END WriteMsg;
  368.  
  369.  
  370. BEGIN
  371.  WriteString(proc); Write(' ');
  372.  FOR len := 0 TO maxlen DO
  373.    Busy;
  374. (* Test auf = *)
  375.    FOR i := blk1 TO blk1+len-1 DO
  376.      cbuf[i] := CHR(10);;
  377.    END;
  378.    cbuf[blk1+len] := CHR(11);
  379.    FOR i := blk2 TO blk2+len-1 DO
  380.      cbuf[i] := CHR(10);
  381.    END;
  382.    cbuf[blk2+len] := CHR(9);
  383.    res := memcmp(ADR(cbuf[blk1]), ADR(cbuf[blk2]), VAL(UNSIGNEDLONG,len));
  384.    IF res <> 0 THEN
  385.      WriteMsg(len, "= 0");
  386.      RETURN;
  387.    END;
  388.    IF len > 0 THEN
  389. (* Test auf < *)
  390.      FOR i := blk1 TO blk1+len-2 DO
  391.        cbuf[i] := CHR(10);;
  392.      END;
  393.      cbuf[blk1+len-1] := CHR(9);
  394.      FOR i := blk2 TO blk2+len-2 DO
  395.        cbuf[i] := CHR(10);
  396.      END;
  397.      cbuf[blk2+len-1] := CHR(11);
  398.      res := memcmp(ADR(cbuf[blk1]), ADR(cbuf[blk2]), VAL(UNSIGNEDLONG,len));
  399.      IF res >= 0 THEN
  400.        WriteMsg(len, "< 0");
  401.        RETURN;
  402.      END;
  403. (* Test auf > *)
  404.      FOR i := blk1 TO blk1+len-2 DO
  405.        cbuf[i] := CHR(10);;
  406.      END;
  407.      cbuf[blk1+len-1] := CHR(11);
  408.      FOR i := blk2 TO blk2+len-2 DO
  409.        cbuf[i] := CHR(10);
  410.      END;
  411.      cbuf[blk2+len-1] := CHR(9);
  412.      res := memcmp(ADR(cbuf[blk1]), ADR(cbuf[blk2]), VAL(UNSIGNEDLONG,len));
  413.      IF res <= 0 THEN
  414.        WriteMsg(len, "> 0");
  415.        RETURN;
  416.      END;
  417.    END;
  418.  END;
  419.  ClearBusy;
  420.  WriteString("OK");
  421.  WriteLn;
  422. END tmemcmp;
  423.  
  424. (*---------------------------------------------------------------------------*)
  425.  
  426. PROCEDURE tmemset ((* EIN/ -- *) REF proc   : ARRAY OF CHAR;
  427.                    (* EIN/ -- *)     from   : SIGNEDWORD;
  428.                    (* EIN/ -- *)     maxlen : SIGNEDWORD    );
  429.  
  430. VAR __REG__ len : SIGNEDWORD;
  431.     __REG__ i   : SIGNEDWORD;
  432.  
  433. PROCEDURE WriteMsg (i, len: SIGNEDWORD; exp : CHAR; REF msg : ARRAY OF CHAR);
  434. BEGIN
  435.  ClearBusy;
  436.  WriteLn;
  437.  WriteString(msg); WriteLn;
  438.  WriteString("from: "); WriteInt(INT(from), 0); WriteLn;
  439.  WriteString(" len: "); WriteInt(INT(len), 0); WriteLn;
  440.  WriteString("cbuf["); WriteInt(INT(i), 0); WriteString("]: ");
  441.  WriteInt(INT(cbuf[i]),0); WriteString(" (expected: ");
  442.  WriteInt(INT(exp),0); Write(')');
  443.  WriteLn;
  444.  Read(ch);
  445. END WriteMsg;
  446.  
  447. BEGIN
  448.  WriteString(proc); Write(' ');
  449.  FOR len := 0 TO maxlen DO
  450.    Busy;
  451.    FOR i := 0 TO MAXCBUF DO
  452.      cbuf[i] := CPATTERN;
  453.    END;
  454.    memset(ADR(cbuf[from]), 5, VAL(UNSIGNEDLONG,len));
  455.    FOR i := 0 TO from-1 DO
  456.      IF cbuf[i] <> CPATTERN THEN
  457.        WriteMsg(i, len, CPATTERN,"*** cbuf[i=0..from-1]:");
  458.        RETURN;
  459.      END;
  460.    END;
  461.    FOR i := from TO from+len-1 DO
  462.      IF cbuf[i] <> 5C THEN
  463.        WriteMsg(i, len, 5C,"*** cbuf[i=from..from+len-1]:");
  464.        RETURN;
  465.      END;
  466.    END;
  467.    FOR i := from+len TO MAXCBUF DO
  468.      IF cbuf[i] <> CPATTERN THEN
  469.        WriteMsg(i, len, CPATTERN,"*** cbuf[i=from+len..MAXCBUF]:");
  470.        RETURN;
  471.      END;
  472.    END;
  473.  END;
  474.  ClearBusy;
  475.  WriteString("OK");
  476.  WriteLn;
  477. END tmemset;
  478.  
  479. (*---------------------------------------------------------------------------*)
  480.  
  481. PROCEDURE tmemmove ((* EIN/ -- *) REF proc    : ARRAY OF CHAR;
  482.                     (* EIN/ -- *)     from    : SIGNEDWORD;
  483.                     (* EIN/ -- *)     to      : SIGNEDWORD;
  484.                     (* EIN/ -- *)     maxlen  : SIGNEDWORD );
  485.  
  486. VAR __REG__ len       : SIGNEDWORD;
  487.     __REG__ i         : SIGNEDWORD;
  488.             high, low : SIGNEDWORD;
  489.             min, max  : SIGNEDWORD;
  490.             dist      : SIGNEDWORD;
  491.  
  492. PROCEDURE WriteMsg (i, len : SIGNEDWORD; exp : CHAR; REF msg : ARRAY OF CHAR);
  493. BEGIN
  494.  ClearBusy;
  495.  WriteLn;
  496.  WriteString(msg); WriteLn;
  497.  WriteString("from: "); WriteInt(INT(from), 0); WriteLn;
  498.  WriteString("  to: "); WriteInt(INT(to), 0); WriteLn;
  499.  WriteString(" len: "); WriteInt(INT(len), 0); WriteLn;
  500.  WriteString("cbuf["); WriteInt(INT(i), 0); WriteString("]: ");
  501.  WriteInt(INT(cbuf[i]),0); WriteString(" (expected: ");
  502.  WriteInt(INT(exp),0); Write(')');
  503.  WriteLn;
  504.  Read(ch);
  505. END WriteMsg;
  506.  
  507. BEGIN
  508.  WriteString(proc); Write(' ');
  509.  dist := ABS(from - to);
  510.  FOR len := 0 TO maxlen DO
  511.    Busy;
  512.    FOR i := 0 TO MAXCBUF DO
  513.      cbuf[i] := 0C;
  514.    END;
  515.    FOR i := from TO from+len-1 DO
  516.      cbuf[i] := CHR(i);
  517.    END;
  518.    memmove(ADR(cbuf[to]), ADR(cbuf[from]), VAL(UNSIGNEDLONG,len));
  519.    IF from <= to THEN
  520.      low  := from;
  521.      high := to;
  522.      min  := from;
  523.      (* Maximale Anzahl von Elementen, die noch im Quellbereich stehen *)
  524.      IF dist < len THEN
  525.        (* Zielbereich ueberlappt den oberen Teil des Quellbereichs,
  526.         * es sind noch soviele Elemente des Quellbereichs erhalten
  527.         * wie die beiden Bereich auseinander sind.
  528.         *)
  529.        max := dist;
  530.      ELSE
  531.        (* Keine Ueberlappung, also ist der volle Quellbereich erhalten *)
  532.        max := len;
  533.      END;
  534.    ELSE
  535.      low  := to;
  536.      high := from;
  537.      max  := len;
  538.      (* Kleinster Index, an dem noch Elemente des Quellbereichs stehen *)
  539.      IF dist < len THEN
  540.        (* Zielbereich ueberlappt den unteren Teil des Quellbereichs,
  541.         * erst nach dem Ende des Zielbereichs stehen die restlichen
  542.         * Elemente des Quellbereichs.
  543.         *)
  544.        min := to + len
  545.      ELSE
  546.        (* Keine Ueberlappung, also ist der volle Quellbereich erhalten *)
  547.        min := from;
  548.      END;
  549.    END;
  550.    FOR i := 0 TO low-1 DO
  551.      IF cbuf[i] <> 0C THEN
  552.        WriteMsg(i, len, 0C,"*** cbuf[i=0..low-1]:");
  553.        RETURN;
  554.      END;
  555.    END;
  556.    FOR i := min TO from+max-1 DO
  557.      (* Quellbereich (teilweise) erhalten? *)
  558.      IF cbuf[i] <> CHR(i) THEN
  559.        WriteMsg(i, len, CHR(i),"*** cbuf[i=min..from+max-1]:");
  560.        RETURN;
  561.      END;
  562.    END;
  563.    FOR i := low+len TO high-1 DO
  564.      IF cbuf[i] <> 0C THEN
  565.        WriteMsg(i, len, 0C,"*** cbuf[i=low+len..high-1]:");
  566.        RETURN;
  567.      END;
  568.    END;
  569.    FOR i := to TO to+len-1 DO
  570.      (* Enthaelt der Zielbereich den Quellbereich? *)
  571.      IF cbuf[i] <> CHR(from+i-to) THEN
  572.        WriteMsg(i, len, CHR(from+i-to),"*** cbuf[i=to..to+len-1]:");
  573.        RETURN;
  574.      END;
  575.    END;
  576.    FOR i := high+len TO MAXCBUF DO
  577.      IF cbuf[i] <> 0C THEN
  578.        WriteMsg(i, len, 0C,"*** cbuf[i=high+len..MAXCBUF]:");
  579.        RETURN;
  580.      END;
  581.    END;
  582.  END;
  583.  ClearBusy;
  584.  WriteString("OK");
  585.  WriteLn;
  586. END tmemmove;
  587.  
  588. (*---------------------------------------------------------------------------*)
  589.  
  590. PROCEDURE tltoa ((* EIN/ -- *) REF proc     : ARRAY OF CHAR;
  591.                  (* EIN/ -- *)     val      : UNSIGNEDLONG;
  592.                  (* EIN/ -- *)     base     : CARDINAL;
  593.                  (* EIN/ -- *)     signed   : BOOLEAN;
  594.                  (* EIN/ -- *) REF expected : ARRAY OF CHAR );
  595. BEGIN
  596.  IF signed THEN
  597.    ltoa(CAST(SIGNEDLONG,val), ADR(cbuf), base);
  598.  ELSE
  599.    ultoa(val, ADR(cbuf), base);
  600.  END;
  601.  IF NOT EQUAL(cbuf, expected) THEN
  602.    WriteString(proc);
  603.    WriteString(": expected: '");
  604.    WriteString(expected);
  605.    WriteString("', got: '");
  606.    WriteString(cbuf);
  607.    WriteString("'.");
  608.    WriteLn;
  609.    ERROR := TRUE;
  610.  END;
  611. END tltoa;
  612.  
  613. (*---------------------------------------------------------------------------*)
  614.  
  615. PROCEDURE tqsort ((* EIN/ -- *) REF proc   : ARRAY OF CHAR;
  616.                   (* EIN/ -- *)     maxlen : SIGNEDWORD;
  617.                   (* EIN/ -- *)     fill   : FillProc   );
  618.  
  619. VAR __REG__ len : SIGNEDWORD;
  620.     __REG__ i   : SIGNEDWORD;
  621.  
  622. PROCEDURE WriteMsg (i, len : SIGNEDWORD; REF msg : ARRAY OF CHAR);
  623. BEGIN
  624.  ClearBusy;
  625.  WriteLn;
  626.  WriteString(msg); WriteLn;
  627.  WriteString("BEFORE: "); WriteInt(BEFORE, 0); WriteLn;
  628.  WriteString(" AFTER: "); WriteInt(AFTER, 0); WriteLn;
  629.  WriteString("   len: "); WriteInt(len, 0); WriteLn;
  630.  WriteString("lbuf["); WriteInt(i, 0); WriteString("]: ");
  631.  WriteInt(INT(lbuf[i]), 0); WriteString(" (expected: ");
  632.  WriteInt(INT(lbuf2[i]), 0); Write(')');
  633.  WriteLn;
  634.  Read(ch);
  635. END WriteMsg;
  636.  
  637. BEGIN
  638.  WriteString(proc); Write(' ');
  639.  FOR len := 0 TO maxlen DO
  640.    Busy;
  641.    FOR i := 0 TO BEFORE-1 DO
  642.      lbuf[i] := VAL(UNSIGNEDLONG,i);
  643.    END;
  644.    FOR i := 0 TO len - 1 DO
  645.      lbuf[i+BEFORE] := fill(i, len);
  646.    END;
  647.    FOR i:=0 TO AFTER-1 DO
  648.      lbuf[i+len+BEFORE] := VAL(UNSIGNEDLONG,i);
  649.    END;
  650.    FOR i := BEFORE+len+AFTER TO MAXLBUF DO
  651.      lbuf[i] := LPATTERN;
  652.    END;
  653.    lbuf2 := lbuf;
  654.    SlowSort(BEFORE, BEFORE+len-1, lbuf2);
  655.    qsort(ADR(lbuf[BEFORE]), VAL(UNSIGNEDLONG,len), VAL(UNSIGNEDLONG,TSIZE(UNSIGNEDLONG)), cmp);
  656.    FOR i:=0 TO BEFORE-1 DO
  657.      IF lbuf[i] <> VAL(UNSIGNEDLONG,i) THEN
  658.        WriteMsg(i, len, "*** lbuf[i=0..BEFORE-1]:");
  659.        RETURN;
  660.      END;
  661.    END;
  662.    FOR i:=BEFORE TO BEFORE+len-1 DO
  663.      IF lbuf[i] <> lbuf2[i] THEN
  664.        WriteMsg(i, len, "*** lbuf[i=BEFORE..BEFORE+len-1]:");
  665.        RETURN;
  666.      END;
  667.    END;
  668.    FOR i:=BEFORE+len TO BEFORE+len+AFTER-1 DO
  669.      IF lbuf[i] <> VAL(UNSIGNEDLONG,i-len-BEFORE) THEN
  670.        WriteMsg(i, len, "*** lbuf[i=BEFORE+len..BEFORE+len+AFTER-1]:");
  671.        RETURN;
  672.      END;
  673.    END;
  674.    FOR i := BEFORE+len+AFTER TO MAXLBUF DO
  675.      IF lbuf[i] <> LPATTERN THEN
  676.        WriteMsg(i, len, "*** lbuf[i=BEFORE+len+AFTER..MAXLBUF]:");
  677.        RETURN;
  678.      END;
  679.    END;
  680.  END;
  681.  ClearBusy;
  682.  WriteString("OK");
  683.  WriteLn;
  684. END tqsort;
  685.  
  686. (*---------------------------------------------------------------------------*)
  687.  
  688. PROCEDURE initsearch;
  689. VAR __REG__ i : SIGNEDWORD;
  690. BEGIN
  691.  FOR i:=0 TO BEFORE-1 DO
  692.    lbuf[i] := 0;
  693.  END;
  694.  FOR i:=BEFORE TO BEFORE+MAXLEN-1 DO
  695.    lbuf[i] := VAL(UNSIGNEDLONG,i+i);
  696.  END;
  697.  FOR i:=BEFORE+MAXLEN TO BEFORE+MAXLEN+AFTER-1 DO
  698.    lbuf[i] := (BEFORE+MAXLEN)*2+AFTER;
  699.  END;
  700. END initsearch;
  701.  
  702. (*---------------------------------------------------------------------------*)
  703.  
  704. PROCEDURE tsearch ((* EIN/ -- *) REF proc     : ARRAY OF CHAR;
  705.                    (* EIN/ -- *)     bin      : BOOLEAN;
  706.                    (* EIN/ -- *)     element  : UNSIGNEDLONG;
  707.                    (* EIN/ -- *)     expected : ADDRESS      );
  708.  
  709. VAR place : ADDRESS;
  710.  
  711. BEGIN
  712.  IF bin THEN
  713.    place := bsearch(ADR(element), ADR(lbuf[BEFORE]), MAXLEN, 4, cmp);
  714.  ELSE
  715.    place := lfind(ADR(element), ADR(lbuf[BEFORE]), MAXLEN, 4, cmp);
  716.  END;
  717.  IF place <> expected THEN
  718.    ultoa(CAST(UNSIGNEDLONG,expected), ADR(cbuf), 16);
  719.    WriteString(proc);
  720.    WriteString(": expected: '$");
  721.    WriteString(cbuf);
  722.    WriteString("', got: '$");
  723.    ultoa(CAST(UNSIGNEDLONG,place), ADR(cbuf), 16);
  724.    WriteString(cbuf);
  725.    WriteString("'.");
  726.    WriteLn;
  727.    ERROR := TRUE;
  728.  END;
  729. END tsearch;
  730.  
  731. (*---------------------------------------------------------------------------*)
  732.  
  733. PROCEDURE action;
  734. BEGIN
  735.  WriteString("action ");
  736.  longjmp(jmpbuf, LONGJUMPVAL);
  737. END action;
  738.  
  739. (*---------------------------------------------------------------------------*)
  740.  
  741. PROCEDURE tjump;
  742.  
  743. VAR localvar : UNSIGNEDLONG;
  744.     jumped   : BOOLEAN;
  745.     val      : INTEGER;
  746.  
  747. BEGIN
  748.  jumped   := FALSE;
  749.  localvar := LOCALVAL;
  750.  
  751.  val := setjmp(jmpbuf);
  752.  IF val = 0 THEN
  753.    WriteString("setjmp ");
  754.    action;
  755.  ELSE
  756.    WriteString("longjmp ");
  757.    jumped := TRUE;
  758.  END;
  759.  IF    jumped                   (* Ruecksprungadresse OK ? *)
  760.    AND (val       = LONGJUMPVAL)(* Funktionswert OK ? *)
  761.    AND (globalvar = GLOBALVAL)  (* Zeiger auf globale Var. OK ? *)
  762.    AND (localvar  = LOCALVAL)   (* Zeiger auf lokale Var. OK ? *)
  763.  THEN
  764.    WriteString("OK");
  765.  ELSE
  766.    (* Wohl eher Absturz... *)
  767.    WriteString("**failed**");
  768.  END;
  769.  WriteLn;
  770. END tjump;
  771.  
  772. (*---------------------------------------------------------------------------*)
  773.  
  774. PROCEDURE talloc;
  775.  
  776. CONST ALLOCSIZE = 256;
  777.  
  778. VAR sp1   : ADDRESS;
  779.     sp2   : ADDRESS;
  780.     old1  : ADDRESS;
  781.     old2  : ADDRESS;
  782.     res1  : ADDRESS;
  783.     res2  : ADDRESS;
  784.  
  785.  
  786. BEGIN
  787.  WriteString("memalloc: ");
  788.  GETREGADR(15, sp1);
  789.  memalloc(ALLOCSIZE, old1, res1);
  790.  ERROR := (sp1 <> old1) OR (SUBADR(sp1, ALLOCSIZE) <> res1);
  791.  GETREGADR(15, sp2);
  792.  ERROR := ERROR OR (sp2 <> res1);
  793.  
  794.  memalloc(ALLOCSIZE, old2, res2);
  795.  ERROR := ERROR OR (sp2 <> old2) OR (SUBADR(sp2, ALLOCSIZE) <> res2);
  796.  GETREGADR(15, sp2);
  797.  ERROR := ERROR OR (sp2 <> res2);
  798.  IF ERROR THEN
  799.    WriteString("**failed**");
  800.  ELSE
  801.    WriteString("OK"); WriteLn;
  802.    WriteString("memdealloc: ");
  803.    memdealloc(old1);
  804.    GETREGADR(15, sp2);
  805.    IF sp1 <> sp2 THEN
  806.      WriteString("**failed**");
  807.    ELSE
  808.      WriteString("OK");
  809.    END;
  810.    WriteLn;
  811.  END;
  812.  WriteLn;
  813. END talloc;
  814.  
  815. (*===========================================================================*)
  816.  
  817. BEGIN
  818.  BusyBuf   := "-\|/";
  819.  BusyIdx   := 0;
  820.  globalvar := GLOBALVAL;
  821.  
  822.  
  823.  tmemmove("memmove[SRC < DST, EVEN->EVEN]: ", 200 ,230, 60);
  824.  tmemmove("memmove[SRC < DST, EVEN->ODD]: ", 200, 231, 60);
  825.  tmemmove("memmove[SRC < DST, ODD->EVEN]: ", 201, 230, 60);
  826.  tmemmove("memmove[SRC < DST, ODD->ODD]: ", 201, 231, 60);
  827.  tmemmove("memmove[SRC > DST, EVEN->EVEN]: ", 230, 200, 60);
  828.  tmemmove("memmove[SRC > DST, EVEN->ODD]: ", 230, 201, 60);
  829.  tmemmove("memmove[SRC > DST, ODD->EVEN]: ", 231, 200, 60);
  830.  tmemmove("memmove[SRC > DST, ODD->ODD]: ", 231, 201, 60);
  831.  
  832.  tmemset("memset[EVEN]: ", 200, 60);
  833.  tmemset("memset[ODD]: ", 201, 60);
  834.  
  835.  tmemswap("memswap[EVEN -> EVEN]: ", 200, 300, 60);
  836.  tmemswap("memswap[EVEN -> ODD]: ", 200, 301, 60);
  837.  tmemswap("memswap[ODD -> EVEN]: ", 201, 300, 60);
  838.  tmemswap("memswap[ODD -> ODD]: ", 201, 301, 60);
  839.  
  840.  tmemchr("memchr: ");
  841.  
  842.  tmemcmp("memcmp[EVEN -> EVEN]: ", 200, 300, 60);
  843.  tmemcmp("memcmp[EVEN -> ODD]: ", 200, 301, 60);
  844.  tmemcmp("memcmp[ODD -> EVEN]: ", 201, 300, 60);
  845.  tmemcmp("memcmp[ODD -> ODD]: ", 201, 301, 60);
  846.  
  847.  tqsort("qsort[INC]: ", MAXLEN, fillinc); (* bereits aufsteigend sortiertes Feld *)
  848.  tqsort("qsort[DEC]: ", MAXLEN, filldec); (* bereits absteigend sortiertes Feld *)
  849.  tqsort("qsort[RND]: ", MAXLEN, fillrnd); (* Zufallszahlen *)
  850.  
  851.  
  852.  ERROR := FALSE;
  853.  tltoa("ltoa", 0, 10, TRUE, "0");
  854.  tltoa("ltoa", MAXLINT, 10, TRUE, "2147483647");
  855.  tltoa("ltoa", MAXLINT, 16, TRUE, "7FFFFFFF");
  856.  tltoa("ltoa", MINLINT, 10, TRUE, "-2147483648");
  857.  tltoa("ltoa", MINLINT, 16, TRUE, "80000000");
  858.  tltoa("ltoa", MAXLCARD, 10, TRUE, "-1");
  859.  tltoa("ltoa", MAXLCARD, 16, TRUE, "FFFFFFFF");
  860.  OK("ltoa");
  861.  
  862.  ERROR := FALSE;
  863.  tltoa("ultoa", 0, 10, FALSE, "0");
  864.  tltoa("ultoa", MAXLINT, 10, FALSE, "2147483647");
  865.  tltoa("ultoa", MAXLINT, 16, FALSE, "7FFFFFFF");
  866.  tltoa("ultoa", MINLINT, 10, FALSE, "2147483648");
  867.  tltoa("ultoa", MINLINT, 16, FALSE, "80000000");
  868.  tltoa("ultoa", MAXLCARD, 10, FALSE, "4294967295");
  869.  tltoa("ultoa", MAXLCARD, 16, FALSE, "FFFFFFFF");
  870.  OK("ultoa");
  871.  
  872.  initsearch;
  873.  ERROR := FALSE;
  874.  tsearch("bsearch", TRUE, 0, NULL); (* vor dem Feld *)
  875.  tsearch("bsearch", TRUE, (BEFORE+5)*2, ADR(lbuf[BEFORE+5])); (* gerade Zahl *)
  876.  tsearch("bsearch", TRUE, (BEFORE+5)*2+1, NULL); (* ungerade Zahl *)
  877.  tsearch("bsearch", TRUE, (BEFORE+MAXLEN)*2+AFTER, NULL); (* hinter dem Feld *)
  878.  OK("bsearch");
  879.  
  880.  ERROR := FALSE;
  881.  tsearch("lfind", FALSE, 0, NULL); (* vor dem Feld *)
  882.  tsearch("lfind", FALSE, (BEFORE+5)*2, ADR(lbuf[BEFORE+5])); (* gerade Zahl *)
  883.  tsearch("lfind", FALSE, (BEFORE+5)*2+1, NULL); (* ungerade Zahl *)
  884.  tsearch("lfind", FALSE, (BEFORE+MAXLEN)*2+AFTER, NULL); (* hinter dem Feld *)
  885.  OK("lfind");
  886.  
  887.  tjump;
  888.  
  889.  talloc;
  890.  
  891.  Read(ch);
  892. END Tlib.
  893.