*DECK S$DSASM 
          PROC S$DSASM (CODE$) ;
  
          BEGIN 
  
          DEF  COM           #CONTROL NOLIST;#; 
          DEF  ENDCOM        #CONTROL LIST;#; 
  
          ITEM ABSADDR      U;              # INSTR ABSOLUTE ADDR      #
          ITEM CODEIX       I;              # INDEX TO CODE$WORD       #
          ITEM INSTR        U;              # OCTAL INSTRUCTION        #
          ITEM INSTRLEN     U;              # 15 OR 30 BITS            #
          ITEM ISB          U;              # INSTR START BIT 0,15,    #
                                            # 30 OR 45 OF CODE$WORD    #
          ITEM OCTADDR      C(20);          # ADDR IN OCTAL DIGITS     #
          ITEM OCTINSTR     C(20);          # INSTR IN OCTAL DIGITS    #
          ITEM OPCODE       U;              # FIRST 6 BITS OF INSTR    #
  
#CODE$#   COM    # AREA TO HOLD GENERATED CODE                         #
  
          ARRAY CODE$ [0:0];
              BEGIN 
              ITEM  CODE$LENGTH  I(0, 0,18);     # LENGTH OF CODE$     #
              ITEM  CODE$USED    I(0,42,18);     # NO. USED CODE$ WORDS#
              ITEM  CODE$WORD    U(0, 0,60);     # A CODE WORD         #
              END 
  
#CODE$#   ENDCOM
  
          ARRAY BUFF$ S(6) ;
              BEGIN 
              ITEM BUFF$LINE  C(00,00,60);#USEFUL FOR BLANKING OUT LINE#
              ITEM BUFF$ADDR  C(00,00,06);#6 OCTAL DIGIT ADDRESS FIELD #
              ITEM FILLER1    C(00,36,03);#3 SPACES                    #
              ITEM BUFF$INSTR C(00,54,20);#20 CHAR MNEMONIC FIELD      #
              ITEM FILLER2    C(02,54,11);#11 SPACES                   #
              ITEM BUFF$MNE   C(04,00,20);#20 CHAR MNEMONIC FIELD      #
              END 
  
          XREF PROC S$PRTCD ;     # ROUTINE TO PRINT A BUFFER LINE     #
  
          XREF ARRAY S$OPTBL[0:71] S(3);
              BEGIN 
              ITEM MNEMONIC C(00,00,20);  # 20 CHAR MNEMONIC           #
              ITEM SCN1     U(02,00,06);  # FIELD 1 START CHAR POS N0  #
              ITEM CL1      U(02,06,06);  # FIELD 1 CHAR LENGTH        #
              ITEM SCN2     U(02,12,06);  # FIELD 2 START CHAR POS N0  #
              ITEM CL2      U(02,18,06);  # FIELD 2 CHAR LENGTH        #
              ITEM SCN3     U(02,24,06);  # FIELD 3 START CHR POS. N0  #
              ITEM CL3      U(02,30,06);  # FIELD 3 CHAR LENGTH        #
              ITEM SHORT    B(02,59,01);  # TRUE IF 15-BIT INSTRUCTION #
              END 
  
#  THIS FUNCTION CONVERTS AN OCTAL NUMBER TO DISPLAY CODE              #
  
          FUNC S$OCT(VALUE) C(20);
          BEGIN 
              ITEM VALUE U;               #  NUMBER TO BE CONVERTED    #
              ITEM II;                    #  INTERNAL STRING INDEX     #
              ITEM C20   C(20);           #  TEMPORARY STRING          #
  
          FOR II = 0 STEP 1 UNTIL 19 DO 
              C<II,1>C20 = B<3*II,3>VALUE + O"33" ; 
          S$OCT = C20 ; 
          END   # S$OCT # 
    CONTROL EJECT ; 
  
$BEGIN
  
# PROC S$DSASM STARTS HERE                                             #
  
          ISB = 0 ;                          # INSTRUCTION START BIT   #
  
# THIS LOOP IS EXECUTED ONCE FOR EVERY COMPASS INSTRUCTION             #
          FOR CODEIX  = 1  WHILE CODEIX  LQ CODE$USED DO
              BEGIN 
  
              #GET THE FIRST 30 BITS OF 60-BIT CODE$WORD COMPASS INSTR.#
              B<0,30>INSTR = B<ISB,30>CODE$WORD[CODEIX ] ;
              OPCODE = B<0,6>INSTR ;          # FIRST 6 BITS IS OPCODE #
  
              #OPCODE WILL BE THE INDEX FOR THE MNEMONIC TABLE S$OPTBL #
              IF OPCODE EQ 03                 #  OPCODE 030 THRU 037   #
              THEN                          # AT S$OPTBL[64] THRU [71] #
                  OPCODE = 64+B<6,3>INSTR ; 
  
              # CHECK IF INSTRUCTION IS 15 OR 30 BITS                  #
              #    IF 30-BIT LONG, FETCH 30 BITS FROM CODE$WORD        #
              IF SHORT[OPCODE]
              THEN
                  INSTRLEN  = 15 ;
              ELSE
                  INSTRLEN  = 30 ;
  
              # PREPARE LINE BUFF$ TO SEND TO S$LSTLN TO PRINT         #
  
              #  BLANK THE WHOLE BUFFER LINE                           #
              BUFF$LINE = " " ; 
  
              #GET ABSOLUTE ADDR OF INSTRUCTION,CONVERT TO DISPLAY CODE#
              # AND PUT IN ADDRESS FIELD OF PRINT LINE FOR EA.CODE$WORD#
              IF ISB EQ 0 THEN
                  BEGIN 
                  ABSADDR  = LOC(CODE$WORD[CODEIX ]) ;
                  OCTADDR  = S$OCT(ABSADDR ) ;
                  C<0,6>BUFF$ADDR = C<14,6>OCTADDR  ; 
                  END 
  
              # CONVERT INSTR WORD TO 20 OCTAL DIGITS AND PUT IN BUFF$ #
              OCTINSTR  = S$OCT(INSTR) ;
              C<ISB/3,INSTRLEN /3>BUFF$INSTR = C<0,INSTRLEN /3>OCTINSTR;
  
              #COPY MNEMONIC  OF S$OPTBL TO MNEMONIC FLD OF PRINT LINE #
              BUFF$MNE = MNEMONIC[OPCODE] ; 
  
              # ADJUST THE OPERAND FIELDS OF MNEMONIC INSTRUCTION      #
              IF CL1[OPCODE] NQ 0 
              THEN
              C<SCN1[OPCODE],CL1[OPCODE]>BUFF$MNE = C<2,1>OCTINSTR; 
  
              IF CL2[OPCODE] NQ 0 
              THEN
              C<SCN2[OPCODE],CL2[OPCODE]>BUFF$MNE = C<3,1>OCTINSTR; 
  
              IF SHORT[OPCODE]
              THEN
              C<SCN3[OPCODE],CL3[OPCODE]>BUFF$MNE = C<4,1>OCTINSTR; 
              ELSE
              C<SCN3[OPCODE],CL3[OPCODE]>BUFF$MNE = C<4,6>OCTINSTR; 
  
              # CALL ROUTINE TO PRINT THE LINE OUT                     #
              S$PRTCD(BUFF$) ;
  
              # MOVE ISB TO NEXT INSTRUCTION START BIT                 #
              ISB = ISB + INSTRLEN  ; 
              IF ISB GQ 60       # (RECOVER FROM ILLEGAL CASE)         #
              THEN
                  BEGIN 
                  ISB = 0 ; 
                  CODEIX  = CODEIX  + 1 ; 
                  END 
  
              END  # FOR CODEIX LOOP #
  
              # FLUSH BUFFER FOR FILE "CODE"                           #
              S$PRTCD(0); 
  
$END
          END  # S$DSASM #
          TERM
