Google
 

Trailing-Edge - PDP-10 Archives - decuslib20-03 - decus/20-0078/libsim/wildsi.mac
There is 1 other file named wildsi.mac in the archive. Click here to see a list.
00100	COMMENT % wildsix, SIMULA specification;
00200	OPTIONS(/E:QUICK,wildsix);
00300	INTEGER PROCEDURE wildsix(id,mask,k); NAME mask;
00400	INTEGER mask, k; TEXT id;
00500	COMMENT Convert at most k (k <= 6) characters from id to sixbit,
00600	taking special notice of "wild cards" as follows:
00700	If a '?' is found, the corresponding position in mask (byte size 6)
00800	will be made = 8R77. If an asterisk ('*') is found, the rest of
00900	the characters up to number k (1<=k<=6) will be treated as '?'.
01000	;
01100	
01200	
01300	!%;! MACRO-10 code !%;!
01400	
01500		TITLE	wildsix
01600		ENTRY	wildsix
01700		SUBTTL	SIMULA utility, Lars Enderin June 1978
01800	
01900	;!*** Copyright 1978 by the Swedish Defence Research Institute. ***
02000	;!*** Copying is allowed.					***
02100	
02200	
02300		sall
02400		search	simmac,simmcr,simrpa
02500		macinit
02600	
02700		;! Local definitions ;!
02800	
02900		id==<result==XWAC1>
03000		mask==id+2
03100		k==mask+2
03200		i==id+1
03300		wild==mask+1
03400	
03500	
03600	wildsix: PROC
03700		IF	;! Non-standard ac's
03800			CAIN XTAC,XWAC1
03900			GOTO FALSE
04000		THEN	;! Put parameters there
04100			EXCH	XWAC1,(XTAC)
04200			EXCH	XWAC2,1(XTAC)
04300			EXCH	XWAC3,2(XTAC)
04400			EXCH	XWAC4,3(XTAC)
04500			EXCH	XWAC5,4(XTAC)
04600		FI
04700		JUMPE	id,L9
04800		JUMPLE k,L9
04900		CAIL k,6
05000		 LI k,6
05100		IFONA ZFLVTD(mask)
05200		 RTSERR 100 ;! Assignment to expression
05300		ADDI mask,(mask+1)
05400		HRLI mask,(POINT 6,)
05500		LI wild,77
05600		LF	,ZTVSP(,id)
05700		IF	JUMPE FALSE
05800		THEN	IDIVI 5
05900			ADD [POINT 7,2
06000			   POINT 7,2,6
06100			   POINT 7,2,13
06200			   POINT 7,2,20
06300			   POINT 7,2,27](X1)
06400			ST X1
06500		ELSE
06600			L X1,[POINT 7,2]
06700		FI
06800		ADDI X1,(id)
06900		L XIAC,[POINT 6,result]
07000		LF i,ZTVLNG(,result)
07100		CAILE i,(k)
07200		 LI i,(k)
07300		SUBI k,(i)
07400		SETZB result,(mask)
07500		LOOP
07600			ILDB X1
07700			SUBI 40
07800			CAIL 100
07900			 SUBI 40
08000			SKIPGE
08100			 SETZ
08200			IF	;! *
08300				CAIE '*'
08400				GOTO FALSE
08500			THEN	;! Make rest '?'s
08600				LI '?'
08700				ADDI i,(k)
08800				LOOP
08900					IDPB XIAC
09000					IDPB wild,mask
09100				AS
09200					SOJG i,TRUE
09300				SA
09400			ELSE
09450				IDPB XIAC
09500				IBP mask
09600				CAIN '?'
09700				 DPB wild,mask
09900			FI
10000		AS
10100			SOJG i,TRUE
10200		SA
10300	
10400	L9():!	IF	CAIN XTAC,XWAC1
10500			GOTO FALSE
10600		THEN	EXCH XWAC5,4(XTAC)
10700			EXCH XWAC4,3(XTAC)
10800			EXCH XWAC3,2(XTAC)
10900			EXCH XWAC2,1(XTAC)
11000			EXCH XWAC1,(XTAC)
11100		FI
11200		RET
11300		EPROC
11400		LIT
11500		END;