home *** CD-ROM | disk | FTP | other *** search
- ; FALSE compiler in a 1020 bytes executable!
- ; Wouter van Oortmerssen, 1993, v1.1
- ; - fixed free twice bug in v1.0
-
- maxsource = 25000
- maxcode = 30000
- maxmem = maxsource+maxcode+5000
-
- k: clr.b -1(a0,d0.w)
- move.l a0,d5 ; d5=temparg
- move.l 4.w,a6
- moveq #0,d1
- moveq #1,d0
- swap d0 ; move.l #maxmem,d0
- jsr -684(a6) ; allocvec
- move.l d0,d6 ; d6=tempmem
- beq nfrer
- move.l d6,a2 ; a2=mem
- move.l d6,a4 ; a4=code
- lea maxsource(a4),a4
- move.l a4,d7 ; d7=begin_of_code
- lea maxcode(a4),a3 ; a3=lambda-stack
- lea dosn(pc),a1
- moveq #37,d0
- jsr -552(a6) ; opendoslib
- tst.l d0
- beq.w ncler
- move.l d0,a6 ; a6=dosbase
- move.l d5,d1
- move.l #1005,d2
- jsr -30(a6) ; open(arg)
- tst.l d0
- beq.w er
- move.l d0,d5 ; d5=temphandle
- move.l d0,d1
- move.l d6,d2
- move.l #maxsource,d3
- jsr -42(a6) ; readfile
- move.l d0,d6
- move.l d5,d1
- jsr -36(a6) ; close
- cmp.w #1,d6
- bmi.w er
- add.l d2,d6 ; d6=end_of_source
- move.l d2,a5 ; a5=source
- lea initc(pc),a0
- lea inite(pc),a1
- bsr copy
-
- loop: cmp.l d6,a5 ; main loop
- bpl.w done
- moveq #0,d0
- move.b (a5)+,d0
- cmp.w #"0",d0
- bpl.w num
- numb: cmp.w #"[",d0 ; lambda
- bne.s .1
- move.l #$41fa0008,(a4)+ ; lea ...(pc),a0
- move.w #$2b08,(a4)+ ; move.l a0,-(a5)
- move.l #$6000fff8,(a4)+ ; bra ...
- move.l a4,(a3)+
- bra.s loop
- .1: cmp.w #"]",d0 ; end of lambda
- bne.s .2
- move.w #$4e75,(a4)+
- move.l -(a3),a0
- move.l a4,d0
- sub.l a0,d0
- addq.l #2,d0
- move.w d0,-2(a0)
- bra.s loop
- .2: cmp.w #"a",d0 ; variable
- bpl.w var
- varb: cmp.w #" "+1,d0
- bmi.s loop
- cmp.w #"{",d0
- bne.s .1
- .l: cmp.l d6,a5 ; collect comments
- bpl.w done
- cmp.b #"}",(a5)+
- bne.s .l
- bra.s loop
- .1: cmp.w #34,d0
- bne.s .2
- move.l #$41fa0006,(a4)+ ; gen code for string
- move.l #$60000000,(a4)+
- move.l a4,a0
- .l2: cmp.l d6,a5
- bpl.s .f
- cmp.b #34,(a5)
- beq.s .f
- move.b (a5)+,(a4)+
- bra.s .l2
- .f: addq.l #1,a5
- clr.b (a4)+
- move.l a4,d0
- btst #0,d0
- beq.s .even
- clr.b (a4)+
- .even: move.l a4,d0
- sub.l a0,d0
- addq.l #2,d0
- move.w d0,-2(a0)
- move.l #$22084eae,(a4)+
- move.w #$fc4c,(a4)+
- bra.w loop
- .2: cmp.w #"'",d0 ; ascii
- bne.s .3
- moveq #0,d0
- move.b (a5)+,d0
- move.w #$2b3c,(a4)+
- move.l d0,(a4)+
- bra.w loop
- .3: cmp.w #"`",d0 ; inline assembler :-)
- bne.s .4
- move.l -(a4),d0
- subq.l #2,a4
- move.w d0,(a4)+
- bra.w loop
- .4:
- lea plus(pc),a0
- search: cmp.b 2(a0),d0 ; generate code for symbol
- bne.s next
- addq.l #3,a0
- moveq #0,d1
- move.b (a0)+,d1
- .cl: move.w (a0)+,(a4)+
- dbra d1,.cl
- bra.w loop
- next: move.w (a0),d1
- beq.w er
- add.w d1,a0
- bra.s search
-
- done: lea exitc(pc),a0
- lea exite(pc),a1
- bsr copy
- move.l a4,d0 ; ready, now write executable.
- btst #1,d0
- beq.s .s
- clr.w (a4)+
- .s: move.l a4,d0
- sub.l d7,d0
- sub.l #32,d0
- lsr.l #2,d0
- move.l #1010,(a4)+ ; hunk_end
- move.l d7,a0
- move.l d0,20(a0) ; hunk lenght
- move.l d0,28(a0)
- lea exen(pc),a0
- move.l a0,d1 ; now write exe
- move.l #1006,d2
- jsr -30(a6) ; open
- move.l d0,d4
- beq er
- move.l d0,d1
- move.l d7,d2
- move.l a4,d3
- sub.l d7,d3
- jsr -48(a6) ; write
- move.l d4,d1
- jsr -36(a6) ; close
-
- close: move.l a6,a1
- move.l 4.w,a6
- jsr -414(a6)
- bsr.s ncler
- moveq #0,d0
- rts
-
- er: bsr.s close
- bra.s nfrer
- ncler: move.l a2,a1
- jsr -690(a6)
- nfrer: moveq #10,d0 ; error exit point
- rts
-
- num: cmp.w #"9"+1,d0 ; code gen voor num
- bpl.w numb
- moveq #0,d1
- .l: mulu #10,d1
- sub.w #"0",d0
- add.l d0,d1
- cmp.b #"0",(a5)
- bmi.s .x
- cmp.b #"9"+1,(a5)
- bpl.s .x
- moveq #0,d0
- move.b (a5)+,d0
- bra.s .l
- .x: move.w #$2b3c,(a4)+ ; move.l #x,-(a5)
- move.l d1,(a4)+
- bra.w loop
-
- var: cmp.w #"z"+1,d0 ; code gen voor vars
- bpl.w varb
- sub.w #"a",d0
- lsl.w #2,d0
- move.w #$41ec,(a4)+ ; lea x(a4),a0
- move.w d0,(a4)+
- move.w #$2b08,(a4)+ ; move.l a0,-(a5)
- bra.w loop
-
- copy: move.l a1,d0
- sub.l a0,d0
- lsr.l #1,d0
- subq.l #1,d0
- .l: move.w (a0)+,(a4)+
- dbra d0,.l
- rts
-
- ; code-gen list: implementation for all other symbols.
-
- plus: dr.w min
- dc.b "+",1
- move.l (a5)+,d0
- add.l d0,(a5)
- min: dr.w mul
- dc.b "-",1
- move.l (a5)+,d0
- sub.l d0,(a5)
- mul: dr.w div
- dc.b "*",3
- move.l (a5)+,d0
- muls 2(a5),d0
- move.l d0,(a5)
- div: dr.w printi
- dc.b "/",4
- move.l (a5)+,d0
- move.l (a5),d1
- divs d0,d1
- ext.l d1
- move.l d1,(a5)
- printi: dr.w exe
- dc.b ".",9
- bra.s .c
- .form: dc.b "%ld",0
- .c: lea .form(pc),a0
- move.l a0,d1
- move.l a5,d2
- jsr -954(a6)
- addq.l #4,a5
- exe: dr.w store
- dc.b "!",1
- move.l (a5)+,a0
- jsr (a0)
- store: dr.w get
- dc.b ":",1
- move.l (a5)+,a0
- move.l (a5)+,(a0)
- get: dr.w equal
- dc.b ";",1
- move.l (a5)+,a0
- move.l (a0),-(a5)
- equal: dr.w if
- dc.b "=",5
- move.l (a5)+,d0
- cmp.l (a5),d0
- seq d0
- ext.w d0
- ext.l d0
- move.l d0,(a5)
- if: dr.w dup
- dc.b "?",3
- move.l (a5)+,a0
- move.l (a5)+,d0
- beq.s .f
- jsr (a0)
- .f:
- dup: dr.w drop
- dc.b "$",0
- move.l (a5),-(a5)
- drop: dr.w swap
- dc.b "%",0
- addq.l #4,a5
- swap: dr.w rot
- dc.b "\",4
- move.l (a5),d0
- move.l 4(a5),(a5)
- move.l d0,4(a5)
- rot: dr.w neg
- dc.b "@",7
- move.l 8(a5),d0
- move.l 4(a5),8(a5)
- move.l (a5),4(a5)
- move.l d0,(a5)
- neg: dr.w and
- dc.b "_",0
- neg.l (a5)
- and: dr.w or
- dc.b "&",1
- move.l (a5)+,d0
- and.l d0,(a5)
- or: dr.w not
- dc.b "|",1
- move.l (a5)+,d0
- or.l d0,(a5)
- not: dr.w big
- dc.b "~",0
- not.l (a5)
- big: dr.w while
- dc.b ">",5
- move.l (a5)+,d0
- cmp.l (a5),d0
- smi d0
- ext.w d0
- ext.l d0
- move.l d0,(a5)
- while: dr.w put
- dc.b "#",12
- movem.l (a5)+,a0/a1 ; fun,boolf
- movem.l a0/a1,-(a7)
- .s: move.l 4(a7),a0
- jsr (a0)
- tst.l (a5)+
- beq.s .e
- move.l (a7),a0
- jsr (a0)
- bra.s .s
- .e: addq.l #8,a7
- put: dr.w getc
- dc.b ",",3
- move.l d6,d1
- move.l (a5)+,d2
- jsr -312(a6)
- getc: dr.w pick
- dc.b "^",3
- move.l d5,d1
- jsr -306(a6)
- move.l d0,-(a5)
- pick: dr.w flush
- dc.b "ø",3
- move.l (a5)+,d0
- lsl.l #2,d0
- move.l 0(a5,d0.l),-(a5)
- flush: dc.w 0
- dc.b "ß",5
- move.l d5,d1
- jsr -360(a6)
- move.l d6,d1
- jsr -360(a6)
-
- exen: dc.b "a.out",0
- even
-
- ; initialisation code.
-
- initc: dc.l 1011 ; hunkheader
- dc.l 0,1,0,0 ; endofnames,1hunk,firsthunkno,lasthn
- dc.l 0 ; codesize/4
- dc.l 1001 ; hunkcode
- dc.l 0 ; codesize/4
- lea -$900(a7),a5 ; a5=calcstack
- lea -$800(a7),a4 ; a4=variables
- move.l a0,(a4) ; var_a=arg
- move.l 4.w,a6
- lea dosn(pc),a1
- moveq #37,d0
- jsr -552(a6) ; opendoslib
- tst.l d0
- bne.s .o
- rts
- .o: move.l d0,a6
- jsr -60(a6)
- move.l d0,d6 ; d6=stdout
- jsr -54(a6)
- move.l d0,d5 ; d5=stdin
- bra.s inite
- dosn: dc.b "dos.library",0
- inite:
- exitc: move.l a6,a1
- move.l 4.w,a6
- jsr -414(a6)
- moveq #0,d0
- rts
- exite:
-