LOC Data_Segment
HEAD    OCTA
head    GREG    HEAD

% Author unknown
% This is an implementation of Algorithm S of section 2.3.1.
% The first octabyte of each node is the left link, and the
% second is the right link.   The least significant bit of
% the links is used as a tag bit.
%
% For the program to work correctly, all links to the head
% must have bits 1 and 2 cleared (that is, the link&6 must
% be 0.)
% The program strips the tag bit from links before calling VISIT
%
% Total run time for the program is: (9+12n-a) oops and 2(n+1) mems
 
p       IS      $0                      P
q       IS      $1                      Q
thead   IS      $2                      tagged head pointer
arg     IS      $4
t       IS      $255
 
LLINK   IS      0
RLINK   IS      8
DATA    IS      16
 
        LOC     #100
S0      LDO     p,head,LLINK    1       S0. Initialize. Set P <- HEAD
        OR      thead,head,1    1       Set thead
        JMP     2F              1
S3      ANDN    arg,p,1         n       S3. Visit P.  Remove tag bit
        PUSHJ   arg-1,VISIT     n       Visit P
S1      LDO     p,p,RLINK       n       S1. RLINK(P) a thread? get
RLINK(P)
        PBOD    p,1F            n       Jump if P is odd
        SET     q,p             n-a     Otherwise set Q <- RLINK(P)
S2      SET     p,q             n       S2. Search to left.  Set P <- Q
2H      LDO     q,p,LLINK       n+1     Q <- LLINK(P)
        BEV     q,S2            n+1     If not tagged, repeat
1H      CMP     t,thead,p       n+1
        PBNZ    t,S3            n+1     Visit unless P = HEAD
 
DONE    TRAP    0,Halt,0
 
% --------------------------------------------------------------------
 
% Testing routines
 
NewLn   BYTE    #a,0
VISIT   LDA     t,$0,DATA
        TRAP    0,Fputs,StdOut
        SET     t,NewLn
        TRAP    0,Fputs,StdOut
        POP     0,0
 
        LOC     HEAD
        OCTA    R,HEAD|1
R       OCTA    TL,TR ; BYTE    "R",0
TL      OCTA    TLL,TLR ; BYTE  "TL",0
TLL     OCTA    TLLL,TL|1 ; BYTE        "TLL",0
TLLL    OCTA    HEAD|1,TLLLR ; BYTE     "TLLL",0
TLLLR   OCTA    TLLL|1,TLL|1 ; BYTE     "TLLLR",0
TLR     OCTA    TLRL,TLRR ; BYTE        "TLR",0
TLRL    OCTA    TL|1,TLR|1 ; BYTE       "TLRL",0
TLRR    OCTA    TLR|1,R|1 ; BYTE        "TLRR",0
TR      OCTA    TRL,TRR ; BYTE  "TR",0
TRL     OCTA    R|1,TR|1 ; BYTE      "TRL",0
TRR     OCTA    TR|1,HEAD|1 ; BYTE      "TRR",0
 
 
 
Main    IS      S0