! PROGRAM TO GENERATE A TEST ASSEMBLY SOURCE FOR TESTING
! THE 6805 ASSEMBLER

   DIM OPCODE$[20]
   DIM OPTYPE$[20]
   DIM OPVALUE, BITNO

SUBROUTINE OPLABEL1
   PRINT #2,"OP:";OPCODE$;
   RETURN SUBROUTINE
END

SUBROUTINE OPLABEL2
   PRINT #2,"OPEND:";OPCODE$;
   RETURN SUBROUTINE
END

SUBROUTINE OPSETUP
   BITNO = 0
   PRINT #2,""
   CALL OPLABEL1
   PRINT #2,CHR$(9);";Opcode = ";HEX$(OPVALUE)
   RETURN SUBROUTINE
END

SUBROUTINE OPOUTPUT
   PRINT #2,CHR$(9);OPCODE$;CHR$(9);
   IF OPTYPE$ = "BB" OR ...
&     OPTYPE$ = "BB!JMAC" OR ...
&     OPTYPE$ = "BSC" THEN
         BITNO = BITNO + 1
         IF BITNO > 7 THEN LET BITNO = 0
         PRINT #2, USING "#,PZLOC", BITNO;
         IF OPTYPE$[1,2] = "BB" THEN PRINT #2,",";
   FI
   RETURN SUBROUTINE
END

SUBROUTINE DIRECT
   CALL OPOUTPUT
   PRINT #2,"PZLOC"
   CALL OPOUTPUT
   PRINT #2,"<FPZLOC"
   RETURN SUBROUTINE
END

SUBROUTINE INDEX0
   CALL OPOUTPUT
   PRINT #2,",X"
   CALL OPOUTPUT
   PRINT #2,"0,X"
   RETURN SUBROUTINE
END

SUBROUTINE INDEX1
   CALL OPOUTPUT
   PRINT #2,"$40,X"
   CALL OPOUTPUT
   PRINT #2,"<FPZLOC,X"
   RETURN SUBROUTINE
END

SUBROUTINE INDEX2
   CALL OPOUTPUT
   PRINT #2,"$1234,X"
   CALL OPOUTPUT
   PRINT #2,"FPZLOC,X"
   CALL OPOUTPUT
   PRINT #2,">PZLOC,X"
   RETURN SUBROUTINE
END

SUBROUTINE IMMEDIATE
   CALL OPOUTPUT
   PRINT #2,"#$12"
   RETURN SUBROUTINE
END

SUBROUTINE EXTENDED
   CALL OPOUTPUT
   PRINT #2,"HIADDRESS"
   CALL OPOUTPUT
   PRINT #2,"FPZLOC"
   CALL OPOUTPUT
   PRINT #2,">PZLOC"
   CALL OPOUTPUT
   PRINT #2,"NONFORWARD"
   RETURN SUBROUTINE
END

SUBROUTINE AUTOEXTENDED
   CALL OPOUTPUT
   PRINT #2,"NONFORWARD"
   RETURN SUBROUTINE
END


SUBROUTINE NILTYPE
   CALL OPSETUP
   CALL OPOUTPUT
   PRINT #2,""
   RETURN SUBROUTINE
END

SUBROUTINE MONADIC
   CALL OPSETUP
   CALL DIRECT
   CALL INDEX0
   CALL INDEX1
   RETURN SUBROUTINE
END

SUBROUTINE DYDATIC
   CALL MONADIC
   CALL INDEX2
   CALL IMMEDIATE
   CALL EXTENDED
   RETURN SUBROUTINE
END

SUBROUTINE BRANCH
   CALL OPSETUP
   CALL OPOUTPUT
   CALL OPLABEL1
   PRINT #2,""
   CALL OPOUTPUT
   CALL OPLABEL2
   PRINT #2,""
   CALL AUTOEXTENDED
   IF OPCODE$ = "BSR" THEN
      CALL OPOUTPUT
      PRINT #2,"PZLOC"
   FI
   RETURN SUBROUTINE
END

SUBROUTINE BITBRANCH
   CALL OPSETUP
   CALL OPOUTPUT
   CALL OPLABEL1
   PRINT #2,""
   CALL OPOUTPUT
   CALL OPLABEL2
   PRINT #2,""
   CALL AUTOEXTENDED
   RETURN SUBROUTINE
END

SUBROUTINE BITSETCLR
   CALL OPSETUP
   CALL OPOUTPUT
   PRINT #2,""
   RETURN SUBROUTINE
END

SUBROUTINE JUMPMACRO
   CALL OPSETUP
   CALL OPOUTPUT
   CALL OPLABEL1
   PRINT #2,""
   CALL INDEX0
   CALL INDEX1
   CALL INDEX2
   CALL EXTENDED
   CALL DIRECT
   RETURN SUBROUTINE
END

SUBROUTINE BBMACRO
   CALL OPSETUP
   CALL OPOUTPUT
   CALL OPLABEL1
   PRINT #2,""
   CALL INDEX0
   CALL INDEX1
   CALL INDEX2
   CALL EXTENDED
   CALL DIRECT
   RETURN SUBROUTINE
END


!*** START OF MAIN PROGRAM
   IF ERROR WHEN OPEN #1,"ASM.05.TEST.DAT" THEN
               PRINT "INPUT OPEN ERROR = ";ERR
     FI
   IF ERROR WHEN CREATE #2,"ASM.05.TEST.ASM" THEN
               PRINT "CREATE OUTPUT ERROR =";ERR
     FI
   PRINT #2,"*";CHR$(9);"WITH";CHR$(9);"BXPN";CHR$(9);
   PRINT #2,"Option to enable branch expansions (default)"
   PRINT #2,"*";CHR$(9);"WITH";CHR$(9);"NBXPN";CHR$(9);
   PRINT #2,"Option to suppress branch expansions"
   PRINT #2,CHR$(9);"PGEN";CHR$(9);"1";CHR$(9);
   PRINT #2,"Show all code bytes"
   PRINT #2,CHR$(9);"ORG";CHR$(9);"$50"
   PRINT #2,"PZLOC";CHR$(9);"RMB";CHR$(9);"1"
   PRINT #2,CHR$(9);"ORG";CHR$(9);"$800"
   PRINT #2,"NONFORWARD";CHR$(9);"RMB";CHR$(9);"1"
   PRINT #2,CHR$(9);"ORG";CHR$(9);"$1000"

SCANFILE: ...
&  REPEAT

       INPUT #1,OPCODE$
       IF EOF(1) THEN EXIT SCANFILE
       INPUT #1,OPTYPE$
       INPUT #1,OPVALUE

       IF OPTYPE$ = "NIL"      THEN CALL NILTYPE
       IF OPTYPE$ = "MON"      THEN CALL MONADIC
       IF OPTYPE$ = "DYD"      THEN CALL DYDATIC
       IF OPTYPE$ = "SBR"      THEN CALL BRANCH
       IF OPTYPE$ = "BB"       THEN CALL BITBRANCH
       IF OPTYPE$ = "JMAC"     THEN CALL JUMPMACRO
       IF OPTYPE$ = "BB!JMAC"  THEN CALL BBMACRO
       IF OPTYPE$ = "BSC"      THEN CALL BITSETCLR
       CALL OPLABEL2
       PRINT #2,""
   END
   PRINT #2,""
   PRINT #2,"FPZLOC     EQU     $70             FORWARD REF PZ LOC"
   PRINT #2,"HIADDRESS"
   PRINT #2,"      END"
   CLOSE #1,#2
   EXIT
END
