Google
 

Trailing-Edge - PDP-10 Archives - decuslib20-03 - decus/20-0078/libsim/storbo.mac
There is 1 other file named storbo.mac in the archive. Click here to see a list.
COMMENT * SIMULA specification;
OPTIONS(/E:QUICK,storbokstav);
TEXT PROCEDURE storbokstav(t); TEXT t;
COMMENT converts all Swedish lower case letters [a-z,$,{,`]
in t to upper case in situ (no copying).
	storbokstav:-t;

! IF t=/= NOTEXT THEN
! BEGIN	CHARACTER c;
!	INTEGER shift;
!	shift:= Rank('a') - Rank('A');
!	t.Setpos(1);
!	WHILE	t.More	DO
!	BEGIN	c:= t.Getchar;
!		IF	c >= '`'	THEN
!		BEGIN	IF c<='z'
!			THEN	c:= Char(Rank(c)-shift)
!			ELSE
!			IF	c='}'	THEN	c:='$'	ELSE
!			IF	c='{'	THEN 	c:='#'	ELSE	GO TO L;
!			t.Setpos(t.Pos-1);
!			t.Putchar(c);
!		END;
! L:	END;
!	t.Setpos(1);
!	storbokstav:- t
! END;

COMMENT *;! MACRO-10 code *;!

	TITLE	storbokstav
	ENTRY	storbokstav
	sall
	search	simmcr,simmac
	macinit
	SUBTTL	SIMULA utility, Lars Enderin Feb 1977

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



storbokstav:
	PROC
	EXCH	XWAC1,(XTAC)
	JUMPE	XWAC1,L9	;! NOTEXT
	EXCH	XWAC2,1(XTAC)
	STACK	X2
	SETZ	X1,
	LF	X0,ZTVSP(,XWAC1)
	IF	;! Subtext
		JUMPE	X0,FALSE
	THEN	;! Split into word offset, byte offset
		IDIVI	X0,5
	FI
	ADD	X0,ptab(x1)
	ADDI	X0,(XWAC1)
	LF	X2,ZTVLNG(,XWAC1)
	LOOP
		ILDB	X1,X0
		IF	;! Possible Swedish lower case
			CAIGE	X1,"`"
			GOTO	FALSE
		THEN	;! Make it upper case
			IF	;! '`' or 'a'-'z'
				CAILE	X1,"z"
				GOTO	FALSE
			THEN	;! Simple translation
				SUBI	X1,"a"-"A"
			ELSE	;! Could be '{' or '}'
				CAIN	X1,"{"
				LI	X1,"#"
				CAIN	X1,"}"
				LI	X1,"$"
			FI
			DPB	X1,X0
		FI
	AS
		SOJG	X2,TRUE
	SA
	UNSTK	X2
	HLLZS	XWAC2	;! t.Setpos(1)
	EXCH	XWAC2,1(XTAC)	;! storbokstav:-t
L9():!	EXCH	XWAC1,(XTAC)
	RETURN
	EPROC

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