(CSETQ + PLUS)
(CSETQ - DIFFERENCE)
(CSETQ * TIMES)
(CSETQ / QUOTIENT)
(CSETQ = EQUAL)
(CSETQ GT GREATERP)
(CSETQ LT LESSP)

(CSETQ GE
(LAMBDA (A-N1 A-N2)
        (NOT (LT A-N1 A-N2))))

(CSETQ LE
(LAMBDA (A-N1 A-N2)
        (NOT (GT A-N1 A-N2))))

(CSETQ NE
(LAMBDA (A-N1 A-N2)
        (NOT (= A-N1 A-N2))))

(CSETQ **
(LAMBDA (A-N A-E)
        (PROG <(A-N1 1)>
         LOOP <COND [<GT A-E 0>
                      <SETQ A-N1 (* A-N1 A-N)>
                      <SETQ A-E (SUB1 A-E)>
                      <GO LOOP>]
                    [T <RETURN A-N1>]>)))

(CSETQ ABS
(LAMBDA (A-N)
        (COND [<LT A-N 0> <MINUS A-N>]
              [T A-N])))

(CSETQ FLOAT
(LAMBDA (A-N)
        (+ A-N 0.0)))

(CSETQ OCTAL *EXAM)

(CSETQ EVENP
(LAMBDA (A-N)
        (ZEROP (LOGAND A-N 1Q))))

(CSETQ MAX
(LAMBDA (A-N1 . A-L)
        (INDEX A-L A-N1
         (LAMBDA (A-N1 A-N2)
                 (COND [<GT A-N1 A-N2> A-N1]
                       [T A-N2])))))

(CSETQ MIN
(LAMBDA (A-N1 . A-L)
        (INDEX A-L A-N1
         (LAMBDA (A-N1 A-N2)
                 (COND [<LT A-N1 A-N2> A-N1]
                       [T A-N2])))))

(CSETQ FACTORIAL
(LAMBDA (A-N)
        (COND [<LT A-N 2> 1]
              [T <* A-N (FACTORIAL (SUB1 A-N))>])))

(CSETQ FPRINT
(LAMBDA (A-N A-W A-D)
        (PROG <(A-S (** 10 A-D))>
              <SETQ A-N (ENTIER (+ (* A-N A-S) 5.0E-1))>
              <IPRINT (/ A-N A-S) (SUB1 (- A-W A-D))>
              <PRIN1 ".">
              <CSETQ A-FILL "0">
              <IPRINT (ABS (REMAINDER A-N A-S)) A-D>
              <CSETQ A-FILL " ">
              <RETURN T>)))

(CSETQ IPRINT
(LAMBDA (A-N A-W)
        (PROG <(A-L (PLENGTH A-N))>
              <COND [<GT A-L A-W> <XPRINT "X" A-W>]
                    [T <XPRINT A-FILL (- A-W A-L)>
                       <PRIN1 A-N>]>
              <RETURN T>)))

(CSETQ OPRINT
(LAMBDA (A-N A-W)
        (PROG <A-L>
              <XPRINT " " (- A-W 12)>
              <SETQ A-W (MIN A-W 12)>
              <RPLACD (NTH (SETQ A-N (EXPLODE (OCTAL A-N))) -2) NIL>
              <COND [<GT A-W (SETQ A-L (LENGTH A-N))>
                      <XPRINT "0" (- A-W A-L)>]
                    [T <SETQ A-N (NTH A-N (ADD1 (- A-L A-W)))>]>
              <MAPC A-N PRIN1>
              <RETURN T>)))

(CSETQ XPRINT
(LAMBDA (A-N A-W)
        (PROG NIL
         LOOP <COND [<GT A-W 0>
                      <PRIN1 A-N>
                      <SETQ A-W (SUB1 A-W)>
                      <GO LOOP>]
                    [T <RETURN T>]>)))

(CSETQ A-FILL " ")

(CSETQ AR-DUMP '(+ - * / = GT LT GE LE NE ** ABS FLOAT OCTAL EVENP MAX
         MIN FACTORIAL FPRINT IPRINT OPRINT XPRINT A-FILL AR-DUMP))

"ARITH PACKAGE LOADED"