Google
 

Trailing-Edge - PDP-10 Archives - decuslib10-05 - 43,50337/24/litenb.mac
There are 2 other files named litenb.mac in the archive. Click here to see a list.
00100	COMMENT * SIMULA specification;
00200	OPTIONS(/E:QUICK,litenbokstav);
00300	TEXT PROCEDURE litenbokstav(t); TEXT t;
00400	COMMENT converts all letters [A-Z,$,#,@]
00500	in t to lower case in situ (no copying).
00600		litenbokstav:-t;
00700	
00800	! IF t=/= NOTEXT THEN
00900	! BEGIN	CHARACTER c;
01000	!	INTEGER shift;
01100	!	shift:= Rank('a') - Rank('A');
01200	!	t.Setpos(1);
01300	!	WHILE	t.More	DO
01400	!	BEGIN	c:= t.Getchar;
01500	!		IF	c >= '@' AND c <= 'Z'	THEN
01600	!		c:= Char(Rank(c)+shift)		ELSE
01700	!		IF c='$' THEN c:='}'		ELSE
01800	!		IF c='#' THEN c:='{' ELSE GO TO L;
01900	!		t.Setpos(t.Pos-1);
02000	!		t.Putchar(c)
02100	!	L:
02200	!	END;
02300	!	t.Setpos(1);
02400	!	litenbokstav:- t
02500	! END;
02600	
02700	COMMENT *;! MACRO-10 code *;!
02800	
02900		TITLE	litenbokstav
03000		ENTRY	litenbokstav
03100		sall
03200		search	simmcr,simmac
03300		macinit
03400		SUBTTL	SIMULA utility, Lars Enderin Feb 1977
03500	
03600	;!*** Copyright 1977 by the Swedish Defence Research Institute. ***
03700	;!*** Copying is allowed.					***
03800	
03900	
04000	
04100	litenbokstav:PROC
04200		EXCH	XWAC1,(XTAC)
04300		JUMPE	XWAC1,L9	;! NOTEXT
04400		EXCH	XWAC2,1(XTAC)
04500		STACK	X2
04600		SETZ	X1,
04700		LF	X0,ZTVSP(,XWAC1)
04800		IF	;! Subtext
04900			JUMPE	X0,FALSE
05000		THEN	;! Split into word offset, byte offset
05100			IDIVI	X0,5
05200		FI
05300		ADD	X0,ptab(x1)
05400		ADDI	X0,(XWAC1)
05500		LF	X2,ZTVLNG(,XWAC1)
05600		LOOP
05700			ILDB	X1,X0
05800			IF	;! 'A'-'Z' or '@'
05900				CAIG	X1,"Z"
06000				CAIGE	X1,"@"
06100				GOTO	FALSE
06200			THEN	;! Make it lower case
06300				ADDI	X1,"a"-"A"
06400				GOTO	L6
06500			FI
06600			;! Check for '$' or '#'
06700			IF	CAIG	X1,"$"
06800				CAIGE	X1,"#"
06900				GOTO	FALSE
07000			THEN
07100				CAIN	X1,"#"
07200				 SKIPA	X1,["{"]
07250				  LI	X1,"}"
07300		L6():!		DPB	X1,X0
07400			FI
07500		L7():!
07600		AS
07700			SOJG	X2,TRUE
07800		SA
07900		UNSTK	X2
08000		HLLZS	XWAC2	;! t.Setpos(1)
08100		EXCH	XWAC2,1(XTAC)	;! litenbokstav:-t
08200	L9():!	EXCH	XWAC1,(XTAC)
08300		RETURN
08400		EPROC
08500	
08600	ptab:	POINT	7,2,-1
08700		POINT	7,2,06
08800		POINT	7,2,13
08900		POINT	7,2,20
09000		POINT	7,2,27
09100		POINT	7,2,34	
09200		END;