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

COMMENT * SIMULA specification;
OPTIONS(/E:QUICK,upcase);
TEXT PROCEDURE upcase(t); TEXT t;
COMMENT converts all letters [a-z] in t to upper case in situ (no copying).
	upcase:-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	Letter(c)	THEN
!		BEGIN	IF	c>='a' AND c<='z'	THEN
!			BEGIN	c:= Char(Rank(c)-shift);
!				t.Setpos(t.Pos-1);
!				t.Putchar(c);
!	END	END	END;
!	t.Setpos(1); ![124];
!	upcase:- t
! END;

COMMENT *;! MACRO-10 code *;!

	TITLE	upcase
	ENTRY	upcase
	sall
	search	simmcr,simmac
	macinit
	SUBTTL	SIMULA utility, Lars Enderin Sept 1975

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

;! Last Edit: [124], 1976-06-21/LE


upcase:	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	;! Lower case
			CAIL	X1,"a"
			CAILE	X1,"z"
			GOTO	FALSE
		THEN	;! Make it upper case
			SUBI	X1,"a"-"A"
			DPB	X1,X0
		FI
	AS
		SOJG	X2,TRUE
	SA
	UNSTK	X2
	HLLZS	XWAC2	;! [124] t.Setpos(1)
	EXCH	XWAC2,1(XTAC)	;! upcase:-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	;! [124]
	LIT
	END;