Google
 

Trailing-Edge - PDP-10 Archives - decuslib20-03 - decus/20-0078/libsim/frontc.mac
There is 1 other file named frontc.mac in the archive. Click here to see a list.
COMMENT * SIMULA specification;
OPTIONS(/E:QUICK,frontcompare);
BOOLEAN PROCEDURE frontcompare(string,config);
	TEXT string,config;

COMMENT TRUE if config matches a substring of string starting at string.Pos;

! IF String.Length - String.Pos+1 >= config.Length THEN
! frontcompare:= string.Sub(string.Pos,config.Length) = config;

COMMENT * ;! MACRO-10 code * ;!

	TITLE	frontcompare
	SUBTTL	SIMULA utility, Lars Enderin Sept 1975

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

	ENTRY	frontcompare
	sall
	search	simmcr,simmac
	macinit

frontcompare:
	PROC
	IF	;! Xtop =/= XWAC1
		CAIN	XTAC,XWAC1
		GOTO	FALSE
	THEN	;! Rearrange ac's
		EXCH	XWAC1,(XTAC)
		EXCH	XWAC2,1(XTAC)
		EXCH	XWAC3,2(XTAC)
		EXCH	XWAC4,3(XTAC)
	FI
	STACK	XWAC5
	LF	,ZTVLNG(,XWAC1)
	SUBI	(XWAC2)
	LF	X1,ZTVLNG(,XWAC3)
	CAIGE	(X1)
	GOTO	L8	;! Not long enough

	LF	XWAC4,ZTVSP(,XWAC3)	;! Offset of config in config.Main
	SETZ	XWAC5,
	IF	;! Non-zero offset
		JUMPE	XWAC4,FALSE
	THEN	;! Compute word and byte offset, byte pointer
		IDIVI	XWAC4,5
		ADDI	XWAC3,2(XWAC4)
		HLL	XWAC3,ptab(XWAC5)
	ELSE	;! Make byte pointer directly
		ADD	XWAC3,ptab(0)
	FI
	

	LF	XWAC4,ZTVSP(,XWAC1)	;! Effective offset of string
	ADDI	XWAC4,(XWAC2)
	IF	;! No offset
		JUMPN	XWAC4,FALSE
	THEN	;! Simple case
		SETZ	XWAC5,
		ADD	XWAC1,ptab(0)
	ELSE	;! word offset, byte offset
		IDIVI	XWAC4,5
		ADDI	XWAC1,2(XWAC4)
		HLL	XWAC1,ptab(XWAC5)
	FI
	IF	;! Both are word aligned
		JUMPN	XWAC5,FALSE
		JUMPGE	XWAC3,FALSE	;! (ptab(0) is the only negative one)
	THEN	;! Compare words first
		WHILE	;! Any full word left
			CAIGE	X1,5
			GOTO	FALSE
		DO
			L	(XWAC1)
			CAME	(XWAC3)
			GOTO	L8	;! unequal
			ADDI	XWAC1,1
			ADDI	XWAC3,1
			SUBI	X1,5
		OD
	FI
	IF	;! There is a tail left
		JUMPLE	X1,FALSE
	THEN	;! Compare char by char
		LOOP
			ILDB	XWAC1
			ILDB	XWAC5,XWAC3
			CAIE	(XWAC5)
			GOTO	L8
		AS
			SOJG	X1,TRUE
		SA
	FI
	SETO	XWAC1,	;! equal!
	SKIPA
L8():!	SETZ	XWAC1,	;! unequal!
	UNSTK	XWAC5
	IF	;! Non-standard ac's were passed as parameters
		CAIN	XTAC,XWAC1
		GOTO	FALSE
	THEN	;! Rearrange
		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;