⍝ ARUN source code by Wiley Greiner. APL source code, 14 June 1974.
⍝ Implementation of APL operators not implemented in microcode.
⍝ Transcribed by Academia.edu Co-scientist and hand-checked by Paul McJones, October 2026.
⍝ Original: https://crms-apl.computerhistory.org/19740614-wg-arun_source.pdf

⍝ PDF page 2
∇ ⎕WIDTH (//) ⎕DIGITS : ∇
∇ ⎕IO_BOXES ← (ϵ) GLOBAL: ∇
∇ (→) A : ⊃ 204 ∇
∇ A ← NOP B : ⊃ 210 ∇
∇ ATTN A : ⊃ 212 ∇
∇ αA αATN αB : ⊃ 212 ∇
∇ (↓) A : ∇
∇ A ← (↑): ∇
∇ OUTCHARSC A : ⊃ 212 ∇
∇ A ← INCHARSC : ⊃ 211 ∇
∇ RETURN : ⊃ 208 ∇
∇ X ← A (←) B : ⊃ 112 ∇
∇ αA αASNO αB: ⊃ 113 ∇
∇ X ← (+) A : ⊃ 128 ∇
∇ X ← (-) A : ⊃ 129 ∇
∇ X ← (⌊) A : ⊃ 130 ∇
∇ X ← (⌈) A : ⊃ 131 ∇
∇ X ← (|) A : ⊃ 132 ∇
∇ X ← (~) A: ⊃ 133 ∇
∇ X ← (∪) : ⊃ 192 ∇
∇ (//) A: ⊃ 193 ∇
∇ X ← A INTCH B : ⊃ 194 ∇
∇ X ← A TYPECONV B : ⊃ 143 ∇
∇ X ← (⊥) A : ¯1 INTCH TYPECONV ∇
∇ X ← (⊤) A : 0 INTCH TYPECONV ∇
∇ X ← A COEFBEXP B : ⊃ 134 ∇
∇ X ←  COEF B : ¯1 INTCH COEFBEXP ∇
∇ X ←      BEXP A : 0 INTCH COEFBEXP ∇
∇ X ← (⍴) A : ⊃ 197 ∇
∇ X ← A (⍴) B : ⊃ 198 ∇
∇ X ← (,) A : ⊃ 199 ∇
∇ X ← A COMAαINST B : ⊃ 200 ∇
∇ X ← (⍳)A : ⊃ 201 ∇
∇ X ← A (=) B , 1 : ⊃ 142 ∇
∇ X ← A (≠) B , 2 : = ~: ∇
∇ X ← A (+) B , 3 : ⊃ 135 ∇
∇ X ← A (-) B , 4 : ⊃ 136 ∇
∇ X ← A (×) B , 5 : ⊃ 137 ∇
∇ X ← A (÷) B , 6 : ⊃ 138 ∇
∇ X ← αA (|) αB , 9 : αASNO αA αASNO αB 0 αA = αA + αB ÷ ⌊: αA × αB - ∪: ← αA αASNO αB ∇
∇ X ← A (<) B , 14 : ⊃ 141 ∇
∇ X ← A (≤) B , 15 : INTCH < ~: ∇
∇ X ← A (≥) B , 16 : < ~: ∇
∇ X ← A (>) B , 17 : INTCH < ∇
∇ X ← A (∨) B , 18 : ⊃ 140 ∇
∇ X ← A (∧) B , 19 : ⊃ 139 ∇
∇ X ← A NOR B , 20 : ∨ ~: ∇
∇ X ← A NAND B , 21 : ∧ ~: ∇
∇ X ← (÷) A : 1.0 ÷ ∇
∇ X ← (×) αA : ← αA 0 INTCH < αA 0 < - ∪: αASNO αA ∇
∇ X ← PI : 3.14159265389793 ∇

⍝ PDF page 3
∇ X ← (○) A : PI: × ∇
∇ X ← MINNUMBER : ⊃ 202 ⊃ 255 ⊃ 255 ⊃ 255 ⊃ 255 ∇
∇ X ← MAXNUMBER : ⊃ 202 ⊃ 127 ⊃ 255 ⊃ 255 ⊃ 255 ∇
∇ X ← αA (⌈) αB , 7 : αASNO αA ← αB αA - αA αB < × αB + ∪: ← αA αASNO αB ∇
∇ X ← αA (⌊) αB , 8 : αASNO αA ← αB αA - αB αA < × αB + ∪: ← αA αASNO αB ∇
∇ X ← A IF B : INTCH ⍴ ∇
∇ X ← A UL B : INTCH ~: ⍴ ∇
∇ X ← A UNLESS B : UL ∇
∇ A ← ANDREDUCE B : 1 INTCH ⍴ ,: ⍴: ∇
∇ A ← CRLF: 106 109 COMAαINST ⊤: ∇
∇ ⎕DE_PROC αA : ← αA 2 αATN ∪: αASNO αA ∇
∇ αB ← ⎕CR_BOX αA: ← αA 3 αATN ∪: αASNO αA ∇
∇ ⎕DE_BOX αA: ← αA 4 αATN ∪: αASNO αA ∇
∇ ⎕CR_FILE αA: ← αA 5 αATN ∪: αASNO αA ∇
∇ ⎕DE_FILE αA: ← αA 6 αATN ∪: αASNO αA ∇
∇ αB ⎕SEND αA: αASNO αB ← αA αB 10 αATN ∪: ← αA αASNO αB ∇
∇ αB ⎕DELIVER αA: αASNO αB ← αA αB 11 αATN ∪: ← αA αASNO αB ∇
∇ ⎕DETACH αB : ← αB 13 αATN ∪: αASNO αB ∇
∇ ⎕RW_FILE αA: ← αA 14 αATN ∪: αASNO αA ∇

⍝ PDF page 4
∇ A ← REDUCE[SWITCH;DIM] SRC;RHOS;RANK;INCR;I;I2;TARGET;LEN;N
 → VECTORSCAL IF (RANK←'' ⍴ ⍴ RHOS← ⍴ SRC) < 2
 → DEFINEDIM+ϵDIM ⍝ SKIP NEXT LINE IFF DIM ALREADY SPECIFIED.
DEFINEDIM: DIM←RANK ⍝ NEXT LINE YIELDS ERROR IF ⍴,DIM ISN'T 1.
 LEN←RHOS[I←DIM←(⍳ DIM<DIM) ⍴ DIM]
 INCR←1
 → LASTDIM IF I=RANK
GENERATEINCR: INCR←INCR × RHOS[I]←RHOS[I2←I+1]
 → GENERATEINCR IF (I←I2) < RANK
LASTDIM: I←'' ⍴ ⍴ SRC←,SRC
 TARGET←1+'' ⍴ ⍴ A←,(RHOS←(RANK-1) ⍴ RHOS) ⍴ 0
 → DONE IF INCR=LEN // → DZERO IF 0=LEN←INCR × LEN
⍝ MAIN LOOP (NONSTANDARD)
SKIP: N←0
VECTOR: ↓SRC[I2←I-N]
 RANK←I2+INCR-LEN
ELEMENT: ↓SRC[I2←I2-INCR] DYSCFNS[SWITCH] ↑  ⍝ USE STACK, SAVE MEMREFS
 → ELEMENT IF RANK<I2
 A[TARGET←TARGET-1]←↑
 → VECTOR IF (N←N+1)<INCR
 → SKIP IF 0<I←I-LEN
⍝ END OF MAIN LOOP (NONSTANDARD)
 RETURN // A←RHOS ⍴ A // → 0 IF 1=⍴ RHOS ⍝ SHORTCUT OP/MATRIX
DONE: RETURN // A←RHOS ⍴ SRC
VECTORSCAL: A←SRC
 → 0 UL RANK ⍝ EXIT NOW IF OP/SCALAR.
 → DZERO IF 0=I←(RHOS←'') ⍴ RHOS ⍝ PORNOGRAPHIC
 → DONE IF 1=I
 ↓SRC[I]
 →V2+SWITCH=3  ⍝ CONDITIONALLY GOTO SPEEDY +/VECTOR SECTION
V2: RETURN // A←↑ // →V2 IF 1<I // ↓SRC[I←I-1] DYSCFNS[SWITCH] ↑
VPL:RETURN // A←↑ // →VPL IF 1<I // ↓SRC[I←I-1] + ↑
DZERO: A←RHOS IDELEM SWITCH ∇

⍝ PDF page 5
∇ A ← ECUDER[SWITCH;DIM] SRC;RHOS;RANK;INCR;I;I2;LEN
 → VECTORSCAL IF (RANK←'' ⍴ ⍴ RHOS← ⍴ SRC)<2
 → DEFINEDIM+ϵDIM
DEFINEDIM: DIM←RANK
 LEN←RHOS[I←DIM←(⍳DIM<DIM) ⍴ DIM]
 INCR←1
 → GENERINCR+I=RANK
GENERINCR: → GENERINCR+I=RANK // INCR←INCR × RHOS[I←I+1]
 → DONE IF (0=I←'' ⍴ ⍴ SRC←,SRC) ∨ INCR=LEN←INCR × LEN
SKIP: A←0
VECTOR: RANK←(I2←I-A)+INCR-LEN
ELEMENT: SRC[I2]←SRC[I2←I2-INCR] DYSCFNS[SWITCH] SRC[I2]
 → ELEMENT IF RANK<I2
 → VECTOR IF (A←A+1)<INCR
 → SKIP IF 0<I←I-LEN
DONE: RETURN // A←RHOS ⍴ SRC
VECTORSCAL: → DONE UL RANK
 → 0 IF (I←'' ⍴ ⍴ A←SRC)<2
V2: → V2+1=I // A[I]←A[I←I-1] DYSCFNS[SWITCH] A[I] ∇

⍝ PDF page 6
∇ A ← B OUTER[SWITCH] C;RHOA;RB;RC;I;AI;CI;L
 RHOA←(⍴ B), ⍴ C
 → END IF (A←0)=(RB←'' ⍴ ⍴ B←,B) × RC←'' ⍴ ⍴ C←,C
⍝ SHOULD THE VECTOR CONCATENATION APPROACH BE USED?
 → ELEM IF 15<RB ⍝ MAXIMUM OF 15 CONCATENATIONS MAY BE PERFORMED
⍝ YES. IT IS MOST EFFICIENT WHEN (⍴,B) <<< ⍴,C
VFNS: → VFNS+SWITCH // A←⍳I←0
VEQ: → END//→ VEQ UL I=RB//A←A,B[I←I+1]=C
VNE: → END//→ VNE UL I=RB//A←A,~ B[I←I+1]=C
VPL: → END//→ VPL UL I=RB//A←A,B[I←I+1]+C
VMS: → END//→ VMS UL I=RB//A←A,B[I←I+1]-C
VTI: → END//→ VTI UL I=RB//A←A,B[I←I+1] × C
VDI: → END//→ VDI UL I=RB//A←A,B[I←I+1]÷C
VMA: → END//→ VMA UL I=RB//A←A,L+(L<C) × C-L←B[I←I+1]
VMI: → END//→ VMI UL I=RB//A←A,L+(C<L) × C-L←B[I←I+1]
VMO: → END//→ VMO UL I=RB//A←A,C-L+⌊C÷L+0=L←B[I←I+1]
VEX: → END//→ VEX UL I=RB//A←A,B[I←I+1] * C
VLO: → END//→ VLO UL I=RB//A←A,B[I←I+1] LN C
VCI: → END//→ VCI UL I=RB//A←A,B[I←I+1] CIRCLESC C
VGA: → END//→ VGA UL I=RB//A←A,B[I←I+1] EXCLAMATION C
VLT: → END//→ VLT UL I=RB//A←A,B[I←I+1]<C
VLE: → END//→ VLE UL I=RB//A←A,~ C<B[I←I+1]
VGE: → END//→ VGE UL I=RB//A←A,~ B[I←I+1]<C
VGT: → END//→ VGT UL I=RB//A←A,C<B[I←I+1]
VOR: → END//→ VOR UL I=RB//A←A,C ∨ B[I←I+1]
VAN: → END//→ VAN UL I=RB//A←A,C ∧ B[I←I+1]
VNO: → END//→ VNO UL I=RB//A←A,~ C ∨ B[I←I+1]
VNA: → END//→ VNA UL I=RB//A←A,~ C ∧ B[I←I+1]
ELEM: AI←1+'' ⍴ ⍴ A←, RHOA ⍴ 0
NEWROW: I←RC // L←B[RB]
 → NEWROW+⍳0<I←I-1 // A[AI←AI-1]←L DYSCFNS[SWITCH] C[I]
 → NEWROW IF 0<RB←RB-1
END: RETURN // A←RHOA ⍴ A ∇

⍝ PDF page 7
∇ A ← B INNER[SW1;SW2] C;B1;B2;C1;C2;RHOA;RHOB;RHOC;I;J;K
 RHOA ←⍳B1+C1-(0<B1← ⍴ RHOB← ⍴ B)+0<C1← ⍴ RHOC← ⍴ C
 B1←B2←C1←C2←1
 → 1+DIMB-(K←I←0)<J←¯1+'' ⍴ ⍴ RHOB
DIMB: → DIMB IF I<J // B1←B1 × RHOA[K←K+1]←RHOB[I←I+1]
 → DIMB+2+J=¯1
 B2←RHOB[J+1]
 → 1+DIMC-(I←1)<J←'' ⍴ ⍴ RHOC
DIMC: → DIMC IF I<J // C2←C2 × RHOA[K←K+1]←RHOC[I←I+1]
 → DIMC+2+J=0
 C1←'' ⍴ RHOC
 → PROPOGATE UL (1=B2) < B2=C1
 → END IF (B1=0) ∨ C2=0 // A←(B1,C2) ⍴ 0
 → FORMED IF (2=⍴ RHOB) ∧ 2=⍴ RHOC
 B←(B1,B2) ⍴ B // C←(C1,C2) ⍴ C
FORMED: → FILLIN IF 0=B2
THIRD: J←C2
SECOND: K←B[B1;I] DYSCFNS[SW2] C[I←B2;J]
FIRST: K←(B[B1;I] DYSCFNS[SW2] C[I←I-1;J]) DYSCFNS[SW1] K
 → FIRST IF 1<I
 A[B1;J]←K
 → SECOND IF 0<J←J-1
 → THIRD IF 0<B1←B1-1
END: → 0 IF 2=⍴ RHOA
 RETURN // A←RHOA ⍴ A
FILLIN: RETURN // A←RHOA IDELEM SW1
PROPOGATE: → LENERR UL (C1=1) ∨ I←B2=1
 RETURN//A←RHOA ⍴ REDUCE[SW1;2+I]((B1,B2) ⍴ B)OUTER[SW2](C1,C2) ⍴ C
LENERR: 1 2 = 1 2 3 ⍝LENGTH ERROR
∇

⍝ PDF page 8
∇ A ← B DYSCFNS[SWITCH] C
 →1+SWITCH
 RETURN // A ← B = C
 RETURN // A ← ~ B = C
 RETURN // A ← B + C
 RETURN // A ← B - C
 RETURN // A ← B × C
 RETURN // A ← B÷C
 RETURN // A ← (B × A) + C × ~ A ← C < B
 RETURN // A ← (C × A) + B × ~ A ← C < B
 RETURN // A←C-B×⌊C÷B+B=0 ⍝APLSV DYADIC |
 RETURN // A ← B * C
 RETURN // A ← B LN C
 RETURN // A ← B CIRCLESC C
 RETURN // A ← B COMSC C
 RETURN // A ← B < C
 RETURN // A ← ~ C < B
 RETURN // A ← ~ B < C
 RETURN // A ← C < B
 RETURN // A ← B ∨ C
 RETURN // A ← B ∧ C
 RETURN // A ← ~ B ∨ C
 RETURN // A ← ~ B ∧ C
⍝ ORDER: = ≠ + - × ÷ ⌈ ⌊ |
⍝        * LN ○ GAMMA < ≤ ≥ > ∨
⍝        ∧ NOR NAND
∇

⍝ PDF page 9
∇ A ← RHOA IDELEM I
 I ← 1 ∨ 1+2=A←(1 0 0 0 1 1,MINNUMBER,MAXNUMBER,0 1 2 2 1 0 1 1 0 0 1 2 2)[I]
⍝ THIS FUNCTION COMPUTES THE IDENTITY ELEMENT FOR THE ITH PRIMITIVE
⍝ FUNCTION. P-FNS WITH NO SUCH ELEMENT, SUCH AS NAND, INVOKE A
⍝ DOMAIN ERROR.
 A ← RHOA ⍴ A ∇

⍝ PDF page 10
∇ A ← B (∊) C
 →OR_IT+0=A←'' ⍴ ⍴ C←,C // ↓(⍴B)⍴0
OR_IT: →OR_IT+0=A←A-1 // ↓(B=C[A]) ∨ ↑
 A←↑
∇

⍝ PDF page 11
∇ A ← B (⍳) C;D;E;I;J
 → 6 IF (⍴ A←,C)=J←0 // E←'' ⍴ ⍴ B←B,0 // D← ⍴ C
 C ← B = B[E]←A[J←J+~ I←0] ⍝C[E] IS FORCED TO BE ONE
 → 3+C[I←I+1] ⍝C[I] IS ALWAYS ONE ∨ ZERO
 A[J]←I ⍝C[I] WAS ONE
 → 2 IF J < ⍴ A
 A←D ⍴ A
⍝ERROR UNLESS 1 GE ⍴ ⍴ B
⍝360 ENHANCEMENT: B MAY BE A SCALAR, IF SO, TREATED LIKE A VECTOR
∇

⍝ PDF page 12
∇ A ← ROTATE[○DIM] SRC;I;I2;INCR;LEN;N;RANK;RHOS;START
 → VECTORSCAL IF (RANK←'' ⍴ ⍴ RHOS← ⍴ SRC)<2
 → DEFINEDIM+ϵDIM
DEFINEDIM: DIM←RANK
 LEN←RHOS[I←DIM←(⍳DIM<DIM) ⍴ DIM]
 INCR←1
 → GENINCR+I=RANK
GENINCR: → GENINCR+I=RANK // INCR←INCR × RHOS[I←I+1]
 → DONE IF 0=I←'' ⍴ ⍴ A←SRC←,SRC // LEN←LEN × INCR
SKIP: N←0
VECTOR: START←-INCR-RANK←(I2←I+INCR-N)-LEN
ELEM: A[I2←I2-INCR]←SRC[START←START+INCR]
 → ELEM IF RANK<I2
 → VECTOR IF (N←N+1)<INCR
 → SKIP IF 0<I←I-LEN
DONE: RETURN // A←RHOS ⍴ A
VECTORSCAL: → 0 UL RANK // A←SRC
 → 0 IF (I←1+'' ⍴ ⍴ A)<3 // START←0
V2: → V2+1=I // A[I←I-1]←SRC[START←START+1]
∇

⍝ PDF page 13
∇ A ← B ROTATE[○DIM] SRC;AI;BI;SI;BASE;I;INCR;LEN;N;RHOS
 → VECTORSCAL IF (BASE←'' ⍴ ⍴ RHOS← ⍴ SRC)<2
 → DEFINEDIM+ϵDIM
DEFINEDIM: DIM←BASE
 LEN←RHOS[AI←(⍳DIM<DIM) ⍴ DIM]
 → DONE+0<I←'' ⍴ ⍴ A←SRC←,SRC
DONE: RETURN // A←RHOS ⍴ SRC←A ⍝ EXTRANEOUS ASSIGNMENT SAVES WORKSPACE
 B←B-LEN×⌊B÷LEN ⍝ B←LEN | B
 → MULTI IF 2<BI←1+'' ⍴ ⍴ B←,B // N← ⍴ B
 → MULTI+1 // BI←1+'' ⍴ ⍴ B←,((~AI=⍳BASE)/RHOS) ⍴ B
MULTI: N αCOMPAT (~AI=⍳BASE)/RHOS
 INCR←1
 → GENINCR+AI=BASE
GENINCR: → GENINCR+AI=BASE // INCR←INCR × RHOS[AI←AI+1]
 LEN←LEN × INCR
SKIP: → DONE IF (I←I-LEN)<N←0
 → ELEM2 IF (AI←0)=SI←B[BI←BI-1] × INCR // BASE←I-N
ELEM1: A[BASE+AI←AI+INCR]←SRC[BASE+SI←SI+INCR]
 → ELEM1 IF SI<LEN
 SI←0
ELEM2: A[BASE+AI←AI+INCR]←SRC[BASE+SI←SI+INCR]
 → ELEM2 IF AI<LEN
 → SKIP+(N←N+1)<INCR
VECTORSCAL: → 0 UL BASE // A←SRC
 B←(⍳B<B) ⍴ B ⍝ → LERR IF 1< ⍴ ,B
 → 0 IF 0=RHOS←'' ⍴ RHOS
 → E2 IF (AI←0)=SI←B-RHOS×⌊B÷RHOS
E1: A[AI←AI+1]←SRC[SI←SI+1]
 → E1 IF SI<RHOS
 SI←0
E2: A[AI←AI+1]←SRC[SI←SI+1]
 → E2 IF AI<RHOS
∇

⍝ PDF page 14
∇ A ← B (↑) C;AS1;AS2;CS1;CS2;I;J
 → RERR IF 1< ⍴ ⍴ B
 → SCAC + 0<I←'' ⍴ ⍴ J← ⍴ C
SCAC: I←'' ⍴ ⍴ J // C←(J←B=,B) ⍴ C
 → LERR UL I= ⍴ B←,B
 → NULL UL ANDREDUCE 0<J
 → 0 UL ANDREDUCE 0< ⍴ A←(|B) ⍴ ' ' 0[1+⍳ ''⍴C]
 → 0 IF I=0 ⍝C IS SCALAR
 CS2←0 ⌈ (B<0) × B+J
 B←J ⌊ | B // AS2←0 ⌈ -B+J
 AS2←AS2[I] // AS1←AS2[1]
 CS2←CS2[I] // CS1←CS2[1]
 J←B[1]
 → VECT IF I=1 ⍝C IS VECTOR
 → RERR UL I=2 ⍝C ~ MATRIX
 I←B[2]
MAT: A[AS1+J;AS2+I]←C[CS1+J;CS2+I]
 → MAT IF 0<I←I-1
 → MAT-⍳0<J←J-1
 RETURN
VECT: → VECT-0=J←J-1 // A[AS1+J]←C[CS1+J]
RERR: I=I ⍴ I←⍳2
LERR: 1 2 = 1 2 3
NULL: A←(|B) ⍴ 0
∇

⍝ PDF page 15
∇ A ← B (↓) C;I;J;II;JJ;STARTCOL;STARTROW
 → SCALAR IF 0=⍴ J←⍴ C
⍝ NEXT STATEMENT INDUCES A LENGTH ERROR WHEN APPROPRIATE
 → RERR UL ((I←'' ⍴ ⍴ J←J-|B)<3) ∧ (1=⍴ ,B) ∨ 1=⍴ ⍴ B
 → MAT IF I=2
 → NULLVEC UL 0<J
 A ← J ⍴ C
 → 0 UL (I←0)<B←'' ⍴ B
VEC: → VEC+J=I // A[I]←C[B+I←I+1]
 RETURN
NULLMAT: RETURN // A←(J × 0<J) ⍴ ''
NULLVEC: RETURN // A←''
SCALAR: RETURN // A←(B=0) ⍴ C
RERR: I=I ⍴ I←⍳2 ⍝GENERATES A RANK ERROR
MAT: → NULLMAT UL (0<JJ←J[2])∧0<II←'' ⍴ J
 A ← J ⍴ C
 STARTCOL←J[2] // STARTROW←'' ⍴ J←2 ⍴ B × (I←0)<B
MATROW: I←I+1 // STARTROW←STARTROW+1 // J←0
MATCOL: A[I;J]←C[STARTROW;STARTCOL+J←J+1]
 → MATCOL IF J<JJ
 → MATROW IF I<II
⍝ DROP IS IMPLEMENTED ONLY FOR SCALAR, VECTOR, ∨ MATRICE
⍝ RIGHT ARGUMENTS.
⍝ SCALAR DROP MATRICE EXECUTES LIKE (SCALAR,SCALAR) DROP MATRICE
⍝ RANK ERROR OCCURS
⍝    IF RIGHT ARGUMENT RANK > 2, OR
⍝    IF LEFT ARGUMENT HAS AN INVALID RANK.
∇

⍝ PDF page 16
∇ A ← UPGRADE VECT;I;INDEX;REMEMBER;RHOV;V;VAL
 → 0 IF 0=RHOV←(,INDEX = 0 0 ⍴ I←0) ⍴ INDEX← ⍴ A←VECT
SEARCH: INDEX←0
⍝ REMEMBER ← SMALLEST INDEX OF THE SMALLEST NUMBER ENCOUNTERED.
 → REMEM - 'M' = VECT[INDEX←INDEX+1]
REMEM: VAL←VECT[REMEMBER←INDEX]
CHECK: → (INDEX = RHOV) ⍴ THRU
 → ('M'=V←VECT[INDEX←INDEX+1]) ⍴ CHECK
 → CHECK - V < VAL
THRU: VECT[A[I←I+1]←REMEMBER]←'M'
 → SEARCH IF I<RHOV
⍝ E R R O R   T R A P S
⍝ RANK ERROR (5,0): 1 ≠ ⍴⍴VECT
⍝ TYPE ERROR (7,0): OR/VECT ELEMENT ANY CHAR EXCEPT 'M'
∇

⍝ PDF page 17
∇ A ← DOWNGRADE VECT
 A←UPGRADE -VECT ∇

⍝ PDF page 18
∇ A ← B αCαOαMαAα C
⍝ *********** MICROPROGRAM ASSUMES 20B ↔×[2]COMA ***********
 A←B,[] C ⍝ INVOKE THE CRMS-APL , INSTRUCTION
∇

⍝ PDF page 19
∇ A ← INDEX1[VAR;I1];RHOA;RHO1;J1
 → IERR UL 1=⍴⍴VAR
 → DEFI1+ϵI1
DEFI1: I1←⍳(⍴VAR)[1]
 RHO1←'' ⍴ ⍴ A←I1←,I1 // RHOA← ⍴ I1 // J1←0
 →6+RHO1=J1
 →5 // A[J1]←VAR[I1[J1←J1+1]]
 → 0 ∧ I1=⍴ RHOA
 RETURN // A←RHOA⍴A
IERR: 1 2[1;1]
∇

⍝ PDF page 20
∇ A ← INDEX2[VAR;I1;I2];I1R1;R1;R2;RA;RHOA
 → IERR UL 2=⍴⍴VAR
 → DEFI1+ϵI1
DEFI1: I1←⍳(⍴VAR)[1]
 → DEFI2+ϵI2
DEFI2: I2←⍳(⍴VAR)[2]
 RHOA←(⍴I1),⍴I2
 A←(RA←(R1←'' ⍴ ⍴ I1←,I1) × '' ⍴ ⍴ I2←,I2) ⍴ VAR
 → END IF 1=RA←RA+1 ⍝ INITIALIZE PRE-DECREMENTING POINTER
 I1R1←I1[R1] // R2←'' ⍴ ⍴ I2
AI1: →AI1+0=R2←R2-1 // A[RA←RA-1]←VAR[I1R1;I2[R2]]
 →AI1-⍳0<R1←R1-1
END: RETURN // A←RHOA⍴A
IERR: 1 2[1;1]
∇

⍝ PDF page 21
∇ A ← INDEX3[VAR;I1;I2;I3];I1R1;I2R2;R1;R2;RA;RHOA
 → IERR UL 3=⍴⍴VAR
 → DEFI1+ϵI1
DEFI1: I1←⍳(⍴VAR)[1]
 → DEFI2+ϵI2
DEFI2: I2←⍳(⍴VAR)[2]
 → DEFI3+ϵI3
DEFI3: I3←⍳(⍴VAR)[3]
 RHOA←(⍴I1),(⍴I2),⍴I3
 A←(RA←(R1←'' ⍴ ⍴ I1←,I1) × ('' ⍴ ⍴ I2←,I2) × '' ⍴ ⍴ I3←,I3) ⍴ VAR
 → END IF 1=RA←RA+1
 I1R1←I1[R1] // R2←'' ⍴ ⍴ I2
AI1: I2R2←I2[R2] // R3←'' ⍴ ⍴ I3
AI2: →AI2+0=R3←R3-1 // A[RA←RA-1]←VAR[I1R1;I2R2;I3[R3]]
 →AI2-⍳0<R2←R2-1
 →AI1-⍳0<R1←R1-1
END: RETURN // A←RHOA⍴A
IERR: 1 2[1;1]
∇

⍝ PDF page 22
∇ A ← TRANSPOSE B;RHOA;RANK;IX;X;Y
 → TWOD IF 2=RANK←'' ⍴ ⍴ RHOA←⍴ A←B
 →0 IF RANK<2
 RETURN // A←((1+RANK)-⍳RANK) TRANSPOSE B ⍝ APLSV TREATMENT OF MONADIC TRANSPOSE
⍝
⍝ ~ WASTEFUL SINCE MOST MONADIC TRANSPOSES INVOLVE
⍝ TWO-D MATRICES.
TWOD: A←((Y←RHOA[2]),IX←'' ⍴ RHOA) ⍴ B
 → 0 IF 0=IX × Y ⍝ IS MATRIX 0 BY N OR N BY 0 ??
 X←IX ⍝NO SUCH LUCK.
MOVE2: A[Y;X]←B[X;Y] ⍝MOST REGRETTABLY, SUBSCR × TAKES TIME.
 →MOVE2 IF 0<X←X-1
 → MOVE2-⍳0<Y←Y-1
⍝ NO ERRORS ARE EXPLICITLY GENERATED.
∇

⍝ PDF page 23
∇ Z ← A TRANSPOSE B;RB;RZ;I;J;W1;W2;CZ
 →RERR IF 1<⍴⍴A
 →LERR IF (J←'' ⍴ ⍴ RB←⍴ Z←B) ≠ ⍴ A←,A
 →0 IF J<2
 W1←J⍴CZ←'' ⍴ (2-ANDREDUCE(A=⌊A)∧A>0) ∧ 2-ANDREDUCE(⍳I←⌈/A)∊A ⍝CHECK DOMAIN
INITΔW1: W1[J←J-1]←W1[J]×RB[J]
 →INITΔW1 IF 1<J
 RZ←W2←I⍴0
LOOP: CZ←CZ×RZ[J]←⌊/(Z←J=A)/RB
 W2[J]←+/Z/W1
 →LOOP UL I<J←J+1
 B←,B // Z←CZ⍴0
 →SHAPE IF CZ=0
VECT: A←CZ←J←1
 I←'' ⍴ ⍴ RZ
ELEM: J←J+W2[I]×W1-RZ[I]×A←⌊(W1←A)÷RZ[I]
 →ELEM IF 0<I←I-1
 Z[CZ]←B[J]
 →VECT IF 0<CZ←CZ-1
SHAPE: →0 // Z←RZ⍴Z
RERR: I=I⍴I←⍳2
LERR: 1 2 = 1 2 3
∇

⍝ PDF page 24
∇ A←B (,) [○DIM] C;RA;RB;RC;RRB;RRC;RANK;I;M;N;NB;NC;COMPERAND
⍝ LOCALS DEFINED IN THE NEXT STATEMENT ARE CHANGED IFF B ∨ C CHANGED
 RANK←(RRB,RRC)[1+(RRB←'' ⍴ ⍴ RB←⍴ B)<RRC←'' ⍴ ⍴ RC←⍴ C]
 → DEFINEDIM+ϵDIM
DEFINEDIM: DIM←RANK ⍝GENERATE ERR IF DIM HAS MORE THAN ONE ELEMENT.
 → LAMINATE IF DIM<I←⌈DIM
 → EASY IF RANK<2
 → SCLRB IF RRB=0
 → SCLRC IF RRC=0
 → RERR IF 1<|RRB-RRC
⍝ M←M=N 2 LINES DOWN IS LEN ERR IF RANK ERR ~ CAUGHT HERE.
 NC←(M←RC,⍳RRC<RRB)[DIM←(⍳I←0)⍴DIM]
 M←M=N // N[DIM]←1+NC+NB←(N←RB,⍳RRB<RRC)[DIM]
⍝ NB ∧ NC ARE LENS OF THE INTERESTING DIMENSIONS OF B ∧ C.
CHECKONE: → CHECKONE IF M[I←I+1]
 → LASTDIM IF N←I=RANK
 M←((⍳RRB<RRC),RB)=RA←(⍳RRC<RRB),RC
 → LERR IF (~ N←I=DIM) ∨ (M[RANK]←0) = M[RANK]
CHECKTWO: → CHECKTWO IF M[I] // N←N × RA[I←I+1]
 → LERR UL I=RANK
LASTDIM: → RELATIONAL+(RRC<RRB)-RRB<RRC // RA←RC
SCLRB: M←((RANK-1) ⍴ RB[DIM]←N←1),0 // NC←(RA←RB←RC)[I←DIM]
 → (CHECKTWO,LASTDIM)[1+I=RANK] // B←RB⍴B
SCLRC: M←((RANK-1) ⍴ RC[DIM]←N←1),0 // NB←(RA←RC←RB)[I←DIM]
 → (CHECKTWO,LASTDIM)[1+I=RANK] // C←RC⍴C
⍝
⍝⍝⍝⍝⍝ LAMINATION SEGMENT ⍝⍝⍝⍝⍝
⍝
LAMINATE: → LAMSCA IF (M←RRB=0) ∨ N←RRC=0
 → RERR UL ((RANK←RANK+I←1)=RRB←'' ⍴ ⍴ RB←(DIM←I),RB) ∧ RANK=RRC
PRESQUEEZE: → LERR UL RC[I]=RB[I]←RB[N←I+1]
 → PRESQUEEZE IF (I←N)<DIM
 → LASTDIM IF NB←N←I=RANK
 → CHECKTWO IF (M[RANK]←0)<(M←RB=RA←(NB←N←1),RC)[RANK]
LERR: 1 2 + 1 2 3
RERR: I+I⍴I←⍳2
LAMSCA: → EASY+N-M
 → LAMINATE+1 // RRB←RRC // B←(RB←RC)⍴B
EASY: RETURN // A←B,C
 → LAMINATE+1 // RRC←RRB // C←(RC←RB)⍴C
⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝⍝
 NB←1
RELATIONAL: → CONTINUE ⍝CALLING PROCEDURE: → RELATIONAL+/-1
 RA←RB // NC←1
CONTINUE: NB←NB × N // NC←NC × N // RA[DIM]←NB+NC
 I←M←N←COMPERAND←0 // RANK←'' ⍴ ⍴ A←(B←,B),C←,C
⍝⍝⍝⍝⍝ CATENATION ∧ LAMINATION COMMON LOOP (RANK RE-DEFINED) ⍝⍝⍝⍝⍝
 → FINI IF (I=DIM) ∨ I=RANK
CATENLOOP: COMPERAND←NB+COMPERAND
L1: A[I←I+1]←B[M←M+1]
 → L1 IF I<COMPERAND
 COMPERAND←NC+COMPERAND
R1: A[I←I+1]←C[N←N+1]
 → R1 IF I<COMPERAND

⍝ PDF page 25
 → CATENLOOP IF I<RANK
FINI: A←RA ⍴ A ∇

⍝ PDF page 26
∇ A ← B (/)[○DIM] C;AI;BI;CI;CMAX;N;NI;RHOB;RHOC
 → DEFINEDIM-⍳0<⍴RHOC←⍴C ⍝BRANCH IF C IS AN ARRAY
 →0∧⍳1=⍴N // A←(N←,B∨0)⍴C ⍝256<⍴,B FOR B/SCALAR ASSUMED
 RHOC←⍴C←,C ⍝VECTOR/SCALAR IS TREATED LIKE VECTOR/1 ⍴ SCALAR
 → DEFINEDIM+ϵDIM
DEFINEDIM: DIM←'' ⍴ ⍴ RHOC ⍝ASSIGN DEFAULT DIMENSION INDEX.
 → QUICK1 IF 1=⍴,B
 → RERR UL 1=⍴RHOB←⍴B ∨ 0 ⍝B MUST BE A BINARY VECTOR
 → NOT1TO1 UL RHOC[DIM]=RHOB←'' ⍴ RHOB
 → NULL IF (0=CMAX←'' ⍴ ⍴ C←,C) ∨ RHOB=AI←CI←0
 → LASTDIM IF DIM=⍴RHOC // B←B,2 // A←CMAX⍴C
 → NDONE IF BI=⍴RHOC // N←RHOC[BI←DIM+1]
 → NDONE-⍳BI<⍴RHOC // N←N × RHOC[BI←BI+1]
NDONE: BI←0 // CI←CI-N
FINDNL: → FINDNL+B[BI←BI+1] // CI←CI+N // NI←0
 → FINDNL+NI<N // A[AI←AI+1]←C[CI+NI←NI+1] ⍝ASSIGN A[AI+⍳N]
 → LGO // → FINDNL-⍳CI<CMAX
LASTDIM: BI←0
FINDL: → FINDL+B[BI←BI+1]
 → FINDL // A[AI←AI+1]←C[CI+BI]
 → FINDL-⍳(CI←CI+RHOB)<CMAX
LGO: RHOC[DIM]←(RHOC[DIM]×AI)÷CI ⍝COMPUTE RHOC[DIM]←+/B
 RETURN // A←RHOC⍴A
QUICK1: → QUICK1F UL B ⍝TRAP IF B ~ BINARY
 RETURN // A←C
QUICK1F: RETURN // A←RHOC⍴RHOC[DIM]←0
NOT1TO1: → LERR UL (1=⍴,C) ∧ 1=⍴⍴C ⍝LENGTH ONE VECTOR
 RETURN // A←(+/B)⍴C
NULL: RETURN // A←RHOC⍴RHOC[DIM]←+/B ⍝''/ARRAY ∨ B/NULLARRAY
LERR: 1 2 = 1 2 3 ⍝LENGTH ERROR
RERR: N=N⍴N←⍳2 ⍝RANK ERROR
∇

⍝ PDF page 27
∇ A ← B (\)[○DIM] C;RA;RC;I;IA;IC;N;NN
 → SCLR+0<I←'' ⍴ ⍴ RA←⍴C
SCLR: I←1 // RA←⍴C←,C
 → DEFINEDIM+ϵDIM
DEFINEDIM: DIM←I
 → RERR IF 1<⍴⍴B ∨ IA←IC←0 ⍝B BETTER BE BIN SCA ∨ VECT
 → REDUCEEXPAND+0=N←'' ⍴ ⍴ B←,B
REDUCEEXPAND: → REDUCEEXPAND+IC=N // IA←IA+B[IC←IC+1]
 → NOMATCH UL IA=RA[DIM]
REMATCH: RA[DIM]←N
 → NULL IF 0=RC←'' ⍴ ⍴ C←,C
 A←,RA ⍴ ' ' 0[1+⊥ ''⍴C] // B←B,2 // AI←CI←0
 → LAST-⍳I=DIM
 → INCR+I=NN // N←RA[NN←1+DIM]
INCR: → INCR+I=NN // N←N × RA[NN←NN+1]
 I←0 // AI←AI-N
NLAST: → NLAST+B[I←I+1] // AI←AI+N // NN←0
 → NLAST+NN<N // A[AI+NN←NN+1]←C[CI←CI+1]
 → NLAST-⍳CI<RC
 RETURN // A←RA⍴A
 I←0
LAST: → LAST+B[I←I+1]
 → LAST // A[AI+I]←C[CI←CI+1]
 → LAST-⍳CI<RC // AI←AI+I-1
 RETURN // A←RA⍴A
NULL: RETURN // A←RA⍴0
FILL: RETURN // A←N⍴' ' 0[1+⊥ ''⍴C]
NOMATCH: → LERR UL (I=1) ∨ 1=RA[1]
 → FILL IF IA=0
 → REMATCH // C←IA⍴C ⍝DIM=1
LERR: 1 2 = 1 2 3
RERR: I=I⍴I←⍳2 ∇

⍝ PDF page 28
∇ Z←OUTONE[○QQ] A;B;I;NOBLANK
 →IPIO IF (ϵ⎕IO_BOXES) // Z←A ⍝ SAVE RETURN VALUE
 A←,A // NOBLANK←1+I←0
DECIDE: →LAST IF (⍴A)<I←I+1
 → (CH,NUMERIC)[1+⊥ B←A[I]]
CH: OUTCHARSC B // NOBLANK←1
 → DECIDE
NUMERIC: → PBL IF NOBLANK
 OUTCHARSC ' '
PBL: OUTNUMSC B
 → DECIDE // NOBLANK←0
IPIO: ⎕IO_BOXES[2] ⎕DELIVER A
LAST: →0∧⍳QQ // →0∧⍳~ϵQQ ⍝ EXIT NOW IF QQUAD OUTPUT
 ⊢←CRLF
∇

⍝ PDF page 29
∇ OUTNUMSC A;B;C;TEXP
 // OUTONE (A<0) ⍴ '-'
 → INT IF (B<1000000) ∧ (99999<B) ∨ B=⌊ B←| A // C←''
 → FLLT1 IF B<1 // TEXP←0
 → FLLT100000 IF B<100000
DOWN: → DOWN+(B←B÷10)<10 // TEXP←TEXP+1
 OUTNUMSC B
 OUTCHARSC 'E'
 OUTNUMSC TEXP
 RETURN
FLLT100000: OUTNUMSC ⌊ B
 OUTCHARSC '.'
 FRACTPART B
 RETURN
FLLT1: → FLLT1 IF (B←B × 10)<1 // TEXP←TEXP-1
 → DOWN+1
INT: → INT+0=B←A // C←'0123456789'[1+⌊ B-10×A←⌊ B÷10],C
 // OUTONE C
 RETURN ∇

⍝ PDF page 30
∇ FRACTPART A;B;SCALE
 SCALE←1 // B←6 ⍝ MAX SIGNIFICANT DIGITS
GETSC: → GETSC+A<SCALE←SCALE × 10 // B←B-1
DIGIT: OUTCHARSC '0123456789'[1+⌊ A←10 × A-⌊ A]
 → DIGIT IF (A>⌊ A) ∧ 0<B←B-1
∇

⍝ PDF page 31
∇ A←(⊣)
 // OUTONE '*'
 ⎕IO_BOXES[1] ⎕SETCONV 1
 A←⎕RECEIVE αA←⎕IO_BOXES[1]
 A←,A ⍝ NO FUNNY STUFF ALLOWED.
∇

⍝ PDF page 32
∇ A←INONE B;C;D
 // OUTONE B // A←''
 →IPIO IF ϵ⎕IO_BOXES
READ: → BSP IF '↑'=C←INCHARSC
 → NEWL IF '\'=C
 → DONE IF 109=⊤C ⍝CARRIER RETURN ENCOUNTERED.
 → READ // A←A,C
BSP: → READ // A←((0<D)×D←¯1+⍴A)⍴A
NEWL: → 1 // OUTONE '←<',CRLF
DONE: // OUTONE CRLF
 RETURN
IPIO: ⎕IO_BOXES[1] ⎕SETCONV 0
 A←⎕RECEIVE αA←⎕IO_BOXES[1]
∇

⍝ PDF page 33
∇ A←(⊢)
 A←INONE '' ∇

⍝ PDF page 34
∇ A←⎕INNUM;B;D;I;SIGN
 →IPIO IF ϵ⎕IO_BOXES
 →BADIS IF (A←0)=⍴B←INONE '⎕:     ',⊤106
 I←SIGN←'-' = ''⍴B
MORE: → NOMORE IF (⍴B)<I←I+1
 → BADIS IF (D<0) ∨ 9<D←(TBL[I])-⊤'0'
 → MORE // A←D+A × 10
BADIS: 'MALFORMED INTEGRAL SCALAR INPUT.'
 → 1
NOMORE: A←A × 1-SIGN+SIGN
 RETURN
NOGOOD: 'TRY AGAIN'
IPIO: // OUTONE '--> ',T106
 ⎕IO_BOXES[1] ⎕SETCONV 1
 A←⎕RECEIVE αA←⎕IO_BOXES[1]
 →NOGOOD IF 0=⍴A←(⊥A)/A
∇

⍝ PDF page 35
∇ B αCOMPAT C;A;I
 → SQUEEZE1B-(⍴B)=⍴C ⍝B ∧ C ARE VECTORS
 → 0 IF ANDREDUCE B=C
SQUEEZE1B: → SQUEEZE1C IF 0=I←'' ⍴ ⍴ B // A←''
 → SQUEEZE1B+⍳0<I←I-1 // A←A,B[I]+⍳1 ≠ B[I]
SQUEEZE1C: → TESTEQ IF 0=I←'' ⍴ ⍴ C // B←''
 → SQUEEZE1C+⍳0<I←I-1 // B←B,C[I]+⍳1 ≠ C[I]
TESTEQ: → LERR UL (⍴A)=⍴B
 → 0 IF ANDREDUCE A=B
LERR: 1 2 = 1 2 3 ∇

⍝ PDF page 36
∇ A←ASINDEX1[⍴B;I1] C;RC
 → IERR UL 1=⍴⍴B
 → DEFI1+ϵI1
DEFI1: I1←1 ⍴ B
 → SINGLE IF 1=RC←'' ⍴ ⍴ C←,A←C
 I1←,I1 // (⍴A) αCOMPAT ⍴I1
 → 0 IF 0=RC
AI1: → AI1+0=RC←RC-1 // B[I1[RC]]←C[RC]
 RETURN
SINGLE: → AI1-1 // C←(RC←'' ⍴ ⍴ I1←,I1) ⍴ C
IERR: 1 2[1;1] ∇

⍝ PDF page 37
∇ A←ASINDEX2[⍴B;I1;I2] C;I1R1;RC;R1;R2
 → IERR UL 2=⍴⍴B ⍝ CHECK RANK
 → DEFI1+ϵI1
DEFI1: I1←⍳(⍴B)[1]
 → DEFI2+ϵI2
DEFI2: I2←⍳(⍴B)[2]
 → SINGLE IF 2=RC←1+'' ⍴ ⍴ C←,A←C
 I1←,I1 // I2←,I2 // (⍴A) αCOMPAT (⍴I1),⍴I2
 → 0 IF 1=RC // R1←'' ⍴ ⍴ I1
 R2←'' ⍴ ⍴ I2 // I1R1←I1[R1]
AI1: → AI1+0=R2←R2-1 // B[I1R1;I2[R2]]←C[RC←RC-1]
 → AI1-⍳0<R1←R1-1
 RETURN
SINGLE: RC←1+'' ⍴ (⍴I1←,I1) × ⍴I2←,I2
 → AI1-2 // C←(RC-1) ⍴ C
IERR: 1 2[1;1] ∇

⍝ PDF page 38
∇ A←ASINDEX3[⍴B;I1;I2;I3] C;I1R1;I2R2;RC;R1;R2;R3
 → IERR UL 3=⍴⍴B ⍝ CHECK RANK
 → DEFI1+ϵI1
DEFI1: I1←⍳(⍴B)[1]
 → DEFI2+ϵI2
DEFI2: I2←⍳(⍴B)[2]
 → DEFI3+ϵI3
DEFI3: I3←⍳(⍴B)[3]
 → SINGLE IF 2=RC←1+'' ⍴ ⍴ C←,A←C
 (⍴A) αCOMPAT (⍴I1),(⍴I2),⍴I3
 I1←,I1 // I2←,I2 // I3←,I3
LASTCHK: R1←'' ⍴ ⍴ I1 // →0∧⍳1=RC
          R2←'' ⍴ ⍴ I2 // I1R1←I1[R1]
AI1:      R3←'' ⍴ ⍴ I3 // I2R2←I2[R2]
AI2: → AI2+0=R3←R3-1 // B[I1R1;I2R2;I3[R3]]←C[RC←RC-1]
 → AI2-⍳0<R2←R2-1
 → AI1-⍳0<R1←R1-1
 RETURN
SINGLE: RC←1+'' ⍴ (⍴I1←,I1) × (⍴I2←,I2) × ⍴I3←,I3
 → LASTCHK // C←(RC-1) ⍴ C
IERR: 1 2[1;1]
∇

⍝ PDF page 39
∇ Z←SQRT X;D;E;Y
 E←X÷0.5 COEFBEXP ⌊129+D+D←⌈0.5×(BEXP X+X=0)-128
 Y←2.185183-3.028991÷1.5451577+E+0∧1+E<0
 Z←0.5×Z+E÷Z←0.5×Y+E÷Y
 Z←Z × 0.5+0.5 × E←Z<1
 Z←(0<X) × Z COEFBEXP ⌊ 129+D-E ∇

⍝ PDF page 40
∇ P←QSC N;Q
 → 2+ϵRAND
 RAND←1⌈⌊|''⍴⎕INNUM // OUT[CRLF,' ENTER PSEUDO-RANDOM INTEGER BETWEEN 1 AND 1 MILLION']
 RAND←(1000×RAND-1000×⌊(RAND←(389×Q)+17×P)÷1000.)+17×Q←RAND-1000×P←⌊RAND÷1000. ⍝RAND←1E6|RAND×73*3
 P←1+⌊N×.99999⌊RAND÷1E6
∇

∇ AN←(*) U;F;G;H;I;J;L
 J←|U÷0.69314718
 G←⌊J+0.5
 H←J-G
 I←H × 0.69314718
 J←I × I
 F←2+J×(2520+28×J)÷15120+(420×J)+J×J
 L←(F+I)÷F-I
 H←L<1
 L←L × H+0.5 × ~ H
 F←L COEFBEXP ⌊ 129+G-H
 AN←((U<0)÷F)+F×U>0
∇

∇ ABB←A (*) B,10
⍝A TO THE B = EXP OF B TIMES NATURAL LOG OF A
 ABB←*B×LN A ∇

∇ AS←LN X;A;B;G0;A1;A2
 A←1 ∧ 1+X ≤ 0
 A←A+A←COEF X
 B←0.5 × 1+A
 A1←0.5 × B+G0←SQRT A
 A2←(0.5 × A1+SQRT A1 × G0)-0.25 × A1
 G0←0.69314718 × (BEXP X)-129
 AS←G0+0.703125×(A-1)÷A2-0.0625×A1-0.25×B
∇

⍝ PDF page 41
∇ C←A LN B,11
 C←(LN B) ÷ LN A ∇

∇ A ← B (⊤) C;RHOA
 → DONE IF 0=(I←(A←'')⍴⍴B←,B) × ⍴C←,C // RHOA←(⍴B),⍴C
LOOP: A←((-B[I]×C←⌊C÷B[I])+C),A ⍝PORNO
 → LOOP UL 0=I←I-1
DONE: A←RHOA ⍴ A
⍝ THIS DECODE DIFFERS FROM APL/360 IN THE TREATMENT OF:
⍝    NEGATIVE LEFT ARGUMENTS
⍝    ∧ NONCONFORMING DIMENSIONS
∇

∇ A ← B (⊥) C;COUNT;I;LASTI;RHOB
 → SCALAR IF 0=A←'' ⍴ ⍴ RHOB←⍴B
 → MAKEONE IF 1=COUNT←RHOB[A]
 → MATMULT IF 1=I←1+'' ⍴ ⍴ B←,B
LASTI←I-COUNT // A←1
ITER: → ITER+LASTI=I // A←(B[I]+A) × B[I←I-1]
 → ITER-⍳1<LASTI
MATMULT: RETURN // A←(RHOB ⍴ B)+.× C
SCALAR: A←1 // RHOB←⍴B←,B
MAKEONE: A←(RHOB ⍴ B∘.*A-⍳A←RHOB[A]←'' ⍴ (⍴C),1)+.× C
∇

⍝ PDF page 42
∇ ANNS←A CIRCLESC B;Z;Z2;K;L;M;N;P;Q;R
⍝ BRANCH TO THE APPROPRIATE PORTION OF CIRCLE
 → (ATH,ACH,ASH,M4,AT,AC,AS,ZER,SS,CS,TA,P4,SH,CSH,TH)[8+A]
⍝
⍝         ARCTANGENT HYPERBOLIC
⍝
ATH: ANNS←0.5×LN (1+B)÷1-B
 RETURN
⍝
⍝         ARCCOSINE HYPERBOLIC
⍝
ACH: ANNS←LN B+SQRT ¯1+B×B
 RETURN
⍝
⍝         ARCSINE HYPERBOLIC
⍝
ASH: ANNS←LN B+SQRT 1+B × B
 RETURN
M4: ANNS←SQRT (B+1) × B-1
 RETURN
ZER: ANNS←SQRT (1+B) × 1-B
 RETURN
P4: ANNS←SQRT 1+B × B
 RETURN
⍝
⍝         ARC TANGENT
⍝
AT: K←| B
 L←(0 ≤ K) ∧ (K ≤ 1)
 M←1<K
 N←(L×K)+M÷K+K=0 ⍝ ELSE ÷0 ERROR
 K← M × 1.5707963
 P←1-M+M
 L←(0 ≤ N) ∧ N ≤ 0.414213562373095
 M←(N ≤ 1) ∧ 0.414213562373095<N
 Q←(L × 0.198912367)+M × 0.668178637
 R←(L × 0.1963495408493621)+M × 0.5890486225480862
 L←(N-Q)÷1+Q×N
 Z←L × L
 Z2← Z × Z
 M←135135+(171962.4603936874 × Z)+52490.48316373623 × Z2
 M←M+2218.098888446071 × Z2 × Z
 N←135135+(217007.463936857 × Z)+97799.30329541391 × Z2
 N←N+10721.37452059297 × Z2 × Z
 ANNS←(×B)×K+P×R+L×M÷N
 RETURN
⍝
⍝         ARCCOSINE
⍝
AC: ANNS←1.5707963-¯1 CIRCLESC B
 RETURN
⍝
⍝         ARC SINE
⍝

⍝ PDF page 43
AS: K← | B
 L←(0 ≤ K) ∧ (K ≤ 0.5)
 M←(0.5 < K) ∧ (K ≤ 0.8660254037844387)
 N←(0.8660254037844387<K) ∧ (K ≤ 1)
 P←(M × 0.7853981633974485)+N × 1.5707963
 Q←L+(0.5 × M)-N+N
 R←(L×K)+(Mׯ1+2×K×K)+N×SQRT 0.5×1-K
 Z←R × R
 K←0.01731276426+Z×0.0223750091+Z×0.00934280551+Z×0.01433124507+Z×0.0183566709+Zׯ0.0118622397+Z×0.03162712225
 K←0.999999999+Z×0.166666666+Z×0.074999999+Z×0.0446428605+Z×0.0303818164+Z×K
 ANNS←(× B) × P+Q × K × R
 RETURN
SH: K← * B
 ANNS←0.5 × K-÷K
 RETURN
CSH: K← * B
 ANNS←0.5×K+÷K
 RETURN
TH: K← * B
 L←÷K
 ANNS←(K-L)÷K+L
 RETURN
TA: K←⌊ B÷PI
 L←PI × K+1.5707963<B-K × PI
 M← | B-L
 N←⌊M÷0.3926990816987241
 P←M-N × 0.3926990816987241
 R←(N=2)+(0.414213562373095 × N=1)+(2.414213562373095 × N=3)
 Z←P × P
 K←2027025+Zׯ270270+Z×6930+Zׯ36
 M←2027025+Zׯ945945+Z×51975+Zׯ630
 Q←P×K÷M
 ANNS←(×B-L)×(R+Q)÷1-R×Q
 RETURN
CS: P←Q-⌊Q←(|B)×0.15915494
 Q←((P-0.75)×(0.5≤P)∧P<1)+(0.25-P)×(0≤P)∧P<0.5
 R←Q×Q
 ANNS←Q×6.283185+Rׯ41.34168+R×81.60248+Rׯ76.58128+R×39.76072
 RETURN
SS: P←Q-⌊Q←(|B)×0.15915494
 Q←(P×(0≤P)∧P<0.25)+((P-1)×(0.75≤P)∧P<1)+(0.5-P)×(P≥0.25)∧P<0.75
 R←Q×Q
 ANNS←Q×6.283185+Rׯ41.34168+R×81.60248+Rׯ76.58128+R×39.76072
∇

⍝ PDF page 44
∇ A ← B (○) C,12;RA;I
 → ONEB IF ANDREDUCE 1=⍴B ⍝ VERRY VERRY LIKELY
 RA←⍴ A←B=C
 → DONE IF 0=I←'' ⍴ ⍴ C←(⍴ B←(⍴ A←,A) ⍴ B) ⍴ C
LOOP: A[I]←B[I] CIRCLESC C[I]
 → LOOP IF 0<I←I-1
DONE: RETURN // A←RA ⍴ A
ONEB: → 0 UL ANDREDUCE 1=⍴A←(''⍴B) CIRCLESC C
 A←(⍴B=C)⍴A ⍝ FORMAT ONE ELEMENT ANSWER
∇

∇ G←FACSC X;K
 → L14 IF X<0
 K←X-⌊ X
 G←Kׯ5.100461+Kׯ1.850729
 G←¯195.6928+Kׯ66.46644+Kׯ36.83094+G
 G←G÷¯195.6928+K×16.2694+K×36.8849+K×K-11.43218
 → 0 IF (1≤X) ∧ X<2
 → L11 IF X<1
 K←K+2
L8: G←G × K
 → L8 IF X≥K←K+1
 RETURN
L11: G←G÷1+K
 RETURN
 K←1+X-⌈ X
L14: G←Kׯ5.100461-K×1.850729
 G←¯195.6928+Kׯ66.46644+Kׯ36.83094+G
 G←G÷¯195.6928+K×16.2694+K×36.8849+K×K-11.43218
 G←G÷K+1
L16: G←G÷K
 → L16 IF X<K←K-1
∇

∇ A ← EXCLAMATION B,13;I
 →LOOP+1=I←1+''⍴⍴A←,B
LOOP: → LOOP+1=I // A[I]←FACSC A[I←I-1]
 A←(⍴B)⍴A ∇

⍝ PDF page 45
∇ COM ← B COMSC A
 →0 UL COM←B<A
 COM←(FACSC A) ÷ (FACSC B) × FACSC A-B ∇

∇ CUT←B EXCLAMATION A
 CUT←(EXCLAMATION A) ÷ (EXCLAMATION B) × EXCLAMATION A-B
∇

∇ A ← (?) B;I
 →LOOP+1=I←1+''⍴⍴A←,B
LOOP: → LOOP+1=I // A[I]←QSC A[I←I-1]
 A←(⍴B)⍴A ∇

∇ A←B (?) C;I;I2
 →DERR UL ((B<I←0)=C<B) ∧ B=⍴B
 →SAVEΔSP IF 300<C
 A←⍳C ⍝ ASSUME ENOUGH SPACE TO USE QUICKIE DYADIC ? ALGORITHM.
 →DONE IF C<2
AGAIN: ↓ A[I2←I+?C-I←I+1]
 A[I2]←A[I] ⍝ EXCHANGE A[I] WITH A[I2]
 A[I]←↑
 →AGAIN IF I<C-1
DONE: RETURN // A←B⍴A
DERR: A←2∧2
SAVEΔSP: A←?C ⍝ PERFORM THE MORE EXPENSIVE DYADIC ? ALGORITHM.
 →DONE IF B<2
NEW: →NEW+B<⍴A←A,I // →NEW IF (I←?C)ϵA
 →DONE
∇

⍝ PDF page 46
∇ OUT[○A;○B;○C;○D;○E;○F;○G;○H;○I;○J;○K;○L]
 ⊢←A // →2 UL ϵA
 ⊢←B // →3 UL ϵB
 ⊢←C // →4 UL ϵC
 ⊢←D // →5 UL ϵD
 ⊢←E // →6 UL ϵE
 ⊢←F // →7 UL ϵF
 ⊢←G // →8 UL ϵG
 ⊢←H // →9 UL ϵH
 ⊢←I // →10 UL ϵI
 ⊢←J // →11 UL ϵJ
 ⊢←K // →12 UL ϵK
 ⊢←L // →13 UL ϵL
∇

∇ αSTART DUMMY
 ⎕START 20 2 ⍝ 20 ↔↔24B ↔↔ LOGGING TERMINAL
 'ALL UP AND RUNNING (BELIEVE IT OR NOT)'
 →1
∇

∇ ⎕START TM_FN;A;B;C
 ⎕IO_BOXES←⎕BOXES_TERM TM_FN[1] // →2 IF ϵ⎕IO_BOXES
 ⎕SLAVES←0 6⍴0 // →3 IF ϵ⎕SLAVES
 CRLF, 'TYPE SUBJECT TERMINALS'
 →0∧⍳0ϵA // ⎕←'YOU ENTERED: ',A←⎕INNUM
AG: B←(⎕BOXES_TERM A[1]),(⎕CR_BOX 1),⎕CR_BOX 1
 OUT[C←'FROM ⎕START' ⎕CR_PROC [130 6,B,⎕CR_BOX 1;3] TM_FN[2] ]
 ⎕SLAVES←⎕SLAVES,[1] C,A[1],B
 →AG IF 0<⍴A←1↓A
∇

⍝ PDF page 47
∇ ⎕KILL ID;A;B
 →0 UL 6=⍴B←,(A←⎕SLAVES[;1]=ID)/⎕SLAVES // →0 UL ϵ⎕SLAVES
 ⎕SLAVES←(~A)/⎕SLAVES
 ⎕DE_PROC B[1]
 ⎕DETACH B[3 4] ⍝ ⎕IO_BOXES
 ⎕DE_BOX B[3] // ⎕DE_BOX B[4]
 ⎕DE_BOX B[5] // ⎕DE_BOX B[6] ⍝ ⎕IPC_BOXES
∇

∇ ID αINIT STATE
 ⎕ID←ID
 →0∧⍳~ϵSTATE ⍝ HEADER ACTS LIKE ID αINIT[○STATE]
 ⎕WIDTH←STATE[1]
 ⎕DIGITS←STATE[2]
 ⎕IO_BOXES←STATE[3],STATE[4]
 ⎕IPC_BOXES←STATE[5],STATE[6]
 ⎕ALARM←STATE[7]
 CRLF
∇

∇ R ← P ⎕CR_PROC[○STATE;○N] FNUM
 →INIT_N + ϵN ⍝ SHOULD DEFAULT BE USED?
INIT_N: N←4 ⍝ YES.
 ↓ P // ↓ N // ↓STATE // ↓ FNUM
 R←↑ // ATTN 1 ∇

∇ BOXES←⎕BOXES_FILE FILE
 ↓BOXES←(⎕CR_BOX 1), ⎕CR_BOX 1 // ↓FILE
 7 αATN ↑ ⍝ ATTACHFILE ATTENTION TRAP
∇

⍝ PDF page 48
∇ BOXES←⎕BOXES_TERM TERM
 ↓BOXES←(⎕CR_BOX 1), ⎕CR_BOX 1 // ↓TERM
 ATTN 8 ⍝ ATTACHTERMINAL TRAP
∇

∇ M←⎕RECEIVE ⍴B
 ATTN 9 // ↓ B
 B←↑ // M←↑ ∇

∇ B ⎕SETCONV L
 ATTN 12 // ↓ B // ↓ L ∇

∇ STAMP←⎕TS
 STAMP←↑
∇

⍝ PDF page 49
∇ ⎕S_AL[○ALARM]
 →DEFΔALARM+ϵALARM
DEFΔALARM: ALARM←⎕ALARM
∇

∇ T←⎕R_AL[○ALARM]
 →DEFΔALARM+ϵALARM
DEFΔALARM: ALARM←⎕ALARM
∇