Trailing-Edge
-
PDP-10 Archives
-
decuslib20-03
-
decus/20-0078/libsim/upcomp.mac
There is 1 other file named upcomp.mac in the archive. Click here to see a list.
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;