perm filename UPCOMP.MAC[SIM,SYS] blob sn#460343 filedate 1979-07-20 generic text, type T, neo UTF8
COMMENT * SIMULA specification;
OPTIONS(/E:QUICK,upcompare);
BOOLEAN PROCEDURE upcompare(master,test);
TEXT master,test;

COMMENT Upcompare returns TRUE if the contents
of TEST is equal to the next TEST.Length characters of MASTER,
counted from current MASTER.Pos.
The MASTER characters will be converted to upper case
before comparison (without changing the MASTER text).
Note that the TEST text will NOT be converted.
Thus

MASTER		TEST		UPCOMPARE

BEGIN		BEG		TRUE
BEGIN		beg		FALSE
begin		BEG		TRUE
begin		beg		FALSE
xxxxx		BEG		FALSE

assuming that MASTER.Pos = 1.
If TEST == NOTEXT the result will always be TRUE.
;
! IF master.Pos + test.Length <= master.Length + 1 THEN
! BEGIN   CHARACTER cmaster,ctest;
!     INTEGER shift;
!	shift:= Rank('a') - Rank('A');
!	WHILE master.More AND test.More AND cmaster = ctest DO
!	BEGIN
!	    cmaster:= master.Getchar;
!	    ctest:= test.Getchar;
!	    IF (IF cmaster > 'Z' THEN Letter(cmaster) ELSE FALSE) THEN
!	    cmaster:= Char(Rank(cmaster) - shift);
!	END loop;
!	out: upcompare:= cmaster = ctest;
! END of upcompare;

!*;! MACRO-10 code *;!

	TITLE	upcompare
	SUBTTL	SIMULA utility, Lars Enderin Nov 1975

;!*** Copyright 1975 by the Swedish Defence Research Institute. ***
;!*** Copying is allowed.					***

	ENTRY	upcompare
	sall
	search	simmcr,simmac
	macinit

upcompare:
	PROC
	IF	;! Xtop is not XWAC1
		CAIN	XTAC,XWAC1
		GOTO	FALSE
	THEN	;! Save ac's
		EXCH	XWAC1,(XTAC)
		EXCH	XWAC2,1(XTAC)
		EXCH	XWAC3,2(XTAC)
		EXCH	XWAC4,3(XTAC)
	FI
	STACK	XWAC5
	LF	,ZTVLNG(,XWAC1)	;! master.Length
	SUBI	(XWAC2)	;! - master.Pos+1
	LF	X1,ZTVLNG(,XWAC3)
	CAIGE	(X1)		;! >= test.Length
	GOTO	L8		;! Finished if not

	LF	XWAC4,ZTVSP(,XWAC3)	;! Offset of test in its main text
	SETZ	XWAC5,
	IF	;! Offset NE 0
		JUMPE	XWAC4,FALSE
	THEN
		IDIVI	XWAC4,5
		ADDI	XWAC3,2(XWAC4)
		HLL	XWAC3,ptab(XWAC5)
	ELSE
		ADD	XWAC3,ptab(0)
	FI
	LF	XWAC4,ZTVSP(,XWAC1)	;! Effective offset of master
	ADDI	XWAC4,(XWAC2)
	SETZ	XWAC5,
	IF	;! Offset NE 0
		JUMPE	XWAC4,FALSE
	THEN	;! word offset, byte offset
		IDIVI	XWAC4,5
		ADDI	XWAC1,2(XWAC4)
		HLL	XWAC1,ptab(XWAC5)
	ELSE
		ADD	XWAC1,ptab(0)
	FI
	LOOP
		ILDB	XWAC1
		ILDB	XWAC5,XWAC3
		CAIN	(XWAC5)
		GOTO	L7	;! direct match
		CAIL	"a"
		CAILE	"z"
		GOTO	L8	;! Was not a lower case letter
		TRZ	"a"-"A"	;! Convert to upper case and
		CAIE	(XWAC5)	;! try again
		GOTO	L8
	AS
L7():!		SOJG	X1,TRUE
	SA
	SETO	XWAC1,	;! equal!
	SKIPA
L8():!	SETZ	XWAC1,	;! unequal!
	UNSTK	XWAC5
	IF	;! Xtop was not XWAC1
		CAIN	XTAC,XWAC1
		GOTO	FALSE
	THEN	;! Restore ac's
		EXCH	XWAC4,3(XTAC)
		EXCH	XWAC3,2(XTAC)
		EXCH	XWAC2,1(XTAC)
		EXCH	XWAC1,0(XTAC)
	FI
	RETURN
	EPROC


ptab:	POINT	7,2,-1
	POINT	7,2,6
	POINT	7,2,13
	POINT	7,2,20
	POINT	7,2,27
	POINT	7,2,34
	LIT
	END;