         Edinburgh IMP77 Compiler - Version 8.4

    1  %begin
    2  {--------------------------------}
    3  {                                }
    4  {   Motorola M6809 Assembler.    }
    5  {                                }
    6  { Copyright M.R.King, 26/3/1984. }
    7  { All rights reserved.           }
    8  {                                }
    9  {--------------------------------}
   10  
   11  %own %string(255) copyright = %c
   12+ "Motorola M6809 Assembler. Copyright M.R.King, 26/3/1984. All rights reserved."
   13  
   14  %constant %integer names         = 1023,
   15+                    line width    = 78,
   16+                    lines on page = 66,
   17+                    max line      = 512,
   18+                    insert limit  = 10,
   19+                    xentries      = 4096
   20  %constinteger ihash = 59
   21  %constant %byte %integer %array hilink(0:58) = %c
   22+      46,  80,  28,  43,  71,  51,  11,  73, 106,  96,  22, 122,
   23+       2,   5,  97,   6,  33,  30,  19,  20, 138,  42,   3,   4,
   24+      75,  45, 124,  76,  77, 108,   7,  27,   8, 111,  32,   9,
   25+      10, 143,  57, 134, 153,  47, 158,  29,  59, 150,   0,  78,
   26+     119,  26,  36,  23,  21,  35,  12,   1,  49,  16,  31
   27  %constant %byte %integer %array ilink(1:198) = %c
   28+      15,  34,  13,  14,  17,  18, 114,  37,  40,  24,  82,  39,
   29+      74,  50,  68,  69,  38,  48,  25,  99,  61, 121, 115,  92,
   30+      54, 117,  66,  65,  44,  41,  63, 162,  88,  62,   0,  70,
   31+       0,  60,  67, 198,  94,  84,  58, 120, 147,  55,  52,  87,
   32+      56,  53,  72, 188, 110,  98,  64, 140, 133,  81,  85,   0,
   33+     116, 137, 100, 102,  90, 160, 186,  89, 154,   0, 112, 113,
   34+      83, 109, 126, 123,  79,  86,   0, 101,  91, 105, 170, 146,
   35+     151, 118, 128,  93, 139, 104,   0, 142, 193,  95, 164, 107,
   36+     127, 141, 166, 185, 103, 155,   0, 167,   0,   0,   0,   0,
   37+     144,   0,   0, 129,   0, 132, 163, 183, 131, 161, 130, 149,
   38+     175, 136, 125, 148, 184,   0, 177, 135, 156,   0,   0,   0,
   39+     157, 152, 159, 187, 145, 176, 169,   0, 165, 168, 179, 171,
   40+     181, 174,   0,   0,   0,   0, 197,   0, 172,   0,   0,   0,
   41+       0,   0,   0,   0, 194,   0, 196, 190,   0, 178,   0,   0,
   42+     192, 173,   0, 180, 189, 182,   0,   0,   0,   0,   0,   0,
   43+       0, 195,   0,   0,   0,   0,   0, 191,   0,   0,   0,   0,
   44+       0,   0,   0,   0,   0,   0
   45  %constant %string(5) %array instr(1:198) = %c
   46+    "LD","LDA","LDAA","LDAB","LDB","LDD","LDS","LDU","LDX",
   47+    "LDY","ST","STA","STAA","STAB","STB","STD","STS","STU",
   48+    "STX","STY","JSR","BSR","LBSR","BRA","LBRA","BRN","LBRN",
   49+    "BHI","LBHI","BLS","LBLS","BCC","LBCC","BHS","LBHS","BCS",
   50+    "LBCS","BLO","LBLO","BNE","LBNE","BEQ","LBEQ","BVC","LBVC",
   51+    "BVS","LBVS","BPL","LBPL","BMI","LBMI","BGE","LBGE","BLT",
   52+    "LBLT","BGT","LBGT","BLE","LBLE","JMP","RTS","SUB","SUBA",
   53+    "SUBB","SUBD","ADD","ADDA","ADDB","ADDD","CMP","CMPA","CMPB",
   54+    "CMPD","CMPS","CMPU","CMPX","CMPY","CPX","LEA","LEAS","LEAU",
   55+    "LEAX","LEAY","EXG","TFR","DEC","DECA","DECB","INC","INCA",
   56+    "INCB","CLR","CLRA","CLRB","INX","DEX","AND","ANDA","ANDB",
   57+    "OR","ORA","ORAA","ORAB","ORB","EOR","EORA","EORB","BIT",
   58+    "BITA","BITB","LSR","LSRA","LSRB","ROR","RORA","RORB","ASR",
   59+    "ASRA","ASRB","ASL","ASLA","ASLB","LSL","LSLA","LSLB","ROL",
   60+    "ROLA","ROLB","SBC","SBCA","SBCB","ADC","ADCA","ADCB","NEG",
   61+    "NEGA","NEGB","COM","COMA","COMB","TST","TSTA","TSTB","TSX",
   62+    "INS","PUL","PULA","PULB","PULS","PULU","PSH","PSHA","PSHB",
   63+    "PSHS","PSHU","DES","TXS","RTI","WAI","CWAI","ANDCC","ORCC",
   64+    "SWI","SWI1","SWI2","SWI3","SBA","CBA","ABA","TAB","TBA",
   65+    "DAA","NOP","TAP","TPA","MUL","SEX","ABX","SYNC","CLV",
   66+    "SEV","CLC","SEC","CLI","SEI","FCB","FDB","EQU","ORG",
   67+    "SETDP","RMB","FCC","NAM","OPT","PAGE","SPC","MON","END"
   68  
   69  %constant %integer %array icode(1:198) = %c
   70+    16_86,16_86,16_86,16_C6,16_C6,16_CC,16_10CE,16_CE,16_8E,
   71+    16_108E,16_87,16_87,16_87,16_C7,16_C7,16_CD,16_10CF,16_CF,
   72+    16_8F,16_108F,16_8D,16_8D,16_8D,16_20,16_20,16_2100,16_1021,
   73+    16_22,16_22,16_23,16_23,16_24,16_24,16_24,16_24,16_25,
   74+    16_25,16_25,16_25,16_26,16_26,16_27,16_27,16_28,16_28,
   75+    16_29,16_29,16_2A,16_2A,16_2B,16_2B,16_2C,16_2C,16_2D,
   76+    16_2D,16_2E,16_2E,16_2F,16_2F,16_0E,16_39,16_80,16_80,
   77+    16_C0,16_83,16_8B,16_8B,16_CB,16_C3,16_81,16_81,16_C1,
   78+    16_1083,16_118C,16_1183,16_8C,16_108C,16_8C,16_30,16_32,16_33,
   79+    16_30,16_31,16_1E,16_1F,16_0A,16_4A,16_5A,16_0C,16_4C,
   80+    16_5C,16_0F,16_4F,16_5F,16_3001,16_301F,16_84,16_84,16_C4,
   81+    16_8A,16_8A,16_8A,16_CA,16_CA,16_88,16_88,16_C8,16_85,
   82+    16_85,16_C5,16_04,16_44,16_54,16_06,16_46,16_56,16_07,
   83+    16_47,16_57,16_08,16_48,16_58,16_08,16_48,16_58,16_09,
   84+    16_49,16_59,16_82,16_82,16_C2,16_89,16_89,16_C9,16_00,
   85+    16_40,16_50,16_03,16_43,16_53,16_0D,16_4D,16_5D,16_1F41,
   86+    16_3261,16_35,16_3502,16_3504,16_35,16_37,16_34,16_3402,16_3404,
   87+    16_34,16_36,16_327F,16_1F14,16_3B,16_3CFF,16_3C,16_1C,16_1A,
   88+    16_3F,16_3F,16_103F,16_113F,16_A0E0,16_A1E0,16_ABE0,16_895D,16_984D,
   89+    16_19,16_12,16_1F8A,16_1FA8,16_3D,16_1D,16_3A,16_13,16_1CFD,
   90+    16_1A02,16_1CFE,16_1A01,16_1CEF,16_1A10,16_00,16_00,16_00,16_00,
   91+    16_00,16_00,16_00,16_00,16_00,16_00,16_00,16_00,16_00
   92  %constant %byte %integer %array itype(1:198) = %c
   93+      6,  4, 12, 12, 12,  9,  9,  9,  9,  9, 10,  5, 13, 13, 13,
   94+     13, 13, 13, 13, 13, 13,  3,  3,  3,  3,  2, 24,  3,  3,  3,
   95+      3,  3,  3,  3,  3,  3,  3,  3,  3,  3,  3,  3,  3,  3,  3,
   96+      3,  3,  3,  3,  3,  3,  3,  3,  3,  3,  3,  3,  3,  3, 14,
   97+      1,  8, 12, 12,  9,  8, 12, 12,  9,  7, 12, 12,  9,  9,  9,
   98+      9,  9,  9, 16, 17, 17, 17, 17, 18, 18, 15,  1,  1, 15,  1,
   99+      1, 15,  1,  1,  2,  2, 11, 12, 12, 11,  4, 12, 12, 12, 11,
  100+     12, 12, 11, 12, 12, 15,  1,  1, 15,  1,  1, 15,  1,  1, 15,
  101+      1,  1, 15,  1,  1, 15,  1,  1, 11, 12, 12, 11, 12, 12, 15,
  102+      1,  1, 15,  1,  1, 15,  1,  1,  2,  2, 19,  2,  2, 20, 20,
  103+     19,  2,  2, 20, 20,  2,  2,  1,  2, 21, 21, 21, 23,  1,  1,
  104+      1, 25, 25, 25, 22, 22,  1,  1,  2,  2,  1,  1,  1,  1,  2,
  105+      2,  2,  2,  2,  2, 26, 27, 28, 29, 30, 31, 32, 33, 34, 35,
  106+     36, 37, 37
  107  %constant %integer %array icycles(1:198) = %c
  108+      2,  2,  2,  2,  2,  3,  4,  3,  3,  4,  2,  2,  2,  2,  2,
  109+      3,  4,  3,  3,  4,  5,  7,  7,  3,  3,  3,  5,  3,  3,  3,
  110+      3,  3,  3,  3,  3,  3,  3,  3,  3,  3,  3,  3,  3,  3,  3,
  111+      3,  3,  3,  3,  3,  3,  3,  3,  3,  3,  3,  3,  3,  3,  1,
  112+      5,  2,  2,  2,  4,  2,  2,  2,  4,  2,  2,  2,  5,  5,  5,
  113+      4,  5,  4,  2,  2,  2,  2,  2,  8,  7,  2,  2,  2,  2,  2,
  114+      2,  2,  2,  2,  5,  5,  2,  2,  2,  2,  2,  2,  2,  2,  2,
  115+      2,  2,  2,  2,  2,  2,  2,  2,  2,  2,  2,  2,  2,  2,  2,
  116+      2,  2,  2,  2,  2,  2,  2,  2,  2,  2,  2,  2,  2,  2,  2,
  117+      2,  2,  2,  2,  2,  2,  2,  2,  6,  5,  5,  6,  6,  5,  5,
  118+      5,  6,  6,  5,  5,  5,  6, 15, 21, 21,  3,  3, 19, 19, 20,
  119+     20, 11, 11, 11,  8,  8,  2,  2,  6,  6, 11,  2,  3,  2,  3,
  120+      3,  3,  3,  3,  3,  0,  0,  0,  0,  0,  0,  0,  0,  0,  0,
  121+      0,  0,  0
  122  %constant %integer no options = 51
  123  %constant %string(10) %array option text(1:no options) = %c
  124+    "BLANK", "B", "NOBLANK", "NOB", "CYCLE", "C", "NOCYCLE", "NOC",
  125+    "DB8", "DB10", "DB16", "ERROR", "E", "SERROR", "SER", "NOERROR",
  126+    "NOE", "FULL", "F", "NOFULL", "NOF",  "GENERATE", "G", "NOGENERATE",
  127+    "NOG", "LIST", "L", "SLIST", "SLIS", "NOLIST", "NOL", "PAGE", "P",
  128+    "NOPAGE", "NOP", "SYMBOL", "S", "NOSYMBOL", "NOS", "TAB", "T",
  129+    "NOTAB", "NOT", "WRAP", "W", "NOWRAP", "NOW", "XREF", "X", "NOXREF",
  130+    "NOX"
  131  %string(255) %function %spec lc(%string(255) source)
  132  %predicate %spec matches(%string(255) source, pattern,
  133+       %integer min, %integer %name i)
  134  %predicate %spec is typed(%string(255) source, %string(255) %name file)
  135  %routine %spec read line
  136  %routine %spec next char
  137  %routine %spec skip blanks
  138  %predicate %spec more items
  139  %integerfn %spec get name(%integername nid)
  140  %predicate %spec get option(%integer %name opt)
  141  %predicate %spec get instr(%integername id)
  142  %integerfn %spec get opd(%integername opd)
  143  %integer %function %spec get term(%integer %name opd)
  144  %integer %function %spec get expression(%integer %name opd)
  145  %routine %spec evaluate(%integer %name a, %integer b, %byte %integer op)
  146  %integerfn %spec get const(%integername cval)
  147  %routine %spec analise operand(%integer eca,
  148+                   %integer %name post, opd, type, cycles)
  149  %routine %spec out symbol(%byte %integer char)
  150  %routine %spec out tag(%integer %name i, j, %integer col)
  151  %routine %spec instr out(%integer op, post,opd,b, cyc)
  152  %routine %spec close
  153  %routine %spec fault(%string(63) s)
  154  %routine %spec nline(%integer n)
  155  %routine %spec print number(%integer n,d)
  156  %predicate %spec accumulator
  157  %predicate %spec acc(%byte %integer acc id)
  158  %predicate %spec auto indexed(%integer %name post, cycles)
  159  %predicate %spec cc
  160  %predicate %spec dp
  161  %predicate %spec pc
  162  %predicate %spec pc relative
  163  %predicate %spec index reg(%integer %name reg)
  164  %predicate %spec transfer reg(%integer %name reg)
  165  %routine %spec sqs(%integer l, r)
  166  %byte %integer %array buffer(1:16)
  167  %byteinteger %array line(1:max line+1)
  168  %integer ca, pass, faults, lp, opd, iid, lid, ln, nnames, i, j, k, opt,
  169+    order, consistent, last consistent, headset, pres char, delim, drad,
  170+    bchar, pflag, sflag, gflag, eflag, lflag, cflag, wflag, tflag, xflag,
  171+    cont, sp1, sp2, sp3, old ca, mcycles, non dense, accop, buffer ca, bp,
  172+    l, xxentries, post, type, acc fault, dp contents, fflag, ostarted,
  173+    eca, look ahead, diff, no longs, last no longs
  174  %constant %integer nhash=67
  175  %integer %array hnlink(0:nhash-1)
  176  %string(6)%array name(1:names)
  177  %integer %array nval, xhead, ndiff, nlink(1:names)
  178  %byteinteger%array nass(1:names)
  179  %integer %array xentry, xlink(1:xentries)
  180  %switch option action(-1:no options)
  181  %switch itype1,itype3(1:37)
  182  %string(line width-37) header
  183  %string(*) %name file
  184  %string(255) params, source, list, object, dummy
  185  
  186     %on %event 9 %start
  187        select output(0)
  188        print string(event_message{source." does not exist."})
  189        new line
  190        %stop
  191     %finish
  192  
  193  !  params = ""
  194  !  select input(0)
  195  !  read symbol(i)
  196  !  params = params.to string(i) %and read symbol(i) %while i#nl
  197  !  params = lc(params)
  198     params = lc(cliparam)
  199     source = ""
  200     list = ".n"
  201     object = ""
  202     dummy = ""
  203     %cycle
  204        i = 1
  205        i = i+1 %while i<=length(params) %and charno(params, i)=' '
  206        %exit %if i>length(params)
  207        params = substring(params, i, length(params))
  208        %if charno(params, 1)='/' %start
  209           params = substring(params, 2, length(params))
  210           %if matches(params, "list", 1, i) %start
  211              list = ""
  212              file == list
  213           %finish %else %if matches(params, "object", 1, i) %start
  214              object = ""
  215              file == object
  216           %finish %else %if matches(params, "nolist", 3, i) %start
  217              list = ".n"
  218              file == dummy
  219           %finish %else %if matches(params, "noobject", 3, i) %start
  220              object = ".n"
  221              file == dummy
  222           %else
  223              i = 1
  224              file == dummy
  225           %finish
  226           %exit %if i>length(params)
  227           params = substring(params, i, length(params))
  228           %continue %unless charno(params, 1)='='
  229           %if length(params)>1 %start
  230              params = substring(params, 2, length(params))
  231           %else
  232              params = ""
  233           %finish
  234       %else
  235           file == source
  236        %finish
  237        i = 1
  238        i = i+1 %while i<=length(params) %and charno(params, i)#' ' %and %c
  239+                                             charno(params, i)#'/'
  240        file = substring(params, 1, i-1) %if i>1
  241        %exit %if i>length(params)
  242        params = substring(params, i, length(params))
  243     %repeat
  244  
  245     %if source="" %start
  246        select output(0)
  247        print string("No source file specified.")
  248        new line
  249        %stop
  250     %finish
  251  
  252     source = source.".asm" %unless is typed(source, params)
  253  
  254     list   = params %if list=""
  255     object = params %if object=""
  256     list = list.".lis" %unless is typed(list, dummy)
  257     object = object.".obj" %unless is typed(object, dummy)
  258  
  259     open input(1, source)
  260     open output(1, object)
  261     open output(2, list)
  262     select output(2)
  263     headset = 0
  264     header = ""
  265     drad = 8
  266     sp1 = 2
  267     sp2 = 4
  268     pflag = 3
  269     sflag = 0
  270     eflag = 1
  271     gflag = 1
  272     lflag = 2
  273     cflag = 0
  274     wflag = 0
  275     tflag = 1
  276     xflag = 0
  277     sp3 = line width-sp1-sp2*3-cflag*3-wflag-11
  278     cont = 0
  279     faults=0
  280     nnames=0
  281     xxentries = 0
  282     consistent = 0
  283     last consistent = 0
  284     last no longs = 0
  285     hnlink(i)=0 %for i = 0, 1, nhash-1
  286     ostarted = 0
  287     bp = 0
  288     look ahead = 0
  289  !-----------------------------------------------------------------------
  290     select input(1)
  291     pass = 1
  292     %cycle
  293        ln = 0
  294        dp contents = 0
  295        ca = 0
  296        bchar = -1
  297        fflag = 0
  298        no longs = 0
  299        %cycle
  300            read line
  301            %continue %if pres char='*'
  302            %if get name(lid)=0 %start
  303              %if pass=1 %start
  304                 %if nass(lid)=0 %start
  305                    nval(lid) = ca
  306                    nass(lid) = 1
  307                 %else
  308                    nval(lid) = 0
  309                    nass(lid) = 2
  310                 %finish
  311              %finish %else %if nass(lid)=1 %and ca#nval(lid) %start
  312                 diff = nval(lid)-ca
  313                 nval(lid) = ca
  314                 %if pass=3 %start
  315                    %for i = 1, 1, consistent %cycle
  316                       -> diff found %if ndiff(i)=diff
  317                    %repeat
  318                    consistent = consistent+1
  319                    ndiff(consistent) = diff
  320  diff found:    %finish
  321              %finish
  322            %else
  323              lid = 0
  324           %finish
  325           next char %while pres char=' '
  326           %continue %unless get instr(iid)
  327           next char %while pres char=' '
  328           %if itype(iid)<=25 %start
  329              %if 0<=icode(iid)<=255 %start
  330                 ca = ca+1
  331              %else
  332                 ca = ca+2
  333              %finish
  334           %finish
  335           ->itype1(itype(iid))
  336  !-----------------------------------------------------------------------
  337  itype1(1):! implied
  338  itype1(2): ! 6800 special implied
  339           %continue
  340  !-----------------------------------------------------------------------
  341  itype1(3):! relative
  342           %if pass<3 %or get opd(opd)#0 %or -128<=opd-ca-1<=127 %start
  343              ca = ca+1
  344           %finish %else %if icode(iid)=16_20 %or icode(iid)=16_8D %start
  345              ca = ca+2
  346              no longs = no longs+1
  347           %else
  348              ca = ca+3
  349              no longs = no longs+1
  350           %finish
  351           %continue
  352  !-----------------------------------------------------------------------
  353  itype1(4): ! lda, ora
  354           ca = ca+1 %and %continue %if pres char='#'
  355           analise operand(ca, post, opd, type, mcycles)
  356           %if 1<=type<=2 %start
  357              skip blanks
  358              -> itype1(12)
  359           %finish
  360           -> analise double
  361  !----------------------------------------------------------------------
  362  itype1(5): ! sta
  363           analise operand(ca, post, opd, type, mcycles)
  364           %if 1<=type<=2 %start
  365              skip blanks
  366              -> itype1(13)
  367           %finish
  368           -> analise double
  369  !-----------------------------------------------------------------------
  370  itype1(6): ! ld
  371           %if accumulator %start
  372              skip blanks
  373              -> itype1(12)
  374           %finish %else %if acc('S') %or acc('Y') %start
  375              ca = ca+1
  376           %finish %else %unless acc('D') %or acc('U') %or acc('X') %start
  377              -> itype1(12)
  378           %finish
  379           skip blanks
  380           -> itype1(9)
  381  !-----------------------------------------------------------------------
  382  itype1(7): ! cmp
  383           %if accumulator %start
  384              skip blanks
  385              -> itype1(12)
  386           %finish %else %if acc('D') %or acc('S') %or acc('U') %or %c
  387+                         acc('Y') %start
  388              ca = ca+1
  389           %finish %else %unless acc('X') %start
  390              -> itype1(12)
  391           %finish
  392           skip blanks
  393           -> itype1(9)
  394  !-----------------------------------------------------------------------
  395  itype1(8): ! add, sub
  396           %if accumulator %start
  397              skip blanks
  398              -> itype1(12)
  399           %finish %else %if acc('D') %start
  400              skip blanks
  401           %else
  402              -> itype1(12)
  403           %finish
  404  !-----------------------------------------------------------------------
  405  itype1(9): ! immediate(3), direct, index, extend
  406           ca = ca+2 %and %continue %if pres char='#'
  407           ->itype1(13)
  408  !-----------------------------------------------------------------------
  409  itype1(10): ! st
  410           %if acc('S') %or acc('Y') %start
  411              ca = ca+1
  412              skip blanks
  413           %finish %else %if acc('D') %or acc('U') %or acc('X') %or %c
  414+                      accumulator %start
  415              skip blanks
  416           %finish
  417           -> itype1(13)
  418  !-----------------------------------------------------------------------
  419  itype1(11): ! inherent*(immediate(2), direct, index, extend)
  420           skip blanks %if accumulator
  421  !-----------------------------------------------------------------------
  422  itype1(12):! immediate(2), direct, index, extend
  423           ca = ca+1 %and %continue %if pres char='#'
  424  !-----------------------------------------------------------------------
  425  itype1(13):! direct, index, extend
  426  itype1(14): ! jmp
  427           analise operand(ca, post, opd, type, mcycles)
  428  analise double:
  429           %if type<=3 %start
  430              ca = ca+1
  431           %finish %else %if type=4 %start
  432              ca = ca+2
  433              no longs = no longs+1
  434           %else
  435              ca = ca+type-4
  436              no longs = no longs+type-5
  437           %finish
  438           %continue
  439  !-----------------------------------------------------------------------
  440  itype1(15): ! inherent, index, extend
  441           analise operand(ca, post, opd, type, mcycles)
  442           %if 3<=type<=4 %start
  443              ca = ca+type-2
  444              no longs = no longs+type-3
  445           %finish %else %if type>=5 %start
  446              ca = ca+type-4
  447              no longs = no longs+type-5
  448           %finish
  449           %continue
  450  !-----------------------------------------------------------------------
  451  itype1(16): ! lea
  452           skip blanks %if index reg(i)
  453  !-----------------------------------------------------------------------
  454  itype1(17):!  Load effective address
  455           analise operand(ca, post, opd, type, mcycles)
  456           %if type<=5 %start
  457              ca = ca+1
  458           %else
  459              ca = ca+type-4
  460              no longs = no longs+type-5
  461           %finish
  462           %continue
  463  !-----------------------------------------------------------------------
  464  itype1(18): ! tfr, exg
  465  itype1(19): ! pul, psh
  466  itype1(20): ! pulu, puls, pshu, pshs
  467  itype1(21): ! cwai, andcc, orcc
  468  itype1(22): ! tab, tba
  469           ca = ca+1
  470           %continue
  471  !-----------------------------------------------------------------------
  472  itype1(23): ! swi
  473           ca = ca+1 %if acc('2') %or acc('3')
  474           %continue
  475  !-----------------------------------------------------------------------
  476  itype1(24): ! lbrn
  477  itype1(25): ! sba, cba, aba
  478           ca = ca+2
  479           %continue
  480  !-----------------------------------------------------------------------
  481  itype1(26): ! fcb
  482           %cycle
  483              ca = ca+1
  484              i = get opd(opd) %unless pres char=','
  485           %repeat %until %not more items
  486           %continue
  487  !-----------------------------------------------------------------------
  488  itype1(27): ! fdb
  489           %cycle
  490              ca = ca+2
  491              i = get opd(opd) %unless pres char=','
  492           %repeat %until %not more items
  493           %continue
  494  !-----------------------------------------------------------------------
  495  itype1(28):! equ
  496           %unless lid=0 %start
  497              %if get opd(opd)=0 %start
  498                %if pass=1 %start
  499                    %if nass(lid)=1 %start
  500                       nval(lid) = opd
  501                       nass(lid) = 3
  502                    %finish
  503                 %finish %else %if nass(lid)=3 %and opd#nval(lid) %start
  504                    diff = nval(lid)-opd
  505                    nval(lid) = opd
  506                    %if pass=3 %start
  507                       %for i = 1, 1, consistent %cycle
  508                          ->equ diff found %if ndiff(i)=diff
  509                       %repeat
  510                       consistent = consistent+1
  511                       ndiff(consistent) = diff
  512  equ diff found:   %finish
  513                 %finish
  514              %else
  515                 %unless nass(lid)=2 %start
  516                    nval(lid) = 0
  517                    nass(lid) = 4
  518                 %finish
  519              %finish
  520           %finish
  521           %continue
  522  !-----------------------------------------------------------------------
  523  itype1(29):! org
  524           %unless lid=0 %start
  525              nval(lid) = 0
  526              nass(lid) = 4
  527           %finish
  528           ca = opd %if get opd(opd)=0
  529           %continue
  530  !-----------------------------------------------------------------------
  531  itype1(30): ! setdp
  532            %unless lid=0 %start
  533               nval(lid) = 0
  534               nass(lid) = 4
  535            %finish
  536            dp contents = opd<<8 %if get opd(opd)=0
  537            %continue
  538  !-----------------------------------------------------------------------
  539  itype1(31): ! rmb
  540            ca = ca+opd %if get opd(opd)=0
  541            %continue
  542  !-----------------------------------------------------------------------
  543  itype1(32):! fcc
  544           %if '0'<=pres char<='9' %start
  545              i = lp
  546              j = 0
  547              %cycle
  548                 j = j*10+pres char-'0'
  549                 next char
  550              %repeat %until %not '0'<=pres char<='9'
  551              %if pres char=',' %start
  552                 ca = ca+j
  553                 %continue
  554              %finish
  555              lp = i-1
  556              next char
  557           %finish
  558           %continue %if pres char<' '
  559           delim = pres char
  560           next char
  561           %cycle
  562              %exit %if pres char=nl
  563              %if pres char=delim %start
  564                 next char
  565                 %exit %unless pres char=delim
  566              %finish
  567              next char
  568              ca=ca+1
  569           %repeat
  570           %continue
  571  !-----------------------------------------------------------------------
  572  itype1(33): ! nam
  573           %unless lid=0 %start
  574              nval(lid) = 0
  575              nass(lid) = 4
  576           %finish
  577           %continue %unless headset=0
  578           headset = 1
  579           header = ""
  580           %while pres char#nl %cycle
  581              header <- header.to string(line(lp))
  582              next char
  583           %repeat
  584           %continue
  585  !-----------------------------------------------------------------------
  586  itype1(34): ! opt
  587           %cycle
  588              %if get option(opt) %start
  589                 %if 1<=opt<=2 %start
  590                    bchar = ' '
  591                 %finish %else %if 3<=opt<=4 %start
  592                    bchar = -1
  593                 %finish %else %if 18<=opt<=19 %start
  594                    fflag = 1
  595                 %finish %else %if 20<=opt<=21 %start
  596                    fflag = 0
  597                 %finish
  598              %finish
  599           %repeat %until %not more items
  600  !-----------------------------------------------------------------------
  601  itype1(35): ! page
  602  !-----------------------------------------------------------------------
  603  itype1(36): ! spc
  604           %unless lid=0 %start
  605              nval(lid) = 0
  606              nass(lid) = 4
  607           %finish
  608  !-----------------------------------------------------------------------
  609        %repeat
  610  !-----------------------------------------------------------------------
  611  itype1(37):! end
  612        %unless lid=0 %start
  613           nval(lid) = 0
  614           nass(lid) = 2
  615        %finish
  616        %if pass<3 %start
  617           pass = pass+1
  618        %else
  619           %exit %if consistent=0 %or %c
  620+             (last consistent#0 %and consistent>=last consistent %and %c
  621+                no longs>=last no longs)
  622           last consistent = consistent
  623        %finish
  624        last no longs = no longs
  625        consistent = 0
  626        reset input
  627     %repeat
  628  !-----------------------------------------------------------------------
  629     nline(0)
  630     reset input
  631     pass = 4
  632     ln = 0
  633     ca = 0
  634     dp contents = 0
  635     old ca = 0
  636     lid = 0
  637     bchar = -1
  638     fflag = 0
  639     %cycle
  640        %unless lid=0 %start
  641           fault("Multiply defined label") %if nass(lid)=2
  642           %if nass(lid)=1 %and nval(lid)#old ca %start
  643              fault("Inconsistent label")
  644              nval(lid) = old ca
  645           %finish
  646        %finish
  647        old ca = ca
  648        lid = 0
  649        read line
  650        accop = 0
  651        acc fault = 0
  652        non dense = 0
  653        instr out(0, 0, 0, -7, 0) %and %continue %if pres char='*'
  654        lid = 0 %unless get name(lid)=0
  655        skip blanks
  656        %if pres char=nl %start
  657           instr out(0, 0, 0, -7, 0)
  658        %finish %else %if get instr(iid) %start
  659           order = icode(iid)
  660           %if 0<=order<=255 %start
  661              eca = ca+1
  662           %else
  663              eca = ca+2
  664           %finish
  665           mcycles = icycles(iid)
  666           skip blanks
  667           ->itype3(itype(iid))
  668        %else
  669           instr out(0, 0, 0, -7, 0)
  670           fault("Unknown operation")
  671        %finish
  672        %continue
  673  !-----------------------------------------------------------------------
  674  itype3(1):! implied
  675        instr out(order, 0, 0, 1, mcycles)
  676        %continue
  677  !-----------------------------------------------------------------------
  678  itype3(2): ! 6800 special implied
  679        instr out((order>>8)&255, order&255, 0, 2, mcycles)
  680        %continue
  681  !-----------------------------------------------------------------------
  682  itype3(3):! relative
  683        i=get opd(opd)
  684        j=opd-eca-1
  685        %if i#0 %or -128<=j<=127 %start
  686           instr out(order, j, 0, 2, mcycles)
  687           fault("Cannot evaluate operand") %unless i=0
  688        %finish %else %if order=16_20 %start
  689           instr out(16_16, j-1, 0, 5, mcycles+2)
  690        %finish %else %if order=16_8D %start
  691           instr out(16_17, j-1, 0, 5, mcycles+2)
  692        %else
  693           instr out(16_1000+order, j-2, 0, 5, mcycles+3)
  694        %finish
  695        %continue
  696  !----------------------------------------------------------------------
  697  itype3(4): ! lda, ora
  698        -> itype3(12) %if pres char='#'
  699        analise operand(eca, post, opd, type, mcycles)
  700        %if 1<=type<=2 %start
  701           order = order+16_40 %if type=2
  702           accop = 1
  703           skip blanks
  704           -> itype3(12)
  705        %finish
  706        -> generate double
  707  !---------------------------------------------------------------------
  708  itype3(5): ! sta
  709        analise operand(eca, post, opd, type, mcycles)
  710        %if 1<=type<=2 %start
  711           order = order+16_40 %if type=2
  712           accop = 1
  713           skip blanks
  714           -> itype3(13)
  715        %finish
  716        -> generate double
  717  !----------------------------------------------------------------------
  718  itype3(6): ! ld
  719     accop = 1
  720     %if acc('A') %start
  721        skip blanks
  722        -> itype3(12)
  723     %finish %else %if acc('B') %start
  724        order = 16_C6
  725        skip blanks
  726        -> itype3(12)
  727     %finish %else %if acc('D') %start
  728        order = 16_CC
  729     %finish %else %if acc('U') %start
  730        order = 16_CE
  731     %finish %else %if acc('X') %start
  732        order = 16_8E
  733     %finish %else %if acc('S') %start
  734        order = 16_10CE
  735        mcycles = mcycles+1
  736     %finish %else %if acc('Y') %start
  737        order = 16_108E
  738        mcycles = mcycles+1
  739     %else
  740        acc fault = 2
  741        accop = 0
  742        -> itype3(12)
  743     %finish
  744     skip blanks
  745     mcycles = mcycles+1
  746     -> itype3(9)
  747  !----------------------------------------------------------------------
  748  itype3(7): ! cmp
  749        accop = 1
  750        %if acc('A') %start
  751           skip blanks
  752           -> itype3(12)
  753        %finish %else %if acc('B') %start
  754           order = 16_C1
  755           skip blanks
  756           -> itype3(12)
  757        %finish %else %if acc('D') %start
  758           order = 16_1083
  759           mcycles = mcycles+1
  760        %finish %else %if acc('U') %start
  761           order = 16_1183
  762           mcycles = mcycles+1
  763        %finish %else %if acc('X') %start
  764           order = 16_8C
  765        %finish %else %if acc('S') %start
  766           order = 16_118C
  767           mcycles = mcycles+1
  768        %finish %else %if acc('Y') %start
  769           order = 16_108C
  770           mcycles = mcycles+1
  771        %else
  772           acc fault = 2
  773           accop = 0
  774           -> itype3(12)
  775        %finish
  776        skip blanks
  777        mcycles = mcycles+2
  778        -> itype3(9)
  779  !-----------------------------------------------------------------------
  780  itype3(8): ! add, sub
  781        accop = 1
  782        %if acc('A') %start
  783           skip blanks
  784           -> itype3(12)
  785        %finish %else %if acc('B') %start
  786           order = order+16_40
  787           skip blanks
  788           -> itype3(12)
  789        %finish %else %if acc('D') %start
  790           %if order=16_80 %start
  791              order = 16_83
  792           %else
  793              order = 16_C3
  794           %finish
  795        %else
  796           acc fault = 1
  797           accop = 0
  798           -> itype3(12)
  799        %finish
  800        skip blanks
  801        mcycles = mcycles+2
  802  !-----------------------------------------------------------------------
  803  itype3(9):! immediate(3), direct, index, extend
  804        %if pres char='#' %start
  805           next char %until pres char#bchar
  806           i = get opd(opd)
  807           instr out(order, opd, 0, 5, mcycles)
  808           fault("Cannot evaluate operand") %unless i=0
  809           %continue
  810        %finish
  811        ->itype3(13)
  812  !-----------------------------------------------------------------------
  813  itype3(10): ! st
  814        accop = 1
  815        %if acc('B') %start
  816           order = 16_C7
  817        %finish %else %if acc('D') %start
  818           order = 16_CD
  819           mcycles = mcycles+1
  820        %finish %else %if acc('U') %start
  821           order = 16_CF
  822           mcycles = mcycles+1
  823        %finish %else %if acc('X') %start
  824           order = 16_8F
  825           mcycles = mcycles+1
  826        %finish %else %if acc('S') %start
  827           order = 16_10CF
  828           mcycles = mcycles+2
  829        %finish %else %if acc('Y') %start
  830           order = 16_108F
  831           mcycles = mcycles+2
  832        %finish %else %unless acc('A') %start
  833           acc fault = 2
  834           accop = 0
  835        %finish
  836        skip blanks
  837        -> itype3(13)
  838  !-----------------------------------------------------------------------
  839  itype3(11): ! inherent*(immediate(2), direct, index, extend)
  840        accop = 1
  841        %if acc('B') %start
  842           order = order+16_40
  843        %finish %else %unless acc('A') %start
  844           accop = 0
  845           acc fault = 1
  846        %finish
  847        skip blanks
  848  !-----------------------------------------------------------------------
  849  itype3(12): ! immediate(2), direct, index, extend
  850        %if pres char='#' %start
  851           next char %until pres char#bchar
  852           i = get opd(opd)
  853           instr out(order, opd, 0, 2, mcycles)
  854           %unless i=0 %start
  855              fault("Cannot evaluate operand")
  856           %finish %else %unless -128<=opd<=255 %start
  857              fault("Invalid constant")
  858           %finish
  859           %continue
  860        %finish
  861  !-----------------------------------------------------------------------
  862  itype3(13):! direct,index,extend
  863        analise operand(eca, post, opd, type, mcycles)
  864  generate double:
  865        %if type<=3 %start
  866           instr out(order+16_10, opd, 0, 2, mcycles)
  867           %if type=0 %start
  868              fault("Cannot evaluate operand")
  869           %finish %else %unless type=3 %start
  870              fault("Illegal operand")
  871           %finish
  872        %finish %else %if type=4 %start
  873           instr out(order+16_30, opd, 0, 5, mcycles)
  874        %else
  875           instr out(order+16_20, post, opd, type-3, mcycles)
  876        %finish
  877        fault("Accumulator not specified") %if acc fault=1
  878        fault("Register not specified") %if acc fault=2
  879        %continue
  880  !----------------------------------------------------------------------
  881  itype3(14): ! jmp
  882        analise operand(eca, post, opd, type, mcycles)
  883        %if type<=3 %start
  884           instr out(order, opd, 0, 2, mcycles)
  885           %if type=0 %start
  886              fault("Cannot evaluate operand")
  887           %finish %else %unless type=3 %start
  888              fault("Illegal operand")
  889           %finish
  890        %finish %else %if type=4 %start
  891           instr out(order+16_70, opd, 0, 5, mcycles)
  892        %else
  893           instr out(order+16_60, post, opd, type-3, mcycles)
  894        %finish
  895        %continue
  896  !----------------------------------------------------------------------
  897  itype3(15): ! inherent, direct, indexed, extended
  898        analise operand(eca, post, opd, type, mcycles)
  899        %if type<=1 %start
  900           accop = 1 %if type=1
  901           instr out(order+16_40, 0, 0, 1, mcycles)
  902           fault("Cannot evaluate operand") %if type=0
  903        %finish %else %if type=2 %start
  904           accop = 1
  905           instr out(order+16_50, 0, 0, 1, mcycles)
  906        %finish %else %if type=3 %start
  907           instr out(order, opd, 0, 2, mcycles+2)
  908        %finish %else %if type=4 %start
  909           instr out(order+16_70, opd, 0, 5, mcycles+2)
  910        %else
  911           instr out(order+16_60, post, opd, type-3, mcycles+2)
  912        %finish
  913        %continue
  914  !-----------------------------------------------------------------------
  915  itype3(16): ! lea
  916        accop = 1
  917        %if acc('X') %start
  918           order = 16_30
  919        %finish %else %if acc('Y') %start
  920           order = 16_31
  921        %finish %else %if acc('S') %start
  922           order = 16_32
  923        %finish %else %if acc('U') %start
  924           order = 16_33
  925        %else
  926           acc fault = 2
  927           accop = 0
  928        %finish
  929        skip blanks
  930  !-----------------------------------------------------------------------
  931  itype3(17): ! load effective address
  932        analise operand(eca, post, opd, type, mcycles)
  933        %if type<=5 %start
  934           instr out(order, post, opd, 2, mcycles)
  935           %if type=0 %start
  936              fault("Cannot evaluate operand")
  937           %finish %else %unless type=5 %start
  938              fault("Illegal operand")
  939           %finish
  940        %else
  941           instr out(order, post, opd, type-3, mcycles)
  942        %finish
  943        fault("Index register not specified") %unless acc fault=0
  944        %continue
  945  !-----------------------------------------------------------------------
  946  itype3(18): ! tfr,exg
  947        %if transfer reg(post) %start
  948           accop = 1 %unless more items
  949           %if transfer reg(opd) %start
  950              instr out(order, (post<<4)!opd, 0, 2, mcycles)
  951              %if (post<8 %and 8<=opd) %or (opd<8 %and 8<=post) %start
  952                 fault("Different size registers")
  953              %finish
  954           %else
  955              instr out(order, post<<4, 0, 2, mcycles)
  956              fault("Second register not specified")
  957           %finish
  958        %else
  959           instr out(order, 0, 0, 2, mcycles)
  960           fault("Registers not specified")
  961        %finish
  962        %continue
  963  !-----------------------------------------------------------------------
  964  itype3(19): ! psh, pul
  965        accop = 1
  966        %if acc('A') %start
  967           instr out(order, 2, 0, 2, mcycles+1)
  968           %continue
  969        %finish %else %if acc('B') %start
  970           instr out(order, 4, 0, 2, mcycles+1)
  971           %continue
  972        %finish %else %if acc('U') %start
  973           order = order+2
  974        %finish %else %unless acc('S') %start
  975           accop = 0
  976           acc fault = 1
  977        %finish
  978        skip blanks
  979  !-----------------------------------------------------------------------
  980  itype3(20): ! pshu, pshs, pulu, puls
  981        post = 0
  982        i = 0
  983        j = 0
  984        %cycle
  985           %if cc %start
  986              mcycles = mcycles+1 %and post = post!1 %if post&1=0
  987           %finish %else %if acc('A') %start
  988              mcycles = mcycles+1 %and post = post!2 %if post&2=0
  989           %finish %else %if acc('B') %start
  990              mcycles = mcycles+1 %and post = post!4 %if post&4=0
  991           %finish %else %if acc('D') %start
  992              mcycles = mcycles+1 %and post = post!2 %if post&2=0
  993              mcycles = mcycles+1 %and post = post!4 %if post&4=0
  994           %finish %else %if dp %start
  995              mcycles = mcycles+1 %and post = post!8 %if post&8=0
  996           %finish %else %if acc('X') %start
  997              mcycles = mcycles+2 %and post = post!16 %if post&16=0
  998           %finish %else %if acc('Y') %start
  999              mcycles = mcycles+2 %and post = post!32 %if post&32=0
 1000           %finish %else %if acc('S') %start
 1001              %if 16_36<=order<=16_37 %start
 1002                 mcycles = mcycles+2 %and post = post!64 %if post&64=0
 1003              %else
 1004                 i = i+1
 1005              %finish
 1006           %finish %else %if acc('U') %start
 1007              %if 16_34<=order<=16_35 %start
 1008                 mcycles = mcycles+2 %and post = post!64 %if post&64=0
 1009              %else
 1010                 i = i+1
 1011              %finish
 1012           %finish %else %if pc %start
 1013              mcycles = mcycles+2 %and post = post!128 %if post&128=0
 1014           %finish %else %if pres char=',' %start
 1015              next char
 1016           %else
 1017              j = 1
 1018              %exit
 1019           %finish
 1020        %repeat %until %not more items
 1021        instr out(order, post, 0, 2, mcycles)
 1022        fault("Stack not specified") %unless acc fault=0
 1023        fault("Cannot stack stack pointer") %for i = i, -1, 1
 1024        fault("Illegal operand") %unless j=0
 1025        %continue
 1026  !-----------------------------------------------------------------------
 1027  itype3(21): ! cwai,andcc,orcc
 1028        %if pres char='#' %start
 1029           next char %until pres char#bchar
 1030        %finish
 1031        i = get opd(opd)
 1032        instr out(order, opd, 0, 2, mcycles)
 1033        %unless i=0 %start
 1034           fault("Cannot evaluate operand")
 1035        %finish %else %unless 0<=opd<=255 %start
 1036           fault("Illegal mask")
 1037        %finish
 1038        %continue
 1039  !-----------------------------------------------------------------------
 1040  itype3(22): ! tab, tba
 1041        instr out(16_1F, (order>>8)&255, order&255, 3, mcycles)
 1042        %continue
 1043  !-----------------------------------------------------------------------
 1044  itype3(23): ! swi
 1045        %if acc('1') %start
 1046           accop = 1
 1047        %finish %else %if acc('2') %start
 1048           accop = 1
 1049           order = order!16_1000
 1050           mcycles = mcycles+1
 1051        %finish %else %if acc('3') %start
 1052           accop = 1
 1053           order = order!16_1100
 1054           mcycles = mcycles+1
 1055        %finish
 1056        instr out(order, 0, 0, 1, mcycles)
 1057        %continue
 1058  !-----------------------------------------------------------------------
 1059  itype3(24): ! lbrn
 1060        instr out(order, 0, 0, 5, mcycles)
 1061        %continue
 1062  !-----------------------------------------------------------------------
 1063  itype3(25): ! sba, cba, aba
 1064        instr out(16_34, 16_04, order, 4, mcycles)
 1065        %continue
 1066  !-----------------------------------------------------------------------
 1067  itype3(26): ! fcb
 1068        %cycle
 1069           %if pres char=',' %start
 1070              opd = 0
 1071              i = 0
 1072           %else
 1073              i = get opd(opd)
 1074           %finish
 1075           %if cont=0 %start
 1076              j = lp
 1077              look ahead = 1
 1078              %while more items %cycle
 1079                 k = get opd(k) %unless pres char=','
 1080              %repeat
 1081              look ahead = 0
 1082              instr out(0, opd&255, 0, -1, 0)
 1083              lp = j-1
 1084              next char
 1085              cont = 1
 1086           %else
 1087              instr out(0, opd&255, 0, -1, 0)
 1088           %finish
 1089           fault("Invalid constant") %unless i=0 %and -128<=opd<=255
 1090        %repeat %until %not more items
 1091        cont = 0
 1092        %continue
 1093  !------------------------------------------------------------------------
 1094  itype3(27): ! fdb
 1095        %cycle
 1096           %if pres char=',' %start
 1097              opd = 0
 1098              i = 0
 1099           %else
 1100              i = get opd(opd)
 1101           %finish
 1102           %if cont=0 %start
 1103              j = lp
 1104              look ahead = 1
 1105              %while more items %cycle
 1106                 k = get opd(k) %unless pres char=','
 1107              %repeat
 1108              look ahead = 0
 1109              instr out(0, opd, 0, -2, 0)
 1110              lp = j-1
 1111              next char
 1112              cont = 1
 1113           %else
 1114              instr out(0, opd, 0, -2, 0)
 1115           %finish
 1116           fault("Invalid constant") %unless i=0
 1117        %repeat %until %not more items
 1118        cont = 0
 1119        %continue
 1120  !-----------------------------------------------------------------------
 1121  itype3(28):! equ
 1122        i = get opd(opd)
 1123        instr out(0, opd, 0, -6, 0)
 1124        fault("No name to equate") %if lid=0
 1125        fault("Cannot evaluate operand") %unless i=0
 1126        %if lid#0 %and i=0 %and nass(lid)=3 %and nval(lid)#opd %start
 1127           fault("Inconsistent label")
 1128           nval(lid) = opd
 1129        %finish
 1130        %continue
 1131  !-----------------------------------------------------------------------
 1132  itype3(29):! org
 1133        i = get opd(opd)
 1134        ca = opd %if i=0
 1135        instr out(0, 0, 0, 0, 0)
 1136        fault("Illegal label") %unless lid=0
 1137        fault("Cannot evaluate operand") %unless i=0
 1138        %continue
 1139  !-----------------------------------------------------------------------
 1140  itype3(30): ! setdp
 1141        i = get opd(opd)
 1142        dp contents = opd<<8 %if i=0 %and 0<=opd<=255
 1143        instr out(0, opd, 0, -3, 0)
 1144        fault("Illegal label") %unless lid=0
 1145        %unless i=0 %start
 1146           fault("Cannot evaluate operand")
 1147        %finish %else %unless 0<=opd<=255 %start
 1148           fault("Invalid direct page contents")
 1149        %finish
 1150        %continue
 1151  !-----------------------------------------------------------------------
 1152  itype3(31): ! rmb
 1153        i = get opd(opd)
 1154        instr out(0, opd, 0, -4, 0)
 1155        %if i=0 %start
 1156           ca = ca+opd
 1157        %else
 1158           fault("Cannot evaluate operand")
 1159        %finish
 1160        %continue
 1161  !-----------------------------------------------------------------------
 1162  itype3(32):! fcc
 1163        non dense = 1
 1164        %if '0'<=pres char<='9' %start
 1165           i = 0
 1166           j = lp
 1167           %cycle
 1168              i = i*10+pres char-'0'
 1169              next char
 1170           %repeat %until %not '0'<=pres char<='9'
 1171           %if pres char=',' %start
 1172              next char
 1173              %if i=0 %start
 1174                 instr out(0, 0, 0, 0, 0)
 1175                 fault("Invalid string")
 1176              %else
 1177                 %while i>0 %cycle
 1178                    %if pres char=nl %start
 1179                       opd = ' '
 1180                    %else
 1181                       opd = line(lp)
 1182                       next char
 1183                    %finish
 1184                    i = i-1
 1185                    %if cont=0 %start
 1186                       j = lp
 1187                       %for k = 1, 1, i %cycle
 1188                          %exit %if pres char=nl
 1189                          next char
 1190                       %repeat
 1191                       instr out(0, opd, 0, -1, 0)
 1192                       lp = j-1
 1193                       next char
 1194                       cont = 1
 1195                    %else
 1196                       instr out(0, opd, 0, -1, 0)
 1197                    %finish
 1198                 %repeat
 1199                 cont = 0
 1200              %finish
 1201              %continue
 1202           %else
 1203              lp = j-1
 1204              next char
 1205           %finish
 1206        %finish
 1207        %if pres char<' ' %start
 1208           next char %while pres char#nl
 1209           instr out(0, 0, 0, 0, 0)
 1210           fault("Invalid string delimiter")
 1211        %else
 1212           delim = pres char
 1213           next char
 1214           %cycle
 1215              %if pres char=nl %start
 1216                 %if cont=0 %start
 1217                    instr out(0, 0, 0, 0, 0)
 1218                    fault("Invalid string")
 1219                 %finish
 1220                 %exit
 1221              %finish
 1222              %if pres char=delim %start
 1223                 next char
 1224                 %unless pres char=delim %start
 1225                    %if cont=0 %start
 1226                       instr out(0, 0, 0, 0, 0)
 1227                       fault("Invalid string")
 1228                    %finish
 1229                    %exit
 1230                 %finish
 1231              %finish
 1232              %if cont=0 %start
 1233                 i = lp
 1234                 %cycle
 1235                    next char %while pres char#delim %and pres char#nl
 1236                    %if pres char=delim %start
 1237                       next char
 1238                    %finish
 1239                    %exit %unless pres char=delim
 1240                    next char
 1241                 %repeat
 1242                 instr out(0, line(i), 0, -1, 0)
 1243                 lp = i-1
 1244                 next char
 1245                 cont = 1
 1246              %else
 1247                 instr out(0, line(lp), 0, -1, 0)
 1248              %finish
 1249              next char
 1250           %repeat
 1251           cont = 0
 1252        %finish
 1253        %continue
 1254  !-----------------------------------------------------------------------
 1255  itype3(33): ! nam
 1256        non dense = 1
 1257        header = ""
 1258        %while pres char#nl %cycle
 1259           header <- header.to string(line(lp))
 1260           next char
 1261        %repeat
 1262        instr out(0, 0, 0, -7, 0)
 1263        fault("Illegal label") %unless lid=0
 1264        %continue
 1265  !-----------------------------------------------------------------------
 1266  itype3(34): ! opt
 1267        i = lp
 1268        j = bchar
 1269        %cycle
 1270           %if get option(opt) %start
 1271              ->option action(opt)
 1272  option action(1):
 1273  option action(2):
 1274              bchar = ' '
 1275              -> next option
 1276  option action(3):
 1277  option action(4):
 1278              bchar = -1
 1279              -> next option
 1280  option action(5):
 1281  option action(6):
 1282              cflag = 1
 1283              -> next option
 1284  option action(7):
 1285  option action(8):
 1286              cflag = 0
 1287              -> next option
 1288  option action(9):
 1289              drad = 4
 1290              sp1 = 3
 1291              sp2 = 6
 1292              -> next option
 1293  option action(10):
 1294              drad = 5
 1295              sp1 = 3
 1296              sp2 = 5
 1297             -> next option
 1298  option action(11):
 1299              drad = 8
 1300              sp1 = 2
 1301              sp2 = 4
 1302              -> next option
 1303  option action(12):
 1304  option action(13):
 1305  option action(14):
 1306  option action(15):
 1307              eflag = 1
 1308              -> next option
 1309  option action(16):
 1310  option action(17):
 1311              eflag = 0
 1312              -> next option
 1313  option action(18):
 1314  option action(19):
 1315              fflag = 1
 1316              -> next option
 1317  option action(20):
 1318  option action(21):
 1319              fflag = 0
 1320              -> next option
 1321  option action(22):
 1322  option action(23):
 1323              gflag = 1
 1324              -> next option
 1325  option action(24):
 1326  option action(25):
 1327              gflag = 0
 1328              -> next option
 1329  option action(26):
 1330  option action(27):
 1331              lflag = 2
 1332              -> next option
 1333  option action(28):
 1334  option action(29):
 1335              lflag = 1
 1336              -> next option
 1337  option action(30):
 1338  option action(31):
 1339              lflag = 0
 1340              -> next option
 1341  option action(32):
 1342  option action(33):
 1343              pflag = 3
 1344              -> next option
 1345  option action(34):
 1346  option action(35):
 1347              pflag = 0
 1348              -> next option
 1349  option action(36):
 1350  option action(37):
 1351              sflag = 1
 1352              -> next option
 1353  option action(38):
 1354  option action(39):
 1355              sflag = 0
 1356              -> next option
 1357  option action(40):
 1358  option action(41):
 1359              tflag = 1
 1360              -> next option
 1361  option action(42):
 1362  option action(43):
 1363              tflag = 0
 1364              -> next option
 1365  option action(44):
 1366  option action(45):
 1367              wflag = 1
 1368              -> next option
 1369  option action(46):
 1370  option action(47):
 1371              wflag = 0
 1372              -> next option
 1373  option action(48):
 1374  option action(49):
 1375              xflag = 1
 1376              -> next option
 1377  option action(50):
 1378  option action(51):
 1379              xflag = 0
 1380  option action(-1):
 1381  option action(0):
 1382  next option:
 1383           %finish
 1384        %repeat %until %not more items
 1385        %if lflag=2 %start
 1386           sp3 = line width-sp1-sp2*3-cflag*3-wflag-11
 1387        %else
 1388           sp3 = line width-wflag-7
 1389        %finish
 1390        instr out(0, 0, 0, -7, 0)
 1391        fault("Illegal label") %unless lid=0
 1392        lp = i-1
 1393        next char
 1394        bchar = j
 1395        %cycle
 1396           %if get option(opt) %start
 1397              %if opt=1 %or opt=2 %start
 1398                 bchar = ' '
 1399              %finish %else %if opt=3 %or opt=4 %start
 1400                 bchar = -1
 1401              %finish %else %if opt<0 %start
 1402                 fault("Unknown option")
 1403              %finish
 1404           %else
 1405              fault("Cannot evaluate operand")
 1406           %finish
 1407        %repeat %until %not more items
 1408        %continue
 1409  !-----------------------------------------------------------------------
 1410  itype3(35): ! page
 1411        %unless lid=0 %start
 1412           instr out(0, 0, 0, -7, 0)
 1413           fault("Illegal label")
 1414        %finish
 1415        nline(lines on page) %unless lflag=0
 1416        %continue
 1417  !-----------------------------------------------------------------------
 1418  itype3(36): ! spc
 1419        i = get opd(opd)
 1420        %unless lid=0 %start
 1421           instr out(0, 0, 0, -7, 0)
 1422           fault("Illegal label")
 1423        %finish
 1424        %unless lflag=0 %start
 1425           %if i=0 %start
 1426              nline(opd)
 1427           %else
 1428              nline(1)
 1429           %finish
 1430        %finish
 1431  !-----------------------------------------------------------------------
 1432     %repeat
 1433  !-----------------------------------------------------------------------
 1434  itype3(37):! end
 1435     instr out(0, 0, 0, -7, 0)
 1436     fault("Illegal label") %unless lid=0
 1437     %for i = 1, 1, nnames %cycle
 1438        fault("Symbol ".name(i)." has no value") %if nass(i)=0
 1439     %repeat
 1440  !-----------------------------------------------------------------------
 1441     %unless xflag=0 %start
 1442        sqs(1, nnames)
 1443        nline(lines on page)
 1444        print string("   Symbol Cross Reference Table")
 1445        nline(2)
 1446        sp3 = (linewidth-6-sp2)//6
 1447        %for i = 1, 1, nnames %cycle
 1448           print string(name(i))
 1449           spaces(7-length(name(i)))
 1450           %if nass(i)=0 %or nass(i)=2 %or nass(i)=4 %start
 1451              print symbol('*') %for j = 1, 1, sp2
 1452           %else
 1453              print number(nval(i), 2)
 1454           %finish
 1455           j = xhead(i)
 1456           k = 0
 1457           %cycle
 1458              l = xlink(j)
 1459              xlink(j) = k
 1460              k = j
 1461              j = l
 1462           %repeat %until j=0
 1463           j = 0
 1464           %cycle
 1465              %if j=sp3 %start
 1466                 nline(1)
 1467                 spaces(7+sp2)
 1468                 j = 0
 1469              %finish
 1470              write(xentry(k), 5)
 1471              j = j+1
 1472              k = xlink(k)
 1473           %repeat %until k=0
 1474           nline(1)
 1475        %repeat
 1476     %finish %else %unless sflag=0 %start
 1477        sqs(1, nnames)
 1478        nline(lines on page)
 1479        print string("  Symbol Table")
 1480        nline(2)
 1481        sp3 = (line width+8-sp2)//15
 1482        sp1 = (linewidth-sp3*15+9-sp2)>>1
 1483        %for j = 1, 1, nnames %cycle
 1484           %if (j-1)=(j-1)//sp3*sp3 %start
 1485              nline(1)
 1486             spaces(sp2)
 1487           %else
 1488              spaces(8-sp2)
 1489           %finish
 1490           print string(name(j))
 1491           spaces(7-length(name(j)))
 1492           %if nass(j)=0 %or nass(j)=2 %or nass(j)=4 %start
 1493              print symbol('*') %for i = 1, 1, sp2
 1494           %else
 1495              print number(nval(j),2)
 1496           %finish
 1497        %repeat
 1498        nline(1)
 1499     %finish
 1500     nline(2)
 1501     spaces(2)
 1502     %if faults=0 %start
 1503        print string("No")
 1504     %else
 1505        write(faults, 0)
 1506     %finish
 1507     print string(" fault")
 1508     print symbol('s') %unless faults=1
 1509     print string(" in this assembly.")
 1510     newline
 1511     select output(0)
 1512     spaces(2)
 1513     %if faults=0 %start
 1514        write(ln, 0)
 1515        print string(" line")
 1516        print symbol('s') %unless ln=1
 1517        print string(" assembled.")
 1518     %else
 1519        write(faults, 0)
 1520        print string(" fault")
 1521        print symbol('s') %unless faults=1
 1522        print string(" in this assembly.")
 1523     %finish
 1524     new line
 1525     close
 1526     %stop
 1527  !-------------------------------------------------------
 1528     %predicate matches(%string(255) source, pattern,
 1529+                       %integer min, %integer %name i)
 1530        %integer l
 1531        l = length(pattern)
 1532        %if length(pattern)>=length(source) %start
 1533           l = length(source)
 1534        %else
 1535           l = length(pattern)
 1536        %finish
 1537        %for i = 1, 1, l %cycle
 1538           %unless charno(source, i)=charno(pattern, i) %start
 1539              %if 'A'<=charno(source, i)<='Z' %start
 1540                 %false
 1541              %finish %else %if i<=min %start
 1542                 %false
 1543              %else
 1544                 %true
 1545              %finish
 1546           %finish
 1547        %repeat
 1548        i = i+1
 1549        %false %if i<=min
 1550        %true
 1551     %end
 1552  !---------------------------------------------------------------------
 1553     %string(255) %function lc(%string(255) source)
 1554        %string(255) result
 1555        %integer i
 1556  
 1557        result = ""
 1558        %for i = 1, 1, length(source) %cycle
 1559           %if 'A'<=charno(source, i)&127<='Z' %start
 1560              result = result.tostring((charno(source, i)&127)+'a'-'A')
 1561           %else
 1562              result = result.tostring(charno(source, i)&127)
 1563           %finish
 1564        %repeat
 1565        %result = result
 1566     %end
 1567  !---------------------------------------------------------------------
 1568     %predicate is typed(%string(255) source, %string(255)%name file)
 1569        %integer i
 1570  
 1571        %for i = 1, 1, length(source) %cycle
 1572           file = substring(source, 1, i-1) %and %true %if charno(source, i)='.'
 1573        %repeat
 1574        file = source
 1575        %false
 1576     %end
 1577  !-----------------------------------------------------------------------
 1578  %routine read line
 1579  %integer ch
 1580     %integer i
 1581     %on %event 9 %start
 1582        %if i=1 %start
 1583           line(1) = ' '
 1584           line(2) = 'E'
 1585           line(3) = 'N'
 1586           line(4) = 'D'
 1587           line(5) = nl
 1588        %else
 1589           line(i) = nl
 1590        %finish
 1591        -> eof exit
 1592     %finish
 1593  
 1594     ln=ln+1
 1595     %for i = 1, 1, max line+1 %cycle
 1596        read symbol(ch); line(i) = ch
 1597        %exit %if line(i)&127=nl %or line(i)&127=12
 1598     %repeat
 1599     read symbol(ch) %and line(i) = ch %while line(i)&127#nl %and line(i)&127#12
 1600  eof exit:
 1601     lp = 0
 1602     next char
 1603  %end
 1604  !-----------------------------------------------------------------------
 1605  %routine next char
 1606  
 1607     lp = lp+1
 1608     pres char = line(lp)&127
 1609     %if 'a'<=pres char<='z' %start
 1610        pres char = pres char+'A'-'a'
 1611     %finish %else %if pres char=12 %start
 1612        pres char = nl
 1613     %finish %else %if pres char=9 %start
 1614        pres char = ' '
 1615     %finish
 1616  %end
 1617  !-----------------------------------------------------------------------
 1618  %routine skip blanks
 1619  
 1620     next char %while pres char=' '
 1621  %end
 1622  !-----------------------------------------------------------------------
 1623  %predicate more items
 1624  
 1625     next char %while pres char=bchar
 1626     %false %unless pres char=','
 1627     next char %until pres char#bchar
 1628     %true
 1629  %end
 1630  !-----------------------------------------------------------------------
 1631  %predicate get option(%integer %name opt)
 1632     %string(11) option
 1633  
 1634     %if 'A'<=pres char<='Z' %start
 1635        option = to string(pres char)
 1636        %cycle
 1637           next char
 1638           %exit %unless 'A'<=pres char<='Z' %or '0'<=pres char<='9'
 1639           option <- option.to string(pres char)
 1640        %repeat
 1641        %for opt = 1, 1, no options %cycle
 1642           %true %if option text(opt)=option
 1643        %repeat
 1644        opt = -1
 1645        %true
 1646     %else
 1647        opt = 0
 1648        %false %unless pres char=','
 1649        next char
 1650        %true
 1651     %finish
 1652  %end
 1653  !-----------------------------------------------------------------------
 1654  %integerfn get name(%integername nid)
 1655     %string(6) n
 1656     %integer h,l
 1657  
 1658     nid = 0 %and %result = 1 %unless 'A'<=pres char<='Z'
 1659     h=pres char-'0'
 1660     n=tostring(pres char)
 1661     l = 1
 1662     %cycle
 1663        next char
 1664        %exit %unless 'A'<=pres char<='Z' %or '0'<=pres char<='9'
 1665        l = l+1
 1666        h=h<<4+pres char-'0' %and n=n.tostring(pres char) %unless l>6
 1667     %repeat
 1668     h=h&32767
 1669     h=h-h//nhash*nhash
 1670     l=hnlink(h)
 1671     %while l#0 %cycle
 1672        %if name(l)=n %start
 1673           nid = l
 1674           %if pass=4 %and xxentries<=xentries %and %c
 1675+                look ahead=0 %start
 1676              xxentries = xxentries+1
 1677              %if xxentries>xentries %start
 1678                 fault("Too many references")
 1679              %else
 1680                 xlink(xxentries) = xhead(l)
 1681                 xentry(xxentries) = ln
 1682                 xhead(l) = xxentries
 1683              %finish
 1684           %finish
 1685           %result = 0
 1686        %finish
 1687        l=nlink(l)
 1688     %repeat
 1689     fault("Too many names") %and %stop %if nnames=names
 1690     nnames = nnames+1
 1691     name(nnames) = n
 1692     nlink(nnames) = hnlink(h)
 1693     %if n="A" %or n="B" %or n="CC" %or n="DP" %or n="X" %or %c
 1694+          n="Y" %or n="U" %or n="S" %or n="PC" %or n="PCR" %start
 1695        nass(nnames) = 2
 1696     %else
 1697        nass(nnames) = 0
 1698     %finish
 1699     nval(nnames) = 0
 1700     %if pass=4 %and xxentries<=xentries %start
 1701        xxentries = xxentries+1
 1702        %if xxentries>xentries %start
 1703           fault("Too many references")
 1704        %else
 1705           xlink(xxentries) = 0
 1706           xentry(xxentries) = ln
 1707           xhead(nnames) = xxentries
 1708        %finish
 1709     %else
 1710        xhead(nnames) = 0
 1711     %finish
 1712     hnlink(h) = nnames
 1713     nid = nnames
 1714     %result=0
 1715  %end
 1716  !-----------------------------------------------------------------------
 1717  %predicate get instr(%integername iid)
 1718     %string(5) i
 1719     %integer h,l
 1720  
 1721     iid=0
 1722     %false %unless 'A'<=pres char<='Z'
 1723     h=pres char-'0'
 1724     i=tostring(pres char)
 1725     %for l = 2, 1, 5 %cycle
 1726        next char
 1727        -> goti %unless 'A'<=pres char<='Z' %or '0'<=pres char<='9'
 1728        h=h<<4+pres char-'0'
 1729        i=i.tostring(pres char)
 1730     %repeat
 1731     next char
 1732     %false %if 'A'<=pres char<='Z'
 1733  goti: h=h&32767
 1734     h=h-h//ihash*ihash
 1735     l=hilink(h)
 1736     %while l#0 %cycle
 1737        iid=l %and %true %if instr(l)=i
 1738        l=ilink(l)
 1739     %repeat
 1740     %false
 1741  %end
 1742  !-----------------------------------------------------------------------
 1743  %routine evaluate(%integer %name a, %integer b, %byte %integer op)
 1744  
 1745     %if op='+' %start
 1746        a = a+b
 1747     %finish %else %if op='-' %start
 1748        a = a-b
 1749     %finish %else %if op='*' %start
 1750        a = a*b
 1751     %finish %else %if op='/' %start
 1752        a = a//b
 1753     %finish %else %if op='|' %start
 1754        a = a-a//b*b
 1755     %finish %else %if op='!' %start
 1756        a = a!b
 1757     %finish %else %if op='&' %start
 1758        a = a&b
 1759     %finish %else %if op='\' %start
 1760        a = a!!b
 1761     %finish %else %if op='<' %start
 1762        a = a<<b
 1763     %finish %else %if op='>' %start
 1764        a = a>>b
 1765     %finish
 1766  %end
 1767  !-----------------------------------------------------------------------
 1768  %integer %function get term(%integer %name opd)
 1769     %integer i
 1770  
 1771     %while pres char='+' %cycle
 1772        next char %until pres char#bchar
 1773     %repeat
 1774     %if pres char='-' %start
 1775        next char %until pres char#bchar
 1776        i = get term(opd)
 1777        opd = -opd
 1778     %finish %else %if pres char='\' %start
 1779        next char %until pres char#bchar
 1780        i = get term(opd)
 1781        opd = \opd
 1782     %finish %else %if pres char='(' %start
 1783        next char %until pres char#bchar
 1784        i = get expression(opd)
 1785        %if i=0 %start
 1786           next char %while pres char=bchar
 1787           %if pres char=')' %start
 1788              next char
 1789           %else
 1790              i = 1
 1791           %finish
 1792        %finish
 1793     %finish %else %if get name(i)=0 %start
 1794        %if pass=1 %or nass(i)=1 %or nass(i)=3 %start
 1795           opd = nval(i)
 1796           i = 0
 1797        %else
 1798           i = 1
 1799        %finish
 1800     %else
 1801        i = get const(opd)
 1802     %finish
 1803     %result = i
 1804  %end
 1805  !-----------------------------------------------------------------------
 1806  %integer %function get expression(%integer %name opd)
 1807     %integer sp, prio, i
 1808     %byte %integer %array op stk, prio stk(1:5)
 1809     %integer %array opd stk(0:5)
 1810  
 1811     %result = 1 %unless get term(opd stk(0))=0
 1812     sp = 0
 1813     i = 0
 1814     %cycle
 1815        next char %while pres char=bchar
 1816        %if pres char='!' %or pres char='\' %start
 1817           prio = 0
 1818        %finish %else %if pres char='&' %start
 1819           prio = 1
 1820        %finish %else %if pres char='+' %or pres char='-' %start
 1821           prio = 2
 1822        %finish %else %if pres char='*' %or pres char='/' %or %c
 1823+             pres char='|' %start
 1824           prio = 3
 1825        %finish %else %if pres char='<' %or pres char='>' %start
 1826           prio = 4
 1827        %else
 1828           %exit
 1829        %finish
 1830        %while sp>0 %and prio stk(sp)>=prio %cycle
 1831           evaluate(opd stk(sp-1), opd stk(sp), op stk(sp))
 1832           sp = sp-1
 1833        %repeat
 1834        sp = sp+1
 1835        op stk(sp) = pres char
 1836        prio stk(sp) = prio
 1837        next char %until pres char#bchar
 1838        %unless get term(opd stk(sp))=0 %start
 1839           sp = sp-1
 1840           i = 1
 1841           %exit
 1842        %finish
 1843     %repeat
 1844     evaluate(opd stk(sp-1), opd stk(sp), op stk(sp)) %for sp = sp, -1, 1
 1845     opd = opd stk(0) %if i=0
 1846     %result = i
 1847  %end
 1848  !-----------------------------------------------------------------------
 1849  %integer %function get opd(%integername opd)
 1850     %integer nid,op,cval
 1851  
 1852     %result = get expression(opd) %unless fflag=0
 1853     opd=0
 1854     %if pres char='+' %or pres char='-' %start
 1855        op =pres char
 1856        next char %until pres char#bchar
 1857     %else
 1858        op = '+'
 1859     %finish
 1860     %cycle
 1861        %if get name(nid)=0 %start
 1862           %result=1 %unless pass=1 %or nass(nid)=1 %or nass(nid)=3
 1863           cval=nval(nid)
 1864        %else
 1865           %result=1 %if get const(cval)#0
 1866        %finish
 1867        evaluate(opd, cval, op)
 1868        next char %while pres char=bchar
 1869        op = pres char
 1870        %result=0 %unless op='+' %or op='-' %or op='*' %or op='/'
 1871        next char %until pres char#bchar
 1872     %repeat
 1873  %end
 1874  !-----------------------------------------------------------------------
 1875  %integerfn get const(%integername cval)
 1876     %integer started, dig val, bin val, oct val, hex val,
 1877+       bin pos, oct pos, dec pos
 1878  
 1879     started=1
 1880     %if pres char='*' %start
 1881        next char
 1882        cval = ca
 1883        %result = 0
 1884     %finish
 1885     cval=0
 1886     %if '0'<=pres char<='9' %start    ;! decimal
 1887        bin pos = 0
 1888        oct pos = 0
 1889        dec pos = 0
 1890        bin val = 0
 1891        oct val = 0
 1892        hex val = 0
 1893        %cycle
 1894           %if bin pos=0 %and pres char='B' %start
 1895              next char
 1896              %if '0'<=pres char<='9' %or 'A'<=pres char<='F' %or %c
 1897+                   pres char='H' %start
 1898                 bin pos = 1
 1899                 oct pos = 1
 1900                 dec pos = 1
 1901                 hex val = (hex val<<4)+11
 1902              %else
 1903                 cval = bin val
 1904                 %result = 0
 1905              %finish
 1906           %finish
 1907           %if oct pos=0 %and (pres char='O' %or pres char='Q') %start
 1908              cval = oct val
 1909              next char
 1910              %result = 0
 1911           %finish %else %if pres char='H' %start
 1912              cval = hex val
 1913              next char
 1914              %result = 0
 1915           %finish %else %if 'A'<=pres char<='F' %start
 1916              dig val = pres char-'A'+10
 1917           %finish %else %if '0'<=pres char<='9' %start
 1918              dig val = pres char-'0'
 1919           %else
 1920              %result = dec pos
 1921           %finish
 1922           bin pos = 1 %if dig val>1
 1923           oct pos = 1 %if dig val>7
 1924           dec pos = 1 %if dig val>9
 1925           bin val = (bin val<<1)+dig val
 1926           oct val = (oct val<<3)+dig val
 1927           cval = cval*10+dig val
 1928           hex val = (hex val<<4)+dig val
 1929           next char
 1930        %repeat
 1931     %finish
 1932     %if pres char='$' %start    ;! hex
 1933        %cycle
 1934           next char
 1935           %if '0'<=pres char<='9' %start
 1936              cval = cval<<4!(pres char-'0')
 1937           %finish %else %if 'A'<=pres char<='F' %start
 1938              cval = cval<<4!(pres char-'A'+10)
 1939           %else
 1940              %result = started
 1941           %finish
 1942           started = 0
 1943        %repeat
 1944     %finish
 1945     %if pres char='@' %start    ;! octal
 1946        %cycle
 1947           next char
 1948           %result = started %unless '0'<=pres char<='7'
 1949           cval = (cval<<3)!(pres char-'0')
 1950           started = 0
 1951        %repeat
 1952     %finish
 1953     %if pres char='%' %start
 1954        %cycle
 1955           next char
 1956           %result = started %unless '0'<=pres char<='1'
 1957           cval = (cval<<1)!(pres char-'0')
 1958           started = 0
 1959        %repeat
 1960     %finish
 1961     %if pres char='''' %start
 1962        next char
 1963        %result=1 %if lp=max line+1
 1964        cval=line(lp)
 1965        next char
 1966        %result=0
 1967     %finish
 1968     %result=1
 1969  %end
 1970  !-----------------------------------------------------------------------
 1971  %routine analise operand(%integer eca,
 1972+                     %integer %name post, opd, type, cycles)
 1973     %integer indirect, i
 1974  
 1975     type = 5
 1976     %if pres char='[' %start
 1977        next char %until pres char#bchar
 1978        indirect = 1
 1979     %else
 1980        indirect = 0
 1981     %finish
 1982     %if more items %start
 1983        %if pc %start
 1984           opd = 0
 1985           post = 16_8C
 1986           type = 6
 1987           cycles = cycles+3
 1988        %finish %else %if pc relative %start
 1989           opd = -2-eca
 1990           %if pass<3 %or -128<=opd<=127 %start
 1991              post = 16_8C
 1992              type = 6
 1993              cycles = cycles+3
 1994           %else
 1995              opd = opd-1
 1996              post = 16_8D
 1997              type = 7
 1998              cycles = cycles+7
 1999           %finish
 2000        %finish %else %unless auto indexed(post, cycles) %start
 2001           type = 0
 2002        %finish
 2003     %finish %else %if pc %start
 2004        opd = 0
 2005        post = 16_8C
 2006        type = 6
 2007        cycles = cycles+3
 2008     %finish %else %if pc relative %start
 2009        opd = -2-eca
 2010        %if pass<3 %or -128<=opd<=127 %start
 2011           post = 16_8C
 2012           type = 6
 2013           cycles = cycles+3
 2014        %else
 2015           opd = opd-1
 2016           post = 16_8D
 2017           type = 7
 2018           cycles = cycles+7
 2019        %finish
 2020     %finish %else %unless auto indexed(post, cycles) %start
 2021        %if acc('A') %start
 2022           type = 1 %and -> check indirect %unless more items
 2023           post = 16_86
 2024           cycles = cycles+3
 2025        %finish %else %if acc('B') %start
 2026           type = 2 %and -> check indirect %unless more items
 2027           post = 16_85
 2028           cycles = cycles+3
 2029        %finish %else %if acc('D') %start
 2030           type = 0 %and -> check indirect %unless more items
 2031           post = 16_8B
 2032           cycles = cycles+6
 2033        %finish %else %if pres char='<' %start
 2034           next char %until pres char#b char
 2035           %if get opd(opd)=0 %start
 2036              type = 4
 2037           %else
 2038              type = 0
 2039           %finish
 2040           cycles = cycles+3
 2041           -> check indirect
 2042        %finish %else %if pres char='>' %start
 2043           next char %until pres char#b char
 2044           %if get opd(opd)=0 %start
 2045             %if indirect=0 %start
 2046                type = 3
 2047             %else
 2048                type = 4
 2049                cycles = cycles+1
 2050             %finish
 2051           %else
 2052              type = 0
 2053           %finish
 2054           cycles = cycles+2
 2055           -> check indirect
 2056        %else
 2057           %if get opd(opd)=0 %start
 2058              %if more items %start
 2059                 %if pc %start
 2060                    %if pass<3 %or -128<=opd<=127 %start
 2061                       post = 16_8C
 2062                       type = 6
 2063                       cycles = cycles+3
 2064                    %else
 2065                       post = 16_8D
 2066                       type = 7
 2067                       cycles = cycles+7
 2068                    %finish
 2069                    -> check indirect
 2070                 %finish %else %if pc relative %start
 2071                    opd = opd-eca-2
 2072                    %if pass<3 %or -128<=opd<=127 %start
 2073                       post = 16_8C
 2074                       type = 6
 2075                       cycles = cycles+3
 2076                    %else
 2077                       opd = opd-1
 2078                       post = 16_8D
 2079                       type = 7
 2080                       cycles = cycles+7
 2081                    %finish
 2082                    ->check indirect
 2083                 %finish %else %if pass<3 %or opd=0 %start
 2084                    type = 0 %unless auto indexed(post, cycles)
 2085                    -> check indirect
 2086                 %finish %else %if indirect=0 %and -16<=opd<=15 %start
 2087                    post = opd&31
 2088                    cycles = cycles+3
 2089                 %finish %else %if -128<=opd<=127 %start
 2090                    post = 16_88
 2091                    type = 6
 2092                    cycles = cycles+3
 2093                 %else
 2094                    post = 16_89
 2095                    type = 7
 2096                    cycles = cycles+6
 2097                 %finish
 2098              %else
 2099                 %if indirect=0 %and 0<=opd-dp contents<=255 %start
 2100                    type = 3
 2101                    cycles = cycles+2
 2102                 %else
 2103                    type = 4
 2104                    cycles = cycles+3
 2105                 %finish
 2106                 -> check indirect
 2107              %finish
 2108           %else
 2109              type = 0
 2110           %finish
 2111        %finish
 2112        %if index reg(i) %start
 2113           post = post!(i<<5)
 2114        %else
 2115           type = 0
 2116        %finish
 2117     %finish
 2118  check indirect:
 2119     %unless indirect=0 %start
 2120        type = 0 %if 1<=type<=2 %or %c
 2121+                   (type=5 %and (post=16_80 %or post=16_82))
 2122        next char %while pres char=b char
 2123        %if pres char=']' %start
 2124           next char
 2125           cycles = cycles+3
 2126           %if 3<=type<=4 %start
 2127              post = 16_9F
 2128              cycles = cycles+4-type
 2129              type = 7
 2130           %else
 2131              post = post!16_10
 2132           %finish
 2133        %else
 2134           type = 0
 2135        %finish
 2136     %finish
 2137  %end
 2138  !-----------------------------------------------------------------------
 2139  %predicate auto indexed(%integer %name post, cycles)
 2140     %integer old lp, reg
 2141  
 2142     old lp = lp
 2143     %if pres char='-' %start
 2144        next char %until pres char#b char
 2145        %if pres char='-' %start
 2146           next char %until pres char#bchar
 2147           post = 16_83
 2148        %else
 2149           post = 16_82
 2150        %finish
 2151     %else
 2152        post = 16_84
 2153     %finish
 2154     %if index reg(reg) %start
 2155        %if post = 16_84 %start
 2156           next char %while pres char=b char
 2157           %if pres char='+' %start
 2158              next char %until pres char#b char
 2159              %if pres char='+' %start
 2160                 next char
 2161                 post = 16_81
 2162                 cycles = cycles+5
 2163              %else
 2164                 post = 16_80
 2165                 cycles = cycles+4
 2166              %finish
 2167           %else
 2168              cycles = cycles+2
 2169           %finish
 2170        %else
 2171           cycles = cycles+4+(post&1)
 2172        %finish
 2173        post = post!(reg<<5)
 2174        %true
 2175     %finish
 2176     lp = old lp-1
 2177     next char
 2178     %false
 2179  %end
 2180  !-----------------------------------------------------------------------
 2181  %predicate accumulator
 2182  
 2183     %true %if acc('A')
 2184     %true %if acc('B')
 2185     %false
 2186  %end
 2187  !-----------------------------------------------------------------------
 2188  %predicate acc(%byte %integer acc id)
 2189  
 2190     %false %unless pres char=acc id
 2191     next char
 2192     %true %unless 'A'<=pres char<='Z' %or '0'<=pres char<='9'
 2193     lp = lp-2
 2194     next char
 2195     %false
 2196  %end
 2197  !-----------------------------------------------------------------------
 2198  %predicate index reg(%integer %name reg)
 2199  
 2200     reg = 0 %and %true %if acc('X')
 2201     reg = 1 %and %true %if acc('Y')
 2202     reg = 2 %and %true %if acc('U')
 2203     reg = 3 %and %true %if acc('S')
 2204     %false
 2205  %end
 2206  !-----------------------------------------------------------------------
 2207  %predicate transfer reg(%integer %name reg)
 2208  
 2209     reg = 0 %and %true %if acc('D')
 2210     reg = 1 %and %true %if acc('X')
 2211     reg = 2 %and %true %if acc('Y')
 2212     reg = 3 %and %true %if acc('U')
 2213     reg = 4 %and %true %if acc('S')
 2214     reg = 5 %and %true %if pc
 2215     reg = 8 %and %true %if acc('A')
 2216     reg = 9 %and %true %if acc('B')
 2217     reg = 10 %and %true %if cc
 2218     reg = 11 %and %true %if dp
 2219     %false
 2220  %end
 2221  !-----------------------------------------------------------------------
 2222  %predicate cc
 2223  
 2224     %false %unless pres char='C'
 2225     next char
 2226     %true %if acc('C')
 2227     lp = lp-2
 2228     next char
 2229     %false
 2230  %end
 2231  !-----------------------------------------------------------------------
 2232  %predicate dp
 2233  
 2234     %false %unless pres char='D'
 2235     next char
 2236     %true %if acc('P')
 2237     lp = lp-2
 2238     next char
 2239     %false
 2240  %end
 2241  !-----------------------------------------------------------------------
 2242  %predicate pc
 2243  
 2244     %false %unless pres char='P'
 2245     next char
 2246     %true %if acc('C')
 2247     lp = lp-2
 2248     next char
 2249     %false
 2250  %end
 2251  !-----------------------------------------------------------------------
 2252  %predicate pc relative
 2253  
 2254     %false %unless pres char='P'
 2255     next char
 2256     %if pres char='C' %start
 2257        next char
 2258        %true %if acc('R')
 2259        lp = lp-1
 2260     %finish
 2261     lp = lp-2
 2262     next char
 2263     %false
 2264  %end
 2265  !-----------------------------------------------------------------------
 2266  %routine dump block
 2267     %integer checksum, old rad, i
 2268  
 2269     select output(1)
 2270     old rad = drad
 2271     drad = 8
 2272     print string("S1")
 2273     print number(bp+3, 1)
 2274     print number(buffer ca, 2)
 2275     checksum = ((buffer ca>>8)&255)+(buffer ca&255)+bp+3
 2276     %for i = 1, 1, bp %cycle
 2277        checksum = check sum+buffer(i)
 2278        print number(buffer(i), 1)
 2279     %repeat
 2280     print number(\(checksum&255), 1)
 2281     print symbol(13)
 2282     new line
 2283     drad = old rad
 2284     select output(2)
 2285     bp = 0
 2286  %end
 2287  !--------------------------------------------------------------------------
 2288  %routine dump(%byte %integer byte)
 2289     %if ostarted=0 %start
 2290        select output(1)
 2291        print symbol(13)
 2292        new line
 2293        print string("S00600004844521B")
 2294        print symbol(13)
 2295        new line
 2296        select output(2)
 2297        ostarted = 1
 2298     %finish
 2299     buffer ca = ca %if bp=0
 2300     dump block %and buffer ca = ca %unless buffer ca+bp=ca
 2301     bp = bp+1
 2302     buffer(bp) = byte
 2303     ca = ca+1
 2304     dump block %if bp=16
 2305  %end
 2306  !---------------------------------------------------------------------------
 2307  %routine close
 2308     %unless ostarted=0 %start
 2309        dump block %unless bp=0
 2310        select output(1)
 2311        print string("S9030000FC")
 2312        print symbol(13)
 2313        new line
 2314        select output(2)
 2315     %finish
 2316  %end
 2317  !-----------------------------------------------------------------------
 2318  %routine instr out(%integer op, post, opd, b, cyc)
 2319     %integer i, j, k, lit
 2320  
 2321     i = 1
 2322     %unless lflag=0 %or ((gflag=0 %or lflag=1) %and cont=1) %start
 2323        write(ln, 5)
 2324        space %unless wflag=0
 2325        %if lflag=2 %start
 2326           space
 2327           %if b<=-5 %start
 2328              spaces(sp2)
 2329           %else
 2330              print number(ca, 2)
 2331           %finish
 2332           space
 2333           %if -6<=b<=-1 %start
 2334              spaces(sp2+1)
 2335              %if b&1=0 %start
 2336                 print number(post, 2)
 2337              %else
 2338                 print number(post, 1)
 2339                 spaces(sp2-sp1)
 2340              %finish
 2341              spaces(sp1+1)
 2342           %else
 2343              %if b<=0 %start
 2344                 spaces(sp2)
 2345              %finish %else %if 0<=op<=255 %start
 2346                 print number(op, 1)
 2347                 spaces(sp2-sp1)
 2348              %else
 2349                 print number(op, 2)
 2350              %finish
 2351              space
 2352              %if b<=1 %start
 2353                 spaces(sp1+sp2+1)
 2354              %finish %else %if b<=4 %start
 2355                 print number(post, 1)
 2356                 space
 2357                 %if b<=2 %start
 2358                    spaces(sp2)
 2359                 %finish %else %if b=3 %start
 2360                    print number(opd, 1)
 2361                    spaces(sp2-sp1)
 2362                 %else
 2363                    print number(opd, 2)
 2364                 %finish
 2365              %else
 2366                 print number(post, 2)
 2367                 spaces(sp1+1)
 2368              %finish
 2369           %finish
 2370           %unless cflag=0 %start
 2371              %if cyc=0 %start
 2372                 spaces(3)
 2373              %else
 2374                 write(cyc, 2)
 2375              %finish
 2376           %finish
 2377        %finish
 2378        %if cont=0 %start
 2379           space
 2380           %if tflag=0 %start
 2381              %cycle
 2382                 out symbol(line(i))
 2383                 %exit %if line(i)&127=nl %or line(i)&127=12
 2384                 i = i+1
 2385              %repeat
 2386           %else
 2387              j = 1
 2388              out tag(i, j, 8)
 2389              out tag(i, j, 12) %if accop=1
 2390              out tag(i, j, 15)
 2391              k = 0
 2392              lit = 0
 2393              %while i#lp %cycle
 2394                 %if line(i)&127=' ' %start
 2395                    k = k+1 %if non dense=1 %or lit=1
 2396                 %else
 2397                    j = j+k+1
 2398                    out symbol(' ') %and k = k-1 %while k>0
 2399                    out symbol(line(i))
 2400                 %finish
 2401                 %if line(i)&127='''' %start
 2402                    lit = 1
 2403                 %else
 2404                    lit = 0
 2405                 %finish
 2406                 i = i+1
 2407              %repeat
 2408              i = i+1 %while line(i)&127=' '
 2409              %unless lp=1 %or line(i)&127=nl %or line(i)&127=12 %start
 2410                 out symbol(' ') %and j = j+1 %until j>=24
 2411              %finish
 2412              %cycle
 2413                 out symbol(line(i))
 2414                 %exit %if line(i)&127=nl %or line(i)&127=12
 2415                 i = i+1
 2416              %repeat
 2417           %finish
 2418        %else
 2419           nline(1)
 2420        %finish
 2421     %else
 2422        i = i+1 %while line(i)&127#nl %and line(i)&127#12
 2423     %finish
 2424     fault("Truncated line") %if i=max line+1
 2425  
 2426     %if b>=1 %start
 2427        dump((op>>8)&255) %unless 0<=op<=255
 2428        dump(op&255)
 2429        dump((post>>8)&255) %if b=5
 2430        dump(post&255) %if b>=2
 2431        dump((opd>>8)&255) %if b=4
 2432        dump(opd&255) %if 3<=b<=4
 2433     %finish %else %if -2<=b<=-1 %start
 2434        dump((post>>8)&255) %if b=-2
 2435        dump((post&255))
 2436     %finish
 2437  %end
 2438  !-----------------------------------------------------------------------
 2439  %routine out tag(%integer %name i, j, %integer col)
 2440  
 2441     %while line(i)&127#' ' %and i#lp %cycle
 2442        out symbol(line(i))
 2443        i = i+1
 2444        j = j+1
 2445     %repeat
 2446     i = i+1 %while line(i)&127=' ' %and i#lp
 2447     %unless i=lp %start
 2448        out symbol(' ') %and j = j+1 %until j>=col
 2449     %finish
 2450  %end
 2451  !------------------------------------------------------------------------
 2452  %routine out symbol(%byte %integer char)
 2453     %own %integer optr = 0
 2454  
 2455     %if char&127=nl %start
 2456        optr = 0
 2457        nline(1)
 2458     %finish %else %if char&127=12 %start
 2459        optr = 0
 2460        nline(lines on page)
 2461     %else
 2462        %if optr=sp3 %start
 2463           %return %if wflag=0
 2464           nline(1)
 2465           write(ln, 5)
 2466           print symbol('+')
 2467           spaces(line width-sp3-7)
 2468           optr = 0
 2469        %finish
 2470        print symbol(char)
 2471        optr = optr+1
 2472     %finish
 2473  %end
 2474  !-----------------------------------------------------------------------
 2475  %routine fault(%string(63) s)
 2476  
 2477     faults=faults+1
 2478     %unless eflag=0 %start
 2479        print string("****  ".s.".  ****")
 2480        nline(1)
 2481     %finish
 2482  %end
 2483  !-----------------------------------------------------------------------
 2484  %routine nline(%integer n)
 2485     %own %integer line on page = lines on page+1, page no = 0
 2486  
 2487     %unless n<0 %start
 2488        %if line on page+pflag+n>lines on page %start
 2489           page no = page no+1
 2490           %unless n=0 %start
 2491              %if line on page=lines on page %start
 2492                 new line
 2493              %else
 2494                 print symbol(12)
 2495              %finish
 2496           %finish
 2497           %if pflag=0 %start
 2498              line on page = 1
 2499           %else
 2500              new line
 2501              print string("  Motorola M6809 Assembler ")
 2502              spaces((line width-37-length(header))//2)
 2503              print string(header)
 2504              spaces((line width-36-length(header))//2)
 2505              print string(" Page")
 2506              write(page no, 2)
 2507              new lines(2)
 2508              line on page = 4
 2509           %finish
 2510        %else
 2511           new lines(n)
 2512           line on page = line on page+n
 2513        %finish
 2514     %finish
 2515  %end
 2516  !-----------------------------------------------------------------------
 2517  %routine print number(%integer n,d)
 2518     %conststring(1)%array h(0:15)="0","1","2","3","4","5","6","7","8","9",
 2519+      "A","B","C","D","E","F"
 2520     %integer model, nn
 2521     %string(6) s
 2522  
 2523     model = 1<<(d*8-1)
 2524     s=""
 2525     %cycle
 2526        model =(model>>1)//drad
 2527        nn = (n>>1)//drad
 2528        s=h(n-((nn*drad)<<1)).s
 2529        n = nn
 2530     %repeat %until model=0
 2531     print string(s)
 2532  %end
 2533  !-----------------------------------------------------------------------
 2534  %routine sqs(%integer l, r)
 2535     %integer nass key, nval key, xhead key, lp, rp, i
 2536     %string(6) name key
 2537  
 2538     %return %unless l<r
 2539     %while r-l>insert limit %cycle
 2540        lp = l
 2541        rp = r+1
 2542        name key = name(l)
 2543        nass key = nass(l)
 2544        nval key = nval(l)
 2545        xhead key = xhead(l)
 2546        %cycle
 2547           rp = rp-1 %until rp=lp %or name key>name(rp)
 2548           %exit %if lp=rp
 2549           name(lp) = name(rp)
 2550           nass(lp) = nass(rp)
 2551           nval(lp) = nval(rp)
 2552           xhead(lp) = xhead(rp)
 2553           lp = lp+1 %until rp=lp %or name key<=name(lp)
 2554           %exit %if lp=rp
 2555           name(rp) = name(lp)
 2556           nass(rp) = nass(lp)
 2557           nval(rp) = nval(lp)
 2558           xhead(rp) = xhead(lp)
 2559        %repeat
 2560        name(lp) = name key
 2561        nass(lp) = nass key
 2562        nval(lp) = nval key
 2563        xhead(lp) = xhead key
 2564        %if lp-l>r-rp %start
 2565           sqs(rp+1, r)
 2566           r = lp-1
 2567        %else
 2568           sqs(l, lp-1)
 2569           l = rp+1
 2570        %finish
 2571     %repeat
 2572     %for rp = l+1, 1, r %cycle
 2573        name key = name(rp)
 2574        nass key = nass(rp)
 2575        nval key = nval(rp)
 2576        xhead key = xhead(rp)
 2577        lp = l
 2578        lp = lp+1 %while lp#rp %and name key>name(lp)
 2579        %for i = rp-1, -1, lp %cycle
 2580           name(i+1) = name(i)
 2581           nass(i+1) = nass(i)
 2582           nval(i+1) = nval(i)
 2583           xhead(i+1) = xhead(i)
 2584        %repeat
 2585        name(lp) = name key
 2586        nass(lp) = nass key
 2587        nval(lp) = nval key
 2588        xhead(lp) = xhead key
 2589     %repeat
 2590  %end
 2591  !-----------------------------------------------------------------------
 2592  %end %of %program
?COPYRIGHT unused

 2170 Statements compiled
