;
; *********************************************************************
;
;    The Command Subroutines for a Redefinable Telesoftware Decoder
;
;
;                      (C) C.J. Oswald 1982
;                           --  rtf7  --
;
; *********************************************************************
;
;
; The <DLA> Command Subroutine
;
; Destroys all registers & temporary zero page locations
;
dla
 LDA igno00  ; ignore <DLA> command?
 BNE dla1      ; (yes)
 LDAIM :LSB: memory  ; copy memory's address to zero page
 STA ztempa
 LDAIM :MSB: memory
 STA ztempa+1
 LDAIM 0      ; reset reloca & memory to zero
 LDYIM 3
;
dla2
 STAIY ztempa
 STAAY reloca
 DEY
 BPL dla2
 JSR dlocat  ; decode operan and store at memory
 INC endofs ; set end of section flag
;
dla1
 CLC ; ensure carry is clear
 RTS
;
; ***********************************************************************
;
; The <DXA> Command Subroutine
;
; Destroys all registers & temporary zero page locations
;
dxa
 LDAIM :LSB: execut   ; copy execut's address to zero page
 STA ztempa
 LDAIM :MSB: execut
 STA ztempa+1
 JSR dlocat  ; decode operan and store at execut
 LDAIM 0
 STA noexec    ; clear noexec flag
 CLC     ; ensure carry is clear
 RTS
;
; ***********************************************************************
;
; The <DLR> Command Subroutine
;
; Destroys all registers & temporary zero page locations
;
dlr
 LDAIM :LSB: reloca   ; copy reloca's address to zero page
 STA ztempa
 LDAIM :MSB: reloca
 STA ztempa+1
 LDAIM 0        ; clear reloca
 LDYIM 3
;
dlr3
 STAIY ztempa
 DEY
 BPL dlr3
 JSR dlocat   ; decode operan and store at reloca
 TXA       ; set flags for test
 BEQ dlr1    ;   length of zero - ie blocks have no order
 LDA disord    ; is file disordered?
 BEQ dlr2      ; (no - therefore blocks must be received in order)
;
dlr1
 INC ordern    ; set flag to show order doesn't matter
;
dlr2
 INC endofs   ; set end of section flag
 CLC          ; ensure carry is clear
 RTS
;
; ***********************************************************************
;
; The <DXR> Command Subroutine
;
; Destroys all registers & temporary zero page locations
;
dxr
 JSR dxa      ; decode execution address as though it was absolute
;
; Now add base address (stored at memory) to execut address
;
 LDA memory
;CLC           ; (carry has already been cleared by <DXA>)
 ADC execut
 STA execut
 LDA memory+1
 ADC execut+1
 STA execut+1
 LDA memory+2
 ADC execut+2
 STA execut+2
 LDA memory+3
 ADC execut+3
 STA execut+3
 CLC           ; ensure carry is clear 
 RTS
;
; ***********************************************************************
;
; A subroutine to decode the operan of <DLA>, <DLR>, <DXA>, <DXR>, <DEB>
; (and at a pinch <DSB> ) command subroutines,
; storingA0 it at (ztempa)
;
; Returns the length of the operan in X
;
; Destroys registers and temporary zero page locations!
;
dlocat
 JSR opinfo    ; get length of operan
 TAX          ; put in X
 BEQ dloc1     ; length is zero
 LDY sevenb     ; in seven bit mode?
 BEQ dloc2     ; (no)
;
; Seven bit mode, no. of digits in A
;
 LSRA         ; divide by 2
 TAY        ; put in Y (now offset from (ztempa))
 BCC dloc3     ; even no. of digits
;
; Odd number of digits - deal with most significant nibble
;
 JSR opinfo    ; get most significant nibble
 STAIY ztempa   ; store it as a byte
;
; Now an even number of digits
;
dloc3
 DEY      ; decrement offset
 BMI dloc1     ; end of operan
;
dloc4
 JSR opinfo    ; get most significant nibble
 ASLA         ; left hand justify it
 ASLA
 ASLA
 ASLA
 STA ztempl
 JSR opinfo    ; get least significant nibble
 ORA ztempl  ; assemble byte
 STAIY ztempa    ; save byte of address
 DEY           ; decrement offset
 BPL dloc4    ; contin until end of operan
;
; End of operan reached
;
dloc1
 RTS
;
; Decoder in eight-bit mode, no. of digits in A
;
dloc2
 TAY        ; put no. of digits in Y
 DEY        ; convert Y to offset
;
dloc5
 JSR opinfo   ;  get next byte
 STAIY ztempa    ; save byte of address
 DEY
 BPL dloc5     ; continue until end of operand
 RTS
;
; ***********************************************************************
;
; The <DEF> Command Subroutine
;
; Destroys all registers & temporary zero page locations
;
def
 JSR initnt        ; reset name tables to default
 LDAIM 0
 STA sevenb       ; not in seven bit mode
 CLC              ; ensure carry is clear
 RTS
;
; ***********************************************************************
;
; The <DET> command subroutine
;
; Preserves all registers and temporary zero page locations
;
det
 INC lastbl    ; set last block flag
;CLC           ; ensure carry is clear
 SEC        ; for BBC until they change their minds...
 RTS
;
; ***********************************************************************
;
; The <DND> command subroutine
;
; Preserves all registers and temporary zero page locations
;
dnd
 INC norese     ; set no reset flag
 CLC            ; ensure carry is clear
 RTS
;
; ***********************************************************************
;
; The <DIG> command subroutine
;
; Destroys all registers & temporary zero page locations
;
dig
 INC operan    ; set flag indicating that an operan is being decode
 JSR opinfo    ; get number of operans
 TAX
 BEQ dig2
;
dig1
 JSR opinfo    ; get length of next operan
 TAY
 BEQ dig3      ; length zero
;
dig4
 JSR decode    ; get next decode byte (throw it away)
 DEY
 BNE dig4
;
dig3
 DEX
 BNE dig1       ; next operan
;
dig2
 JSR chopqu     ; empty the queue
 DEC operan     ; restore operan to its original value
 CLC            ; ensure carry is clear
 RTS
;
; ***********************************************************************
;
; The <DES> Command Subroutine
;
; Destroys all registers & temporary zero page locations
;
des
 INC operan      ; set operan flag to true
 JSR decode      ; get the name
 JSR parity ;  <<<<<<<<<<<<<<<<<<<
 TAY             ; put in Y
 JSR opinfo      ; get length of field
 TAX             ; put length of field in X
 BEQ des1        ; length of zero
 CPXIM 3         ; three or more bytes?
 BCS des2        ; (yes)
 DEX
 BEQ des3        ; name decodes to one byte
;
; Name decodes to two bytes
;
 JSR decode      ; get first byte
 STAAY eschi
 JSR decode
 STAAY esclo
 LDAIM 2         ; type entry is 2
 STAAY esctyp
 JMP des5
;
; Name decodes to one byte
;
des3
 JSR decode      ; get byte
 STAAY esclo     ; store it in name tables
 LDAIM 1         ; TYPE ENTRY = 1
 STAAY esctyp
 JMP des5
;
; Name decodes to nothing
;
des1
;LDAIM 0          ; (A already holds zero)
 STAAY esctyp     ;  type entry is 0
 JMP des5
;
; Name decodes to a lookup string
;
des2
 LDA heapfr       ; store pointer into heap temporarily on the stack
 PHA
 LDA heapfr+1
 PHA
 LDAIM &0F        ; type entry is &0F
 STAAY esctyp
 TXA              ; put length in A
 JSR heapby       ; decode operan and add to heap
 PLA               
 STAAY eschi
 PLA
 STAAY esclo
;
des5
 DEC operan       ; reset operan flag to it original value
 CLC              ; ensure carry is clear
 RTS
;
; ***********************************************************************
;
; The <DLS> Command Subroutine
;
; Destroys all registers & temporary zero page locations
;
dls
 INC operan         ; set operan flag to true
 JSR decode         ; get the name
 JSR parity ;         <<<<<<<<<<<<
 TAY                ; put in Y
 JSR opinfo         ; get length of field
 TAX                ; put length of field in X
 BEQ dls1           ; length of zero
 CPXIM 3            ; three or more bytes?
 BCS dls2
 DEX
 BEQ dls3           ; name decodes to one byte
;
; Name decodes to two bytes
;
 JSR decode         ; get first byte
 STAAY lonehi
 JSR decode
 STAAY lonelo
 LDAIM 2            ; type entry is 2
 STAAY lonety
 JMP dls5
;
; Name decodes to one byte
;
dls3
 JSR decode          ; get byte
 STAAY lonelo        ; store it in name tables
 LDAIM 1
 STAAY lonety
 JMP dls5
;
; Name decodes to nothing
;
dls1
;LDAIM 0          ; (A already holds zero)
 STAAY lonety     ; type entry is 0
 JMP dls5
;
; Name decodes to a lookup string
;
dls2
 LDA heapfr     ; store pointer into heap temporarily on stack
 PHA
 LDA heapfr+1
 PHA
 LDAIM &0F       ; type entry is &0F
 STAAY lonety
 TXA             ; put length in A
 JSR heapby      ; decode operan and add to heap
 PLA
 STAAY lonehi
 PLA
 STAAY lonelo
;
dls5
 DEC operan       ; reset operan flag to its original value
 CLC              ; ensure carry is clear
 RTS
;
parity
 LDX sevenb
 BEQ pc1
 ASLA
 PHA
 ORAIM 1
 STA ztempl
 LDXIM 8
 ASLA
pc2
 ASL ztempl
 ADCIM 0
 DEX
 BNE pc2
 RORA            ; only correct for odd parity
 PLA
 RORA            ; (sorry about all that devious code)
pc1
 RTS
;
; ***********************************************************************
;
 LNK RTF8