OpenSource
/
cbmsrc
mirror of https://github.com/mist64/cbmsrc.git
1
0
Fork 0
Code Issues Projects Releases Wiki Activity
Browse Source

added HCD65_3.5

pull/5/head
Michael Steil 4 years ago
parent
e9db39ea22
commit
d7a574819e
20 changed files with 7851 additions and 4 deletions
Whitespace
Show all changes Ignore whitespace when comparing lines Ignore changes in amount of whitespace Ignore changes in whitespace at EOL
Split View
Diff Options
Show Stats Download Patch File Download Diff File
  1. 154
      HCD65_3.5/byte.src
  2. 127
      HCD65_3.5/c65.src
  3. 386
      HCD65_3.5/directive.src
  4. 127
      HCD65_3.5/error.src
  5. 787
      HCD65_3.5/eval.src
  6. 83
      HCD65_3.5/global.src
  7. 275
      HCD65_3.5/ifendif.src
  8. 487
      HCD65_3.5/input.src
  9. 187
      HCD65_3.5/kernal.src
  10. 844
      HCD65_3.5/macro.src
  11. 168
      HCD65_3.5/macros.src
  12. 311
      HCD65_3.5/main.src
  13. 813
      HCD65_3.5/opcode.src
  14. 698
      HCD65_3.5/output.src
  15. 278
      HCD65_3.5/parse.src
  16. 791
      HCD65_3.5/symbol.src
  17. 821
      HCD65_3.5/util.src
  18. 504
      HCD65_3.5/xref.src
  19. 7
      README.md
  20. 7
      build.sh

154
HCD65_3.5/byte.src
Unescape View File

@ -0,0 +1,154 @@
;
directive_byte
directive_byt
lda #0
sta byte_cntr
;
byte_main_loop
ldy #$00
jsr byte_classify_this_char if dunno
beq 50$ go do up normal expression
and #%11001110 if white
bne 10$
jmp byte_exit normal exit
10$ and #%00000110 if comma or semi colon
bne 20$
jsr outerr_q ???
jmp byte_exit exit
20$ and #%00000100 if not single quote
bne byte_interpreter goto byte interpreter
;
ldy #0 look for terminating single quote
30$ iny
lda (args),y if not found
beq byte_interpreter go use interpreter
cmp #''
bne 30$
;
cpy #4 if too many chars for an expression
bcs byte_interpreter go use interpreter
; if next char is known terminetor
jsr byte_classify_next_char
bne byte_interpreter go use interpreter
;
50$ jsr byte_find_end_of_normal_expression
lda (args),y save (),y
pha
tya save .y
pha
lda #0 terminate the argument
sta (args),y
ldd args eval args ( eval complains if errors )
jsr eval
lda value spit the byte
jsr byte_spit_one
lda value+1 if >value <> 0
beq 70$
jsr outerr_v V error
70$ pla restore .y ,(),y
tay
pla
sta (args),y
jmp byte_terminator handle terminator
;
;
; .byte $00,';',$20,$09,',',$22,$27
; .byte $80,$40,$20,$10,$08,$04,$02
;
byte_terminator
jsr byte_classify_this_char if dunno
beq 90$ say what ?, exit
and #%01001110 if white or null
beq byte_exit exit
and #%01001000 if quotes
beq 80$ goto 80$
and #%00001000 if not be comma
beq 90$ go complain
;
20$ jsr byte_classify_next_char do read next
and #%11111000 if dunno or quotes
beq 80$ break
and #%11001000 if white
beq 20$ loop
jmp 90$ question , ; <null>
;
80$ ldd args reset args to point here
jsr effective_address
std args
jmp byte_main_loop goto main loop
;
90$ jsr outerr_f complain
jmp byte_exit exit
;
byte_interpreter
ldy #0
10$ iny
lda (args),y
beq 90$
;
ldx #0
cmp (args,x)
beq 30$
20$ jsr byte_spit_one
jmp 10$
;
30$ iny
cmp (args),y
beq 20$
;
jmp byte_terminator
;
90$ jsr outerr_b
;
byte_exit
lda byte_cntr
bne 10$
jsr outerr_q
;
10$ lda byte_cntr return number of bytes used
clc
rts
;
byte_spit_one ; .y preserved
tax
tya
pha
txa
ldy byte_cntr
jsr outbyte
pla
tay
inc byte_cntr
rts
;
byte_find_end_of_normal_expression
ldy #$ff start at the beginning, please...
10$ jsr byte_classify_next_char do classify next char
and #%11111010 if not terminitor, or if double quote
beq 10$ loop
and #%11111000 if not single quote
bne 20$ break
ldd args advance y based on range of singel quote
jsr range_of_single_quote
dey back up one char
jmp 10$
;
20$ and #%10001111 if space or semi colon
bne 30$
sta (args),y make null ( make terminator )
30$ rts return
;
;
byte_classify_next_char
iny
byte_classify_this_char
lda (args),y
byte_classify_char
jsr classify_char
and #%11111110 ; do not care about '='
rts
;
;
;

127
HCD65_3.5/c65.src
Unescape View File

@ -0,0 +1,127 @@
;***************************************************************************
; C65 ASSEMBLER FOR C128
;***************************************************************************
;
version .macro ; DECLARE FOR DATE OF MODIFICATIONS
.byte "V3t5"
.endm
;
; REV_LIST
;
; WHO WHEN WHAT
; --- ---- ----
; hcd 10/02/87
; V3.5 added bank0_ram_max to global definitions,
; integrated into init_macro.
; ( gives 16k additional macro expansion space )
;
; hcd 9/28/87 rewrote value_xyzzy which is really the integer divide
; V3.4 routine so that it was more clear, less brain damaged,
; less likely to hang, and hopefully now returns the
; correct result.
;
; hcd 7/27/87 1) corrected local labels so that leading zeros
; v3.3 are insignificant. This done in issymbollegal.
; 2) corrected bug where empty symbol table would
; make xref puke.
; 3) Caused xref and symbol table sort to be bypassed
; if no list channel or xref device. This saves
; time on object only assemblies.
;
; hcd 9/9/86 moved a page buffer from sprite buffers to basic run
; time stack to free sprite buffers for use with
; ramdisk.
;
; hcd 9/1/86 removed date string macro, and inserted version
; V3.0 string macro. This macro is tied to the
; listing format and the entry point which simply
; displayes the assemblers name and copyright message.
;
; hcd 8/15/86 removed code that disabled basic irqs, and
; simply caused interupts to be disabled over entire
; assembly process.
;
; moved error count to place where basic may PEEK it.
;
; made macro names case insenitive
; ( added TOUPPER call in directive_macro , and
; OPER_TOUPPER call in pass_a routine )
;
; added date declares for version tracking
;
; moved CURRENT_SYMBOL to zero page for speed/codespace
;
; modified parse_macro_args_for_expansion to use
; tildes per BSO operation.
;
; changed IS_SYMBOL_DEFINED ( affects .ifdef,.ifndef )
; to reply false for all symbols defined after
; the current line even though they are in the
; symbol table.
;
;***************************************************************************
;
curzpg = $0a ; start of zero page variables ( lots of em too )
zero_page_save_bot = $0a
zero_page_save_top = $8f
;
down_load_code_base = $0240 ; place for down loaded code
down_load_code_max = $02a2 ; first illegal down load addr
;
macro_args = $0B00 ; page_buffer in cassette buffer
storbuf = $0800 ; page buffer in basic run time stack
xref_buf = $0900 ; page buffer in basic run time stack
;
curram = $1300 ; start of normal ram variables
;
mmucr = $FF00 ; address of mmu cr register
mmucr_bank1_ram = %01111111 ; config for bank 1 ram only
mmucr_bank0_normal = %00001110 ; config for normal ops
; ( bank 0, kernal,io )
bank0_ram_max = $bfff ; highest address for bank0 ram
; ; with mmucr_bank0_normal
symbol_table_start = $1000 ; base of symbol table in bank 1
symbol_table_end = $FEFF ; end of symbol table in bank 1
;
code_start = $1700 ; code is in bit map & bit map color map
; ; and even below that ...
; its every where, its everywhere
.include macros
.include kernal
;
.blist
.include global
*=code_start
jmp init
jsr $ff7d ; primm....
.byte "(C)1986 COMMODORE ELECTRONICS, LTD.",cr
.byte "ALL RIGHTS RESERVED "
version
.byte cr,0
rts
;
.include main
.include util
.include parse
.include opcode
.include eval
.include error
.include directive
.include ifendif
.include macro
.include input
.include output
.include symbol
.include xref
;
.ifgt *-$4000
*** error *** code overlays start of basic
.endif
.ifgt curram-code_start
*** error *** allocated ram overlaps code
.endif
.ifgt curzpg-$90
*** error *** allocated zeropage overlaps kernal area
.endif
;
.end

386
HCD65_3.5/directive.src
Unescape View File

@ -0,0 +1,386 @@
.page
.subttl "Direcitves"
;
;
zpage directive_pntr,2
zpage directive_cntr,1
;
directive
ldi directive_text_base
std directive_pntr
jsr oper_toupper
;
lda #0
sta directive_cntr
;
10$ ldy #oper
ldd directive_pntr
jsr strcmp
beq 80$
;
inc directive_cntr
ldx #directive_pntr
jsr string_advance
;
ldy #0
lda (directive_pntr),y
bne 10$
jmp outerr_o
;
80$ lda directive_cntr
asl a
tax
lda directive_code+1,x
pha
lda directive_code,x
pha
rts
;
directive_code
.word directive_blist-1
.word directive_byte-1
.word directive_byt-1
.word directive_clist-1
.word directive_dbyte-1
.word directive_else-1
.word directive_end-1
.word directive_endif-1
.word directive_endm-1
.word directive_endr-1
.word directive_formln-1
.word directive_gen-1
.word directive_ifb-1
.word directive_ifdef-1
.word directive_ife-1
.word directive_ifge-1
.word directive_ifgt-1
.word directive_ifidn-1
.word directive_ifle-1
.word directive_iflt-1
.word directive_ifn-1
.word directive_ifnb-1
.word directive_ifndef-1
.word directive_ifnidn-1
.word directive_include-1
.word directive_irp-1
.word directive_irpc-1
.word directive_list-1
.word directive_local-1
.word directive_messg-1
.word directive_mlist-1
.word directive_nam-1
.word directive_name-1
.word directive_nclist-1
.word directive_nlist-1
.word directive_nmlist-1
.word directive_nogen-1
.word directive_page-1
.word directive_pag-1
.word directive_rept-1
.word directive_rmb-1
.word directive_ski-1
.word directive_skip-1
.word directive_space-1
.word directive_subttl-1
.word directive_word-1
.word directive_wor-1
;
text_macro ; this is not detected by directive
.byte '.MACRO',0 ; it is used elsewhere for trapping elsewhere
;
;
directive_text_base
.byte '.BLIST',0
.byte '.BYTE',0
.byte '.BYT',0
.byte '.CLIST',0
.byte '.DBYTE',0
text_else
.byte '.ELSE',0
.byte '.END',0
text_endif
.byte '.ENDIF',0
text_endm
.byte '.ENDM',0
text_endr
.byte '.ENDR',0
.byte '.FORMLN',0
.byte '.GEN',0
.byte '.IFB',0
.byte '.IFDEF',0
.byte '.IFE',0
.byte '.IFGE',0
.byte '.IFGT',0
.byte '.IFIDN',0
.byte '.IFLE',0
.byte '.IFLT',0
.byte '.IFN',0
.byte '.IFNB',0
.byte '.IFNDEF',0
.byte '.IFNIDN',0
.byte '.INCLUDE',0
text_irp
.byte '.IRP',0
text_irpc
.byte '.IRPC',0
.byte '.LIST',0
.byte '.LOCAL',0
.byte '.MESSG',0
.byte '.MLIST',0
.byte '.NAM',0
.byte '.NAME',0
.byte '.NCLIST',0
.byte '.NLIST',0
.byte '.NMLIST',0
.byte '.NOGEN',0
.byte '.PAGE',0
.byte '.PAG',0
text_rept
.byte '.REPT',0
.byte '.RMB',0
.byte '.SKI',0
.byte '.SKIP',0
.byte '.SPACE',0
.byte '.SUBTTL',0
.byte '.WORD',0
.byte '.WOR',0
.byte 0 ; terminate list
;
;
;******************************************************************************
; word directive
;******************************************************************************
;
;
directive_wor
directive_word
jsr comma_delimit_args delimit args
lda #0 cntr <= 0
sta directive_cntr
ldd args pntr <= args
std directive_pntr
;
;
10$ lda nargs while cntr <> nargs
cmp directive_cntr
beq 80$
;
ldd directive_pntr do eval the current arg
jsr eval
lda directive_cntr y <= 2*cntr
asl a
tay
ldd value output the value
jsr outword
ldx #directive_pntr advance one arg
jsr string_advance
inc directive_cntr inc counter
jmp 10$
;
80$ lda nargs return bytes used
asl a
clc
rts
;******************************************************************************
; word directive
;******************************************************************************
;
;
directive_dbyte
jsr comma_delimit_args delimit args
lda #0 cntr <= 0
sta directive_cntr
ldd args pntr <= args
std directive_pntr
;
;
10$ lda nargs while cntr <> nargs
cmp directive_cntr
beq 80$
;
ldd directive_pntr do eval the current arg
jsr eval
lda directive_cntr .a <= 2*cntr
asl a
pha save .a
tay .y <= .a
lda value+1 spit high order byte
jsr outbyte
pla .y <= stacked value + 1
tay
iny
lda value spit low order byte
jsr outbyte
;
ldx #directive_pntr advance one arg
jsr string_advance
inc directive_cntr inc counter
jmp 10$
;
80$ lda nargs return bytes used
asl a
clc
rts
;
;
;
;******************************************************************************
; include directive
;******************************************************************************
;
directive_include
jsr delimit_single_arg ; delimit the arg
bcc 10$ ; if error
jmp outerr_s syntax error,exit
10$ jsr open_error_channel_if_unique
jsr primm
.byte "INCLUDING ",0
ldd args
jsr print_null_terminated_string_cr
ldd args set file to (args)
jsr set_file
sec no bytes used
rts
;
;******************************************************************************
; .endm directive
; .endr directive
;******************************************************************************
;
directive_endm
directive_endr
jmp outerr_n
;
;******************************************************************************
; .formln directive
;******************************************************************************
;
directive_formln
jsr delimit_single_arg delimit_the_arg
bcs 90$ complain if no arg
ldd arg eval the arg
jsr eval
bcs 90$ complain if error
lda value+1 puke if value > 255
bne 90$
lda value if value <> 0 ( kill paging )
clc
adc #6 .a <= value+6
bcs 90$ puke if > 255
cmp #15
bcc 90$ puke if < 15
70$ sta formln stick to to formln
sec
rts
;
90$ jmp outerr_q
;
;
;******************************************************************************
; .messg directive
;******************************************************************************
directive_messg
bit pass
bpl 90$
jsr open_error_channel_if_unique
ldd arg
jsr print_null_terminated_string_cr
90$ sec
rts
;
;******************************************************************************
; .subttl directive
;******************************************************************************
directive_subttl
ldy #0 y <= 0
10$ lda (arg),y do subttl,y <= (arg),y
sta subttl,y if was null
beq 20$ break
iny y++
cpy #subttl_max_len-2 until y== max len for subttl - 2
bne 10$
lda #0 clear last byte of subttl
sta subttl,y
20$ sec return no bytes used
rts
;
;******************************************************************************
; .name directive
;******************************************************************************
directive_nam
directive_name
ldy #0 y <= 0
10$ lda (arg),y do name,y <= (arg),y
sta name,y
beq 20$ exit iff null
iny y++
cpy #name_max_len until y== max len for name
bne 10$
lda #0 clear last byte of name
sta name,y
20$ sec return no bytes used
rts
;
;******************************************************************************
; .rmb directive
;******************************************************************************
;
directive_rmb
jsr delimit_single_arg
bcs 90$ syntax if no args
ldd arg
jsr eval
bcs 90$ syntax if cannot eval ok
lda value+1
bne 80$ address error if > 255 bytes
lda value return number of bytes to reserve
clc return happy
rts
;
80$ jmp outerr_a
90$ jmp outerr_s
;
;******************************************************************************
; .end directive
;******************************************************************************
;
directive_end
bit pass
bpl 60$
;
jsr flush_list ; flush a list
jsr read_line ; read next line
bcs 80$ ; if ok
jsr primm_to_error_channel
.byte "ADDITIONAL INPUT AFTER END STATEMENT IGNORED",cr,0
;
60$ jsr read_line ; eat all remaining lines
bcc 60$
;
80$ dec end_flag ; end flag <= non-zero
sec ; return no bytes used
rts
;
;
;******************************************************************************
; .byte directive
;******************************************************************************
;
; byte is unique in the way it handles quotes.
; consequently here is a pile of software.
;
; basically quoted string must be delimited on both sides.
;
; normal expressions appearing in byte directives can only yeild
; a single byte.
;
;
ram byte_cntr
.include byte
;

127
HCD65_3.5/error.src
Unescape View File

@ -0,0 +1,127 @@
;
;
; A Address error. Address specified is out of range for
; given instruction. Relative branch out of bounds, etc.
; B Balance error. Unmatched delimiters
; C Character error. Indicates a character not in the
; supported subset for the assembler.
; D Macro definition error. Indicates macro definition which
; is missing the name of the macro, or one with too many
; dummy arguments specified. The entire macro definition
; (up to its matching .ENDM) is ignored.
; E Expression error. Invalid syntax in an expression,
; usually one of the following:
; (1) Missing last term
; (2) Division by zero.
; (3) Missing expression (blank field)
; F Format error. Probably a missing or incorrect field.
; J Warning that address space is filled. Location counter
; wrapped around from the last allowable address to 0, and
; a byte was deposited.
; L Erroneous use of a local symbol (i.e. with = or .MACRO).
; M Multiply-defined symbol. A symbol is defined more than
; once (where this is illegal). All but the first
; definition are ignored.
; N Nesting error. Mispaired .IF:.ENDIF, .MACRO:.ENDM, etc.
; This is an error which encompasses more than one line.
; Single-line delimiter pairing errors normally generate
; "B" errors. This error will also occur when include files
; exceed the maximum nesting level of five.
;
; O Undefined instruction mnemonic (opcode).
;
; P Phase error. Pass 2 value of symbol not equal to pass 1
; value of symbol. The pass 1 value prevails. This error
; code may also indicate an illegal forward reference, such
; as branch out of range, or an attempt to redefine a
; symbol which has already been referenced.
;
; Q Questionable syntax. Generally a warning which indicates
; a line is not entirely of proper syntax, and that the
; assembler has made some assumption about what the
; programmer intended. Often indicates improper
; delimiters, extra delimiters, or missing delimiters.
; This error code is also produced when an "EVEN" directive
; appears in a SECTION which has been defined as aligned
; only on a BYTE boundary. In such a case, the "EVEN"
; directive is ignored.
;
; S Invalid symbol. Use of the wrong type of user symbol in
; the wrong place (e.g. macro name used as part of a
; numeric expression, etc.). This error code will also
; flag all lines on which references appear to symbols that
; are multiply-defined in the program. While the latter
; does not strictly indicate an error condition, it is
; possible that changing one of the multiply defined symbol
; names might require changing lines which reference it;
; therefore, such lines are flagged by the assembler to
; facilitate locating them. This error can also occur when
; a forward reference to a redefined special symbol is
; made. In addition, any attempt to define a symbol whose
; name is the same as a section (segment) name will produce
; this error.
;
; U Undefined symbol. A symbol is referenced in an
; expression, but that symbol has no defined value. The
; assembler assumes the symbol to have a value of zero.
;
; V Value error. An operand value was out of range.
;
; W Wasted byte warning. Indicates that an extended address
; was generated because of a forward reference to a symbol
; appearing in the operand field. The assembled code will
; still work correctly, but a byte of memory may be wasted.
; This error can frequently be corrected by rearranging
; code in the source program.
;
; Y Assembler feature not implemented. The user has
; attempted to use an assembler directive or feature which
; is not implemented in the currently-running assembler.
; Also flags relocation-oriented directives used without /R
; in command string.
;
; * Too many errors detected on the source line to print all
; of the error codes for this line.
;
;
;
;
;
; SYSTEM ERRORS
;
; non_fatal
; could_not_open_source_file:xxx : ignored
; conditional_in_progress_at_eof
; macro_in_progress_at_eof
; macro_definition_at_eof
; too_many_source_files
;
; fatal
; insufficient_memory ( symbols work ok )
; could_not_open_output_file
; output_file_error
;
insufficient_memory
jsr error_fatal
.byte "INSUFFICIENT MEMORY",0
;
error_fatal
lda #$ff mark fatal error flag
sta fatal_error
jsr open_error_channel open up mr error
pla pull text address off of stack
tay y <= low order
pla x <= high order
tax
iny a <= y+1
tya
bne 10$ if .a == 0
inx x++
10$ jsr print_null_terminated_string_cr print (x,a)
jsr primm
.byte "CURRENT FILE = ",0
ldi file_name print the current file
jsr print_null_terminated_string_cr
sec return unhappy
rts
;

787
HCD65_3.5/eval.src
Unescape View File

@ -0,0 +1,787 @@
.page
.subttl "Expression Evaluation"
;
; 2.3.4 EXPRESSION OPERATORS
;
; The operators available for constructing expressions include both
; the unary and binary operators listed below:
;
;
; UNARY: + Identity
; - Negation
; > High byte
; < Low byte
; !N Logical one's complement
;
; BINARY: + Addition
; - Subtraction
; * Multiplication
; / Division. Any remainder is discarded.
; !. Logical AND
; !+ Logical OR
; !X Logical Exclusive OR
; !M modulus division
; ( returns remainder )
;
; Expressions will be evaluated according to the following operator
; precedence, and from left to right when of equal precedence:
;
;
; 1) Unary +, unary -, !N, <, >
; 2) *, /, !., !+, !X
; 3) Binary +, binary -
;
;
;
;
zpage eval_pntr,2 ; pointer for evaluation
; ram value,2 ; result location /* global */
; ram valflg ; result quality
zpage value2,2 ; temp result
;
ram binop_loc ; index to binary operator
ram plus_minus_loc ; index to binary plus or minus only
;
;******************************************************************************
; EVAL
;******************************************************************************
;
; eval evaluates strings into 16 bit values
;
; entry: x,a point to null terminated string
; exit: value = value
; c = 0 cool ( valflg = 0 )
; c = 1
; valflg = 1 forward reference
; valflg = 2 value undefined
; valflg = 4 value overflow (/0)
; valflg = 8 syntax error
;
eval std eval_pntr eval_pntr <= value
cld peace of mind
ldy #0 clear evaluation errors
sty valflg
jsr sub_eval eval the entire string
ldd value x,a <= value
ldy valflg y <= value quality flag
cpy #$1 set carry if not perfectly ok
bcc 90$ if undefined or syntax error
beq 90$
lda #$ff x,a <= -1
tax
std value value <= -1
90$ rts return
;
;
;
eval_syntax
jsr outerr_s
lda #value_syntax
bne eval_errset
;
eval_undefined
jsr outerr_u
lda #value_undefined
bne eval_errset
;
eval_overflow
jsr outerr_z
lda #value_overflow
bne eval_errset
;
eval_forward_reference
lda #value_forward
eval_errset
ora valflg
sta valflg
rts
;
;
;
; sub_eval
;
; examines the string looking for operators
; determines whether the string has
; a value, and any binary operators in it.
; passes control to eval_feature_check
;
sub_eval
ldy #0 y <= 0
sty binop_loc clear feature flags
sty plus_minus_loc
;
10$ lda (eval_pntr),y do if at EOS
beq eval_feature_check goto feature check
jsr unop_check if at a UNOP
bcs 20$
jsr skip_op skip it
jmp 10$ loop
;
20$ lda (eval_pntr),y if at the dreaded single quote
cmp #''
bne 40$
ldd eval_pntr
jsr range_of_single_quote eat the appropriate numberr of chars
jmp 45$ go look for EOS or binop
; if PC symbol
40$ cmp #'*
bne 48$
iny point to next char
45$ lda (eval_pntr),y
beq eval_feature_check exit if EOS
jsr binop_check if not binop
bcs 90$ syntax error
bcc 60$ else
;
48$ jsr binop_check if binop
bcc 90$ syntax error
;
50$ iny do read next char
lda (eval_pntr),y
beq eval_feature_check EOS -> check features
jsr plus_minus_check if plus minus
bcc 60$ go mark location
jsr binop_check until at a binop
bcs 50$
;
sty binop_loc mark location of binary operator
bcc 70$ skip next operation
;
60$ sty plus_minus_loc mark location of +/_
;
70$ jsr skip_op skip the operator
jmp 10$ go to start
;
90$ jmp eval_syntax
;
;
eval_feature_check
ldy plus_minus_loc if +/- found
beq 10$
jmp eval_split split evaluation aroung operater
10$ ldy binop_loc if binop found
beq evaL_unops
jmp eval_split split evaluation aroung operater
;
; the entire string has no binary operators in it
;
eval_unops
ldy #0 if not a unop at start of string
jsr unop_check
bcc 10$
jmp eval_value go eval as a straight value
;
10$ jsr skip_op point y pass the operator
ldd eval_pntr stack <= pntr
phd
tya point pntr past operator
clc
adc eval_pntr
sta eval_pntr
bne 20$
inc eval_pntr+1
20$ jsr eval_unops ( value <= value of whats left )
pld restore pntr
sta eval_pntr
;
;
;
ldy #0 .y <= opertor
lda (eval_pntr),y
tay
ldd value x,a <= value
cpy #'+ if +
beq 80$ go value <= xa
cpy #'- if -
beq 70$ go value = twos_comp(xa)
cpy #'> if >
beq 40$ go do high order only
cpy #'< if <
beq 50$ go do low order only
cpy #'! if escape
beq 30$ go invert xa ( assume NOT )
jmp eval_syntax
;
30$ jsr invert_xa
jmp 80$
;
40$ txa
50$ ldx #0
beq 80$
;
70$ jsr twos_complement_xa
80$ std value
clc
rts
;
;
invert_xa ; ones complement of xa
eor #$ff
pha
txa
eor #$ff
tax
pla
rts
;
absolute_value_xa ; absolute value of xa
cpx #$80
bcs twos_complement_xa
rts
;
twos_complement_xa ; twos_complement of xa
jsr invert_xa
inc_xa clc ; increment xa
adc #$01
bcc 10$
inx
10$ rts
;
;
;
;
; skip_op
; assuming y points to operator
; point y past operator
;
skip_op
jsr get_opr get the op
bcc 10$ if escape op
iny y++
10$ iny y++
rts return
;
;
; binop_check
; returns true if (eval_pntr),y points to binop
;
char_ok .macro %a
cmp #'%a
beq op_check_ok
.endm
;
binop_check
jsr get_opr get operator
bcs binop_escape_check if escape, use that routine
char_ok <*>
char_ok </>
bne plus_minus_check
;
binop_escape_check
char_ok <.>
char_ok <X>
char_ok <M>
bne plus_check
;
unop_check
jsr get_opr getr opr
bcs op_check_N if escape, go check for N only
char_ok <~<> ; ok if <
char_ok <~>> ; ok if >
plus_minus_check
char_ok <-> ok if -
plus_check
char_ok <+> ok if +
op_check_fail
sec
rts
;
op_check_N
char_ok <N> ok if N
op_check_ok
clc
rts
;
; get_opr
; gets operator at (eval_pntr),y
; returns
; .a = char
; .y = unchanged
; c=0 char was not escape
; c=1 char was escape ( returns the char, not the escape )
;
;
get_opr lda (eval_pntr),y
beq op_check_ok
cmp #'!
bne op_check_ok
iny
lda (eval_pntr),y
jsr toupper
dey
sec return c=1
rts
;
;
;
;
;
; eval_split
; entry: y points to first char of binary operator
;
; calls sub_eval to evaluate right and left hand sides
; of string past operator.
;
; then merges result per operator.
;
; exit: value = result
;
eval_split
tya save position
pha
jsr get_opr get opr
bcc 10$ if escape
iny point to real operator
10$ iny point to first char of left side of string
;
lda eval_pntr+1 stack eval_pntr, x,a <= eval_pntr
pha
tax
lda eval_pntr
pha
; eval_pntr += y
tya
clc
adc eval_pntr
sta eval_pntr
bcc 20$
inc eval_pntr+1
;
20$ jsr sub_eval ( right side in value )
;
pla recall pntr
sta eval_pntr
pla
sta eval_pntr+1
pla recall index to operator
tay
;
ldd value stack result
phd
lda (eval_pntr),y save operator on stack
pha
tya save index
pha
lda #0 operator <= null
sta (eval_pntr),y
;
jsr sub_eval ( left side in value)
;
pla recall index
tay
pla restore operator
sta (eval_pntr),y
pld recall right side value
std value2 value2 <= value for right side
;
;
;
; at this point:
; value contains result for right side of string
; value2 contains result for left hand side of string
; valflg set per possible errors
; eval_pntr,y points to operator
;
40$ jsr get_opr get operator
bcs 50$ if not escape operator
;
cmp #'+ if +
beq value_add
cmp #'- if -
beq value_sub
cmp #'* if *
beq value_mul
cmp #'/ if /
bne 90$
jmp value_divide
; go puke
;
50$ cmp #'+ if !+
beq value_or
cmp #'. if !.
beq value_and
cmp #'X if !X
beq value_xor
cmp #'M if !M
bne 90$
jmp value_modulus
;
90$ jmp eval_syntax
;
value_or
lda value2 value <= value or value2
ora value
sta value
lda value2+1
ora value+1
sta value+1
clc
rts
;
;
value_and
130$ lda value2 value <= value and value2
and value
sta value
lda value2+1
and value+1
sta value+1
clc
rts
;
value_xor
140$ lda value2 value <= value eor value2
eor value
sta value
lda value2+1
eor value+1
sta value+1
clc
rts
;
value_sub
sec
lda value
sbc value2
sta value
;
lda value+1
sbc value2+1
sta value+1
;
clc
rts
;
value_add
ldd value2
value_add_entry
clc
adc value
sta value
txa
adc value+1
sta value+1
clc
rts
;
; value_mul
;
value_mul
lda value+1 stack >value
pha
;
lda value .a <= <value
;
ldx #0 value <= 0
stx value
stx value+1
;
jsr 10$ do mul 8 bits in .a
pla recall high order value
;
;
;
10$ ldy #7 y <= 7
20$ lsr a do shift .a right
bcc 30$ if bit set
pha save .a
jsr value_add value <= value + value2
pla recall .a
30$ asl value2 shift value2 left one bit
rol value2+1
dey y <= y - 1
bpl 20$ until y < 0
rts return
;
;
;
; value_divide value_mod
;
ram quo,2
ram divide_sign
;
;
; quo = result
;
; modulus operations: |value| MOD |value2|
; sign of result = sign of divedend ( hp16C )
;
;
;
value_modulus
lda value2+1 y <= 0 + sign bit of value2
asl a
lda #0
rol a
tay
sec sec
bcs value_divide_entry
;
value_divide
clc clc
ldy #0 y <= 0
;
value_divide_entry
php save desired result ( value or mod )
;
ldd value divend <= abs(value)
bpl 10$
;
jsr twos_complement_xa
iny
10$ std value
;
ldd value2 divsor <= abs(value2)
bpl 20$
jsr twos_complement_xa
iny
20$ std value2
;
sty divide_sign lsb divide_sign is desired result sign
;
jsr eval_divide_unsigned
;
plp carry <= save desired result flag
;
50$ ldd quo xa <= quotient
bcc 60$ if really wanted MOD
ldd value xa <= whats left
;
60$ lsr divide_sign if result should be minus
bcc 70$
jsr twos_complement_xa
70$ std value save result
clc return happy
rts
;
; value_shift value_mul_10
;
;
value_shift_4
jsr value_shift_2
value_shift_2
jsr value_shift
value_shift
asl value
rol value+1
rts
;
value_mul_10
jsr value_shift
ldd value
jsr value_shift_2
jmp value_add_entry
;
;
;***********************************************************************
; eval_value
;***********************************************************************
;
; eval_value evaluate string at (eval_pntr) for value only
;
eval_value
ldy #0 y <= 0
sty value value <= 0
sty value+1
lda (eval_pntr),y a <= first_char
cmp #'$ if $
beq eval_hex go eval_hex
cmp #'% if %
beq eval_binary go eval_binary
jsr isdigit if (0-9)
bcc eval_decimal_local eval as decimal or local_label
;
cmp #'' if DREADED SINGLE QUOTE
bne 10$
jmp eval_literal eval as a literal string
;
10$ cmp #'* if its the damn star
bne 20$
ldy #1 if next char null
lda (eval_pntr),y
bne 90$
ldd pc value <= pc
std value
rts return
;
90$ jmp eval_syntax syntax error
;
20$ cmp #'@ if @
beq eval_octal go eval as octal thinging
ldd eval_pntr
jmp eval_symbol evaluate as symbol
;
eval_binary
iny get next char
lda (eval_pntr),y if done
bne 10$
clc retunr happy
rts
10$ lsr a if not binaary digit
eor #$18
beq 20$
jmp eval_syntax complain about syntax
20$ php
jsr value_shift
plp
bcc 30$
inc value
30$ jmp eval_binary go for another digit
;
;
eval_hex
iny point to next digit
lda (eval_pntr),y if null
bne 10$
clc return happy
rts
;
10$ jsr ishex if not hex
bcc 20$
jmp eval_syntax syntax error, return
;
20$ jsr value_shift_4 shift value left one nybble
;
lda (eval_pntr),y recall digit
jsr isdigit convert to binary value
bcc 50$
sbc #'A'-$a
50$ and #$0f
jsr add_to_value
jmp eval_hex go try another digit
;
;
;
;
eval_decimal_local
lda (eval_pntr),y
beq 80$
jsr isdigit
bcc 20$
;
cmp #'$
bne 90$
ldd eval_pntr
jmp eval_symbol
;
90$ jmp eval_syntax
;
20$ jsr value_mul_10
lda (eval_pntr),y
and #$0f
jsr add_to_value
iny
bne eval_decimal_local
;
80$ clc
rts
;
;
eval_octal
iny point to next digit
lda (eval_pntr),y if null
bne 10$
clc return happy
rts
;
10$ cmp #'8 if not 0-7
bcs 19$
cmp #'0
bcs 20$
19$ jmp eval_syntax syntax error, return
;
20$ jsr value_shift shift value 3 bits ( ho hum )
jsr value_shift_2
;
lda (eval_pntr),y recall digit
and #%00000111 mask to true value
jsr add_to_value add the sucker in
jmp eval_octal go try another digit
;
;
add_to_value
clc
adc value
sta value
bcc 10$
inc value+1
10$ rts
;
; eval_literal
; entry: value == 0
; eval_pntr points to string
; first char is a single quote
;
; exit: value = value of char ( 1 or 2 )
; syntax error emitted if misterminated
;
eval_literal
ldy #0 find out what is involved
ldd eval_pntr
jsr range_of_single_quote
bcs 90$ if honky dory
lda (eval_pntr),y if terminated by a null
bne 90$
;
ldy #1 value <= first char in string
lda (eval_pntr),y
sta value
iny .a <= next char in string
lda (eval_pntr),y
beq 80$ if not null
cmp #'' if not single quote
beq 80$
ldx value value+1 <= value
stx value+1
sta value value <= next char
80$ clc return happy
rts
90$ jmp eval_syntax syntax error
;
;
;
; divend = value
; quo = uninitilized
; divsor,divend = positive twos complement numbers
;
eval_divide_unsigned
lda value2 if divsor is zero
ora value2+1
bne 1$
jmp eval_overflow puke
;
1$ ldy #0 y <= 0
sty quo quo <= 0
sty quo+1
;
10$ asl value2 do shift left divsor
rol value2+1
iny y++
bcc 10$ while c=0
;
.byte $24 skip next clc ( c=1 )
;
20$ clc do clc
ror value2+1 shift right divsor
ror value2
dey y--
bmi 80$ if < 0, then exit
;
asl quo shift quo left
rol quo+1
;
cmpdr value,value2,a if value >= value2
bcc 50$
jsr value_sub divend -= divsor
inc quo set low order bit of quo
;
50$ jmp 20$ loop
;
80$ rts return
;

83
HCD65_3.5/global.src
Unescape View File

@ -0,0 +1,83 @@
;
; basic program interface variables
;
* = curram
list_channel *=*+1 0,4,5 etc 4
error_channel *=*+1 0,4,5 etc 5
object_channel *=*+1 0,4-30 6
;
input_device_low *=*+1 8-11 8,9,10,11
input_device_high *=*+1 8-11
;
xref_device *=*+1 0,8,9,10,11 12
xref_channel = 14
list_channel_width *=*+1 = 40,80,132 13
;
start_file_name *=*+17 ( null terminated string )
date_string *=*+33 ( null terminated string )
error_count *=*+2 ; return error count to basic
;
curram = *
;
; internal global variables.
;
zpage label,2 ; pointer to label strint
zpage oper,2 ; pointer to operand string
zpage arg,2 ; pointer to argument string
args = arg
zpage nargs ; number of arguments found
;
;
zpage pass ; pass 1 or pass 2 ?
zpage current_line,2 ; 16 bit current line number
zpage pc,2 ; 16 bit current pc value
zpage value,2 ; 16 evaluation value
ram valflg,1 ; quality of value
;
zpage list_line_count ; current line on page
ram page_number,2 ; current page number
ram conditional_depth ; depth of nested conditionals
ram macro_expansion_depth ; depth of macro expansions
ram formln ; number of lines per page
ram fatal_error ; caused by read errors, etc
ram end_flag
ram mid_line_pntr,2 ; pointer to midline string
; ( see list_page_header )
;
line_max_len = 250
ram line,line_max_len+1 ; input line
subttl_max_len = 132
ram subttl,subttl_max_len+1 ; sub title for various pages
name_max_len = 16 ; users name for program....
ram name,name_max_len+1 ; plus the trailing null
;
zpage bank1_pntr,2 ; pointer for bank 1 indirection
;
;
value_ok = %00000000 ; value ok
value_forward = %00000001 ; value forward reference
value_overflow = %00000010 ; value overflowed during calulations
value_undefined = %00000100 ; value is undefined
value_syntax = %00001000 ; evaluation syntax error
;
cr = 13
lf = 10
form_feed = 12
tab = 9
space = 32
;
global_init .macro
lda #66 ; formln
sta formln
ldi $0000
std current_line ; input source line
std error_count ; error counter
std pc ; pc
sta conditional_depth ; depth counter
sta macro_expansion_depth ; depth counter
sta subttl ; subttl
sta file_name ; filename
sta end_flag ; flag to indicate end statement
.endm
;
;

275
HCD65_3.5/ifendif.src
Unescape View File

@ -0,0 +1,275 @@
;
;
;***************************************************************************
; directive_ife
;***************************************************************************
directive_ife
jsr numeric_conditional_eval eval
bcs false_conditional false iff error
lda value if value <> 0
ora value+1
bne false_conditional false
beq true_conditional go true
;
;***************************************************************************
; directive_ifn
;***************************************************************************
directive_ifn
jsr numeric_conditional_eval eval
bcs false_conditional flase iff error
lda value if == 0
ora value+1
beq false_conditional false
bne true_conditional true
;
;***************************************************************************
; directive_ifge
;***************************************************************************
directive_ifge
jsr numeric_conditional_eval eval
bcs false_conditional false iff error
lda value+1 if < 0
bmi false_conditional false
bpl true_conditional true
;
;***************************************************************************
; directive_ifgt
;***************************************************************************
directive_ifgt
jsr numeric_conditional_eval eval
bcs false_conditional false iff error
lda value+1 if < 0
bmi false_conditional false
ora value if == 0
beq false_conditional false
bne true_conditional true
;
;***************************************************************************
; directive_ifle
;***************************************************************************
directive_ifle
jsr numeric_conditional_eval eval
bcs false_conditional false iff error
lda value+1 if < 0
bmi true_conditional true
ora value if <> 0
bne false_conditional false
beq true_conditional true
;
;***************************************************************************
; directive_iflt
;***************************************************************************
directive_iflt
jsr numeric_conditional_eval eval
bcs false_conditional false iff error
lda value+1 if >= 0
bpl false_conditional false
; bmi true_conditional true
;
true_conditional
jmp true_1
;
false_conditional
jmp false_1
;
;
;***************************************************************************
; directive_ifb
;***************************************************************************
;
directive_ifb
jsr macro_conditional_eval
lda nargs
beq true_conditional
ldy #0
lda (args),y
beq true_conditional
bne false_conditional
;
;***************************************************************************
; directive_ifnb
;***************************************************************************
;
directive_ifnb
jsr macro_conditional_eval
lda nargs
beq false_conditional
ldy #0
lda (args),y
beq false_conditional
bne true_conditional
;
;***************************************************************************
; directive_ifdef
;***************************************************************************
;
directive_ifdef
jsr macro_conditional_eval
lda nargs
beq false_conditional
ldd args
jsr is_symbol_defined
bcs false_conditional
bcc true_conditional
;
;***************************************************************************
; directive_ifndef
;***************************************************************************
directive_ifndef
jsr macro_conditional_eval
lda nargs
beq false_conditional
ldd args
jsr is_symbol_defined
bcc false_conditional
bcs true_conditional
;
;***************************************************************************
; directive_ifnidn
;***************************************************************************
directive_ifnidn
jsr macro_conditional_eval
ldx nargs
beq false_conditional
dex
beq true_conditional
jsr idn_check
bne true_conditional
beq false_conditional
;
;***************************************************************************
; directive_ifidn
;***************************************************************************
directive_ifidn
jsr macro_conditional_eval
ldx nargs
beq true_conditional
dex
beq false_conditional
jsr idn_check
beq true_conditional
bne false_conditional
;
idn_check
ldd args
phd
ldx #args
jsr string_advance
pld
ldy #args
jmp strcmp
;
;
;
macro_conditional_eval
inc conditional_depth
jsr macro_parse_args_for_expansion ; copies args to macro_args
ldi macro_args ; set argsto point to macro args
std args
rts
;
numeric_conditional_eval
inc conditional_depth
jsr comma_delimit_args
ldd args
jsr eval
php
ldd value
jsr list_equate
plp
rts
;
;
;;
;
;******************************************************************************
; .endif directive
;******************************************************************************
;
directive_endif
lda conditional_depth
bne 10$
jmp outerr_n
;
10$ dec conditional_depth
;
;****************************************************************************
; true conditional
;****************************************************************************
;
directive_if_list_check
true_1
;
lda list_enable_conditional
beq 20$
jsr un_set_list
20$ sec
rts
;
;******************************************************************************
; .else directive
;******************************************************************************
;
directive_else
lda conditional_depth
bne false_1
jmp outerr_n
;
;
;****************************************************************************
; false conditional
;****************************************************************************
;
ram embedded_conditional_count
;
false_1 jsr directive_if_list_check unlist if not to do that
lda #1
sta embedded_conditional_count
;
10$ jsr read_line do read a line
bcc 20$ if EOF
rts return sec ( no bytes used )
;
20$ ldi line send to lister
jsr set_list
;
jsr directive_if_list_check unlist if not to do that
;
30$ jsr delimit_label_oper delimit the operator
jsr oper_toupper force it to upper case
;
ldi text_endif if oper == ".ENDIF"
ldy #oper
jsr strcmp
bne 40$
; dec nest count
dec embedded_conditional_count
bne 10$ if <> 0
; loop
dec conditional_depth dec global endif count
sec return no bytes used
rts
;
40$ ldi text_else if oper == ".ELSE"
ldy #oper
jsr strcmp
bne 50$
lda embedded_conditional_count if nest count <> 1
cmp #1
bne 10$ loop
;
sec return no bytes used
rts
;
50$ ldi 200$ if oper doesn;t start with ".IF"
ldy #oper
jsr strstrt
bcs 10$ loop
;
inc embedded_conditional_count nest count++
jmp 10$
;
200$ .byte ".IF",0
;

487
HCD65_3.5/input.src
Unescape View File

@ -0,0 +1,487 @@
.page
.subttl "Input File Handlers"
;
;
; init_input intializes input software
;
; set_file sets software to filename pointed to by x,a
; ( pukes if too many files )
; attempts to open file
; compains if cannot be opened
;
; get_byte reaqds byte from current input (macro or file)
; reads a byte from the current input file.
; returns c=0 byte returned ( may close file id EOF )
; c=1 file was closed for some reason.
;
;
; the following global variables may be read-only referenced externally
;
; file_name text for the current filename.
; current_input_file
; indicates number of currently open files.
;
;
file_name_max = 12 ; 12 3456 789a b
ram file_name,file_name_max+14
;
input_file_max = 4
ram current_input_file
zpage file_name_pntr,2
;
zpage struct_pntr,2
;
; ram storbuf,256 globally declared as unusually located
zpage storbuf_temp ; zero page because of space
;
storbuf_len = storbuf
storbuf_type = storbuf+1
storbuf_struct_pntr = storbuf+3
storbuf_data = storbuf+5
storbuf_data_offset = 5
;
struct_type_macro = 0
struct_type_file_stat = 1
struct_type_file_name = 2
;
;
;
init_input
lda #0
sta current_input_file
lda #0
sta file_name
ldd input_pntr
std struct_pntr
rts
;
; set_file
; entry: x,a point to plane file name.
; oper: attempts to open the file.
; sets current_input_file to LFS for new file.
; checks disk stat to verify files open.
; returns:
; c=0 ok
; c=1 .a = error code.
;
;
set_file
std file_name_pntr ; save pointer to filename
lda current_input_file ;
cmp #input_file_max ; if > max number allowed
bcc 1$
jsr primm_to_error_channel
.byte "TOO MANY FILES :",0
ldd file_name_pntr
jsr print_null_terminated_string
sec ; return error
rts
;
1$ jsr push_file_name_struct ; push the old filename
lda #'0 ; mark beginning of our copy with "0:"
sta file_name
lda #':
sta file_name+1
;
ldy #0 ; copy file name to file_name buffer
10$ lda (file_name_pntr),y
sta file_name+2,y
beq 20$
iny
cpy #file_name_max ; only copy so many bytes....
bne 10$
lda #0 ; terminate with null
;
20$ sta file_name+2,y
;
ldi file_name ; point pntr to our copy of filename
std file_name_pntr
;
ldy #file_name_pntr ; if doesn't end with .src
ldi 100$
jsr strend
bcc 40$
;
ldi 100$ ; append ".src" to name
ldy #file_name_pntr
jsr str_append
bcs 90$
;
40$ ldi 110$ ; append ",s,r" to name
ldy #file_name_pntr
jsr str_append
bcs 90$
;
jsr open_file ; try to open
bcs 90$ ; puke if failure
;
jsr push_file_stat_struct ; push a filestat structure
clc ; return happy
rts
;
90$ jsr primm_to_error_channel tell user
.byte "CANNOT OPEN FILE:",0
ldi file_name
jsr print_null_terminated_string_cr
jmp close_input_file close the sonavabitch
;
100$ .byte ".SRC",0
110$ .byte ",S,R",0
;
;
;
; attempts to open file pointed to by file_name_pntr
; first on device 8 then 9 then 10 then 11
; if any succeeds return with c=0
; else return with c=1
; pukes if filename is 0 or >255 chars
;
ram open_file_unit
;
open_file
lda input_device_low device #8
sta open_file_unit
;
10$ ldd file_name_pntr do a <= len of string
jsr strlen
bcs 90$
tya
beq 90$
;
ldx file_name_pntr y,x <= address of name
ldy file_name_pntr+1
jsr setnam set the name
jsr 20$ try the open
bcc 80$ if ok then return
;
inc open_file_unit device number ++
lda input_device_high while device_number =< max device number
cmp open_file_unit
bcs 10$
90$ sec return unhappy
rts
;
;
20$ jsr _clrch ; clear channels
lda current_input_file ; setlfs
ora #$08
tay
ldx open_file_unit
jsr setlfs
lda #0 ; setbnk
tax
jsr setbnk
jsr open ; do open
;
bcs close_input_file ; if ok
;
ldx open_file_unit ; check disk for error
jsr dscheck ; check with disk
bcs close_input_file ; if ok
80$ clc
rts
;
;
close_input_file
jsr _clrch ; close the current input file
lda current_input_file
ora #$08
jsr close
sec
rts
;
;
;**************************************************************************
; disk status
;**************************************************************************
;dscheck read disk status on unit .x
; returns c=0 if ok
; else returns c=1
; .a = 0
ds_lfn = 15 logical file number for ds check
;
ram ds_temp,2
;
dscheck ; entry point for submit command
lda #ds_lfn
ldy #$6f
jsr setlfs
lda #0 set up for error channel read
jsr setnam
jsr open
bcs 90$
jsr readss
bmi 90$
ldx #ds_lfn
jsr _chkin
bcs 90$
jsr readss
bpl 10$
90$ jsr 80$ close the command channel
sec
rts
;
; set up for status line print
;
10$
;
lda #0
sta ds_temp
sta ds_temp+1
;
20$ jsr basin do read a char
cmp #cr if cr
beq 80$ quit
cmp #'0' if not '0'
beq 30$
ldx ds_temp if ds_temp < 2
cpx #2
bcs 30$
inc ds_temp+1 inc ds_temp+1
30$ inc ds_temp inc ds_temp
; jsr print print the char ( on command line )
jmp 20$ enddo
;
80$ lda #ds_lfn
jsr close
; jsr clear_to_eol blank rest of line
jsr _clrch clear channels
lda ds_temp+1 return c=0 if ds_temp == 0
cmp #1
lda #0 .A = 0 ( null error ).
rts
;
;
;
;
;/*
;readline() line <= inputline
; return false if EOF
; also returns error.
;*/
;
ram read_line_byte_count
line_len_max = 100
;
read_line
;
incd current_line keep track of number of lines rea
;
ldx #$ff x <= -1
10$ inx do x++
12$ stx read_line_byte_count cntr <= x
jsr get_byte read a byte
ldx read_line_byte_count x <= cntr
bcs 90$ puke if error
;
cmp #cr if cr
beq 80$ go exit
cmp #tab if not tab
beq 20$
cmp #12 if form-feed
bne 18$
bit pass if pass2
bpl 10$
jsr top_of_form uh.. do it.
lda #12
18$ cmp #$20 if < $20
bcc 12$ ignore this char
;
20$ sta line,x store the char
cpx #line_len_max if no room for more
beq 12$ go read another
bne 10$ go inc xx and read
;
80$ lda fatal_error
bne get_all_bytes
lda #00
sta line,x
clc
rts
;
90$ jsr 80$
lda fatal_error if error is fatal.....................
bne get_all_bytes go empty the stacks
sec
rts
;
;
;
;
;
get_all_bytes_loop
jsr get_byte
get_all_bytes
cmpdr input_pntr,input_top_pntr,a
bcc get_all_bytes_loop
rts
;
;
;
ram last_byte ; byte for ensuring files end in <cr>
;
get_byte
cmpdr input_pntr,struct_pntr,y if not pointing to struct
beq 10$
jsr pull_byte pull byte from input stack
sta last_byte remember what it was
rts return
;
10$ jsr pull_struct pull the structure
bcc 20$
rts return error iff error
20$ lda storbuf_type if macro type
cmp #struct_type_macro
bne 30$
dec macro_expansion_depth dec macro expansion depth
jmp get_byte go get next byte
;
30$ cmp #struct_type_file_stat if file stat type
bne 40$
lda storbuf+storbuf_data_offset
sta open_file_unit
;
jsr push_file_stat_struct push struct back on stact
jsr read_bytes_from_file read more data ( pushed on stack )
bcc 38$ if error
jsr pull_struct pull struct back off again
lda #cr .a <= cr
cmp last_byte if last byte <> cr
beq 38$
clc return a cr,happy
rts
;
38$ jmp get_byte go see whats next
;
; must be filename structure
;
40$ ldy #$ff copy file name from structre to filename
50$ iny
lda storbuf_data,y
sta file_name,y
bne 50$
;
dec current_input_file back up a file
jmp get_byte go see whats next
;
;
;
;
;
;
;
read_bytes_from_file
lda #0 store buf temp <= 0
sta storbuf_temp
lda current_input_file open the channel
ora #$08
tax
jsr _chkin if not there, we must have closed..
bcc 10$
rts return error to sender
;
;
10$ jsr basin do read a byte
;
ldy storbuf_temp (storbuf+temp) <= .a
sta storbuf,y
inc storbuf_temp storbuf_temp++
jsr readss if status <> 0
beq 20$
and #%10111111 if more than EOI
bne 90$ go fatal
jsr _clrch clear channels
jsr close_input_file close the file
jmp 80$ go exit happy
20$ lda storbuf_temp while temp <> 254
cmp #254
bne 10$
;
80$ jsr _clrch clear channels
ldy storbuf_temp shove the bytes
jsr shove_y_bytes
clc return happy
rts
;
90$ jsr close_input_file forget we saw this file
jsr error_fatal fatal time
;
.byte "FATAL READ ERROR !!!",0
;
;
push_file_name_struct
ldy #$ff
10$ iny
lda file_name,y
sta storbuf+storbuf_data_offset,y
bne 10$
iny save all the bytes including null
inc current_input_file allow for next input file
lda #struct_type_file_name push the struct
jmp push_struct
;
push_macro_struct
inc macro_expansion_depth
lda #struct_type_macro
ldy #0
jmp push_struct
;
push_file_stat_struct
lda open_file_unit
sta storbuf+storbuf_data_offset
lda #struct_type_file_stat
ldy #1
jmp push_struct
;
push_struct
sta storbuf_type mark type
tya mark length
clc
adc #storbuf_data_offset
sta storbuf
sta storbuf_temp
ldd struct_pntr
std storbuf_struct_pntr
;
ldy storbuf_temp
jsr shove_y_bytes
;
ldd input_pntr struct_pntr <= input_pntr
std struct_pntr
clc
rts
;
pull_struct
ldx #0
10$ stx storbuf_temp
jsr pull_byte
bcc 20$ return error iff occurs
rts
20$ ldx storbuf_temp
sta storbuf,x
inx
cpx storbuf
bne 10$
ldd storbuf_struct_pntr
std struct_pntr
clc
rts
;
shove_y_bytes
sty storbuf_temp temp <= number of bytes to shove
;
10$ ldy storbuf_temp while temp <> 0
beq 80$
dey do temp <= y <= y-1
sty storbuf_temp
lda storbuf,y push( buffer,y )
jsr push_byte
jmp 10$
;
80$ clc return happy
rts

187
HCD65_3.5/kernal.src
Unescape View File

@ -0,0 +1,187 @@
.page
.subttl ed1 editor initialization & I/O routines (04/29/85)
;//////////////// E D I T O R J U M P T A B L E \\\\\\\\\\\\\\\\\
*=$c000
cint *=*+3 ;initialize editor & screen
disply *=*+3 ;display character in .a, color in .x
lp2 *=*+3 ;get a key from irq buffer into .a
loop5 *=*+3 ;get a chr from screen line into .a
k_print *=*+3 ;print character in .a
scrorg *=*+3 ;get size of current window (rows,cols) in .x, .y
scnkey *=*+3 ;scan keyboard subroutine
repeat *=*+3 ;repeat key logic & 'ckit2' to store decoded key
plot *=*+3 ;read or set (.c) cursor position in .x, .y
cursor *=*+3 ;move 8563 cursor subroutine
escape *=*+3 ;execute escape function using chr in .a
keyset *=*+3 ;redefine a programmable function key
irq *=*+3 ;irq entry
init80 *=*+3 ;initialize 80-column character set
swapper *=*+3 ;swap editor local variables (40/80 mode change)
window *=*+3 ;set top left or bottom right (.c) of window
.page
.subttl c/128 KERNAL JUMP TABLE (04/29/85)
;/////////////////// K E R N A L J U M P T A B L E \\\\\\\\\\\\\\\\\\\\
* = $ff80-57 ;new 'jmps' for c/128
spin_spout *=*+3 ;setup fast serial port for input or output
close_all *=*+3 ;close all logical files for a given device
c64mode *=*+3 ;reconfigure system as a c/64 (no return!)
dma_call *=*+3 ;initiate dma request to external ram expansion
boot_call *=*+3 ;boot load program from disk
phoenix *=*+3 ;call all function card's cold start routines
lkupla *=*+3 ;search tables for given la
lkupsa *=*+3 ;search tables for given sa
_swapper *=*+3 ;swap to alternate display device (editor)
dlchr *=*+3 ;init 80-col character ram (editor)
pfkey *=*+3 ;program function key (editor)
setbnk *=*+3 ;set bank for load/save/verify
get_cfg *=*+3 ;convert bank to mmu configuration
jsrfar *=*+3 ;JSR to any bank, RTS to calling bank
jmpfar *=*+3 ;JMP to any bank
indfet *=*+3 ;LDA (fetvec),Y from any bank
indsta *=*+3 ;STA (stavec),Y to any bank
indcmp *=*+3 ;CMP (cmpvec),Y to any bank
_primm *=*+3 ;print immediate (always JSR to this routine!)
.page
* = $ff80 ;conforms to c/64 jump table
sys_rev *=*+1 ;release number of kernal (318020-04 rev 07/10/85)
_cint *=*+3 ;init screen editor & display chips (editor)
ioinit *=*+3 ;init i/o devices (ports, timers, etc.)
ramtas *=*+3 ;initialize ram for system
restor *=*+3 ;restore vectors to initial system
vector *=*+3 ;change vectors for user
setmsg *=*+3 ;control o.s. messages
secnd *=*+3 ;send sa after listen
tksa *=*+3 ;send sa after talk
memtop *=*+3 ;set/read top of memory
membot *=*+3 ;set/read bottom of memory
key *=*+3 ;scan keyboard (editor)
settmo *=*+3 ;set timeout in ieee ?????????????????? unused ???????????
acptr *=*+3 ;handshake serial byte in
ciout *=*+3 ;handshake serial byte out
untlk *=*+3 ;send untalk out serial
unlsn *=*+3 ;send unlisten out serial
listn *=*+3 ;send listen out serial
talk *=*+3 ;send talk out serial
readss *=*+3 ;return i/o status byte
setlfs *=*+3 ;set la, fa, sa
setnam *=*+3 ;set length and fn adr
__open *=*+3 ;open logical file
__close *=*+3 ;close logical file
__chkin *=*+3 ;open channel in
__ckout *=*+3 ;open channel out
__clrch *=*+3 ;close i/o channel
basin *=*+3 ;input from channel
bsout *=*+3 ;output to channel
loadsp *=*+3 ;load from file
savesp *=*+3 ;save to file
settim *=*+3 ;set internal clock
rdtim *=*+3 ;read internal clock
stop *=*+3 ;scan stop key
getin *=*+3 ;get char from queue
clall *=*+3 ;clear all logical files (see close_all)
clock *=*+3 ;increment clock
_scrorg *=*+3 ;return current screen window size (editor)
_plot *=*+3 ;read/set x,y coord (editor)
iobase *=*+3 ;return i/o base
;
;
init_status = $0a04
;
;
.ifn 0
.page
.subttl c/128 BASIC JUMP TABLE (04/29/85)
;/////////////////// B A S I C J U M P T A B L E \\\\\\\\\\\\\\\\\\\\
;
*=$4000
basic_hard_reset *=*+3
basic_soft_reset *=*+3
basic_irq *=*+3
;
*=$af00
; Format Conversions
ayint *=*+3 ;convert f.p. to integer
givayf *=*+3 ;convert integer to f.p.
fout *=*+3 ;convert f.p. to ascii string
val_1 *=*+3 ;convert ascii string to f.p.
getadr *=*+3 ;convert f.p. to an address
floatc *=*+3 ;convert address to f.p.
; Math Functions
fsub *=*+3 ;MEM - FACC
fsubt *=*+3 ;ARG - FACC
fadd *=*+3 ;MEM + FACC
faddt *=*+3 ;ARG - FACC
fmult *=*+3 ;MEM * FACC
fmultt *=*+3 ;ARG * FACC
fdiv *=*+3 ;MEM / FACC
fdivt *=*+3 ;ARG / FACC
log *=*+3 ;compute natural log of FACC
int *=*+3 ;perform basic INT on FACC
sqr *=*+3 ;compute square root of FACC
negop *=*+3 ;negate FACC
fpwr *=*+3 ;raise ARG to the MEM power
fpwrt *=*+3 ;raise ARG to the FACC power
exp *=*+3 ;compute EXP of FACC
cos *=*+3 ;compute COS of FACC
sin *=*+3 ;compute SIN of FACC
tan *=*+3 ;compute TAN of FACC
atn *=*+3 ;compute ATN of FACC
round *=*+3 ;round FACC
abs *=*+3 ;absolute value of FACC
sign *=*+3 ;test sign of FACC
fcomp *=*+3 ;compare FACC with MEM
rnd_0 *=*+3 ;generate random f.p. number
; Movement
conupk *=*+3 ;move RAM MEM to ARG
romupk *=*+3 ;move ROM MEM to ARG
movfrm *=*+3 ;move RAM MEM to FACC
movfm *=*+3 ;move ROM MEM to FACC
movmf *=*+3 ;move FACC to MEM
movfa *=*+3 ;move ARG to FACC
movaf *=*+3 ;move FACC to ARG
optab *=*+3
drawln *=*+3
gplot *=*+3
cirsub *=*+3
run *=*+3
runc *=*+3
clear *=*+3
new *=*+3
lnkprg *=*+3
crunch *=*+3
fndlin *=*+3
newstt *=*+3
_eval *=*+3
frmevl *=*+3
run_a_program *=*+3
setexc *=*+3
linget *=*+3
garba2 *=*+3
execute_a_line *=*+3
.endif
.page
; basic ram variables
;
text_top = $1210
max_mem_0 =$1212
;

844
HCD65_3.5/macro.src
Unescape View File

@ -0,0 +1,844 @@
.page
.subttl "MACRO JUNKOLA"
;
;
; the macro storage area contains 2 things.
;
; macro definitions grow from the bottom of the
; storage area.
;
; the input stack grows from the top of the storage area.
; note that macros are expanded by pushing the expanded
; text back into the input stream.
;
; the input stack is also managed by the input moduale.
; all references to the stack by inpunt moudual
; are performed by PUSH_BYTE(),PULL_BYTE(), and
; input_pntr. Input_pntr is the pointer to the
; moving end of the input stack. it is merely used
; as an index. no external moduales may attempt to
; reference data in the stack except via the push and
; pull routines.
;
; the input moduale contains a routine called
; push_macro_struct which must be called before a macro
; is expanded into the input stream. this is
; to allow the input manager to communicate with the
; output manager information regarding the depth of
; of the macro expansion.
;
;
; macros are stored as groups of two null terminated strings.
; the first string is the macro name. the second string is the
; macro definiition. The macro definition is stored as a seris of
; <CR> terminated lines. line_feeds are ignored. charecters with the
; value from $e0 through $ff are used as arguement position indicators.
; the end of the macro store area is terminated by a NULL macro and
; is pointed too by the macro_expand_top pntr.
;
; note that while macros are being defined, the macro_top_pntr may
; not be correct. the only assurence is that macro_top_pntr
; if correct when the macro definition phase is ended
;
; the macro expansion routines will not store the .endm or the .endr
; in the macro expansion stream. Note that endm and endr are symnonyms
;
;
macro_subs_char = $e0
;
; these for pointers are the buffer limits for the macro storage area
;
zpage macro_base_pntr,2 (fixed)
zpage macro_end_pntr,2 (moving)
zpage input_pntr,2 (moving)
zpage input_top_pntr,2 (fixed)
;
; these two pointers are general purpose pointers
;
zpage macro_pntr_1,2
zpage macro_pntr_2,2
;
; this area holds macro arguments during expansion/compression
;
; ram macro_args,256 you put it where ??? the cassette buffer !?!
;
ram macro_directive_nest_count
;
ram macro_arg_cntr ; counter into arg list
zpage macro_arg_pntr,2 ; pointer into arg list
zpage macro_expansion_input,2 ; pointer into expansion area for
;
;
;
;
macro_init
ldd max_mem_0 ; x,a <= highest free address for basic
tay
bne 10$
dex
10$ dey
tya
cpi bank0_ram_max ; if > max "seeable" ram
bcc 20$
ldi bank0_ram_max x,a <= max seeable ram
;
20$ std input_top_pntr ; set up top of macro area here
std input_pntr
;
ldd text_top ; calc first free address after basic text
clc
adc #1
bne 30$
inx
30$ std macro_base_pntr ; point there
ldy #0 ; put a null there ( irpc,irp,rept need this )
tya
sta (macro_base_pntr),y
incd macro_base_pntr ; put our base one past there
ldd macro_base_pntr ; put endpntr at same place
std macro_end_pntr
;
cpd input_top_pntr ; if top < bot
bcc 80$
jmp insufficient_memory ; uh.. sorry about that null....
80$ rts
;
push_byte ; if pointers are equal
cmpdr macro_end_pntr,input_pntr,y
bcc 10$
jmp insufficient_memory
;
10$ ldy #0
sta (input_pntr),y
decd input_pntr input_pntr--
clc
rts
;
;
;
pull_byte ; if input_pntr >= end_pntr
cmpdr input_pntr,input_top_pntr,y
bcs 90$ ; go exit error
incd input_pntr ; input_pntr++
ldy #0 ; .a <= (input_pntr)
lda (input_pntr),y
clc
90$ rts
;
macro_store_append_byte
cmpdr input_pntr,macro_end_pntr,y
beq 90$
ldy #0
sta (macro_end_pntr),y
incd macro_end_pntr
clc
rts
;
90$ jmp insufficient_memory
;
delete_macro
;
; delete_macro
; entry: x,a point to name for macro
; exit: if macro was in macro store, it is removed.
;
;
jsr find_macro if macro can be found
bcs 80$
std macro_pntr_2 pntr2 <= pointer to name
std macro_pntr_1 pntr1 <= pointer to next macro
ldx #macro_pntr_1
jsr next_macro
10$ cmpdr macro_pntr_1,macro_end_pntr,x
bcs 20$ while pntr_1 < macro_end_pntr
ldy #0 do (macro_pntr_2++) <= (macro_pntr_1++)
lda (macro_pntr_1),y
sta (macro_pntr_2),y
incd macro_pntr_1
incd macro_pntr_2
jmp 10$
;
20$ ldd macro_pntr_2 macro_end_pntr <= macro_pntr_2
std macro_end_pntr
;
80$ clc return happy
rts
;
;
; next_macro
; .x is zero page address of pointer to macro definition
; advances macro_pntr to point to next macro definition
; ( by advanccing by 2 null terminated string )
; next_macro_string
; .x is zero page pntr to macro definition
; advances macro_pntr to point to next string in macro store.
;
next_macro
jsr next_macro_string
next_macro_string
jmp string_advance
;
;
;
;*******************************************************************************
; FIND_MACRO
;*******************************************************************************
;
; find_macro
; entry: x,a point to alleged macro name
; exit: c=0: macro name found.
; x,a point to macro definition.
; c=1: macro name not found
; x,a point to end of macro store.
find_macro
std macro_pntr_2 store address of macro name
ldd macro_base_pntr set pointer to start of macro store
std macro_pntr_1
;
10$ ldd macro_pntr_1 do if at end of macro definitions
cpd macro_end_pntr
bne 20$
sec return pointer to end of def
rts
;
20$ ldy #macro_pntr_2 compare string at pntr with name
jsr strcmp_toupper ( ignore case of users string )
bcs 30$ if equal
ldd macro_pntr_1 x,a <= pointer to macro name
clc c=0
rts return
;
30$ ldx #macro_pntr_1 point to next macro
jsr next_macro
jmp 10$ loop forever
;
;
;
;
; directive_macro
; entry: (label) = name of macro to be defined
; args: points to arguement list
;
; defines macro with name == (label)
; also processes args while storing macro
; stores the .endm as part of the macro.
; ( this is used to change the macro nest count during
; macro expansion ).
;
;
directive_macro
ldd label if macro defined with same name
jsr delete_macro delete it
;
; copy name of macro into store
;
ldd label pntr_2 <= label addresss
std macro_pntr_2
;
10$ ldy #0 do a <= (pntr_2++)
lda (macro_pntr_2),y
incd macro_pntr_2
pha save .a
jsr toupper store name in upper case only
jsr macro_store_append_byte append this byte to macro store
pla recall .a
bne 10$ while .a <> 0
;
;
20$ jsr comma_delimit_args delimit args
lda nargs clip nargs to max allowed
cmp #$1f
bcc 30$
lda #$1f
30$ sta nargs
;
ldy #$FF y <= -1
ldx nargs x = number of args
;
beq 50$ if x <> 0
;
40$ iny do do y++
lda (args),y macro_args <= (args)
sta macro_args,y
bne 40$ until null copyied
dex x--
bne 40$ until x==0
;
; at this point:
; if the macro was previously defined
; the macro definition was deleted
; the macro name has been appended to the end of the macro store.
; the end of the macro store now points to the position where the
; the macro definition should be written
;
; macro_args is pointing to a seris of null terminated
; dummy arguments which are to mark the substitution areas
; within the macro.
;
50$ jmp store_macro go store the macro
;
;
; store_macro
; entry: nargs = number of argumenets for macro definitnon
; macro_args =
; seris of null terminated macro args
; read_line points to first line of macro.
;
; operation: lines are read in, compressed,
; and checked for the macro directives.
; they are stored until the correct unested
; endm or endr is detected.
; THIS ONLY STORES A DEFINITION.
;
store_macro
lda #1 nest count <= 1
sta macro_directive_nest_count
;
10$ jsr read_line do read a line of text into line
bcc 12$
;
jsr primm_to_error_channel
.byte "MACRO DEFINITION IN PROGRESS AT EOF",cr,0
sec
rts
;
12$ ldi line
jsr set_list list line to output
;
jsr macro_compress_line compress the line
;
; save current end of macro store
ldd macro_end_pntr
phd
;
ldi line point to start of line
std macro_pntr_1
;
20$ ldy #0 while (pntr) <> '0'
lda (macro_pntr_1),y
beq 30$ do append byte to macro store
jsr macro_store_append_byte
incd macro_pntr_1 point to next byte
jmp 20$
;
30$ lda #cr append a cr at end of line
jsr macro_store_append_byte
;
jsr delimit_label_oper delimit the operator on the saved line
;
jsr oper_toupper force operator to upper case
;
inc macro_directive_nest_count
;
ldi text_macro if oper = .macro,.irp,.irpc or .rept
ldy #oper
jsr strcmp
beq 80$
ldi text_irp
ldy #oper
jsr strcmp
beq 80$
ldi text_irpc
ldy #oper
jsr strcmp
beq 80$
ldi text_rept
ldy #oper
jsr strcmp
beq 80$ goto 60$
;
dec macro_directive_nest_count
dec macro_directive_nest_count
;
ldi text_endr if oper == .endr or .endm
ldy #oper
jsr strcmp
beq 80$ goto 70$
ldi text_endm
ldy #oper
jsr strcmp
beq 80$
;
inc macro_directive_nest_count
;
;
80$ pld recall_end_of_storage before this line
; while nest_count <) 0
ldy macro_directive_nest_count
beq 88$
jmp 10$
; terminate storage before this line
88$ std macro_end_pntr
lda #0 terminate macro with null
jmp macro_store_append_byte
;
;
;
; macro_compress_line
; entry: macro_args has arglist for psuedo args.
; line has a line of text for compression
; nargs is set.
;
;
; nargs number of argumants in the arg list
; macro_arg_pntr pointer into arg list
; macro_arg_cntr counter into arg list
;
macro_input_pntr = macro_pntr_1
macro_output_pntr = macro_pntr_2
;
macro_compress_line
ldi line input <= output <= line
std macro_input_pntr
std macro_output_pntr
;
10$ ldy #0
lda (macro_input_pntr),y while (input_pntr) <> null
beq 80$
;
jsr macro_find_arg do if can find the arg
bcc 30$ .a <= subs char,.y = len of arg
; else
ldy #0 .a <= input char
lda (macro_input_pntr),y
iny .y = 1
;
30$ pha save char
;
ldd macro_input_pntr advance input by number of args
jsr effective_address
std macro_input_pntr
;
pla recall char
ldy #0 write at output location
sta (macro_output_pntr),y
;
incd macro_output_pntr incd output pntr
jmp 10$
;
80$ lda #0 terminate output string
tay
sta (macro_output_pntr),y
clc return
rts
;
; macro_find_arg
; entry: nargs = number of args
; macro_args = list of macro_args
; macro_input_pntr = pointer to string to check
; exit: c=1 argument not found
; c=0 argument found
; .a = subs char to use of arg
; .y = length of arg
;
macro_find_arg
lda #0 if no args
cmp nargs
bcc 10$
rts return c=1
;
10$ ldi macro_args pntr <= start of args
std macro_arg_pntr
;
lda #0 cntr == 0
sta macro_arg_cntr
;
20$ ldy #0 do if (pntr) not null
lda (macro_arg_pntr),y
beq 30$
;
ldd macro_arg_pntr if (pntr) matches
ldy #macro_input_pntr
jsr strstrt
bcs 30$
;
ldd macro_arg_pntr y <= length of arg
jsr strlen
lda macro_arg_cntr a <= subs char to use
ora #macro_subs_char
clc reurtn happy
rts
;
30$ ldx #macro_arg_pntr advance arg pntr
jsr string_advance
inc macro_arg_cntr inc counter
lda macro_arg_cntr until cntrr == nargs
cmp nargs
bne 20$
sec
rts
;
;
;
;
;
; eval_macro
;
; checks oper to see if it is a macro
; if so it expands the macro
; by shoving it back into the input stream.
;
eval_macro
ldd oper if (oper) is not macro
jsr find_macro
bcc 1$
rts return c=1
;
1$ std macro_expansion_input save input source
jsr push_macro_struct inform input manager
;
jsr list_macro_call
jsr macro_parse_args_for_expansion
ldi macro_args pntr <= @macro_args
std macro_arg_pntr
; point to definition
ldx #macro_expansion_input
jsr string_advance
ldd macro_expansion_input x,a <= pointer to defitnion
jmp expand_macro go expand the bugger
;
;
;
;
rept_pntr = directive_pntr
;
;
directive_rept
jsr macro_parse_args_for_expansion
lda nargs save number of args
pha
lda #0 mark number of args as 0
sta nargs
;
ldd macro_end_pntr save current end of definitions
std rept_pntr
;
jsr store_macro store the new definition
jsr push_macro_struct inform input manager
;
pla if args
beq 10$
ldi macro_args evaluate the repeat count
jsr eval
bcs 10$ if value perfect
lda valflg
beq 20$ goto 20
10$ jsr outerr_v complain
lda #0
tax value <= 0
std value
;
20$ lda value while value <> 0
ora value+1
beq 50$
30$ ldd rept_pntr do expand the definition
jsr expand_macro
decd value value--
jmp 20$
;
50$ ldd rept_pntr delete the final defitnion by marking endpntr
std macro_end_pntr
lda #0 return zero bytes used
clc
rts
;
;
;
;
directive_irpc
ldd macro_end_pntr save current end of definitions
std rept_pntr
;
jsr macro_parse_args_for_expansion
lda nargs save number of args
pha
lda #1 mark number of args as 1
sta nargs
;
;
jsr store_macro store the new definition
jsr push_macro_struct inform input manager
;
pla if not exactly two args
cmp #2
beq 10$
jsr outerr_s complain about syntax
jmp 80$ go clean up and exit
;
10$ lda #1 nargs <= 1
sta nargs
;
ldi macro_args arg_pntr <=pointer to null at end
std macro_arg_pntr of expansion string
ldx #macro_arg_pntr
jsr string_advance
jsr string_advance
decd macro_arg_pntr
;
20$ ldy #0 do terminate arg at (macro_arg_pntr)
lda #0
sta (macro_arg_pntr),y
dec macro_arg_pntr back up a char
lda (macro_arg_pntr),y if at null
beq 80$ break
ldd rept_pntr expand the definition with this arg
jsr expand_macro
jmp 20$
;
;
80$ ldd rept_pntr delete the final defitnion by marking endpntr
std macro_end_pntr
lda #0 return zero bytes used
clc
rts
;
;
;
;
directive_irp
ldd macro_end_pntr save current end of definitions
std rept_pntr
;
jsr macro_parse_args_for_expansion
lda nargs save number of args
pha
lda #1 mark number of args as 1
sta nargs
;
jsr store_macro store the new definition
jsr push_macro_struct inform input manager
;
pla nargs <= recall number of args
sta nargs
cmp #2 if < 2 args
bcs 10$
jsr outerr_s complain about syntax
jmp 80$ go clean up and exit
;
;
10$ dec nargs do args--
lda nargs save number of args on stack
pha
;
ldi macro_args arg_pntr <= base of args
std macro_arg_pntr
;
20$ ldx #macro_arg_pntr do arg_pntr <= address of next arg
jsr string_advance
dec nargs while (--nargs)<>0
bne 20$
;
70$ lda #1 nargs <= 1
sta nargs
ldd rept_pntr expand the definition with this arg
jsr expand_macro
pla restore nargs from stack
sta nargs
cmp #1 until nargs == 1
bne 10$
;
;
80$ ldd rept_pntr delete the final defitnion by marking endpntr
std macro_end_pntr
lda #0 return zero bytes used
clc
rts
;
;
;
; expand_macro
;
; entry: x,a points to start of macro definition
; macro_arg_pntr
; points to seris of null terminated macro args.
; nargs contains the number of args in macro_args.
;
; operation:
; expands macro definition into input stream.
; does not inform input of operation.
;
;
expand_macro
std macro_expansion_input
ldx #macro_expansion_input
jsr string_advance
decd macro_expansion_input
;
; do point to previous char
10$ decd macro_expansion_input
ldy #0 if null
lda (macro_expansion_input),y
beq 80$ go exit
;
cmp #macro_subs_char if not a macro expand token
bcs 20$
jsr push_byte push the byte
jmp 10$ loop
;
20$ and #255-macro_subs_char a <= index value of token
;
cmp nargs if >= nargs
bcs 10$ loop ( null expansion )
;
tax .x <= index value + 1
inx
ldy #$ff y <= -1
;
; do
30$ iny do .a <= (args),++y
lda (macro_arg_pntr),y
bne 30$ until .y = 0
dex x--
bne 30$ while x <> 0
;
tya if y==0
beq 10$ loop ( null first record )
;
dey
sty macro_arg_cntr cntr <= y - 1
;
50$ ldy macro_arg_cntr do
lda (macro_arg_pntr),y if (arg_pntr,cntr) == 0
beq 70$ break
jsr push_byte push (arg_pntr,cntr)
ldy macro_arg_cntr if cntr == 0
beq 70$ break
dec macro_arg_cntr cntr--
jmp 50$ loop
;
70$ jmp 10$ loop
;
80$ clc
rts
;
;
;
; macro_parse_args_for_expansion
;
; copies ares from args ( default location ) to
; macro_args ( needed to expand the macro ).
;
; on the way, args are delimited with spaces, and counted via nargs.
; the tilde charecter is used for a literal substitution char, and
; outside sets of angle brackets are used per BSO operation.
;
;
macro_parse_args_for_expansion
ldd args pntr1 <= address of args
std macro_pntr_1
ldi macro_args pntr2 <= address of our copy of args
std macro_pntr_2
lda #0 nargs <= 0
sta nargs
;
10$ ldy #0 do get a char
jsr mpafe_getc
beq 80$ quit if null
bcs 50$ if tilded, go get normal arg
jsr mpafe_space_check if space or semi colon
beq 80$ exit
;
cmp #'< if <
clc
bne 50$
;
inc nargs args ++
jsr mpafe_incd_pntr1 pntr1++
ldx #1 x <= 1
ldy #$ff y <= -1
20$ iny do y++
jsr mpafe_getc (pntr2) <= next char
sta (macro_pntr_2),y
bne 30$ if EOS
jsr outerr_b balance error
bcs 80$ go exit
; if tilded
30$ bcs 20$ loop
cmp #'< if <
bne 40$
inx x++
;
40$ cmp #'> if >
bne 20$
dex x--
bne 20$ until x==0
;
jsr mpafe_clip_advance clip arg and point to next
;
ldy #0 read next char
lda (macro_pntr_1),y
beq 80$ if space,or semicolon,orEOS
jsr mpafe_space_check
beq 80$ go exit
cmp #', if comma
bne 45$
;
jsr mpafe_incd_pntr1 pntr1++
jmp 10$ go get next arg
;
45$ jsr outerr_q complain about_syntax
jmp 10$ go get next arg
;
50$ inc nargs nargs++
sta (macro_pntr_2),y write the byte
bcc 69$
;
60$ iny do y++
jsr mpafe_getc (pntr2) <= next char
sta (macro_pntr_2),y
beq 80$ go exit iff null
bcs 60$ loop if tilded
jsr mpafe_space_check if space or ;
beq 70$ go terminiate and exit
69$ cmp #', until , found
bne 60$
;
65$ jsr mpafe_clip_advance
jmp 10$ go get more args (hungry)
;
70$ lda #0 termiante arg
sta (macro_pntr_2),y
;
80$ clc return happy
rts
;
;
;
mpafe_getc
lda (macro_pntr_1),y .a <- char
; if null
beq 80$ exit Z=1,C=0
cmp #'~ if not tilde
bne 80$ exit Z=1,C=0
jsr mpafe_incd_pntr1 skip tilde char ; c preserved as 1
lda (macro_pntr_1),y .a <= char
; if not null
bne 90$ exit Z=0,C=1
jsr outerr_s complain
lda #0 exit null, Z=0,C=0
;
80$ clc
90$ rts
;
mpafe_space_check
cmp #';
beq 10$
jsr isspace
10$ rts
;
;
mpafe_clip_advance
lda #0 (pntr2) <= null (clip arg )
sta (macro_pntr_2),y
iny adjust pntr1,pntr2 to point past
tya
adad macro_pntr_2
tya
adad macro_pntr_1
rts return
;
mpafe_incd_pntr1
incd macro_pntr_1
rts
;

168
HCD65_3.5/macros.src
Unescape View File

@ -0,0 +1,168 @@
.subttl 16 bit macro definitions
;
ram .macro %a,%b
.ifdef %a
.messg multiple definitions -> curram
.else
%a = curram
.ifb <%b>
curram = curram+1
.else
curram = curram+%b
.endif
.endif
.endm
zpage .macro %a,%b
.ifdef %a
.messg multiple definitions -> curram
.else
%a = curzpg
.ifb <%b>
curzpg = curzpg+1
.else
curzpg = curzpg+%b
.endif
.ifgt curzpg-$100
ERROR- too many zero page variables.....
.endif
.endif
.endm
;
;
; double precision macros
;
;
ldd .macro %a
lda %a ; x,a <= %a
ldx %a+1
.endm
;
std .macro %a
sta %a ; %a <= x,a
stx %a+1
.endm
;
cpd .macro %a
mactmp = %a
cpx %a+1 ; compare x,a with %a
.ifn >mactmp
bne *+5
.else
bne *+4
.endif
cmp %a
.endm
;
;
cpi .macro %a
cpx #>%a ; compare x,a with #%a
bne *+4
cmp #<%a
.endm
;
ldi .macro %a
lda #<%a ; x,a <= #%a
ldx #>%a
.endm
;
;
incd .macro %a
mactmp = %a
inc %a ; inc double precision %a
.ifn >mactmp
bne *+5
.else
bne *+4
.endif
inc %a+1
.endm
;
decd .macro %a
mactmp = %a
pha ; dec double precision %a
lda %a
.ifn >mactmp
bne *+5
.else
bne *+4
.endif
dec %a+1
dec %a
pla
.endm
;
add .macro %a
cld ; add %a to x,a
clc ; ( carry is only good condition code )
adc %a
pha
txa
adc %a+1
tax
pla
.endm
;
sbd .macro %a
cld ; sub %a from x,a
sec ; ( carry is only good condition code )
sbc %a
pha
txa
sbc %a+1
tax
pla
.endm
;
cmpdr .macro %a,%b,%r ; double compare %a to %b using .%r
ld%r %a+1
cp%r %b+1
mactmp = %a
.ifn >mactmp
mactmp = %b
.ifn >mactmp
bne *+2+3+3
.else
bne *+2+3+2
.endif
.else
mactmp = %b
.ifn >mactmp
bne *+2+2+3
.else
bne *+2+2+2
.endif
.endif
ld%r %a
cp%r %b
.endm
;
cpa .macro %a
cmp %a
.endm
;
phd .macro
pha
txa
pha
.endm
;
pld .macro
pla
tax
pla
.endm
;
adad .macro %a
clc
adc %a
sta %a
mactmp = %a
.ifn >mactmp
bcc *+5
.else
bcc *+4
.endif
inc %a+1
.endm
;

311
HCD65_3.5/main.src
Unescape View File

@ -0,0 +1,311 @@
.page
.subttl "initialization software"
;
init lda #0 ; kill kernal messages
jsr setmsg
;
jsr kill_basic_irqs ; bye bye basic...
jsr save_zero_page ; save zero page
jsr down_load_code ; down load our private indirect code
;
lda mmucr ; save mmu on stack
pha
lda #mmucr_bank0_normal ; select my ram set up..
sta mmucr
;
lda #0
sta fatal_error ; make statenon fatal
sta current_channel ; init our i/o
;
jsr pass_a ; perform pass 1 ( .a == 0 )
bit fatal_error
bmi 9$
lda #$ff ; perform pass2
jsr pass_a
bit fatal_error
9$ bmi 90$
;
jsr flush_list flush list
jsr flush_obj flush obj
jsr flush_xref flush xref
;
60$ lda conditional_depth
beq 70$
;
jsr primm_to_error_channel
.byte "CONDITIONAL IN PROGESS AT EOF",CR,0
;
70$ lda end_flag
bne 80$
;
jsr primm_to_error_channel
.byte "MISSING END STATEMENT",CR,0
;
80$ jsr list_error_count list errors count please
lda list_channel if listing or xref enabled
ora xref_device
beq 85$
jsr symbol_table print symbol table
jsr perform_cross_reference
;
85$ jsr top_of_form ( form feed... )
;
90$ jsr clrch clear channels
jsr restore_zero_page
pla restore mmu to previous state
sta mmucr
jsr enable_basic_irqs
rts return to papa
;
.page
.subttl "Main Loops"
;
;
pass_a
sta pass save pass number
global_init do lots of inits
jsr macro_init macro init complains if not enough mem
bcs 90$
jsr line_number_init
jsr init_input must init after macro init !!!!!
jsr init_symbol_table
jsr xref_init ; do up the xref open
ldi start_file_name open the first file
jsr set_file
bcs 90$ if ok
;
1$ jsr read_line do read a line
bcs 90$ if error, break
jsr pass_main_loop call the buggers innards
jmp 1$ loop
90$ rts
;
pass_main_loop
ldi line list the line
jsr set_list
jsr equate_check perform equate processing
bcs 80$ if done, exit
; switch(oper)
ldy #0
lda (oper),y case (null):
beq 80$ exit
;
cmp #'. case( starts with '.'):
bne 20$
jsr directive directive
jmp 70$ break
;
20$ cmp #'* case(oper start with '*'):
bne 30$
;
jmp outerr_e error, equate missed
;
; default
30$ jsr oper_toupper convert oper to upper case...
ldd oper eval as macro
jsr eval_macro if no error
bcc 70$ break;
;
jsr eval_opcode evaluate line as opcode
bcc 70$ if no error, break
;
jmp outerr_o tell user 'O' error
;
70$ bcs 80$ if not in error condition
adc pc pc += .a
sta pc
bcc 80$
inc pc+1
;
80$ rts return
;
;
;*******************************************************************************
; equate check
;*******************************************************************************
;
; equate_check
; delimits label and oper
; scans for equates
; if present
; performs nessesary opertions
;
; if label feild no blank
; does label operation or call to define macro.
;
; exit: c=0 need to continue processing operation
; for macros opcodes....
; c=1 line is completed
;
;
equate_check
jsr delimit_label_oper
;
; delimit everything normally
;
ldd label if '=' in the label !!
jsr equate_here
bcs 30$
cpy #0 if first char
bne 10$
jmp outerr_e expression error, done
10$ tax save next
lda #0 terminate label
sta (label),y
txa if = was last char
bne 20$
ldd oper x,a <= oper
jmp equate_label_to_this go equate label to oper
;
20$ iny x,a <= label + y + 1
ldd label
jsr effective_address
jmp equate_label_to_this go equate label to this thing
;
30$ ldd oper if '=' in the operator
jsr equate_here
bcs 60$
;
cpy #0 if = is not the first char in oper
beq 40$
;
jsr main_store_label assign to label the value of PC
ldd oper label <= oper
std label
jsr equate_here where were we ?
;
40$ tax save char after =
lda #0 make the eq a terminator
sta (oper),y
txa restore char after =
;
cmp #0 if = is last char in arg
bne 50$
jsr delimit_single_arg delimit the arg
jmp equate_label_to_arg go equate the (label) to the arg
;
50$ iny x,a <= oper + y + 1
ldd oper
jsr effective_address
jmp equate_label_to_this go use that to equate too
;
60$ ldy #0 if the first char of oper is =
lda (arg),y
cmp #'=
bne 100$
;
jsr main_store_label assign PC to label
;
ldd oper label <= oper
std label
;
70$ incd arg do arg++
ldy #0 while (arg) = space
lda (arg),y
jsr isspace
bcc 70$
;
80$ jsr delimit_single_arg delimit the argument
;
jmp equate_label_to_arg
;
;
;
100$ ldy #0 if label is non blank
lda (label),y
beq 180$
ldi text_macro if oper is .macro
ldy #oper
jsr strstrt_toupper
bcs 150$
jsr directive_macro go do up the macro bit
sec return done with line
rts
;
150$ jsr main_store_label do the label operation
180$ clc return and continue processing
rts
;
main_store_label
ldy #0
lda (label),y
beq 10$
jsr label_operation
jmp list_pc
10$ rts
;
;
;*******************************************************************************
; equate_label_to something
;*******************************************************************************
; equate_label_to_xxx
;
; passes xxx to eval for equation
; if eval fails in anyway
; error 'E'
; list value as equate
; if label ='*'
; lists the PC
; PC <= value
; else
; add_symbol.
;
; always returns c=1 to prevent further line proccessing
;
;
equate_label_to_arg
ldd arg
equate_label_to_this
jsr eval eval x,a
lda valflg if error
bne 90$ go puke
;
ldy #0 if (label)=='*'
lda (label),y
cmp #'*
bne 20$
;
iny if next char not null
lda (label),y
bne 90$ massive error
;
ldd value pc <= value
std pc
jmp 80$ else
;
20$ ldd label define (label) to equal value
jsr add_symbol
;
80$ ldd value list the equate
jsr list_equate
;
sec return c=1 (always)
rts
;
90$ jmp outerr_e expression error, return
;
; equate_here
; entry: x,a pointer to string
; exit c=1 '=' not in string
; c=1 = in string at position y
; .a = next char
zpage equate_pntr,2
;
equate_here
std equate_pntr
ldy #$FF
10$ iny
lda (equate_pntr),y
beq 90$
cmp #'=
bne 10$
;
incd equate_pntr
lda (equate_pntr),y
clc
rts
;
90$ sec
rts

813
HCD65_3.5/opcode.src
Unescape View File

@ -0,0 +1,813 @@
.page
.subttl "Opcode Definition & Evaluation"
;
; opcodes.
; 0 1 2 3 4 5 6 7 8 9 a b c d e f
; type imm abs zp acc imp (x) (y) z,x a,x a,y rel (a) z,y (z) (a,x)
; mnem imm abs zpg acc imp izx izy zpx abx aby rel iab zpy izp iax
; #bytes 2 3 2 1 1 2 2 2 3 3 2 3 2 2 3
;
;
bit_mode_imm = %0000000000000001
bit_mode_abs = %0000000000000010
bit_mode_zpg = %0000000000000100
bit_mode_acc = %0000000000001000
bit_mode_imp = %0000000000010000
bit_mode_izx = %0000000000100000
bit_mode_izy = %0000000001000000
bit_mode_zpx = %0000000010000000
bit_mode_abx = %0000000100000000
bit_mode_aby = %0000001000000000
bit_mode_rel = %0000010000000000
bit_mode_iab = %0000100000000000
bit_mode_zpy = %0001000000000000
bit_mode_izp = %0010000000000000
bit_mode_iax = %0100000000000000
bit_mode_write = %1000000000000000 ; this is a flag for xref only
;
;
mode_imm = 0
mode_abs = 1
mode_zpg = 2
mode_acc = 3
mode_imp = 4
mode_izx = 5
mode_izy = 6
mode_zpx = 7
mode_abx = 8
mode_aby = 9
mode_rel = 10
mode_iab = 11
mode_zpy = 12
mode_izp = 13
mode_iax = 14
;
;imm abs zpg acc imp izx izy zpx abx aby rel ind zpy izp iax
;
;
;opcode_strcuture
; <pntr><name><mode><....>
; <pntr> = single byte pntr to next opcode
; <name) = 2 byte hashed opcode name
; <mode> = sixteeen bit addressing mode flag
; <....> = 1-16 bytes of opcode values.
; ( only those that exsist according to <mode> are present ).
;
opstruct_name_offset = 1
opstruct_mode_offset = 3
opstruct_op_offset = 5
;
add_mode .macro %mode,%arg
.ifge %arg
defop_mode = defop_mode+%mode
defop_count = defop_count+1
.endif
.endm
;
;
;
defop .macro %name,^wri,^imm,^abs,^zpg,^acc,^imp,^izx,^izy,^zpx,^abx,^aby,^rel,^iab,^zpy,^izp,^iax
.ife ^wri
defop_mode = 0
.else
defop_mode = bit_mode_write
.endif
defop_count = 0
; 1 2 3 4 5 6 7 8 9 a b c d e f
; imm abs zp acc imp (x) (y) z,x a,x a,y rel (a) z,y (z) write
add_mode bit_mode_imm,^imm
add_mode bit_mode_abs,^abs
add_mode bit_mode_zpg,^zpg
add_mode bit_mode_acc,^acc
add_mode bit_mode_imp,^imp
add_mode bit_mode_izx,^izx
add_mode bit_mode_izy,^izy
add_mode bit_mode_zpx,^zpx
add_mode bit_mode_abx,^abx
add_mode bit_mode_aby,^aby
add_mode bit_mode_rel,^rel
add_mode bit_mode_iab,^iab
add_mode bit_mode_zpy,^zpy
add_mode bit_mode_izp,^izp
add_mode bit_mode_iax,^iax
;
opcode_hash_value = 0
.irpc %char,%name
opcode_hash_value = %00100000*opcode_hash_value+%00011111!.'%char'
.endr
;
.byte defop_count+5
.word opcode_hash_value
.word defop_mode
;
.ifge ^imm
.byte ^imm
.endif
.ifge ^abs
.byte ^abs
.endif
.ifge ^zpg
.byte ^zpg
.endif
.ifge ^acc
.byte ^acc
.endif
.ifge ^imp
.byte ^imp
.endif
.ifge ^izx
.byte ^izx
.endif
.ifge ^izy
.byte ^izy
.endif
.ifge ^zpx
.byte ^zpx
.endif
.ifge ^abx
.byte ^abx
.endif
.ifge ^aby
.byte ^aby
.endif
.ifge ^rel
.byte ^rel
.endif
.ifge ^iab
.byte ^iab
.endif
.ifge ^zpy
.byte ^zpy
.endif
.ifge ^izp
.byte ^izp
.endif
.ifge ^iax
.byte ^iax
.endif
;
.endm
; imm abs zpg acc imp izx izy zpx abx aby rel ind zpy izp iax
opcode_table
defop lda,0,$a9,$ad,$a5,-01,-01,$a1,$b1,$b5,$bd,$b9,-01,-01,-01,-01,-01
defop sta,1,-01,$8d,$85,-01,-01,$81,$91,$95,$9d,$99,-01,-01,-01,-01,-01
defop jsr,0,-01,$20,-01,-01,-01,-01,-01,-01,-01,-01,-01,-01,-01,-01,-01
defop adc,0,$69,$6d,$65,-01,-01,$61,$71,$75,$7d,$79,-01,-01,-01,-01,-01
defop and,0,$29,$2d,$25,-01,-01,$21,$31,$35,$3d,$39,-01,-01,-01,-01,-01
defop asl,1,-01,$0e,$06,$0a,-01,-01,-01,$16,$1e,-01,-01,-01,-01,-01,-01
; imm abs zpg acc imp izx izy zpx abx aby rel ind zpy izp iax
defop bcc,0,-01,-01,-01,-01,-01,-01,-01,-01,-01,-01,$90,-01,-01,-01,-01
defop bcs,0,-01,-01,-01,-01,-01,-01,-01,-01,-01,-01,$b0,-01,-01,-01,-01
defop beq,0,-01,-01,-01,-01,-01,-01,-01,-01,-01,-01,$f0,-01,-01,-01,-01
defop bit,0,-01,$2c,$24,-01,-01,-01,-01,-01,-01,-01,-01,-01,-01,-01,-01
defop bmi,0,-01,-01,-01,-01,-01,-01,-01,-01,-01,-01,$30,-01,-01,-01,-01
defop bne,0,-01,-01,-01,-01,-01,-01,-01,-01,-01,-01,$d0,-01,-01,-01,-01
defop bpl,0,-01,-01,-01,-01,-01,-01,-01,-01,-01,-01,$10,-01,-01,-01,-01
defop brk,0,-01,-01,-01,-01,$00,-01,-01,-01,-01,-01,-01,-01,-01,-01,-01
defop bvc,0,-01,-01,-01,-01,-01,-01,-01,-01,-01,-01,$50,-01,-01,-01,-01
defop bvs,0,-01,-01,-01,-01,-01,-01,-01,-01,-01,-01,$70,-01,-01,-01,-01
; 0,imm abs zpg acc imp izx izy zpx abx aby rel ind zpy izp iax
defop clc,0,-01,-01,-01,-01,$18,-01,-01,-01,-01,-01,-01,-01,-01,-01,-01
defop cld,0,-01,-01,-01,-01,$d8,-01,-01,-01,-01,-01,-01,-01,-01,-01,-01
defop cli,0,-01,-01,-01,-01,$58,-01,-01,-01,-01,-01,-01,-01,-01,-01,-01
defop clv,0,-01,-01,-01,-01,$b8,-01,-01,-01,-01,-01,-01,-01,-01,-01,-01
defop cmp,0,$c9,$cd,$c5,-01,-01,$c1,$d1,$d5,$dd,$d9,-01,-01,-01,-01,-01
defop cpx,0,$e0,$ec,$e4,-01,-01,-01,-01,-01,-01,-01,-01,-01,-01,-01,-01
defop cpy,0,$c0,$cc,$c4,-01,-01,-01,-01,-01,-01,-01,-01,-01,-01,-01,-01
; imm abs zpg acc imp izx izy zpx abx aby rel ind zpy izp iax
defop dec,1,-01,$ce,$c6,-01,-01,-01,-01,$d6,$de,-01,-01,-01,-01,-01,-01
defop dex,1,-01,-01,-01,-01,$ca,-01,-01,-01,-01,-01,-01,-01,-01,-01,-01
defop dey,1,-01,-01,-01,-01,$88,-01,-01,-01,-01,-01,-01,-01,-01,-01,-01
defop eor,0,$49,$4d,$45,-01,-01,$41,$51,$55,$5d,$59,-01,-01,-01,-01,-01
defop inc,1,-01,$ee,$e6,-01,-01,-01,-01,$f6,$fe,-01,-01,-01,-01,-01,-01
defop inx,1,-01,-01,-01,-01,$e8,-01,-01,-01,-01,-01,-01,-01,-01,-01,-01
defop iny,1,-01,-01,-01,-01,$c8,-01,-01,-01,-01,-01,-01,-01,-01,-01,-01
; imm abs zpg acc imp izx izy zpx abx aby rel ind zpy izp iax
defop jmp,0,-01,$4c,-01,-01,-01,-01,-01,-01,-01,-01,-01,$6c,-01,-01,-01
defop ldx,0,$a2,$ae,$a6,-01,-01,-01,-01,-01,-01,$be,-01,-01,$b6,-01,-01
defop ldy,0,$a0,$ac,$a4,-01,-01,-01,-01,$b4,$bc,-01,-01,-01,-01,-01,-01
defop lsr,1,-01,$4e,$46,$4a,-01,-01,-01,$56,$5e,-01,-01,-01,-01,-01,-01
defop nop,0,-01,-01,-01,-01,$ea,-01,-01,-01,-01,-01,-01,-01,-01,-01,-01
defop ora,0,$09,$0d,$05,-01,-01,$01,$11,$15,$1d,$19,-01,-01,-01,-01,-01
defop pha,0,-01,-01,-01,-01,$48,-01,-01,-01,-01,-01,-01,-01,-01,-01,-01
defop php,0,-01,-01,-01,-01,$08,-01,-01,-01,-01,-01,-01,-01,-01,-01,-01
defop pla,0,-01,-01,-01,-01,$68,-01,-01,-01,-01,-01,-01,-01,-01,-01,-01
defop plp,0,-01,-01,-01,-01,$28,-01,-01,-01,-01,-01,-01,-01,-01,-01,-01
; imm abs zpg acc imp izx izy zpx abx aby rel ind zpy izp iax
defop rol,1,-01,$2e,$26,$2a,-01,-01,-01,$36,$3e,-01,-01,-01,-01,-01,-01
defop ror,1,-01,$6e,$66,$6a,-01,-01,-01,$76,$7e,-01,-01,-01,-01,-01,-01
defop rti,0,-01,-01,-01,-01,$40,-01,-01,-01,-01,-01,-01,-01,-01,-01,-01
defop rts,0,-01,-01,-01,-01,$60,-01,-01,-01,-01,-01,-01,-01,-01,-01,-01
defop sbc,0,$e9,$ed,$e5,-01,-01,$e1,$f1,$f5,$fd,$f9,-01,-01,-01,-01,-01
defop sec,0,-01,-01,-01,-01,$38,-01,-01,-01,-01,-01,-01,-01,-01,-01,-01
defop sed,0,-01,-01,-01,-01,$f8,-01,-01,-01,-01,-01,-01,-01,-01,-01,-01
defop sei,0,-01,-01,-01,-01,$78,-01,-01,-01,-01,-01,-01,-01,-01,-01,-01
defop stx,1,-01,$8e,$86,-01,-01,-01,-01,-01,-01,-01,-01,-01,$96,-01,-01
defop sty,1,-01,$8c,$84,-01,-01,-01,-01,$94,-01,-01,-01,-01,-01,-01,-01
defop tax,0,-01,-01,-01,-01,$aa,-01,-01,-01,-01,-01,-01,-01,-01,-01,-01
defop tay,0,-01,-01,-01,-01,$a8,-01,-01,-01,-01,-01,-01,-01,-01,-01,-01
defop tsx,0,-01,-01,-01,-01,$ba,-01,-01,-01,-01,-01,-01,-01,-01,-01,-01
defop txa,0,-01,-01,-01,-01,$8a,-01,-01,-01,-01,-01,-01,-01,-01,-01,-01
defop txs,0,-01,-01,-01,-01,$9a,-01,-01,-01,-01,-01,-01,-01,-01,-01,-01
defop tya,0,-01,-01,-01,-01,$98,-01,-01,-01,-01,-01,-01,-01,-01,-01,-01
.byte 0
end_opcode_table
;
;
ram opcode_hash,2 two byte area for hash of opcode name
opcode_temp = opcode_hash two byte temp area
zpage opcode_pntr,2
ram opcode_flags syntax flags for features found in arg to opcode
;
; opcode_flags = flag values for argument features
flag_inx = %00000001 ; index x ,x
flag_iny = %00000010 ; index y ,y
flag_ind = %00000100 ; indirect )
flag_opp = %00001000 ; opening paren (
flag_imm = %00010000 ; immediate #
flag_acc = %00100000 ; accumilator mode "A"
flag_noarg = %01000000 ; no argument flag
;
;
ram opcode_modes,16 legality flags for opcodes ( 0 = not opcode )
ram opcodes,16 opcodes in each addressing mode.
;
; find_opcode finds opcode list
; entry: oper point to 3 byte of mnumonic
; exit: c=1 .a = 'O'
; opcode not found; c=0 opcode found
; opcode_modes ( b7 ) set for legal modes
; opcodes contains opcodes for modes
; marked as legal.
;
find_opcode
lda #0 opcode_hash <= hash value for opcode
sta opcode_hash
tay
10$ lda (oper),y
jsr isalpha
bcc 15$
;
90$ sec puke if non alpha char
lda #'O
rts
;
15$ jsr 100$
iny
cpy #3
bne 10$
;
lda (oper),y puke iff > 3 chars
bne 90$
;
ldi opcode_table opcode_pntr <= base of opcode_table
std opcode_pntr
;
20$ ldy #0 do if (opcode_pntr) == null
lda (opcode_pntr),y
beq 90$ go puke
ldy #opstruct_name_offset
lda (opcode_pntr),y if this name matches
cmp opcode_hash
bne 30$
iny
lda (opcode_pntr),y
cmp opcode_hash+1
beq 50$ goto 50$
;
;
30$ ldy #0 opcode_pntr += (opcode_pntr)
lda (opcode_pntr),y
clc
adc opcode_pntr
sta opcode_pntr
bcc 20$
inc opcode_pntr+1
jmp 20$ forever
;
50$ ldy #opstruct_mode_offset+1 opcode_tempo <= legal modes
lda (opcode_pntr),y
sta opcode_temp+1
dey
lda (opcode_pntr),y
sta opcode_temp
;
ldy #opstruct_op_offset y <= offset in structure to opcode storage
ldx #0 x <= 0
;
60$ lsr opcode_temp+1 do shift bit out of legal modes
ror opcode_temp
bcc 65$ if bit set
;
lda (opcode_pntr),y opcodes,x <= next byte in struct
sta opcodes,x
iny y ++
;
65$ ror opcode_modes,x shift carry high order modes byte
inx inx
cpx #16 until x = 16
bne 60$
clc return happy
rts
;
;
100$ asl a
asl a
asl a
ldx #4
110$ asl a
rol opcode_hash
rol opcode_hash+1
dex
bpl 110$
rts
;
;
;
.ifn 0
;
;
; opcode_analyze_arg
;
; looks at (arg)
; termiates at first non quoted space or semi colon
; sets flag
;
;
opcode_analyze_arg
lda #0 opcode_flags <= 00
sta opcode_flags
;
10$ jsr delimit_single_arg delimit the arg ( commas not relevant )
bcs 110$ if error go set no arg bits.
;
; trailing spaces, semicolon or EOS have now resulted in
; the ARG being terminated.
;
;
jsr 150$ x,a <= last two chars in string
;
cpx #'Y if arg ends in ",Y"
bne 30$
cmp #',
bne 30$
;
lda #flag_iny set flags and terminate arg
jsr 100$
jsr 150$ x,a <= last two chars in string
;
30$ cpx #') if last char is )
bne 40$
iny y ++ ( point to last char )
lda #flag_ind set flags and terminate arg
jsr 100$
jsr 150$ x,a <= last two chars in string
;
40$ cpx #'X if arg ends in ",X"
bne 60$
cmp #',
bne 60$
;
lda #flag_inx set flags and terminate arg
jsr 100$
;
;
60$ ldy #0 if string starts with immediatte sign
lda (arg),y
cmp #'#
bne 70$
;
incd arg skip immediate sign
;
lda #flag_imm set immediate flag
jsr 120$
;
70$ lda (arg),y if string starts with open paren
cmp #'(
bne 80$
;
incd arg skip open paren
;
lda #flag_opp set open paren flag
jsr 120$
;
80$ lda (arg),y if string is now a single A
jsr toupper
cmp #'A
bne 90$
iny
lda (arg),y
bne 90$
lda #flag_acc set accumilator flag
jsr 120$
ldy #0 nullify string
tya
sta (arg),y
rts
;
90$ ldy #0 if arg is null
lda (arg),y
beq 110$ go set no arg flag and return
99$ rts return
;
;
100$ jsr 120$ set bits in opcode flags
lda #0 terminate arg at yth char
sta (arg),y
rts return
;
110$ lda #flag_noarg set no argumnet flag
120$ ora opcode_flags set bits in opcode flags
sta opcode_flags
rts return
;
; 150$
; if (arg) > 2 chars
; x <= last char
; a <= next to last char
; y <= pointer to next to last char
; else
; x,a <= 0
;
;
150$ ldy #$ff y <= pointer to last char in .arg
ldx #0 ( .a,.x = 0 )
160$ iny
lda (arg),y
bne 160$
;
cpy #2 if y < 2
bcc 170$ go return
;
dey x <= last char ( upper case please )
lda (arg),y
jsr toupper
tax
dey y <= pointer to next to last char
lda (arg),y .a <= next to last char
170$ rts
;
;
.else
;
;
; opcode_analyze_arg
;
; looks at (arg)
; termiates at first non quoted space or semi colon
; sets flag
;
;
opcode_analyze_arg
lda #0 opcode_flags <= 00
sta opcode_flags
;
10$ jsr delimit_single_arg delimit the arg ( commas not relevant )
bcs 110$ if error go set no arg bits.
;
; trailing spaces, semicolon or EOS have now resulted in
; the ARG being terminated.
;
ldy #0 if string starts with immediatte sign
lda (arg),y
cmp #'#
bne 20$
lda #flag_imm set immediate flag & skip
jsr 105$
jmp 80$ check for null arg and return
;
;
20$ cmp #'( if string starts with open paren
bne 25$
;
lda #flag_opp set open paren flag & skip
jsr 105$
;
25$ jsr 150$ x,a <= last two chars in string
;
cpx #'Y if arg ends in ",Y"
bne 30$
cmp #',
bne 30$
;
lda #flag_iny set flags and terminate arg
jsr 100$
jsr 150$ x,a <= last two chars in string
;
30$ cpx #') if last char is )
bne 40$
lda #flag_opp if no open paren
bit opcode_flags
beq 80$ go exit
;
iny y ++ ( point to last char )
lda #flag_ind set flags and terminate arg
jsr 100$
jsr 150$ x,a <= last two chars in string
;
40$ cpx #'X if arg ends in ",X"
bne 80$
cmp #',
bne 80$
;
lda #flag_inx set flags and terminate arg
jsr 100$
;
80$ ldy #0
lda (arg),y if string is now null
beq 110$ go set no arg and return
jsr toupper if its a single .a
cmp #'A
bne 90$
iny
lda (arg),y
bne 90$
lda #flag_acc set accumilator flag
jsr 120$
ldy #0 nullify string
tya
sta (arg),y
90$ rts return
;
;
;
100$ jsr 120$ set bits in opcode flags
lda #0 terminate arg at yth char
sta (arg),y
rts return
;
105$ incd arg inc arg
.byte $2c
;
110$ lda #flag_noarg set no argumnet flag
;
120$ ora opcode_flags set bits in opcode flags
sta opcode_flags
rts return
;
; 150$
; if (arg) > 2 chars
; x <= last char
; a <= next to last char
; y <= pointer to next to last char
; else
; x,a <= 0
;
;
150$ ldy #$ff y <= pointer to last char in .arg
ldx #0 ( .a,.x = 0 )
160$ iny
lda (arg),y
bne 160$
;
cpy #2 if y < 2
bcc 170$ go return
;
dey x <= last char ( upper case please )
lda (arg),y
jsr toupper
tax
dey y <= pointer to next to last char
lda (arg),y .a <= next to last char
170$ rts
;
;
.endif
;
;******************************************************************************
; EVAL_OPCODE
;******************************************************************************
;
;
; this routine parses opcode and arg.
; it checks for errors.
; it calls outbyte to emit object code bytes
; it calls eval to check the value of the argument
; it calls outerr for various errors
; it return the number of object code bytes created.
;
;
; the software first searches for the opcode in the opcode
; tables, and also checks the arguement for various syntactical
; features expected by 6502 assemeblers.
;
; if then combines information about the addressing mode with
; the syntactical features found and the results of any arguement
; evalautation to produce lots of errors except in the special case
; where in the input line is correct.
;
; ram value 16 bit flag
; ram valerr = 0 ok
; = 1 undefined
; = 2 forward reference
eval_opcode
jsr find_opcode find the opcode
bcc 1$
rts
; if implied operation
1$ lda opcode_modes+mode_imp
bpl 10$
lda opcodes+mode_imp .a <= opcode
81$ ldy #0 output at pc
jsr outbyte
lda #1 return happy one byte used
clc
rts
;
10$ jsr opcode_analyze_arg examine the arg for syntactical features
lda opcode_flags if no arg or 'A' addressing selected
and #flag_noarg+flag_acc
beq 20$
;
ldx opcode_modes+mode_acc if acc addressing allowed
bpl 17$
lda opcode_flags if any other flags set
cmp #flag_acc
beq 15$
jsr outerr_q ???
15$ lda opcodes+mode_acc output the acc mode byte
jmp 81$ & return happy
; else
17$ and #flag_noarg if no arg
beq 18$ dreaded 'E' error
jmp 90$
;
18$ and #255-flag_acc clear noarg flag
sta opcode_flags
;
lda #$a value <= $000a
sta value
lda #0
sta value+1
sta valflg valflg <= no errors
jsr outerr_q output a ??
jmp 30$ else
;
20$ asl opcode_modes+15 c <= b7 of write mode opcade flag
jsr xref_write_if_carry
ldd arg go evaluate the arguement
jsr eval ( user gets the errors )
clc
jsr xref_write_if_carry
;
;
; at this point
; implied and accumilator modes have been eliminated.
; the arguement has been evaluated, and any evaluation
; errors have been reported.
;
;
;
30$ lda opcode_modes+mode_rel
; if relative mode opcode
bpl 40$
lda opcode_flags if any flags set
beq 31$
;
jsr outerr_q ?
;
31$ ldi $FFFE value <= -2 + value - pc
add value
sbd pc
std value
;
asl a spit 'A' error if out of range
txa
bcc 32$
eor #$ff
32$ beq 35$
jsr outerr_a
;
35$ lda opcodes+mode_rel a <= relative mode opcode
;
82$ ldy #0 output .a as opcode
jsr outbyte
lda value output low order value
ldy #1
jsr outbyte
lda #2 .a <= 2 bytes used
clc return happy
rts
;
40$ lda opcode_flags
and #flag_imm if immediate mode selected
beq 50$
cmp opcode_flags if others selected
beq 47$
jsr outerr_q outerr a q
47$ ldx #mode_imp x <= known illegal mode
ldy #mode_imm y <= immeditate mode
jmp 100$ go select one
;
50$ lda opcode_flags
and #flag_ind+flag_opp if any parens found
beq 70$
cmp #flag_ind+flag_opp if both not found
beq 55$
jsr outerr_q output a 'Q' error
;
55$ lda opcode_flags if no indexing
and #flag_iny+flag_inx
bne 60$
ldx #mode_iab x,a <= abs,zpg indirect modes
ldy #mode_izp
jmp 100$ go perform decision
;
60$ cmp #flag_inx if by x only
bne 65$
;
ldx #mode_iax x,a <= abs,zpg indirect indexed modes
ldy #mode_izx
jmp 100$
;
65$ cmp #flag_iny if not by y only
beq 67$
jsr outerr_q ??
;
67$ ldx #mode_imp x <= known illegal opcode mode
ldy #mode_izy
jmp 100$ go decide
;
;
; have eliminated implied, acc immediate,relative and
; all indirect forms of addressing. therefore it must be
; indexing by x, ort y or no indexing at all
;
70$ lda opcode_flags if not index by x
cmp #flag_inx
beq 85$ if not index by y
cmp #flag_iny
beq 80$
cmp #0
beq 75$ if any flags set...
jsr outerr_q question that
;
75$ ldx #mode_abs x,y <= abs,zero page modes
ldy #mode_zpg
jmp 100$ go perform decision
;
80$ ldx #mode_aby x,y <= abs,zpg y indexed modes
ldy #mode_zpy
jmp 100$ go decide
;
;
85$ ldx #mode_abx x,y <= abs,zpg x indexed modes
ldy #mode_zpx
;
;
;100$ at this point, the zero page and absolute modes
; for this the addresing mode are in x and y.
; examine the legality of these modes and make a selection
; based on the legality of the modes, and the result of
; instructiin evaluation.
;
100$ lda opcode_modes,y if zero page mode legal
bpl 140$
;
lda value+1 if >8bit result
beq 110$
;
lda opcode_modes,x if abs legal
bmi 140$ go use abs
;
lda opcodes,y .a <= opcode to use
pha .save .a
jsr outerr_v outerr 'v'
pla reacll opcode to use
jmp 82$ go spit it out
;
110$ lda valflg if forward_reference
and #value_forward
beq 120$
lda opcode_modes,x if abs legal
bpl 120$
lda opcodes,x .a <= opcode to use
pha stack .a
jsr outerr_w wasted byte warning
pla recall .a
jmp 83$ go spit it out
;
120$ lda opcodes,y .a <= zero page opcode
jmp 82$ go spit it out.....
;
;
140$ lda opcode_modes,x if abs opcode illegal
bmi 150$
90$ jsr outerr_question I'm confused...
lda #0 return no bytes used
clc
rts
;
150$ lda opcodes,x output the opcode
83$ ldy #0
jsr outbyte
ldd value output the value
ldy #1
jsr outword
lda #3 return 3 bytes used
clc
rts
;

698
HCD65_3.5/output.src
Unescape View File

@ -0,0 +1,698 @@
.page
.subttl "Output File Handlers"
;
zpage list_enable_main
ram list_enable_conditional
zpage list_enable_gen
zpage list_enable_macro
; ram list_line_count
ram list_char_count
; ram page_number,2
;
;
directive_pag
directive_page
jsr un_set_list forget my line
top_of_form
bit pass
bpl 80$
jsr flush_list flush the listing buffer
lda formln if formln <> 0
beq 80$
lda list_line_count if count <> 0
beq 80$
sec value <= formln - count
lda formln
sbc list_line_count
sta value
beq 80$ if not zero
jmp list_value_lines list that many lines
80$ clc return happy no bytes used
rts
;
;
directive_list
lda #$00
.byte $2c
directive_nlist
lda #$FF
jsr listing_directive_flush
stx list_enable_main
rts
;
directive_clist
lda #$00
.byte $2c
directive_nclist
lda #$ff
jsr listing_directive_flush
stx list_enable_conditional
rts
;
directive_gen
lda #0
.byte $2c
directive_nogen
lda #$ff
jsr listing_directive_flush
stx list_enable_gen
rts
;
directive_mlist
lda #$00
.byte $2c
directive_blist
lda #$1
.byte $2c
directive_nmlist
lda #$FF
jsr listing_directive_flush
stx list_enable_macro
rts
;
listing_directive_flush
pha
jsr un_set_list
pla
tax
clc
lda #0
rts
;
;
directive_space
directive_skip
directive_ski
bit pass if pass 1
bmi 10$
sec return no bytes used
rts return
10$ jsr un_set_list forget my line
jsr delimit_single_arg delimit the arg
bcs 40$ if ok
ldd args eval the arg
jsr eval
bcs 40$ if ok
lda value if value <> 0
bne list_value_lines go use value
;
40$ lda #01 value <= 1
sta value
;
list_value_lines
jsr flush_list flush the listing buffer
jsr open_list_channel open the list channel
50$ jsr print_cr do print a cr
dec value dec value
bne 50$ until value == 0
lda #0 return no bytes used & happy
clc
rts
;
;
; outerr marks the list file with error code in .A.
;
;
; current_line;
;globalref int error_count;
;globalref FILE *listfile;
;
;globalref int list_enable;
;globalref int file_line; /* set by read_line getting from file */
;globalref int obj_line; /* set by object code generated on line */
list_data_max = 132 /* max listing line length */
ram list_data,list_data_max+1 ; ram for listing line
ram list_dirty ; flag for listing line dirty
ram oldline,2 ; line number for last line in list
zpage list_pntr,2 ; pntr for reading the line
;
;
;
;
;
;0123456789 123456789 123456789 12
;EEEE PCPC OO OO OO OO NNNNN+ line text............
;
list_error_offset = 0
list_error_length = 5
list_pc_offset = 6
list_obj_offset = 11
list_obj_length = 10
list_line_offset = 23
list_macro_offset = 28
list_text_offset = 32
list_text_length = 133-list_text_offset /* len + 1 of text line */
;
line_number_init
ldi list_line_middle_text
std mid_line_pntr set up the middle lines
lda #0
tax xa <= 0000
ldy pass if pass one
bne list_enable_output
;
std page_number clear the page counter
sta list_line_count clear the lines this page counter
sta list_char_count clear the charecters on this line
std object_record_count clear number of object records sent
sta o_ndata clear object output counter
sta list_dirty mark list as clean
lda #$FF
sta object_wrap_flag output_wrap_flag <= $FF
;
ldy #text_name_end-text_name-1 set up name
10$ lda text_name,y
sta name,y
dey
bpl 10$
;
list_enable_output
lda #0
sta list_enable_main enable all listing options
sta list_enable_conditional
sta list_enable_gen
sta list_enable_macro
rts
;
list_line_middle_text
.byte cr,"ERROR ADDR CODE SEQ SOURCE STATEMENT",cr,0
; 123456789.123456789.123456789.123456789.
text_name
.byte ".MAIN.",0
text_name_end
;
;
;
; outerr(.a)
; adds .a to error feild
; increments error count
; returns c=1
;
outerr_at lda #'@ ; symbol table overflow
.byte $2c
outerr_question lda #'? ; assemebler is confused
.byte $2c
outerr_a lda #'A ; addressing error ( branch too far, etc )
.byte $2c
outerr_b lda #'B ; balance ( mispaired quotes etc )
.byte $2c
outerr_e lda #'E ; expression error
.byte $2c
outerr_f lda #'F ; feild error ( something not where expected )
.byte $2c
outerr_j lda #'J ; address space filled ( wrapped past $ffff )
.byte $2c
outerr_m lda #'M ; multiblby defined symbol
.byte $2c
outerr_n lda #'N ; nesting error ( mispaired macro/endm etc )
.byte $2c
outerr_o lda #'O ; the assembler does not support that opcode/macro.
.byte $2c
outerr_p lda #'P ; phase error, label does not have same value
; during pass 2 as during pass 1.
.byte $2c
outerr_q lda #'Q ; questionable syntax
.byte $2c
outerr_s lda #'S ; symbol error, reference to multibly defined symbol.
.byte $2c
outerr_u lda #'U ; symbol undefined.
.byte $2c
outerr_v lda #'V ; assembler cannot fit 16 bit value into 8 bit slot.
.byte $2c
outerr_w lda #'W ; wasted byte ( forward zero page reference caused a
; byte to be wasted )
.byte $2c
outerr_z lda #'Z ; division by zero error
;
;
; ram outerr_savex
; ram outerr_savey
;
;
outerr bit pass
bpl 90$
; stx outerr_savex
; sty outerr_savey
tax
ldy #0
10$ lda list_data+list_error_offset,y
cmp #$20
beq 20$
iny
cpy #list_error_length
bne 10$
dey
ldx #'*
20$ txa
sta list_data+list_error_offset,y
incd error_count
; ldx outerr_savex
; ldy outerr_savey
90$ sec
rts
;
;
ram output_offset
ram output_value,2
;
; outbyte spits out an object file byte byte at PC using Y
; as index past PC.
;
; this routine marks both the object file, and the list file.
;
; entry: .A = byte of object code
; .Y = position relative to PC
;
; exit:
;
outbyte bit pass
bpl 90$
sty output_offset
sta output_value
jsr out_o_byte ; write byte to object file
;
jsr list_find_obj_feild ; if cannot find room on this line
cpx #2
bcs 80$
jsr out_gen_check if should not list gen bytes here
bcs 90$ exit
;
jsr list_force_new_line force a new line
;
80$ lda output_value
jsr list_two_hex_chars
90$ clc
rts
;
outword bit pass
bpl 90$
sty output_offset
std output_value
; write low order to obj
jsr out_o_byte
ldy output_offset write high order to obj
iny
lda output_value+1
jsr out_o_byte
;
jsr list_find_obj_feild if cannot find room on line
cpx #4
bcs 80$
jsr out_gen_check if should not list gen bytes here
bcs 90$ exit
jsr list_force_new_line scuz a newline
;
80$ ldd output_value list output value
jsr list_four_hex_chars
90$ clc return happy
rts
;
;
out_gen_check
bit list_enable_gen if nogen
bmi 90$ exit no
lda list_data+list_macro_offset if macro line
beq 80$
bit list_enable_macro if .nmlist
bmi 90$ exit no
80$ clc exit yes
rts
;
90$ sec
rts
;
; list find obj feild
; if nothing listed in object feild for data
; forces location counter to be listed
;
; sets x to remaining number of bytes in obj feild
; sets y to pointer to second consecutive space in feild
;
list_force_new_line
ldi null_string force a new null line
jsr set_list
;
list_find_obj_feild
lda list_data+list_obj_offset if nothing in object feild
cmp #$20
bne 1$
ldd pc x,a <= pc + offset
ldy output_offset
jsr effective_address
ldy #list_pc_offset y <= poc offset
jsr list_four_hex_chars list 4 chars
;
1$ ldy #list_obj_offset-1
ldx #list_obj_length
;
10$ iny
lda list_data-1,y
ora list_data,y
cmp #$20
beq 20$
dex
bne 10$
20$ rts
;
;
;
; list_equate
; prints "=XXAA" in OBJ feild on list line
;
list_equate
bit pass
bpl 99$
ldy #'=
sty list_data+list_obj_offset
;
ldy #list_obj_offset+1
jmp list_four_hex_chars
99$ clc
rts
;
; list_pc
; prints PC in PC feild on list line
;
list_pc
bit pass
bmi 10$
clc
rts
10$ ldd pc
ldy #list_pc_offset
;
; list_four_hex_chars
; list_two_hex_chars
; list_one_hex_char
;
; prints hex chars for (X,A) on list line
; at offset specified by .y
; y points to next available location
;
;
list_four_hex_chars
pha
txa
jsr list_two_hex_chars
pla
list_two_hex_chars
pha
lsr a
lsr a
lsr a
lsr a
jsr list_one_hex_char
tax
pla
list_one_hex_char
and #$0f
ora #$30
cmp #$3a
bcc 20$
adc #$06
20$ sta list_data,y
iny
rts
;
;
;
;
;
set_list
bit pass
bpl 99$
phd save address of text
jsr flush_list flush the list buffer
;
ldx #list_text_offset ; mark list data area with spaces
lda #$20
1$ sta list_data,x
dex
bpl 1$
;
pld recall address of text
std list_pntr
ldy #0 copy line to list buffer
10$ lda (list_pntr),y
sta list_data+list_text_offset,y
iny
cmp #0
beq 20$
cpy #list_text_length
bne 10$
;
lda #0
sta list_data+list_text_length-1
;
20$ inc list_dirty mark the list as dirty
;
ldd current_line if this line is new input line
cpd oldline
beq 30$
std oldline
;
jsr format_decimal print the line number
ldx #$04
;
25$ lda format_decimal_text,x
sta list_data+list_line_offset,x
dex
bpl 25$
;
lda macro_expansion_depth if in a macro
beq 30$
ora #'@
sta list_data+list_macro_offset mark list
;
30$
;
99$ clc
rts
;
;
list_macro_call
lda #'+
sta list_data+list_macro_offset
clc
rts
;
;
;
; flush_list
; flushes listing line output buffer
;
flush_list
lda list_dirty if list line is dirty
beq 80$
;
lda list_data+list_error_offset if error on line
cmp #space
beq 10$
;
jsr open_error_channel_if_unique print to the error channel
ldi list_data
jsr print_null_terminated_string_cr
jmp 60$ also print to the listing channel
;
10$ bit list_enable_main if listing disabled
bmi 80$ abort
;
lda list_data+list_macro_offset if macro line
cmp #$20
beq 60$
;
cmp #'+ if macro call
bne 20$
ldx macro_expansion_depth if first level
dex
beq 60$ go print it
;
20$ ldx list_enable_macro if macro lines disabled
bmi 80$ abort
; if always allowed
beq 60$ go print line
;
lda list_data+list_obj_offset if no object code here
cmp #space
beq 80$ abort
cmp #'= if equate
beq 80$ abort
;
60$ lda list_channel if list channel is zero
beq 80$ abort
jsr open_list_channel open the listing channel
ldi list_data print the line in question
jsr print_null_terminated_string_cr
;
80$ ; fall through to mark list line as clean
; un_set_list
; allows directives to remove the default output caused by
; their line.
;
un_set_list
lda #0 clear the dirty flag
sta list_dirty
clc return happy
rts
;
;
list_error_count
jsr flush_list
jsr open_error_channel_if_unique
jsr 10$
jsr open_list_channel
10$ ldd error_count
jsr format_decimal
ldi format_decimal_text
jsr print_null_terminated_string
jsr primm
.byte " ERRORS DETECTED",cr,0
rts
;
;
;
; outobyte spits out an object file byte byte at PC using Y
; as index past PC.
;
; this routine marks both the object file, and the list file.
;
; entry: .A = byte of object code
; .Y = position relative to PC
;
;
max_o_ndata = 16 ; max number of data bytes per line
ram o_ndata ; number of data bytes
ram o_pc,2 ; output pc
ram o_data,max_o_ndata ; data bytes
ram o_sum,2 ; check sum for line
ram o_cpc,2 ; current byte pc
ram object_wrap_flag ; if 0 then user just wrote byte to $FFFF
ram object_record_count,2 ; number of records sent out obj thingy
;
out_o_byte
pha save data on stack
ldd pc calc address of byte
jsr effective_address
cpd o_cpc if not the next expected byte
bne 50$
;
ldy o_ndata if line not empty,
bne 1$
;
50$ phd save pc
jsr o_flush_obj flush the current line
pld recall pc
;
60$ std o_pc mark this pc
std o_cpc mark next expected byte
ldy #0 y <= 0
;
1$ pla place the data
sta o_data,y
iny point to next location
sty o_ndata
cpy #max_o_ndata if buffer now full
bcc 2$
jsr o_flush_obj go flush
; if wrap flag = 0 and address == 0
2$ lda object_wrap_flag
ora o_cpc
ora o_cpc+1
bne 3$
jsr outerr_j complain that user wrapped address space
; wrap_flag <= $ff
dec object_wrap_flag
;
3$ incd o_cpc calc next pc
;
bne 4$ if zero
;
inc object_wrap_flag wrap_flag <= zero
;
4$ rts return
;
;
;
; flush_obj
; causes last obj record to be sent, then the
; object list record terminator.
; o_flush_obj
; causes buffered obj record to be dumped
;
flush_obj
jsr o_flush_obj
jsr open_object_channel
lda #0 sum <= 0
sta o_sum
sta o_sum+1
lda #'; print semicolon
jsr print
lda #$00 print '00'
jsr o_sum_and_dump
ldd object_record_count print record count
jsr o_sum_and_dump_word
;
o_print_sum_cr ; print check sum
ldd o_sum
jsr print_hex_word
jmp print_cr print cr and return
;
o_flush_obj
lda o_ndata if number of object file bytes <> 0
beq 80$
; if object channel <> 0
lda object_channel
beq 80$
jsr open_object_channel open output to object channel
bcs 80$
;
incd object_record_count
;
lda #'; spit a semi colon
jsr print
;
lda o_ndata chgecksum <= number of bytes to send
ldx #0
std o_sum
jsr print_hex_byte print hex number of bytes to send
;
ldd o_pc spit four nybbles of PC
jsr o_sum_and_dump_word
;
ldx #0 spit the data bytes
10$ txa
pha
lda o_data,x
jsr o_sum_and_dump
pla
tax
inx
cpx o_ndata
bne 10$
jsr o_print_sum_cr
;
;
80$ lda #0 clear number of bytes on the line.
sta o_ndata
clc return happy
rts
;
o_sum_and_dump_word
pha ; save low order
txa ; do high order
jsr o_sum_and_dump
pla ; do low order
;
o_sum_and_dump
pha
clc
adc o_sum
sta o_sum
bcc 80$
inc o_sum+1
80$ pla
jmp print_hex_byte
;
;;

278
HCD65_3.5/parse.src
Unescape View File

@ -0,0 +1,278 @@
.page
.subttl "Parser Utils"
;******************************************************************************
; PARSER UTILS
;******************************************************************************
;
zpage parse_pntr,2
;
; delimit_label_oper
; chops up LINE.
; sets LABEL to point to the label feild string or to a NULL.
; sets OPER to point to operaetor feild
; sets ARGS to point to remander of string ( comment delimited ).
;
;
null_string
.byte 0
;
delimit_label_oper
;
ldi null_string label,oper,args <= null_string
std label
std oper
std args
;
ldi line parse_pntr <= base of line
std parse_pntr
;
jsr 100$ a <= first char
bcs 80$ exit iff comment or EOS
;
jsr isspace if not a space
bcc 20$
;
ldd parse_pntr mark start of label
std label
;
jsr parse_skip_nonwhite advance to first delimiting space
bcs 80$
;
lda #0 terminate label string here
sta (parse_pntr),y
;
jsr parse_advance point to next field
;
20$ jsr parse_skip_white skip_white
jsr 100$ exit iff comment
bcs 80$
;
ldd parse_pntr mark start of oper
std oper
;
jsr parse_skip_nonwhite advance past chars
bcs 80$ exit if end of string
;
lda #0
sta (parse_pntr),y mark end of oper string
;
jsr parse_advance point to next field
;
jsr parse_skip_white skip spaces
jsr 100$ exit iff comment or null
bcs 80$
ldd parse_pntr
std args mark arguement base
;
80$ clc return
rts
;
100$ ldy #0
lda (parse_pntr),y
beq 109$
cmp #';
bne 80$
109$ sec
rts
;
; oper_toupper
; force contents of oper to upper case
;
oper_toupper
ldy #$ff y <= -1
10$ iny do y++
lda (oper),y (oper),y <= toupper( (oper),y )
jsr toupper
sta (oper),y
cmp #0 until null encountered
bne 10$
clc return
rts
;
;
parse_skip_white
10$ lda (parse_pntr),y
beq 90$
jsr isspace
bcc 20$
clc
rts
;
20$ jsr parse_advance
bne 10$
;
90$ sec
rts
;
parse_advance
incd parse_pntr
rts
;
parse_skip_nonwhite
10$ lda (parse_pntr),y
beq 90$
jsr isspace
bcs 20$
clc
rts
20$ jsr parse_advance
bne 10$
;
90$ sec
rts
;
;
;
;
; comma_delimit_args
;
; chops up args string based on quotes and
; commas. leaves args string as seris of
; null terminated strings in args field.
; sets NARGS to number of args found.
;
comma_delimit_args
;
ldy #0 y <= 0
sty nargs nargs <= 0
;
10$ lda (args),y while not at EOS
beq 80$
cmp #';
beq 80$
jsr isspace
bcc 80$
;
20$ inc nargs do inc nargs
;
dey y--
;
30$ iny do get next char
33$ lda (args),y
beq 80$ exit iff EOS
jsr isspace if space
bcc 80$ exit ( no more args )
cmp #'; if semicolon
bne 40$
;
jsr 80$ terminate arg
jmp outerr_q output Q error, exit
;
40$ cmp #'' if dreaded single quote
bne 70$
;
ldd args find range
jsr range_of_single_quote ignore errors
dey back up a char
jmp 30$ loop
;
70$ eor #', until a comma
bne 30$
sta (args),y mark comma with null
iny point to next byte
jmp 10$ forever
;
80$ lda #0 mark exit char w/ null ( semi colon ? )
sta (args),y
rts
;
;
;
; delimit_single_arg
; delimits ARG for a single numeric value
; recognizes the following chars as universal delimiters:
; space,tab
; passes any commas or other punctation.
; implementes the single quote weirdness.
;
delimit_single_arg
ldy #0
sty nargs
;
lda (args),y if first char is null or space or ;
beq 90$
cmp #';
beq 90$
jsr isspace
bcs 10$
90$ sec return un happy ( args is 0 )
rts
;
10$ inc nargs nargs <= 1
;
20$ lda (args),y do if yth char is null
beq 80$ go exit hapopy
cmp #'; if yth char is ;
bne 30$
jsr 80$ terminate at ;
jsr outerr_q issue 'q error
clc return happy
rts
;
30$ jsr isspace if char is white
bcc 80$ go terminate and return happy
;
cmp #'' if its a quote (ARG!!)
bne 40$
ldd args find how many chars are invovled
jsr range_of_single_quote
jmp 20$ else
40$ iny point to next char
jmp 20$
;
80$ lda #0
sta (args),y
clc
rts
;
;
;
; range of single_quote
; this weird routine is called when a single quote is
; encountered in the args list stream.
;
; entry: (x,a),y points to single quote
; exit: parse_pntr destroyed
; x,a destroyed
; (oldx,a),y pointer to end of quoted thingie.
; c=1 y=0 routine misscalled
; c=1 y<>0 syntactical problem,
; y points to next bit
; c=0 y points to next bit
;
;
range_of_single_quote
std parse_pntr
lda (parse_pntr),y if yth char is not a
cmp #''
bne 90$ go return 0 chars un happy
;
iny if char 1 is null
lda (parse_pntr),y
beq 90$ go return 1 char, un happy
cmp #'' if char 1 is single quote
beq 70$ go return 2, happy
;
iny
lda (parse_pntr),y if char 3 is null
beq 80$ go return 2,happy
;
cmp #'' if char 3 is single quote
beq 70$ go return 3,happy
;
iny
lda (parse_pntr),y if char 4 is single quote
cmp #''
beq 70$ go return 4,happy
;
dey prepare to return 2 chars
lda (parse_pntr),y
jmp isspace return happy iff char 2 is white
;
70$ iny
80$ clc
rts
;
90$ sec
rts
;

791
HCD65_3.5/symbol.src
Unescape View File

@ -0,0 +1,791 @@
.page
.subttl "Symbol Table Management"
;
; SYMBOL TABLE MANAGEMENT
; -----------------------
; The symbol table manager provides the user with
; a seris of routines for managing the symbols within the
; cross assembler.
;
; It is designed for both local labels ( i.e. symbols of the
; form ( xxx$ ) where xxx is the decimal representaion of a
; number from 1 to 255 ) and normal symbols ( i.e those
; containging only letters, digits, underscores, and periods,
; but do not start with a digit ).
;
;
; The main software provides the following global locations
; for reference:
; current_line current line number
; value value ( for symbol definitions )
; pc current program counter value
;
;
; the main software is provided with the following calls
;
; symbol_init clears the symbol_table
;
; add_symbol adds a SYMBOL to the table
; may be called to redefine symbol values.
; entry: x,a point to null terminated string
; value = value of symbol
; exit: c=0 ok.
; c=1 symbol table overflow
; .y = "@" overflow char
;
; label_operation
; adds symbol as label if pass one
; checks symbol for label value match if pass 2
;
; eval_symbol returns value of a symbol.
; entry: x,a point to null terminate string.
; if symbol not in table, it is added
; as an undefined symbol.
; spits errors if pass 2 and errors occur.
; exit: x,a = value of label.
;
;
; symbol_table prints the symbol table to stdout.
;
;
; Internally the symbol table mamager maintains the symbol table,
; a temporary symbol structure ( current_symbol) and an buffer called
; local_symbol_name. local_symbol_name contains the delimiting symbol
; for the curent set of local labels.
;
;
;
; GLOBALS
; -------
; pc program counter ( 2 bytes )
; current_line current line number ( 2 bytes )
; pass pass number ( 1 byte = 1 or 2 )
;
; 0 1 23 456 7 n
; <len><type><value><linedef><locdef><text><0>
; len: single byte indicating size of definition
; ( pointer to next definition )
; type: single byte indicating status of symbol
; 0 = undefined
; 1 = SYMBOL
; 2 = LABEL
; 3 = MULIBLY DEFINED LABEL
; linedef: 3 byte binary line number of when symbol first defined
; locdef: single byte
; if null then <text> contains the label name
; else locdef is the local label value
; <text> is null.
; text: the text for the label.
;
type_undefined = 0 symbol if undefined
type_symbol = 1 symbol is defined symbol
type_label = 2 symbol is defined label
type_multilabel = 3 symbol is multibly defined label
;
;
symbol_len_offset = 0
symbol_type_offset = 1
symbol_value_offset = 2
symbol_linedef_offset = 4 ; lindef overwriten w/ alpha @ symbol table time.
symbol_alpha_offset = 4
symbol_local_offset = 6
symbol_name_offset = 7
max_symbol_len = 32
;
max_symbol_struct_len = max_symbol_len+symbol_local_offset+2
;
;
zpage current_symbol,max_symbol_struct_len+2 ; painful but efficient
current_symbol_name = current_symbol+symbol_name_offset
ram directive_local_cntr,2
ram largest_symbol
;
;
;
;*****************************************************************************
; indirection code
;*****************************************************************************
;
down_load_code
ldx #down_load_code_end-down_load_code_start-1
10$ lda down_load_code_start,x
sta down_load_code_base,x
dex
bpl 10$
rts
;
down_load_code_start ; mark start of down loaded code area
;
.ifgt current_symbol-$400
*** error *** current symbol not in shared ram
.endif
;
;
find_symbol = *+down_load_code_base-down_load_code_start
jsr first_symbol point to first_symbol ( slow but less code )
ldx #mmucr_bank1_ram select correct bank
stx mmucr
;
10$ sec do assume failure
ldy #0 if next symbol pntr == 0
lda (bank1_pntr),y
beq 80$ exit fail
tax save pntr to next symbol
ldy #symbol_local_offset y <= index of comparision -
lda (bank1_pntr),y if locals match
cmp current_symbol,y
bne 50$
20$ iny do y++
lda (bank1_pntr),y if yth char doesn't match
cmp current_symbol,y
beq 30$
50$ txa recall offset
clc add to pntr
adc bank1_pntr
sta bank1_pntr
bcc 10$
inc bank1_pntr+1
bne 10$ goto top loop
;
30$ cmp #0 until .a == 0
bne 20$
clc ok
;
80$ ; fall through to bank1_lda to return (carry preserved,less code)
;
bank1_lda = *+down_load_code_base-down_load_code_start
ldx #mmucr_bank1_ram
stx mmucr
ldx #mmucr_bank0_normal ; select bank 0
lda (bank1_pntr),y ; read it
stx mmucr ; restore mmu
rts ; return
;
bank1_sta = *+down_load_code_base-down_load_code_start
ldx #mmucr_bank1_ram ; select bank1
stx mmucr
ldx #mmucr_bank0_normal
sta (bank1_pntr),y ; write it
stx mmucr ; return mmu
rts ; return
;
;
;
down_load_code_end ; mark end of downloaded code area
down_load_code_space = down_load_code_max-down_load_code_base
down_load_code_len = down_load_code_end-down_load_code_start
;
.ifgt down_load_code_len-down_load_code_space
*** ERROR *** downloaded code too large
.endif
;
;
;
;
init_symbol_table
bit pass if pass one
bmi 10$
;
jsr first_symbol
lda #0 largest symbol == null length
sta largest_symbol
jsr bank1_sta make first symbol null length
;
10$ lda #$01 local_cntr <= two non zero digits
sta directive_local_cntr+1
sta directive_local_cntr
rts
;
;
first_symbol ; point to first symbol
ldi symbol_table_start
std bank1_pntr
ldy #0
jmp bank1_lda return length of symbol in .a
;
next_symbol
ldy #0 if not at a null
jsr bank1_lda
beq 10$
;
clc bank1_pntr += (bank1_pntr)
adc bank1_pntr
sta bank1_pntr
bcc 10$
inc bank1_pntr+1
;
10$ jmp bank1_lda return length of symbol in .a
;
read_this_symbol
std bank1_pntr
;
read_symbol ; copy symbol from bank1_pntr to current_symbol
ldy #0 y <+ (bank1_pntr) (length)
jsr bank1_lda
tay if > max length allowed
dey
cpy #max_symbol_struct_len+1
bcc 10$
;
sec return unhappy
rts
;
10$ jsr bank1_lda copy y bytes to current_symbol
sta current_symbol,y
dey
bpl 10$
clc return happy
rts
;
;
;
store_symbol ; copys current_symbol too symbol_table
; y <= the length of the symbol structure to save
; ( carry preserved )
; exit: c=0 ok, symbol stored
; c=1,y=@ symbol table overflow
;
ldy #0 if overwriting previous description
jsr bank1_lda
beq 5$
;
ldy #symbol_local_offset y <= number of bytes to copy
; ( just the data, not the name )
bne 50$ else
;
;
; at this point we know we wish add a symbol to the table.
; the bank1_pntr points to the null at the current end of
; the symbol table.
;
5$ ldy #symbol_name_offset y <= number of bytes in symbol
10$ lda current_symbol,y
beq 20$
iny
cpy #max_symbol_struct_len ( clip iff too many )
bne 10$
;
lda #0
sta current_symbol,y
;
;
20$ iny .a <= offset to following symbol
lda #0
sta current_symbol,y tack the null on the end
sty current_symbol current symbol <= offset to null
;
tya .a <= length of this addition
;
ldx bank1_pntr+1 x,a <= .a + bank1_pntr
clc
adc bank1_pntr
bcc 25$
inx
25$ cpi symbol_table_end if >= end of symbol_table
bcc 30$
lda #'@ symbol table overflow !!!!
sec gag puke
rts return
;
30$ cpy largest_symbol if y > largest_symbol
bcc 50$
;
sty largest_symbol largest_symbol <= .y
;
50$ lda current_symbol,y copy the data to bank one
jsr bank1_sta
dey
bpl 50$
clc return happy
rts
;
;
;
;
;
; compare_symbol entry: current_symbol has name of a legal symbol
; symbols are lexographicically compared.
; exit: z,c are as if you could say:
; lda (bank1_pntr),y
; cmp current_symbol
;
compare_symbol
ldy #symbol_local_offset if locals match
jsr bank1_lda
cmp current_symbol,y
bne 80$
;
10$ iny do iny
jsr bank1_lda read a byte of symbol
cmp current_symbol,y if <> current symbol
bne 80$ break
cmp #0 until at terminating nulls
bne 10$ loop
;
80$ rts return
;
;
.ife 1
;
; find_symbol entry: current_symbol set up with name of
; legal symbol.
;
; exit: c = 1 symbol not in table
; ( bank1_pointer at end of table )
; c=0 symbol in table
; ( bank1_pntr at base of symbol )
;
find_symbol
;
jsr first_symbol point to first symbol (.a == len,c=1ifa=0)
bne 20$ if there goto middle of loop
;
10$ jsr next_symbol do point to next symbol
bne 20$ if not there
sec puke ola
rts
;
20$ jsr compare_symbol until matches current symbol
bne 10$
80$ clc return happy
rts
;
.endif
;
;
zpage ext_symbol_pntr,2
;
;
; legal_symbol
; entry: x,a point to a symbol string
; exit: c=0 symbol is legal.
; current_symbol_name = name of symbol
; if local, then local feild <> 0
; c=1 symbol is illegal.
;
;
;
legal_symbol
std ext_symbol_pntr stuff the pointer
ldy #0 clear the local feild
sty current_symbol+symbol_local_offset
;
lda (ext_symbol_pntr),y load the first char
beq 90$ puke if null string...
;
jsr isdigit if its a digit
bcs 30$
;
10$ lda (ext_symbol_pntr),y while char is a digit
jsr isdigit
bcs 20$
;
and #$0F do mask high order bits
ldx #10 local <= 10*local+.acc
15$ adc current_symbol+symbol_local_offset
bcs 90$ ( puke if overflow )
dex
bne 15$
sta current_symbol+symbol_local_offset
;
iny point to next char
bne 10$
;
20$ cmp #'$ if not '$
bne 90$ puke
iny
lda (ext_symbol_pntr),y if next not a null
bne 90$ puke
; install symbol trailing null
sta current_symbol+symbol_name_offset+2
ldd directive_local_cntr mark local value stuff
std current_symbol+symbol_name_offset
;
ldy #2 y <= pointer to null in name
jmp 50$ else
;
30$ lda (ext_symbol_pntr),y do copy upper case to current symbol
jsr toupper
sta current_symbol+symbol_name_offset,y
jsr islegalsymbolchar if illegal char
bcs 40$ break
iny
cpy #max_symbol_len
bne 30$
lda #0 ( clip if too long )
40$ cmp #0 if not null
bne 90$ puke ( illegal symbol )
; mark trailing null
sta current_symbol+symbol_name_offset,y
;
; at this point the local or global symbol has been copied to the
; current symbol, and .y = the offset to the trailing null.
;
50$ tya
adc #symbol_name_offset+1
sta current_symbol
clc
rts
;
90$ sec
rts
;
;
; .local directive
; selects a new unwige local label string
; creates overflow if all used
;
directive_local
inc directive_local_cntr inc low order
bne 10$ if zero
inc directive_local_cntr inc low order
inc directive_local_cntr+1 inc high order
bne 10$ if zero
jsr outerr_at symbol table overflow
10$ sec return no bytes used
rts
;
;
;***************************************************************************
; LABEL_OPERATION
;***************************************************************************
label_operation
ldd label copy symbol to current symbol
jsr legal_symbol if illeagl
bcc 5$
jmp outerr_q puke
;
; if symbol is not local
5$ lda current_symbol+symbol_local_offset
bne 10$
jsr directive_local delimit locals
;
10$ jsr find_symbol look for the symbol
bcs 50$ if found
;
jsr read_symbol read the damn thing
bit pass if pass 1
bmi 20$
;
; PASS1, LABEL FOUND & READ IN
;
lda #type_multilabel mark as multi label
sta current_symbol+symbol_type_offset
jmp store_symbol store the symbol & return
;
; PASS2, LABEL FOUND & READ IN
;
20$ jsr xref_definition
;
lda current_symbol+symbol_type_offset if multilabel
cmp #type_multilabel
bne 25$
jmp outerr_m M error,return
;
25$ cmp #type_label if label
bne 30$
ldd pc if value <> PC
cpd current_symbol+symbol_value_offset
beq 28$
jmp outerr_p PHASE ERROR !
28$ clc return happy
rts
;
30$ jsr outerr_p PHASE ERROR !
lda #type_multilabel mark as multi label
jsr store_symbol store the symbol
bcc 38$ if error
jsr outerr spit error
38$ rts return happy
;
; ---> LABEL NOT FOUND <---
;
50$ lda pass if pass 1
bne 60$
;
; PASS1 LABEL NOT FOUND
;
lda #type_label mark as label
sta current_symbol+symbol_type_offset
ldd current_line mark line
std current_symbol+symbol_linedef_offset
ldd pc mark value
std current_symbol+symbol_value_offset
jmp store_symbol go store the symbol and return
;
; PASS2 LABEL NOT FOUND
;
60$ jsr xref_definition
lda #type_undefined mark as undefined
sta current_symbol+symbol_type_offset
jsr store_symbol store it
bcs 90$ if no error returned
lda #'P complain about phase
90$ jmp outerr return error
;
;
;
;
; add_symbol adds a SYMBOL to the table
; may be called to redefine symbol values.
; entry: x,a point to null terminated string
; value = value of symbol
; exit: c=0 ok.
; c=1 symbol table overflow
; .y = "@" overflow char
;
;
add_symbol
jsr legal_symbol if illegal
bcc 10$
lda #'Q quetion that.
rts
;
10$ jsr find_symbol if not found
bcc 20$
; mark current symbol as undefined
lda #type_undefined
sta current_symbol+symbol_type_offset
jmp 30$
; else copy symbol to current symbol
20$ jsr read_symbol
;
; if symbol undefined
30$ lda current_symbol+symbol_type_offset
cmp #type_undefined
bne 50$
;
lda #type_symbol mark as symbol
sta current_symbol+symbol_type_offset
; copy line number across
ldd current_line
std current_symbol+symbol_linedef_offset
;
45$ ldd value copy value into symbol
std current_symbol+symbol_value_offset
;
jmp 80$
;
50$ cmp #type_symbol if symbal already defined as symbol
beq 45$ go copy the new value, store and return
;
lda #type_multilabel mark as mulibly defined label
sta current_symbol+symbol_type_offset
;
80$ jsr xref_definition
jmp store_symbol store symbol_and return
;
;
;
; eval_symbol
; eval_symbol returns value of a symbol.
; entry: x,a point to null terminate string.
; if symbol not in table, it is added
; as an undefined symbol.
; errors are spit out.
; exit: value = value of label.
; valflg bits set
;
; forward reference
; undefined
; syntax
;
; c=0 cool man, cool.
; c=1 error occured
;
eval_symbol
jsr legal_symbol if illegal
bcc 10$
;
jmp eval_syntax syntax_error
;
10$ jsr find_symbol if cannot be found
bcc 20$
;
lda pass if pass 2
bpl 15$
lda #type_undefined mark as undefined
sta current_symbol+symbol_type_offset
jsr store_symbol store in table
;
jsr xref_access tell xref
15$ jmp eval_undefined return undefined error
;
;
20$ jsr xref_access tell xref
jsr read_symbol read symbol into current symbol
;
lda current_symbol+symbol_type_offset
cmp #type_undefined if undefined
bne 25$
jmp eval_undefined return such to eval
;
25$ cmp #type_multilabel if multi label
bne 30$
;
jsr outerr_s outerr an 'S'
;
30$ ldd current_symbol+symbol_value_offset
std value copy value to value
;
; if forward reference
40$ ldd current_line
cpd current_symbol+symbol_linedef_offset
bcs 50$
;
jmp eval_forward_reference tell eval
;
50$ clc return
rts
;
;
; is_symbol_defined
; used by ifdef,ifndef conditional checks.
; just returns whether symbol is leaglly defined.
; does not affect symboltable, cross reference, nor
; errors
;
;
;
;
is_symbol_defined
jsr legal_symbol if illegal
bcs 90$ puke
;
jsr find_symbol if cannot be found
bcs 90$ puke
;
jsr read_symbol read symbol into current symbol
;
lda current_symbol+symbol_type_offset
cmp #type_undefined if undefined
beq 90$ puke
; if not yet defined
ldd current_symbol+symbol_linedef_offset
cpd current_line
; return c=1
90$ rts
;
;
;
; symbol table
; this routine causes the symbol table to be printed.
; in the process of printing the symbol table, the
; value feild in teh symbol structure is overwritten with
; an index describing the alphabetical postion of the
; symbol. This is used by the cross reference software.
; the type feild in the structure is set to type_cross_ref
; once the symbol is printed. this is also used by the
; xref util. local symbols are ignored.
;
symbol_table_text
.byte cr,tab,tab,tab,"SYMBOL TABLE",cr
.byte tab,"<BLANK> = LABEL, <=> = SYMBOL, <+>= MULTIBLY DEFINED",cr,0
;
ram alpha_order,2
;
symbol_table
lda #0 alpha order <= 0
sta alpha_order
sta alpha_order+1
;
ldi symbol_table_text set up symbol table text...
std mid_line_pntr
;
jsr list_enable_output enable all outputs
jsr open_list_channel
jsr top_of_form do a page
;
;
1$ jsr first_symbol do iff no symbols
bne 10$ exit
rts
10$ jsr read_symbol do read symbol
lda current_symbol+symbol_local_offset if local
beq 20$
jsr next_symbol point to next symbol
bne 10$ loop if present
rts
;
20$ jsr next_symbol while more symbol
beq 50$
jsr compare_symbol do if >= than current_symbol
bcs 20$ loop
;
jsr read_symbol read it into current symbol
jmp 20$
;
;
50$ lda largest_symbol if not room on this line
jsr is_there_room_on_this_line
bcc 60$
jsr print_cr print a cr
;
60$ jsr print_symbol print this symbol
jsr print_space some space would be nice
jsr print_space
;
70$ jsr find_symbol refind the symbol
; mark it as local so we won't consider it
; again.
dec current_symbol+symbol_local_offset
incd alpha_order alpha_order++
ldd alpha_order mark alpha order
std current_symbol+symbol_alpha_offset
jsr store_symbol store (trash ) it.
jmp 1$ go see if more symbols to print
;
;
;
;
; print_symbol
; entry: current_symbol has a symbol in it.
;
; prints symbol in current symbol along with
; value and typeing information
;
;
ram print_symbol_temp
;
print_symbol
;
ldx #7 print name
stx print_symbol_temp
;
10$ ldx print_symbol_temp
lda current_symbol+symbol_name_offset-7,x
beq 20$
jsr print
inc print_symbol_temp
bne 10$
;
20$ ldx print_symbol_temp
cpx largest_symbol
bcs 30$
jsr print_space
inc print_symbol_temp
bne 20$
;
30$ ldx current_symbol+symbol_type_offset
cpx #type_undefined
bne 40$
jsr primm
.byte " ****",0
rts
;
40$ lda #'='
cpx #type_symbol
beq 70$
lda #' '
cpx #type_label
beq 70$
lda #'+
70$ jsr print
ldd current_symbol+symbol_value_offset
jmp print_hex_word
;
;

821
HCD65_3.5/util.src
Unescape View File

@ -0,0 +1,821 @@
.page
.subttl "Output utilities
ram current_channel
;
_chkin cpx current_channel
bne 10$
clc
rts
10$ stx current_channel
jsr clrch
ldx current_channel
chkin jsr __chkin
jmp delay_150
;
open_list_channel
ldx list_channel
jmp _ckout
;
open_object_channel
ldx object_channel
jmp _ckout
;
open_error_channel_if_unique
ldx error_channel
cpx list_channel
beq _clrch
jmp _ckout
;
open_error_channel
incd error_count
ldx error_channel
jmp _ckout
;
open_xref_channel
ldx #xref_channel
jmp _ckout
;
_ckout cpx current_channel
bne 10$
clc
rts
;
10$ stx current_channel
jsr clrch
ldx current_channel
ckout jsr __ckout
jmp delay_150
;
_clrch lda #0
sta current_channel
clrch jsr __clrch
;
delay_150 ; .a, .c preserved
ldx #30
10$ dex
bpl 10$
rts
;
open jsr __open
jmp delay_150
;
close jsr __close
jmp delay_150
;
;
zpage pnts_pntr,2
;
print_tab
lda #tab
.byte $2c
print_space
lda #space
print ldx current_channel if current channel <> 0
beq 80$
cpx list_channel if list channel
bne 70$
;
ldx list_line_count if first line on page
bne 40$
ldx formln andif formln <> 0
beq 40$
;
pha stack all temps
ldd pnts_pntr used by page_header
phd
;
ldx #5 greasy greasy greasy
20$ lda format_decimal_text,x
pha
dex
bpl 20$
;
inc list_line_count
jsr print_page_header print the page header
dec list_line_count
;
ldx #0 restore all temps used
30$ pla by page header
sta format_decimal_text,x
inx
cpx #6
bcc 30$
;
pld
std pnts_pntr
pla
;
40$ cmp #cr if <Cr>
bne 50$
jsr bsout print it
;
ldx #0 char count <= 0
stx list_char_count
ldx list_line_count x <= line count +1
inx
cpx formln if >= formln
bcc 45$
ldx #0 x <= 0
45$ stx list_line_count line_count <= x
jmp 80$ exit
;
50$ cmp #tab if tab
bne 60$
;
55$ lda #space do .a <= space
jsr 60$ cionditionally printit
lda list_char_count until at tabstop
and #%0000111
bne 55$
rts return
;
60$ ldx list_char_count if char count++ < width
inc list_char_count
cpx list_channel_width
bcs 80$
70$ jsr bsout print the char
80$ rts return
;
.page
.subttl "Utilities"
;
; UTILS:
;
; strlen entry: x,a pointer to string
; exit: if string longer than 255 chars
; c=1, y=0
; else c=0
; y = number of chars
; z = 1 iff y==0
;
zpage strlen_pntr,2
;
strlen std strlen_pntr
ldy #0
1$ lda (strlen_pntr),y
beq 80$
iny
bne 1$
sec
rts
;
80$ cpy #0
clc
rts
;
; ishex:
; if .a is legal hexadecimal digit
; retun c=0
; else c = 1
;
ishex pha save char
jsr toupper if .a is alpha , convert to upper case
bcs 90$ break is not alhpa
cmp #'G set carry if > G
pla restore stack
rts return
;
90$ pla restore stack
; fall through to isdigit
;
; isdigit:
; if .a is a legal decimal digit
; c = 0
; else c=1
; x,y preserved
;
isdigit cmp #'0
bcc 90$
cmp #'9'+1
rts
90$ sec
rts
;
; return c=0 iff .a = tab or space or shifted space !!!!!
;
isspace cmp #$20
beq 80$
cmp #$9
beq 80$
cmp #$a0
beq 80$
sec
rts
;
80$ clc
rts
;
;
islegalsymbolchar
cmp #$a0 if higher that controls
bcs 80$ ok
cmp #$80 if upper set of controls
bcs 90$ error
cmp #$41 if 'A or above
bcs 80$ ok
cmp #$3b if symbols ;<=>?@
bcs 90$ error
cmp #$30 if digit or colon
bcs 80$ ok
cmp #$2e if period
beq 80$ ok
cmp #$27 if symbols ()*+,-/'
bcs 90$ error
cmp #$23 if symbols #$%&
bcs 80$ ok
; if controls or space or symbols !"
90$ sec error
rts
80$ clc
rts
;
;
;
;
;
zpage str_pntr_y,2
zpage str_pntr_xa,2
;
; str_read_args
; pntr1 <= (y)
; pntr2 <= x,a
;
str_read_args
std str_pntr_xa
lda 0,y
ldx 1,y
std str_pntr_y
rts
;
; strend
; entry y points to a pointer pointing to a string_1
; x,a points to a different string_2
;
; returns c=0 iff string_1 ends in string_2
;
strend jsr str_read_args ; pntr_2 <= search string
; ; pntr_1 <= original long string
;
10$ ldy #0 ; while pntr_1 does not point to null string
lda (str_pntr_y),y
beq 90$
ldy #0 ; do y <= 0
15$ lda (str_pntr_xa),y ; do if (pntr2),y == 0
bne 20$
clc ; return happy
rts
;
20$ cmp (str_pntr_y),y ; if (pntr2)<>(pntr1)
bne 30$ ; break
;
iny ; y++
jmp 15$ ; loop
;
30$ incd str_pntr_y ; pntr_1 ++
jmp 10$
;
90$ sec ; return pissed
rts
;
;
;
; str_append
; entry y points to a pointer pointing to a string_1
; x,a points to a different string_2
;
; appends string2 to string1
;
; returns c=0 iff ok.
; returns c=1 iff composite length > 255 chars.
;
str_append
jsr str_read_args read args
;
1$ ldy #0 do if (pntr1) == 0
lda (str_pntr_y),y
beq str_append_entry go copy (pntr2) to pntr1)
incd str_pntr_y advance pntr 1
jmp 1$ forever
;
;
;
.ife 1
; str_cpy
; copy string pointed to by x,a to location pointed
; too by pointer @ y.
;
;
strcpy jsr str_read_args
ldy #0
.endif
str_append_entry
10$ lda (str_pntr_xa),y
sta (str_pntr_y),y
beq 80$
iny
bne 10$
dey
lda #0
sta (str_pntr_y),y
sec
rts
;
80$ clc
rts
;
;
; strcmp string copmparision utility
;
; entry y points to a pointer pointing to a string1
; x,a points to a string 2
; exit z=1:c=0 string1 = string 2
; z=0:c=1 string1 != string 2
;
strcmp jsr str_read_args
ldy #0
10$ lda (str_pntr_xa),y
cmp (str_pntr_y),y
bne 90$
tax
beq 80$
iny
bne 10$
;
txa
;
90$ sec
rts
;
80$ clc
rts
;
; strstrt
; returns c=0 if string (Y) starts with contents of string (XA)
;
; entry: x,a = pointer to start string
; y = address of pointer to long string
;
; return c=0 if long string starts with start string.
; else return c=1
;
strstrt jsr strcmp return results based on last byte of strcmp
cmp #0 ( set carry )
bne 80$ if last byte was null
clc clear carry
80$ rts return
;
;
; just like strcmp except that
; string x,a must be in upper case and
; routine is insensitive to case of string y
;
strcmp_toupper
jsr str_read_args read args
;
ldy #0 y <= 0
10$ lda (str_pntr_y),y do if (xapntr) <> toupper ((ypntr))
jsr toupper
cmp (str_pntr_xa),y
bne 90$ puke
tax if .a == null
beq 80$ exit happy
iny y++
bne 10$ while y <> 0
txa
90$ sec puke
rts
;
80$ clc happy exit
rts
;
; strstrt_toupper
; just like strstrt except that
; string x,a must be in upper case and
; routine is insensitive to case of string y
;
strstrt_toupper
jsr strcmp_toupper if strcmp_toupper failes
bcc 10$
lda (str_pntr_xa),y if last byte checked was null
bne 10$
clc uh. we were really happy
10$ rts return
;
;
;
; string_advance
; entry: .x = zero page address of string pointer
; exit: string pointer advanced to start of next string
; .x,.y preserved = unchanged
;
;
string_advance
1$ lda (0,x)
inc 0,x
bne 10$
inc 1,x
10$ cmp #0
bne 1$
rts
;
;
ram effective_address_temp
;
effective_address ; x,a <= x,a + y
sty effective_address_temp
clc
adc effective_address_temp
bcc 10$
inx
10$ clc
rts
;
.ife 1
; isalnum returns c=0 if .a = a-z or A-Z or 0-9
;
isalnum jsr isdigit
bcs isalpha
rts
;
.endif
; isalpha if .a is a-z or A-Z or petscii A-Z
; return c=0
;
isalpha cmp #'A
bcc 90$
cmp #'Z'+1
bcc 80$
cmp #'a'
bcc 90$
cmp #'z'+1
bcc 80$
cmp #193
bcc 90$
80$ cmp #219
rts
;
90$ sec
rts
;
;
; toupper converts .a from lower case to upper case
;
toupper jsr isalpha ; if its not a letter
bcs 90$ ; go return c=1
80$ and #%00011111 ; move to upper case range
ora #%01000000 ; return c=0
90$ rts
;
.ife 1
; tolower converts .a from lower case to upper case
;
tolower jsr toupper ; greasy isn't it ?
cmp #'A
bcc 90$
cmp #'Z'+1
bcs 90$
;
80$ ora #%00100000
90$ clc
rts
;
.endif
exptab .byte 1,2,4,8,$10,$20,$40,$80
;
;
;
print_hex_word
pha
txa
jsr print_hex_byte
pla
print_hex_byte
pha
lsr a
lsr a
lsr a
lsr a
jsr print_hex_digit
pla
print_hex_digit
and #$0f
ora #$30
cmp #'9'+1
bcc 10$
adc #6
10$ jmp print
;
;
; print_null_terminated_string_cr
; prints the ttext string pointed to by x,a followed by cr
; print_null_terminated_string
; prints the ttext string pointed to by x,a
;
;
print_null_terminated_string_cr
jsr print_null_terminated_string
print_cr lda #$0d
jmp print
print_null_terminated_string
std pnts_pntr ; set up pointer
;
primm_entry
10$ ldy #0 ; do a <= char at pointer
lda (pnts_pntr),y
bne 20$ ; if null
rts ; return
20$ jsr print ; print the char
incd pnts_pntr
bne 10$ ;loop ( pretty safe bet.. )
;
;
primm_to_error_channel
jsr open_error_channel open the error channel
jsr primm print the first part of the message
.byte "ERROR: ",0
; fall through to print the rest of the message
;
primm pla list_pntr <= return address+1
sta pnts_pntr
pla
sta pnts_pntr+1
incd pnts_pntr
;
jsr primm_entry print null terminated from there
; restack return address ( points to null at EOS)
80$ lda pnts_pntr+1 return to it
pha
lda pnts_pntr
pha
rts
;
;
;
;******************************************************************************
; format decimal routime
;******************************************************************************
;
;
; format_decimal
; entry: x,a <= 16 bit binary number
; exit: loc,loc+4 <= 5 digits to decimal text
; with leading zeros suppressed
;
ram format_decimal_text,6
ram format_decimal_temp,2
;
print_decimal
jsr format_decimal
ldi format_decimal_text
jmp print_null_terminated_string
;
;
format_decimal
std format_decimal_temp temp <= binary
ldy #0 y <= 0
sty format_decimal_text+5
lda #$20 .a <= $20
10$ sta format_decimal_text,y do text,y <= .a
20$ sec do a,x <= temp-100$,y
lda format_decimal_temp
sbc 100$,y
tax
lda format_decimal_temp+1
sbc 110$,y
bcc 30$ if > 0
sta format_decimal_temp+1 temp <= a,x
stx format_decimal_temp
lda format_decimal_text,y text ++ or $30
adc #00
ora #$30
sta format_decimal_text,y
jmp 20$ loop
;
30$ lda format_decimal_text,y .a <= $30 or $20
and #$f0
iny y++
cpy #$05 until y==5
bne 10$
;
lda format_decimal_text+4 force last digit to be not a space
ora #$30
sta format_decimal_text+4
;
clc return happy
rts
;
100$ .byte <10000,<1000,<100,<10,<1
110$ .byte >10000,>1000,>100,>10,>1
;
;
; classify char
; sets flags in .a based on value of .a
;
; this routine checks the char in .a for the delmiting
; chars most internal parsers need.
; .a is destroyed.
;
; the order of args was chosen carefully for this application.
;
; its not pretty but it is optimized for the charset
;
; input char output
; $00 null %10000000
; $3b ; %01000000
; $20 space %00100000
; $09 tab %00010000
; $2c comma %00001000
; $22 " %00000100
; $27 ' %00000010
; $3d = %00000001
; other %00000000
;
;
classify_char
cmp #$3d if =
beq 80$ ok
;
bcs 90$ if > '=`, exit unknown
;
cmp #$a0 if shifted space
beq 85$ ok, exit
;
cmp #$20 if space
beq 85$ ok , exit
;
bcs 10$ if < space
cmp #$09 if tab
beq 84$ ok
;
cmp #0 if null
beq 87$ ok
bne 90$ unknown
;
10$ cmp #$2c if comma
beq 83$ ok
bcs 20$ if < comma
;
cmp #$27 if single quote
beq 81$ ok
cmp #$22 if double quote
beq 82$ ok
bne 90$ error
;
20$ cmp #$3b if ;
beq 86$ ok
90$ lda #%00000000 unknown
rts
;
80$ lda #%00000001 equals
rts
81$ lda #%00000010 single quote
rts
82$ lda #%00000100 double quote
rts
83$ lda #%00001000 comma
rts
84$ lda #%00010000 tab
rts
85$ lda #%00100000 space
rts
86$ lda #%01000000 semi colon
rts
87$ lda #%10000000 null
rts
;
;
ram zero_page_store,zero_page_save_top-zero_page_save_bot+1
;
save_zero_page
sec
.byte $24
restore_zero_page
clc
ldx #zero_page_save_top-zero_page_save_bot
10$ lda zero_page_store,x
bcc 20$
lda zero_page_save_bot,x
sta zero_page_store,x
20$ sta zero_page_save_bot,x
dex
bne 10$
rts
;
;
;
; the page header is roginizeed into several differenent feilds
; on several lines as follows:
;
; <name><program><user_message><pagenum>
; <subtttl><source_file>
; <mid_lines>
;
; where <name> is either a null name, or a string
; supplied by the source code in a .NAME directive.
; <program> the string "HCD65XX version 0.8"
; <user_message> is text suppied by the basic program at
; run time. generally this is for the
; date feild.
; <pagenum> is the page number.
;
; <subttl> is text supplied by the users .SUBTTL directive.
; <source_file> is the file which the source is being read from
; at the time the page header was generated.
;
; <mid_lines> is text which changes based on what is on the
; page. I.E. the symbol table, the cross reference
; and the actual source code.
;
;
print_page_header
lda page_number if this is the first page
ora page_number+1
bne 10$
;
inc list_line_count fake ourselves into thinking we're
inc list_line_count further down ( make page happen early )
jmp 20$ else
;
10$ jsr primm print a pair of crs to move to real page
.byte cr,cr,0
;
20$ jsr primm print some crs.
.byte cr,cr,0
;
ldi name print the name
jsr print_null_terminated_string
;
jsr primm print version info
.byte tab,"HCD65XX "
version
.byte tab,0
;
ldi date_string print user supplied date
jsr print_null_terminated_string
;
30$ jsr print_tab do print a tab
lda #15+8 while theres room for 15 cahrs + tab.
jsr is_there_room_on_this_line
bcc 30$
;
jsr primm print the page number
.byte "PAGE ",0
incd page_number increment page number
ldd page_number
jsr print_decimal
jsr print_cr new line..
;
ldi subttl print subttl
jsr print_null_terminated_string
;
40$ jsr print_tab do print a tab
ldi file_name .a <= 8 + length of file name.
jsr strlen
tya
adc #$08 while room for that many chars on this line.
jsr is_there_room_on_this_line
bcc 40$
;
;
ldi file_name print filename w/ cr
jsr print_null_terminated_string_cr
;
ldd mid_line_pntr print middle bits w/ a cr
jmp print_null_terminated_string_cr
;
;
; is_there_room_on_this_line ( list channel only of course )
; entry: .a = number of chars you're gonna print
; exit: c=0 will fit on line
; c=1 will not fit on line
;
;
is_there_room_on_this_line
clc
adc list_char_count
bcs 90$
cmp list_channel_width
90$ rts
;
kill_basic_irqs
lda init_status
and #%11111110
sta init_status
rts
;
enable_basic_irqs
lda init_status
ora #%00000001
sta init_status
rts
;
;

504
HCD65_3.5/xref.src
Unescape View File

@ -0,0 +1,504 @@
.subttl "CROSS REFERENCE SOFTWARE"
;***************************************************************************
; xref software
;***************************************************************************
;
ram xref_mode
; ram xref_buf,256 globally declared for unusual location
;
ram xref_pntr,2
ram xref_start_col ; coloumn to start printing references in.
;
;
;
; called by eval opcode to indicate that a reference is
; write type ( as opposed to read ).
;
;
xref_write_if_carry
ror xref_mode
rts
;
; called by eval_symbol to indicate a reference to a symbol
;
xref_access
lda #space
bit xref_mode
bpl xref_output_reference
lda #'$
bne xref_output_reference
;
; called by add_symbol,add_label to inicate a symbol is being
; assigned a value here.
;
xref_definition
lda #'#
; jmp xref_output_reference
;
;
xref_output_reference
bit pass if pass2
bpl 99$ if not local
ldx current_symbol+symbol_local_offset
bne 99$
pha save ref
lda bank1_pntr spit bank 1 pntr
jsr xref_byte
lda bank1_pntr+1
jsr xref_byte
lda current_line spit line of reference
jsr xref_byte
lda current_line+1
jsr xref_byte
pla spit saved ref
jmp xref_byte
99$ rts return
;
; xref_byte spits a byte out the xref channel
;
;
xref_byte
ldx xref_pntr place byte in buffer
sta xref_buf,x
inc xref_pntr inc pointer
cpx #254-1 if not full
beq xref_flush_xref
rts return
;
;
;
; xref_flush_xref
; this is the internal flush xref for when
; xref is feeling consipated and wishes to
; flush self.
;
xref_flush_xref
ldx xref_pntr if xref buffer not empty & device <> 0
beq 80$
;
ldx xref_device
beq 80$
;
jsr open_xref_channel open the xref channel
;
ldx #0 x <= 0
10$ txa do save .x
pha
lda xref_buf,x print buf,x
jsr print
pla recall .x
tax
inx x++
cpx xref_pntr until x==xref_pntr
bne 10$
;
80$ lda #0 xref_pntr <= 0
sta xref_pntr
rts return
;
;
;
; flush_xref caues xref buf to be flushed.
; causes symbol table to be printed.
;
flush_xref
lda xref_device if xref file here
beq 9$
jsr xref_flush_xref flush the reference buffer
jsr xref_close close the file
9$ rts
;
;
;
xref_file_name_read
.byte "0:HCD65XREF.TMP,S,R"
xref_file_name_write
.byte "0:HCD65XREF.TMP,S,W"
;
xref_open_read
ldx #<xref_file_name_read
ldy #>xref_file_name_read
bne open_xref
;
xref_init
lda pass ; only init once at start of pass two.
bmi 10$
rts
10$ lda #0
sta xref_pntr
ldx #<xref_file_name_write
ldy #>xref_file_name_write
;
open_xref
lda #xref_file_name_write-xref_file_name_read
jsr setnam
ldx xref_device
bne 10$
sec
rts
10$ lda #xref_channel
tay
jsr setlfs
lda #0
tax
jsr setbnk
jsr open
bcs xref_file_error
ldx xref_device
jsr dscheck
bcs xref_file_error
jsr _clrch
clc
rts
;
xref_close
jsr _clrch
lda #xref_channel
jsr close
ldx xref_device
jsr dscheck
bcs xref_file_error_message
rts
;
xref_file_error
jsr xref_close
bcc xref_file_error_message
rts
;
xref_file_error_message
jsr primm_to_error_channel
.byte "PROBLEM WITH XREF OUTPUT FILE.",cr,0
lda #0
sta xref_device
sec
rts
;
;
;
; symbol table has been printed.
; line def feild in symbol table has been overwritten with
; alpha ordering.
;
; cross reference file has been written a a seris of
; 5 byte records containing:
;
; <pntr_to_symbol_entry_in_table><linnumber><access_type>
;
;
; reference_struct
.next = 0
.symbol = 2
.alpha = 4
.line = 6
.type = 8
;
declare_ref_struct .macro %a
ram %a.next,2 <pntr_to_next_struct>
ram %a.symbol,2 <pntr_to_symbol>
ram %a.alpha,2 <alpha_order_index>
ram %a.line,2 <line_number>
ram %a.type,1 <access_type>
%a = %a.next
.endm
;
ref_struct_len = 9
;
declare_ref_struct low_ref ; low structure for current buffered set
declare_ref_struct this_ref ; the current structure
declare_ref_struct high_ref ; high structure for buffered set
;
zpage start_pntr,2 ; pointer to first entry in linked list
zpage end_pntr,2 ; pointer to end of area
zpage this_pntr,2 ; pointer to the current entry in the list
zpage prev_pntr,2 ; pointer to entry before that
zpage free_pntr,2 ; pointer to free slot at end of entry
zpage pre_free_pntr,2 ; pointer to mem before that
;
zpage ref_cmp_pntr,2 ; pointer for comparing two references
;
;
; compare the ref poined to by x,a to this_ref
; ( only the alpha,line,and type feilds )
; return z,c flags as normal compare would.
;
compare_to_this_ref
std ref_cmp_pntr
ldx #110$-100$-1
;
10$ ldy 100$,x
lda (ref_cmp_pntr),y
cmp this_ref,y
bne 80$
dex
bpl 10$
sec
inx
80$ rts
;
; table of offsets for comparion purposes
100$ .byte .type
.byte .line
.byte .line+1
.byte .alpha
.byte .alpha+1
110$
;
;
;
; perform_cross_reference is called to have a
; cross reference performed by the software.
;
; It must be called after a symbol table is printed
; because symbol_table marks all the symbols with their
; relative order in memory.
;
text_cross_reference
.byte tab,tab,tab,"CROSS REFERENCE",cr
.byte tab,tab,"( <#> = DEFINITION, <$> = WRITE, <BLANK> = READ )",cr,0
;
;
perform_cross_reference
lda xref_device
bne 1$
rts
;
1$ ldi text_cross_reference
std mid_line_pntr
;
jsr top_of_form top of form
lda #0 low ref <= 0000
tax
std low_ref.alpha
std low_ref.line
sta low_ref.type
; do open xref file
10$ jsr xref_open_read
bcc 11$
rts return if error occured ( error already printed)
;
11$ ldx #0 start pntr <= 0000
stx start_pntr
stx start_pntr+1
dex high_ref.alpha <= $FFFF
stx high_ref.alpha
stx high_ref.alpha+1
;
ldd macro_base_pntr end_pntr <= start of strage area
std end_pntr
;
jsr _clrch
ldx #xref_channel
jsr _chkin
;
20$ jsr basin do read bytes from xref file
sta this_ref.symbol
jsr basin
sta this_ref.symbol+1
;
jsr readss ( dummy check for empty file )
beq 25$ ( ok
eor #$40
bne 90$ error
beq 40$ early eof )
;
25$ jsr basin
sta this_ref.line
jsr basin
sta this_ref.line+1
jsr basin
sta this_ref.type
;
jsr readss if real bad status
and #%10111111
beq 30$
90$ jmp xref_file_error
; get the alpha order for this symbol
30$ ldd this_ref.symbol
jsr read_this_symbol
bcs 90$ puke if erroneous symbol.
ldd current_symbol+symbol_linedef_offset
std this_ref.alpha
jsr insert_reference insert the reference into storage
;
40$ jsr readss until status <> 0
beq 20$
;
jsr xref_close close the xref file
bcc 45$ if error occured
rts return
;
45$ jsr open_list_channel open the list channel
ldd start_pntr x,a <= address of first ref struct
cpx #0 if this pntr = $00xx
bne 50$
rts return
; do
50$ std this_pntr this_pntr <= x,a
;
ldy #ref_struct_len-1 read ref to this_ref
55$ lda (this_pntr),y
sta this_ref,y
dey
bpl 55$
;
ldd this_ref.alpha x,a <= alpha for this ref
cpd low_ref.alpha if <> low_ref.alpha
beq 60$
std low_ref.alpha low_ref.lpha <= x,a
jsr print_cr print a cr
ldd this_ref.symbol read its symbol
jsr read_this_symbol
jsr print_symbol print it
jsr print_tab print a tab
lda list_char_count start_col <= current coloumn in list
sta xref_start_col
;
60$ lda #8 if no room on this line
jsr is_there_room_on_this_line
bcc 65$
jsr print_cr print_cr
62$ jsr print_tab do print tabs
lda list_char_count until at right place
cmp xref_start_col
bcc 62$
;
65$ ldd this_ref.line print the line number
jsr print_decimal
lda this_ref.type print the access char
jsr print
jsr print_tab print a tab
;
;
70$ ldd this_ref.next x,a <= this_ref.next
bne 50$ while x,a <> 0
;
80$ jsr _clrch clear channels
; low_ref <= high_ref
ldy #ref_struct_len-1
85$ lda high_ref,y
sta low_ref,y
dey
bpl 85$
;
lda #$ff while low_ref.alpha <> $FFFF
tax
cpd low_ref.alpha
beq 89$
jmp 10$
89$ rts return
;
;
;
; high_ref previous high reference value
; this_ref the current reference to insert
; low_ref the lowest refernce already printed
; start_pntr pointer to first symbol in list ( or null )
; end_pntr pointer to end of mem
; this_pntr free
; prev_pntr
;
;
insert_reference
ldi low_ref if ref is before low ref
jsr compare_to_this_ref
bcc 10$
9$ rts return
;
10$ ldi high_ref if ref is after high ref
jsr compare_to_this_ref
bcc 9$ return
;
;
ldi start_pntr prev_pntr <= address_of_start_pointer
std prev_pntr
;
ldd start_pntr this_pntr <= start_pntr
20$ std this_pntr
cpx #0
beq 30$ while > this pntr <> 0
; if this string is higher than ref
jsr compare_to_this_ref
bcs 30$ break
;
ldd this_pntr prev_pntr <= this_pntr
std prev_pntr
;
ldy #1 this_pntr <= this_pntr->next
lda (this_pntr),y
tax
dey
lda (this_pntr),y
jmp 20$
;
;
30$ ldd end_pntr free_pntr <= end_pntr ( free stuff at end )
std free_pntr
;
ldi ref_struct_len if room at end
add end_pntr
cpd input_top_pntr
bcs 35$
;
std end_pntr end_pntr <= new end of data area
jmp 70$ else
;
35$ ldd prev_pntr x,a <= prev_pntr
;
40$ ldy free_pntr do pre_free_pntr <= free_pntr
sty pre_free_pntr ( preserve ,xa )
ldy free_pntr+1
sty pre_free_pntr+1
;
std free_pntr free_pntr <= x,a
ldy #1 x,a <= (prev_pntr)
lda (free_pntr),y
tax
dey
lda (free_pntr),y
cpx #0 while x <> 0
bne 40$
;
; pre_free is now pointing to reference before last referece
; in a list which hasn't sufficient space to insert a new reference
;
;
50$ ldd free_pntr x,a <= pointer to last reference in list
ldy this_pntr+1 if the currrent refrence goes
bne 60$ after this one
;
std pre_free_pntr pre_free_pntr <= last reference
;
55$ ldy #ref_struct_len-1 copy (pre_free_pntr) to high_ref
58$ lda (pre_free_pntr),y
sta high_ref,y
dey
bpl 58$
rts return
;
60$ jsr 55$ copy (pre_free_pntr) to high_ref
lda #0 (pre_free_pntr) <= 0000 ( new last ref )
tay
sta (pre_free_pntr),y
iny
sta (pre_free_pntr),y
;
;
;
70$ ldy #1
72$ lda (prev_pntr),y this_ref points to where previous one
sta this_ref.next,y used too.
lda free_pntr,y previous ref points to where this
sta (prev_pntr),y one will be.
dey
bpl 72$
;
ldy #ref_struct_len-1 copy this ref to (free_pntr)
;
75$ lda this_ref,y
sta (free_pntr),y
dey
bpl 75$
;
rts return

7
README.md
Unescape View File

@ -136,7 +136,7 @@ Using [kernalemu](https://github.com/mist64/kernalemu) and [cbm6502asm](https://
| [DISK_MONITOR](DISK_MONITOR) | 1980 | Monitor extension for PET |
| [FIG](FIG) | 1980 | fig-FORTH |
## Software: Resident Assembler
## Software: Resident Assembler & HCD65
| Directory | Year | Comments |
|--------------------------------------------------------------|------|-------------|
@ -151,6 +151,7 @@ Using [kernalemu](https://github.com/mist64/kernalemu) and [cbm6502asm](https://
| [ASSEMBLER_C64_REC](ASSEMBLER_C64_REC/) | 1982 | "C64 Macro Assembler", adds `.MAC` |
| [ASSEMBLER_TED](ASSEMBLER_TED) | 1984 | TED version, adds `.OPT LON`, `.OPT MLI` |
| [ASSEMBLER_C128](ASSEMBLER_C128) | 1986 | C128 version, heavily commented |
| [HCD65_3.5](HCD65_3.5) | 1986 | BSO-compatible rewrite |
| [LOADER_PET](LOADER_PET) | 1979 | OBJ Loader |
| [LOADER_C64](LOADER_C64) | 1986 | OBJ Loader |
@ -471,6 +472,10 @@ A version of the Commodore Resident Assembler for the TED series (Plus/4, C16 an
The final version of the Commodore Resident Assembler, for the C128 (V022086; 1986).
### HCD65_3.5
The release version of the C128 HCD65 assembler. Source: [c128_dev_pack.tar.gz](http://www.zimmers.net/anonftp/pub/cbm/src/c128/index.html)
### LOADER_PET
The PET OBJ Loader, version V121379. Extracted from [ted_kernal_basic_src.tar.gz](http://www.zimmers.net/anonftp/pub/cbm/src/plus4/ted_kernal_basic_src.tar.gz) and converted to uppercase and LST-style indenting. File loload.4 added.

7
build.sh
Unescape View File

@ -156,9 +156,6 @@ build2 DOS_1541_05 1541
build2 DOS_1541C_02 serlib
build2 DOS_1541C_03 serlib
# TODO cbm6502asm problems:
# build2 RAMDOS a
build1 PRINTER_8023P us.ptr.src
build1 ASSEMBLER_AIM65_REC assembler
@ -182,3 +179,7 @@ build1 KICKMAN kickman
build1 OMEGA omega
build1 WIZARD wizard
build1 FIG FOR1-1
# TODO cbm6502asm problems:
# build2 RAMDOS a
# build2 HCD65_3.5 c65

Write Preview
Loading…
Cancel
Save