Trailing-Edge
-
PDP-10 Archives
-
tops10and20_integ_tools_v9_3-aug-86
-
tools/crc/browse/craise.mac
There are no other files named craise.mac in the archive.
TITLE craise - raise the case of a fortran string
search crcsym,monsym,macsym
entry craise
external gtbypt,gtbufa,ptbufa
;
;Reference from Fortran with :-
;
; upper=craise(lower)
;
;
; where lower and upper are character variables
; and craise is a character function
; lower is the input and upper the output.
;
forarg <upper,lower> ;define argument offsets
;
;set up the block of accumulators for the movst instruction
;
; _________________________________
; t1 | 400 | source string length |
; t2 |{ source string byte ptr }|-- lower
; t3 |{ }|
; t4 | 000 | dest. string length |
; q1 |{ dest. string byte ptr. }|-- upper
; q2 |{ }|
; ---------------------------------
;
craise:
push p,t1 ;save accumulators
push p,t2
push p,t3
push p,t4
push p,q1
push p,q2
;
movei t1,upper ;get the pointers for upper
call gtbufa
move t4,t2 ;length to t4
move q1,t1 ;pointer to q1
movei t1,lower ;get the pointers for lower
call gtbypt
exch t1,t2 ;swap pointer and length
txo t1,1b0 ;set the bit S, (start translation)
setzb t3,q2 ;one word byte pointers, clear 2nd
;
;move string 1 to string 2 using crtab as the translation table
;
extend t1,[movst 0,crtab ;move string translated
" " ] ;fill with blanks
nop
movei t1,upper ;get the pointers for upper
call ptbufa ;copy out string
pop p,q2 ;restore accumulators
pop p,q1
pop p,t4
pop p,t3
pop p,t2
pop p,t1
ret
;
code==0
crtab: repeat "a"/2,< ;translation table
code,,code+1 ;these characters remain the same
code==code+2 > ;NULL to UNDERLINE
"`",,"A" ;start of lower to upper case
code==code+2 ; conversion, GRAVE is ok, a => A
repeat ^d12,< ;these are converted to upper
code-40,,code-37
code==code+2 > ; b to y => B to Y
"Z",,"{" ; z => Z, { is ok
code==code+2
repeat ^d2,< ;these characters remain the same
code,,code+1 ; |}~ DEL
code==code+2 >
end