S-C Macro Assembler 3.0 -- ASM2/X.DIRECTIVES.1

1000 *SAVE X.DIRECTIVES.1
1010 *---------------------------------
1020 *      DIRECTIVES
1030 *--------------------------------
1040 *      .DUMMY -- START DUMMY SECTION
1050 *--------------------------------
1060 D.DUMMY
1070        LDA DUMMY.FLAG    DO NOTHING IF ALREADY IN DUMMY
1080        BMI .2
1090        LDX #3
1100 .1     LDA ORGN,X
1110        STA DUMMY.ORGN,X
1120        DEX
1130        BPL .1
1140        STX DUMMY.FLAG    SET FLAG NEGATIVE
1150 .2     RTS
1160 *--------------------------------
1170 *      .ED -- END DUMMY SECTION
1180 *--------------------------------
1190 D.END.DUMMY
1200        LDA DUMMY.FLAG
1210        BPL .2       DO NOTHING IF NOT IN .DUMMY
1220        LDX #3
1230        STX DUMMY.FLAG    SET FLAG POSITIVE
1240 .1     LDA DUMMY.ORGN,X
1250        STA ORGN,X
1260        DEX
1270        BPL .1
1280 .2     RTS         RETURN TO MAIN LEVEL OF ASM
1290 *---------------------------------
1300 *      .PH -- START PHASE
1310 *--------------------------------
1320 D.PHASE
1330        JSR D.END.PHASE
1340        JSR EXPR.DEFINED  GET PHASE ORIGIN
1350        LDX #3
1360 .1     LDA ORGN,X   SAVE ORIGIN
1370        STA ORIGIN.SAVE,X
1380        LDA EXP.VALUE,X
1390        STA ORGN,X   SET PHASE ORIGIN
1400        DEX
1410        BPL .1
1420        SEC          SET FLAG TO $80
1430        ROR PHASE.FLAG
1440        RTS         RETURN TO MAIN LEVEL OF ASM
1450 *--------------------------------
1460 *      .EP -- END PHASE
1470 *--------------------------------
1480 D.END.PHASE
1490        ASL PHASE.FLAG    TEST AND CLEAR FLAG
1500        BCC .2            IT WAS ALREADY CLEAR
1510        LDX #3
1520 .1     LDA ORIGIN.SAVE,X
1530        STA ORGN,X
1540        DEX
1550        BPL .1
1560 .2     RTS
1570 *---------------------------------
1580 *   .OR -- SET ORIGIN
1590 *---------------------------------
1600 PSOR   JSR EXPR.DEFINED  GET ORIGIN VALUE
1610        LDX #3
1620 .1     LDA EXP.VALUE,X   STORE IT IN
1630        STA ORGN,X        LOCATION
1640        DEX               COUNTER
1650        BPL .1
1660        LDA DUMMY.FLAG    IF IN DUMMY SECTION, DON'T
1670        BMI RTS.1         ...IN DUMMY
1680 NEW.TARGET
1690        JSR TFEND         END .TF IF DOING ONE
1700        LDA EXP.VALUE     STORE VALUE IN
1710        STA TRGT          TARGET ADDRESS
1720        LDA EXP.VALUE+1
1730        STA TRGT+1
1740 RTS.1  RTS
1750 *---------------------------------
1760 *    .TA -- SET TARGET ADDRESS
1770 *---------------------------------
1780 PSTA   JSR EXPR.DEFINED  GET EXPR VALUE
1790        LDA EXP.VALUE+2
1800        ORA EXP.VALUE+3
1810        BEQ NEW.TARGET
1820        JMP RAER
1830 *--------------------------------
1840 *   .AT -- ASCII STRING WITH LAST BYTE FLAGGED
1850 *   .AS -- ASCII STRING WITH ALL BYTES SAME
1860 *   .AZ -- Same as .AS, but with 00 terminator byte.
1870 *--------------------------------
1880 PSAZ   JSR PSAS
1890        JMP EMIT.ZERO
1900 PSAT   LDA #$80     LAST BYTE HAS OPPOSITE BIT 7
1910        .HS 2C       ...SKIP OVER 2 BYTES
1920 PSAS   LDA #0       ALL BYTES GET SAME BIT 7
1930        STA AT.HIBIT
1940        JSR GNNB     Scan to next non-blank
1950        BCS ERBA2     END OF LINE
1960        DEC CHAR.PNTR     BACK UP
1970 .1     JSR TRY.HEX.STRING
1980        BEQ .5       ...END OF LINE
1990        LDY #0
2000        STY AS.HIBIT ...assume hibit is 0
2010        CMP #'-'      1ST NON-BLANK A MINUS?
2020        BNE .15      ...no, hibit is 0
2030        ROR AS.HIBIT ...yes, hibit is 1
2040        JSR GNC.UC
2050 .15    STA DLIM     SAVE DELIMITER
2060        JSR GNC.UC   GET NEXT CHAR
2070        BCS ERBA2    END OF LINE IS BAD NEWS
2080        CMP DLIM     CHK IF DELIMITER
2090        BEQ .4       YES, NO STRING IN BETWEEN
2100 .2     JSR GNC.UC   GET NEXT CHAR
2110        BCS ERBA2    END OF LINE IS BAD NEWS
2120        CMP DLIM     CHK IF DELIMITER
2130        BEQ .3       YES, FINISH UP AND RETURN
2140        LDA WBUF-2,Y ...NO, GET PREVIOUS CHAR
2150        ORA AS.HIBIT MERGE WITH TOP BIT
2160        JSR EMIT
2170        JMP .2       GO FOR ANOTHER ONE
2180 .3     LDA WBUF-2,Y GET PREVIOUS CHAR
2190        ORA AS.HIBIT MERGE WITH SELECTED BIT 7
2200        EOR AT.HIBIT TOGGLE BIT 7 IF IN .AT
2210        JSR EMIT     EMIT THE BYTE
2220 .4     JSR GNC      CHECK IF MORE IN LIST
2230        BEQ .5
2240        CMP #','
2250        BEQ .1
2260 .5     RTS
2270 *---------------------------------
2280 *   .HS -- HEX STRING
2290 *---------------------------------
2300 PSHS   JSR GNNB     GET NEXT NON-BLANK CHAR
2310        BCS ERBA2    END OF LINE
2320        JSR BACKUP.CHAR.PNTR
2330        JSR TRY.HEX.STRING
2340        BNE ERBA2    ...ERROR, BAD ADDRESS
2350        RTS
2360 *--------------------------------
2370 THX1   JSR HEX.DIGIT  GET NEXT HEX DIGIT
2380        BCC ERBA2    ERROR, ODD DIGITS
2390        LDA SYM.VALUE    GET CONVERTED VALUE
2400        JSR EMIT
2410 TRY.HEX.STRING
2420 .1     JSR HEX.DIGIT
2430        BCS THX1
2440        LDA CURRENT.CHAR
2450        BEQ .2       ...END OF LINE
2460        CMP #','     IF COMMA, GO GET MORE BYTES
2470        BEQ .1       ...OKAY
2480        CMP #' '     IF BLANK, VALID END OF STRING
2490 .2     RTS
2500 *--------------------------------
2510 ERBA2  JMP ERBA     ERROR: BAD ADDRESS
2520 GT255ERR LDY #QER8  VALUE > 255 ERROR
2530        .HS 2C       LONG "BIT" TO SKIP NEXT TWO BYTES
2540 NOLBLERR LDY #QER1  "NO LABEL"
2550        .HS 2C       LONG "BIT" TO SKIP NEXT TWO BYTES
2560 UNDF   LDY #QER6     "UNDEF"
2570        JMP SOFT.ERROR
2580 *---------------------------------
2590 *   .EQ -- EQUATE
2600 *---------------------------------
2610 PSEQ   LDY WBUF     SEE IF ANY LABEL
2620        CPY #$20
2630        BEQ NOLBLERR   NO LABEL ON LINE
2640        LDA STPNTR   SAVE STPNTR WHILE CALLING EXPR
2650        PHA
2660        LDA STPNTR+1
2670        PHA
2680        JSR EXPR.DEFINED  GET VALUE
2690        PLA          RESTORE STPNTR
2700        STA STPNTR+1
2710        PLA
2720        STA STPNTR
2730        LDA PASS       WHICH PASS
2740        BNE .5         PASS 2, PRINT VALUE
2750 *---PASS 1:  DEFINE VALUE--------
2760        LDY WBUF     COLUMN 1 AGAIN
2770        CPY #':      PRIVATE LABEL?
2780        BCC .4       ...LOCAL LABEL
2790        BEQ .2       ...PRIVATE LABEL
2800 *---NORMAL LABEL-----------------
2810        LDY #2
2820 .1     LDA EXP.VALUE-2,Y   REDEFINE SYMBOL
2830        >SYM STA,PNTR
2840        INY
2850        CPY #6
2860        BCC .1
2870        RTS
2880 *---PRIVATE LABEL----------------
2890 .2     LDY #0
2900 .3     LDA EXP.VALUE,Y
2910        >SYM STA,STPNTR
2920        INY
2930        CPY #4
2940        BCC .3
2950        RTS
2960 *---LOCAL LABEL------------------
2970 .4     LDY #2       COMPUTE LOCAL OFFSET
2980        SEC
2990        LDA EXP.VALUE
3000        >SYM SBC,STPNTR
3010        DEY
3020        >SYM STA,PNTR
3030        LDY #3
3040        LDA EXP.VALUE+1
3050        >SYM SBC,STPNTR
3060        BNE GT255ERR    VALUE > 255
3070        RTS         RETURN TO MAIN LEVEL OF ASM
3080 *---PASS 2:  PRINT VALUE---------
3090 .5     JMP P.EXP.VALUE.DASH
3100 *---------------------------------
3110 *   .DA -- DATA VALUE (8- OR 16-BITS)
3120 *---------------------------------
3130 PSDA   LDA #0       UNDEF FLAG FOR LINE
3140        PHA
3150 .1     JSR GNNB     GET NEXT NON-BLANK CHAR
3160        BCS ERBA2    END OF LINE
3170        STA DLIM
3180 *---Could be $$dstringd----------
3190        CMP #'$'     $$dstringd value?
3200        BNE .2       ...NO
3210        LDA WBUF,Y   Look for second $
3220        CMP #'$'
3230        BNE .25      ...NO, MUST BE SIMPLE HEX WORD
3240        JSR GNC      SKIP OVER SECOND '$'
3250        JSR PSAS     GET dstringd
3260        JMP .5
3270 *---Look for size char-----------
3280 .2     LDY #1       ASSUME 1-BYTE DATA
3290        CMP #'#'
3300        BEQ .3
3310        CMP #'/'
3320        BEQ .3
3330        LDY #3       ASSUME 3-BYTE DATA
3340        CMP #'<'     24-BIT SIGNAL
3350        BEQ .3       ...3-BYTE DATA
3360        INY          ASSUME 4-BYTE DATA
3370        CMP #'>'     32-BIT SIGNAL
3380        BEQ .3
3390 *---Size is two bytes------------
3400 .25    JSR BACKUP.CHAR.PNTR
3410        LDY #2       2-BYTE DATA
3420 *---Get expression, emit value---
3430 .3     STY ADDR.LENGTH
3440        JSR EXPR     CRACK EXPRESSION
3450        LDY DLIM     If preceded by /, shift over
3460        CPY #'/'
3470        BNE .4       ...NOT /
3480        JSR EXP.OVER.256
3490 .4     JSR EMIT.VALUE  ACCORDING TO ADDR.LENGTH
3500 *---Update UNDEF flag------------
3510        PLA          .DA'S UNDEF FLAG
3520        ORA EXP.UNDEF
3530        PHA
3540 *---Next item in list------------
3550 .5     JSR GNC.UC   LOOK FOR ANOTHER ITEM
3560        CMP #',      COMMA?
3570        BEQ .1       YES, GET ANOTHER ONE
3580        PLA          GET .DA'S UNDEF FLAG
3590        STA EXP.UNDEF     MERGED VALUE
3600        RTS          LIST LINE OR REPORT UNDEF ERROR
3610 *--------------------------------
3620 *      DO/ELSE/FIN
3630 *--------------------------------
3640 PSDO   JSR EXPR.DEFINED    GET VALUE
3650        LDX DO.INDEX        0 IF EMPTY, ELSE 1-63
3660        INX
3670        CPX #64
3680        BCC .2
3690        LDY #QERDO2  ".DO NEST TOO DEEP"
3700        JMP SOFT.ERROR
3710 .2     LDA EXP.VALUE
3720        ORA EXP.VALUE+1  TEST FOR ZERO
3730        ORA EXP.VALUE+2
3740        ORA EXP.VALUE+3
3750        BEQ .3       ZERO, FALSE
3760        SEC          NONZERO, TRUE
3770 .3     STX DO.INDEX
3780        LDX #-8
3790 .4     ROR DO.STACK+8,X
3800        INX
3810        BNE .4
3820        RTS          LIST THE LINE
3830 *--------------------------------
3840 PSEL   LDX DO.INDEX
3850        BEQ ERR.DO   ERROR, NOT BTWN .DO AND .FIN
3860        LDA DO.STACK
3870        EOR #$80     TOGGLE CURRENT LOGIC LEVEL
3880        STA DO.STACK
3890        RTS         RETURN TO MAIN LEVEL OF ASM
3900 *--------------------------------
3910 ERR.DO LDY #QERDO   "MISSING .DO"
3920        JMP SOFT.ERROR
3930 *--------------------------------
3940 PSFI   LDX DO.INDEX
3950        BEQ ERR.DO   ERROR, NOT AFTER .DO
3960        DEC DO.INDEX POP THIS DO
3970        LDX #7
3980 .1     ROL DO.STACK,X
3990        DEX
4000        BPL .1
4010        RTS         RETURN TO MAIN LEVEL OF ASM
4020 *--------------------------------