Enter your search terms Submit search form
	Web pdp-10.trailing-edge.com

COMMENT * SIMULA specification;
OPTIONS(/E:QUICK,findtrigger);
CHARACTER PROCEDURE findtrigger(master,triggers);
NAME master;   TEXT master,triggers;
COMMENT EXTERNAL Procedures required: TEXT PROCEDURE scanto;
COMMENT Starting from current MASTER.Pos find first occurrence
of any of the characters in TRIGGERS.;
!BEGIN   CHARACTER c;
!    TEXT t;
!    t:- master;
!    WHILE t.More DO
!    BEGIN   c:= t.Getchar;
!	triggers.Setpos(1);
!	IF scanto(triggers,c) =/= triggers THEN
!	BEGIN COMMENT C found in triggers;
!	    findtrigger:= c;
!	    GO TO out;
!	END
!    END loop;
!    out:  master.Setpos(t.Pos);
!END of findtrigger;

!*;! MACRO-10 code !*;!

	TITLE	findtrigger
	ENTRY	findtrigger
	SUBTTL	SIMULA utility, Lars Enderin Nov 1975

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

	sall
	search	simmac,simmcr,simrpa
	macinit

	;! Local definitions ;!

	master==XWAC1
	t==master+1
	triggers==t+1
	c==triggers+2
	lng==c+1
	trp==triggers
	trl==XIAC
	tp==master
	result==XWAC1
	ct1==c+2

findtrigger:	PROC
	IF	;! Xtop is not XWAC1
		CAIN	XTAC,XWAC1
		GOTO	FALSE
	THEN	;! Swap and save
		EXCH	XWAC1,0(XTAC)
		EXCH	XWAC2,1(XTAC)
		EXCH	XWAC3,2(XTAC)
		EXCH	XWAC4,3(XTAC)
	FI
	SAVE	<XTAC,c,lng,ct1>
	ADDI	t,(master)
	LF	lng,ZTVLNG(t)
	LF	X1,ZTVCP(t)
	SUBI	lng,(X1)
	IF	;! NOT t.More OR triggers==NOTEXT
		JUMPLE	lng,TRUE
		JUMPN	triggers,FALSE
	THEN
		SETZ	result,
	ELSE
		;! Byte pointer for master
		LF	,ZTVSP(t)
		LF	X1,ZTVCP(t)
		ADDI	(X1)
		IDIVI	5
		LF	tp,ZTVZTE(t)
		ADDM	tp
		ADD	tp,ptab(X1)
		;! Byte pointer for triggers
		LF	,ZTVSP(,triggers)
		ADDI	(triggers+1)
		IDIVI	5
		ADDI	(triggers)
		ADD	ptab(X1)
		ST	trp
		LF	X2,ZTVLNG(,triggers)
		ILDB	ct1,trp	;! First trigger character
		SUBI	X2,1
		SF	X2,ZTVLNG(,triggers)
		LOOP
			ILDB	c,tp
			CAIN	c,(ct1)
			SOJA	lng,found
			LF	X2,ZTVLNG(,triggers)
			IF	;! More than one char in triggers
				JUMPE	X2,FALSE
			THEN
				L	X1,trp
				LOOP
					ILDB	X1
					CAIN	(c)
					SOJA	lng,found
				AS
					SOJG	X2,TRUE
				SA
			FI
		AS
			SOJG	lng,TRUE
		SA
		TDZA	result,result
	found:	L	result,c
	out:	LF	,ZTVLNG(t)
		SUBI	(lng)
		SF	,ZTVCP(t)
		TLNE	tp,-1
		SETZ	result,
	FI
	RESTORE
	IF	CAIN	XTAC,XWAC1
		GOTO	FALSE
	THEN
		EXCH	XWAC4,1(XTAC)
		EXCH	XWAC3,2(XTAC)
		EXCH	XWAC2,1(XTAC)
		EXCH	XWAC1,0(XTAC)
	FI
	POPJ	XPDP,
	EPROC

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