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;