|
DataMuseum.dkPresents historical artifacts from the history of: CP/M |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about CP/M Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - download
Length: 4864 (0x1300) Types: TextFile Names: »SETFTN.SRC«
└─⟦c9df7130d⟧ Bits:30005915 Pascal MT+ Release 5.2 (Jet-80) └─ ⟦this⟧ »SETFTN.SRC«
;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»