{$U-}
 {$R-}
 {===============================================================}
 {                                                               }
 {               UCSD   ADAPTABLE   ASSEMBLER                    }
 {               ----   ---------   ---------                    }
 {       Patterned after The Waterloo Last Assembler (TLA)       }
 {       Core Authors:  William P. Franks and Dennis Volper      }
 {                                                               }
 {                                                               }
 {               Version :       pdp 11 & LSI 11                 }
 {               Date    :       Sept.  27, 1978                 }
 {               Author  :       Dennis Volper                   }
 {               Release :       I.5.b.1                         }
 {                                                               }
 {                                                               }
 {              Institute for Information Systems                }
 {                UC  San Diego, La Jolla,  CA                   }
 {                                                               }
 {                 Kenneth L. Bowles, Director                   }
 {                                                               }
 {                     Copyright (C) 1978,                       }
 {       Regents of the University of California, San Diego      }
 {                                                               }
 {===============================================================}
 PROGRAM SYSTEMLEVEL;
 TYPE    PHYLE=FILE;
 VAR     FILLER:ARRAY[0..6] OF INTEGER;
         USERINFO:RECORD
                 WORKSRC,WORKCODE:^PHYLE;
                 ERRSYM,ERRBLK,ERRNUM:INTEGER;
                 SLOWTERM,STUPID:BOOLEAN;
                 ALTMODE:CHAR;
                 FILLER2:ARRAY[0..21] OF INTEGER; {change with care...allows}
                 WORKTITLE,SYMTITLE:STRING[15]     {more compile time space}
             END;

 SEGMENT PROCEDURE TLA(III,JJJ:INTEGER);
 CONST  RELEASEVERSION =TRUE;  {Is this for the outside world?}
        NUMKWORDS      =27;    {The number of key words in this assembler}
        HASHRANGE      =128;   {The hash table size}
        HASHTOP        =127;   {One less than HASHRANGE}
        MACROSIZE      =19;    {The buffer size for a MACRO stored on heap}
        BUFBLKS        =2;     {# of blocks for output buffer}
        BUFLIMIT       =1023;  {(BUFBLKS*512) - 1}
        MAXPROC        =10;    {Maximum number of Procedures per Assembly}
        PAGESIZE       =55;    {Lines printed per page}
        VIEWSTACK      =TRUE;  {Display stack & heap while Assembling}
        DEBUG          =FALSE; {for debugging Assembler}
        CODESIZE       =20;    {Testing values}
        RELEASENAME    ='I.5 [b.1]';

 {Below constants are Assembler dependent}

        NOP            =160;   {A one byte NOP}
        ASMNAME        ='11';
        BYTEFIT        =5;     {maximum bytes per output line}
        WORDFIT        =3;     {maximum words per output line}
        HIBYTEFIRST    =FALSE; {First byte is the high-order byte?}
        LISTHIFIRST    =TRUE;
        LCCHAR         ='*';   {Location counter character}
        WORDADDRESSED  =FALSE; {Word as opposed to byte addressed}
        AFTERPLUS      =0;     {An impossible character}
        AFTERMINUS     ='(';   { "-(" is always auto decrement}
        DEFRADIX       =8;     {Default radix}
        LISTRADIX      =8;     {Printed listing radix}
        HEXSWITCH      ='H';   {Char following number which resets radix}
        DECSWITCH      ='.';
        OCTSWITCH      =0;
        BINSWITCH      ='B';
        RELHI          =FALSE; {Relative byte most significant passed PUTWORD}

 TYPE BITE=0..255;
      PACKNAME=PACKED ARRAY[0..7] OF CHAR;
      WORDSWAP=PACKED RECORD CASE INTEGER OF
               0:(HWORD:INTEGER);
               1:(HIBYTE,LOWBYTE:BITE);
               2:(HEX1,HEX2,HEX3,HEX4:0..15);
               3:(OCT2,OCT3,OCT4,OCT5,OCT6:0..7;
                                      OCT1:0..1);
               4:(BIN:PACKED ARRAY[0..15] OF 0..1);
           END;
      HASHTYPE=RECORD CASE BOOLEAN OF
               TRUE:(INT:INTEGER);
              FALSE:(BOL:BOOLEAN)
           END;
      BYTESWAP=PACKED RECORD CASE INTEGER OF
               0:(BWORD:INTEGER);
               1:(BADBYTE,GOODBYTE:BITE);
               2:(REGLOW:0..7;
                  MODELOW:0..7;
                  REGHI:0..7;
                  MODEHI:0..7;
                  DUM2:0..15);
               3:(XOFFSET:0..255;
                  DUM3:0..255);
               4:(SOBSET:0..63;
                  DUM4:0..1023)
           END;

 (*$I ASM1.TEXT*)
                          {start of ASM1}
      {Copyright (c) 1978 Regents of the University of California}

 TOKENS=(EQUAL,NOTEQUAL,BITWISEOR,EXCLUSIVEOR,DIVIDE,MODULO,ONESCOMPLEMENT,TNOT,
        OPENPAREN,CLOSEPAREN,OPENBRACKET,CLOSEBRACKET,OPNBRACE,CLSBRACE,
        COMMA,OPNBROKEN,CLSBROKEN,QUERY,PLUS,MINUS,
        ASTERISK,AMPERSAND,ATSIGN,COLON,NUMBERSIGN,AUTOINCR,AUTODECR,LOCCTR,
        FIRSTOPCODE,
        REF,DEF,OP1,OP2,OP3,OP4,OP5,OP6,OP7,OP8,OP9,OP10,OP11,OP12,OP13,
        OP14,OP15,OP16,OP17,OP18,OP19,OP20,ALIGN,
        TEOF,BLOCK,WORD,BIGHT,ENDLINE,TMOD,PROC,FUNC,CONDEND,TELSE,ORG,
        ASCII,MACRODEF,CONDITION,EQU,PUBLIC,PRIVATE,TCONST,
        LIST,NOLIST,ASECT,PSECT,TEND,TPAGE,TITLE,
        LASTOPCODE,
        INCLUDE,TLABEL,LOCLABEL,TSTRING,CONSTANT,TIDENTIFIER,STARTFILE,
        MACROEND,EXPAND,TNULL);
     CODETYPE=(A,P);
     SOURCETYPE=(MACROSOURCE,PARMSOURCE,FILESOURCE);
     ATRIBUTETYPE=(DEFABS,PROCS,
            OPS1,OPS2,OPS3,OPS4,OPS5,OPS6,OPS7,OPS8,OPS9,OPS10,OPS11,
            OPS12,OPS13,OPS14,OPS15,OPS16,OPS17,OPS18,OPS19,OPS20,
            DEFRP,DEFREG,DEFCC,DEFIR,
            PUBLICS,CONSTS,PRIVATES,REFS,DEFS,FUNCS,ABS,LABELS,UNKNOWN,MACROS);
     MACROPTR=^MACROTYPE;
     MACROTYPE=PACKED ARRAY[0..MACROSIZE] OF CHAR;
     JTABPTR=^JTAB;
     JTAB=RECORD               {Used for linkinfo references}
        PCOFFSET:INTEGER;
        LAST:JTABPTR
      END;
     BKLABELPTR=^BACKLABEL;
     SYMTABLEPTR=^SYMBOLTABLE;
     SYMBOLTABLE=RECORD        {Symboltable entry}
        NAME:PACKNAME;
        LINK:SYMTABLEPTR;
        CASE ATTRIBUTE:ATRIBUTETYPE OF
          {OPS1,OPS2,OPS3,OPS4,OPS5,OPS6,OPS7,OPS8,OPS9,OPS10,
          OPS11,OPS12,OPS13,OPS14,OPS15,OPS16,OPS17,OPS18,OPS19,OPS20,
          ABS,DEFABS,DEFRP,DEFREG,DEFCC,DEFIR,LABELS,}
                            UNKNOWN:(OFFSETORVALUE:INTEGER;
                                     FWDREF:BKLABELPTR);
                             MACROS:(MACRO:MACROPTR;
                                    EXPANDMCRO:BOOLEAN);
                               DEFS:(PROCNUM,CODEOFFSET:INTEGER;
                                     DEFFWDREF:BKLABELPTR);
       PUBLICS,PRIVATES,REFS,CONSTS:(NREFS,NWORDS:INTEGER;
                                     LINKOFFSET:JTABPTR);
                        PROCS,FUNCS:(FUNCNUM,NPARAMS:INTEGER)
       END;
     TEMPTABLE=RECORD            {Temporary table entry}
          TEMPNAME:PACKNAME;
          DEFOFFSET:INTEGER;
          FWDREF:BKLABELPTR;
          TEMPATRIB:ATRIBUTETYPE
       END;
     RELTYPE=(LLREL,LABELREL,LCREL,NOTSET);
     RESULTREC=RECORD            {expression evaluator result record}
          ATTRIBUTE:ATRIBUTETYPE;
          OFFSETORVALUE:INTEGER;
       END;
     RELREC=RECORD               {current expression's relocation info}
          TIPE:RELTYPE;
          OFFSETORVALUE,TEMPLABEL:INTEGER;
          ATTRIBUTE:ATRIBUTETYPE;
          SYM:SYMTABLEPTR
       END;
     BACKLABEL=PACKED RECORD     {forward reference record}
          WORDLC,BYTESIZE:BOOLEAN;
          OFFSET,LC,VALUE:INTEGER;
          NEXT:BKLABELPTR
       END;
     JTABREC=ARRAY[0..6] OF INTEGER;     {for storage of relocation info}
     BUFFERTYPE=PACKED ARRAY[0..511] OF BITE;
     SCRATCHREC=RECORD            {scratch file for temporary storage}
          CLASS:INTEGER;
          CASE BOOLEAN OF
               TRUE:(JUMPS:JTABREC);
              FALSE:(FWDREF:BACKLABEL)
     END;

 {----------------------------------------------------------------------}

 VAR SYM:SYMTABLEPTR;      {pointer to current symboltable entry}
     LEXTOKEN:TOKENS;      {current token returned by LEX}
     OUTBLKNO,             {next output block #}
     TEXTINDEX,            {index into TEXTLINE, containing line of source text}
     MACROINDEX,           {index into macro source sitting on heap}
     SPCIALSTKINDEX,       {index into stack of outstanding special symbols}
     CODECOUNT:INTEGER;    {index into array containing current line's code}
     OPBYTE:BYTESWAP;      {used exclusively by ZOP1 - ZOP20}
     CH:CHAR;
     DISPLAY:BOOLEAN;      {currently displaying output?}
     FULLLABEL:BKLABELPTR; {forward referenced labels still unresolved}
     RESULT:RESULTREC;     {result of last call to expression evaluator}

     BUFBOTTOM,            {start of BUFFER relative to start of output file}
     BUFFERPOS,            {next output byte relative to start of BUFFER}
     BUFFERTOP,            {next output byte relative to start of file}
     MAXBUFTOP,            {maximum BUFFERTOP}
     OUTBLKTOP,            {next block after current end of output file}
     PROCSTART,            {start of procedure relative to start of file}
     JCOUNT1,JCOUNT2,JCOUNT3, {indexes for relocation records JTABREC's}
     TEMPTOP,TEMPLABEL,
     BLOCKPTR,BNUM,BLOCKNO,ALTBLOCNO,ALTBLOCPTR,
     PROCNUM,SEGSIZE,PAGENO,
     LINENUM,LISTNUM,
     NUMERRORS,
     OPVAL,CONSTVAL,
     PARMPTR,MCSTKINDEX,LINKEND,SCRATCHEND,CONDINDEX,
     LC,ALC,LASTLC,LOWLC                                 :INTEGER;

     SYMLAST,FOUND,CONSOLE,STARTLINE,FROMPUTWORD,NOTSTRING,LISTING,JUMPINFO,
     ADVANCE,EXPANDMACRO,PARMCHECK,ALTINPUT,EXPRSSADVANCE,DEFMCHOOK  :BOOLEAN;
     MCPTR:MACROPTR;
     BUFFER:^BUFFERTYPE;   {buffer for output code in core}
     TAB:CHAR;
     LISTFILE:INTERACTIVE;
     TITLELINE,STRVAL,CURFNAME,FIRSTFNAME:STRING;
     TEXTLINE,BLANKLINE:PACKED ARRAY[0..79] OF CHAR;

     RELOCATE,OPERAND1,OPERAND2,OPERAND3,NULLREL:RELREC;
     NEXTJP:JTABPTR;
     JUMP1,JUMP2,JUMP3:JTABREC;
     FREELABEL:BKLABELPTR;

     CURRENTATRIB:ATRIBUTETYPE;
     SOURCE:SOURCETYPE;
     CODESECTION:CODETYPE;
     MACROSTACK:ARRAY[0..5] OF MACROPTR;
     PARMSTACK,MCINDEX:ARRAY[0..5] OF INTEGER;
     SPECIALSTK:ARRAY[0..5] OF TOKENS;
     TEMP:ARRAY[0..20] OF TEMPTABLE;
     HASH,HASHRES:ARRAY[0..HASHTOP] OF SYMTABLEPTR;
     LASTSYM:SYMTABLEPTR;

     ALTFILE:FILE;
     SCRATCH:FILE OF SCRATCHREC;

     KWORDS:ARRAY[0..NUMKWORDS] OF PACKNAME;
     KTOKEN:ARRAY [0..NUMKWORDS] OF TOKENS;
     XBLOCK:PACKED ARRAY[0..1023] OF CHAR;
     CONSTID,HEXCHAR:PACKED ARRAY[0..15] OF CHAR;
     CODE,BLANKCODE:PACKED ARRAY[0..CODESIZE] OF CHAR;
     HEAP:^INTEGER;
     SEGNAME,PROCNAME:PACKNAME;
     PROCTABLE:ARRAY[0..MAXPROC] OF INTEGER;


 PROCEDURE ERROR(ERRORNUM:INTEGER); FORWARD;
 PROCEDURE PATCHCODE(FWDREF:BACKLABEL; BUFINDEX:INTEGER); FORWARD;
 PROCEDURE IOCHECK(QUIT:BOOLEAN); FORWARD;
 PROCEDURE LLCHECK; FORWARD;
 PROCEDURE PRINTPAGE; FORWARD;
 PROCEDURE PRINTLINE; FORWARD;
 PROCEDURE PRINTNUM(WORD:INTEGER; BYTESIZE:BOOLEAN);  FORWARD;
 PROCEDURE PUTBYTE(BYTE:BITE); FORWARD;
 PROCEDURE PUTRELWORD(WORD:INTEGER; BYTESIZE,WORDOFFSET:BOOLEAN); FORWARD;
 PROCEDURE PUTWORD(WORD:INTEGER);  FORWARD;
 PROCEDURE GETCHAR; FORWARD;
 PROCEDURE LEX; FORWARD;
 FUNCTION  EXPRESS(OPERANDREQUIRED:BOOLEAN):BOOLEAN; FORWARD;
 FUNCTION  CHECKOPERAND(CKSPCSTK,CKABS,CKRANGE:BOOLEAN;LO,HI:INTEGER):BOOLEAN;
                                                               FORWARD;

 {dummy segments necessary since compiled U-}
 SEGMENT PROCEDURE DUMMY2;  BEGIN END;
 SEGMENT PROCEDURE DUMMY3;  BEGIN END;
 SEGMENT PROCEDURE DUMMY4;  BEGIN END;
 SEGMENT PROCEDURE DUMMY5;  BEGIN END;
 SEGMENT PROCEDURE DUMMY6;  BEGIN END;
 SEGMENT PROCEDURE DUMMY7;  BEGIN END;
 SEGMENT PROCEDURE DUMMY8;  BEGIN END;
 SEGMENT PROCEDURE DUMMY9;  BEGIN END;


 SEGMENT PROCEDURE INITIALIZE;
 TYPE  OPREC=RECORD
          OPNAME:PACKNAME;
          OPVALUE:INTEGER;
          OPATRIB:ATRIBUTETYPE
       END;

 VAR  OK:BOOLEAN;
      COUNT:INTEGER;
      OPFILENAME,LISTNAME:STRING;
      OPFILE:FILE OF OPREC;

 PROCEDURE KEYTOKENSET;
 BEGIN
   KWORDS[0] :='ALIGN   '; KTOKEN[0] :=ALIGN;
   KWORDS[1] :='ASCII   '; KTOKEN[1] :=ASCII;
   KWORDS[2] :='BLOCK   '; KTOKEN[2] :=BLOCK;
   KWORDS[3] :='BYTE    '; KTOKEN[3] :=BIGHT;
   KWORDS[4] :='CONST   '; KTOKEN[4] :=TCONST;
   KWORDS[5] :='EQU     '; KTOKEN[5] :=EQU;
   KWORDS[6] :='FUNC    '; KTOKEN[6] :=FUNC;
   KWORDS[7] :='PUBLIC  '; KTOKEN[7] :=PUBLIC;
   KWORDS[8] :='PRIVATE '; KTOKEN[8] :=PRIVATE;
   KWORDS[9] :='PROC    '; KTOKEN[9] :=PROC;
   KWORDS[10]:='WORD    '; KTOKEN[10]:=WORD;
   KWORDS[11]:='EXPAND  '; KTOKEN[11]:=EXPAND;
   KWORDS[12]:='MACRO   '; KTOKEN[12]:=MACRODEF;
   KWORDS[13]:='ENDM    '; KTOKEN[13]:=MACROEND;
   KWORDS[14]:='IF      '; KTOKEN[14]:=CONDITION;
   KWORDS[15]:='ENDC    '; KTOKEN[15]:=CONDEND;
   KWORDS[16]:='ELSE    '; KTOKEN[16]:=TELSE;
   KWORDS[17]:='REF     '; KTOKEN[17]:=REF;
   KWORDS[18]:='DEF     '; KTOKEN[18]:=DEF;
   KWORDS[19]:='ORG     '; KTOKEN[19]:=ORG;
   KWORDS[20]:='INCLUDE '; KTOKEN[20]:=INCLUDE;
   KWORDS[21]:='LIST    '; KTOKEN[21]:=LIST;
   KWORDS[22]:='NOLIST  '; KTOKEN[22]:=NOLIST;
   KWORDS[23]:='ASECT   '; KTOKEN[23]:=ASECT;
   KWORDS[24]:='PSECT   '; KTOKEN[24]:=PSECT;
   KWORDS[25]:='TITLE   '; KTOKEN[25]:=TITLE;
   KWORDS[26]:='END     '; KTOKEN[26]:=TEND;
   KWORDS[27]:='PAGE    '; KTOKEN[27]:=TPAGE;
 END;

 PROCEDURE LEXINIT;
 VAR  HASHA,HASHB:INTEGER;
      ID:PACKNAME;
 BEGIN
   FOR COUNT:=0 TO HASHTOP DO HASH[COUNT]:=NIL;
   KEYTOKENSET;
   REPEAT
     ID:=OPFILE^.OPNAME;
     HASHA:=0; FOUND:=FALSE;
     FOR COUNT:=0 TO 7 DO
       BEGIN
         HASHA:=HASHA + HASHA; {left shift}
         HASHB:=ORD(ID[COUNT]);
         HASHA:=ORD((NOT ODD(HASHA) AND ODD(HASHB)) OR
                    (ODD(HASHA) AND NOT ODD(HASHB)));
       END;

     HASHB:=HASHA MOD HASHRANGE; {lo-order part}
     HASHA:=HASHA DIV HASHRANGE; {hi-order part}
     HASHA:=ORD((NOT ODD(HASHA) AND ODD(HASHB)) OR
                (ODD(HASHA) AND NOT ODD(HASHB))); {xor}
     HASHA:=HASHA MOD HASHRANGE;
     SYM:=HASH[HASHA];
     WHILE (NOT FOUND) AND (SYM<>NIL) DO
       IF SYM^.NAME=ID THEN FOUND:=TRUE
         ELSE SYM:=SYM^.LINK;
     IF FOUND THEN WRITELN('Opcode declared twice=',ID)
       ELSE
         BEGIN
           NEW(SYM,UNKNOWN); {using UNKNOWN here is to save compile time space}
           SYM^.NAME:=ID; SYM^.ATTRIBUTE:=OPFILE^.OPATRIB;
           SYM^.OFFSETORVALUE:=OPFILE^.OPVALUE;
           SYM^.LINK:=HASH[HASHA];
           HASH[HASHA]:=SYM;
           IF DEBUG THEN WRITELN(ID,HASHA:10);
         END;
     GET(OPFILE);
   UNTIL EOF(OPFILE);
   EXPANDMACRO:=TRUE;
   PARMCHECK:=FALSE;
   CURRENTATRIB:=UNKNOWN;
   BLOCKNO:=2;
   ADVANCE:=TRUE;
   MCSTKINDEX:=0;
   SOURCE:=FILESOURCE;
   BLOCKPTR:=1024;
   LEXTOKEN:=ENDLINE;
   TEMPTOP:=0;
 END;

 BEGIN {Segment INITIALIZE}
   (*$I-*)
   OPFILENAME:=CONCAT(ASMNAME,'.OPCODES');
   OPFILENAME:=CONCAT('*',OPFILENAME);
   RESET(OPFILE,OPFILENAME);
   IF IORESULT<>0 THEN
     BEGIN
       WRITELN(OPFILENAME,' not on vol');
       UNITCLEAR(3);
       EXIT(TLA);
     END;
   FOR COUNT:=0 TO 79 DO BLANKLINE[COUNT]:=CHR(0);
   TEXTLINE:=BLANKLINE;
   WRITELN(ASMNAME,'   Assembler  ',RELEASENAME);
   FOR COUNT:=0 TO CODESIZE DO BLANKCODE[COUNT]:=' ';
   CODE:=BLANKCODE; CODECOUNT:=0; HEXCHAR:='0123456789ABCDEF';
   BUFFERPOS:=0; NUMERRORS:=0;
   TAB:=CHR(9);
   LINENUM:=0;  SPCIALSTKINDEX:=-1; PROCNUM:=0; LISTNUM:=0;
   IF LENGTH(USERINFO.WORKTITLE)=0 THEN
     FIRSTFNAME:=USERINFO.SYMTITLE
   ELSE
     FIRSTFNAME:=USERINFO.WORKTITLE;
   CURFNAME:=FIRSTFNAME;
   REPEAT
     WRITE('Output file for assembled listing: (<CR> for none)');
     READLN(LISTNAME);
     DISPLAY:=(LISTNAME<>'');  LISTING:=DISPLAY;
     CONSOLE:=(LISTNAME='CONSOLE:') OR (LISTNAME='#1:');
     IF DISPLAY THEN
       IF CONSOLE THEN
         OPENNEW(LISTFILE,'CONSOLE:')
       ELSE
         OPENNEW(LISTFILE,CONCAT(LISTNAME,'.TEXT[*]'));
     OK:=(IORESULT=0);
     IOCHECK(FALSE);
   UNTIL OK;
   (*$I+*)
   IF NOT RELEASEVERSION THEN
     BEGIN
       WRITELN('Relocation info at file end?');
       READ(KEYBOARD,CH);
       JUMPINFO:=(CH='Y') OR (CH='y');
     END
   ELSE JUMPINFO:=TRUE;
   FOR COUNT:=1 TO 9 DO WRITELN;
   NULLREL.TIPE:=NOTSET; NULLREL.TEMPLABEL:=0; NULLREL.SYM:=NIL;
   NULLREL.ATTRIBUTE:=UNKNOWN; NULLREL.OFFSETORVALUE:=0;
   RELOCATE:=NULLREL;
   MARK(HEAP); {To initialize MEMAVAIL}
   EXPRSSADVANCE:=TRUE;  NOTSTRING:=TRUE; DEFMCHOOK:=FALSE;
   ALTINPUT:=FALSE; SYMLAST:=FALSE; FROMPUTWORD:=FALSE;
   LC:=0; LASTLC:=0; LOWLC:=0; ALC:=0;
   CONDINDEX:=-1;
   PROCNAME:='        ';
   PAGENO:=0;
   TITLELINE:=' ';
   IF DISPLAY THEN
     BEGIN
       WRITELN(LISTFILE,'PAGE - ',PAGENO:3);
       PAGENO:=PAGENO + 1;
     END;
   (*$I-*)
   REWRITE(SCRATCH,'*LINKER.INFO'); LINKEND:=0;
   IOCHECK(TRUE);
   (*$I+*)
   NEW(SYM,UNKNOWN); {extra record on heap to garbage}
   LEXINIT;
   IF NOT (CONSOLE AND DISPLAY) THEN
     BEGIN
       WRITELN;
       WRITE('<   0>');
     END;
   CODESECTION:=P;
 END;

(*$I ASM2.TEXT*)
(*$I ASM3.TEXT*)
(*$I ASM4.TEXT*)
(*$I ASM5.TEXT*)
(*$I ASM6.TEXT*)