%external %routine ass11(%string (63) files)
   %external %integer %function %spec smaddr(%integer chan,
      %integer %name length)
   %routine define(%string (255) s)
      %external %routine %spec emas3(%string %name command,params,
         %integer %name flag)
      %integer flag
      emas3("DEFINE",s,flag)
   %end;                                 ! Of %routine define.
   %external %string %function %spec date %alias "S#DATE"
   %dynamic %integer %fn %spec time40(%integer in)
   %dynamic %integer %fn %spec time03(%integer in)
   %dynamic %integer %fn %spec time45(%integer in)
   %routine dump bin(%half %integer %array %name code, %integer start,finish,
      %string %name t, %integer %name flag)
      %integer check,j
      %routine put(%integer n)
         %integer m
         m = n>>8&255
         n = n&255
         printch(n); printch(m)
         check = check+(n+m)
      %end
      %return %if start<0;               !?????
      select output(3)
      check = 0
      put(1)
      put((finish-start+1)*2+4)
      %cycle j = start,1,finish
         put(code(j))
      %repeat
      printch((-check)&255)
      select output(2)
   %end
                                         !!
   %integer %fn %spec break up(%byte %integer %array %name lne)
   %routine %spec octal(%integer n)
   %routine %spec code
   %integer %fn %spec an opnd(%integer type, %string (80) opnd)
   %routine %spec set def(%integer def,opn)
   %routine %spec user def(%string %name opnd)
   %routine %spec list line(%integer len)
   %integer %fn %spec test reg(%string (80) reg)
   %integer %fn %spec value(%string %name opnd)
   %integer %fn %spec test name(%string %name name)
   %integer %fn %spec branch(%integer val,here)
   %integer %fn %spec new tag(%string %name a)
   %integer %fn %spec search(%string %name a)
   %integer %fn %spec hash(%string %name ident, %byte %integer flag)
   %routine %spec word(%string (80) opnd)
   %routine %spec fault(%integer i)
   %routine %spec origin
   %routine %spec pseudo eval
   %routine %spec globals
   %routine %spec byte(%string %name opnd)
   %routine %spec push byte(%integer n)
   %routine %spec abandon(%string (60) s)
   %routine %spec symbols
   %routine %spec bin out
   %routine %spec report faults
   %routine %spec start pass two(%integer str)
                                         !!
                                         !!!!!!!!!!%c
                                         !!!!!!!!!!%c
                                         !!!!!!!!!!%c
                                         !!!!!!!!!!!!!!!!!!!!!!!!!!!!!
                                         !!         %c
                                         !!
                                         !!               INSTRUCTION%c
                                         DESCRIPTOR                  !!
                                         !!         %c
                                         !!
                                         !!!!!!!!!!%c
                                         !!!!!!!!!!%c
                                         !!!!!!!!!!%c
                                         !!!!!!!!!!!!!!!!!!!!!!!!!!!!!
                                         !!
   %record %format instf(%byte %integer type,byte, %half %integer code)
   %record (instf) %name inst
                                         !!
                                         !!!!!!!!!!%c
                                         !!!!!!!!!!%c
                                         !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
                                         !!         %c
                                         !!
                                         !!                FORMAT OF DES (NAME%c
                                         DESCRIPTOR)    !!
                                         !!         %c
                                         !!
                                         !!    DES_DEF%c
                                         DES_REG (NAME TYPE) !!
                                         !!    0    NOT DEFINED           0%c
                                         NOT USED        !!
                                         !!    1    DEFINED               1%c
                                         REGISTER        !!
                                         !!                               2%c
                                         GLOBAL          !!
                                         !!  128    USED                  3%c
                                         USER DEFINED    !!
                                         !!                               4%c
                                         LABEL           !!
                                         !!                               8%c
                                         OPERATION       !!
                                         !!                               9%c
                                         MACRO           !!
                                         !!         %c
                                         !!
                                         !!!!!!!!!!%c
                                         !!!!!!!!!!%c
                                         !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
                                         !!
   %record %format desf(%byte %integer def,reg, %half %integer value)
   %record (desf) %name des
   %own %half %integer %array desa(0:4096)=0(4097)
                                         !!
                                         !!!!!!!!!!%c
                                         !!!!!!!!!!%c
                                         !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
                                         !!         %c
                                         !!
                                         !!   UNDEFINED REFERENCE LINK FORMAT%c
                                         AND ASL LIST     !!
                                         !!         %c
                                         !!
                                         !!   FORMAT:%c
                                         !!
                                         !!          LINK - LINK TO NEXT%c
                                         UNDEF. REF            !!
                                         !!          COT  - POSITION TO MODIFY%c
                                         IN CORE ARRAY   !!
                                         !!          OPN  - OPERATION TO DO ON%c
                                         WORD +,-,*,/ ETC!!
                                         !!          BYT  - INDICATES A BYTE%c
                                         OPERATION         !!
                                         !!          ADD  - ADDRESS IN CORE%c
                                         (LISTING USE ONLY) !!
                                         !!          LINO - LINE NUMBER OF%c
                                         REFERENCE           !!
                                         !!         %c
                                         !!
                                         !!!!!!!!!!%c
                                         !!!!!!!!!!%c
                                         !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
                                         !!
   %integer curr,currp,aslp,code1,inpt,stinpt,pass
   %integer code2
   %own %half %integer %array cot(0:200)= 0(201)
   %own %integer corep=0
   %half %integer %array names(0:2048)
   %byte %integer %array letters(0:10000)
   %integer i,j,len,pos,bf,obf,top
   %own %byte %integer sbf=0
   %own %integer lino=0
   %own %integer reloc flag= 0, global op = 0
   %own %integer endflag=0
   %own %integer faults=0
   %own %integer mon=0
   %own %integer timer= 0
   %own %integer letterpt=1
   %own %half %integer dot=0
   %own %byte %integer brf=1
   %own %byte %integer list=0
   %own %byte %integer assmf=0
   %own %byte %integer absf=0
   %own %byte %integer mode=0
   %own %integer hashf=0
   %own %integer hashg=0
   %own %integer input=0
   %own %integer bsw=0
   %own %integer bytef=0
   %own %integer enf=1
   %own %integer desap=0
   %string (80) oper,opnd
   %string (63) file2,file3,grot
   %byte %integer %array lne(0:132)
                                         !!
                                         !!
   %own %half %integer %array instaa(-1:114)=0, 0,
      x'0101', x'0A00', x'0101', x'0AC0',
      x'0101', x'0A80', x'0101', x'0B00',
      x'0101', x'0BC0', x'0101', x'0A40',
      x'0101', x'0C80', x'0101', x'0CC0',
      x'0101', x'0B40', x'0101', x'0B80',
      x'0101', x'0C40', x'0101', x'0C00',
      x'0101', x'00C0', x'0201', x'1000',
      x'0200', x'6000', x'0200', x'E000',
      x'0201', x'2000', x'0201', x'5000',
      x'0201', x'3000', x'0201', x'4000',
      x'0400', x'0100', x'0400', x'0300',
      x'0400', x'0200', x'0400', x'8100',
      x'0400', x'8000', x'0400', x'8700',
      x'0400', x'8600', x'0400', x'8500',
      x'0400', x'8400', x'0400', x'0500',
      x'0400', x'0400', x'0400', x'0700',
      x'0400', x'0600', x'0400', x'8200',
      x'0400', x'8300', x'0400', x'8700',
      x'0400', x'8600', x'0100', x'0080',
      x'0300', x'0800', x'0500', x'8800',
      x'0500', x'8900', x'0000', x'0003',
      x'0000', x'0004', x'0000', x'0000',
      x'0000', x'0001', x'0000', x'0005',
      x'0000', x'0002', x'0100', x'0040',
      x'0000', x'00A8', x'0000', x'00A4',
      x'0000', x'00A2', x'0000', x'00A1',
      x'0000', x'00B8', x'0000', x'00B4',
      x'0000', x'00B2', x'0000', x'00B1',
      x'0300', x'7400'
                                         !!
   %own %half %integer %array built if(1:130)= %c
      x'0101', x'0000', x'0101', x'0001',
      x'0101', x'0002', x'0101', x'0003',
      x'0101', x'0004', x'0101', x'0005',
      x'0101', x'0006', x'0101', x'0007',
      x'0108', x'0001', x'0108', x'0002',
      x'0108', x'0003', x'0108', x'0004',
      x'0108', x'0005', x'0108', x'0006',
      x'0108', x'0007', x'0108', x'0008',
      x'0108', x'0009', x'0108', x'000A',
      x'0108', x'000B', x'0108', x'000C',
      x'0108', x'000D', x'0108', x'000E',
      x'0108', x'000F', x'0108', x'0010',
      x'0108', x'0011', x'0108', x'0012',
      x'0108', x'0013', x'0108', x'0014',
      x'0108', x'0015', x'0108', x'0016',
      x'0108', x'0017', x'0108', x'0018',
      x'0108', x'0019', x'0108', x'001A',
      x'0108', x'001B', x'0108', x'001C',
      x'0108', x'001D', x'0108', x'001E',
      x'0108', x'001F', x'0108', x'0020',
      x'0108', x'0021', x'0108', x'0022',
      x'0108', x'0023', x'0108', x'0024',
      x'0108', x'0025', x'0108', x'0026',
      x'0108', x'0027', x'0108', x'0028',
      x'0108', x'0029', x'0108', x'002A',
      x'0108', x'002B', x'0108', x'002C',
      x'0108', x'002D', x'0108', x'002E',
      x'0108', x'002F', x'0108', x'0030',
      x'0108', x'0031', x'0108', x'0032',
      x'0108', x'0033', x'0108', x'0034',
      x'0108', x'0035', x'0108', x'0036',
      x'0108', x'0037', x'0108', x'0038',
      x'0108', x'0039'
   %const %byte %integer %array built in(1:259)=2, 82, 48, 2, 82, 49, 2 %c
        , 82, 50, 2,
      82, 51, 2, 82, 52, 2, 82, 53, 2, 83,
      80, 2, 80, 67, 3, 67, 76, 82, 3, 68,
      69, 67, 3, 73, 78, 67, 3, 78, 69, 71,
      3, 84, 83, 84, 3, 67, 79, 77, 3, 65,
      83, 82, 3, 65, 83, 76, 3, 65, 68, 67,
      3, 83, 66, 67, 3, 82, 79, 76, 3, 82,
      79, 82, 3, 83, 87, 65, 3, 77, 79, 86,
      3, 65, 68, 68, 3, 83, 85, 66, 3, 67,
      77, 80, 3, 66, 73, 83, 3, 66, 73, 84,
      3, 66, 73, 67, 2, 66, 82, 3, 66, 69,
      81, 3, 66, 78, 69, 3, 66, 77, 73, 3,
      66, 80, 76, 3, 66, 67, 83, 3, 66, 67,
      67, 3, 66, 86, 83, 3, 66, 86, 67, 3,
      66, 76, 84, 3, 66, 71, 69, 3, 66, 76,
      69, 3, 66, 71, 84, 3, 66, 72, 73, 4,
      66, 76, 79, 83, 3, 66, 76, 79, 4, 66,
      72, 73, 83, 3, 82, 84, 83, 3, 74, 83,
      82, 3, 69, 77, 84, 4, 84, 82, 65, 80,
      3, 66, 80, 84, 3, 73, 79, 84, 4, 72,
      65, 76, 84, 4, 87, 65, 73, 84, 5, 82,
      69, 83, 69, 84, 3, 82, 84, 73, 3, 74,
      77, 80, 3, 67, 76, 78, 3, 67, 76, 90,
      3, 67, 76, 86, 3, 67, 76, 67, 3, 83,
      69, 78, 3, 83, 69, 90, 3, 83, 69, 86,
      3, 83, 69, 67, 3, 65, 83, 72, 128
   %const %half %integer %array built hash(1:65)=1120, 1122, 1124,
        1126, 1128, 1130, 1696, 134, 2020, 1487,
      1258, 1999, 249, 237, 505, 2041, 1228, 710, 749, 1261,
      1285, 493, 1996, 2047, 487, 2011, 731, 2012, 1188, 463,
      1514, 488, 752, 1993, 1994, 2, 3, 740, 1493, 1508,
      725, 472, 1660, 996, 1644, 2044, 1273, 999, 1672, 753,
      2029, 596, 597, 1970, 508, 1767, 997, 2021, 998, 741,
      975, 2000, 976, 719, 1017
                                         !!
                                         !!
   %const %string (8) %array pseudo in(1:23)="ASCII", "BYTE",
      "WORD", "PAGE",
      "IFDF", "IFNDF",
      "GLOBL", "TITLE",
      "ABSOLUTE",
      "END",
      "LIST", "NOLIST",
      "MON", "MOFF",
      "ENDC", "PLIST",
      "EVEN", "EOT",
      "TIME40", "TIME03", "TIME45",
      "DATE",
      "^ ^"
                                         !!
   %const %byte %integer %array trans(0:128)=0(32), 6, 2, 0(2), 10, 0,
        3, 0, 1, 0, 4, 6, 0, 5,
      8, 7, 9(10), 0(7), 11(26), 0(38)
                                         !!  0 - RUBBISH
                                         !!  1 - (
                                         !!  2 - !
                                         !!  3 - &
                                         !!  4 - *
                                         !!  5 - -
                                         !!  6 - + AND SPACE
                                         !!  7 - /
                                         !!  8 - .
                                         !!  9 - 0-9
                                         !! 10 - $
                                         !! 11 - A-Z
                                         !!
   %if files->files.("/").grot %start
      grot = grot.",,"
      grot -> file2.(",").file3.(",").grot
   %finish %else %start
      files = files.",,,"
      files -> files.(",").file2.(",").file3.(",").grot
   %finish
   file2 = ".NULL" %if file2=""
   file3 = "SS#LIST" %if file3=""
   define("ST2,".file3.",511")
   define("ST3,".file2)
   define("SM1,".files)
   inpt = smaddr(1,input); input = input+inpt
   stinpt = inpt
   select output(2)
!       SET MARGINS(2, 1, 132)
   printstring("
SOURCE: ".files."
BINARY: ".file2."

                              ERCC PDP11 two pass assembler  Version 1.8


")
                                         !!
   desap = addr(desa(0))
                                         !!
   curr = 1; currp = 2
   obf = 0
   %cycle i = 0,1,2048; names(i) = 0; %repeat
   %cycle i = 1,1,259; letters(i) = built in(i); %repeat
   %cycle i = 1,1,65
      names(built hash(i)) = letterpt
      letterpt = letterpt+letters(letterpt)+1
      j = built hash(i)<<1
      desa(j) = built if(i<<1-1)
      desa(j+1) = built if(i<<1)
   %repeat
   pass = 1
loop:corep = 0
   %until endflag#0 %cycle
      len = 0; bf = 0; sbf = 1
      lino = lino+1
      %if break up(lne)<0 %start
         endflag = 1; fault(2);          ! NO '.END'
         oper = ".END"
      %finish
      %if oper#"" %or opnd#"" %start
         code
         %if obf#0 %and sbf=0 %start
            fault(18); dot <- dot+2
                                         ! NOT WORD ALIGNED
            bsw = 0;                     ! FOR THE SAKE OF LABELS
         %finish
         obf = bf;                       !  %if SBF#0 %and LEN=0 %then
                                         ! LEN=1
      %finish
      %if pass=2 %start
         %if list=0 %or (list=1 %and assmf=0) %then list line(len)
         curr = curr+(len+1)>>1; currp = curr+1
      %finish %else curr = 1
      dot <- (dot+len)&x'FFFFFFFE'
      %if curr>80 %and bsw=0 %start
         bin out;                        ! OUTPUT THIS BLOCK
         corep = dot;                    ! RESET THE BEGINNING OF THE
                                         ! BLOCK
      %finish
   %repeat
   %if pass=1 %start
      pass = pass+1
      inpt = stinpt
      lino = 0
      start pass two(2)
      dot = 0
      endflag = 0
      assmf = 0; absf = 0; list = 0; obf = 0; bsw = 0
      ->loop
   %finish
   endflag = 0
   bin out; corep = dot
   symbols
   endflag = 1; bin out
   report faults
   newpage
   select output(0)
   report faults
   %return
                                         !!


   %integer %fn break up(%byte %integer %array %name lne)
                                         !!
      %byte %integer %array l(0:100)
      %integer i,f,len,pt,lp,lp2,s,sc,n,pt2
      %string %name lab
      %byte %integer %name str
      oper = ""; opnd = ""
      f = 0; len = 0
      %until i=nl %cycle
         i = byteinteger(inpt)
         inpt = inpt+1; %result = -1 %if inpt>input
         %unless f=0 %and i=' ' %and len<=80 %start
            len = len+1; l(len) = i; f = 1
         %finish
      %repeat
      lp = 1; lp2 = 1
      %if len=1 %then ->fin;             ! BLANK LINE
      l(len) = nl
      pt = 1; %if l(1)=';' %then ->com
                                         ! SEARCH FOR LABELS
      pt2 = 1; i = 'A';                  ! DUMMY
      %while trans(i)>=7 %cycle
         i = l(pt2); pt2 = pt2+1
         lne(lp2) = i; lp2 = lp2+1
         %if i=':' %start
            l(0) = pt2-2
            %if l(0)>6 %and pass=2 %then fault(10)
            lab == string(addr(l(0)))
            %if assmf=0 %start
               n = newtag(lab)
               set def(4,dot+bsw)
            %finish
            lp = lp2
            pt = pt2
            ->exit1
         %finish
      %repeat
exit1:                                   ! ON EXIT, NO NAME=>PT=1
                                         !          NAME   =>PT=PAST LABEL
                                         !
      %while lp<9 %cycle; lne(lp) = ' '; lp = lp+1; %repeat
      pt = pt+1 %while l(pt)=' '
                                         ! SCAN PAST SPACES
      pt2 = pt-1; i = trans(l(pt))
      %if i>9 %or i=8 %start
         lne(lp) = l(pt); lp = lp+1
         pt = pt+1
         %while trans(l(pt))>=9 %cycle
            lne(lp) = l(pt); lp = lp+1; pt = pt+1
         %repeat
      %finish
      l(pt2) = pt-pt2-1
      oper = string(addr(l(pt2)))
      %while lp<17 %cycle; lne(lp) = ' '; lp = lp+1; %repeat
      pt = pt+1 %while l(pt)=' '
      %if oper=".ASCII" %start
                                         ! DEAL WITH .ASCII SEPERATELY
         sc = l(pt)
         lp2 = lp-1; str == lne(lp2); s = str
         %until (i=sc %and lp2#lp-2) %or i=nl %cycle
            i = l(pt)
            pt = pt+1
            lne(lp) = i; lp = lp+1
         %repeat
         %if i=sc %start
            i = l(pt); pt = pt+1
         %finish %else %start
            lne(lp) = sc; lp = lp+1; fault(16)
         %finish
         ->opndl
      %finish
      %if l(pt)=';' %start
com:     %if pass=2 %start
            %if lp#1 %start;             ! NOT AT BEGINNING OF LINE
               %while lp<37 %cycle; lne(lp) = ' '; lp = lp+1
               %repeat
            %finish
            %until i=nl %cycle
               i = l(pt); pt = pt+1
               lne(lp) = i; lp = lp+1
            %repeat
            lp = lp-1;                   ! DONT OUTPUT THE NL
         %finish
      %finish %else %start
         lp2 = lp-1; str == lne(lp2); s = str
         %until i=nl %cycle
            i = l(pt); pt = pt+1
            %if i#' ' %start
               lne(lp) = i; lp = lp+1
            %finish
            %if i=';' %and l(pt-2)#'''' %then %exit
         %repeat
         lp = lp-1;                      ! DELETE THE NL
opndl:   str = lp-lp2-1
         opnd = string(addr(str))
         str = s
         %if i=';' %start; pt = pt-1; ->com; %finish
      %finish
fin:  lne(0) = lp-1
      %result = 0
                                         !!
   %end


   %routine code
      %integer byteflag
      %integer n,m
      %half %integer %name cpt
      %string (80) opnd2,opern
      %switch sw(0:5)
      code1 = -1
      opern = oper
      byteflag = 0
      %if byteinteger(addr(opern)+4)='B' %and length(opern)=4 %start
         byteflag = x'8000'; byteinteger(addr(opern)) = 3
      %finish
      %if oper->(".").oper %start
                                         !! PSEUDO OP OR JUST .
         %if oper="" %start
            %if byteinteger(addr(opnd)+1)='=' %then origin %else %start
               oper = "."; ->words
            %finish
         %finish %else pseudo eval
         %return
      %finish
words:%return %if assmf#0
      %if opnd->("=").opnd %start
         user def(opnd)
         %return
      %finish
      sbf = 0;                           ! OPERATION ON BYTE BDRY NOT
                                         ! ALLOWED
      n = -1
      %if opern#"" %then n = hash(opern,8)
                                         ! HASH WILL SET UP DES
      %if n=-1 %start;                   ! OPER NOT RECOGNISED
         word(oper."+".opnd)
         %return
      %finish
      inst == record(addr(instaa(-1))+des_value<<2)
                                         ! DES_VALUE POINTS TO ENTR
      cpt == cot(curr)
      cpt = 0;                           ! ZERO, FOR 'OR' LATER
      %if byteflag=1 %and inst_byte=0 %then fault(4)
                                         ! ILLEGAL 'BYTE'
      len = 2;                           ! LENGTH OF INSTR
      %if opern="SWA" %then byteflag = 0
      cpt <- inst_code+byte flag
      ->sw(inst_type)
                                         !!
sw(1):                                   ! ONE OPERAND
      cpt <- cpt!an opnd(inst_type,opnd)
      %return
sw(4):                                   ! BRANCH INSTRUCTION
      brf = 5
      %if pass=2 %start
         cpt <- cpt!branch(value(opnd),dot)
      %finish
      brf = 1; %return
sw(2):                                   ! TWO OPERANDS
sw(3):                                   ! REG, OPND
      %unless opnd->opnd.(",").opnd2 %start
         fault(3); len = 0
      %finish %else %start
         m = an opnd(inst_type,opnd)
         cpt <- cpt!an opnd(2,opnd2)!m<<6
      %finish
      %return
sw(5):                                   ! EMT AND TRAP
      %if pass=2 %start
         %if opnd#"" %then cpt <- cpt!(value(opnd)&x'FF')
      %finish
sw(0):                                   ! NO OPERANDS
   %end


   %integer %fn an opnd(%integer type, %string (80) opnd)
      %string (16) reg,last
      %integer minus
      reloc flag = dot+len+2; global op = 0
      mode = 0; minus = 0; code1 = 0; code2 = 1
      %if opnd->("@").opnd %then mode = 8
      %if opnd->("(").reg.(")").last %start
         mode = mode!test reg(reg);      ! DEAL WITH THE REGISTER FIRST
         %if last="" %start
            %if mode>=8 %start;          ! @(R) => @0(R)
               code1 = 0; code2 = 0; mode = mode!x'38'
            %finish
            mode = mode!8;               ! FOR (R)
         %finish %else %start
            %if last#"+" %then fault(5)
                                         ! '+' ONLY LEGAL CHAR
            mode = mode!x'10';           ! (R)+ OR @(R)+
         %finish
      %finish %else %start
         %if opnd->("-(").opnd %start
            %if opnd->reg.(")").last %start
               mode = mode+x'20'+test reg(reg)
            %finish %else fault(5)
            ->dump
         %finish
         %unless opnd->("#").opnd %start
                                         ! NOT MODE 27
            code1 = value(opnd);         ! NOTE R WILL RETURN CODE2=1 AND
                                         ! MODE 0
            %if opnd->("(").reg.(")").last %start
                                         ! +X(R)
               mode = mode+x'30'+test reg(reg)
               fault(5) %if last#""
            %finish %else %start
               %if code2=0 %start
                                         ! NOT A R OPND
                  %if (global op!absf)=0 %or mode#0 %then %c
                     mode = mode!x'37' %else mode = mode!x'1F'
                                         ! MODE 67 OR MODE 37 IF .ABSOLUTE
               %finish
            %finish
         %finish %else %start
                                         ! # TYPE OPERAND
            code1 = value(opnd)
            mode = mode+x'17'
         %finish
      %finish
dump:
      %if pass=2 %start
         %if type#4 %start;              ! NOT BRANCH TYPE
            %if type=3 %and mode&x'38'#0 %then fault(7)
                                         ! REG OPERATION
            %if code2=0 %start
               %if mode&x'37'=x'37' %then code1 = code1-(reloc flag)
                                         ! PC INDEXED OPERATION
               cot(currp) <- code1
               currp = currp+1; len = len+2
            %finish
         %finish %else %start
                                         ! DEAL WITH BRANCH
            %if mode#x'37' %then fault(6)
         %finish
      %finish %else %start
         %if code2=0 %then len = len+2
      %finish
      %result = mode
   %end


   %integer %fn test reg(%string (80) reg)
      %integer n
      byte integer(addr(reg)) = 6 %if length(reg)>6
      n = search(reg)
      %if n<0 %start; fault(7); %result = 0; %finish
                                         ! REGISTER NAME NOT KNOWN
                                         ! SEARCH SETS UP DES
      %if des_reg#1 %then fault(7)
      des_def = des_def!x'80'
      %result = des_value&7
   %end


   %integer %fn value(%string %name opnd)
      %integer oc,dec,od,j,pt,b,i,total,opl,ptx
      %byte %integer minus,t
      %switch char type(0:11)
      %switch doper(2:7)
      %string (6) name
      %byte %integer %name f
      code2 = 0
      minus = 6; pt = 1; total = 0; opl = length(opnd)
      byteinteger(addr(opnd)+opl+1) = ' '
outer:
      i = byteinteger(addr(opnd)+pt); pt = pt+1
      %result = total %if pt>opl+1
inner:t = trans(i)
      ->char type(t) %if t<2 %or t>7
                                         !! CHARTYPE(6):%c
                                         ! '+'
                                         !! CHARTYPE(5):%c
                                         ! '-'
                                         !! CHARTYPE(4):%c
                                         ! '*'
                                         !! CHARTYPE(3):%c
                                         ! '&'
                                         !! CHARTYPE(2):%c
                                         ! '!'
      minus = t; ->outer
                                         !!
chartype(8):                             ! '.'
      j = dot&x'FFFF'
jt:   i = byteinteger(addr(opnd)+pt); pt = pt+1
      ->addon
chartype(10):                            ! '$'
chartype(11):                            ! NAME SEARCH
      b = pt-2; f == byteinteger(addr(opnd)+b)
      %while trans(i)>=9 %cycle
         i = byteinteger(addr(opnd)+pt); pt = pt+1
      %repeat
      f = pt-b-2; name <- string(addr(f))
      j = test name(name)
      ->addon
chartype(9):                             ! SEARCH FOR NUMBER
      oc = 0; od = 0
      ptx = pt-1
      %while '0'<=i %and i<='9' %cycle
         j = i-'0'
         %if j>7 %then od = 1
         i = byteinteger(addr(opnd)+pt); pt = pt+1
      %repeat
      %if i#'.' %start
         %if od=1 %then fault(8)
      %finish %else %start
         od = 1
      %finish
      i = byteinteger(addr(opnd)+ptx); ptx = ptx+1
      %while ptx<pt %cycle
         j = i-'0'
         %if od=1 %then oc = oc*10+j %else oc = oc<<3+j
         i = byteinteger(addr(opnd)+ptx); ptx = ptx+1
      %repeat
      %if i='.' %start
         i = byteinteger(addr(opnd)+pt); pt = pt+1
      %finish
      j = oc
      ->addon
chartype(1):                             ! '('
      b = pt-2; f == byteinteger(addr(opnd)+b)
      f = opl-b
      opnd = string(addr(f))
      %result = total
chartype(0):                             ! THE REST
      %if i='''' %start
         j = byteinteger(addr(opnd)+pt); pt = pt+1
         ->jt
      %finish
      fault(11)
      %result = total
                                         !!
addon:
      ->doper(minus)
doper(2):total = total!j; ->last
doper(3):total = total&j; ->last
doper(4):total = total*j; ->last
doper(5):total <- total+((-j)&x'FFFF'); ->last
doper(6):total = total+j; ->last
doper(7):total = total//j
                                         !!
last: minus = 6
      ->inner %unless pt>opl
      %result = total
   %end


   %integer %fn test name(%string %name name)
      %string (6) r
      %integer n
      r <- name
      n = newtag(r)
      n = 0
      %if des_reg=1 %start
                                         ! REGISTER NAME
         mode = mode!des_value;          ! IE MODE 0+ VALUE REGISTER
         code2 = 1;                      ! NO EXTRA WORD
      %finish %else %start
         %if des_def&x'7F'#0 %start;     ! IS DEFINED
            %if des_reg=5 %start
               inst == record(addr(instaa(-1))+des_value<<2)
               n = inst_code
            %finish %else n = des_value&x'FFFF'
         %finish %else %start
            n = -1
            %if pass=2 %start
               %if des_reg#2 %then fault(15) %else %start
                  n = des_value; reloc flag = 0; global op = 1
                  des_value = dot+len
               %finish
            %finish
         %finish
      %finish
      des_def = des_def!x'80';           ! SET NAME=USED
      %result = n
   %end


   %routine set def(%integer def,opn)
      %integer i
      %if des_def&x'7F'=0 %start
                                         ! NAME NOT DEFINED
         des_value <- opn
         des_def = des_def!1;            ! INDICATE DEFINED
         des_reg = def;                  ! SET UP TYPE OF NAME
      %finish %else %start
                                         ! NAME WAS DEFINED BEFORE
         %if des_value&x'FFFF'#opn&x'FFFF' %start
            %if def=4 %and pass=2 %then i = 14 %else i = 1
            fault(i)
         %finish
                                         ! REDEF
      %finish
   %end


   %routine user def(%string %name opnd)
      %integer n,m,temp
      %record (desf) %name des2
      %if length(oper)>6 %then fault(10)
      pos = new tag(oper)
      des2 == des
      %if opnd->("%").opnd %then m = 1 %else m = 0
      mode = 0
      n = value(opnd)
      des == des2
      %if code2+m#0 %start
                                         ! REGISTER
         %if m=1 %then des_value = n %else des_value = mode
         des_reg = 1; des_def = des_def!1
      %finish %else %start
                                         ! NAME
         set def(3,n)
      %finish
   %end


   %routine octal(%integer n)
      %integer i
      n <- n&x'FFFF'
      %cycle i = 15,-3,0
         printsymbol((n>>i)&7+'0')
      %repeat
   %end


   %routine list line(%integer len)
      %routine %spec numbers
      %integer i,l2,t
      write(lino,4)
      spaces(3)
      %if assmf=0 %then octal(dot) %else spaces(6)
      l2 = len
      %if len>0 %start
         i = 0; numbers
         spaces(5)
      %finish %else spaces(32)
      %if timer#0 %start
         %if l2>0 %start
            %if timer=1 %then t = time40(cot(curr)) %else t = time03(cot(curr))
            printsymbol('('); print(t/100,2,2)
            printstring(")   ")
         %finish %else spaces(11)
      %finish
      printstring(string(addr(lne(0))))
      %while len>0 %cycle
         newline; spaces(14)
         numbers
      %repeat
      newline
                                         !!


      %routine numbers
         %integer j
         %cycle j = i,1,i+2
            spaces(3)
            %if len>0 %then octal(cot(curr+j)) %else spaces(6)
            len = len-2
         %repeat
         i = j+1
      %end
   %end
                                         !!


   %integer %fn branch(%integer val,here)
      %half %integer x
      %integer y
      x <- val-(here+2)
                                         !!  %if MON#0 %start
                                         !!     PRINTSTRING('BRANCH: X=')
                                         !! OCTAL(X)
                                         !!     PRINTSTRING(' VAL,HERE:')
                                         !! OCTAL(VAL)
                                         !! SPACE
                                         !!     OCTAL(HERE);           !!%c
                                         NEWLINE
                                         !!  %finish
      y <- x&x'FF00'
      %if y#0 %and y#x'FF00' %start
         fault(13); x = x'FF'
      %finish %else x <- x>>1
      %result = x&x'FF'
   %end


   %integer %fn new tag(%string %name a)
      %result = hash(a,128+7)
   %end
                                         !!


   %integer %fn search(%string %name a)
      %result = hash(a,7)
   %end


   %integer %fn hash(%string %name ident, %byte %integer flag)
                                         !!
                                         !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
                                         !!                                 !!
                                         !!  NOTE: HASH SETS DES AS A SIDE  !!
                                         !!        EFFECT                   !!
                                         !!                                 !!
                                         !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
                                         !!
      %own %integer cname=0
      %integer hashc,f8
      %half %integer z,a,b,c
      length(ident) = 6 %if length(ident)>6
      f8 = flag&8
      hashg = hashg+1
      b = 0; c = 0; a = 0
      string(addr(z)+1) = ident
      hashc = ((a+b+c)*length(ident))&2047
      %while names(hashc)#0 %cycle
         %if ident=string(addr(letters(names(hashc)))) %start
            des == record(desap+hashc<<2)
            %if f8!!des_reg<8 %start
               %result = hashc
            %finish
                                         !! IE IF F=8 AND AN OPER OR F<8 AND A%c
                                         LABEL ETC
         %finish
         hashc = (hashc+1)&2047
         hashf = hashf+1
      %repeat
      %result = -1 %if flag<128;         ! SEARCH
      names(hashc) = letterpt
      des == record(desap+hashc<<2)
      des_def = 0; des_reg = 0; des_value = 0
      string(addr(letters(letterpt))) = ident
      letterpt = letterpt+length(ident)+1
      cname = cname+1
      abandon("TOO MANY NAMES") %if cname>=2047
      abandon("NAMES TOO LONG") %if letterpt>=10000-10
      %result = hashc
   %end


   %routine word(%string (80) opnd)
      %string (60) t
      opnd = opnd.","
      currp = curr
      %until opnd="" %cycle
         opnd -> t.(",").opnd
         %if pass=2 %start
            cot(currp) <- value(t)
            currp = currp+1
         %finish
         len = len+2
      %repeat
      sbf = 0;                           ! WORD ON BYTE BDRY NOT ALLOWED
   %end


   %routine fault(%integer i)
      %own %string (20) %array flist(1:19)= %c
         "NAME REDEFINITION",
         "NO .END",
         "TOO FEW OPNDS",
         "ILLEGAL BYTE INSTR.",
         "BRACKETS?",
         "TYPE FAULTY",
         "ILLEGAL REG. OPER.",
         "NOT OCTAL",
         "ILLEGAL NAME",
         "NAME TOO LONG",
         "ILLEGAL EXPR.",
         "ILLEGAL NAME",
         "OUT OF RANGE",
         "PHASE ERROR",
         "NAME NOT DEFINED",
         "TERMINATOR?",
         "TOO BIG",
         "ON BYTE BDRY",
         "PSEUDO INSTR.?"
      %string (20) s
      %if i=10 %then s = "WARNING" %else s = "FAULT"
      write(lino,4)
      printstring(" ** ".s." ** ")
      write(i,2)
      printstring("(".flist(i).")")
      faults = faults+1 %unless i=10
      newline
   %end


   %routine origin
      %integer i
      %if assmf=0 %start
         opnd -> ("=").opnd
         i = value(opnd)
         %if code2=1 %start
                                         !! UNDEFINED NAME OR REGISTER- NOT%c
                                         ALLOWED
            fault(12)
         %finish %else %start
            bin out
            dot <- i
            corep <- dot
            bsw = 0; obf = 0;            ! ALIGN EVEN
            %if i&1#0 %start
               bsw = 1; sbf = 1; bf = 2
               cot(curr) = 0
            %finish
         %finish
      %finish
   %end


   %integer %fn try name
      %integer n,def
      %string (6) r
      r <- opnd
      n = newtag(r)
      def = des_def&x'7F'
      des_def = des_def!x'80'
      %result = def
   %end


   %routine pseudo eval
      %integer i,q
      %switch ps(1:23)
      %cycle i = 1,1,23; ->exit3 %if oper=pseudo in(i); %repeat
exit3:%if assmf=0 %or i>4 %start
         ->ps(i)
ps(19):                                  ! TIME TO BE PRINTED
         timer = 1
         %return
ps(20):                                  ! 11/03 TIME
         timer = 2
         %return
ps(23):  ;                               ! ILLEGAL
         fault(19)
         ->ret
ps(22):                                  ! .DATE
         opnd = "/".date."/"
ps(1):                                   ! .ASCII
         %if length(opnd)>2 %start
                                         ! SET FLAG UNLESS IN BYTE INSTR.
            %if obf=0 %then bsw = 0 %else %start
               len = 1
               %if obf=2 %then bsw = 1 %else curr = curr-1
                                         ! OBF=2 IS THE .=ODD FLAG
            %finish
            currp = curr
            %cycle i = 2,1,length(opnd)-1
               push byte(byte integer(addr(opnd)+i))
            %repeat
            bf = bsw;                    ! NOTE WHETHER ON BDRY OR NOT
         %finish
         ->ret
ps(2):                                   ! .BYTE
         byte(opnd)
         ->ret
ps(3):                                   ! .WORD
         word(opnd)
         ->ret
ps(4):                                   ! .PAGE
         newpage %if list<2 %and pass=2
         ->ret
ps(5):                                   ! .IFDF
         q = 0
ps5:
         %if assmf>0 %then assmf = assmf+1 %else %start
            %if try name=q %start
               assmf = 1
               %if list=1 %and pass=2 %start
                  list line(0)
                  printstring("***** CONDITIONAL TEXT OMITTED
")
               %finish
            %finish
         %finish
         ->ret
ps(6):                                   ! .IFNDF
         q = 1
         ->ps5
ps(7):                                   ! .GLOBL
         globals
         ->ret
ps(8):                                   ! .TITLE
         ->ret
ps(9):                                   ! .ABSOLUTE
         absf = 1
         ->ret
ps(10):                                  ! .END
ps(18):                                  ! .EOT
         endflag = 1
         %if opnd#"" %then enf <- value(opnd)
         ->ps17
ps(11):                                  ! .LIST
         list = 0; ->ret
ps(12):                                  ! .NOLIST
         list = 2; ->ret
ps(13):                                  ! .MON
         mon = 1; ->ret
ps(14):                                  ! .MOFF
         mon = 0; ->ret
ps(15):                                  ! .ENDC
         %if assmf<=1 %start
            assmf = 0
         %finish %else assmf = assmf-1
         ->ret
ps(16):                                  ! .PLIST (PARTIAL LIST (NOT
                                         ! CONDITIONALS))
         list = 1
         ->ret
ps(17):                                  ! .EVEN
ps17:
         dot <- (dot+bsw+1)&x'FFFFFFFE'
         obf = 0; bsw = 0;               ! TO ALIGN LABELS CORRECTLY
      %finish
ret:
   %end


   %routine globals
      %integer n
      %string (30) s
      %if pass=1 %start
         opnd = opnd.","
         %while opnd->s.(",").opnd %cycle
            n = newtag(s)
compiler bug:                            ! OVER OPTIMISATION OF 'DES'
            fault(1) %if des_reg#0
            des_reg = 2;                 ! GLOBAL
            des_value = 0
         %repeat
      %finish
   %end


   %routine byte(%string %name opnd)
      %string (60) t
                                         ! SET FLAG UNLESS LAST OPRN.
      %if obf=0 %then bsw = 0 %else %start
         len = 1
         %if obf=2 %then bsw = 1 %else curr = curr-1
      %finish
                                         ! WAS BYTE
      currp = curr
      opnd = opnd.","
      %until opnd="" %cycle
         bytef = 2-bsw
         opnd -> t.(",").opnd
         push byte(value(t))
      %repeat
      bytef = 0
      bf = bsw;                          ! REMEMBER ALIGNMENT
   %end


   %routine push byte(%integer n)
      %half %integer %name cpt
      n = n&x'FFFF';                     ! CUT TO 16 BITS
      %if n>x'FF' %then write(n,1) %and fault(17)
      n <- n&x'FF'
      cpt == cot(currp)
      %if bsw=0 %start
         cpt = n
      %finish %else %start
         cpt <- cpt!n<<8; currp = currp+1
      %finish
      bsw = bsw!!1; len = len+1
   %end


   %routine abandon(%string (60) s)
      select output(0)
      printstring("
** ABORT ** ".s." **
")
      endflag = 2;                       ! INDISCATE ABNORMAL STOP
      select output(2)
   %end


   %routine symbols
      %routine %spec list symbol table
      %routine %spec check refs
      %routine %spec sort names(%integer a,b)
                                         !!
      %half %integer %array sorta(0:2048)
                                         !!
      check refs
      list symbol table
      %return
                                         !!


      %routine list symbol table
         %integer i,cn,pos,j,old end
         %string %name s
         %string (15) sss
         %own %byte %integer %array type(0:5)=' ', 'R', 'G', 'U', 'L', 'S'
         %own %byte %integer %array used(0:1)='*', ' '
         old end = endflag; end flag = 0
         bin out; len = 0
         newpage
         printstring("
SYMBOL TABLE

SPACE USED ="); write(letterpt,1); printstring(" BYTES
NUMBER OF NAMES =")
         write(top,1); printstring("
HASH GOES ="); print(hashf/hashg+1,1,2); newline
         sort names(1,top)
         cn = 0
         %cycle i = 1,1,top
            s == string(addr(letters(sorta(i))))
            pos = search(s)
            %if pos>=0 %start
               des == record(desap+pos<<2)
               %continue %if des_reg=254
               printstring(s); spaces(7-length(s))
               printsymbol(type(des_reg)); space
               %if des_def&x'7F'#0 %or des_reg=2 %then octal(des_value) %else %c
                  printstring("UNDFND")
               printsymbol(used((des_def&128)>>7))
               cn = cn+1
               %if cn#6 %then spaces(6) %else %start
                  cn = 0; newline
               %finish
               %if des_reg=2 %start
                  sss = tostring(length(s)).s
                  sss = sss.tostring(0) %if length(sss)&1#0
                  %cycle j = 1,2,length(sss)-1
                     cot(curr) <- charno(sss,j+1)<<8+charno(sss,j)
                     curr = curr+1; len = len+2
                  %repeat
                  cot(curr) <- des_value
                  curr = curr+1; len = len+2
                  dot = (dot+len)&(\1)
                  bin out; corep = dot; len = 0
               %finish
               des_reg = 254
            %finish
         %repeat
         cot(curr) = 0; curr = curr+1; len = len+2
         dot = (dot+len)&(\2)
         bin out; corep = dot; len = 0
         endflag = old end
         newlines(5)
      %end


      %routine check refs
         %integer i,pt
         pt = 1; i = 1
         %until pt>=letterpt %cycle
            sorta(i) = pt
            i = i+1
            pt = pt+letters(pt)+1
         %repeat
         top = i-1
      %end


      %routine sort names(%integer a,b)
         %integer l,u,d
         %string (6) x
         %return %if a>=b
         l = a; u = b; d = sorta(u)
         x = string(addr(letters(sorta(u))))
         ->find
                                         !!
up:      l = l+1
         ->found %if l=u
find:    ->up %unless string(addr(letters(sorta(l))))>=x
         sorta(u) = sorta(l)
                                         !!
down:    u = u-1
         ->found %if l=u
         ->down %unless string(addr(letters(sorta(u))))<=x
         sorta(l) = sorta(u)
         ->up
                                         !!
found:   sorta(u) = d
         sort names(a,l-1)
         sort names(u+1,b)
      %end
   %end


   %routine bin out
      %integer i,flag
      %string (10) st
      i = 1
      st = ""; flag = 0
      cot(0) = corep;                    ! SET THE START ADDRESS
      %if curr>1 %then dump bin(cot,0,curr-1,st,flag)
      abandon("BINARY FAULT") %if flag#0
      %if endflag#0 %start
         st = "END"
         cot(0) = enf
         dump bin(cot,0,0,st,flag) %unless oper="EOT"
         dump bin(cot,-1,200,st,flag)
      %finish
      currp = 2; curr = 1
   %end


   %routine report faults
      %if faults=0 %start
         write(lino,6)
         printstring(" statements assembled
")
      %finish %else %start
         write(faults,6); printstring(" FAULTS IN PROGRAM
")
      %finish
   %end
                                         !!
   %routine start pass two(%integer str)
      select output(str)
      printstring("Pass two"); newline
   %end
%end
!!
!!
%end %of %file