From 40e5a5811c6ffce9b0974e93cdd927cbcf60c157 Mon Sep 17 00:00:00 2001
From: Joe Hunkeler <jhunkeler@gmail.com>
Date: Tue, 11 Aug 2015 16:51:37 -0400
Subject: Repatch (from linux) of OSX IRAF

---
 unix/boot/spp/rpp/rpprat/swend.r | 106 +++++++++++++++++++++++++++++++++++++++
 1 file changed, 106 insertions(+)
 create mode 100644 unix/boot/spp/rpp/rpprat/swend.r

(limited to 'unix/boot/spp/rpp/rpprat/swend.r')

diff --git a/unix/boot/spp/rpp/rpprat/swend.r b/unix/boot/spp/rpp/rpprat/swend.r
new file mode 100644
index 00000000..86088ddd
--- /dev/null
+++ b/unix/boot/spp/rpp/rpprat/swend.r
@@ -0,0 +1,106 @@
+#-h-  swend			 2714  local   12/01/80  15:55:07
+# swend - finish off switch statement; generate dispatch code
+   include  defs
+
+   subroutine swend (lab)
+   integer lab
+
+   include COMMON_BLOCKS
+
+   integer lb, ub, n, i, j, swn
+
+   string sif "if ("
+   string slt ".lt.1.or."
+   string sgt ".gt."
+   string sgoto "goto ("
+   string seq ".eq."
+   string sge ".ge."
+   string sle ".le."
+   string sand ".and."
+
+   swn = swvstk(swvlev)		#get switch variable number, SWnnnn
+   swvlev = max(0, swvlev - 1)
+
+   lb = swstak (swtop + 3)
+   ub = swstak (swlast - 2)
+   n = swstak (swtop + 1)
+   call outgo (lab + 1) # terminate last case
+   if (swstak (swtop + 2) == 0)
+      swstak (swtop + 2) = lab + 1  # default default label
+   xfer = NO
+   call indent (-1)
+   call outcon (lab)  # L   continue
+   call indent (1)
+   if (n >= CUTOFF & ub - lb + 1 < DENSITY * n) { # output branch table
+      if (lb != 1) {  # L  Innn=Innn-lb+1
+	 call outtab
+	 call swvar (swn)
+	 call outch (EQUALS)
+	 call swvar (swn)
+	 if (lb < 1)
+	    call outch (PLUS)
+	 call outnum (-lb + 1)
+	 call outdon
+	 }
+      if (swinrg == NO) {
+	  call outtab  #  if (Innn.lt.1.or.Innn.gt.ub-lb+1)goto default
+	  call outstr (sif)
+	  call swvar (swn)
+	  call outstr (slt)
+	  call swvar (swn)
+	  call outstr (sgt)
+	  call outnum (ub - lb + 1)
+	  call outch (RPAREN)
+	  call outch (BLANK)
+	  call outgo (swstak (swtop + 2))
+      }
+      call outtab  #  goto (....),Innn
+      call outstr (sgoto)
+      j = lb
+      for (i = swtop + 3; i < swlast; i = i + 3) {
+	 for ( ; j < swstak (i); j = j + 1) { # fill in vacancies
+	    call outnum (swstak (swtop + 2))
+	    call outch (COMMA)
+	    }
+	 for (j = swstak (i + 1) - swstak (i); j >= 0; j = j - 1)
+	    call outnum (swstak (i + 2)) # fill in range
+	 j = swstak (i + 1) + 1
+	 if (i < swlast - 3)
+	    call outch (COMMA)
+	 }
+      call outch (RPAREN)
+      call outch (COMMA)
+      call swvar (swn)
+      call outdon
+      }
+   else if (n > 0) {  # output linear search form
+      for (i = swtop + 3; i < swlast; i = i + 3) {
+	 call outtab  # if (Innn
+	 call outstr (sif)
+	 call swvar (swn)
+	 if (swstak (i) == swstak (i+1)) {
+	    call outstr (seq) #   .eq....
+	    call outnum (swstak (i))
+	    }
+	 else {
+	    call outstr (sge) #   .ge.lb.and.Innn.le.ub
+	    call outnum (swstak (i))
+	    call outstr (sand)
+	    call swvar (swn)
+	    call outstr (sle)
+	    call outnum (swstak (i + 1))
+	    }
+	 call outch (RPAREN) #	  ) goto ...
+	 call outch (BLANK)
+	 call outgo (swstak (i + 2))
+	 }
+      if (lab + 1 != swstak (swtop + 2))
+	 call outgo (swstak (swtop + 2))
+      }
+   call indent (-1)
+   call outcon (lab + 1)   # L+1  continue
+   swlast = swtop # pop switch stack
+   swtop = swstak (swtop)
+   swinrg = NO
+   return
+   end
-- 
cgit