development/compilers/freepascal/rtl/m68k/set.inc

   1 {
   2     $Id$
   3     This file is part of the Free Pascal run time library.
   4     Copyright (c) 1999-2000 by Carl-Eric Codere,
   5     member of the Free Pascal development team.
   6
   7     See the file COPYING.FPC, included in this distribution,
   8     for details about the copyright.
   9
  10     This program is distributed in the hope that it will be useful,
  11     but WITHOUT ANY WARRANTY; without even the implied warranty of
  12     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
  13
  14  **********************************************************************}
  15 {*************************************************************************}
  16 {  Converted by Carl Eric Codere                                          }
  17 {*************************************************************************}
  18 {  This inc. implements low-level set operations for the motorola         }
  19 {  68000 familiy of processors.                                           }
  20 {  Based on original code bt Florian Kl„mpfl  for the 80x86.              }
  21 {*************************************************************************}
  22
  23
  24   { add the element b to the set pointed by p }
  25   { On entry                                   }
  26   {  a0    = pointer to set                    }
  27   {  d0.b  = element to add to the set         }
  28   { Registers destroyed: d0,a1,d6              }
  29   procedure do_set;assembler;
  30   asm
  31     XDEF SET_SET_BYTE
  32           move.l  d0,d6
  33           { correct long position: }
  34           {   -> (value div 32)*4 = longint }
  35           {       (value shr 5)*shl 2       }
  36           lsr.l  #5,d6
  37           lsl.l  #2,d6
  38           adda.l d6,a0       { correct offset from start address of set }
  39
  40           move.l d0,d6       { bit is now in here                       }
  41           andi.l #31,d0      { bit number is =  value mod 32            }
  42
  43           { now bit set the value }
  44           move.l  (a0),d0              { we must put bits into register }
  45           bset.l  d6,d0                { otherwise btst will be a byte  }
  46           { put result in carry flag } { operation.                     }
  47           bne    @LDOSET1
  48           andi.b #$fe,ccr              { clear carry flag }
  49           bra    @LDOSET2
  50        @LDOSET1:
  51           ori.b  #$01,ccr              { set carry flag   }
  52        @LDOSET2:
  53           move.l  d0,(a0)              { restore the value at that location }
  54                                        { of the set.                        }
  55     end;
  56
  57     { Finds an element in a set }
  58     { a0   = address of set                                 }
  59     { d0.b = value to compare with                          }
  60     { CARRY SET IF FOUND ON EXIT                            }
  61     { Registers destroyed: d0,a0,d6                         }
  62   procedure do_in; assembler;
  63   { Returns Carry set then = in set , otherwise carry is cleared }
  64   {         (D0)                                                 }
  65   asm
  66        XDEF SET_IN_BYTE
  67           move.l  d0,d6
  68           { correct long position: }
  69           {   -> (value div 32)*4 = longint }
  70           {       (value shr 5)*shl 2       }
  71           lsr.l  #5,d6
  72           lsl.l  #2,d6
  73           adda.l d6,a0       { correct offset from start address of set }
  74
  75           move.l d0,d6       { bit is now in here                       }
  76           andi.l #31,d0      { bit number is =  value mod 32            }
  77
  78           move.l  (a0),d0              { we must put bits into register }
  79           btst.l  d6,d0                { otherwise btst will be a byte  }
  80           { put result in carry flag } { operation.                     }
  81           bne    @LDOIN1
  82           andi.b #$fe,ccr              { clear carry flag }
  83           bra    @LDOIN2
  84        @LDOIN1:
  85           ori.b  #$01,ccr             { set carry flag   }
  86        @LDOIN2:
  87     end;
  88
  89
  90
  91    { vereinigt set1 und set2 und speichert das Ergebnis in dest }
  92
  93    procedure add_sets(set1,set2,dest : pointer);[public,alias: 'SET_ADD_SETS'];
  94    {  PSEUDO-CODE:
  95        type
  96          destination = array[1..8] of longint;
  97         for i:=1 to 8 do
  98            destination(dest^)[i] := destination(set1^)[i] OR destination(set2^)[i];
  99     }
 100     begin
 101         asm
 102            { saved used register }
 103            move.l a2,-(sp)
 104
 105            move.l 8(a6),a0
 106            move.l 12(a6),a1
 107            move.l 16(a6),a2
 108
 109            move.l #32,d6
 110
 111        @LMADDSETS1:
 112
 113            move.b  (a0)+,d0
 114            or.b    (a1)+,d0
 115            move.b  d0,(a2)+
 116            subq.b  #1,d6
 117            bne     @LMADDSETS1
 118            { restore register }
 119            move.l  a2,(sp)+
 120         end ['d0','d6','a0','a1'];
 121      end;
 122
 123    { computes the symetric diff from set1 to set2    }
 124    { result in dest                                  }
 125
 126    procedure sym_sub_sets(set1,set2,dest : pointer);[public,alias: 'SET_SYMDIF_SETS'];
 127
 128      begin
 129         asm
 130            { saved used register }
 131            move.l a2,-(sp)
 132
 133            move.l 8(a6),a0
 134            move.l 12(a6),a1
 135            move.l 16(a6),a2
 136
 137            move.l #32,d6
 138
 139        @LMADDSETS1:
 140
 141            move.b  (a0)+,d0
 142            move.b  (a1)+,d1
 143            eor.b   d1,d0
 144            move.b  d0,(a2)+
 145            subq.b  #1,d6
 146            bne     @LMADDSETS1
 147            { restore register }
 148            move.l  a2,(sp)+
 149         end;
 150      end;
 151
 152
 153   { bad implementation, but it's very seldom used }
 154   procedure do_set(p : pointer;l,h : byte);[public,alias: 'SET_SET_RANGE'];
 155
 156     begin
 157        asm
 158           move.b h,d0
 159        @LSetRLoop:
 160           cmp.b  l,d0
 161           blt    @Lend
 162           move.w d0,-(sp)
 163           { adjust value to correct endian }
 164           lsl.w  #8,d0
 165           pea    p
 166           jsr    SET_SET_BYTE
 167           sub.b  #1,d0
 168           bra    @LSetRLoop
 169        @Lend:
 170        end;
 171     end;
 172
 173
 174    { bildet den Durchschnitt von set1 und set2 }
 175    { und speichert das Ergebnis in dest        }
 176
 177    procedure mul_sets(set1,set2,dest : pointer);[public,alias: 'SET_MUL_SETS'];
 178    {  type
 179          larray = array[0..7] of longint;
 180         for i:=0 to 7 do
 181            larray(dest^)[i] := larray(set1^)[i] AND larray(set2^)[i];
 182    }
 183    begin
 184         asm
 185            { saved used register }
 186            move.l a2,-(sp)
 187            move.l 8(a6),a0
 188            move.l 12(a6),a1
 189            move.l 16(a6),a2
 190
 191            move.l #32,d6
 192
 193        @LMMULSETS1:
 194
 195            move.b  (a0)+,d0
 196            and.b   (a1)+,d0
 197            move.b  d0,(a2)+
 198            subq.b  #1,d6
 199            bne     @LMMULSETS1
 200            { restore register }
 201            move.l  a2,(sp)+
 202         end ['d0','d6','a0','a1'];
 203      end;
 204
 205
 206    { bildet die Differenz von set1 und set2 }
 207    { und speichert das Ergebnis in dest     }
 208
 209    procedure sub_sets(set1,set2,dest : pointer);[public,alias: 'SET_SUB_SETS'];
 210    {  type
 211          larray = array[0..7] of longint;
 212      begin
 213         for i:=0 to 7 do
 214            larray(dest^)[i] := larray(set1^)[i] AND NOT (larray(set2^)[i]);
 215      end;
 216      }
 217    begin
 218         asm
 219            { saved used register }
 220            move.l a2,-(sp)
 221            move.l 8(a6),a0
 222            move.l 12(a6),a1
 223            move.l 16(a6),a2
 224
 225            move.l #32,d6
 226
 227        @LSUBSETS1:
 228            move.b  (a0)+,d0
 229            move.b  (a1)+,d1
 230            not.b   d1
 231            and.b   d1,d0
 232            move.b  d0,(a2)+
 233            sub.b   #1,d6
 234            bne     @LSUBSETS1
 235            { restore register }
 236            move.l  a2,(sp)+
 237         end ['d0','d1','d6','a0','a1'];
 238      end;
 239
 240    { compare both sets }
 241    { compares set1 and set2                             }
 242    { zeroflag is set if they are equal                  }
 243    { on entry :  a0 = pointer to first set              }
 244    {          :  a1 = pointer to second set             }
 245    procedure comp_sets; assembler;
 246
 247         asm
 248          XDEF SET_COMP_SETS
 249            move.l #32,d6
 250        @LMCOMPSETS1:
 251            move.b (a0)+,d0
 252            move.b (a1),d1
 253            cmp.b  d1,d0
 254            bne    @LMCOMPSETEND
 255            adda.l #1,a1
 256            sub.b  #1,d6
 257            bne    @LMCOMPSETS1
 258            { we are here only if the two sets are equal         }
 259            { we have zero flag set, and that what is expected   }
 260            cmp.b  d0,d0
 261        @LMCOMPSETEND:
 262      end;
 263
 264   procedure do_set(p : pointer;b : word);[public,alias: 'SET_SET_WORD'];
 265   begin
 266      asm
 267           move.l 8(a6),a0
 268           move.w 12(a6),d6
 269           andi.l #$fff8,d6
 270           lsl.l  #3,d6
 271           adda.l d6,a0
 272           move.b 12(a6),d6
 273           andi.l #7,d6
 274
 275           move.l  (a0),d0              { we must put bits into register }
 276           btst.l  d6,d0                { otherwise btst will be a byte  }
 277           { put result in carry flag } { operation.                     }
 278           bne    @LBIGDOSET1
 279           andi.b #$fe,ccr              { clear carry flag }
 280           bra    @LBIGDOSET2
 281        @LBIGDOSET1:
 282           ori.b  #$01,ccr              { set carry flag   }
 283        @LBIGDOSET2:
 284        end ['d0','a0','d6'];
 285   end;
 286
 287   { testet, ob das Element b in der Menge p vorhanden ist }
 288   { und setzt das Carryflag entsprechend                  }
 289
 290   procedure do_in(p : pointer;b : word);[public,alias: 'SET_IN_WORD'];
 291     begin
 292       asm
 293           move.l  8(a6),a0
 294           move.w  12(a6),d6
 295           andi.l  #$fff8,d6
 296           lsl.l   #3,d6
 297           adda.l  d6,a0       { correct offset from start address of set }
 298
 299           move.b 12(a6),d6
 300           andi.l #7,d6
 301
 302           move.l  (a0),d0              { we must put bits into register }
 303           btst.l  d6,d0                { otherwise btst will be a byte  }
 304           { put result in carry flag } { operation.                     }
 305           bne    @LBIGDOIN1
 306           andi.b #$fe,ccr              { clear carry flag }
 307           bra    @LBIGDOIN2
 308        @LBIGDOIN1:
 309           ori.b  #$01,ccr              { set carry flag   }
 310        @LBIGDOIN2:
 311        end ['d0','a0','d6'];
 312     end;
 313
 314
 315    { vereinigt set1 und set2 und speichert das Ergebnis in dest }
 316    { size is the number of bytes in the set }
 317
 318    procedure add_sets(set1,set2,dest : pointer;size : longint);[public,alias: 'SET_ADD_SETS_SIZE'];
 319     begin
 320         asm
 321            { saved used register }
 322            move.l a2,-(sp)
 323            move.l 8(a6),a0
 324            move.l 12(a6),a1
 325            move.l 16(a6),a2
 326
 327            move.l 20(a6),d6
 328
 329        @LBIGMADDSETS1:
 330
 331            move.l  (a0)+,d0
 332            or.l    (a1)+,d0
 333            move.l  d0,(a2)+
 334            subq.l  #4,d6
 335            bne     @LBIGMADDSETS1
 336            { restore register }
 337            move.l  a2,(sp)+
 338         end ['d0','d6','a0','a1'];
 339      end;
 340
 341
 342    procedure mul_sets(set1,set2,dest : pointer;size : longint);[public,alias: 'SET_MUL_SETS_SIZE'];
 343    { bildet den Durchschnitt von set1 und set2 }
 344    { und speichert das Ergebnis in dest        }
 345    { size is the number of bytes in the set }
 346    begin
 347         asm
 348            { saved used register }
 349            move.l a2,-(sp)
 350            move.l 8(a6),a0
 351            move.l 12(a6),a1
 352            move.l 16(a6),a2
 353
 354            move.l 20(a6),d6
 355
 356        @LBIGMMULSETS1:
 357
 358            move.l  (a0)+,d0
 359            and.l    (a1)+,d0
 360            move.l  d0,(a2)+
 361            subq.l  #4,d6
 362            bne     @LBIGMMULSETS1
 363            { restore register }
 364            move.l  a2,(sp)+
 365         end ['d0','d6','a0','a1'];
 366      end;
 367
 368
 369    { bildet die Differenz von set1 und set2 }
 370    { und speichert das Ergebnis in dest     }
 371    { size is the number of bytes in the set }
 372
 373    procedure sub_sets(set1,set2,dest : pointer;size : longint);[public,alias: 'SET_SUB_SETS_SIZE'];
 374    begin
 375         asm
 376            { saved used register }
 377            move.l a2,-(sp)
 378            move.l 8(a6),a0
 379            move.l 12(a6),a1
 380            move.l 16(a6),a2
 381
 382            move.l 20(a6),d6
 383
 384        @BIGSUBSETS1:
 385
 386            move.l  (a0)+,d0
 387            not.l   d0
 388            and.l   (a1)+,d0
 389            move.l  d0,(a2)+
 390            subq.l  #4,d6
 391            bne     @BIGSUBSETS1
 392            { restore register }
 393            move.l  a2,(sp)+
 394         end ['d0','d6','a0','a1'];
 395      end;
 396
 397
 398    { vergleicht Mengen und setzt die Flags entsprechend }
 399
 400    procedure comp_sets(set1,set2 : pointer;size : longint);[public,alias: 'SET_COMP_SETS_SIZE'];
 401
 402
 403      begin
 404         asm
 405            move.l 8(a6),a0  { set1 - esi}
 406            move.l 12(a6),a1 { set2 - edi }
 407            move.l 16(a6),d6
 408        @MCOMPSETS1:
 409            move.l (a0)+,d0
 410            move.l (a1),d1
 411            cmp.l  d1,d0
 412            bne  @BIGMCOMPSETEND
 413            add.l #4,a1
 414            subq.l #1,d6
 415            bne  @MCOMPSETS1
 416            { we are here only if the two sets are equal         }
 417            { we have zero flag set, and that what is expected   }
 418            cmp.l d0,d0
 419        @BIGMCOMPSETEND:
 420         end;
 421      end;
 422
 423 {
 424   $Log$
 425   Revision 1.1  2002/02/19 08:25:43  sasu
 426   Initial revision
 427
 428   Revision 1.1  2000/07/13 06:30:57  michael
 429   + Initial import
 430
 431   Revision 1.8  2000/01/07 16:41:43  daniel
 432     * copyright 2000
 433
 434   Revision 1.7  2000/01/07 16:32:29  daniel
 435     * copyright 2000 added
 436
 437   Revision 1.6  1998/07/30 12:16:29  carl
 438     * set_sub_sets bugfix, was not using correct operation
 439
 440   Revision 1.5  1998/07/01 14:27:13  carl
 441     * set_set and set_in bugfix
 442
 443   Revision 1.2  1998/03/27 23:47:35  carl
 444     * bugfix of FLAGS as return values for SET_IN_BYTE and SET_SET_BYTE
 445
 446   Revision 1.4  1998/01/26 12:01:42  michael
 447   + Added log at the end
 448
 449
 450
 451   Working file: rtl/m68k/set.inc
 452   description:
 453   ----------------------------
 454   revision 1.3
 455   date: 1998/01/05 00:34:50;  author: carl;  state: Exp;  lines: +349 -350
 456   * Silly syntax errors fixed.
 457   ----------------------------
 458   revision 1.2
 459   date: 1997/12/01 12:37:22;  author: michael;  state: Exp;  lines: +14 -0
 460   + added copyright reference in header.
 461   ----------------------------
 462   revision 1.1
 463   date: 1997/11/28 16:51:20;  author: carl;  state: Exp;
 464   + set routines for m68k.
 465   =============================================================================
 466 }