home *** CD-ROM | disk | FTP | other *** search
/ norge.freeshell.org (192.94.73.8) / 192.94.73.8.tar / 192.94.73.8 / pub / computers / cpm / alphatronic / PASCALZ4.ZIP / D3 / SETCON.SRC < prev    next >
Text File  |  1999-04-05  |  4KB  |  140 lines
  1. ;SUBROUTINES FOR SET CONSTRUCTION,UNION,MEMBERSHIP,AND INTERSECTION
  2. ;
  3.     NAME SETCON
  4.     ENTRY .CONSET,.RCSET,.UNION,.INN,.INSECT
  5.     EXT .SAVREG
  6.  
  7. ;
  8. ; CONSET : A SUBROUTINE THAT SETS THE RELEVANT BIT(S) IN A SET TO INDICATE
  9. ;    THE PRESENCE OF THAT ELEMENT IN THE SET.
  10. ;
  11. ;
  12. ;    IF THE REPETITION COUNT IS NEGATIVE, IGNORE IT AND RETURN IMMEDIATELY
  13. ;        NO BITS ARE SET IN THIS CASE.
  14. ;
  15. .RCSET:
  16. ; IS THE REPETITION COUNT NEGATIVE ?
  17.     MOV    A,L    ; HIGH BOUND OF RANGE
  18.     SUB    E    ; LESS LOW BOUND OF RANGE
  19.     JRZ    LEGRNG    ; IF NON-ZERO AND CARRY FLAG SET -- YES
  20.     RC
  21. LEGRNG:    INR    A    ; CORRECT RANGE
  22.     MOV    C,A    ; SAVE IT IN C REG
  23.     JR    TOPSET
  24.  
  25. ; DOING ONE ELEMENT
  26. .CONSET: MVI    C,1    ; INDICATE A SINGLE ELEMENT, NOT A RANGE
  27. TOPSET:    LXI    H,33    ; ALL SETS ARE 32 BYTES
  28.     DAD    S    ; HL -> FIRST BYTE OF THE SET
  29.     MOV    A,E    ; SAVE VALUE IN A
  30.     SRLR    E    ;; DE = VALUE
  31.     SRLR    E
  32.     SRLR    E    ;  DE = NUMBER OF BYTES OFFSET FROM START OF SET
  33.     ORA    A    ; CLEAR CARRY, SAVE VALUE
  34.     DSBC    D    ;; HL -> BYTE ON STACK
  35.     ANI    7    ; POSITION WITHIN BYTE
  36.     MVI    E,1    ;  START WITH BIT 0
  37. ;    CPI    0    ;; IS IT BIT 0 ? ( ZERO FLAG SET/CLEARED BY ANI )
  38.     JRZ    SINIT    ;; YES -- DONE
  39.     MOV    B,A    ;  B = BIT POSITION
  40. SETBIT:    SLAR    E    ;; ROTATE TO THE CORRECT BIT
  41.     DJNZ    SETBIT
  42. SINIT:    MOV    B,C    ;; GET RANGE 
  43.     MOV    A,M    ;; GET BYTE IN ACC
  44. RANGE:    ORA    E    ;; SET BIT
  45.     SLAR    E    ;; GO TO THE NEXT BIT
  46.     JRNC    NOOVER    ;;
  47.     MOV    M,A    ;; IF OVERFLOW, SAVE BYTE AND
  48.     MVI    E,1    ;  START AGAIN WITH BIT 0 OF THE NEXT BYTE
  49.     DCX    H    ;;
  50.     MOV    A,M
  51. NOOVER:    DJNZ    RANGE
  52.     MOV    M,A    ;; SAVE BYTE
  53.     XRA    A
  54.     RET
  55.  
  56. ; UNION : A ROUTINE THAT TAKES THE UNION OF TWO SETS ON THE STACK AND
  57. ;    STORES IT IN THE FIRST SET -- THE ONE AT THE HIGHER LOCATION ON
  58. ;    THE STACK.
  59. ;
  60. ;
  61. .UNION:
  62.     CALL    .SAVREG    ; SET UP POINTERS
  63.     ; HL -> START OF FIRST SET
  64.     ; DE -> START OF SECOND SET
  65. ORBIT:    MOV    A,M    ;; GET BYTE FROM 2ND SET
  66.     XCHG
  67.     ORA    M    ;; OR WITH BYTE FROM 1ST SET
  68.     XCHG
  69.     MOV    M,A    ;; SAVE IT
  70.     DCX    H    ; GO ON TO NEXT BYTE
  71.     DCX    D
  72.     DJNZ    ORBIT
  73.     POP    D    ; DE = RETURN ADDRESS
  74.     LXI    H,32    ; ALL SETS ARE 32 BYTES
  75.     DAD    S    ;; REMOVE THE 2ND SET FROM THE STACK
  76.     SPHL
  77.     XCHG        ; HL = RETURN ADDRESS
  78.     XRA    A
  79.     PCHL
  80.  
  81.  
  82. ; INN : A ROUTINE TO TEST FOR THE MEMBERSHIP OF AN ELEMENT IN A SET.
  83. ;
  84. ;
  85. .INN:    LXI    H,34
  86.     DAD    S    ;; POINT TO VAR - ABOVE RET. ADDR. AND 32 BYTE SET
  87.     MOV    B,A
  88.     MOV    C,M
  89.     MOV    A,C    ; A AND C REGS CONTAIN THE VALUE OF THE ELEMENT
  90.     DCX    H    ;; HL -> FIRST BYTE OF SET
  91.     SRLR    C    ;; CALCULATE THE LOCATION IN THE SET
  92.             ;   OF THE ELEMENT
  93.     SRLR    C
  94.     SRLR    C
  95.     ORA    A    ;; CLEAR CARRY - SAVE VALUE IN A
  96.     DSBC    B    ;; POINT TO RELEVANT BYTE IN SET
  97.     ANI    7
  98.     MOV    B,A    ;; GET POSITION WITHIN SET 
  99.     MVI    A,1    ;  START WITH BIT 0 IN THE BYTE
  100.     JRZ    SET2    ;; IF ZERO THEN DONE ( ZERO FLAG SET/CLEARED BY ANI )
  101. SET1:    ADD    A    ;; ROTATE TO CORRECT BIT POSITION
  102.     DJNZ    SET1
  103. SET2:    ANA    M    ;; SEE IF BIT IS SET
  104.     POP    D    ; RETURN ADDRESS
  105.     LXI    H,34
  106.     DAD    S    ; REMOVE SET ( 32 BYTES ) AND VARIABLE
  107.     SPHL
  108.     XCHG        ; RETURN ADDRESS -> HL
  109.     JRZ    NOTIN    ;; IF ZERO THEN NOT IN SET( SET/CLEARED BY ANA )
  110.     STC        ;;IS IN THE SET
  111. NOTIN:    MVI    A,0
  112.     PCHL
  113.  
  114.  
  115. ;
  116. ; INSECT : A ROUTINE TO TAKE THE INTERSECTION OF TWO SETS ON THE STACK AND
  117. ;    STORE THE RESULT IN THE FIRST. INTERSECTION IS EQUIVALENT TO THE LOGICAL
  118. ;    AND OF TWO SETS.
  119.  
  120. ;
  121. .INSECT:
  122.     CALL    .SAVREG
  123. ;    HL -> FIRST SET
  124. ;    DE -> SECOND SET
  125. ANDBIT:
  126.     LDAX    D
  127.     ANA    M
  128.     MOV    M,A
  129.     DCX    H
  130.     DCX    D
  131.     DJNZ    ANDBIT
  132.     POP    D    ; DE = RETURN ADDRESS
  133.     LXI    H,32
  134.     DAD    S    ; REMOVE SECOND SET FROM STACK
  135.     SPHL
  136.     XCHG        ; HL = RETURN ADDRESS
  137.     XRA    A
  138.     PCHL
  139.  
  140.