JOB  MULTIPLE MORSE TEST FOR 1401
     *   111111111122222222223333333333444444444455555555556666666666777
     * 89012345678901234567890123456789012345678901234567890123456789012
     * $Revision: 1.6 $
     * USES SENSE SWITCHES TO SELECT VARIOUS CODE SNIPPETS
     * FOR MARK (TONE) AND SPACE (SILENT). KEY:
     * SSB SSC   SELECT MARK FUNCTIONS (ALL LOW MEMORY)
     * OFF OFF   CLEAR STORAGE       (LCS)
     * OFF  ON   SINGLE LONG MOVE    (LMV)
     *  ON  ON   TIGHT COUNT         (LTC)
     *  ON OFF   COUNT WITH LONG NOP (LNC)
     * SSD SELECTS WHETHER SPACE FUNCTIONS RUN IN HIGH OR LOW MEM.
     * OFF RUNS IN HIGH (OVER 4K) MEMORY
     *  ON RUNS IN LOW (FIRST 4K) MEMORY (SAME AS MARK FUNCTIONS)
     * SSE SSF SELECT SPACE ROUTINE WITH SAME CODE AS MARK
     *
     * ASSEMBLE WITH COMMAND
     * AUTOCODER -L MMTEST.LIS -O MMTEST.OBJ -BV MMTEST.AC
               CTL  6111
     * INDEX REGISTERS
               ORG  87
     X1        DS   3
               ORG  92
     X2        DS   3
               ORG  97
     X3        DS   3
     * MISC DATA IN PUNCH BUFF. NOT PUNCHING
               ORG  100
     LMBUF     DS   80
     HMBUF     EQU  LMBUF&8000
     ELTIM     DCW  #3
               ORG  400
     * SETUP: INITIALIZE MOVE BUFFERS, READ A CARD WITH MESSAGE
     * ENCODED AS * FOR DIT, - FOR DAH, SPACE BETWEEN CHARACTERS.
     * TWO SPACES FOR WORD-SPACE.
     SETUP     LCA   MPAT,LMBUF
               LCA   MPAT,HMBUF
               CS    80
               R
               SBR   X1, 0
     * CLOOP: LOOP ACROSS ALL CHARS OF MESSAGE, UNTIL WE
     * SEE A CHRACTER WHICH IS NOT *, -, OR SPACE.
     * RESET POINTER (IN X1) AT END, TO LOOP MESSAGE.
     * AS WE FETCH EACH CHARACTER, CHECK SENSE SWITCHES
     * TO SELECT FUNCTIONS. FIRST SELECT MARK (TONE) 
     CLOOP     B     MLCNT,B     MARK IS ONE OF COUNT FUNCS
               B     MLM,C       MOV IF SSC
     * GETTING HERE MEANS USER SELECTED CS FOR MARK FUNC
               SBR   MFB&3, LCS   CS IN LOMEM FOR MARK FUNCTION
               B     SFSEL       SELECT SPACE FUNC
     MLM       SBR   MFB&3, LMV  MOV IN LOMEM
               B     SFSEL
     MLCNT     B     MLSC,C      
               SBR   MFB&3, LNC  COUNT WITH NOP
               B     SFSEL
     MLSC      SBR   MFB&3, LTC  TIGHT COUNT
     * NOW SELECT GENERAL SPACE (SILENCE)
     SFSEL     B     SLCNT,E     SPACE IS ONE OF COUNT FUNCS
               B     SLM,F       MOV IF SSF
     * GETTING HERE MEANS USER SELECTED CS FOR SPACE FUNC
               SBR   SFB&3, LCS  CS IN LOMEM FOR SPACE FUNCTION
               B     SMSEL       SELECT SPACE MEM AREA
     SLM       SBR   SFB&3, LMV  MOV IN LOMEM
               B     SMSEL
     SLCNT     B     SLSC,F      
               SBR   SFB&3, LNC  COUNT WITH NOP
               B     SMSEL
     SLSC      SBR   SFB&3, LTC  TIGHT COUNT
     * WE HAVE SELECTED SPACE FUNC. OFFSET TO HIGH MEM?
     SMSEL     B     NCHAR,D     RUN FROM LOW IF SSD ON
               MA    @00!@,SFB&3  MODIFY FUNC POINTER TO 8000+
     * FINALLY, CHECK NEXT CHARACTER OF MESSAGE
     * STARTING BY INCREMENTING POINTER
     NCHAR     MA    @001@,X1
               BCE   DIT,0&X1,*
               BCE   DAH,0&X1,-
               BCE   SPC,0&X1, 
     * IF NOT AN EXPECTED CHARACTER, RESET POINTER TO 1ST CHAR
               SBR   X1, 0
               H     CLOOP       PAUSE FOR SWITCH CHANGE THEN RESTART
     * ROUTINES FOR '*', '-', ' ' 
     * DIT IS ONE ELEMENT OF ALTERNATING CALLS VIA MFB, SFB.
     * WITH A TARGET SPEED OF 5 WPM, A DIT IS 240 MILLISECONDS
     * IF OUR BASE TONE IS ABOUT 400HZ, A CYCLE IS ABOUT 2.5
     * MILLISECONDS, SO A DIT IS A BIT LESS THAN 100 CYCLES.
     * A DAH IS 3 TIMES AS LONG. BOTH JUST SET ELTIM AND MERGE.
     DIT       MLC   @899@,ELTIM
               B     MFB
     DAH       MLC   @699@,ELTIM
     * WE ALTERNATE MARK AND SPACE FUNCS TO MAKE A TONE
     * BRANCH BELOW WILL BE PATCHED TO POINT TO SELECTED MARK.
     MFB       B    *            CALL MARK FUNCTION
     * MARK FUNCTION RETURNS HERE. COUNT UP ELTIM TO OVERFLOW
               A     @1@,ELTIM
               BAV   STIME       ON OVERFLOW, DO 1 ELEMENT SPACING
               B     SHCYC       CALL ONE HALF CYCLE OF SPACE
               B     MFB
     * SHCYC PRODUCES ONE HALF CYCLE OF SPACE. iT IS USED AS
     * ONE PART OF THE TONE GENERATION, AND AS THE BASIC TIMING
     * FOR SPACING ELEMENTS
     SHCYC     SBR   SHCRET&3
     * BRANCH BELOW WILL BE PATCHED TO POINT TO SELECTED SPACE
     SFB       B     *
     SHCRET    B     *          RETURN ADDR ( SHCYC )
     * ACTUAL SILENT TIME (NOT JUST LOW PART OF TONE) IS HERE
     * STIME DOES ONE ELEMENT OF SPACE (FOLLOWING DIT OR DAH)
     * THEN LOOPS BACK TO FETCH NEXT CHARACTER OF MESSAGE
     STIME     MLC   @899@,ELTIM  DEFAULT 1-ELEMENT
     SILENT    B     SHCYC
               B     SHCYC
               A     @1@,ELTIM
               BAV   CLOOP       DONE HANDLING THIS CHAR
               B     SILENT
     * WE GET TO SPC WHEN THE CHARACTER IS A PACE. A SINGLE SPACE
     * IS THE INTER-CHARACTER SPACE FOR NOW, SO WE NEED 3 ELEMENTS OF
     * SILENCE, IF IT IS FOLLOWED BY A SPACE, WE NEED SEVEN TOTAL.
     * BUT WE HAVE ALREADY DONE ONE AFTER THE PREVIOUS ELEMENT,
     * SO DO TWO OR SIX MORE,
     SPC       B     WSPC,1&X1,   6 MORE IF NEXT CHAR IS SPACE
               MLC   @799@,ELTIM  OTHERWISE 2 MORE
               B     SILENT
     WSPC      MLC   @399@,ELTIM
               SBR   X1, 1&X1     SKIP OVER ADDED SPACE
               B     SILENT
     *
     * BELOW HERE IS COLLECTION OF TONE FUNCTIONS.
     * FIRST THE MARK-HIGH ONES, THEN THE LOW/SPACE ONES
     * THE FUNCTIONS, LOW MEMORY VERSION
     LCS       SBR  LCSR&3
     LCSR      CS   *,299       CLEAR STORAGE AND RETURN
     LMV       SBR  LFR&3
               MLC  LMBUF,LMBUF  MOVE TO SELF
     LFR       B    *
     LNC       SBR  LFR&3
     LNCL      A    @1@,LCTIM
               BAV  LFR
               NOP
               DC   @000000@
               B    LNCL
     LTC       SBR  LFR&3
     LTCL      A    @1@,LCTIM
               BAV  LFR
               A    @1@,LCTIM
               BAV  LFR
               B    LTCL
     LCTIM     DCW  #3
               ORG  1000
     * THE FUNCTIONS, HIGH MEMORY VERSION
               ORG  LCS&8000
     HCS       SBR  HCSR&3
     HCSR      CS   *,4299       CLEAR STORAGE AND RETURN
     HMV       SBR  HFR&3
               MLC  HMBUF,HMBUF  MOVE TO SELF
     HFR       B    *
     HNC       SBR  HFR&3
     HNCL      A    @1@,HCTIM
               BAV  HFR
               NOP
               DC   @000000@
               B    HNCL
     HTC       SBR  HFR&3
     HTCL      A    @1@,HCTIM
               BAV  HFR
               A    @1@,HCTIM
               BAV  HFR
               B    HTCL
     HCTIM     DCW  #3
               ORG  1000
     * PATTERN FOR MOVE FUNCTIONS TWO REPS OF 36 CHARS
               DCW  @ABCDEFGHIJKLMNOPQRSTUVWXYZ@
               DC   @0123456789@
               DC   @ABCDEFGHIJKLMNOPQRSTUVWXYZ@
     MPAT      DC   @0123456789@
               END  SETUP