inish
            %repeat
            %if adim # 0 %or %not a(left) %start
               %if adim = 0 %start
                 syntax error %if decl_flags >= 0
                 adim = 1
               %finish
               get ARRAY DECLARATION(adim)
               -> exit2
            %finish
            get ARRAY DECLARATION(adim)
          %finish
          -> exit2 %if %not a(comma)
          atom = next atom
        %repeat %until atom # ident
exit22:
        %continue
      %finish
    %finish
    %exit %if %not a(comma);  ![NB %continue above]
  %repeat
exit2:
  max = disp %if disp > max
%repeat %until %not a(keyor)
disp = max
%end;  !get declaration

initial(keyconst):
  literal = 1
  get DECLARATION(okflag+readable,constmode,cad,0)
  -> term

initial(atsign):
  dump = 0
atted:
  fault(lowlevel+warn+point) %and control = control!lowbit %if control&lowbit = 0
  get LITERAL(inttype)
  jokerad = value
  %if a(left) %start
    get MIDENT(a0,a7)
    get(right)
    value = item+(dispmode-a0)
  %finish %elsPE,VAL) PER TAG
%INTEGERARRAY L(1:80);      !SOURCE LINE
%SWITCH BIF(1:7);           !BUILT-IN FUNCTIONS (ASSEMBLER DIRECTIVES)
%SWITCH F(0:4)

%ROUTINESPEC FAULT(%INTEGER F)

%ROUTINE SKIP
  SPOS=SPOS+1 %WHILE L(SPOS)=' '
%END

%ROUTINE READLINE
%INTEGER SYM
  SPOS=1; CURRENTLINE=CURRENTLINE+1
  %CYCLE
    READSYMBOL(SYM); %EXITIF SYM=NL
    %IF SPOS=80 %START;        !THROW AWAY REST
      READSYMBOL(SYM) %UNTIL SYM=NL
      %EXIT
    %FINISH
    L(SPOS)=SYM; SPOS=SPOS+1
  %REPEAT
  L(SPOS)=NL; SPOS=1
  PRINTED=0
%END

%ROUTINE LOOKUP
%INTEGER TRIED
  POS=(TAG1>>7+TAG2>>5+TAG1+TAG2)&TMASK<<2; !HASH VALUE
  TRIED=0; FOUND=0; TYPE=0; VAL=0
  %CYCLE
    %RETURNIF T(POS)=0;      !EMPTY SLOT
    %IF T(POS)=TAG1 %AND T(POS+1)=TAG2 %START
      TYPE=T(POS+2); VAL=T(POS+3)
      FOUND=1
      %RETURN
    %FINISH
    POS=(POS+4)&TMAX
    TRIED=TRIED+1
    FAULT('C') %ANDRETURNIF TRIED>=TMASK;  !DICT FULL
  %REPEAT
%END

%ROUTINE OCT(%INTEGER X,Y)
%INTEGER Z
  SPACE
 %IF THREE=3%START;         !OCTAL
  Y=Y+Y+Y-3
  %CYCLE Y=Y,-3,0
    PRINTSYMBOL(X>>Y&7+'0')
  %REPEAT
 %ELSE;               !HEX
  Y=Y<<2-4
  %CYCLE Y=Y,-4,0
    Z=X>>Y&15
    Z=Z+7 %IF Z>9
    PRINTSYMBOL(Z+'0')
  %REPEAT
 %FINISH
%END

%ROUTINE NEWLINE
  %RETURNUNLESS PASS>0
  %IF LINES=63 %START
    PRINTSYMBOL(FF)
    PRINTSYMBOL(NL)
    LINES=1
  %FINISH
  PRINTSYMBOL(NL); LINES=LINES+1
  FSYM=' '
%END

%PREDICATE TAG
%INTEGER K
%INTEGERNAME T
  %PREDICATE LET
     K=L(SPOS)
     %FALSEIF K>'Z'
     %FALSEIF K<'A'
     K=K-'A'+1
     %TRUE
  %END
  %PREDICATE DIG
     %FALSEIF K>'9'
     %FALSEIF K<'0'
     K=K&15+27
     %TRUE
  %END
  %PREDICATE T1
  %INTEGER I
    %CYCLE I=1,1,3
      %EXITUNLESS LET %OR DIG
      SPOS=SPOS+1
      T=T*36+K
    %REPEAT
    %TRUEUNLESS T=0
    %FALSE
  %END
  TPOS=SPOS;                 !FRIG FOR BACK-TRACKING
  T==TAG1; TAG2=0
  TAG1=0; %FALSEUNLESS LET
  %FALSEUNLESS T1
  FOUND1=0
  LOOKUP
  %IF FOUND#0 %START
    FOUND1=POS; TYPE1=TYPE; VAL1=VAL
  %FINISH
  T==TAG2; %TRUEUNLESS T1
  %WHILE LET %OR DIG %CYCLE
    SPOS=SPOS+1
  %REPEAT
  LOOKUP
  %TRUE
%END

%ROUTINE PRINTLINE
%INTEGER I,K
  I=1
  %CYCLE
    K=L(I)
    PRINTSYMBOL('^') %IF I=FPOS
    %EXITIF K=NL; PRINTSYMBOL(K)
    I=I+1
  %REPEAT
%END

%ROUTINE FAULT(%INTEGER F)
  FAULTS=FAULTS+1
  %RETURNUNLESS FAULTY=0 %AND PASS#0; FAULTY=1
  FSYM=F; %IF F='F' %THEN FPOS=SPOS %ELSE FPOS=TPOS; !BACKTRACK
  SELECTOUTPUT(REPORT)
  PRINTSYMBOL(FSYM)
  OCT(ADDR,FIVE); SPACE
  %IF FSYM#'$' %START
    OCT(VAL,SIX); SPACE
  %finishELSE FPOS=0
  SPACE; PRINTLINE
  PRINTSYMBOL(NL)
%END

%PREDICATE S(%INTEGER X)
  K=L(SPOS)
  %FALSEIF K#X
  SPOS=SPOS+1
  %TRUE
%END

%PREDICATE NUM; !RECOGNISES CHARACTER OR (SIGNED) DECIMAL CONSTANTS
                !OR HEX CONSTANTS OF THE FORM  X'....'
%INTEGER SIGN,D,START
  START=SPOS; SIGN=L(SPOS)
  SPOS=SPOS+1 %IF SIGN='-' %OR SIGN='\'
  %IF S('''') %START
    VAL=L(SPOS); SPOS=SPOS+1
    ->NO %UNLESS S('''')
    %IF VAL='''' %START
      ->NO %UNLESS S(VAL)
    %FINISH
    ->END
  %FINISH
  %IF L(SPOS)='X' %AND L(SPOS+1)='''' %START;   !HEX
    SPOS=SPOS+2
    VAL=0
    %CYCLE
      %EXITIF S('''')
      D=L(SPOS); D=D-7 %IF D>='A'; D=D-'0'
      FAULT('F') %ANDFALSEUNLESS 0<=D<=15
      SPOS=SPOS+1
      VAL=VAL<<4+D
    %REPEAT
    ->END
  %FINISH
  VAL=0; D=L(SPOS)
  %IF BASE=10 %START;      !DECIMAL RADIX
    %UNLESS '0'<=D<='9' %START
NOQ: FAULT('F') %IF SIGN='-' %OR SIGN='\'
NO: SPOS=START; %FALSE
    %FINISH
    %CYCLE
      VAL=(VAL<<2+VAL)<<1+D-'0'; SPOS=SPOS+1
      D=L(SPOS); %EXITUNLESS '0'<=D<='9'
    %REPEAT
  %ELSE;                         !OCTAL RADIX
    ->NOQ %UNLESS '0'<=D<='7'
    %CYCLE
      VAL=VAL<<3+D-'0'; SPOS=SPOS+1
      D=L(SPOS); %EXITUNLESS '0'<=D<='7'
    %REPEAT
  %FINISH
END:
  VAL=-VAL %IF SIGN='-'
  VAL=\VAL %IF SIGN='\'
  %TRUE
%END

%ROUTINE GETEXP(%INTEGER CONTROL); !EVALUATES ASSEMBLY-TIME EXPRESSIONS
!* CONTROL=1 MEANS FIRST OPERAND ALRADY MATCHED
!* CONTROL=0 MEANS FIRST OPERAND YET TO BE MATCHED
%SWITCH O('!':'-')
%INTEGER OPR
  %IF CONTROL#0 %START
    ACTYPE=TYPE
    ACVAL=VAL
  %ELSE
    OPR='$';ACTYPE=0; ACVAL=0;       !ASSIGN
LOOP: SKIP
    %IF NUM %START
      TYPE=CONST
    %ELSEIF TAG
      FAULT('U') %IF TYPE=0
      FAULT('I') %IF OP&TYPE#0 %AND PASS>=0
    %ELSEIF S('*')
      TYPE=MEM; VAL=STAR
    %FINISH
    ->O(OPR)
!*
O('$'): ACVAL=VAL; ->JOIN;       !ASSIGN
O('#'): ACVAL=ACVAL<<VAL;        !LEFTSHIFT
SH: FAULT('L') %IF ACTYPE &MEM#0; ->J
O('%'): ACVAL=ACVAL>>VAL;        !RIGHTSHIFT
->SH
O('+'): ACVAL=ACVAL+VAL;         !ADD
L: FAULT('L') %IF ACTYPE&TYPE&MEM#0;  !SUM OF ADDRESSES INVALID
->JOIN
O('!'): ACVAL=ACVAL!VAL; ->L;    !OR
O('&'): ACVAL=ACVAL&VAL; ->L;    !AND
O('"'): ACVAL=ACVAL!!VAL; ->L;   !XOR
O('-'): ACVAL=ACVAL-VAL;         !MINUS
TYPE=TYPE!MINUSMEM&(\MEM) %IF TYPE&MEM#0
!*
JOIN: K=MEM+MINUSMEM
      FAULT('I') %IF ACTYPE&TYPE!K!CONST#K!CONST
      ACTYPE=ACTYPE!TYPE
ACTYPE=ACTYPE&(\K)!CONST %IF ACTYPE&K=K; !NEUTRALISE ADDRESS DIFFERENCES
%FINISH
J: SKIP
!*
%IF S('!') %OR S('&') %C
%OR S('<') %OR S('>') %C
%OR S('+') %OR S('-') %C
%OR S('\') %START
  %IF K='<' %OR K='>' %START
    FAULT('F') %ANDRETURNUNLESS S(K); !MUST HAVE TWO SYMS FOR SHIFTS
    K=K-25;                 !MAP INTO RANGE OF SWITCH
  %FINISH
  K='"' %IF K='\'; !MAP INTO RANGE
  OPR=K; ->LOOP
%FINISH
!*
%END

%ROUTINE GETLIT;  !RECOGNISE FIXED ADDRESS OR CONSTANT
  GETEXP(0); FAULT('I') %UNLESS 0#(MEM+CONST)&ACTYPE=ACTYPE
%END

%ROUTINE ADDRESS(%INTEGER Q)
  LOC=LOC-Q
  SELECTOUTPUT(LIST); PRINTSYMBOL(FSYM)
  OCT(LOC,FIVE); SPACE
  LOC=LOC+Q
%END

%ROUTINE PRINT(%INTEGER S)
  %IF PRINTED=0 %START
    PRINTED=1
    SPACES(S) %UNLESS L(1)=NL
    PRINTLINE
  %FINISH
  NEWLINE
%END

%ROUTINE LISTLINE
  %RETURNIF PRINTED#0 %OR PASS<=0
  SELECTOUTPUT(LIST)
  PRINTSYMBOL(FSYM); PRINT(TWENTYONE)
%END

%ROUTINE PUT(%INTEGER V)
  SELECTOUTPUT(BIN); PRINTSYMBOL(V)
  PRINTSYMBOL(V) %IF V=EOT; !TRANSPARENCY
%END

%PREDICATE YOU WANT TO LIST
  %TRUEIF CONTROL&1#0 %AND PRINTED=0
  %TRUEIF CONTROL&2#0
  %FALSE
%END

%ROUTINE DUMP1(%INTEGER V)
  LOC=LOC+1; %RETURNUNLESS PASS>0
  PUT(V); %RETURNUNLESS YOU WANT TO LIST
  ADDRESS(1); OCT(V,THREE); PRINT(TEN)
%END

%ROUTINE DUMP2(%INTEGER V1,V2)
  LOC=LOC+2; %RETURNUNLESS PASS>0
  PUT(V1); PUT(V2); %RETURNUNLESS YOU WANT TO LIST
  ADDRESS(2); OCT(V1,THREE); OCT(V2,THREE); PRINT(SIXX)
%END

%ROUTINE DUMP3(%INTEGER V1,V2,V3)
  LOC=LOC+3; %RETURNUNLESS PASS>0
  PUT(V1); PUT(V2); PUT(V3); %RETURNUNLESS YOU WANT TO LIST
  ADDRESS(3); OCT(V1,THREE); OCT(V2,THREE); OCT(V3,THREE); PRINT(2)
%END

%ROUTINE V2
  GETLIT; FAULT('I') %IF ACTYPE&MEM#0
  FAULT('T') %UNLESS -4<=ACVAL<=3
  BYTE0=ACVAL&3+BYTE0
%END

%ROUTINE COMMA
  FAULT('F') %UNLESS S(',')
%END

%ROUTINE V8
  GETLIT
  FAULT('T') %UNLESS -256<=ACVAL<=255
  BYTE1=ACVAL&255
%END

%ROUTINE V7S
  GETLIT; FAULT('I') %IF ACTYPE&MEM#0
  FAULT('T') %UNLESS -64<=ACVAL<=63
  BYTE1=ACVAL&127+BYTE1
%END

%ROUTINE INDIR
  BYTE1=128 %IF S('@')
%END

%ROUTINE INDEX
%INTEGER K
  %RETURNIF OPTYPE=2
  %IF S('*') %THEN K=96 %AND ->END
  K=L(SPOS)
  %IF (S('+') %OR S('-')) %AND S('*') %START
    %IF K='+' %THEN K=32 %ELSE K=64
  %finishELSE K=0
END:
  BYTE1=BYTE1+K
%END

%ROUTINE V13
%INTEGER MASK
  MASK=16_1FFF; MASK=16_7FFF %IF OPTYPE=2
  GETLIT
  FAULT('T') %UNLESS ACVAL&MASK=ACVAL
  BYTE1=(ACVAL>>8)&31+BYTE1; BYTE2=ACVAL&255
%END


!!! MAIN PROGRAM

!INITIALISATION

%string(255)file

file = cliparam
openinput(source,file.".2650")
openinput(predef,"assem:2650.def")
openoutput(bin,file.".obj")
openoutput(list,file.".lis")

T(I)=0 %FOR I=0,4,TMAX-3;  !CLEAR DICTIONARY
LPOS=0; PASS=-1; SELECTINPUT(PREDEF)
DO PASS: LOC=0; ADDR=0; STAR=0; FAULTS=0
CURRENTLINE=0; FAULTY=0; FSYM=' '; PRINTED=1
SELECTOUTPUT(LIST)
%IF PASS>0 %START
  PRINTSTRING("

                        EUCSD  Signetics 2650 Assembler

")
  LINES=4
%FINISH

!MAIN LOOP

NLINE: LISTLINE; PRINTED=0; FAULTY=0; FSYM=' '; FPOS=0
  READLINE; ADDR=LOC
  %WHILE L(SPOS)=NL %CYCLE
    LISTLINE %IF YOU WANT TO LIST
    READLINE
  %REPEAT
LOOP: SKIP; STAR=LOC; LABEL=0; GEN=1
  %IF S('$') %AND S('/') %START;  !SPECIAL COMMENT
      SELECTOUTPUT(LIST)
     LINES=63; NEWLINE
      ->NLINE
  %FINISH
  ->NLINE %IF S('/');       !COMMENT: IGNORE

  BYTE0=0; BYTE1=0; BYTE2=0; OPTYPE=0

%IF TAG %START
  %IF FOUND1#0=FOUND %AND TYPE1&3#0 %START
    BYTE0=VAL1; OPTYPE=TYPE1
    %IF TYPE1#3 %START
      T2=TAG2
      %IF TYPE1=1 %START; !ZIRA
        %IF T2=TAGZ %START
F(0):     V2; DUMP1(BYTE0); ->JOIN
        %FINISH
        %IF T2=TAGI %START
          BYTE0=BYTE0+4
F(2):     V2; COMMA
F(1):     SKIP; V8; DUMP2(BYTE0,BYTE1)
          ->JOIN
        %FINISH
      %FINISH
      %IF T2=TAGR %START
          BYTE0=BYTE0+8
          V2; COMMA; SKIP; INDIR; ->RELATIVE
F(3):     SKIP; INDIR
          %IF BYTE0&16_10=0 %START
            V7S
          %ELSE; !(BYTE0&16_10#0) I.E. REL BRANCH
RELATIVE:   V13; ACVAL=ACVAL-LOC-2
            FAULT('T') %UNLESS -64<=ACVAL<=63
            BYTE1=ACVAL&127+BYTE1&128
          %FINISH
          DUMP2(BYTE0,BYTE1); ->JOIN
        %FINISH
        %IF T2=TAGA %START
          BYTE0=BYTE0+12
          V2; COMMA
F(4):     SKIP; INDIR; INDEX; V13
          DUMP3(BYTE0,BYTE1,BYTE2); ->JOIN
        %FINISH
        FAULT('F')
      %FINISH
    %FINISH
  %IF FOUND#0 %START
    ACTYPE=TYPE; ACVAL=VAL
    %IF TYPE&3=3 %START
      BYTE0=VAL; BYTE1=0; BYTE2=0
      OPTYPE=2 %IF TYPE=16_43
      T2=TYPE>>4; ->F(T2)
    %FINISH
    ->BIF(VAL) %IF ACTYPE&SPECIAL#0
    FAULT('D') %IF ACTYPE&DUPLICATE#0
    %IF S('=') %OR S(':') %START
      T(POS+2)=DUPLICATE %IF PASS=0
      %IF L(SPOS-1)=':' %THEN LABEL=1 %ELSE GETLIT
      ->JOIN
    %FINISH
    GETEXP(1)
PUTVAL: SKIP; K=L(SPOS)
    FAULT('F') %UNLESS K=';' %OR K=NL %OR K='/'
    %IF -256<=ACVAL<=255 %THEN DUMP1(ACVAL) %ELSESTART
      DUMP2(ACVAL>>8,ACVAL&255)
    %FINISH
  %ELSE
    %IF S('=') %START
      T(POS)=TAG1; T(POS+1)=TAG2;
      X=POS+2
      GETLIT; T(X)=ACTYPE
      %IF S('_') %START
        T(X)=ACVAL
        GETLIT; FAULT('I') %UNLESS ACTYPE=CONST
      %FINISH
      T(X+1)=ACVAL
    %ELSEIF S(':')
      LABEL=1
      T(POS)=TAG1; T(POS+1)=TAG2
      X=POS+2; T(X)=MEM
      T(X+1)=LOC
    %ELSE
      FAULT('U'); LOC=LOC+2
    %FINISH
  %FINISH
%ELSEIF S('''')
  %CYCLE
    %IF S('''') %START
      %EXITUNLESS S('''')
      SPOS=SPOS-1
    %FINISH
    DUMP1(L(SPOS))
    %IF L(SPOS)=NL %START
      LISTLINE; READLINE; SPOS=0
    %FINISH
    SPOS=SPOS+1
  %REPEAT
%ELSE
  GETLIT; ->PUTVAL
%FINISH

JOIN: SKIP
->NLINE %IF L(SPOS)=NL %OR L(SPOS)='/'
->LOOP %IF LABEL#0 %OR S(';')
FAULT('F')
%CYCLE
  ->NLINE %IF L(SPOS)=NL %OR L(SPOS)='/'
  ->LOOP %IF S(';')
  SPOS=SPOS+1
%REPEAT

BIF(1):                               !LOC   (SETLOC)
    GETLIT; LOC=ACVAL; ->JOIN
BIF(2):                               !BLOCK (SETLOC+REL)
    GETLIT; VAL=LOC+ACVAL
    FAULT('I') %UNLESS ACTYPE&CONST=ACTYPE %AND 0<=ACVAL<=511
    DUMP1(0) %WHILE VAL#LOC
    ->JOIN
BIF(3): GETLIT; CONTROL=ACVAL;              !CONTROL
    ->JOIN
BIF(5):                                     !OCTAL INPUT
    BASE=8; ->JOIN
BIF(6):                                     !DECIMAL INPUT
    BASE=10; ->JOIN
BIF(7):                 !HEX OUTPUT
  THREE=2; FIVE=4; SIX=4; SIXX=5; TEN=8
  TWENTYONE=17; ->JOIN
BIF(4):                                     !END
%IF PASS<=0 %START
  PASS=PASS+1
  %STOPIF PASS=0#FAULTS; !PREDEFS HAVE ERRORS
  SELECTINPUT(SOURCE)
  RESETINPUT;       !TO RE-READ
  ->DO PASS
%FINISH
SELECTOUTPUT(REPORT); PRINTSYMBOL(STX)
TPOS=0; VAL=FAULTS; FAULTS=1 %IF FAULTS#0
FAULT('$'-FAULTS)
LISTLINE; NEWLINE
SELECTOUTPUT(LIST); PRINTSYMBOL(FF)
SELECTOUTPUT(BIN); PRINTSYMBOL(EOT); PRINTSYMBOL(0)
%IF CONTROL&4#0 %START; !MONITOR DICTIONARY
  %CYCLE I=0,4,TMAX-3
    NEWLINE %IF I&255=0
    %IF T(I)=0 %THEN PRINTSYMBOL('_') %ELSE PRINTSYMBOL('+')
  %REPEAT
  NEWLINE
%FINISH
%ENDOFPROGRAM