--- /dev/null
+.define Aar
+
+! This subroutine gets the address of the array element
+
+
+Aar:
+ stx ADDR ! address of descriptor (lowbyte)
+ sta ADDR+1 ! address of descriptor (highbyte)
+ ldy #0
+ lda (ADDR),y ! lowerbound (lowbyte)
+ tax
+ iny
+ lda (ADDR),y ! lowerbound (highbyte)
+ jsr Sbi2 ! index - lowerbound
+ jsr Push
+ 2: ldy #4
+ lda (ADDR),y ! objectsize (lowbyte)
+ sta NBYTES
+ tax
+ iny
+ lda (ADDR),y ! objectsize (highbyte)
+ sta NBYTES+1
+ bne 5f
+ cpx #1 ! objectsize = 1 then return
+ bne 5f ! arrayaddress + index
+ jsr Pop
+ jmp Adi2
+ 5: jsr Mli2 ! objectsize > 1 then return
+ jmp Adi2 ! arrayaddress + index * objectsize
+
+
--- /dev/null
+.define Addsub
+
+! This subroutine is used by the fourbyte addition and subtraction
+! routines.
+! It puts the address of the second operand into
+! the zeropage locations ADDR and ADDR+1
+! The address of the first operand is put into
+! zeropage locations ADDR+2 and ADDR+3.
+
+
+Addsub:
+ clc
+ lda SP+2
+ sta ADDR ! address of second operand (lowbyte)
+ adc #4
+ sta SP+2
+ sta ADDR+2 ! address of first operand (lowbyte)
+ lda SP+1
+ sta ADDR+1 ! address of second operand (highbyte)
+ adc #0
+ sta ADDR+3 ! address of first operand (highbyte)
+ sta SP+1
+ ldy #0
+ ldx #0FCh ! do it 4 times
+ rts
+
+
--- /dev/null
+.define Adi2
+
+! This subroutine adds two twobyte integers.
+! The first operand is on the top of the stack, the second operand
+! is in the AX registerpair.
+! The result is returned in registerpair AX.
+
+
+Adi2:
+ sta ARTH+1 ! second operand (highbyte)
+ stx ARTH ! second operand (lowbyte)
+ jsr Pop ! get first operand
+ pha ! save A
+ clc
+ txa
+ adc ARTH ! add lowbytes
+ tax
+ pla ! get A
+ adc ARTH+1 ! add the highbytes
+ rts
+
+
--- /dev/null
+.define Adi4
+
+! This subroutine adds two fourbyte integers, which are on the stack.
+! The addresses are initiated by the subroutine Addsub.
+! Also the loopvariable (register X) is initiated by that routine.
+! The result is pushed back onto the stack
+
+
+Adi4:
+ jsr Addsub ! initiate addresses
+ clc
+ 1: lda (ADDR+2),y ! get byte first operand
+ adc (ADDR),y ! add to byte second operand
+ sta (ADDR+2),y ! push on real stack
+ iny
+ inx
+ bne 1b ! do it 4 times
+ rts
+
+
--- /dev/null
+.define And
+
+! This subroutine performs the logical and on two groups of
+! atmost 254 bytes. The number of bytes is in register Y.
+! The two groups are on the stack.
+! First the value of the stackpointer is saved in zeropage
+! locations ADDR, ADDR+1. Then an offset of Y is added
+! and stored in ADDR+2, ADDR+3.
+! The result is pushed back on the stack.
+
+
+And:
+ lda SP+1
+ sta ADDR+1 ! address of first group (lowbyte)
+ lda SP+2
+ sta ADDR ! address of first group (highbyte)
+ clc
+ tya
+ adc SP+2
+ sta SP+2 ! new stackpointer (lowbyte)
+ sta ADDR+2 ! stackpointer + Y (lowbyte)
+ lda #0
+ adc SP+1
+ sta SP+1 ! new stackpointer (highbyte)
+ sta ADDR+3 ! stackpointer + Y (highbyte)
+ 1: dey
+ lda (ADDR),y ! get byte first group
+ and (ADDR+2),y ! perform logical and with second group
+ sta (ADDR+2),y ! push result on real_stack
+ tya
+ bne 1b ! do it n times
+ rts
+
+
--- /dev/null
+.define Asp
+
+! This subroutine adds an offset to the stackpointer,
+! e.g. after the return from a procedurecall.
+! The offset is in registerpair AX, and is added to the
+! stackpointer.
+
+
+Asp:
+ tay ! save A
+ txa ! get X
+ clc
+ adc SP+2 ! add adjustment (lowbyte)
+ sta SP+2 ! new stackpointer (lowbyte)
+ tya ! get A
+ adc SP+1 ! add adjustment (highbyte)
+ sta SP+1 ! get stackpointer (highbyte)
+ rts
+
+
--- /dev/null
+.define Blm, Blmnp
+
+! This subroutine copies bytes from one place in memory to
+! another. The source address is in registerpair AX and is stored
+! in zeropage locations ADDR and ADDR+1.
+! The destination address is popped from the stack and stored in
+! zeropage locations ADDR+2 and ADDR+3.
+! The number of bytes to be copied is in register Y (lowbyte) and
+! zeropage location NBYTES+1 (highbyte).
+! The subroutine Blmnp is used when the source and destination
+! addresses are already in zeropage.
+
+
+Blm:
+ stx ADDR+2 ! source address (lowbyte)
+ sta ADDR+3 ! source address (highbyte)
+ jsr Pop
+ stx ADDR ! destination address (lowbyte)
+ sta ADDR+1 ! destination address (highbyte)
+Blmnp: ldx NBYTES+1
+ 1: dey
+ lda (ADDR),y ! get source byte
+ sta (ADDR+2),y ! copy to destination
+ tya
+ bne 1b
+ dec ADDR+1 ! 256 bytes copied
+ dec ADDR+3 ! decrement source and destination address
+ ldy #0
+ dex
+ bne 1b ! do it n times
+ rts
+
+
--- /dev/null
+.define Cii
+
+! This subroutine converts integers to integers.
+! Convertions of integers with the same source size as destination
+! size aren't done, there just return the source.
+! A convertion from 4 bytes to 2 bytes just strips the two
+! most significant bytes.
+! A convertion from 2 bytes to 4 bytes tests the sign of the
+! source so that sign extentension takes place if neccesairy.
+
+
+Cii:
+ cpx #2
+ beq Cii_2 ! a conversion from ? to 2
+ jsr Pop ! a conversion from 4 to ?
+ cpx #4
+ beq 8f ! a conversion 4 to 4 (skip)
+ jsr Pop
+ tay ! save A for sign test
+ pha ! save A
+ txa
+ pha ! save X
+ tya ! test on negative
+ bmi 1f ! negative means sign extension
+ lda #0 ! no sign extension here
+ tax
+ beq 2f
+ 1: lda #0FFh ! sign extension here
+ tax
+ 2: jsr Push ! push twobyte integer
+ pla
+ tax ! get X
+ pla ! get A
+ jmp Push
+Cii_2: ! a conversion from 2 to ?
+ jsr Pop
+ cpx #2
+ beq 8f ! a conversion from 2 to 2 (skip)
+ jsr Pop ! a conversion from 4 to 2
+ pha ! save A
+ txa
+ pha ! save X
+ jsr Pop ! strip most significant bytes
+ pla ! get X
+ tax
+ pla ! get A
+ jmp Push ! push result
+ 8: rts
+
+
--- /dev/null
+.define Cmi
+
+! This subroutine compares on two integers.
+! If T is pushed first and than S, the routine will return:
+! -1 if S < T,
+! 0 if S = T,
+! 1 if S > T.
+
+
+Cmi:
+ jsr Sbi2 ! subtract operands (T - S)
+ bpl 1f ! S >= T
+ lda #0FFh ! S < T
+ tax ! AX becomes -1
+ rts
+ 1: beq 2f
+ 3: lda #0 ! S > T
+ ldx #1 ! AX becomes 1
+ rts
+ 2: txa
+ bne 3b
+ lda #0 ! S = T
+ tax ! AX becomes 0
+ rts
+
+
--- /dev/null
+.define Cmi4
+
+! This subroutine compares on fourbyte integers.
+! If T is pushed first and than S, the routine will return:
+! -1 if S < T,
+! 0 if S = T,
+! 1 if S > T.
+
+
+Cmi4:
+ jsr Sbi4 ! subtract operands (T - S)
+ jsr Pop ! get result (lowbyte, lowbyte+1)
+ stx ARTH ! store lowbyte
+ sta ARTH+1 ! store lowbyte+1
+ jsr Pop ! get result (lowbyte+2, lowbyte+3)
+ tay ! test lowbyte+3
+ bpl 1f ! S >= T
+ lda #0FFh ! S < T
+ tax ! AX becomes -1
+ rts
+ 1: cmp #0 ! test lowbyte+3 on zero
+ bne 2f
+ cpx #0 ! test lowbyte+2 on zero
+ bne 2f
+ lda #0
+ cmp ARTH+1 ! test lowbyte+1 on zero
+ bne 2f
+ cmp ARTH ! test lowbyte on zero
+ bne 2f
+ lda #0 ! S = T
+ tax ! AX becomes 0
+ rts
+ 2: lda #0 ! S > T
+ ldx #1 ! AX becomes 1
+ rts
+
+
--- /dev/null
+.define Cms
+
+! This subroutine compares two groups of bytes, bit for bit.
+! The groups can consist of 2 or 4 bytes. This number is in
+! register Y.
+! The address of the first group is stored in zeropage locations
+! ADDR and ADDR+1, the address of the second group in ADDR+2 and ADDR+3
+! The routine returns a 0 on equality, a 1 otherwise.
+
+
+
+Cms:
+ lda SP+2
+ ldx SP+1
+ sta ADDR ! address of first group (lowbyte)
+ stx ADDR+1 ! address of second group (highbyte)
+ clc
+ tya
+ adc SP+2
+ sta SP+2
+ sta ADDR+2 ! address of second group (lowbyte)
+ txa
+ adc #0
+ sta ADDR+3 ! address of second group (highbyte)
+ tax
+ clc
+ tya
+ adc SP+2
+ sta SP+2 ! new stackpointer (lowbyte)
+ txa
+ adc #0
+ sta SP+1 ! new stackpointer (highbyte)
+ 1: dey
+ lda (ADDR),y ! get byte first group
+ cmp (ADDR+2),y ! compare bit for bit with byte second group
+ bne 2f
+ tya
+ bne 1b
+ lda #0 ! both groups are equal
+ tax
+ rts
+ 2: lda #0 ! there is a difference between the groups
+ ldx #1
+ rts
+
+
--- /dev/null
+.define Cmu2
+
+! This subroutine compares two unsigned twobyte integers.
+! If T is the first pushed and than S, the routine will return:
+! -1 if S < T,
+! 0 if S = T,
+! 1 if S > T.
+
+Cmu2:
+ stx EXG ! S (lowbyte)
+ sta EXG+1 ! S (highbyte)
+ jsr Pop ! get T
+ cmp EXG+1
+ beq 2f ! S (highbyte) = T (highbyte)
+ bcc 1f
+ 4: lda #0 ! S > T
+ ldx #1
+ rts
+ 1: lda #0FFh ! S < T
+ tax
+ rts
+ 2: cpx EXG
+ bne 3f
+ lda #0 ! S = T
+ tax
+ rts
+ 3: bcc 1b
+ bcs 4b
+
+
--- /dev/null
+.define Cmu4
+
+! This subroutine compares two unsigned fourbyte integers.
+! If T is first pushed and than S the routine will return:
+! -1 if S < T,
+! 0 if S = T,
+! 1 if S > T.
+
+
+Cmu4:
+ lda #ARTH
+ sta ADDR
+ lda #0
+ sta ADDR+1
+ jsr Sdo ! store S in zeropage ARTH - ARTH+3
+ lda #ARTH+4
+ sta ADDR
+ jsr Sdo ! store T in zeropage ARTH+4 - ARTH+7
+ lda ARTH+7
+ cmp ARTH+3
+ bcc 3f ! S (lowbyte+3) < T (lowbyte+3)
+ bne 2f ! S (lowbyte+3) < T (lowbyte+3)
+ lda ARTH+6
+ cmp ARTH+2
+ bcc 3f ! S (lowbyte+2) < T (lowbyte+2)
+ bne 2f ! S (lowbyte+2) < T (lowbyte+2)
+ lda ARTH+5
+ cmp ARTH+1
+ bcc 3f ! S (lowbyte+1) < T (lowbyte+1)
+ bne 2f ! S (lowbyte+1) < T (lowbyte+1)
+ lda ARTH+4
+ cmp ARTH
+ bcc 3f ! S (lowbyte+0) < T (lowbyte+0)
+ bne 2f ! S (lowbyte+0) < T (lowbyte+0)
+ lda #0
+ tax ! S = T
+ rts
+ 2: lda #0 ! S > T
+ ldx #1
+ rts
+ 3: lda #0FFh ! S < T
+ tax
+ rts
+
+
--- /dev/null
+.define Com
+
+! This subroutine performs a one complement on
+! a group of atmost 254 bytes (number in register Y).
+! This group is on the top of the stack.
+
+
+Com:
+ lda SP+1
+ sta ADDR+1 ! address (highbyte) of first byte
+ lda SP+2
+ sta ADDR ! address (lowbyte) of first byte
+ 1: dey
+ lda (ADDR),y
+ eor #0FFh ! one complement
+ sta (ADDR),y
+ tya
+ bne 1b ! do it n times
+ rts
+
+
--- /dev/null
+.define Csa
+
+! This subroutine performs the case jump by indexing.
+! The zeropage locations ADDR, ADDR+1 contain the address of
+! the case descriptor which also is the address of the
+! default pointer.
+! The zeropage locations ADDR+2, ADDR+3 contain the address of the
+! indextable which is the casedescriptor + 6.
+
+Csa:
+ stx ADDR ! address of descriptor (lowbyte)
+ sta ADDR+1 ! address of descriptor (highbyte)
+ tay
+ txa
+ clc
+ adc #6
+ sta ADDR+2 ! address of index table (lowbyte)
+ tya
+ adc #0
+ sta ADDR+3 ! address of index table (highbyte)
+ jsr Pop ! fetch index
+ pha ! subtract lowerbound
+ txa
+ ldy #2
+ sec
+ sbc (ADDR),y
+ sta ARTH ! lowerbound (lowbyte)
+ pla
+ iny
+ sbc (ADDR),y
+ sta ARTH+1 ! lowerbound (highbyte)
+ bmi 1f ! index < lowerbound
+ ldy #5
+ lda (ADDR),y
+ cmp ARTH+1
+ bcc 1f ! index (highbyte) > upperbound - lowerbound
+ bne 2f ! index (highbyte) <= upperbound - lowerbound
+ dey
+ lda (ADDR),y
+ cmp ARTH
+ bcc 1f ! index (lowbyte) > upperbound - lowerbound
+ 2: asl ARTH
+ rol ARTH+1 ! index * 2
+ clc
+ lda ADDR+2
+ adc ARTH
+ sta ADDR+2 ! address of pointer (lowbyte)
+ lda ADDR+3
+ adc ARTH+1
+ sta ADDR+3 ! address of pointer (highbyte)
+ ldy #0
+ lda (ADDR+2),y ! jump address (lowbyte)
+ tax
+ iny
+ lda (ADDR+2),y ! jump address (highbyte)
+ bne 3f
+ cpx #0
+ beq 1f
+ 3: stx ADDR ! pointer <> 0
+ sta ADDR+1
+ jmp (ADDR) ! jump to address
+ 1: ldy #0 ! pointer = 0
+ lda (ADDR),y ! get default pointer (lowbyte)
+ tax
+ iny
+ lda (ADDR),y ! get default pointer (highbyte)
+ bne 3b
+ cpx #0
+ bne 3b ! default pointer <> 0
+
+
--- /dev/null
+.define Csb
+
+! This subroutine performs the case jump by searching the table.
+! The zeropage locations ADDR, ADDR+1 contain the address of the
+! case descriptor, which also is the address of the default pointer.
+! The zeropage locations ADDR+2, ADDR+3 are used to address the jump
+! pointers.
+
+
+Csb:
+ stx ADDR ! address of descriptor (lowbyte)
+ sta ADDR+1 ! address of descriptor (highbyte)
+ stx ADDR+2
+ sta ADDR+3
+ ldy #2
+ lda (ADDR),y ! number of entries (lowbyte)
+ pha
+ jsr Pop
+ stx ARTH ! index (lowbyte)
+ sta ARTH+1 ! index (highbyte)
+ pla
+ tax
+ inx
+ 2: clc
+ lda #4
+ adc ADDR+2
+ sta ADDR+2 ! pointer (lowbyte)
+ bcc 1f
+ lda #0
+ adc ADDR+3
+ sta ADDR+3 ! pointer (highbyte)
+ 1: ldy #0
+ lda (ADDR+2),y
+ cmp ARTH
+ bne 3f ! pointer (lowbyte) <> index (lowbyte)
+ iny
+ lda (ADDR+2),y
+ cmp ARTH+1
+ bne 3f ! pointer (highbyte) <> index (highbyte)
+ iny
+ lda (ADDR+2),y ! jump address (lowbyte)
+ tax
+ iny
+ lda (ADDR+2),y ! jump address (highbyte)
+ jmp 4f
+ 3: dex
+ bne 2b
+ 5: ldy #0
+ lda (ADDR),y ! default pointer (lowbyte)
+ tax
+ iny
+ lda (ADDR),y ! default pointer (highbyte)
+ beq 1f
+ 4: bne 1f ! pointer (lowbyte) <> 0
+ cpx #0
+ bne 1f ! pointer (highbyte) <> 0
+ beq 5b ! get default pointer
+ 1: stx ADDR
+ sta ADDR+1
+ jmp (ADDR) ! jump
+
+
--- /dev/null
+.define EARRAY,ERANGE,ESET,EIOVFL
+.define ECONV,ESTACK
+.define EHEAP,EODDZ,ECASE
+.define EBADMON,EBADLIN,EBADGTO
+
+! This file contains the global data used by the trap routine.
+
+
+! DATA
+.data
+EARRAY:
+.asciz "Array bound error\n\r"
+ERANGE:
+.asciz "Range bound error\n\r"
+ESET:
+.asciz "Set bound error\n\r"
+EIOVFL:
+.asciz "Integer overflow\n\r"
+ECONV:
+.asciz "Conversion error\n\r"
+ESTACK:
+.asciz "Stack overflow\n\r"
+EHEAP:
+.asciz "Heap overflow\n\r"
+EODDZ:
+.asciz "Illegal size argument\n\r"
+ECASE:
+.asciz "Case error\n\r"
+EBADMON:
+.asciz "Bad monitor call\n\r"
+EBADLIN:
+.asciz "Argument of LIN to high\n\r"
+EBADGTO:
+.asciz "GTO descriptor error\n\r"
+
+
--- /dev/null
+.define Div4
+
+! This subroutine performs a signed divide on two fourbyte integers.
+! For more detail see dvi.s
+! The only difference is that zeropage locations are twice as big.
+
+Div4:
+ ldy #0
+ sty SIGN
+ jsr Pop
+ stx ARTH
+ sta ARTH+1
+ jsr Pop
+ stx ARTH+2
+ sta ARTH+3 ! divisor in ARTH - ARTH+3
+ tay
+ bpl 1f
+ lda #0
+ ldx #ARTH
+ jsr Ngi4
+ ldy #1
+ sty SIGN ! it's signed
+ 1: jsr Pop
+ stx ARTH+4
+ sta ARTH+5
+ jsr Pop
+ stx ARTH+6
+ sta ARTH+7 ! dividend in ARTH+4 - ARTH+7
+ tay
+ bpl 1f
+ lda #0
+ ldx #ARTH+4
+ jsr Ngi4
+ lda SIGN
+ eor #1
+ sta SIGN
+ lda #1
+ sta NBYTES
+ 1: jmp Duv4
+
+
--- /dev/null
+.define Adf4
+.define Adf8
+.define Sbf4
+.define Sbf8
+.define Mlf4
+.define Mlf8
+.define Dvf4
+.define Dvf8
+.define Ngf4
+.define Ngf8
+.define Zrf4
+.define Zrf8
+.define Cmf4
+.define Cmf8
+.define Fef4
+.define Fef8
+.define Fif4
+.define Fif8
+.define Cfi
+.define Cif
+.define Cuf
+.define Cff
+.define Cfu
+.define Lfr8
+.define Ret8
+
+! Dummy floating point package for 6500
+! every EM floating point instruction results in an
+! "Illegal EM instruction" trap.
+
+
+Adf4:
+Adf8:
+Sbf4:
+Sbf8:
+Mlf4:
+Mlf8:
+Dvf4:
+Dvf8:
+Ngf4:
+Ngf8:
+Zrf4:
+Zrf8:
+Cmf4:
+Cmf8:
+Fef4:
+Fef8:
+Fif4:
+Fif8:
+Cfi:
+Cif:
+Cuf:
+Cff:
+Cfu:
+Lfr8:
+Ret8:
+ ldx #Eillins
+ lda #0
+ jsr Trap
--- /dev/null
+.define Dup
+
+! This subroutine duplicate's the top n (in register Y) bytes.
+! N is atmost 256.
+! The duplicating takes place as follows.
+! The registerpair is filled with the bytes at stackpointer + N
+! and stackpopinter + N-1.
+! These two bytes then are pushed onto the stack.
+! Next the offset N is decremented and the next two byte are taken
+! care off. Until N = 0.
+
+
+Dup:
+ lda SP+1
+ ldx SP+2
+ stx ADDR ! address of group (lowbyte)
+ sta ADDR+1 ! address of group (highbyte)
+ 1: dey
+ lda (ADDR),y ! get lowbyte
+ pha
+ dey
+ lda (ADDR),y ! get highbyte
+ tax
+ pla
+ jsr Push ! push them
+ tya
+ bne 1b
+ rts
+
+
--- /dev/null
+.define Duv4
+
+! This subroutine performs an unsigned division on two fourbyte
+! unsigned integers.
+! For more details see dvi.s
+! The only difference is that zeropage locations are twice as big.
+
+
+Duv4:
+ 1: ldy #0
+ sty ARTH+8
+ sty ARTH+9
+ sty ARTH+10
+ sty ARTH+11
+ ldy #33
+ 4: lda ARTH+11
+ cmp ARTH+3
+ bcc 1f ! no sub
+ bne 2f ! sub
+ lda ARTH+10
+ cmp ARTH+2
+ bcc 1f
+ bne 2f
+ lda ARTH+9
+ cmp ARTH+1
+ bcc 1f
+ bne 2f
+ lda ARTH+8
+ cmp ARTH
+ bcc 1f
+ 2: sec
+ lda ARTH+8
+ sbc ARTH
+ sta ARTH+8
+ lda ARTH+9
+ sbc ARTH+1
+ sta ARTH+9
+ lda ARTH+10
+ sbc ARTH+2
+ sta ARTH+10
+ lda ARTH+11
+ sbc ARTH+3
+ sta ARTH+11
+ sec
+ rol ARTH+4
+ bne 3f
+ 1: asl ARTH+4
+ 3: rol ARTH+5
+ rol ARTH+6
+ rol ARTH+7
+ rol ARTH+8
+ rol ARTH+9
+ rol ARTH+10
+ rol ARTH+11
+ dey
+ bne 4b
+ ldy UNSIGN
+ beq 1f
+ ldy SIGN
+ beq 1f
+ lda #0
+ ldx #ARTH+4
+ jsr Ngi4
+ 1: rts
+
+
--- /dev/null
+.define Dvi2, Div, Duv
+
+! The subroutine Dvi2 performs a signed division.
+! Its operands are on the stack.
+! The subroutine Div performs also a signed division, ecxept that
+! its operand are already in zeropage.
+! The subroutine Duv performs a n unsigned division.
+! For an explanation of the algoritm used see
+! A. S. Tanenbaum's Structered Computer Organisation. 1976
+
+
+Dvi2:
+ stx ARTH
+ sta ARTH+1 ! store divisor
+ jsr Pop
+ stx ARTH+2
+ sta ARTH+3 ! store dividend
+ ldy #1
+ sty UNSIGN ! used for result sign
+Div:
+ ldy #0
+ sty SIGN
+ lda ARTH+1
+ bpl 1f ! if divisor is negative
+ ldx ARTH ! make it positive
+ jsr Ngi2
+ ldy #1
+ sty SIGN
+ stx ARTH
+ sta ARTH+1
+ 1: lda ARTH+3
+ bpl 1f ! if dividend is negative
+ ldx ARTH+2 ! make it positive
+ jsr Ngi2
+ pha
+ lda SIGN
+ eor #1 ! excusive or with sign of divisor
+ sta SIGN
+ lda #1
+ sta NBYTES
+ pla
+ stx ARTH+2
+ sta ARTH+3
+Duv:
+ 1: ldy #0
+ sty ARTH+4
+ sty ARTH+5
+ ldy #17
+ 4: lda ARTH+5
+ cmp ARTH+1
+ bcc 1f ! no subtraction
+ bne 2f ! divisor goes into dividend
+ lda ARTH+4
+ cmp ARTH
+ bcc 1f ! no subtraction
+ 2: sec ! divisor goes into dividend
+ lda ARTH+4
+ sbc ARTH
+ sta ARTH+4
+ lda ARTH+5
+ sbc ARTH+1
+ sta ARTH+5 ! subtract divisor from dividend
+ sec
+ rol ARTH+2 ! a subtraction so shift in a 1
+ bne 3f
+ 1: asl ARTH+2 ! no subtraction so shift in a 0
+ 3: rol ARTH+3
+ rol ARTH+4
+ rol ARTH+5 ! shift dividend
+ dey
+ bne 4b
+ ldx ARTH+2
+ lda ARTH+3
+ ldy UNSIGN ! is it an unsigned division
+ beq 1f
+ ldy SIGN ! is the result negative
+ beq 1f
+ jsr Ngi2
+ 1: rts
+
+
+
--- /dev/null
+.define Dvi4
+
+! This subroutine performs a fourbyte signed division.
+! For more details see dvi.s
+! The only difference is that zeropage locations are twice as big.
+
+
+Dvi4:
+ ldy #1
+ sty UNSIGN
+ jsr Div4
+ lda ARTH+7
+ ldx ARTH+6
+ jsr Push
+ lda ARTH+5
+ ldx ARTH+4
+ jmp Push
+
+
--- /dev/null
+.define Dvu2
+
+! This subroutine performs a twobyte unsigned division
+! For more details see dvi.s.
+
+
+Dvu2:
+ stx ARTH
+ sta ARTH+1
+ jsr Pop
+ stx ARTH+2
+ sta ARTH+3
+ ldy #0
+ sty UNSIGN
+ jmp Dvu
+
+
--- /dev/null
+.define Dvu4
+
+! This subroutine performs an unsigned division on fourbyte
+! integers. For more details see dvi.s
+! The only difference is that zeropage locations are twice as big.
+
+
+Dvu4:
+ ldy #0
+ sty UNSIGN ! it is unsigned
+ jsr Pop
+ stx ARTH
+ sta ARTH+1
+ jsr Pop
+ stx ARTH+2
+ sta ARTH+3 ! divisor in ARTH - ARTH+3
+ jsr Pop
+ stx ARTH+4
+ sta ARTH+5
+ jsr Pop
+ stx ARTH+6
+ sta ARTH+7 ! dividend in ARTH+4 - ARTH+7
+ jsr Duv4
+ lda ARTH+7
+ ldx ARTH+6
+ jsr Push
+ lda ARTH+5
+ ldx ARTH+4
+ jmp Push ! store result
+
+
--- /dev/null
+.define Exg
+
+! This subroutine exchanges two groups of bytes on the top of the
+! stack. The groups may consist of atmost 255 bytes.
+! This number is in register Y.
+! The exchange is from ADDR, ADDR+1 to ADDR+2, ADDR+3
+
+
+Exg:
+ lda SP+1
+ ldx SP+2
+ stx ADDR ! address of first group (lowbyte)
+ sta ADDR+1 ! address of first group (highbyte)
+ sty Ytmp ! save number of bytes to be exchanged
+ clc
+ lda SP+2
+ adc Ytmp
+ sta ADDR+2 ! address of second group (lowbyte)
+ lda SP+1
+ adc #0
+ sta ADDR+3 ! address of second group (highbyte)
+ 1: dey
+ lda (ADDR),y ! get byte from first group
+ pha ! temporary save
+ lda (ADDR+2),y ! get byte from second group
+ sta (ADDR),y ! store in first group
+ pla ! get temporary saved byte
+ sta (ADDR+2),y ! store in second group
+ tya
+ bne 1b ! perform n times
+ rts
+
+
--- /dev/null
+.define Exg2
+
+! This subroutine exchanges two words on top of the stack.
+! The top word of the stack is really in the AX registerpair.
+! So this word is exchanged with the top of the real stack.
+
+
+Exg2:
+ pha ! save A
+ txa
+ pha ! save X
+ jsr Pop ! get top real stack
+ stx EXG
+ sta EXG+1 ! save top of real stack
+ pla ! get X
+ tax
+ pla ! get A
+ jsr Push ! push on real stack
+ ldx EXG ! get new X
+ lda EXG+1 ! get new A
+ rts
+
+
--- /dev/null
+.define Gto
+
+! This subroutine performs the non_local goto.
+! The address of the descriptor is stored in zeropage locations
+! ADDR, ADDR+1.
+! Since there are two stacks (hardware_stack and the real_stack),
+! the stackpointer of the hard_stack is resetted by searching the
+! new localbase in the real_stack while adjusting the hardware_stack.
+
+
+Gto:
+ stx ADDR ! address of descripto (lowbyte)
+ sta ADDR+1 ! address of descriptor (highbyte)
+ pla ! remove
+ pla ! __gto return address.
+ ldy #4
+ lda (ADDR),y ! new localbase (lowbyte)
+ sta ARTH
+ tax
+ iny
+ lda (ADDR),y ! new localbase (highbyte)
+ sta ARTH+1
+ cmp LB+1
+ bne 1f
+ cpx LB
+ beq 2f ! goto within same procedure
+ 1: ldy #0
+ lda (LB),y ! get localbase (lowbyte)
+ tax
+ iny
+ lda (LB),y ! get localbase (highbyte)
+ cmp ARTH+1
+ bne 3f
+ cpx ARTH
+ beq 2f ! found localbase
+ 3: stx LB ! temporary save of localbase
+ sta LB+1
+ pla ! adjust
+ pla ! hardware_stack
+ jmp 1b
+ 2: sta LB+1 ! store localbase (highbyte)
+ pha
+ stx LB ! store localbase (lowbyte)
+ sec
+ txa
+ sbc #BASE
+ sta LBl ! localbase - 240 (lowbyte)
+ pla
+ sbc #0
+ sta LBl+1 ! localbase - 240 (highbyte)
+ ldy #3
+ lda (ADDR),y ! new stackpointer (highbyte)
+ sta SP+1
+ dey
+ lda (ADDR),y ! new stackpointer (lowbyte)
+ sta SP+2
+ dey
+ lda (ADDR),y ! jump address (highbyte)
+ sta ADDR+3
+ dey
+ lda (ADDR),y ! jump address (lowbyte)
+ sta ADDR+2
+ jmp (ADDR+2) ! jump to address
+
+
--- /dev/null
+.define Indir
+
+! This subroutine performs an indirect procedurecall.
+! This must be done this way since the jump instruction
+! is the only one which can indirect change the programcounter.
+! The address of the function must be in zeropage loactions
+! ADDR, ADDR+1.
+
+
+Indir:
+ jmp (ADDR)
+
+
--- /dev/null
+.define Inn
+
+! This subroutine checks if a certain bit is set in a set
+! of n bytes on top of the stack.
+
+
+Inn:
+ stx ARTH ! save bit number (lowbyte)
+ sta ARTH+1 ! save bit number (highbyte)
+ and #80h
+ beq 1f
+ lda #0 ! bit number is negative
+ sta ARTH+2 ! make it zero
+ beq 3f
+ 1: txa
+ and #07h ! get bit number mod 8
+ tax
+ lda #1
+ cpx #0 ! bit number = 0
+ beq 2f ! no shifting to right place
+ 1: asl a ! shift left until bit is in place
+ dex
+ bne 1b
+ 2: sta ARTH+2 ! bit is one in place
+ ldx #3
+ 1: lsr ARTH+1 ! shift left 3 times bit number (highbyte)
+ ror ARTH ! shift left 3 times bit number (lowbyte)
+ dex ! this is bit number div 8
+ bne 1b ! which is byte number
+ 3: lda SP+1
+ ldx SP+2
+ stx ADDR ! address of the set (lowbyte)
+ sta ADDR+1 ! address of the set (highbyte)
+ iny
+ tya
+ bne 2f
+ inc SP+1
+ 2: clc ! remove the set
+ adc SP+2
+ sta SP+2 ! new stackpointer (lowbyte)
+ lda #0
+ adc SP+1
+ sta SP+1 ! new stackpointer (highbyte)
+ ldy ARTH
+ lda (ADDR),y ! load the byte in A
+ bit ARTH+2 ! test bit
+ bne 1f
+ 3: lda #0 ! bit is zero
+ tax
+ rts
+ 1: lda #0 ! bit is one
+ ldx #1
+ rts
+
+
--- /dev/null
+.define Ior
+
+! This subroutine performs the logical inclusive or on two
+! groups of bytes. The groups may consist of atmost 254 bytes.
+! The two groups are on the stack.
+
+Ior:
+ lda SP+1
+ sta ADDR+1 ! address of the first group (highbyte)
+ lda SP+2
+ sta ADDR ! address of the first group (lowbyte)
+ clc
+ tya
+ adc SP+2
+ sta SP+2 ! new stackpointer (lowbyte)
+ sta ADDR+2 ! address of second group (lowbyte)
+ lda #0
+ adc SP+1
+ sta SP+1 ! new stackpointer (highbyte)
+ sta ADDR+3 ! address of second group (highbyte)
+ 1: dey
+ lda (ADDR),y ! get byte first group
+ ora (ADDR+2),y ! inclusive or with byte second group
+ sta (ADDR+2),y ! restore result on stack
+ tya
+ bne 1b ! perform n times
+ rts
+
+
--- /dev/null
+.define Lar
+
+! This subroutine performs the LAR instruction.
+! For details see rapport IR-81.
+
+
+Lar:
+ jsr Aar ! get object address
+ ldy NBYTES+1 ! the size of the object (highbyte)
+ bne 2f
+ ldy NBYTES ! the size of the object (lowbyte)
+ cpy #1
+ bne 1f ! object size is one byte
+ jsr Loi1 ! get object
+ jmp Push ! push on the stack
+ 1: cpy #2
+ bne 1f ! object size is a word
+ jsr Loi ! get word
+ jmp Push ! push on the stack
+ 1: cpy #4
+ bne 2f ! object size is four bytes
+ jmp Ldi ! get object
+ 2: jmp Loil ! get object
+
+
--- /dev/null
+.define Lcs
+
+! This subroutine creates space for locals on procedure entry
+! by lowering the stackpointer.
+
+
+Lcs:
+ sta ARTH ! number of locals (lowbyte)
+ stx ARTH+1 ! number of locals (highbyte)
+ sec
+ lda SP+2
+ sbc ARTH
+ sta SP+2 ! new stackpointer (lowbyte)
+ lda SP+1
+ sbc ARTH+1
+ sta SP+1 ! new stackpointer (highbyte)
+ rts
+
+
--- /dev/null
+.define Ldi, Ldo
+
+! The subroutine Ldi pushes a four byte object onto the stack.
+! The address is in registerpair AX.
+! If the address is already in zeropage Ldo is used.
+
+
+Ldi:
+ stx ADDR ! address of object (lowbyte)
+ sta ADDR+1 ! address of object (highbyte)
+Ldo:
+ ldy #3
+ 1: lda (ADDR),y ! get lowbyte
+ pha
+ dey
+ lda (ADDR),y ! get highbyte
+ tax
+ pla
+ jsr Push ! do the push
+ dey
+ bpl 1b ! perform 2 times
+ rts
+
+
--- /dev/null
+.define Locaddr
+
+! This routine gets the address of a local which offset is to big.
+! The offset is in registerpair AX.
+
+
+Locaddr:
+ pha ! save A
+ txa
+ clc
+ adc LB ! localbase + offset (lowbyte)
+ sta ADDR ! address (lowbyte)
+ pla
+ adc LB+1 ! localbase + offset (highbyte)
+ sta ADDR+1 ! address (highbyte)
+ rts
+
+
--- /dev/null
+.define Loi, Lext
+! This subroutine performs an indirect load on a word of two bytes.
+! Lext is used when the address is already in zeropage.
+
+
+Loi:
+ stx ADDR ! address of object (lowbyte)
+ sta ADDR+1 ! address of object (highbyte)
+Lext:
+ ldy #0
+ lda (ADDR),y ! get lowbyte
+ tax
+ iny
+ lda (ADDR),y ! get highbyte
+ rts
+
+
--- /dev/null
+.define Loi1
+
+! This routine loads a one byte object in registerpair AX.
+
+
+Loi1:
+ stx ADDR ! address of byte (lowbyte)
+ sta ADDR+1 ! address of byte (highbyte)
+ ldy #0
+ lda (ADDR),y ! load byte
+ tax ! store byte in X
+ tya ! clear highbyte of AX
+ rts
+
+
--- /dev/null
+.define Loil
+
+! This subroutine pushes an object of size greater than four bytes
+! onto the stack.
+
+
+Loil:
+ sta ADDR+1 ! source address (lowbyte)
+ stx ADDR ! source address (highbyte)
+ sty NBYTES
+ sec
+ lda SP+2
+ sbc NBYTES
+ sta ADDR+2 ! destination address (lowbyte)
+ sta SP+2 ! new stackpointer
+ lda SP+1
+ sbc NBYTES+1
+ sta ADDR+3 ! destination address (highbyte)
+ sta SP+1 ! new stackpointer
+ inc NBYTES+1
+ jmp Blmnp ! do the move
+
+
--- /dev/null
+.define Lol
+
+! This subroutine loads a local in registerpair AX which
+! offset from the localbase is to big.
+
+
+Lol:
+ jsr Locaddr ! get the address of local
+ ldy #0
+ lda (ADDR),y ! get lowbyte
+ tax
+ iny
+ lda (ADDR),y ! get highbyte
+ rts
+
+
--- /dev/null
+.define Los
+
+! This subroutine perfoms the LOS instruction.
+! For detail see rapport IR-81.
+
+
+Los:
+ cmp #0
+ bne 3f
+ cpx #1
+ bne 1f ! the size is one
+ jsr Pop ! get address
+ jsr Loi1 ! push it on the stack
+ jmp Push
+ 1: cpx #2
+ bne 2f ! the size is two
+ jsr Pop ! get address
+ jsr Loi ! push it on the stack
+ jmp Push
+ 2: cpx #4
+ bne 3f ! the size is four
+ jsr Pop ! get address
+ jmp Ldi ! push it on the stack
+ 3: sta ARTH+1 ! the size is greater than four
+ txa
+ tay
+ jsr Pop ! get address
+ jmp Loil ! push it on the stack
+
+
--- /dev/null
+.define Lxa1
+
+! This subroutine loads the address of AB zero static levels back.
+
+Lxa1:
+ ldy LB+1 ! load address of localbase (highbyte)
+ ldx LB ! load address of localbase (lowbyte)
+ inx
+ inx ! argumentbase = localbase + 2
+ bne 1f
+ iny
+ 1: tya
+ rts
+
+
--- /dev/null
+.define Lxa2
+
+! This subroutine load the address of AB n (255 >= n > 0) static levels
+! back.
+
+
+Lxa2:
+ lda LB
+ sta ADDR ! address of localbase (lowbyte)
+ lda LB+1
+ sta ADDR+1 ! address of localbase (highbyte)
+ 1: ldy #2
+ lda (ADDR),y ! static level LB (lowbyte)
+ pha
+ iny
+ lda (ADDR),y ! static level LB (highbyte)
+ sta ADDR+1 ! static level LB (highbyte)
+ pla
+ sta ADDR ! static level LB (lowbyte)
+ dex
+ bne 1b
+ tax
+ ldy ADDR+1
+ inx
+ inx ! argumentbase = localbase + 2
+ bne 1f
+ iny
+ 1: tya
+ rts
+
+
+
--- /dev/null
+.define Lxl
+
+! This subroutine loads LB n (255 => n > 0) static levels back.
+
+
+Lxl:
+ lda LB
+ sta ADDR ! address of localbase (lowbyte)
+ lda LB+1
+ sta ADDR+1 ! address of localbase (highbyte)
+ 1: ldy #2
+ lda (ADDR),y ! get localbase (lowbyte) 1 level back
+ pha
+ iny
+ lda (ADDR),y ! get localbase (highbyte) 1 level back
+ sta ADDR+1 ! new localbase (highbyte)
+ pla
+ sta ADDR ! new localbase (lowbyte)
+ dex
+ bne 1b ! n levels
+ tax
+ lda ADDR+1
+ rts
+
+
--- /dev/null
+.define Mli2, Mlinp, Mul
+
+! The subroutine Mli2 multiplies two signed integers. The integers
+! are popped from the stack.
+! The subroutine Mlinp expects the two integer to be in zeropage.
+! While the subroutine Mul an unsigned multiply subroutine is.
+! For the algoritme see A. S. Tanenbaum
+! Structured Computer Organisation. 1976.
+
+
+Mli2:
+ stx ARTH
+ sta ARTH+1
+ jsr Pop
+ stx ARTH+2
+ sta ARTH+3
+Mlinp: ldy #1
+ sty UNSIGN ! it's signed
+ lda ARTH+1
+ bpl 3f ! multiplier negative so:
+ ldx ARTH
+ jsr Ngi2 ! negate multiplier
+ stx ARTH
+ sta ARTH+1
+ ldx ARTH+2
+ lda ARTH+3
+ jsr Ngi2 ! negate multiplicand
+ stx ARTH+2
+ sta ARTH+3
+Mul:
+ 3: lda #0
+ sta ARTH+4
+ sta ARTH+5
+ sta ARTH+6
+ sta ARTH+7 ! clear accumulator
+ ldy #16
+ 1: lda #1h
+ bit ARTH
+ beq 2f ! multiplying by zero: no addition
+ clc
+ lda ARTH+6
+ adc ARTH+2
+ sta ARTH+6
+ lda ARTH+7
+ adc ARTH+3
+ sta ARTH+7
+ 2: lsr ARTH+1
+ ror ARTH ! shift multiplier
+ lsr ARTH+7
+ ror ARTH+6
+ ror ARTH+5
+ ror ARTH+4 ! shift accumulator
+ lda UNSIGN
+ beq 3f ! unsigned multiply: so no shift in of signbit
+ lda ARTH+3
+ bpl 3f
+ lda #40h
+ bit ARTH+7
+ beq 3f
+ lda ARTH+7
+ ora #80h
+ sta ARTH+7
+ 3: dey
+ bne 1b
+ ldx ARTH+4
+ lda ARTH+5
+ rts
+
+
--- /dev/null
+.define Mli4
+
+! This subroutine multiplies two signed fourbyte integers
+! For more detail see mli.s
+! The only difference is that zeropage locations are twice as big.
+
+
+Mli4:
+ ldy #1
+ sty UNSIGN
+ jsr Pop
+ stx ARTH
+ sta ARTH+1
+ jsr Pop
+ stx ARTH+2
+ sta ARTH+3 ! multiplier
+ jsr Pop
+ stx ARTH+4
+ sta ARTH+5
+ jsr Pop
+ stx ARTH+6
+ sta ARTH+7 ! multiplicand
+ lda ARTH+3
+ bpl 3f
+ lda #0
+ ldx #ARTH
+ jsr Ngi4
+ lda #0
+ ldx #ARTH+4
+ jsr Ngi4
+ 3: jmp Mul4
+
+
--- /dev/null
+.define Mlu2
+
+! This subroutine multiplies two unsigned fourbyte intergers.
+! For more details see mli.s
+
+
+Mlu2:
+ stx ARTH
+ sta ARTH+1 ! multiplier
+ jsr Pop
+ stx ARTH+2
+ sta ARTH+3 ! multiplicand
+ ldy #0
+ sty UNSIGN
+ jmp Mul
+
+
--- /dev/null
+.define Mlu4
+
+! This subroutine multiplies two fourbyte unsigned integers.
+! For more details see mli.s
+! The only difference is that zeropage locations are twice as big.
+
+
+Mlu4:
+ ldy #0
+ sty UNSIGN
+ jsr Pop
+ stx ARTH
+ sta ARTH+1
+ jsr Pop
+ stx ARTH+2
+ sta ARTH+3 ! multiplier
+ jsr Pop
+ stx ARTH+4
+ sta ARTH+5
+ jsr Pop
+ stx ARTH+6
+ sta ARTH+7 ! multiplicand
+ jmp Mul4
+
+
--- /dev/null
+.define Mon
+
+! This subroutine performs some monitor calls.
+! The exit call just resets the hardware_stackpointer so
+! this routine will return to the operating system.
+! The close call just returns a zero.
+! The ioctl call just pops its arguments and returns a zero.
+! The write routine is a real one.
+
+
+Mon:
+ cpx #1
+ bne 1f ! exit
+ ldx STACK ! load stackpointer
+ dex
+ dex ! adjust stackpointer
+ txs ! set stackpointer
+ rts
+ 1: cpx #4
+ bne 1f
+ jmp Mwrite
+ 1: cpx #6 ! facked
+ bne 1f ! close
+ lda #0
+ tax ! return zero
+ rts
+ 1: cpx #54
+ jsr Pop ! pop first argument (fildes)
+ jsr Pop ! pop second argument (request)
+ jsr Pop ! pop third argument (argp)
+ lda #0
+ tax ! return zero
+ rts
+
+
--- /dev/null
+.define Mul4
+
+! This subroutine multiplies two fourbyte signed integers.
+! For more details see mli.s
+! The only difference is that zeropage locations are twice as big.
+
+
+Mul4:
+ 3: lda #0
+ sta ARTH+8
+ sta ARTH+9
+ sta ARTH+10
+ sta ARTH+11
+ sta ARTH+12
+ sta ARTH+13
+ sta ARTH+14
+ sta ARTH+15 ! clear accumulator
+ ldy #32
+ 1: lda #1h
+ bit ARTH
+ beq 2f ! multiplying by zero: no addition
+ clc
+ lda ARTH+12
+ adc ARTH+4
+ sta ARTH+12
+ lda ARTH+13
+ adc ARTH+5
+ sta ARTH+13
+ lda ARTH+14
+ adc ARTH+6
+ sta ARTH+14
+ lda ARTH+15
+ adc ARTH+7
+ sta ARTH+15
+ 2: lsr ARTH+3
+ ror ARTH+2
+ ror ARTH+1
+ ror ARTH ! shift multiplier
+ lsr ARTH+15
+ ror ARTH+14
+ ror ARTH+13
+ ror ARTH+12
+ ror ARTH+11
+ ror ARTH+10
+ ror ARTH+9
+ ror ARTH+8 ! shift accumulator
+ lda UNSIGN
+ beq 3f ! it's unsigned: so no shift in of signbit
+ lda ARTH+7
+ bpl 3f
+ lda #40h
+ bit ARTH+15
+ beq 3f
+ lda ARTH+15
+ ora #80h
+ sta ARTH+15
+ 3: dey
+ bne 1b
+ ldx ARTH+10
+ lda ARTH+11
+ jsr Push
+ ldx ARTH+8
+ lda ARTH+9
+ jmp Push
+
+
--- /dev/null
+.define Ngi2
+
+! This subroutine negates the integer in registerpair AX.
+! The negation is a one's complement plus one.
+
+
+Ngi2:
+ eor #0FFh ! one's complement A
+ tay
+ txa
+ eor #0FFh ! one's complement X
+ tax
+ inx ! increment X
+ bne 1f
+ iny ! increment A if neccesairy
+ 1: tya
+ rts
+
+
--- /dev/null
+.define Ngi4
+
+! This subroutine takes a fourbyte interger and negates it.
+! For more details see ngi2.s
+
+
+Ngi4:
+ sta ADDR+1
+ stx ADDR
+ ldy #3
+ 1: lda (ADDR),y
+ eor #0FFh ! one's complement lowbyte+y
+ sta (ADDR),y
+ dey
+ bpl 1b
+ ldx #0FDh
+ iny
+ clc
+ lda (ADDR),y
+ adc #1
+ sta (ADDR),y ! lowbyte+y
+ 1: iny
+ lda (ADDR),y
+ adc #0
+ sta (ADDR),y ! (lowbyte+y)+0
+ inx
+ bne 1b
+ rts
+
+
--- /dev/null
+.define Mprint
+
+! This subroutine prints a zero terminated ascii string.
+! The registerpair AX contains the start of the string.
+! The subroutine WRCH is a special routine on the BBC microcomputer
+! which prints the character in A to the screen.
+! The subroutine WRCH is a special one provided by the BBC
+! microcomputer.
+
+
+Mprint:
+ stx ADDR ! start address of string (lowbyte)
+ sta ADDR+1 ! start address of string (highbyte)
+ ldy #0
+ 1: lda (ADDR),y ! get ascii character
+ beq 2f
+ jsr WRCH ! put it on the screen
+ iny
+ bne 1b
+ 2: rts
+
+
--- /dev/null
+.define Printhex
+
+! This subroutine print the contents of register A to the screen
+! in hexadecimal form.
+! The subroutine WRCH is a special one provided by the BBC
+! microcomputer.
+
+
+Printhex:
+ pha ! save A
+ lsr a
+ lsr a
+ lsr a
+ lsr a ! get four high bits
+ jsr 1f
+ pla ! restore A
+ and #0Fh ! get four low bits
+ jsr 1f
+ rts
+ 1: sed ! print in hex
+ clc
+ adc #90h
+ adc #40h
+ cld
+ jmp WRCH
+
+
--- /dev/null
+.define Printstack
+
+! This a special subroutine which prints some things to the
+! monitorscreen for debugging.
+
+
+Printstack:
+ ldy #0
+ 2: lda (hol0+4),y
+ beq 1f
+ jsr WRCH ! print filename
+ iny
+ jmp 2b
+ 1: lda #32
+ jsr WRCH ! print a space
+ lda hol0+1
+ jsr Printhex ! print line number (highbyte)
+ lda hol0
+ jsr Printhex ! print line number (lowbyte)
+ lda #32
+ jsr WRCH ! print a space
+ lda SP+1
+ jsr Printhex ! print stackpointer (highbyte)
+ lda SP+2
+ jsr Printhex ! print stackpointer (lowbyte)
+ lda #32
+ jsr WRCH ! print a space
+ lda LB+1
+ jsr Printhex ! print real localbase (highbyte)
+ lda LB
+ jsr Printhex ! print real localbase (lowbyte)
+ lda #32
+ jsr WRCH ! print a space
+ lda LBl+1
+ jsr Printhex ! print second lowerbase (highbyte)
+ lda LBl
+ jsr Printhex ! print second lowerbase (lowbyte)
+ lda #10
+ jsr WRCH ! print a newline
+ lda #13
+ jsr WRCH ! print a carriagereturn
+ rts
+
+
--- /dev/null
+.define Pro
+
+! This routine is called at the entry of a procedure.
+! It saves the localbase of the invoking procedure, and sets the
+! new localbase to the present value of the stackpointer.
+! It then initializes the second localbase by subtracting
+! BASE from the real one.
+
+
+Pro:
+ ldx LB ! get localbase (lowbyte)
+ lda LB+1 ! get localbase (highbyte)
+ jsr Push ! push localbase onto the stack
+ ldx SP+2 ! get stackpointer (lowbyte)
+ lda SP+1 ! get stackpointer (highbyte)
+ stx LB ! new localbase (lowbyte)
+ sta LB+1 ! new localbse (highbyte)
+ tay
+ txa
+ sec
+ sbc #BASE
+ sta LBl ! second localbase (lowbyte)
+ tya
+ sbc #0
+ sta LBl+1 ! second localbase (highbyte)
+ rts
+
+
--- /dev/null
+.define Mread
+
+! This subroutine reads characters from the standard input.
+! It ignores the filedes.
+! It reads atmost 255 characters. So the runtime system must
+! provide a way of dealing with this.
+! The subroutine RDCH is a special one provided by the BBC
+! microcomputer.
+
+
+Mread:
+ jsr Pop ! ignore filedescriptor
+ jsr Pop ! bufptr
+ stx ADDR ! address of character buffer (lowbyte)
+ sta ADDR+1 ! address of character buffer (highbyte)
+ jsr Pop ! number of characters
+ ldy #0 ! <= 255
+ inx
+ 1: jsr RDCH ! read a character from the current inputstream
+ bcs 8f
+ sta (ADDR),y
+ iny
+ dex
+ bne 1b
+ 8: tya
+ tax
+ lda #0
+ jsr Push ! number of characters red.
+ tax ! report a succesfull read.
+ rts
+
+
--- /dev/null
+.define Ret
+
+! This subroutine stores the returnvalue in the return area.
+! This area is in zeropage.
+! The size of the object to be returned is in zeropage location
+! RETSIZE.
+! It also restores the localbases and the stackpointer of the
+! invoking procedure.
+
+
+Ret:
+ sty RETSIZE ! save returnsize
+ beq 1f ! the return size is zero
+ lda #0 ! address of returnvalue area (highbyte)
+ ldx #RETURN ! address of returnvalue area (lowbyte)
+ cpy #2
+ bne 2f
+ jsr Sti ! store word
+ jmp 1f
+ 2: cpy #4
+ jsr Sdi ! store fourbyte word
+ 1: ldx LB ! get old stackpointer (lowbyte)
+ stx SP+2
+ lda LB+1 ! get old stackpointer (highbyte)
+ sta SP+1
+ inc LB
+ inc LB
+ bne 1f
+ inc LB+1
+ 1: jsr Pop ! get old localbase
+ stx LB ! localbase (lowbyte)
+ sta LB+1 ! localbase (highbyte)
+ pha
+ sec
+ txa
+ sbc #BASE
+ sta LBl ! second localbase (lowbyte)
+ pla
+ sbc #0
+ sta LBl+1 ! second localbase (highbyte)
+ rts
+
+
--- /dev/null
+.define Rmi2
+
+! This subroutine returns the remainder of a twobyte signed division.
+! The sign of the result is as specified in the emtest.
+
+
+Rmi2:
+ ldy #0
+ sty NBYTES ! for the sign of the result
+ stx ARTH
+ sta ARTH+1 ! first operand
+ jsr Pop
+ stx ARTH+2
+ sta ARTH+3 ! second operand
+ ldy #0
+ sty UNSIGN ! its signed arithmetic
+ jsr Div
+ lsr ARTH+5
+ ror ARTH+4 ! result must be shifted one time
+ ldx ARTH+4
+ lda ARTH+5
+ ldy NBYTES
+ beq 1f ! result must be positive
+ jmp Ngi2
+ 1: rts
+
+
--- /dev/null
+.define Rmi4
+
+! This subroutine returns the remainder of a fourbyte division.
+
+
+Rmi4:
+ ldy #0
+ sty NBYTES ! for the sign of the result
+ ldy #0
+ sty UNSIGN ! it is signed arithmetic
+ jsr Div4
+ lsr ARTH+11
+ ror ARTH+10
+ ror ARTH+9
+ ror ARTH+8 ! result must be shifted one time
+ ldy NBYTES
+ beq 1f ! result is positive
+ lda #0
+ ldx #ARTH+8
+ jsr Ngi4
+ 1: lda ARTH+11
+ ldx ARTH+10
+ jsr Push
+ lda ARTH+9
+ ldx ARTH+8
+ jmp Push
+
+
--- /dev/null
+.define Rmu2
+
+! This subroutine returns the remainder of an twobyte unsigned
+! integer division.
+
+
+Rmu2:
+ stx ARTH
+ sta ARTH+1 ! first operand
+ jsr Pop
+ stx ARTH+2
+ sta ARTH+3 ! second operand
+ ldy #1
+ sty UNSIGN ! it unsigned
+ jsr Duv
+ lsr ARTH+5
+ ror ARTH+4 ! shift result one time
+ ldx ARTH+4
+ lda ARTH+5
+ rts
+
+
--- /dev/null
+.define Rmu4
+
+! This subroutine returns the remainder of a fourbyte unsigned
+! division.
+
+
+Rmu4:
+ ldy #1
+ sty UNSIGN ! its unsigned
+ jsr Pop
+ stx ARTH
+ sta ARTH+1
+ jsr Pop
+ stx ARTH+2
+ sta ARTH+3 ! second operand
+ jsr Pop
+ stx ARTH+4
+ sta ARTH+5
+ jsr Pop
+ stx ARTH+6
+ sta ARTH+7 ! first operand
+ jsr Duv4
+ lsr ARTH+11
+ ror ARTH+10
+ ror ARTH+9
+ ror ARTH+8 ! shift result one time
+ lda ARTH+11
+ ldx ARTH+10
+ jsr Push
+ lda ARTH+9
+ ldx ARTH+8
+ jmp Push
+
+
--- /dev/null
+.define Rol
+
+! This subroutine rotates left an integer n times
+! N is in register X.
+! The result is returned in registerpair AX.
+
+
+Rol:
+
+ txa
+ bne 1f
+ jmp Pop ! zero rotate return input
+ 1: tay ! Y contains number of rotates
+ jsr Pop
+ stx Ytmp ! save lowbyte
+ 2: clc
+ rol Ytmp ! rotate lowbyte
+ rol a ! rotate highbyte
+ bcc 1f ! no carry
+ inc Ytmp ! put carry in rightmost bit
+ 1: dey
+ bne 2b
+ ldx Ytmp ! store lowbyte in X
+ rts
+
+
--- /dev/null
+.define Rol4
+
+! This subroutine rotates left a fourbyte integer n times.
+! N is in register X.
+
+
+Rol4:
+ txa
+ bne 1f ! a zero rotate skip
+ rts
+ 1: tay
+ jsr Pop
+ stx ARTH
+ sta ARTH+1
+ jsr Pop
+ stx ARTH+2
+ sta ARTH+3
+ 2: asl ARTH
+ rol ARTH+1
+ rol ARTH+2
+ rol ARTH+3 ! rotate left
+ bcc 1f
+ inc ARTH ! put carry in rightmost bit
+ 1: dey
+ bne 2b
+ ldx ARTH+2
+ lda ARTH+3
+ jsr Push
+ ldx ARTH
+ lda ARTH+1
+ jmp Push
+
+
--- /dev/null
+.define Ror
+
+! This subroutine rotates right a integer twobyte word.
+! The number of rotates is in X.
+! The result is returned in registerpair AX.
+
+
+Ror:
+ txa
+ bne 1f ! a zero rotate just return input
+ jmp Pop
+ 1: tay
+ jsr Pop ! get word
+ stx Ytmp ! save lowbyte
+ 2: clc
+ ror a ! rotate highbyte
+ ror Ytmp ! rotate lowbyte
+ bcc 1f ! no carry
+ ora #80h ! put carry in leftmost bit
+ 1: dey
+ bne 2b
+ ldx Ytmp ! get lowbyte
+ rts
+
+
--- /dev/null
+.define Ror4
+
+! This subroutine rotates right a fourbyte word.
+! The number of rotates is in X.
+
+
+Ror4:
+ txa
+ bne 1f ! a zero rotate skip
+ rts
+ 1: tay
+ jsr Pop
+ stx ARTH
+ sta ARTH+1
+ jsr Pop
+ stx ARTH+2
+ sta ARTH+3
+ 2: lsr ARTH+3 ! rotate word
+ ror ARTH+2
+ ror ARTH+1
+ ror ARTH
+ bcc 1f ! no carry
+ lda #80h ! put carry in leftmost bit
+ ora ARTH+3
+ sta ARTH+3
+ 1: dey
+ bne 2b
+ lda ARTH+3
+ ldx ARTH+2
+ jsr Push
+ lda ARTH+1
+ ldx ARTH
+ jmp Push ! push result onto the stack
+
+
--- /dev/null
+.define Rtt
+
+! This subroutine performs the return from trap.
+
+
+Rtt:
+ ldy #0
+ jsr Ret ! restore old stackpointer and localbase
+ jsr Pop ! remove trapnumber
+ jsr Pop
+ sta hol0+1
+ stx hol0 ! restore linenumber
+ jsr Pop
+ sta hol0+5
+ stx hol0+4 ! restore filename pointer
+ lda #0
+ ldx #RETURN
+ jsr Sdi ! restore return area
+ rts
+
+
--- /dev/null
+.define Sar
+
+! This subroutine performs the SAR instruction.
+! For details see rapport IR-81.
+
+
+Sar:
+ jsr Aar ! get object address
+ ldy NBYTES+1 ! the size of the object (highbyte)
+ bne 2f
+ ldy NBYTES ! the size of the object (lowbyte)
+ cpy #1
+ bne 1f ! object size is one byte
+ jmp Sti1 ! put it in array
+ 1: cpy #2
+ bne 1f ! object size is two bytes
+ jmp Sti ! put it in array
+ 1: cpy #4
+ bne 2f ! object size is fourbytes
+ jmp Sdi ! put it in array
+ 2: jmp Stil ! put it in array
+
+
--- /dev/null
+.define Sbi2
+
+! This subroutine subtracts two twobyte signed integers
+! and returnes the result in registerpair AX.
+
+
+Sbi2:
+ stx ARTH ! save second operand (lowbyte)
+ sta ARTH+1 ! save second operand (highbyte)
+ jsr Pop
+ pha
+ sec
+ txa ! get first operand (lowbyte)
+ sbc ARTH ! subtract second operand (lowbyte)
+ tax
+ iny
+ pla ! get first operand (highbyte)
+ sbc ARTH+1 ! subtract second operand (highbyte)
+ rts
+
+
--- /dev/null
+.define Sbi4
+
+! This subroutine subtracts two fourbyte signed integers.
+
+
+Sbi4:
+ jsr Addsub ! initiate addresses
+ sec
+ 1: lda (ADDR+2),y ! get lowbyte+y first operand
+ sbc (ADDR),y ! subtract lowbyte+y second operand
+ sta (ADDR+2),y ! put on stack lowbyte+y result
+ iny
+ inx
+ bne 1b
+ rts
+
+
--- /dev/null
+.define Sdi, Sdo
+
+! The subroutine Sdi takes a fourbyte word and stores it
+! at the address in registerpair AX.
+! If the address is in zeropage, Sdo is used.
+
+
+Sdi:
+ stx ADDR ! address (lowbyte)
+ sta ADDR+1 ! address (highbyte)
+Sdo:
+ ldy #0
+ 1: jsr Pop
+ pha
+ txa
+ sta (ADDR),y ! store lowbyte
+ iny
+ pla
+ sta (ADDR),y ! store highbyte
+ iny
+ cpy #4
+ bne 1b
+ rts
+
+
--- /dev/null
+.define Set
+
+! This subroutine creates a set of n (n <= 256) bytes.
+! In this set a certain bit, which number is in registerpair AX,
+! is set. The rest is zero.
+
+
+Set:
+ stx ARTH ! save bitnumber (lowbyte)
+ sta ARTH+1 ! save bitnumber (highbyte)
+ jsr Zer ! create n zerobytes
+ lda ARTH
+ and #07h ! n mod 8 (bitnumber in byte)
+ tax
+ lda #1
+ cpx #0
+ beq 2f
+ 1: asl a ! set bit (n mod 8)
+ dex
+ bne 1b
+ 2: sta ARTH+2
+ ldx #3
+ 1: lsr ARTH+1 ! shiftright n 3 times (= n div 8)
+ ror ARTH ! this is the bytenumber
+ dex
+ bne 1b
+ ldy ARTH ! load bytenumber
+ lda SP+1
+ ldx SP+2
+ stx ADDR ! address of set (lowbyte)
+ sta ADDR+1 ! address of set (highbyte)
+ lda ARTH+2 ! get bit
+ sta (ADDR),y ! store byte with bit on
+ rts
+
+
--- /dev/null
+.define Sli2
+
+! This subroutine shifts a signed or unsigned interger to the
+! left n times.
+! N is in register X.
+! The returned value is in registerpair AX.
+
+
+Sli2:
+ txa
+ bne 1f
+ jmp Pop ! zero shift, return input
+ 1: tay
+ jsr Pop ! get integer
+ stx Ytmp ! save lowbyte
+ 2: asl Ytmp
+ rol a ! shift left
+ dey
+ bne 2b
+ ldx Ytmp ! get lowbyte
+ rts
+
+
--- /dev/null
+.define Sli4
+
+! This subroutine shift a signed or unsigned fourbyte integer
+! n times left. N is in register X.
+
+
+Sli4:
+ cpx #0
+ beq 9f ! zero shift, return input
+ lda SP+2 ! the shifting is done on the stack
+ sta ADDR ! address of integer (lowbyte)
+ lda SP+1
+ sta ADDR+1 ! address of integer (highbyte)
+ 2: ldy #0
+ clc
+ lda (ADDR),y
+ rol a
+ sta (ADDR),y
+ iny
+ lda (ADDR),y
+ rol a
+ sta (ADDR),y
+ iny
+ lda (ADDR),y
+ rol a
+ sta (ADDR),y
+ iny
+ lda (ADDR),y
+ rol a
+ sta (ADDR),y ! shift left
+ dex
+ bne 2b
+ 9: rts
+
+
--- /dev/null
+.define Sri2, Sru2
+
+! The subroutine Sri2 shifts a signed integer n times right.
+! In the case of a negative integer there is signextension.
+! The subroutine Sru2 shifts right an unsigned integer.
+! The returned value is in registerpair AX.
+
+
+Sru2:
+ txa
+ bne 1f
+ jmp Pop ! zero shift, return input
+ 1: tay
+ jsr Pop ! get integer
+ stx Ytmp ! save lowbyte
+ jmp 2f ! shift unsigned
+Sri2:
+ txa
+ bne 1f
+ jmp Pop ! zero shift, return input
+ 1: tay
+ jsr Pop ! get integer
+ stx Ytmp ! save lowbyte
+ tax
+ bmi 1f ! negative signextended shift
+ 2: lsr a
+ ror Ytmp ! shift not signextended
+ dey
+ bne 2b
+ ldx Ytmp ! get lowbyte
+ rts
+ 1: sec ! shift signextended
+ ror a
+ ror Ytmp
+ dey
+ bne 1b
+ ldx Ytmp ! get lowbyte
+ rts
+
+
--- /dev/null
+.define Sri4, Sru4
+
+! The subroutine Sri4 shifts a signed fourbyte integer to the
+! right n times
+! N is in register X.
+! The subroutine Sru4 shifts an unsigned fourbyte integer to the
+! right n times.
+
+Sru4:
+ txa
+ tay
+ bne 1f
+ rts
+ 1: jsr Pop
+ stx ARTH
+ sta ARTH+1
+ jsr Pop
+ stx ARTH+2
+ jmp 2f
+Sri4:
+ txa
+ tay
+ bne 1f
+ rts
+ 1: jsr Pop
+ stx ARTH
+ sta ARTH+1
+ jsr Pop
+ stx ARTH+2
+ tax
+ bmi 1f
+ 2: lsr a
+ ror ARTH+2
+ ror ARTH+1
+ ror ARTH
+ dey
+ bne 2b
+ beq 4f
+ 1: sec
+ ror a
+ ror ARTH+2
+ ror ARTH+1
+ ror ARTH
+ 3: dey
+ bne 1b
+ 4: ldx ARTH+2
+ jsr Push
+ lda ARTH+1
+ ldx ARTH
+ jmp Push
+
+
--- /dev/null
+.define Sti, Sext, Stii
+
+! The subroutine Sti stores an twobyte word at the address which
+! is in registerpair AX.
+! The subroutine Sext is used when the address is already in
+! zeropage.
+! The subroutine Stii is used when the address is in zeropage
+! and the registerpair AX contains the word.
+
+
+Sti:
+ stx ADDR ! address of word (lowbyte)
+ sta ADDR+1 ! address of word (highbyte)
+Sext:
+ jsr Pop ! get word
+Stii:
+ ldy #1
+ sta (ADDR),y ! store highbyte
+ dey
+ txa
+ sta (ADDR),y ! store lowbyte
+ rts
+
+
--- /dev/null
+.define Sti1
+
+! This subroutine stores an onebyte wordfractional at the address
+! which is in registerpair AX.
+
+
+Sti1:
+ stx ADDR ! address of byte (lowbyte)
+ sta ADDR+1 ! address of byte (highbyte)
+ jsr Pop ! get byte
+ ldy #0
+ txa
+ sta (ADDR),y ! store byte
+ rts
+
+
--- /dev/null
+.define Stil
+
+! This subroutine stores indirect a block of bytes if
+! the number of bytes is greater than four.
+! The destination address is in registerpair AX.
+! The lowbyte of the number of bytes is in Y,
+! the highbyte is in zeropage location NBYTES+1.
+
+
+Stil:
+ sta ADDR+3 ! destination address (highbyte)
+ stx ADDR+2 ! destination address (lowbyte)
+ sty NBYTES ! number of bytes (lowbyte)
+ clc
+ lda SP+2
+ sta ADDR ! source address (lowbyte)
+ adc NBYTES
+ sta SP+2 ! new stackpointer (lowbyte)
+ lda SP+1
+ sta ADDR+1 ! source address (highbyte)
+ adc NBYTES+1
+ sta SP+1 ! new stackpointer (highbyte)
+ inc NBYTES+1
+ jmp Blmnp ! do the move
+
+
--- /dev/null
+.define Stl
+
+! This subroutine performs the storage of a local which offset
+! is to big.
+
+
+Stl:
+ jsr Locaddr ! get the local address
+ jsr Pop ! get the word
+ ldy #1
+ sta (ADDR),y ! store highbyte
+ dey
+ txa
+ sta (ADDR),y ! store lowbyte
+ rts
+
+
--- /dev/null
+.define Sts
+
+! This subroutine stores indirect a number of bytes.
+! The number of bytes is in the registerpair AX.
+
+
+Sts:
+ cmp #0
+ bne 3f ! number of bytes > 255
+ cpx #1
+ bne 1f ! onebyte storage
+ jsr Pop ! get the address
+ jmp Sti1 ! store the byte
+ 1: cpx #2
+ bne 2f ! twobyte storage
+ jsr Pop ! get the address
+ jmp Sti ! store the word
+ 2: cpx #4
+ bne 3f ! fourbyte storage
+ jsr Pop ! get the address
+ jmp Sdi ! store the double word
+ 3: sta ARTH+1 ! objectsize > 4
+ txa
+ tay
+ jsr Pop ! get address
+ jmp Stil ! store the object
+
+
--- /dev/null
+.define Teq
+
+! This subroutine test if the value in registerpair AX is zero
+! or nonzero.
+! The returned value, a 1 or a 0, is in AX.
+
+
+Teq:
+ tay
+ beq 1f ! A is zero
+ 2: lda #0 ! AX is zero
+ tax
+ rts
+ 1: txa
+ bne 2b ! X is zero
+ lda #0 ! AX is nonzero
+ ldx #1
+ rts
+
+
--- /dev/null
+.define Test2
+
+! This subroutine tests if the value on top of the stack is 2.
+! It is used if the size is on top of the stack.
+! The word which is to be handled is returned in registerpair AX.
+
+
+Test2:
+ tay
+ bne 1f ! value > 255
+ cpx #2
+ bne 1f ! value <> 2
+ jsr Pop ! get word
+ rts
+ 1: ldx #Eoddz
+ lda #0
+ jsr Trap
+
+
--- /dev/null
+.define TestFFh
+
+! This subroutine tests if the value on top of the stack is <= 256.
+! It is used if the istruction argument is on top of the stack.
+! The value is saved in Y.
+
+
+TestFFh:
+ cmp #2
+ bpl 1f ! value > 256
+ cmp #0
+ beq 2f
+ cpx #0
+ bne 1f ! value is zero
+ 2: dex
+ txa
+ tay
+ rts
+ 1: ldx #Eoddz
+ lda #0
+ jsr Trap
+
+
--- /dev/null
+.define Tge
+
+! This subroutine test if the value in registerpair AX is
+! greater than or equal to zero.
+! The result is returned in AX.
+
+
+Tge:
+ tay
+ bpl 1f ! A >= 0
+ lda #0 ! AX < 0
+ tax
+ rts
+ 1: lda #0 ! AX >= 0
+ ldx #1
+ rts
+
+
--- /dev/null
+.define Tgt
+
+! This subroutine tests if the value in registerpair AX is
+! greater than zero.
+! The value returned is in AX.
+
+Tgt:
+ tay
+ bpl 1f ! A >= 0
+ 3: lda #0 ! AX <= 0
+ tax
+ rts
+ 1: beq 1f ! A = 0
+ 2: lda #0 ! AX > 0
+ ldx #1
+ rts
+ 1: txa
+ bne 2b ! X > 0
+ beq 3b ! X = 0
+
+
--- /dev/null
+.define Tle
+
+! This subroutine tests if the value in registerpair AX is
+! less than or equal to zero.
+! The value returned is in AX.
+
+
+Tle:
+ tay
+ bpl 1f ! A >= 0
+ 3: lda #0 ! AX <= 0
+ ldx #1
+ rts
+ 1: beq 1f ! A = 0
+ 2: lda #0 ! AX > 0
+ tax
+ rts
+ 1: txa
+ bne 2b ! X > 0
+ beq 3b ! x = 0
+
+
--- /dev/null
+.define Tlt
+
+! This subroutine tests if the value in registerpair AX is
+! less than zero.
+! The value returned is in AX.
+
+
+Tlt:
+ tay
+ bpl 1f ! A >= 0
+ lda #0 ! AX < 0
+ ldx #1
+ rts
+ 1: lda #0 ! AX >= 0
+ tax
+ rts
+
+
--- /dev/null
+.define Tne
+
+! This subroutine tests if the value in registerpair AX is
+! not equal to zero.
+! The value returned is in AX.
+
+
+Tne:
+ tay
+ beq 1f ! A = 0
+ 2: lda #0 ! AX <> 0
+ ldx #1
+ rts
+ 1: txa
+ bne 2b ! X <> 0
+ lda #0 ! AX = 0
+ tax
+ rts
+
+
--- /dev/null
+.define Trap
+
+! This subroutine performs the trap instruction.
+
+Trap:
+ txa
+ cmp #64
+ bcc 1f
+ 2: jmp Dotrap
+ 1: bmi 2b
+ pha
+ lda IGNMASK ! get bitmask (lowbyte)
+ sta ARTH
+ lda IGNMASK+1 ! get bitmask (highbyte)
+ 2: lsr a
+ ror ARTH ! shiftright bitmask n times
+ dex
+ bne 2b
+ lda #1
+ and ARTH
+ bne 3f
+ pla ! clear hardware_stack
+ jmp Dotrap
+ 3: pla ! clear hardware_stack
+ rts
+
+Dotrap:
+ sta TRAPVAL
+ lda #0
+ cmp ERRPROC+1
+ bne 1f ! ERRPROC <> 0 (highbyte)
+ cmp ERRPROC
+ bne 1f ! ERRPROC <> 0 (lowbyte)
+ jmp Mtrap
+ 1: lda #0
+ ldx #RETURN
+ jsr Ldi ! save return area
+ lda hol0+5
+ ldx hol0+4
+ jsr Push ! save filename pointer
+ lda hol0+1
+ ldx hol0
+ jsr Push ! save linenumber
+ lda ERRPROC
+ sta ADDR ! address of errorhandler (lowbyte)
+ lda ERRPROC+1
+ sta ADDR+1 ! address of errorhandler (highbyte)
+ lda #0
+ sta ERRPROC ! reset ERRPROC (lowbyte)
+ sta ERRPROC+1 ! reset ERRPROC (highbyte)
+ ldx TRAPVAL
+ jsr Push
+ jmp (ADDR) ! proceed with errorhandler
+
+Mtrap:
+ cpx #0
+ bne 1f
+ lda #[EARRAY].h
+ ldx #[EARRAY].l
+ jsr Mprint
+ jmp errorend
+ 1: cpx #1
+ bne 1f
+ lda #[ERANGE].h
+ ldx #[ERANGE].l
+ jsr Mprint
+ jmp errorend
+ 1: cpx #2
+ bne 1f
+ lda #[ESET].h
+ ldx #[ESET].l
+ jsr Mprint
+ jmp errorend
+ 1: cpx #3
+ bne 1f
+ lda #[EIOVFL].h
+ ldx #[EIOVFL].l
+ jsr Mprint
+ jmp errorend
+ 1: cpx #10
+ bne 1f
+ lda #[ECONV].h
+ ldx #[ECONV].l
+ jsr Mprint
+ jmp errorend
+ 1: cpx #16
+ bne 1f
+ lda #[ESTACK].h
+ ldx #[ESTACK].l
+ jsr Mprint
+ jmp errorend
+ 1: cpx #17
+ bne 1f
+ lda #[EHEAP].h
+ ldx #[EHEAP].l
+ jsr Mprint
+ jmp errorend
+ 1: cpx #19
+ bne 1f
+ lda #[EODDZ].h
+ ldx #[EODDZ].l
+ jsr Mprint
+ jmp errorend
+ 1: cpx #20
+ bne 1f
+ lda #[ECASE].h
+ ldx #[ECASE].l
+ jsr Mprint
+ jmp errorend
+ 1: cpx #25
+ bne 1f
+ lda #[EBADMON].h
+ ldx #[EBADMON].l
+ jsr Mprint
+ jmp errorend
+ 1: cpx #26
+ bne 1f
+ lda #[EBADLIN].h
+ ldx #[EBADLIN].l
+ jsr Mprint
+ jmp errorend
+ 1: cpx #27
+ bne errorend
+ lda #[EBADGTO].h
+ ldx #[EBADGTO].l
+ jsr Mprint
+errorend:
+ ldx STACK
+ dex
+ dex
+ txs
+ rts
+
+
--- /dev/null
+.define Mwrite
+
+! This subroutine performs the monitor call write.
+! Writing is always done to standardoutput.
+! A zero is returned on exit.
+! The subroutine WRCH is a special routine of the BBC
+! microcomputer.
+
+
+Mwrite:
+ jsr Pop ! get fildes
+ jsr Pop ! get address of characterbuffer
+ stx ADDR ! bufferaddress (lowbyte)
+ sta ADDR+1 ! bufferaddress (highbyte)
+ jsr Pop ! number of characters to be writen.
+ ldy #0
+ 1: lda (ADDR),y
+ cmp #10
+ bne 2f
+ pha
+ lda #13
+ jsr WRCH
+ pla
+ 2: jsr WRCH
+ iny
+ dex
+ bne 1b
+ tya
+ tax
+ lda #0
+ jsr Push
+ tax
+ rts
+
--- /dev/null
+.define Xor
+
+! This subroutine performs the exclusive or on two groups of bytes.
+! The groups consists of atmost 254 bytes.
+! The result is on top of the stack.
+
+
+Xor:
+ lda SP+1
+ sta ADDR+1 ! address of first group (lowbyte)
+ lda SP+2
+ sta ADDR ! address of first group (highbyte)
+ clc
+ tya
+ adc SP+2
+ sta SP+2 ! new stackpointer (lowbyte)
+ sta ADDR+2 ! address of second group (lowbyte)
+ lda #0
+ adc SP+1
+ sta SP+1 ! new stackpointer (highbyte)
+ sta ADDR+3 ! address of second group (highbyte)
+ 1: dey
+ lda (ADDR),y ! get byte first group
+ eor (ADDR+2),y ! exclusive or with byte second group
+ sta (ADDR+2),y ! restore result
+ tya
+ bne 1b
+ rts
+
+
--- /dev/null
+.define Zer
+
+! This subroutine puts n (n <=256) zero bytes on top of
+! the stack.
+! The number of bytes minus one is in Y.
+
+
+Zer:
+ tya
+ lsr a ! number of bytes div 2
+ tay
+ iny
+ lda #0
+ tax
+ 2: jsr Push ! push two bytes
+ dey
+ bne 2b
+ rts
+
+
--- /dev/null
+.define Zrl, Zro
+
+! The subroutine Zrl makes a local zero which offset is to big.
+! The offset of the local is in registerpair AX.
+! The subroutine Zro is used if the address is already in zeropage.
+
+
+Zrl:
+ jsr Locaddr ! get address of local
+Zro:
+ lda #0
+ tay
+ sta (ADDR),y ! lowbyte = 0
+ iny
+ sta (ADDR),y ! highbyte = 0
+ rts
+
+
public / ack.git / commitdiff