; - - - - - - - - - - - - - - - - - - - - - - -
        $MACRO print
        ** p%%t <#@*(1"Z)>
        $ENDM
; - - - - - - - - - - - - - - - - - - - - - - -
        $MACRO p%%t
        printf "#@1=(%d)(%o)" <#@1> <#@1>
        $ENDM
; - - - - - - - - - - - - - - - - - - - - - - -
/
        yes=1
        no=0
        debug=no

	cntl==140        ;add this to a control char to get ascii
        control==-1      ;type of all control chars

        program jpl

        .mcall gprt$,dir$
gprt:   gprt$ psdev,tbuf ;get partition info on `psdev' its only on a machine
tbuf:   .blkw 3
speed:: .word 9600.      ;speed of terminal if this is small, assume no crt
cret:   .byte 15,0
ech:    .asciz '=x'
fact:   .asciz 'reserved letters=(f,g,i,m,o,q,r,s,u,z)'
prm:    .asciz    <15>'a>'
btab:   .asciz /abcdehjklnptvwxy/
        .even
mcr:    .byte 127.,41.  ;get mcr cmd line dpb

        struct input
            member term
            member string[82.]
        end-struct input

        .mcall exit$s

start:
        jsr pc,main             ;we want this prog as small as possible
        exit$s                  ;so don't use std main stuff

        auto s[84.],t,len,lh[8.],p,star,ch
        auto t1,pt,t2
function main
        cur=r3
        trm=r4
        dir$ #gprt              ;we do a get partition on psdev to tell which
				;machine we are on. Then adjust prompt to a/b.
        if cs
            movb #'b,prm+1      ;if no picture system, then its the b system.
        fi

        .if eq debug-yes
	movb #76,prm+1          ;an >> prompt so's we can tell who we is
        .endc



        r2 := &s                ;do a get mcr into array s
        (r2) := mcr
        dir$ r2

        if 6(r2)  = #<"SL>      ;slow terminal= sl on cmd line
            mov #300.,speed
        fi


        .lh[#3] := #0         ;clear data cell of list head
        ilist[&lh]            ;init list
        stuff[lh,#con.a,""]   ;initially two buffers, control-a,-b, both null
        stuff[lh,#con.b,""]   ;
        cur := next[lh]       ;start at first buffer in list
        do forever
            do forever
		t := line[&s,speed,#prm]        ;read a line, t=line terminator
                break if t ne #-1               ;until there was no timeout
                r0 := "  Time out at:"          ;in which case just spawn
                call outstr                     ;a time command so we know the
                call creturn                    ;terminal has been inactive
                system["tim"]                   ;and up for grabs
            od
            len := strlen[&s]                   ;get length of input line
            trm := ctype[t]                     ;find type of the terminator
            if len = #0                         ;a command
                begin
                select terminator-type trm for

                case #cr                        ;edit mode
                    if editm[lh,cur,&s]  ne #0
                        call creturn
                        system[<cur + #string>]
                    fi
                    break
                case #esc                       ;rotate buffers
                    cur := next[cur]
                    if cur = lh
                        cur := next[cur]
                    fi
                    call creturn
                    p := cur                    ;shift to next buffer and
                    call prnt                   ;print it
                    break

                case #control                   ;get from buffer t
                    r2 := find[lh,t]
                    if (r2) = t
                        r0 := r2 + #string
                        call outstr
                        call creturn
                        system[<r2 + #string>]
                    else
                        call creturn
                        printf "undefined string `%c'" <t + #cntl>
                    fi
                    break

                case #con.z                     ;clear current buffer
                    #string[cur] := #0
                    break

                case #con.f                     ;display facts
                    if speed gt #600.
                        mov #fact,r0
                        call outstr
                    fi
                    call creturn
                    for <let p = next[lh]> <while p ne lh> <let p = next[p]>
                        call prnt
                    rof
                    break
                case #con.qq                    ;control ? = help message
                    call creturn
                    system["h jplconq"]         ;spawn a help command
                    break
                case #0                         ;control null debug
                    call creturn
                    ldump[lh]
                    printf "&s=%o t=%o cur=%o" &s,t,cur
                    printf "editm=(%o) change=(%o) find=(%o)"  #editm #change #find
                    break
                default
                    jmp none
                esac
                end
            else                                ;not a zero length line
                select terminator-type trm for
                case #con.qq                    ;^? find 1st avail buffer
                    call conqq
                    break
                case #control                   ;stuff buffer t
conques:
                    stuff[lh,t,&s]
                    outterm[t]
                    break
                case #cr                        ;execute line and save
                    cpy[cur,&s]                 ;in current buffer
                    call creturn
                    system[&s]
                    break
                default
none:
                    call creturn
                    printf "I can't do that"
                esac
            fi

        od
done:
        ret

conqq:
        pt := #btab
        for <let p = next[lh]> <while p ne lh> <let p = next[p]>
            if p ne cur
                t1 := #term[p]
                t2 := #0[pt,b]
                if t1 ne <t2 - #cntl> or strlen[<p + #string>] = #0
qq1:
                    t := t2 - #cntl
                    jmp conques
                fi
            fi
            inc pt(r5)
        rof
        t2 := #0[pt,b]
        if t2 ne #0
            br qq1
        else
            call creturn
            printf "No more buffers"
        fi
        rts pc
prnt:                                           ;prints buf at p
        if p = cur
            star := #'*
        else
            star := #space
        fi
        printf "%c%c=(%s)" star  <@p(r5) + #cntl> <p + #string>
        rts pc


creturn::                                       ;output a cr
        push r0
        mov #cret,r0
        call outstr
        pop r0
        rts pc

        auto ch
function outterm[t]                             ;outputs =x for terminator x
        ch := t + #cntl
        movb ch(r5),ech+1
        mov #ech,r0
        call outstr
        ret


function stuff[lh,t,s]  ;stuff s into buf t in list lh (extend if nec)

        found=r4
        new.cell=r2

        found := find[lh,t]
        if term(found) = t
            cpy[found,s]
        else
            new.cell := insert[prev[found],new[#input]]
            term(new.cell) := t
            cpy[new.cell,s]
        fi
        ret


function cpy[into,s]                            ;copy string s into buffer

        r2 := into + #string
        clrb (r2)
        cat[r2,s,#0]
        ret

function find[lh,t]                ;returns node with term=t or ret ins loc

        this=r4
        this := lh
        do forever
            this := next[this]
            if term(this) ge t  or  this = lh
                ret this
            fi
        od



function ctype[term]   ;returns type of the terminator
;
; returns are:
;               ^z       ^f      ^?     others
;   cr   esc   con.z   con.f   con.qq   control
;
; where control means any undefined control char
; i.e. used for buffers
;
        r4 := term
        select case r4 of

        case #cr
            ret #cr

        case #esc
            ret #esc

        case #con.z
            ret #con.z

        case #con.f
            ret #con.f

        case #con.qq
            ret #con.qq
        case #0
            ret #0
        default
            ret #control
        esac
        .end start
