Google
 

Trailing-Edge - PDP-10 Archives - decuslib20-03 - decus/20-0078/libsim/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	CAIE X1,"$"
06800				GOTO FALSE
06900			THEN	LI X1,"}"
07000				GOTO L6
07100			FI
07200			IF	CAIE X1,"#"
07300				GOTO FALSE
07400			THEN	LI	X1,"{"
07500		L6():!		DPB	X1,X0
07600			FI
07700		L7():!
07800		AS
07900			SOJG	X2,TRUE
08000		SA
08100		UNSTK	X2
08200		HLLZS	XWAC2	;! t.Setpos(1)
08300		EXCH	XWAC2,1(XTAC)	;! litenbokstav:-t
08400	L9():!	EXCH	XWAC1,(XTAC)
08500		RETURN
08600		EPROC
08700	
08800	ptab:	POINT	7,2,-1
08900		POINT	7,2,06
09000		POINT	7,2,13
09100		POINT	7,2,20
09200		POINT	7,2,27
09300		POINT	7,2,34	
09400		END;