DataMuseum.dk

Presents historical artifacts from the history of:

Jet Computer Jet80

This is an automatic "excavation" of a thematic subset of
artifacts from Datamuseum.dk's BitArchive.

See our Wiki for more about Jet Computer Jet80

Excavated with: AutoArchaeologist - Free & Open Source Software.


top - download

⟦be3a1e2b0⟧ TextFile

    Length: 4864 (0x1300)
    Types: TextFile
    Names: »SETFTN.SRC«

Derivation

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

TextFile

;SET ROUTINES TO TEST LTEQ,GTEQ,DIFFERENCE,EQUALITY,INEQUALITY
;
	NAME SETFTN
	ENTRY LTEQ,GTEQ,ORGAN,COMP,FUSS
	EXT SAVREG
;
;
; LTEQ : A ROUTINE TO COMPARE TWO SETS ON THE STACK AND SEE IF THE FIRST IS
;	LESS THAN OR EQUAL TO THE SECOND AS DEFINED IN JENSEN AND WIRTH.
;
;	HL = OFFSET (IN BYTES) OF START OF SECOND SET FROM TOP OF STACK
;	DE = OFFSET (IN BYTES) FROM START OF SECOND SET OF EQUIVALENT BYTE
;			IN FIRST SET.
; FOR EXPLANATION OF WHY THE FIRST SET MAY NOT BE THE THE SAME SIZE AS THE
;	SECOND SET SEE COMMENTS IN INN ROUTINE.
;
;
;
LTEQ:
	CALL	SAVREG
;	HL -> FIRST BYTE OF SECOND SET
;	DE -> EQUIVALENT BYTE IN FIRST SET
;	 B  = SIZE OF SECOND SET ( IN BYTES )
	XCHG
	JR	LTGTEQ

;
; GTEQ : A ROUTINE TO COMPARE TWO SETS ON THE STACK AND DETERMINE IF THE
;	SECOND SET IS GREATER THAN OR EQUAL TO THE FIRST SET AS DEFINED IN
;	JENSEN AND WIRTH.
;
;	HL = OFFSET OF START OF SECOND SET FROM TOP OF STACK.
;	DE = OFFSET FROM START OF SECOND SET OF EQUIVALENT SET IN FIRST SET.
;
GTEQ:
	CALL	SAVREG
;	HL -> START OF SECOND SET
;	DE -> EQUIVALENT BYTE IN FIRST SET
;	 B  = SIZE OF SECOND SET.
;
; THE CODE HAS TO FALL THROUGH HERE !!!!
;

;
; LTGTEQ : A COMMON ROUTINE SHARED BY LTEQ AND GTEQ. IT COMPARES THE TWO SETS
;	POINTED TO BY THE HL AND DE REGISTERS. IF THE SET POINTED TO BY HL
;	IS LESS THAN OR EQUAL TO THE SET POINTED TO BY THE DE PAIR, IT
;	RETURNS WITH THE CARRY SET. ( BIT 8 OF THE ACC SET )
;
;	LTEQ CALLS IT WITH HL POINTING TO THE FIRST SET AND DE POINTING TO THE
;		SECOND SET.
;	GTEQ CALLS IT WITH HL POINTING TO THE SECOND SET AND HL POINTING TO THE
;		FIRST SET.
;
;	B = NUMBER OF BYTES IN SECOND SET.
;
LTGTEQ:
	MOV	A,M	; GET BYTE FROM ONE SET
	XCHG
	ORA	M	; COMPARE IT WITH THE OTHER SET
	XRA	M
	JRNZ	NO	; IF NZ, THEN NOT =<
	DCX	H	; DECREMENT POINTERS AND REPEAT WITH THE NEXT BYTE
	DCX	D
	XCHG
	DJNZ	LTGTEQ
	POP	H	; HL = OFFSET OF SECOND SET
	POP	D	; DE = RETURN ADDRESS
	DAD	S	; REMOVE SECOND SET FROM STACK
	SPHL
	XCHG		; HL = RETURN ADDRESS
	MVI	A,80H
	PCHL
NO:
	POP	H
	POP	D
	DAD	S
	SPHL
	XCHG
	XRA	A
	PCHL

;
; ORGAN : A  ROUTINE TO TAKE THE DIFFERENCE OF TWO SETS ON THE STACK AND
;	STORE THE RESULT IN THE FIRST SET. THE DIFFERENCE OF TWO SETS IS
;	DEFINED TO BE THE ELEMENTS OF THE FIRST SET THAT ARE NOT PRESENT
;	IN THE SECOND SET.
;
;	HL = OFFSET OF START OF SECOND SET FROM TOP OF STACK
;	DE = OFFSET FROM START OF SECOND SET OF EQUIVALENT BYTE IN FIRST SET
;
ORGAN:
	CALL	SAVREG
;	HL -> SECOND SET
;	DE -> FIRST SET
;	 B  = SIZE OF SECOND SET
SETDIF:
	MOV	A,M
	XCHG
	ANA	M	; TAKE OUT THE ELEMENTS OF THE SECOND SET
			; THAT ARE NOT PRESENT IN THE FIRST SET
	XRA	M	; TAKE OUT THE ELEMENTS OF THE FIRST SET
			; THAT ARE ALSO IN THE SECOND SET
	MOV	M,A
	DCX	H
	DCX	D
	XCHG
	DJNZ	SETDIF
	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

;
; COMP : A ROUTINE TO COMPARE TWO SETS ON THE STACK AND SEE IF THEY ARE EQUAL
;	THIS IS DONE BY TAKING THE EXCLUSIVE OR OF THE TWO SETS. IF THE RESULT
;	IS NOT ZERO THEN THEY ARE NOT ZERO.
;
;	HL = OFFSET OF FIRST BYTE OF SECOND SET FROM TOP OF STACK
;	DE = OFFSET FROM START OF SECOND SET OF EQUIVALENT BYTE IN THE FIRST
;		SET
;
COMP:
	CALL	SAVREG
;	HL -> SECOND SET
;	DE -> FIRST SET
;	 B  = SIZE OF SECOND SET
	MVI	C,1	; INDICATE TEST FOR EQUALITY
;
; QUERY : A ROUTINE TO TEST FOR EQUALITY/NON-EQUALITY OF TWO SETS ON THE
;	STACK. IF THE C REGISTER CONTAINS A ZERO THEN THE TEST IS FOR 
;	NON-EQUALITY AND FOR EQUALITY OTHERWISE. ON ENTRY THE HL,DE AND C
;	REGISTERS SHOULD BE THE SAME AS THEY WERE UPON ENTRY INTO COMP
;	AND FUSS.
;
QUERY:
	LDAX	D
	XRA	M
	JRNZ	NOTEQ
	DCX	H
	DCX	D
	DJNZ	QUERY	; NOT ZERO -> NOT EQUAL
	CMP	C	; IS THIS A TEST FOR EQUALITY OR NON-EQUALITY ?
	JRZ	NEQTST	; IF ZERO THEN TEST FOR NON-EQUALITY
EQTST:	POP	H	; HL = OFFSET OF SECOND SET
	POP	D	; DE = RETURN ADDRESS
	DAD	S	; REMOVE SECOND SET FROM STACK
	SPHL
	XCHG		; HL = RETURN ADDRESS
	MVI	A,80H
	PCHL
NOTEQ:
	XRA	A	; MIGHT AS WELL CLEAR THE ACC
	CMP	C	; TEST FOR NON-EQUALITY?
	JRZ	EQTST	; YES
NEQTST:	POP	H
	POP	D
	DAD	S
	SPHL
	XCHG
	PCHL

;
; FUSS : A ROUTINE TO COMPARE TWO SETS ON THE STACK AND TEST IF THEY ARE
;	NOT EQUAL. ( APOLOGIES FROM THE PROGRAMMER FOR A ROUTINE NAME THAT
;	HAS ABSOLUTELY NO RELEVANCE TO WHAT IT DOES -- I RAN OUT OF
;	IMAGINATION )
;
;	HL = OFFSET OF START OF SECOND SET FROM TOP OF STACK
;	DE = OFFSET FROM HL OF EQUIVALENT BYTE IN FIRST BYTE
;
FUSS:
	CALL	SAVREG
;	HL -> SECOND SET
;	DE -> FIRST SET
;	 B  = SIZE OF SECOND SET
	MOV	C,A	; INDICATE THAT THIS IS A TEST FOR <>
	JR	QUERY	; JUMP TO COMMON TEST CODE
«eof»