64'er 1989 October/64er_Magazin_89-10_1989_Markt__Technik_de_Side_A.d64/decomp.src

Text File | 2022-10-26 | 24KB | 1,403 lines

;***********************************************************
;*                                                         *
;*     Decompiler fuer C64 mit Austrocompiler              *
;*         Bringt mit dem Austrocompiler kompilierte       *
;*         Basicprogramm wieder in eine lesbare Form.      *
;*                                                         *
;*     Geschrieben 1987/88 von Thomas Klaeger              *
;*                                                         *
;***********************************************************
;
;
       .nolist
       .error
*      =   $9000
;
;  Betriebssystemroutinen:
;
bsout  =   $ffd2
basin  =   $ffcf
clrch  =   $ffcc
chkin  =   $ffc6
ckout  =   $ffc9
open   =   $ffc0
close  =   $ffc3
filpar =   $ffba
filnam =   $ffbd
load   =   $ffd5
reset  =   $fce2
;
;  Datenadressen: (globale Daten)
;
vst    =   $2d
arst   =   $2f
aren   =   $31
inst   =   $33
datst  =   $35
prgst  =   $37
count  =   $39
;
savesp =   $fe
;
namlen =   $ff
nambuf =   $200
nambu2 =   nambuf+2
;
;  Datenadressen: (lokale Daten, werden mit pushrg gerettet
;                  und mit poprg restauriert)
;
wp     =   $3b
pf     =   $3d
pl     =   $3f
pt     =   $41
p2     =   $43
prior1 =   $45
prior2 =   $46
priorc =   $47
c      =   $48
i      =   $49
;
;  hierher kommen Rueckmeldungen:
;
back   =   $14
;
;  Daten zur Zeilennummerierung:

linbuf =   $b000
lline  =   $7a
;
;  verschiedene benoetigte Macros:
;
.mac   print ;gibt text aus
       ldx #0
?2     lda ?1,x
       pha
       and #$7f
       jsr bsout
       inx
       pla
       bpl ?2
.mnd
;
.mac   mvw ;verschieben von 2-Byte-
       lda ?1 ;Zeigern
       ldy ?1+1
       sta ?2
       sty ?2+1
.mnd
;
.mac   phw ;push word
       lda ?1+1
       pha
       lda ?1
       pha
.mnd
;
.mac   plw ;pull word
       pla
       sta ?1
       pla
       sta ?1+1
.mnd
;
;
;  Das Werk kann beginnen:
;
       jmp start
;
error  lda #13     ; Floppyfehlerkanal abfragen
       jsr bsout
       ldx #15     ; vom Kommandokanal der Floppy
       jsr chkin   ; Lesen
       jsr basin   ; Zeichen holen
       cmp #'0'    ; Nummer '00' oder '01'?
       beq ok
       cmp #'7'    ; Nummer '73' (Resetmeldung?)
       bne out
       jsr basin
       cmp #'3'
       beq ok
       pha
       lda #'7'
       jsr bsout
       pla
out    jsr bsout   ; Fehlermeldung ausgeben
       jsr basin
       cmp #$d
       bne out
       pla
       pla
       jsr clrch
       jmp start
ok     jsr basin   ; Fehlermeldung nur lesen
       cmp #$d
       bne ok
       jsr clrch
       rts
;
titel  .byt $d,'decompiler zum austrocompiler',$8d
fnam   .byt 'bitte filenamen eingeben',$8d
init   .byt 'i0'
;
;
ende   jmp reset
;
;
start  tsx
       stx savesp
       print titel
       print fnam
       ldy #0
get    jsr basin
       cmp #$d
       beq end
       cmp #95     ; "<-" zum Abbruch
       beq ende
       sta nambuf+2,y
       iny
       bne get
end    tya
       beq start
       cmp #16
       bcs start
       sty namlen
;
       lda #15 ;fehlerkanal oeffnen
       ldx #8
       tay
       jsr filpar
       lda #2
       ldx #<init
       ldy #>init
       jsr filnam
       jsr open
;
       lda #1 ;programm laden
       ldx #8
       ldy #0
       jsr filpar
       lda namlen
       ldx #<nambu2
       ldy #>nambu2
       jsr filnam
       ldx #1
       ldy #8
       lda #0
       jsr load
       jsr error
;
       lda namlen
       adc #2
       cmp #16
       bcc filop
       lda #16
filop  sta namlen
       lda #'b'
       sta nambuf
       lda #'/'
       sta nambuf+1
       ldx #15
       jsr ckout
       lda #'s'    ; altes Basic-
       jsr bsout   ; programm loeschen
       lda #':'
       jsr bsout
       ldy #0
deloop lda nambuf,y
       jsr bsout
       iny
       cpy namlen
       bne deloop
       lda #13
       jsr bsout
       jsr clrch
       jsr error
       lda #2 ; ausgabedatei oeffnen
       ldx #8
       ldy #1
       jsr filpar
       clc
       lda namlen
       ldx #<nambuf
       ldy #>nambuf
       jsr filnam
       jsr open
       jsr error
;
       ldx #11 ;Parameter holen
setpar lda $1784,x
       sta vst,x
       dex
       bpl setpar
;
       lda datst+1 ; wirklich austro-compiler-
       cmp inst+1  ; code?
       bcc noaust
       bne ok01
       ldy datst
       cpy inst
       bcc noaust
ok01   lda prgst+1
       cmp datst+1
       bcc noaust
       bne ok02
       ldy prgst
       cpy datst
       bcc noaust
ok02   lda vst+1
       cmp prgst+1
       bcc noaust
       bne ok03
       ldy vst
       cpy prgst
       bcc noaust
ok03   lda arst+1
       cmp vst+1
       bcc noaust
       bne ok04
       ldy arst
       cpy vst
       bcc noaust
ok04   lda aren+1
       cmp arst+1
       bcc noaust
       bne vpack
       ldy aren
       cpy arst
       bcs vpack
noaust print notok
       ldx savesp
       txs
       jmp start
notok  .byt 13,'code nicht ok, kein austro-compiler-',13,'programm!!',$8d
;
vpack  mvw vst,count ; Variabelnnamen packen
       mvw vst,pt
vpack0 lda count+1
       cmp arst+1
       bcc vpa00
       lda count
       cmp arst
       bcs vpack1
vpa00  ldy #0
       lda (count),y
       sta (pt),y
       iny
       lda (count),y
       sta (pt),y
       clc
       lda #7
       adc count
       sta count
       bcc vpa01
       inc count+1
vpa01  clc
       lda #2
       adc pt
       sta pt
       bcc vpack0
       inc pt+1
       bne vpack0
vpack1 mvw pt,arst
;
       ldy #0          ; vordefinierte Arrays
       lda (inst),y    ; holen
       cmp #$16
       bne pda00
       jmp noar        ; Keine Arrays vorhanden
pda00  mvw inst,count
       mvw inst,pl
       jsr intval      ; Anzahl Arrays holen
       inc back
       bne pda01
       inc back+1
pda01  mvw back,$60    ; Platz fuer Array-
       asl $60         ; Deskriptoren
       rol $61         ; schaffen
       clc
       lda $60
       adc back
       sta back
       lda $61
       adc back+1
       sta back+1
       clc
       lda arst
       adc back
       sta aren
       lda arst+1
       adc back+1
       sta aren+1
;
arloop jsr next
       ldy #0
       lda (count),y
       cmp #$16        ; Ende der vordefinierten
       beq noar        ; Arrays
       cmp #$10        ; Dim?
       bne arloop
       jsr getarn
       jmp arloop
;
noar   lda #>linbuf
       ldy #4
       sta $7b
       sty $7a
       lda #$8f
       ldy #0
       sta wp+1
       sty wp
       lda #0
       sta linbuf
       sta linbuf+1
       lda #255
       sta linbuf+2
       sta linbuf+3
       lda #$36
       sta 1
       jsr pass1
       jsr pass2
       jsr pass3
       lda #2
       jsr close
       jmp start
;
; ************************************
; *          Unterprogramme          *
; ************************************
;
getarn ldy #1      ; Arrayparameter ablegen
       lda (count),y
       sta $5a
       iny
       lda (count),y
       sta $58
       iny
       lda (count),y
       sta $59
       iny
       lda (count),y
       sta back+1
       iny
       lda (count),y
       sec
       sbc #7
       sta back
       lda back+1
       sbc #0
       sta back+1
       lsr a
       sta $61
       lda back
       ror a
       clc
       adc back
       sta back
       lda back+1
       adc $61
       sta back+1
       lda $58
       cmp #$da
       bne ar1
       lda $59
       cmp #$aa
       beq ar3
ar1    clc
       lda back
       adc arst
       sta back
       lda back+1
       adc arst+1
       sta back+1
       ldy #2
ar2    lda $58,y
       sta (back),y
       dey
       bpl ar2
ar3    rts
;
intval ldy #0
       lda (pl),y
       bmi intv00
       rts
intv00 sty back
       sty back+1
       iny
       cmp #$a6
       bne intva1
       lda (pl),y
       sta back
       rts
intva1 cmp #$a7
       bne intva2
       lda (pl),y
       sta back+1
       iny
       lda (pl),y
       sta back
       rts
intva2 cmp #$c0
       and #15
       bcc intv01
       clc
       adc #$10
intv01 sta back
       rts
;
nextab
;           0 1 2 3 4 5 6 7 8 9 a b c d e f
       .byt 0,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1 0
       .byt 6,1,1,1,1,1,1,1,0,3,3,0,0,1,1,2 1
       .byt 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1 2
       .byt 1,1,1,1,1,1,1,6,3,1,1,1,1,1,1,1 3
       .byt 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1 4
       .byt 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1 5
       .byt 2,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1 6
       .byt 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1 7
       .byt 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1 8
       .byt 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1 9
       .byt 2,2,2,3,2,3,2,3,6,6,1,1,1,1,1,1 a
       .byt 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1 b
       .byt 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1 c
       .byt 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1 d
       .byt 2,2,2,3,2,3,1,0,1,2,3,4,5,6,7,8 e
       .byt 1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1 f
;
next   ldy #0
       lda (count),y
       tax
       lda nextab,x
       beq nexta
nextad clc
       adc count
       sta count
       bcc next00
       inc count+1
next00 rts
nexta  lda (count),y
       cmp #$e7
       bne nextb
       iny
       lda (count),y
       clc
       adc #2
       bcc nextad
nextb  cmp #27
       bcc nextc
       iny
       lda (count),y
       bne nextad
nextc  cmp #24
       bne nextd
next01 iny
       lda (count),y
       cmp #':'
       bne next01
       iny
next02 tya
       bne nextad
nextd  iny
       cpy #100
       beq next02
       lda (count),y
       cmp #$9e
       bne nextd
       iny
       lda (count),y
       cmp #'3'
       bne nextd
       iny
       lda (count),y
       cmp #'2'
       bne nextd
       iny
       lda (count),y
       cmp #'2'
       bne nextd
       iny
       lda (count),y
       cmp #'0'
       bne nextd
       iny
       lda (count),y
       cmp #':'
       bne nextd
       iny
       tya
       jmp nextad
;
getval ldy #0
       lda #$37
       sta 1
       lda priorc
       pha
       lda (pl),y
       cmp #$a8
       bne getint
       ldy pl+1
       lda pl
       clc
       adc #1
       bcc getv0
       iny
getv0  jsr $bba2
       jsr $bddd
       lda #$36
       sta 1
       pla
       sta priorc
       rts
;
getint jsr intval
       ldy back
       lda back+1
       jsr $b391
       jsr $bddd
       lda #$36
       sta 1
       pla
       sta priorc
       rts
;
cint   lda #$37
       sta 1
       ldy back
       lda back+1
       jsr $b391
       jsr $bddd
       lda #$36
       sta 1
       lda #1
       ldy #0
       sta back+1
       sty back
       lda (back),y
       cmp #32
       bne cint0
       inc back
cint0  lda (back),y
       sta (pt),y
       beq cint1
       iny
       bne cint0
cint1  rts
;
getstr ldy #0
       lda #34
       sta (pt),y
getst1 lda (pl),y
       cpy i
       bcs getst2
       iny
       sta (pt),y
       bne getst1
getst2 iny
       lda #34
       sta (pt),y
       iny
       lda #0
       sta (pt),y
       rts
;
pushrg dec wp+1
       lda wp+1
       cmp aren+1
       bne pushr0
       jmp nomem
pushr0 ldy #0
pushr1 lda $3d,y
       sta (wp),y
       iny
       cpy #16
       bne pushr1
       rts
;
poprg  ldy #0
poprg1 lda (wp),y
       sta $3d,y
       iny
       cpy #16
       bne poprg1
       inc wp+1
       rts
;
varna1 phw count
       ldy #0
       lda (count),y
       sty back+1
       cmp #$e5
       bne varn01
       iny
       lda (count),y
       sta back+1
varn01 iny
       lda (count),y
       jsr varn5
       plw count
       rts
;
varnam ldy #0
       lda (pl),y
       and #$3f
       sta i
       cmp #32
       bcs varn1
       sta back
       sty back+1
       jsr vnam
       jmp varnc
varn1  cmp #35
       bne varn2
       iny
       lda (pl),y
       sta back+1
       iny
       lda (pl),y
       sta back
       jsr vnam
       jmp varnc
varn2  bcs varn3
       and #3
       sta back+1
       iny
       lda (pl),y
       sta back
       jsr vnam
varnc  ldy #0
       lda $100,y
       sta (pt),y
       beq varnen
       iny
       bne varnc+2
varnen mvw pl,back
       rts
;
varn3  sty back+1
       cmp #37
       bne varn4
       iny
       lda (pl),y
       sta back+1
varn4  iny
       lda (pl),y
varn5  sta back
       jsr arnam
       pha
       jsr varnc
       pla
       sta back
       jsr incpt
getmul lda #'('
       sta (pt),y
       tya
       sec
       adc pt
       sta pt
       jsr pushrg
       lda back
       pha
       lda #16
       ldy wp+1
       sta pt
       sty pt+1
       jsr getexp
       lda #116
       ldy wp+1
       sta p2
       sty p2+1
varnl  lda #16
       sta pt
       pla
       sec
       sbc #1
       bne varnl0
       jmp varne1
varnl0 pha
       ldy #0
varnl1 lda (pt),y
       sta (p2),y
       beq varnl2
       iny
       bne varnl1
varnl2 mvw back,pl
       jsr getexp
       lda #16
       sta pt
       lda #44
       jsr addchr
       lda #116
       ldy wp+1
       sta p2
       sty p2+1
       ldy #0
varnl3 lda (p2),y
       sta (pt),y
       beq varnl4
       iny
       bne varnl3
varnl4 lda #16
       sta pt
       jmp varnl
varne1 ldy #255
varne2 iny
       lda (pt),y
       bne varne2
       lda #')'
       sta (pt),y
       tya
       pha
       mvw pt,$5f
       jsr poprg
       pla
       tay
       iny
       lda #0
       sta (pt),y
       dey
varne3 lda ($5f),y
       sta (pt),y
       dey
       bpl varne3
       rts
;
vnam   lda back
       asl a
       rol back+1
       clc
       adc vst
       sta $61
       lda back+1
       adc vst+1
       sta $62
vname  ldy #0
       lda ($61),y
       php
       and #$7f
       sta $100
       iny
       lda ($61),y
       php
       and #$7f
       beq vnam0
       sta $100,y
       iny
vnam0  plp
       bpl vnam3
       plp
       bmi vnam1
       lda #'$'
       bne vnam2
vnam1  lda #'%'
vnam2  sta $100,y
       iny
       bne vnam4
vnam3  plp
vnam4  lda #0
       sta $100,y
       rts
;
arnam  sec
       lda back
       sbc #3
       sta back
       bcs arn00
       dec back+1
arn00  asl a
       tax
       lda back+1
       rol a
       tay
       txa
       clc
       adc back
       tax
       tya
       adc back+1
       tay
       txa
       adc arst
       sta $61
       tya
       adc arst+1
       sta $62
       jsr vname
       ldy #2
       lda ($61),y
       rts
;
getexp mvw pf,count ; Holt Ausdruck aus
getexl mvw count,p2 ; dem Text
       jsr next
       lda count+1
       cmp pl+1
       bcc getexl
       lda count
       cmp pl
       bcc getexl
       ldy #0
       lda (p2),y
       sta c
       cmp #7       ; Prioritaet feststellen
       bcs gx000
       lda #4
       bne getexa
gx000  cmp #9
       bcs gx001
       lda #5
       bne getexa
gx001  cmp #11
       bcs gx002
       lda #6
       bne getexa
gx002  bne gx003
       lda #8
       bne getexa
gx003  cmp #13
       bcs gx004
       lda #2
       bne getexa
gx004  bne gx005
       lda #1
       bne getexa
gx005  cmp #15
       bcs gx006
       lda #7
       bne getexa
gx006  bne gx007
       lda #7
       bne getexa
gx007  lda #10
getexa sta priorc
       lda c
       cmp #14
       bcc gx008
       jmp getb00
gx008  jsr pushrg  ; d1 op d2
       mvw p2,pl
       lda #132
       ldy wp+1
       sta pt
       sty pt+1
       jsr getexp  ; hole d2
       ldy #prior2-pf
       sta (wp),y
       mvw back,pl
       lda #32
       sta pt
       jsr getexp  ; hole d1
       ldy #prior1-pf
       sta (wp),y
       lda wp+1
       pha
       jsr poprg
       mvw back,pl
       pla
       sta back+1
       lda #32
       sta back
       ldy #0
       lda prior1   ; muss d1 geklammert werden ?
       cmp priorc
       bcs gx009    ; nein ->
       lda #'('     ; '(' in Ausdruckbuffer
       sta (pt),y
       inc pt
gx009  lda (back),y ; d1 in Ausdruckbuffer
       sta (pt),y
       beq gx010
       iny
       bne gx009
gx010  lda prior1
       cmp priorc
       bcs gx011    ; wenn d1 geklammert werden muss
       lda #')'     ; ')' in Ausdruckbuffer
       sta (pt),y
       iny
gx011  tya
       clc
       adc pt
       sta pt
       ldy #0
       lda c
       cmp #7
       bcc gx012
       adc #162     ; + - * / ^ and or
       sta (pt),y
       iny
       bne geta00
gx012  and #4
       beq gx013
       lda #179     ; '<'
       sta (pt),y
       iny
gx013  lda c
       and #1
       beq gx014
       lda #177     ; '>'
       sta (pt),y
       iny
gx014  lda c
       and #2
       beq geta00
       lda #178     ; '='
       sta (pt),y
       iny
geta00 tya
       clc
       adc pt
       sta pt
       ldy #0
       lda #132
       sta back
       lda prior2   ; muss d2 geklammert werden ?
       cmp priorc
       bcc geta01   ; unbedingt ->
       bne geta02   ; sicher nicht ->
       lda c
       cmp #10      ; wenn op <> '/'
       bne geta02   ; nicht klammern ->
       dec prior2   ; merken fuer 2. Test
geta01 lda #'('
       sta (pt),y
       inc pt
geta02 lda (back),y
       sta (pt),y
       beq geta03
       iny
       bne geta02
geta03 lda prior2
       cmp priorc
       bcs geta04
       lda #')'
       sta (pt),y
       iny
geta04 lda #0
       sta (pt),y
       mvw pl,back
       lda priorc
       rts          ; geschafft!
getb00 cmp #32
       bcs getb02
getb01 jmp getc00
getb02 cmp #52
       bcs getb01
       jsr pushrg
       lda #32     ; fkt(d1)
       ldy wp+1
       sta pt
       sty pt+1
       mvw p2,pl
       jsr getexp  ; d1 holen
       lda wp+1
       pha
       jsr poprg
       mvw back,pl
       pla
       sta back+1
       lda #32
       sta back
       ldy #0
       lda c
       clc
       adc #148
       sta (pt),y  ;{CBM-B}fkt in den Ausdruckbuffer
       inc pt
       lda #'('    ; '(' in den Ausdruckbuffer
       sta (pt),y
       inc pt
getb03 lda (back),y ; d1 in den Ausdruckbuffer
       sta (pt),y
       beq getb04
       iny
       bne getb03
getb04 lda #')'     ; ')' in den Ausdruckbuffer
       sta (pt),y
       iny
       lda #0
       sta (pt),y
       mvw pl,back
       lda priorc
       rts          ; geschafft!
getc00 cmp #52
       beq getc01
       cmp #53
       bne getd00
getc01 adc #147     ; fkt(d1,d2) (left$,right$)
       ldy #0
       sta (pt),y   ; fkt in den Aus
       inc pt
       lda #2
getc02 sta back     ; back := 2/3
       sty back+1
       mvw p2,pl
       ldy #0
       jsr getmul   ; 2/3 Teilausdruecke in Klammern holen
       lda priorc
       rts          ; geschafft!
getd00 cmp #54
       bne gete00
       adc #147     ; fkt(d1,d2,d3) (mid$)
       ldy #0
       sta (pt),y
       inc pt
       lda #3
       bne getc02
gete00 cmp #$7f
       bcs gete02
gete01 jmp getf00
gete02 cmp #$a6
       bcs gete01
       mvw p2,pl
       jsr varnam   ; Variable holen
       lda priorc
       rts
getf00 cmp #$a6
       bcs getf02
getf01 jmp getg00
getf02 cmp #$a9
       bcc getf03
       cmp #$b0
       bcc getf01
       cmp #$c0
       bcc getf03
       cmp #$f0
       bcc getf01
getf03 mvw p2,pl    ; Konstante holen
       jsr getval
       lda #1
       ldy #0
       sta back+1
       sty back
       lda (back),y
       cmp #32
       bne getf04
       inc back
getf04 lda (back),y
       sta (pt),y
       beq getf05
       iny
       bne getf04
getf05 mvw pl,back
       lda priorc
       rts
getg00 cmp #14      ; '-' ? (Vorzeichen)
       beq getg01
       cmp #15      ; not
       bne getg10
getg01 jsr pushrg
       mvw p2,pl
       lda #132
       ldy wp+1
       sta pt
       sty pt+1
       jsr getexp
       ldy #prior2-pf
       sta (wp),y
       lda wp+1
       pha
       jsr poprg
       mvw back,pl
       pla
       sta back+1
       ldy #0
       lda c
       asl a
       sta back
       sec
       lda #213
       sbc back
       sbc c
       sta (pt),y   ; Operator merken
       iny
       jmp geta00
getg10 cmp #$aa
       bne getg20
       ldy #0
       lda #255     ; Pi
       sta (pt),y
       tya
       iny
       bne geth00
getg20 cmp #$ab
       bne getg30
       ldy #0
       lda #'s'     ; st
       sta (pt),y
       iny
       lda #'t'
       sta (pt),y
       iny
       bne geth00
getg30 cmp #$ac
       beq getg31
       cmp #$af
       bne getg40
getg31 ldy #0
       lda #'t'     ; ti/ti$
       sta (pt),y
       iny
       lda #'i'
       sta (pt),y
       iny
       lda c
       cmp #$ac
       beq geth00
       lda #'$'
       sta (pt),y
       iny
geth00 lda #0
       sta (pt),y
       mvw p2,back
       lda priorc
       rts
getg40 cmp #$e7     ; String
       bne getg50
       mvw p2,pl
       ldy #1
       lda (pl),y
       sta i
       iny
       bne getg60
getg50 cmp #56
       beq getg70
       and #7       ; Shortstring
       sta i
       mvw p2,pl
       ldy #1
getg60 tya
       clc
       adc pl
       sta pl
       bcc getg61
       inc pl+1
getg61 jsr getstr
       mvw p2,back
       lda priorc
       rts
getg70 ldy #0       ; Arrayelement
       lda #165
       sta (pt),y
       inc pt
       ldy #1
       lda (p2),y
       sta back+1
       iny
       lda (p2),y
       sta back
       jsr div7
       lda back
       asl a
       rol back+1
       adc vst
       sta $61
       lda back+1
       adc vst+1
       sta $62
       jsr vname
       jsr varnc
       lda #'('
       jsr addchr
       jsr pushrg
       lda #32
       ldy wp+1
       sta pt
       sty pt+1
       mvw p2,pl
       jsr getexp
       lda wp+1
       pha
       jsr poprg
       mvw back,pl
       pla
       sta back+1
       lda #32
       sta back
       ldy #0
getg71 lda (back),y
       sta (pt),y
       beq getg72
       iny
       bne getg71
getg72 lda #')'
       sta (pt),y
       iny
       lda #0
       sta (pt),y
       mvw pl,back
       lda priorc
       rts
;
;
isexpr ldy #0       ; Auf Ausdruckelement pruefen
       lda (count),y
       beq isnexp
       cmp #16
       bcc isexp
       cmp #32
       bcc isnexp
       cmp #$37
       bcc isexp
       cmp #$38
       beq isexp
       cmp #$80
       bcc isnexp
       cmp #$c0
       bcc isexp
       cmp #$e7
       bcc isnexp
isexp  sec
       rts
isnexp clc
       rts
;
islet  ldy #0       ; Auf Zuweisung pruefen
       lda (count),y
       cmp #$c0
       bcc isnlet
       cmp #$e7
       bcs isnlet
       sec
       rts
isnlet clc
       rts
;
addlin jsr search
       bcc addl02
       rts
addl02 mvw lline,$65
       clc
       lda #2
       adc lline
       sta lline
       bcc addl03
       inc lline+1
       lda lline
       cmp #$d0
       bcc addl03
       jmp nomem
addl03 mvw $7a,$5f
addl04 lda $65
       bne addl05
       dec $66
addl05 dec $65
       lda $5f
       bne addl06
       dec $60
addl06 dec $5f
       ldy #0
       lda ($65),y
       sta ($5f),y
       lda $64
       cmp $66
       bcc addl04
       lda $63
       cmp $65
       bcc addl04
       lda back
       sta ($63),y
       iny
       lda back+1
       sta ($63),y
       rts
;
nom    .byt 'not enough memory!!',$8d
;
nomem  print nom
       ldx savesp
       txs
       ldx #2
       jsr ckout
       lda #0
       jsr bsout
       jsr bsout
       jsr clrch
       ldx #2
       jsr close
       jmp start
;
linend phw count
       lda pt
       cmp #72
       bcs line02
       bcc linen2
linen1 phw count
linen2 jsr next
       mvw count,back
       jsr search
       bcc line03
line02 plw count
       sec
       rts
line03 plw count
       clc
       rts
;
incpt  ldy #255
incpt0 iny
       lda (pt),y
       bne incpt0
       clc
       tya
       adc pt
       sta pt
       ldy #0
       rts
;
addchr pha
       ldy #255
addch0 iny
       lda (pt),y
       bne addch0
       pla
       sta (pt),y
       sec
       tya
       adc pt
       sta pt
       ldy #0
       tya
       sta (pt),y
       rts
;
search mvw lline,$63
       lda #>linbuf
       ldy #0
       sty $61
       sta $62
seloop clc
       lda $61
       adc $63
       sta $65
       lda $62
       adc $64
       ror a
       sta $66
       lda $65
       ror a
       and #254
       sta $65
       cmp $61
       bne sel01
       lda $66
       cmp $62
       bne sel01
       clc
       rts
sel01  ldy #1
       lda ($65),y
       cmp back+1
       bcc sel02
       bne sel03
       dey
       lda ($65),y
       cmp back
       bcc sel02
       bne sel03
       rts
sel02  mvw $65,$61
       jmp seloop
sel03  mvw $65,$63
       jmp seloop
;
       .fil decomp2.src