sw/rescue/lab8e_goettingen/disk2_11/rkb/paroff/hpcond.ra

   1 /       \ e HPCOND.RA
   2 /
   3         SECT    #COND
   4         ENTRY   NCOND           / FORTRAN INTEGER FUNCTION
   5         ENTRY   COND            / FORTRAN REAL FUNCTION
   6 /
   7 / ODD NUMBER OF PARAMETERS: I=NCOND(LA,A,LB,B,...,LY,Y,Z)
   8 /       NCOND:=.IF LA .THEN A .ELIF LB .THEN B .ELIF ... .ELSE Z .FI
   9 / EVEN NUMBER OF PARAMETERS: I=NCOND(LA,A,LB,B,...,LZ,Z)
  10 /       NCOND:=.IF LA .THEN A .ELIF .... .ELIF LZ .THEN Z .ELSE 0 .FI
  11 /
  12 X0=     0
  13 X1=     X0+1
  14 X2=     X1+1
  15 XR,     ORG     .+X2+1
  16 /       TEXT    'NCOND '
  17 /CXR,   SETX    XR
  18 /       SETB    BAS
  19 BAS,    ORG     .+3
  20 T1,     ORG     .+3             / POINTER INTO PARAMETER LIST
  21 T2,     ORG     .+3             / HOLD ADR. OF PARAMETERS
  22 RETURN, JA      .;0             / RETURN ADR
  23 TWO,    0;0;2
  24 /       ORG     10*3+BAS        / COMPLETE BASE PAGE IS NOT USED HERE
  25 /       FNOP
  26 /       JA      CXR
  27 /
  28 /
  29         BASE    0
  30 NCOND,
  31 COND,
  32         STARTD
  33         FLDA    3*10            / GET RETURN ADR
  34         FSTA    RETURN
  35         FLDA    0               / POINTER TO PARAMETER LIST --> T1
  36         SETB    BAS
  37         BASE    BAS
  38         FSTA    T1
  39         FLDA%   T1              / RETURN ADR --> FAC
  40         FSUB    T1              /  AND COMPUTE LENGTH OF PARAMETER LIST
  41         FSUB    TWO
  42         SETX    XR
  43         LDX     1,X2            / SHIFT ONE BIT TO THE RIGHT
  44         ALN     X2              /  DIVIDE BY TWO AND BUMP NO. OF PARAMETERS
  45         FNEG                    /  INTO X2
  46         ATX     X2
  47         LDX     0,X1            / SET UP POINTER
  48         STARTF
  49         JEQ     RETURN          / NO PARAMETERS AT ALL, RETURN WITH FAC=0
  50 /
  51 /
  52 LOOP,
  53         STARTD                  / LOAD AND TEST THE ODD NUMBERED PARAMETERS
  54         FLDA%   T1,X1+
  55         FSTA    T2              / STORE THE ADR. OF THE PARAMETER
  56         STARTF
  57         FLDA%   T2              / AND LOAD IT'S VALUE
  58         JNE     TRUE            / WE FOUND A NONZERO SWITCH
  59 /
  60         JXN     C1,X2+          / IF THERE ARE NO PARAMETERS LEFT THEN
  61         JA      RETURN          / RETURN WITH FAC=0 ELSE
  62 /
  63 C1,     ADDX    1,X1            / SKIP THE EVEN NUMBERED PARAMETER
  64         JXN     LOOP,X2+        / IF THIS WAS THE LAST PARAMETER THEN
  65         JA      RETURN          / RETURN WITH FAC =0 ELSE GET NEXT PAIR OF PARAMETERS
  66 /
  67 /
  68 TRUE,   JXN     C2,X2+          / IF THERE IS A ODD NUMBER OF PARAMETERS
  69         JA      RETURN          /  THEN RETURN WITH FAC=LAST PARAMETER ELSE
  70 C2,
  71         STARTD
  72         FLDA%   T1,X1+          / RETURN THE EVEN NUMBERED PARAMETER
  73         FSTA    T2
  74         STARTF
  75         FLDA%   T2
  76         JA      RETURN
  77         END
  78 \1a