DataMuseum.dk

top - download

    Length: 4480 (0x1180)
    Types: TextFile
    Names: »SETCON.SRC«

└─⟦c9df7130d⟧ Bits:30005915 Pascal MT+ Release 5.2 (Jet-80)
    └─ ⟦this⟧ »SETCON.SRC« 

TextFile

;SUBROUTINES FOR SET CONSTRUCTION,UNION,MEMBERSHIP,AND INTERSECTION
;
	NAME SETCON
	ENTRY CONSET,UNION,INN,INSECT
	EXT SAVREG

;
; CONSET : A SUBROUTINE THAT SETS THE RELEVANT BIT(S) IN A SET TO INDICATE
;	THE PRESENCE OF THAT ELEMENT IN THE SET.
;
;	HL = OFFSET OF FIRST BYTE OF THE SET FROM THE TOP OF THE STACK.
;	DE = VALUE OF ELEMENT
;	 C = REPETITION COUNT ( SUBRANGES )
;
;	IF THE REPETITION COUNT IS NEGATIVE, IGNORE IT AND RETURN IMMEDIATELY
;		NO BITS ARE SET IN THIS CASE.
;
CONSET:
; IS THE REPETITION COUNT NEGATIVE ?
	INR	C
	DCR	C
	JRZ	LEGRNG	; IF NON-ZERO AND CARRY FLAG SET -- YES
	RC
LEGRNG	DAD	S	; HL -> FIRST BYTE OF THE SET
	PUSH	B
	PUSH	D
	SRLR	E	;; DE = VALUE
	SRLR	E
	SRLR	E	;  DE = NUMBER OF BYTES OFFSET FROM START OF SET
	XRA	A
	DSBC	D	;; HL -> BYTE ON STACK
	POP	B	;; BC = VALUE
	MOV	A,C
	ANI	7	;; GET LOW THREE BITS -- OFFSET IN BYTE
	MVI	E,1	;  START WITH BIT 0
;	CPI	0	;; IS IT BIT 0 ? ( ZERO FLAG SET/CLEARED BY ANI )
	JRZ	SINIT	;; YES -- DONE
	MOV	B,A	;  B = BIT POSITION
SETBIT:	SLAR	E	;; ROTATE TO THE CORRECT BIT
	DJNZ	SETBIT
SINIT:	POP	B	;; GET RANGE ( 0..255 ), SO IT'S IN THE C REGISTER
	MOV	B,C
	INR	B	;; COUNT LESS BY ONE -- CHANGE REPETITION COUNT TO
			;   NUMBER OF BITS TO BE SET
	MOV	A,M	;; GET BYTE IN ACC
RANGE:	ORA	E	;; SET BIT
	SLAR	E	;; GO TO THE NEXT BIT
	JRNC	NOOVER	;;
	MOV	M,A	;; IF OVERFLOW, SAVE BYTE AND
	MVI	E,1	;  START AGAIN WITH BIT 0 OF THE NEXT BYTE
	DCX	H	;;
	MOV	A,M
NOOVER:	DJNZ	RANGE
	MOV	M,A	;; SAVE BYTE
	XRA	A
	RET

; UNION : A ROUTINE THAT TAKES THE UNION OF TWO SETS ON THE STACK AND
;	STORES IT IN THE FIRST SET -- THE ONE AT THE HIGHER LOCATION ON
;	THE STACK.
;
;	HL = OFFSET IN  BYTES OF THE SECOND SET FROM THE TOP OF THE STACK
;	DE = OFFSET FROM START OF SECOND SET OF THE EQUIVALENT BYTE IN THE
;		FIRST SET.
;
UNION:
	CALL	SAVREG	; SAVE THE APPROPRIATE REGISERS AND SET UP POINTERS
	; HL -> START OF SECOND SET
	; DE -> START OF FIRST SET
	;  B  = SIZE OF SECOND SET
ORBIT:	MOV	A,M	;; GET BYTE FROM 2ND SET
	XCHG
	ORA	M	;; OR WITH BYTE FROM 1ST SET
	MOV	M,A	;; SAVE IT
	XCHG
	DCX	H	; GO ON TO NEXT BYTE
	DCX	D
	DJNZ	ORBIT
	POP	H	; HL = OFFSET OF SECOND SET FROM TOP OF STACK + 2
	POP	D	; DE = RETURN ADDRESS
	DAD	S	;; REMOVE THE 2ND SET FROM THE STACK
	SPHL
	XCHG		; HL = RETURN ADDRESS
	XRA	A
	PCHL


; INN : A ROUTINE TO TEST FOR THE MEMBERSHIP OF AN ELEMENT IN A SET.
;
;	HL = OFFSET OF ELEMENT FROM TOP OF STACK
;	DE = VALUE OF FIRST ELEMENT IN SET DIV 8
;
INN:
	DAD	S	;; POINT TO VAR
	PUSH	H
	MOV	C,M
	MOV	A,C	; A AND C REGS CONTAIN THE VALUE OF THE ELEMENT
	DCX	H	;; HL -> FIRST BYTE OF SET
;
; TO OPTIMIZE FOR STORAGE IN SETS, ONLY THE SPACE THAT ACTUALLY GETS USED
; IS ALLOCATED. FOR EXAMPLE FOR A SET OF CHAR, 16 BYTES OF STORAGE ARE
; ALLOCATED BUT FOR A SET OF 'A'..'Z' ONLY 4 BYTES OF STORAGE ARE ALLOCATED.
; SO FOR A SET OF 'A'..'Z', THE FIRST ELEMENT IN THE SET HAS AN ORDINAL
; VALUE OF 65. BEFORE THE TEST FOR MEMBERSHIP CAN BE MADE, THE POINTER TO THE
; SET HAS TO BE RESET TO POINT TO THE LOCATION OF THE ELEMENT IN THE SET WITH
; AN ORDINAL VALUE OF 0 EVEN IF IT DOES NOT EXIST.
;
	DAD	D
	SRLR	C	;; CALCULATE THE LOCATION IN THE SET
			;   OF THE ELEMENT
	SRLR	C
	SRLR	C
	ORA	A	;; CLEAR CARRY
	DSBC	B	;; POINT TO RELEVANT BYTE IN SET
	ANI	7
	MOV	B,A	;; GET POSITION WITHIN SET 
	MVI	A,1	;  START WITH BIT 0 IN THE BYTE
	JRZ	SET2	;; IF ZERO THEN DONE ( ZERO FLAG SET/CLEARED BY ANI )
SET1:	ADD	A	;; ROTATE TO CORRECT BIT POSITION
	DJNZ	SET1
SET2:	ANA	M	;; SEE IF BIT IS SET
	POP	H	;; RESET STACK POINTER
	POP	D
	SPHL
	XCHG		; RETURN ADDRESS -> HL
	INX	S	; REMOVE VAR FROM STACK
	INX	S
	JRZ	NOTIN	;; IF ZERO THEN NOT IN SET( SET/CLEARED BY ANA )
	STC		;;IS IN THE SET
NOTIN:	MVI	A,0
	PCHL


;
; INSECT : A ROUTINE TO TAKE THE INTERSECTION OF TWO SETS ON THE STACK AND
;	STORE THE RESULT IN THE FIRST. INTERSECTION IS EQUIVALENT TO THE LOGICAL
;	AND OF TWO SETS.

;
;	HL = OFFSET OF START OF SECOND SET FROM THE TOP OF STACK
;	DE = OFFSET FROM START OF SECOND SET OF EQUIVALENT BYTE IN FIRST SET
;
INSECT:
	CALL	SAVREG
;	HL -> SECOND SET
;	DE -> EQUIVALENT BYTE IN FIRST SET
;	 B  = SIZE OF SECOND SET
ANDBIT:
	LDAX	D
	ANA	M
	STAX	D
	DCX	H
	DCX	D
	DJNZ	ANDBIT
	POP	H	; HL = OFFSET OF SECOND SET
	POP	D	; DE = RETURN ADDRESS
	DAD	S	; REMOVE SECOND SET FROM STACK
	SPHL
	XCHG		; HL = RETURN ADDRESS
	XRA	A
	PCHL

«eof»