💾 Archived View for mirrors.apple2.org.za › archive › ground.icaen.uiowa.edu › apple8 › Languages › … captured on 2024-12-18 at 02:57:48.

View Raw

More Information

-=-=-=-=-=-=-

Received: by NDSUVM1 (Mailer R2.07) id 0441; Tue, 21 Aug 90 21:21:57 CDT
Date:         Tue, 21 Aug 90 22:18:03 EDT
Reply-To:     Apple II List <APPLE2-L@BROWNVM.BITNET>
Sender:       Apple II List <APPLE2-L@BROWNVM.BITNET>
From:         "Comp.Binaries.Apple2 Forwarding" <delaneyg@wnre.aecl.ca>
Subject:      PIDGIN.RT.S
To:           "Steven E. Nelson" <CMDSENPG@UIAMVS.BITNET>
 
run-time file for Pidgin programs
 
 

 

 
PNTR EQU $00
PNTR2 EQU $02
PNTR3 EQU $04
 
TEMP EQU $06
TEMP2 EQU $07
TEMP3 EQU $08
 
CH EQU $24
CV EQU $25
 

 
FILEBUF0 EQU $800
FILEBUF1 EQU $C00
FILEBUF2 EQU $1000
 
FNAME0 EQU $1400
FNAME1 EQU $1440
FNAME2 EQU $1480
 
REFNUM0 EQU $14C0
REFNUM1 EQU $14C1
REFNUM2 EQU $14C2
 

 
MLI EQU $BF00
 

 
BASCALC EQU $FC24
GETKEY EQU $FD0C
COUT EQU $FDED
 

 

 
__GETKEY JSR GETKEY
 AND #$7F
 RTS
 

 
__COUT ORA #$80
 JMP COUT
 

 
__MSG PLA
 STA PNTR
 PLA
 STA PNTR+1
 LDX #0
 
:LOOP INC PNTR
 BNE :SKIPINC
 INC PNTR+1
 
:SKIPINC LDA (PNTR,X)
 BEQ :FINIS
 JSR COUT
 JMP :LOOP
 
:FINIS LDA PNTR+1
 PHA
 LDA PNTR
 PHA
 RTS
 

 
__PRTDEC STX TEMP
 LDA #0
 STA TEMP3 ; Zero flag
 
 LDX #4
:OUTER LDA #0 ; Current place value counter
 STA TEMP2
:INNER INC TEMP2
 TYA
 SEC
 SBC DECPWRL,X
 TAY
 LDA TEMP
 SBC DECPWRH,X
 STA TEMP
 BCS :INNER
 TYA
 ADC DECPWRL,X
 TAY
 LDA TEMP
 ADC DECPWRH,X
 STA TEMP
 
 DEC TEMP2
 BNE :PRT
 BIT TEMP3
 BPL :SKIPPRT
:PRT LDA TEMP2
 CLC
 ADC #$B0
 JSR COUT
 SEC
 ROR TEMP3
:SKIPPRT DEX
 BPL :OUTER
 BIT TEMP3
 BPL :ZERO
 RTS
 
:ZERO LDA #"0"
 JMP COUT
 
DECPWRL DFB #1,#10,#100,#1000,#10000
 
DECPWRH DFB #/1,#/10,#/100,#/1000,#/10000
 

 

 
__FLEN PLA
 STA PNTR
 PLA
 STA PNTR+1
 
 LDA #$02 ; Two parameters for GET_EOF call
 STA PARMS
 
 LDY #$01 ; Fetch "channel" #
 LDA (PNTR),Y
 TAY
 LDA REFNUM0,Y
 STA PARMS+1
 
 INY ; Fetch variables for length
 LDA (PNTR),Y
 STA PNTR2
 INY
 LDA (PNTR),Y
 STA PNTR2+1
 INY
 LDA (PNTR),Y
 STA PNTR3
 INY
 LDA (PNTR),Y
 STA PNTR3+1
 
 JSR MLI ; Call ProDOS
 DFB $D1
 DW PARMS
 
 STA _ER:
 BCS :ERROR
 
 LDA #$00 ; Store file length in variables
 LDY #$01
 STA (PNTR3),Y
 LDA PARMS+3
 STA (PNTR2),Y
 DEY
 LDA PARMS+4
 STA (PNTR3),Y
 LDA PARMS+2
 STA (PNTR2),Y
 
:ERROR LDA #$05
 JMP EXIT
 

 
__FOPEN PLA
 STA PNTR
 PLA
 STA PNTR+1
 
 LDA #$03 ; Three parameters for OPEN call
 STA PARMS
 
 LDY #$01 ; Fetch "channel" #
 LDA (PNTR),Y
 STA LASTFILE
 TAX
 LDA FNAMEL,X ; Set up filename destination
 STA PNTR3
 STA PARMS+1
 LDA FNAMEH,X
 STA PNTR3+1
 STA PARMS+2
 
 INY ; Set up pointer to filename source
 LDA (PNTR),Y
 STA PNTR2
 INY
 LDA (PNTR),Y
 STA PNTR2+1
 
 LDA FILEBUFL,X ; Set up pointer to ProDOS file buffer
 STA PARMS+3
 LDA FILEBUFH,X
 STA PARMS+4
 
 LDY #$00 ; Convert filename to ProDOS format
:LOOP LDA (PNTR2),Y
 INY
 STA (PNTR3),Y
 TAX
 BNE :LOOP
 DEY
 TYA
 LDY #$00
 STA (PNTR3),Y
 
 JSR MLI ; Call ProDOS
 DFB $C8
 DW PARMS
 
 STA _ER:
 BCS :ERROR
 
 LDA PARMS+5 ; Save reference number
 LDX LASTFILE
 STA REFNUM0,X
 
:ERROR LDA #$03
 JMP EXIT
 

 
__FREAD PLA
 STA PNTR
 PLA
 STA PNTR+1
 
 LDA #$04 ; Four parameters for READ call
 STA PARMS
 
 LDY #$01 ; Set up reference number
 LDA (PNTR),Y
 TAX
 LDA REFNUM0,X
 STA PARMS+1
 
 INY ; Set up data buffer
 LDA (PNTR),Y
 STA PARMS+2
 INY
 LDA (PNTR),Y
 STA PARMS+3
 
 INY ; Set up requested length
 LDA (PNTR),Y
 STA PNTR2
 INY
 LDA (PNTR),Y
 STA PNTR2+1
 LDY #$00
 LDA (PNTR2),Y
 STA PARMS+4
 INY
 LDA (PNTR2),Y
 STA PARMS+5
 
 JSR MLI ; Call ProDOS
 DFB $CA
 DW PARMS
 
 STA _ER: ; Save error number, if any
 
 LDA #$05
 JMP EXIT
 

 
__FCLOSE PLA
 STA PNTR
 PLA
 STA PNTR+1
 
 LDA #$01 ; One parameter
 STA PARMS
 
 LDY #$01
 LDA (PNTR),Y
 STA PARMS+1
 
 JSR MLI
 DFB $CC
 DW PARMS
 
 LDA #$01
 JMP EXIT
 

 
EXIT CLC
 ADC PNTR
 TAY
 LDA PNTR+1
 ADC #$00
 PHA
 TYA
 PHA
 RTS
 

 
PARMS DS 18
 

 
LASTFILE DFB 1
 
_ER: DFB 1
 
FNAMEL DFB #<REFNUM0,#<REFNUM1,#<REFNUM2
FNAMEH DFB #>REFNUM0,#>REFNUM1,#>REFNUM2
 
FILEBUFL DFB #<FILEBUF0,#<FILEBUF1,#<FILEBUF2
FILEBUFH DFB #>FILEBUF0,#>FILEBUF1,#>FILEBUF2