aboutsummaryrefslogtreecommitdiff
path: root/sys/osb/strupk.f
diff options
context:
space:
mode:
authorJoseph Hunkeler <jhunkeler@gmail.com>2015-07-08 20:46:52 -0400
committerJoseph Hunkeler <jhunkeler@gmail.com>2015-07-08 20:46:52 -0400
commitfa080de7afc95aa1c19a6e6fc0e0708ced2eadc4 (patch)
treebdda434976bc09c864f2e4fa6f16ba1952b1e555 /sys/osb/strupk.f
downloadiraf-linux-fa080de7afc95aa1c19a6e6fc0e0708ced2eadc4.tar.gz
Initial commit
Diffstat (limited to 'sys/osb/strupk.f')
-rw-r--r--sys/osb/strupk.f39
1 files changed, 39 insertions, 0 deletions
diff --git a/sys/osb/strupk.f b/sys/osb/strupk.f
new file mode 100644
index 00000000..1123e2ac
--- /dev/null
+++ b/sys/osb/strupk.f
@@ -0,0 +1,39 @@
+c STRUPK -- Unpack a kernel (C style) string into an SPP string. The unpacking
+c operation can be performed in place. A kernel string consists of a sequence
+c of host characters stored one character per byte, delimited by EOS='\0'.
+c We assume here that the host character set is ASCII. If this is not the
+c case code must be added to convert from the host character set to ASCII in
+c the unpacked string.
+c
+c N.B.: If sizeof(XCHAR)=1, XEOS=EOS, and the host character set is ASCII,
+c and the operation is being performed in place, then this procedure should
+c do nothing.
+c
+c N.B.: This code ASSUMES that XCHAR is implemented as INTEGER*2 and that
+c both XEOS and EOS are 0.
+
+ subroutine strupk (instr, outstr, maxch)
+
+ character*1 instr(*)
+ integer*2 outstr(*)
+ integer maxch, EOS
+ parameter (EOS=0)
+ integer i
+
+
+c Determine length of string so that we can unpack it in the reverse
+c direction.
+ i = 1
+ 10 continue
+ if (ichar (instr(i)) .eq. EOS .or. i .gt. maxch) goto 20
+ i = i + 1
+ goto 10
+ 20 continue
+
+c Unpack the string from right to left.
+c
+ outstr(i) = EOS
+ do 30 i=i, 1, -1
+ outstr(i) = ichar (instr(i))
+ 30 continue
+ end