mirror of
https://github.com/marketideas/qasm.git
synced 2026-10-24 22:02:28 +00:00
Shawn Quick
dfcaae62dd
Move the assembler to src/qasm. qlink links OMF 1.0 and 2.0 from a script. makeBin flattens a load file, qomf dumps OMF, and qpro builds ProDOS volumes. APW and MPW assemble through the ORCA front end. Relocatable modules emit OMF objects. Listings stay off unless -l is set. make boot assembles the GS/OS 6.0.1 ProDOS 8 kernel and BASIC.SYSTEM into an 800K volume. BASIC.SYSTEM accepts ls and pfx, and its splash reports PRODOS BASIC 2.0, copyright 1983-2026. IIGS.601.SRC is the source and the BASIC.SYSTEM oracle that image is built from.
1 line
18 KiB
Plaintext
1 line
18 KiB
Plaintext
Blanks off
|
|
;-----------------------------------------------
|
|
;
|
|
; Imported addresses
|
|
;
|
|
;-----------------------------------------------
|
|
|
|
IMPORT output_table
|
|
IMPORT pitch_out
|
|
|
|
;-----------------------------------------------
|
|
;
|
|
; Forward addresses and entries
|
|
;
|
|
;-----------------------------------------------
|
|
|
|
ENTRY compute_envelope
|
|
ENTRY halt_gen
|
|
|
|
|
|
INCLUDE 'gcb.aii'
|
|
INCLUDE 'Note.Macros'
|
|
INCLUDE 'NS.equ'
|
|
INCLUDE 'E16.MIDI'
|
|
|
|
****************************************************************
|
|
*
|
|
* update
|
|
*
|
|
* Inputs: none
|
|
*
|
|
* Outputs: none
|
|
*
|
|
****************************************************************
|
|
*
|
|
EXPORT update
|
|
update PROC
|
|
|
|
* This task is installed as the interrupt handler for the update timer.
|
|
* The update timer is actually generator 14.
|
|
|
|
* If this is my timer interrupting
|
|
* if update isn't already running
|
|
* allow interrupts
|
|
* for generator = 0 to 14:
|
|
* if ID = note synth and priority < 255
|
|
* raise priority
|
|
* compute envelope
|
|
* if note is done
|
|
* dealloc generator
|
|
* else
|
|
* if flipflop = 0
|
|
* compute lfo and pitch
|
|
* endif
|
|
* flipflop = 1 - flipflop
|
|
* endif
|
|
* lower priority
|
|
* endif
|
|
* next generator
|
|
* endif
|
|
* rti
|
|
*
|
|
* NoteOn is also reentrant. NoteOn, AllocGen, and Update have to protect
|
|
* themselves against each other. Here's the scheme:
|
|
* AllocGen runs with interrupts disabled. It may interrupt either of the
|
|
* other two. However it will never take a gen with a priority over 127.
|
|
* When either NoteOn or Update are munging with a gen, they will raise it's
|
|
* priority to 255.
|
|
* NoteOn will, therefore, be playing with priorities. Lets say that it too
|
|
* refuses to touch a gen with priority 255. That will take care of the case
|
|
* where the update interrupt happens while NoteOn was running.
|
|
* Now if the NoteOn comes from an interrupt (presumably MIDI) then it is
|
|
* stuck. If the update routine were updating the gen that you were
|
|
* trying to turn on, it can't very well refuse! But it will. It will
|
|
* return an error code. Try again and it may succeed. (This scenario
|
|
* only happens when you try to NoteOn a gen that is already on. Don't
|
|
* do that.)
|
|
|
|
|
|
****************************************************************
|
|
* If this isn't my timer, then pass control to the next guy in line
|
|
*
|
|
longi off
|
|
longa off * IRQ leaves us like this!
|
|
* compare the gen num to my special gennum. if no match, then
|
|
* pass control to the next guy in the DOC vector chain!
|
|
|
|
and #$0F
|
|
cmp #My_ID
|
|
beq its_time
|
|
* if not mine: jml (>cubbyhole+5) ;*** EXIT *** to next irq handler
|
|
tax
|
|
lda >old_vector+2
|
|
pha ; push bank (and page too)
|
|
mem_long
|
|
lda >old_vector ; push low word-1
|
|
dec a
|
|
pha
|
|
mem_short ; leave as we came...
|
|
txa
|
|
rtl ; synthesized jump long
|
|
****************************************************************
|
|
|
|
|
|
* CALL THE USERS ROUTINE
|
|
|
|
* a sequencer can install this hook to get a clock.
|
|
* It can also choose to reenable interrupts here.
|
|
|
|
|
|
its_time both long
|
|
lda >myflags
|
|
and #user_bit
|
|
beq no_routine
|
|
jsl userjump
|
|
|
|
****************************************************************
|
|
|
|
no_routine lda >myflags
|
|
and #busy_bit
|
|
beq not_runnin
|
|
rtl ;*** EXIT *** we've reentered.
|
|
|
|
not_runnin lda >myflags
|
|
ora #busy_bit ; set running flag
|
|
sta >myflags
|
|
|
|
****************************************************************
|
|
* Get my DP area and my workarea pointers
|
|
*
|
|
both long
|
|
phd ; save old dp
|
|
lda >mydp-1 ; put my dp in high byte
|
|
and #$FF00
|
|
tcd
|
|
; for rom ldy #priority_table must be replaced.
|
|
lda myram_ptr ; get low word of addr to priority_table.
|
|
tay
|
|
mem_short
|
|
phb ; save the callers bank.
|
|
lda myram_ptr+2 ; get my bank
|
|
pha ; and put on stack.
|
|
plb ; pull bank.
|
|
|
|
; Clear x regester, which is now the MIDI Poll counter, when 5 pull midi.
|
|
ldx #$0
|
|
|
|
* Stack is up 3. memory is short. WAP is in y and DBR. DP is set.
|
|
|
|
****************************************************************
|
|
*
|
|
* Repeat Loop.
|
|
*
|
|
* DP will be the Loop counter, incremented by 16's.
|
|
* y will also count through the priority table.
|
|
* memory is short index is long
|
|
; needs to fall through into this loop, not branch to it (When starting loop).
|
|
|
|
LOOP cpx #$5 ; if 5 times through loop without polling, poll.
|
|
bmi @1
|
|
phy
|
|
both long ; memory was short index was long.
|
|
jsl MIDIInputPoll ; poll.
|
|
mem_short ; both were long.
|
|
ply
|
|
ldx #$0
|
|
@1 inx ; about to do another loop.
|
|
lda gcb_ID
|
|
and #$0F
|
|
cmp #my_ID
|
|
bne not_note
|
|
|
|
|
|
pha ; make space on the stack
|
|
php ; save users IRQ preference
|
|
sei ; and protect this maneuver:
|
|
lda |0,y ;;; its a note. make sure
|
|
cmp #255 ;;; its not untouchable (noteon)
|
|
bne notbusy
|
|
plp
|
|
pla
|
|
bra not_note
|
|
notbusy sta 2,s ;;; save old priority in the space.
|
|
lda #255 ;;; gaurd it against others
|
|
sta |0,y ;;; with super high priority
|
|
plp ; restore users IRQ preference
|
|
phy ; and save y for later
|
|
both long
|
|
|
|
* now the stack is 6 up, with old priority and a pointer to it on top.
|
|
jsr compute_envelope ; both long
|
|
bne notdone ; eq means voice is done
|
|
|
|
* if done, do this:
|
|
mem_short
|
|
ply
|
|
pla ; the envelope is done. free
|
|
lda #0 ; the gen by setting its ID
|
|
sta gcb_ID ; and its priority to zero.
|
|
sta |0,y
|
|
|
|
jsr halt_gen ; doesn't trash y or x.
|
|
ldx #$0 ; we polled midi in compute_envelope.
|
|
bra not_note ; and continue with ne
|
|
|
|
* else, do this:
|
|
|
|
notdone mem_short ; index is long
|
|
lda gcb_ID ; hi bit is flip flop so t
|
|
bmi bitset
|
|
* if flip, do this:
|
|
ora #$80 ; we do freq every other update
|
|
sta gcb_ID
|
|
jsr pitch_out ; please return with memory short
|
|
bra lab1 ; index long
|
|
* else flop, do this:
|
|
bitset and #$7F ; don't doit if bit was set.
|
|
sta gcb_ID
|
|
* endif flipflop
|
|
lab1 ply
|
|
ldx #$0 ; we just polled midi in compute_envelope or pitch_out.
|
|
pla ; restore priority
|
|
sta |0,y
|
|
|
|
* endif
|
|
|
|
not_note iny
|
|
tdc ; ( do this with 8 bit acc? )
|
|
clc
|
|
adc #gcb_size ; advance direct page to next gcb
|
|
tcd
|
|
cmp #gcb_size*num_of_gen
|
|
bne loop
|
|
|
|
****************************************************************
|
|
* Now leave the way we came, restoring registers and running flag.
|
|
php
|
|
sei ; **** protect this maneuver ***
|
|
lda >myflags
|
|
and #255-busy_bit ; reset running flag
|
|
sta >myflags
|
|
plp
|
|
plb
|
|
pld
|
|
mem_long
|
|
rtl ; this will finally RTI
|
|
|
|
************************************************************************
|
|
|
|
EXPORT halt_gen
|
|
halt_gen ;
|
|
; must not trash y or x.
|
|
|
|
longi on
|
|
longa off
|
|
lda gcb_doc ; call with dp pointing to
|
|
clc ; gcb of the generator to kill.
|
|
adc #doc_ctrl ; to make sure they don't
|
|
sta >GAdrl ; leak.
|
|
lda >SysVol ; (9/24/86)
|
|
ora #GPtrInc ;
|
|
sta >GStatReg ;
|
|
lda #doc_halt_reset ;
|
|
sta >GDataReg ;
|
|
sta >GDataReg ;
|
|
|
|
lda gcb_doc ;
|
|
clc ;
|
|
adc #doc_freqlo ;
|
|
sta >GAdrl ;
|
|
lda #0 ; zap the freq
|
|
sta >GDataReg ;
|
|
sta >GDataReg ;
|
|
lda gcb_doc ;
|
|
clc ;
|
|
adc #doc_freqhi ;
|
|
sta >GAdrl ;
|
|
lda #0 ; zap the freq
|
|
sta >GDataReg ;
|
|
sta >GDataReg ;
|
|
rts
|
|
|
|
|
|
|
|
ENDP
|
|
eject
|
|
|
|
****************************************************************
|
|
*
|
|
* Compute_Envelope
|
|
*
|
|
* Inputs: DP points to GCB; memory and index are long
|
|
*
|
|
* Outputs: both long; writes to doc, z set if envelope=0 (done)
|
|
*
|
|
****************************************************************
|
|
*
|
|
EXPORT Compute_Envelope
|
|
Compute_Envelope PROC
|
|
|
|
longi on
|
|
longa on
|
|
|
|
* !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
|
|
|
* This is where we poll midi during the NS interupt.
|
|
|
|
JSL MIDIInputPoll
|
|
|
|
* Banks and dp are preserved by the MidiTools.
|
|
* With out this polling midi data is lost when playing the NS.
|
|
|
|
* !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
|
|
|
****************************************************************
|
|
|
|
lda gcb_env_inc
|
|
beq sustain
|
|
bmi going_down
|
|
|
|
* going up:
|
|
clc
|
|
adc gcb_env_cur
|
|
bvs hit_it
|
|
cmp gcb_env_lim
|
|
bcs hit_it
|
|
bra contin
|
|
|
|
going_down clc
|
|
adc gcb_env_cur
|
|
bmi hit_it
|
|
cmp gcb_env_lim
|
|
bmi hit_it
|
|
|
|
contin sta gcb_env_cur
|
|
|
|
|
|
|
|
* Now we have the envelope in the high byte of acc. Treat it as a log
|
|
* and add to it the volume, then look it up in the exponential table.
|
|
* this simulates a multiply. Put the volume out to the DOC.
|
|
|
|
both short
|
|
xba ; env = [0..127]
|
|
clc
|
|
adc gcb_volume ; vol = [0..127]
|
|
sec
|
|
sbc #127
|
|
bpl audible ; below zero is inaudible
|
|
lda #0
|
|
audible tax
|
|
lda gcb_doc
|
|
clc
|
|
adc #doc_vol
|
|
php ;;;
|
|
sei ;;;
|
|
sta >GAdrL ;;;***** NO IRQS ******
|
|
lda >SysVol ;;;writing to DOC
|
|
ora #GPtrInc ;;;
|
|
sta >GStatReg ;;;
|
|
lda >output_table,x ;;get volume
|
|
sta >GDataReg ;;;
|
|
sta >GDataReg ;;;for both oscs
|
|
plp ; *** cli and both long ****
|
|
both long
|
|
sustain ldx gcb_env_cur ; check if we hit zero env
|
|
rts ;======= EXIT ========>
|
|
|
|
|
|
****************************************************************
|
|
* This stretch is protected from noteoff coming from an interrupt.
|
|
|
|
longi on ; advance to next env segment
|
|
longa on
|
|
hit_it php
|
|
sei
|
|
lda gcb_env_lim ; start by locking the level
|
|
sta gcb_env_cur ; to the breakpoint we just hit.
|
|
|
|
ldy #vcb_current_seg
|
|
lda (gcb_vcb),y ;the pointer to the next segment
|
|
tay
|
|
lda (gcb_vcb),y ;points to the breakpoint
|
|
xba
|
|
and #$7F00 ;which was a byte, now a word
|
|
cmp gcb_env_lim
|
|
bge going_up
|
|
* going down ; and make sure the increment
|
|
sta gcb_env_lim ; is the correct sign for the
|
|
iny ; direction we are headed.
|
|
lda (gcb_vcb),y ;get increment word
|
|
bmi its_cool
|
|
eor #$FFFF ; negate it if it isn't negative
|
|
inc a
|
|
bra its_cool
|
|
|
|
going_up sta gcb_env_lim
|
|
iny
|
|
lda (gcb_vcb),y
|
|
bpl its_cool ; negate it if it isn't positive
|
|
dec a
|
|
eor #$FFFF
|
|
|
|
its_cool sta gcb_env_inc
|
|
tya ; advance cur seg to next one
|
|
inc a
|
|
inc a
|
|
ldy #vcb_current_seg
|
|
sta (gcb_vcb),y
|
|
lda gcb_env_cur
|
|
plp
|
|
brl contin ; now continue with doc output.
|
|
|
|
|
|
|
|
ENDP
|
|
eject
|
|
|
|
****************************************************************
|
|
*
|
|
* SetUpDateRate functon #E
|
|
*
|
|
* Inputs: space for result (word)
|
|
* UpDateRate (word)
|
|
*
|
|
* Outputs: Old UpdateRate (word)
|
|
*
|
|
* Errors: NotStarted
|
|
*
|
|
* Change History:
|
|
*
|
|
* 7/7/88 First time call is fully implemented. MLD.
|
|
*
|
|
****************************************************************
|
|
*
|
|
EXPORT SetUpDateRate
|
|
SetUpDateRate PROC
|
|
|
|
longa on
|
|
longi on
|
|
|
|
OldRate equ 9
|
|
UpdateRate equ 7
|
|
RTL1 equ 4
|
|
RTL2 equ 1
|
|
|
|
phd ; save the old direct page.
|
|
tcd ; set dp.
|
|
bne Started ; if not zero then we are started.
|
|
|
|
ldx #errNotStarted ; NSynth must be started for this call.
|
|
bra exit
|
|
|
|
Started lda UpdateRate+2,s ; if paramater zero use default rate.
|
|
bne @1
|
|
lda #Update_rate ; get the default update rate.
|
|
sta UpdateRate+2,s
|
|
|
|
@1 both short ; short a and x for doc glue.
|
|
|
|
php ; no interupts while going to doc glue.
|
|
sei
|
|
lda >SysVol ; get the system volume.
|
|
and #$F ; make sure we get just vol.
|
|
sta >GStatReg ; no inc, to doc, same volume.
|
|
|
|
; get the old update.
|
|
lda #doc_freqhi+timer_osc ; point to freq.
|
|
sta >GAdrL ;
|
|
lda >GDataReg ; Read to catch up.
|
|
lda >GDataReg ; Get high part of Frequency.
|
|
clc ; don't bring in a zero in high bit.
|
|
ror A ; half the frequency to get update rate.
|
|
sta OldRate+2+1+1,s ; save in old update, hi byte.
|
|
lda #doc_freqlo+timer_osc ; point glue to set frequency of the
|
|
sta >GAdrL ; timer osc.
|
|
lda >GDataReg ; Read to catch up.
|
|
lda >GDataReg ; Get low part of Frequency.
|
|
ror A ; carry is set correctly.
|
|
sta OldRate+2+1,s ; save the old update, low byte.
|
|
|
|
; store the new update rate.
|
|
* lda #doc_freqlo+timer_osc ; point glue to set frequency of the
|
|
* sta >GAdrL ; timer osc.
|
|
lda UpdateRate+2+1,s
|
|
asl A ; 9/24/86 double the freq
|
|
sta >GDataReg
|
|
lda #doc_freqhi+timer_osc
|
|
sta >GAdrL
|
|
lda updateRate+2+1+1,s
|
|
rol A ; 9/24/86 hi byte of freq
|
|
sta >GDataReg
|
|
|
|
lda #doc_vol+timer_osc ; set volume, for kicks...
|
|
sta >GAdrL
|
|
lda #$00
|
|
sta >GDataReg
|
|
|
|
lda #doc_size+timer_osc
|
|
sta >GAdrL
|
|
lda #$00
|
|
sta >GDataReg
|
|
lda #doc_ctrl+timer_osc
|
|
sta >GAdrL
|
|
lda #doc_irq_bit ; free run, interrupts
|
|
sta >GDataReg
|
|
plp
|
|
|
|
both long
|
|
ldx #0
|
|
|
|
exit pld
|
|
lda RTL1+1,s ; move high 2 bytes of RTL1
|
|
sta UpdateRate,s
|
|
lda RTL2+2,s ; move high byte of RTL2 and low of RTL1
|
|
sta RTL1+1,s
|
|
lda RTL2,s
|
|
sta RTL2+2,s ; done cleaning up stack
|
|
pla ; pull off the extra stuff.
|
|
txa
|
|
cmp #1
|
|
rtl
|
|
ENDP
|
|
|
|
****************************************************************
|
|
*
|
|
* SetUserUpdateRtn functon #F
|
|
*
|
|
* Inputs: space for result (Long)
|
|
* UserUpdateRtn (long) zero causes updatertn to be disabled.
|
|
*
|
|
* Outputs: OldUserRtn (Long) zero if there isn't one.
|
|
*
|
|
* Errors: NotStarted
|
|
*
|
|
* ChangeHistory:
|
|
*
|
|
* 7/8/88 Call is fully implemented. MLD
|
|
*
|
|
****************************************************************
|
|
|
|
EXPORT SetUserUpDateRtn
|
|
SetUserUpdateRtn PROC
|
|
|
|
longa on
|
|
longi on
|
|
|
|
OldUpdateRtn equ 11+2
|
|
UpdateRtn equ 7+2
|
|
RTL1 equ 4+2
|
|
RTL2 equ 1+2
|
|
oldDP equ 1
|
|
|
|
phd ; save the old direct page.
|
|
tcd ; set dp.
|
|
bne Started ; if not zero then we are started.
|
|
|
|
ldx #errNotStarted
|
|
bra exit
|
|
|
|
Started lda >myflags ; get flags, includeing user flag.
|
|
and #User_Bit ; get just the user bit.
|
|
beq NoPrevUser ; if bit isn't set their wan't a previous vect.
|
|
|
|
; return the old vector.
|
|
lda UserUpdate
|
|
sta OldUpdateRtn,s
|
|
lda UserUpdate+2
|
|
and #$00FF ; only the low byte is valid.
|
|
sta OldUpdateRtn+2,s
|
|
bra NewUpdate
|
|
|
|
; if no previous vector, return zero.
|
|
NoPrevUser lda #0
|
|
sta OldUpdateRtn,s
|
|
sta OldUpdateRtn+2,s
|
|
sta UserUpdate+1 ; clear the UserUpdate, just incase.
|
|
sta UserUpdate
|
|
bra UpDate ; the user bit is already cleared.
|
|
|
|
; First make sure I don't interupt myself.
|
|
NewUpdate lda >myflags ; get myflags
|
|
and #not_user_bit_w ; clear the user bit.
|
|
sta >myflags ; and save flag.
|
|
|
|
; install the new Update Routine.
|
|
UpDate lda UpdateRtn,s
|
|
sta UserUpdate
|
|
lda UpdateRtn+1,s
|
|
sta UserUpdate+1
|
|
|
|
; if UpdateRtn = 0 then user flag is clear, else set it.
|
|
* lda UpdateRtn+1,s
|
|
ora UpdateRtn,s
|
|
beq Done
|
|
|
|
SetUser lda >myflags
|
|
ora #User_bit
|
|
sta >myflags
|
|
mem_short
|
|
lda #$5c ; install a jump long instruction
|
|
sta >userjump
|
|
mem_long
|
|
|
|
Done ldx #0 ; no error code.
|
|
|
|
exit lda RTL1+1,s
|
|
sta UpdateRtn+2,s
|
|
lda RTL2+2,s
|
|
sta UpdateRtn,s
|
|
lda RTL2,s
|
|
sta RTL1+1,s
|
|
pld
|
|
pla
|
|
pla
|
|
txa
|
|
cmp #1
|
|
rtl
|
|
|
|
ENDP
|
|
END
|
|
|