NEW
  AUTO 3,1
*--------------------------------------
*      DIRECTIVES
*--------------------------------
*      .DUMMY -- START DUMMY SECTION
*--------------------------------
D.DUMMY
       LDA DUMMY.FLAG    DO NOTHING IF ALREADY IN DUMMY
       BMI .2
       LDX #3
.1     LDA ORGN,X
       STA DUMMY.ORGN,X
       DEX
       BPL .1
       STX DUMMY.FLAG    SET FLAG NEGATIVE
.2     RTS
*--------------------------------
*      .ED -- END DUMMY SECTION
*--------------------------------
D.END.DUMMY
       LDA DUMMY.FLAG
       BPL .2       DO NOTHING IF NOT IN .DUMMY
       LDX #3
       STX DUMMY.FLAG    SET FLAG POSITIVE
.1     LDA DUMMY.ORGN,X
       STA ORGN,X
       DEX
       BPL .1
.2     RTS         RETURN TO MAIN LEVEL OF ASM
*---------------------------------
*      .PH -- START PHASE
*--------------------------------
D.PHASE
       JSR D.END.PHASE
       JSR EXPR.DEFINED  GET PHASE ORIGIN
       LDX #3
.1     LDA ORGN,X   SAVE ORIGIN
       STA ORIGIN.SAVE,X
       LDA EXP.VALUE,X
       STA ORGN,X   SET PHASE ORIGIN
       DEX
       BPL .1
       SEC          SET FLAG TO $80
       ROR PHASE.FLAG
       RTS         RETURN TO MAIN LEVEL OF ASM
*--------------------------------
*      .EP -- END PHASE
*--------------------------------
D.END.PHASE
       ASL PHASE.FLAG    TEST AND CLEAR FLAG
       BCC .2            IT WAS ALREADY CLEAR
       LDX #3
.1     LDA ORIGIN.SAVE,X
       STA ORGN,X
       DEX
       BPL .1
.2     RTS
*---------------------------------
*   .OR -- SET ORIGIN
*---------------------------------
PSOR   JSR EXPR.DEFINED  GET ORIGIN VALUE
       LDX #3
.1     LDA EXP.VALUE,X   STORE IT IN
       STA ORGN,X        LOCATION
       DEX               COUNTER
       BPL .1
       LDA DUMMY.FLAG    IF IN DUMMY SECTION, DON'T
       BMI RTS.1         ...IN DUMMY
NEW.TARGET
       JSR TFEND         END .TF IF DOING ONE
       LDA EXP.VALUE     STORE VALUE IN
       STA TRGT          TARGET ADDRESS
       LDA EXP.VALUE+1
       STA TRGT+1
RTS.1  RTS
*---------------------------------
*    .TA -- SET TARGET ADDRESS
*---------------------------------
PSTA   JSR EXPR.DEFINED  GET EXPR VALUE
       LDA EXP.VALUE+2
       ORA EXP.VALUE+3
       BEQ NEW.TARGET
       JMP RAER
*--------------------------------------
DIR1.PS	   		jsr GNNB
				bcs .9

				sta DLIM     			SAVE DELIMITER

				ldx #$ff
				ldy CHAR.PNTR

.1				inx
				lda WBUF,Y
				and #$7F
				beq .9

				iny
				cmp DLIM
				bne .1

				txa
				jsr EMIT

.2				jsr GNC
				jsr EMIT
				dex
				bne .2

				clc
				rts

.9				jmp ERBA2
*--------------------------------------
DIR1.EscChars	.AS "abefnrtv"
				.HS 5C27223F25			\'"?%
DIR1.EscChars.L	.EQ *-DIR1.EscChars
DIR1.EscCodes	.HS 07081B0C0A0D090B
				.HS 5C27223F25
*--------------------------------------
DIR1.CZ			jsr DIR1.CS
				jmp EMIT.ZERO

DIR1.CS	   		lda #0
				sec
				jmp DIR1.String
*--------------------------------------
*   .AT -- ASCII STRING WITH LAST BYTE FLAGGED
*   .AS -- ASCII STRING WITH ALL BYTES SAME
*   .AZ -- Same as .AS, but with 00 terminator byte.
*--------------------------------------
PSAZ			jsr PSAS
				jmp EMIT.ZERO

PSAT			lda #$80     			LAST BYTE HAS OPPOSITE BIT 7
				.HS 2C       			...SKIP OVER 2 BYTES

PSAS			lda #0       			ALL BYTES GET SAME BIT 7
				clc

DIR1.String		sta AT.HIBIT
				ror BYTE				C String Flag

				jsr GNNB     			Scan to next non-blank
				bcs .9	     			END OF LINE

				dec CHAR.PNTR     		BACK UP

.1  			jsr TRY.HEX.STRING
				beq .5       			...END OF LINE

				ldy #0
				sty AS.HIBIT 			...assume hibit is 0
				cmp #'-'      			1ST NON-BLANK A MINUS?
				bne .15     			...no, hibit is 0

				ror AS.HIBIT 			...yes, hibit is 1
				jsr GNC.UC

.15 			sta DLIM     			SAVE DELIMITER
				jsr GNC.UC  			GET NEXT CHAR
				bcs .9	    			END OF LINE IS BAD NEWS

				cmp DLIM     			CHK IF DELIMITER
				beq .4       			YES, NO STRING IN BETWEEN

.2  			jsr GNC.UC   			GET NEXT CHAR
				bcs .9	    			END OF LINE IS BAD NEWS

				cmp DLIM     			CHK IF DELIMITER
				beq .3       			YES, FINISH UP AND RETURN

				lda WBUF-2,Y 			...NO, GET PREVIOUS CHAR
				bit BYTE
				bpl .27

				cmp #'\'				"\?" ?
				bne .27

				jsr GNC.UC  			GET NEXT CHAR
				bcs .9	    			END OF LINE IS BAD NEWS

				lda WBUF-2,Y			get "?"
				ldx #DIR1.EscChars.L-1

.20				cmp DIR1.EscChars,x
				beq .21

				dex
				bpl .20
				bmi .9

.21				lda DIR1.EscCodes,x

				ldx WBUF-1,Y
				cpx DLIM
				beq .30

.27				ora AS.HIBIT 			MERGE WITH TOP BIT
				jsr EMIT
				jmp .2       			GO FOR ANOTHER ONE

.3  			lda WBUF-2,Y 			GET PREVIOUS CHAR

.30				ora AS.HIBIT 			MERGE WITH SELECTED BIT 7
				eor AT.HIBIT 			TOGGLE BIT 7 IF IN .AT
				jsr EMIT     			EMIT THE BYTE

.4  			jsr GNC      			CHECK IF MORE IN LIST
				beq .5

				cmp #','
				beq .1

.5  			rts

.9				jmp ERBA2
*---------------------------------
*	.HX -- HEX DIGIT STRING
*---------------------------------
PSHX			jsr GNNB     			GET NEXT NON-BLANK CHAR
				bcs ERBA2    			END OF LINE

				jsr BACKUP.CHAR.PNTR

.1				jsr PSHX.GetNibble
				bcs .8

.2				sta SYM.VALUE

				jsr PSHX.GetNibble
				bcs .7

				asl
				asl
				asl
				asl
				ora SYM.VALUE
				jsr EMIT
				jsr PSHX.GetNibble
				bcc .2
				
				clc
				rts

.7				lda SYM.VALUE
				jsr EMIT
				
.8				rts
*---------------------------------
PSHX.GetNibble
.1     			jsr GNC.UC   			IGNORE CASE
				beq .9

				cmp #'.'     			ALLOW PERIODS
				beq .1       			...BUT IGNORE THEM

				eor #$30
				cmp #$0A
				bcc .3       			...0-9, TEXT VALIDITY

				adc #$88     			...MIGHT BE A...F

.2     			cmp #$FA
				bcc .3       			NOT A-F EITHER, RETURN CARRY CLEAR

				and #$0F     			TRIM HEX A...F

.3				clc
				rts

.9     			sec
				rts
*---------------------------------
*   .HS -- HEX STRING
*---------------------------------
PSHS   			jsr GNNB     			GET NEXT NON-BLANK CHAR
				bcs ERBA2    			END OF LINE

				jsr BACKUP.CHAR.PNTR
				jsr TRY.HEX.STRING
				bne ERBA2   			...ERROR, BAD ADDRESS

				rts
*--------------------------------
THX1   			jsr HEX.DIGIT  			GET NEXT HEX DIGIT
				bcc ERBA2    			ERROR, ODD DIGITS

				lda SYM.VALUE    		GET CONVERTED VALUE
				jsr EMIT
*--------------------------------
TRY.HEX.STRING	jsr HEX.DIGIT
				bcs THX1

				lda CURRENT.CHAR
				beq .2       			...END OF LINE

				cmp #','     			IF COMMA, GO GET MORE BYTES
				beq TRY.HEX.STRING		...OKAY

				cmp #' '     			IF BLANK, VALID END OF STRING

.2     			rts
*--------------------------------
ERBA2  			jmp ERBA     			ERROR: BAD ADDRESS
GT255ERR 		ldy #QER8  				VALUE > 255 ERROR
				.HS 2C      			LONG "BIT" TO SKIP NEXT TWO BYTES
NOLBLERR 		ldy #QER1  				"NO LABEL"
				.HS 2C       			LONG "BIT" TO SKIP NEXT TWO BYTES
UNDF   			ldy #QER6     			"UNDEF"
				jmp SOFT.ERROR
*---------------------------------
*   .EQ -- EQUATE
*---------------------------------
PSEQ   LDY WBUF     SEE IF ANY LABEL
       CPY #$20
       BEQ NOLBLERR   NO LABEL ON LINE
       LDA STPNTR   SAVE STPNTR WHILE CALLING EXPR
       PHA
       LDA STPNTR+1
       PHA
       JSR EXPR.DEFINED  GET VALUE
       PLA          RESTORE STPNTR
       STA STPNTR+1
       PLA
       STA STPNTR
       LDA PASS       WHICH PASS
       BNE .5         PASS 2, PRINT VALUE
*---PASS 1:  DEFINE VALUE--------
       LDY WBUF     COLUMN 1 AGAIN
       CPY #':      PRIVATE LABEL?
       BCC .4       ...LOCAL LABEL
       BEQ .2       ...PRIVATE LABEL
*---NORMAL LABEL-----------------
       LDY #2
.1     LDA EXP.VALUE-2,Y   REDEFINE SYMBOL
       >SYM STA,PNTR
       INY
       CPY #6
       BCC .1
       RTS
*---PRIVATE LABEL----------------
.2     LDY #0
.3     LDA EXP.VALUE,Y
       >SYM STA,STPNTR
       INY
       CPY #4
       BCC .3
       RTS
*---LOCAL LABEL------------------
.4     LDY #2       COMPUTE LOCAL OFFSET
       SEC
       LDA EXP.VALUE
       >SYM SBC,STPNTR
       DEY
       >SYM STA,PNTR
       LDY #3
       LDA EXP.VALUE+1
       >SYM SBC,STPNTR
       BNE GT255ERR    VALUE > 255
       RTS         RETURN TO MAIN LEVEL OF ASM
*---PASS 2:  PRINT VALUE---------
.5     JMP P.EXP.VALUE.DASH
*---------------------------------
*   .DA -- DATA VALUE (8- OR 16-BITS)
*---------------------------------
PSDA   LDA #0       UNDEF FLAG FOR LINE
       PHA
.1     JSR GNNB     GET NEXT NON-BLANK CHAR
       BCS ERBA2    END OF LINE
       STA DLIM
*---Could be $$dstringd----------
       CMP #'$'     $$dstringd value?
       BNE .2       ...NO
       LDA WBUF,Y   Look for second $
       CMP #'$'
       BNE .25      ...NO, MUST BE SIMPLE HEX WORD
       JSR GNC      SKIP OVER SECOND '$'
       JSR PSAS     GET dstringd
       JMP .5
*---Look for size char-----------
.2     LDY #1       ASSUME 1-BYTE DATA
       CMP #'#'
       BEQ .3
       CMP #'/'
       BEQ .3
       LDY #3       ASSUME 3-BYTE DATA
       CMP #'<'     24-BIT SIGNAL
       BEQ .3       ...3-BYTE DATA
       INY          ASSUME 4-BYTE DATA
       CMP #'>'     32-BIT SIGNAL
       BEQ .3
*---Size is two bytes------------
.25    JSR BACKUP.CHAR.PNTR
       LDY #2       2-BYTE DATA
*---Get expression, emit value---
.3     STY ADDR.LENGTH
       JSR EXPR     CRACK EXPRESSION
       LDY DLIM     If preceded by /, shift over
       CPY #'/'
       BNE .4       ...NOT /
       JSR EXP.OVER.256
.4     JSR EMIT.VALUE  ACCORDING TO ADDR.LENGTH
*---Update UNDEF flag------------
       PLA          .DA'S UNDEF FLAG
       ORA EXP.UNDEF
       PHA
*---Next item in list------------
.5     JSR GNC.UC   LOOK FOR ANOTHER ITEM
       CMP #',      COMMA?
       BEQ .1       YES, GET ANOTHER ONE
       PLA          GET .DA'S UNDEF FLAG
       STA EXP.UNDEF     MERGED VALUE
       RTS          LIST LINE OR REPORT UNDEF ERROR
*--------------------------------
*      DO/ELSE/FIN
*--------------------------------
PSDO   JSR EXPR.DEFINED    GET VALUE
       LDX DO.INDEX        0 IF EMPTY, ELSE 1-63
       INX
       CPX #64
       BCC .2
       LDY #QERDO2  ".DO NEST TOO DEEP"
       JMP SOFT.ERROR
.2     LDA EXP.VALUE
       ORA EXP.VALUE+1  TEST FOR ZERO
       ORA EXP.VALUE+2
       ORA EXP.VALUE+3
       BEQ .3       ZERO, FALSE
       SEC          NONZERO, TRUE
.3     STX DO.INDEX
       LDX #-8
.4     ROR DO.STACK+8,X
       INX
       BNE .4
       RTS          LIST THE LINE
*--------------------------------
PSEL   LDX DO.INDEX
       BEQ ERR.DO   ERROR, NOT BTWN .DO AND .FIN
       LDA DO.STACK
       EOR #$80     TOGGLE CURRENT LOGIC LEVEL
       STA DO.STACK
       RTS         RETURN TO MAIN LEVEL OF ASM
*--------------------------------
ERR.DO LDY #QERDO   "MISSING .DO"
       JMP SOFT.ERROR
*--------------------------------
PSFI   LDX DO.INDEX
       BEQ ERR.DO   ERROR, NOT AFTER .DO
       DEC DO.INDEX POP THIS DO
       LDX #7
.1     ROL DO.STACK,X
       DEX
       BPL .1
       RTS         RETURN TO MAIN LEVEL OF ASM
*--------------------------------------
MAN
SAVE usr/src/scmasm.31/scmasm.s.dir1
LOAD usr/src/scmasm.31/scmasm.s
ASM