Trailing-Edge
-
PDP-10 Archives
-
decuslib10-05
-
43,50337/23/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;