HPAL,L,"AMWCS",0,3,99 
BEGIN                           COMMENT 
C 
                         HP RTE MICROASSEMBLER
C 
  BY  J. D. REED
      HUGHES AIRCRAFT CO. 
      P. O. BOX 11337 
      BLDG. 802  MS 145 
      TUCSON, ARIZONA 85734 
C 
  THE RTE MICROASSEMBLER IS A MODIFIED HP BCS MICROASSEMBLER. 
C 
  THE RTE MICROASSEMBLER INCORPORATES ALL OF THE FEATURES OF
 THE HP DOS MICROASSEMBLER AS OUTLINED IN THE HP DOS MICRO- 
 PROGRAMMING SOFTWARE MANUAL (HP ORDER # 02100-90146).
  ALL REFERENCES TO FILES ARE RTE FILEMANAGER FILES. SOURCE 
 FILES ARE TYPE 0 OR 4. OBJECT MICROCODE FILES ARE TYPE 0 OR
 7. 
  THE CONTROL STATEMENT $NAME=XXXXXX, WHERE XXXXXXIS ANY
 ASCII STRING, HAS BEEN INCORPORATED TO PERMIT THE PRO- 
 GRAM NAME TO BE LISTED AT THE TOP OF EACH LISTING PAGE.
C 
  TO SCHEDULE AMWCS:
     *ON,AMWCS,A,B,C,D
  WHERE 
      A = LOGICAL UNIT OF SOURCE INPUT DEVICE. DEFAULT = 5. 
          2 = LS TRACKS.
      B = LOGICAL UNIT OF LIST DEVICE. DEFAULT = 6. 
      C = LOGICAL UNIT OF PUNCH DEVICE. DEFAULT = 4.
      D = MAXIUM NUMBER OF LINES/PAGE FOR SOURCE MICROPROGRAM 
          LISTING. DEFAULT = 56.
  IF 100 IS ADDED TO A KYBD/DISPLAY LOGICAL UNIT NUMBER AND 
 SUPPLIED AS PARAMETER A AND/OR C, THE MICROASSEMBLER WILL
 REQUEST A FMP FILE NAME BE ENTERED THRU THAT DEVICE. THE 
 FILE(S) WILL THEN BE USED FOR SOURCE AND/OR OBJECT CODE
 RESPECTIVELY.
C 
  PROGRAM DECLARATIONS; 
& 
 BOOLEAN ADDTYPE, ADRINSBUS, CONINSBUS, CWINSPECIAL, EOC, 
         EOP:=FALSE, EOPINSKIP:=FALSE, INFMP:=FALSE, JMPFLG,  
         LISTING:=TRUE, LS:=FALSE, LSWRITE:=FALSE, MINSTORE,
         NOPINRBUS, NOPINSBUS, OUTFMP:=FALSE, PINSBUS,  
         PUNCH:=TRUE, RPTINSKIP:=FALSE, S1INSBUS, S2INSBUS, 
         S3INSBUS, S4INSBUS, SURPRESS:=FALSE; 
& 
& FORMAT ARRAYS 
& 
  INTEGER ARRAY F0[1:36] := "  ","  ","  ","  ","  ","  ",
               "  ","  ","  ","  ","  ","  ","  ","  "," W",
               "CS"," P","RO","GR","AM","  ","  ","  ","  ",
               "  ","  ","  ","  ","  ","  ","  ","  "," P",
               "AG","E ","  ";  
  INTEGER ARRAY F1[1:12] := "  ","  "," *","**","*E","RR","OR", 
               "  ","  "," *","**","* ";
  INTEGER ARRAY F2[1:11] := " B","AD"," C","ON","TR","OL"," S", 
               "TA","TE","ME","NT"; 
  INTEGER ARRAY F5[1:13] := "  ","**","ER","RO","R ","  "," I", 
               "N ","LI","NE","  ","  ","**"; 
  INTEGER ARRAY F6[1:14] := "  ","**","WA","RN","IN","G ","  ", 
               " I","N ","LI","NE","  ","  ","**";
  INTEGER ARRAY F7[1:7] := " S","YM","BO","L ","TA","BL","E ";
  INTEGER ARRAY F8[0:8] := "  ","  ","  ","  ","  ","  ","  ",
               "  ","  "; 
  INTEGER ARRAY F9[1:12]:= "  ","  ","  ","**"," E","RR","OR",
               "S ","= ","  ","  ","**";
  INTEGER ARRAY F12[1:6] := " E","ND"," 0","F ","TA","PE";
  INTEGER ARRAY F13[1:7] := " E","OF"," L","S ","TR","AC","KS"; 
  INTEGER ARRAY F14[1:8] := " E","OF"," I","N ","FM","P ","FI", 
               "LE";
  INTEGER ARRAY F15[1:5] := "  ","  ","  ","  ","  "; 
  INTEGER ARRAY F16[1:12] :="  ","SY","MB","OL"," T","AB","LE", 
               " O","VE","RF","LO","W ";
  INTEGER ARRAY F17[1:6] := " E","ND","$ ","AM","WC","S ";
  INTEGER ARRAY F18[1:9] := "  ","LS"," T","RA","CK","S ","EM", 
               "PT","Y!"; 
  INTEGER ARRAY F19[1:9] := "SO","UR","CE"," F","IL","E ","NA", 
               "ME"," _"; 
  INTEGER ARRAY F20[1:9] := "OB","JE","CT"," F","IL","E ","NA", 
               "ME"," _"; 
  INTEGER ARRAY F21[1:12] := "  ","NO"," L","S ","TR","AC","KS",
               " A","VA","IL","AB","LE";
  INTEGER ARRAY F22[1:12] := " P","AS","S ","II"," L","S ","WR",
               "IT","E ","ER","RO","R!";
  INTEGER ARRAY K3[1:2] := "K3","  "; 
  INTEGER ARRAY K4[1:2] := "K4","  "; 
  INTEGER ARRAY K6[1:2] := "K6","  "; 
  INTEGER ARRAY I2[1:2] := "I2","  "; 
  INTEGER ARRAY I3[1:2] := "I3","  "; 
  INTEGER ARRAY I4[1:2] := "I4","  "; 
 INTEGER A, BASE:=-1, CHARS:=71, CHECKSUMB:=0, CONST:=@272, 
         ERR, ERROR, I, INDEX, J, K, LEADER, LEN, LIMIT:=@400,
         LINE:=-1, LINES:=0, LIST:=6, LOCCNTR:=0, NEXT:=0,
         NUMERRORS:=0, LINESPERPAGE:=-54, OUTWORDS, PAGE:= 0, 
         PUN:=4, QQ, RDR:=5, T, TTY, WDCNT:=1, XPUN, Z:=" ",
         STATUS,FORMFEED := @1100, N1 := -1,ONE := 1; 
 INTEGER ARRAY
         BUFFER[-10:36], CARD[0:71], INDCB[1:144], INFILE[1:3], 
         MCODE[-1:114], OUTDCB[1:144], OUTFILE[1:3],  
         PNAME[1:3], ROMA[0:56], ROMB[0:56], TABLE[0:89,1:5], 
         TYPE[0:89], VALUES[0:89],SYMBOL[0:5],NAME[1:3];
INTEGER ARRAY RBUS[0:8,1:3] :=
        "A"," "," ",
        "B"," "," ",
        "Q"," "," ",
        "F"," "," ",
        "C","A","B",
        "A","A","B",
        "C","Q"," ",
        "N","O","P",
        " "," "," ";
INTEGER ARRAY SBUS[0:16,1:4]_ 
       "C","I","R"," ", 
       "I","O","I"," ", 
       "T"," "," "," ", 
       "M"," "," "," ", 
       "R","R","S"," ", 
       "C","N","T","R", 
       "A","D","R"," ", 
       "C","O","N","D", 
       "S","4"," "," ", 
       "S","3"," "," ", 
       "S","2"," "," ", 
       "S","1"," "," ", 
       "C","R"," "," ", 
       "C","L"," "," ", 
       "P"," "," "," ", 
       "N","O","P"," ", 
       " "," "," "," "; 
INTEGER ARRAY FCN[0:32,1:4] :=
       "R","F","I"," ", 
       "R","F","E"," ", 
       "P","1","A"," ", 
       "M","P","Y"," ", 
       "D","I","V"," ", 
       "S","U","B"," ", 
       "D","E","C"," ", 
        0,0,0,0,
       "I","N","C","O", 
       "I","N","C"," ", 
       "A","D","D","O", 
       "A","D","D"," ", 
       "A","N","D"," ", 
       "N","O","R"," ", 
       "X","O","R"," ", 
       "Y","Y","Y"," ", 
       "J","S","B"," ", 
       "J","S","B"," ", 
       "J","M","P"," ", 
       "J","M","P"," ", 
       "C","J","M","P", 
       "R","S","B"," ", 
       "L","G","S"," ", 
       "C","R","S"," ", 
       "A","R","S"," ", 
       "C","J","M","P", 
       "L","W","F"," ", 
       "C","F","L","G", 
       "S","F","L","G", 
       "C","L","O"," ", 
       "S","O","V"," ", 
       "I","O","R"," ", 
" "," " ," "," "; 
INTEGER ARRAY STOR[0:16,1:3]_ 
        "I","O","O",
        "M"," "," ",
        "T"," "," ",
        "I","R"," ",
        "S","4"," ",
        "S","3"," ",
        "S","2"," ",
        "S","1"," ",
        "P"," "," ",
        "F"," "," ",
        "Q"," "," ",
        "C","A","B",
        "A","A","B",
        "B"," "," ",
        "A"," "," ",
        "N","O","P",
        " "," "," ";
INTEGER ARRAY SPEC[0:16,1:4]_ 
       "R","S","S"," ", 
       "L","1"," "," ", 
       "R","1"," "," ", 
       "C","N","T","R", 
       "S","R","G","1", 
       "S","R","G","2", 
       "A","A","B"," ", 
       "L","E","P"," ", 
       "E","C","Y","Z", 
       "E","C","Y","N", 
       "A","S","G","1", 
       "A","S","G","2", 
       "C","W"," "," ", 
       "I","O","G","1", 
       "R","W"," "," ", 
       "N","O","P"," ", 
" "," "," "," ";
INTEGER ARRAY SKIP[0:16,1:4]_ 
       "I","C","T","R", 
       "R","P","T"," ", 
       "O","D","D"," ", 
       "N","E","G"," ", 
       "C","O","U","T", 
       "O","V","F"," ", 
       "F","L","G"," ", 
       "T","B","Z"," ", 
       "C","T","R","I", 
       "C","T","R"," ", 
       "N","M","P","V", 
       "A","A","B"," ", 
       "N","A","A","B", 
       "E","O","P"," ", 
       "U","N","C"," ", 
       "N","O","P"," ", 
" "," "," "," ";
 LABEL ABORT; 
& EXTERNAL PROCEDURES 
& 
PROCEDURE ASCIN (BUFFER,LUN,LEN,NUM,STATUS);
  VALUE LEN; INTEGER BUFFER,LUN,LEN,NUM,STATUS; 
  CODE; 
& 
PROCEDURE CLOSE (DCB,ERROR); INTEGER DCB,ERROR; CODE; 
& 
PROCEDURE EXEC (XCODE,LUN,BUFFER,WORDS);
  VALUE XCODE,LUN,WORDS; INTEGER XCODE,LUN,BUFFER,WORDS;
  CODE; 
& 
PROCEDURE FETCH (A,B,C,D); INTEGER A,B,C,D; CODE; 
& 
INTEGER PROCEDURE IFMGR (ERROR,FCODE,TTY,FILE); 
  VALUE FCODE; INTEGER ERROR,FCODE,TTY,FILE;
  CODE; 
& 
PROCEDURE SFMTR (I,FMT,BUFF,PNTR);
  VALUE I,PNTR; INTEGER I,FMT,BUFF,PNTR;
  CODE; 
& 
PROCEDURE LSEOF; CODE;
& 
PROCEDURE LSINT (ERROR); INTEGER ERROR; CODE; 
& 
PROCEDURE LSRED (BUFFER,LEN,WORDS); 
  VALUE LEN; INTEGER BUFFER,LEN,WORDS;
  CODE; 
& 
PROCEDURE LSREL; CODE;
& 
PROCEDURE LSRQ (ERROR,I); INTEGER ERROR,I; CODE;
& 
PROCEDURE LSWRT (BUFFER,WORDS,ERROR); 
  INTEGER BUFFER,WORDS,ERROR; 
  CODE; 
& 
PROCEDURE OPEN (DCB,ERROR,FILE,OPTION); 
  VALUE OPTION; INTEGER DCB,ERROR,FILE,OPTION;
  CODE; 
& 
PROCEDURE READF (DCB,ERROR,BUFFER,LEN,WORDS); 
  VALUE LEN; INTEGER DCB,ERROR,BUFFER,LEN,WORDS;
  CODE; 
& 
PROCEDURE RWNDF (DCB,ERROR); INTEGER DCB,ERROR; CODE; 
& 
PROCEDURE WRITF (DCB,ERROR,BUFFER,LEN); 
  INTEGER DCB,ERROR,BUFFER,LEN; 
  CODE; 
& INTERNAL PROCEDURES 
& 
PROCEDURE FILLER (J); 
&  PROCEDURE TO PACK LEADING ZEROS INTO THE LINE NUMBER.
 VALUE J; INTEGER J;  
 BEGIN
      IF BUFFER[J] = "  " THEN BUFFER[J] := " 0"; 
      IF (BUFFER[J+1] AND @77400) = @20000
     THEN BUFFER[J+1] := BUFFER[J+1] + @10000;
 END OF FILLER PROCEDURE; 
& 
PROCEDURE PACK; 
&  PACK REPACKS THE CARD ARRAY, 2 CHARS/WORD, INTO THE BUFFER 
& ARRAY FOR PRINTING. 
 BEGIN  INTEGER J,K;
      FOR K := -10 TO 0 DO BUFFER[K] := "  "; 
      J := 0; 
      FOR K := 1 TO LEN DO
     BEGIN BUFFER[K] := ROTATE(CARD[J]) + CARD[J+1];
           J := J + 2;
     END
 END OF PACK; 
& 
PROCEDURE HEADING;
&  HEADING WRITES THE PAGE HEADING ON THE LIST DEVICE 
 BEGIN
      EXEC (3,FORMFEED,N1,0); 
      PAGE := PAGE + 1; SFMTR (PAGE,I2[1],F0[36],0);
      EXEC (2,LIST,F0[1],36); LINES := LINESPERPAGE;  
      EXEC (3,FORMFEED,ONE,0) 
 END OF HEADING;
& 
PROCEDURE LISTIT (N); 
&  LISTIT OUTPUTS SOURCE LISTINGS AND ERROR MESSAGES TO THE 
& LIST DEVICE. IF A HEADING IS REQUIRED, THE HEADING IS 
& PRINTED THAN THE LINE.
 VALUE N; INTEGER N; & N = LIST CODE. 
 BEGIN
      IF LINES = 0 THEN HEADING;
      IF N = 1 THEN 
     BEGIN SFMTR (ERR,I4[1],F1[8],1); 
           EXEC (2,LIST,F1[1],12);
     END ELSE 
      IF N = 2 THEN EXEC (2,LIST,F2[1],11) ELSE 
      IF N = 3 THEN 
     BEGIN PACK; EXEC (2,LIST,BUFFER[1],LEN) END ELSE 
      IF N = 4 THEN EXEC (3,FORMFEED,N1,0) ELSE   
      IF N = 5 THEN 
     BEGIN SFMTR (ERROR,I2[1],F5[6],0); 
           SFMTR (LINE,I3[1],F5[11],1); 
           EXEC (2,LIST,F5[1],13) 
     END ELSE 
      IF N = 6 THEN 
     BEGIN SFMTR (ERROR,I2[1],F6[7],0); 
           SFMTR (LINE, I3[1],F6[12],1);
           EXEC (2,LIST,F6[1],14) 
     END ELSE 
      IF N = 7 THEN 
     EXEC (2,LIST,F7[1],7) ELSE 
      IF N = 8 THEN 
     BEGIN FOR I := 0 TO NEXT-1 DO
      BEGIN F8[1] := TABLE[I,1] + @20000; 
            F8[2] := ROTATE(TABLE[I,2]) + TABLE[I,3]; 
            F8[3] := ROTATE(TABLE[I,4]) + TABLE[I,5]; 
            SFMTR (VALUES[I],K6[1],F8[5],1);
            F8[8] := (F8[8] AND @77400) + TYPE[I];  
            EXEC (2,LIST,F8[0],9);
            LINES := LINES + 1; 
            IF LINES = 0 THEN HEADING;
      END;
           EXEC (2,LIST,F8[0],0)
     END ELSE 
      IF N = 9 THEN 
     BEGIN SFMTR (NUMERRORS,I3[1],F9[10],0);
           EXEC (2,LIST,F9[1],12) 
     END ELSE 
      IF N = 10 THEN
     BEGIN PACK; SFMTR (LINE,I3[1],BUFFER[-2],1); 
           FILLER (-2); 
           EXEC (2,LIST,BUFFER[-2],LEN+3) 
     END ELSE 
      IF N = 11 THEN
      BEGIN PACK; 
           SFMTR (LINE,I3[1],BUFFER[-10],1);
           FILLER (-10);
           SFMTR (BASE+LOCCNTR,K4[1],BUFFER[-7],0); 
           SFMTR (ROMA[WDCNT] AND @377,K3[1],BUFFER[-5],1);   
           SFMTR (ROMB[WDCNT],K6[1],BUFFER[-3],1);  
           EXEC (2,LIST,BUFFER[-10],LEN+11) 
     END ELSE 
      IF N = 15 THEN EXEC (2,LIST,F15[1],5) ELSE
      IF N = 16 THEN EXEC (2,LIST,F16[1],12); 
      LINES := LINES + 1; 
 END OF LISTIT; 
& 
PROCEDURE CHECKLIST (POINTER);
&  PROCEDURE TO CHECK LIST OPTION.
 VALUE POINTER; INTEGER POINTER;  
 BEGIN
      IF LISTING THEN LISTIT (POINTER); 
 END OF CHECKLIST PROCEDURE;
& 
PROCEDURE PRINTERROR (ERR); 
& 
& PRINTERROR SETS UP THE CALL TO LISTIT FOR ERROR MESSAGES. 
& 
 VALUE ERR; INTEGER ERR;
 BEGIN ERROR := ERR;
       LISTIT (5);
       NUMERRORS := NUMERRORS + 1;
 END OF PRINTERROR; 
& 
PROCEDURE SKIPBLANKS; 
&  SKIPBLANKS SKIPS BLANK CHARACTERS IN THE CARD BUFFER.
 BEGIN LABEL S1;
  S1: IF INDEX < CHARS THEN IF CARD[INDEX] = " " THEN 
     BEGIN INDEX := INDEX + 1; GO TO S1; END; 
      EOC := (IF INDEX>= CHARS THEN TRUE ELSE FALSE); 
 END OF SKIPBLANKS; 
& 
PROCEDURE SKIPTO (S); 
&  SKIPTO SKIPS CHARSACTERS IN THE CARD BUFFER UNTIL S IS FOUND.
&  IS FOUND.
 VALUE S; INTEGER S;
 BEGIN LABEL S1;
  S1: IF INDEX < CHARS THEN IF CARD[INDEX] # S THEN 
     BEGIN INDEX := INDEX + 1; GO TO S1; END; 
     EOC := (IF INDEX = CHARS THEN TRUE ELSE FALSE);
 END OF SKIPTO; 
& 
PROCEDURE WARNING (ERR);
& 
& WARNING SETS UP THE CALL TO LISTIT TO PRINT WARNING 
& MESSAGES IF SURPRESS IS NOT TRUE. 
& 
 VALUE ERR; INTEGER ERR;
 BEGIN ERROR := ERR;  
       IF NOT(SURPRESS) THEN
      BEGIN LISTIT(6); NUMERRORS := NUMERRORS + 1 END;
 END OF WARNING;
& 
PROCEDURE CHECKSET (A,B); 
& 
& CHECKSET CHECKS EACH FIELD FOR LEGALITY AND IF LEGAL SETS 
& THE PROPER FLAG TO INDICATE THE OPERATION IN THE FIELD. 
& 
 VALUE A; INTEGER A,B;
 BEGIN
      CASE A
    BEGIN 
& ** RBUS FIELD **
      BEGIN IF B < 0 THEN PRINTERROR(3) ELSE
            IF B = 7 THEN NOPINRBUS := TRUE ELSE
            IF B = 6 THEN WARNING(12);
      END 
  ** SBUS FIELD **; 
      BEGIN IF B < 0 THEN PRINTERROR(4) ELSE
            IF B = 15 THEN NOPINSBUS := TRUE ELSE 
            IF B = @15 OR B = @14 THEN CONINSBUS := TRUE ELSE 
            IF B = @13 THEN S1INSBUS := TRUE ELSE 
            IF B = @16 THEN PINSBUS := TRUE ELSE
            IF B = @12 THEN S2INSBUS := TRUE ELSE 
            IF B = @11 THEN S3INSBUS := TRUE ELSE 
            IF B = @6  THEN ADRINSBUS := TRUE ELSE
            IF B = @10 THEN S4INSBUS := TRUE ;
      END 
  ** FUNCTION FIELD **; 
      BEGIN K := B; 
            IF B < 0 THEN PRINTERROR(5) ELSE
            IF B < @25 AND B > @17 THEN JMPFLG := TRUE ELSE 
            IF B < @14 AND B > @7 THEN ADDTYPE := TRUE ELSE 
            IF B = 6 AND NOPINRBUS THEN WARNING(13) ELSE
            IF B = 0 THEN WARNING(12) ELSE
            IF (B = 1) AND NOT(NOPINSBUS) THEN WARNING(21) ELSE 
            IF JMPFLG AND NOT(NOPINSBUS OR ADRINSBUS) THEN
            IF PINSBUS THEN WARNING(22) ELSE WARNING(14); 
      END 
  ** STORE FIELD **;
      BEGIN IF B < 0 THEN PRINTERROR(6) ELSE
            IF B = 1 THEN MINSTORE := TRUE ELSE 
            IF (B = 4 AND S4INSBUS) OR (B = 5 AND S3INSBUS) 
           OR (B = 6 AND S2INSBUS) OR (B = 7 AND S1INSBUS)
           THEN PRINTERROR(15); 
      END 
  ** SPECIAL FIELD **;
      BEGIN IF B < 0 THEN PRINTERROR(7) ELSE
            IF B = @14 THEN CWINSPECIAL := TRUE;
            IF B = 7 THEN WARNING(16) ELSE
            IF NOT(CWINSPECIAL OR B = @16) AND MINSTORE 
           THEN WARNING(17);
      END 
  ** SKIP FIELD **; 
      BEGIN IF B < 0 THEN PRINTERROR(8) ELSE
         BEGIN IF B # @17 AND EOPINSKIP THEN WARNING(18) ELSE 
               IF ((B # @16) AND (B # @12)) AND CWINSPECIAL 
              THEN WARNING(10); 
               IF ((B = 7) OR (B = 0) OR (B = 1) OR (B = @17) 
              OR (B = @15)) AND RPTINSKIP THEN PRINTERROR(19);  
               IF RPTINSKIP THEN
               IF ((B = 3) OR (B = 2)) AND ADDTYPE
              THEN PRINTERROR(20);
               IF B = @15 THEN EOPINSKIP := TRUE ELSE 
              EOPINSKIP := FALSE; 
               IF B = 1 THEN RPTINSKIP := TRUE ELSE 
              RPTINSKIP := FALSE; 
         END; 
      END;
    END;
 END OF CHECKSET; 
& 
INTEGER PROCEDURE CONVERT (N);
&  CONVERT CONVERTS ASCII CHARACTERS IN THE CARD BUFFER,
& STARTING AT CARD[N] UNTIL A DELIMITER IS REACHED TO AN
& INTEGER.
 VALUE N; INTEGER N;
 BEGIN
      CONVERT := 0; 
      WHILE CARD[N] > @57 AND CARD[N] < @70 DO
     BEGIN CONVERT := CONVERT * 8 + (CARD[N] AND @7); 
           N := N + 1;
     END; 
 END OF CONVERT;
&