--- /dev/null
+.define aar
+
+!R1 contains description address
+!R3 contains element number
+!base address is on stack
+aar:
+ sub R3, 0(R1)
+ mult RR2, 4(R1)
+ inc R15, $4
+ add R3, *RR14
+ ld *RR14, R3
+ dec R15, $4
+ ret
--- /dev/null
+.define blm
+
+!size in R0
+blm:
+ popl saveret, *RR14
+ ldm savereg, R4, $10
+ ldk R2, $0
+ ld R4, R2
+ pop R3, *RR14 !RR2: dst address
+ pop R5, *RR14 !RR4: src address
+ ld R1, R0
+ sra R0
+ jr EQ, 2f
+ !now avoid wrong copy in case the pieces overlap
+ cp R5, R3
+ jr EQ, 2f
+ jr LT, 1f
+ ldir *RR2, *RR4, R0
+ jr 2f
+1: dec R1, $2
+ add R3, R1
+ add R5, R1
+ lddr *RR2, *RR4, R0
+2: ldm R4, savereg, $10
+ pushl *RR14, saveret
+ ret
--- /dev/null
+.define cii
+
+cii:
+ popl saveret, *RR14
+ pop R2, *RR14
+ pop R1, *RR14
+ sub R2, R1 !expansion in bytes
+ jr LE, 1f
+ sra R2 !expansion in words > 0
+ jr NC, 2f
+ pop R1, *RR14 !expand 1 --> 2
+ extsb R1
+ push *RR14, R1
+ test R2
+ jr EQ, 4f
+2: !expand >= 1 word
+ ld R1, *RR14
+ exts RR0
+3: push *RR14, R0
+ djnz R2, 3b
+ jr 4f
+1: sub R15, R2
+4: pushl *RR14, saveret
+ ret
--- /dev/null
+.define cmi
+
+!size in R0
+cmi:
+ cp R0, $2
+ jr NE, 1f
+ popl RR2, *RR14
+ pop R1, *RR14
+ pop R0, *RR14
+ sub R0, R1
+ jp *RR2
+1: cp R0, $4
+ jr EQ, cmi4
+ jr unknown
--- /dev/null
+.define cmi4
+
+cmi4:
+ popl saveret, *RR14
+ popl RR0, *RR14
+ popl RR2, *RR14
+ subl RR2, RR0
+ ldk R0, $0
+ ldl RR2, saveret
+ jr LT, 1f
+ jp EQ, *RR2
+ inc R0
+ jp *RR2
+1: dec R0
+ jp *RR2
--- /dev/null
+.define cms
+
+cms:
+ popl saveret, *RR14
+ ldm savereg, R4, $10
+ ldl RR2, RR14
+ add R3, R0
+ ldl RR4, RR2
+ add R5, R0
+ sra R0
+2: pop R1, *RR14
+ cp R1, *RR2
+ jr NE, 1f
+ inc R3, $2
+ djnz R0, 2b
+1: ld R15, R5
+ ldm R4, savereg, $10
+ pushl *RR14, saveret
+ ret
--- /dev/null
+.define cmu
+
+!size in R0
+cmu:
+ cp R0, $2
+ jr NE, 1f
+ popl RR2, *RR14
+ pop R1, *RR14
+ pop R0, *RR14
+ cp R0, R1
+ ldk R0, $0
+ jr ULT, 2f
+ jp EQ, *RR2
+ inc R0
+ jp *RR2
+2: dec R0
+ jp *RR2
+1: cp R0, $4
+ jr EQ, cmu4
+ jr unknown
--- /dev/null
+.define cmu4
+
+cmu4:
+ popl saveret, *RR14
+ popl RR0, *RR14
+ popl RR2, *RR14
+ cpl RR2, RR0
+ ldk R0, $0
+ ldl RR2, saveret
+ jr ULT, 1f
+ jp EQ, *RR2
+ inc R0
+ jp *RR2
+1: dec R0
+ jp *RR2
--- /dev/null
+.define csa
+
+!R1 contains address of jump table
+!R2 contains case index
+csa:
+ sub R2, 2(R1)
+ jr LT, 1f
+ cp R2, 4(R1)
+ jr UGT, 1f
+ sla R2
+ add R1, R2
+ ld R2, 06(R1)
+ cp R2, $0
+ jr EQ, 2f
+ jp 0(R2)
+1: ld R1, 0(R1)
+ jp NE, 0(R1)
+2: push *RR14, $ECASE
+ jr fatal
--- /dev/null
+.define csb
+
+!R1 contains address of jump table
+!R2 contains case index
+csb:
+ ld R3, 0(R1) !default pointer
+ ld R0, 2(R1) !number of entries
+ test R0
+ jr EQ, 1f
+3: inc R1, $4
+ cp R2, 0(R1)
+ jr EQ, 2f
+ djnz R0, 3b
+1: ld R1, R3 !default pointer
+ jr 4f
+2: ld R1, 2(R1)
+4: test R1
+ jr EQ, 5f
+ jp 0(R1)
+5: push *RR14, $ECASE
+ jr fatal
--- /dev/null
+.define cuu
+
+cuu:
+ popl RR2, *RR14
+ pop R0, *RR14
+ pop R1, *RR14
+ sub R0, R1 !expansion in bytes
+ jr LE, 1f
+ sra R0 !expansion in words
+ jp EQ, *RR2
+2: push *RR14, $0
+ djnz R0, 2b
+ jp *RR2
+1: sub R15, R0
+ jp *RR2
--- /dev/null
+.define dup
+
+dup:
+ popl saveret, *RR14
+ dec R15, $2
+ ldl RR2, RR14
+ add R3, R0
+ sra R0
+ lddr *RR14, *RR2, R0
+ inc R15, $2
+ pushl *RR14, saveret
+ ret
--- /dev/null
+.define dvu2
+
+dvu2:
+ popl saveret, *RR14
+ pop R2, *RR14
+ pop R1, *RR14
+ test R2
+ jr MI, 1f
+ ldk R0, $0
+ div RR0, R2
+2: pushl *RR14, saveret
+ ret
+1: cp R2, R1
+ ldk R1, $0
+ jr UGT, 2b
+ inc R1
+ jr 2b
--- /dev/null
+.define dvu4
+
+dvu4:
+ popl saveret, *RR14
+ ldm savereg, R4, $10
+ popl RR4, *RR14
+ popl RR2, *RR14
+ testl RR4
+ jr MI, 1f
+ ldl RR0, $0
+ divl RQ0, RR4
+ jr 2f
+1: cpl RR4, RR2
+ ldl RR2, $0
+ jr UGT, 2f
+ inc R3
+2: ldm R4, savereg, $10
+ pushl *RR14, saveret
+ ret
--- /dev/null
+.define endtext, enddata, endbss, _etext, _edata, _end
+
+ .text
+endtext:
+_etext:
+ .data
+enddata:
+_edata:
+ .bss
+endbss:
+_end:
--- /dev/null
+.define exg
+
+!size (bytes) in R0
+exg:
+ ldm savereg, R4, $10
+ ldl RR2, RR14
+ inc R3, $2
+ ldl RR4, RR2
+ add R5, R0
+ sra R0
+1: ld R1, *RR2
+ ex R1, *RR4
+ ld *RR4, R1
+ inc R3, $2
+ inc R5, $2
+ djnz R0, 1b
+ ldm R4, savereg, $10
+ ret
--- /dev/null
+.define gto
+
+gto:
+ pop R3, *RR14
+ ld R13, 4(R3)
+ ld R15, 2(R3)
+ ld R3, 0(R3)
+ jp 0(R3)
--- /dev/null
+.define EXIT, F_DUM
+.define ERANGE, ESET, EHEAP, EILLINS, EODDZ, ECASE, EBADMON
+.define hol0, trppc, trpim, reghp, argv, envp
+
+EXIT = 0
+F_DUM = 0
+
+ERANGE = 1
+ESET = 2
+EHEAP = 17
+EILLINS = 18
+EODDZ = 19
+ECASE = 20
+EBADMON = 25
+
+.text
+ !clear .bss
+ ldk R2, $0
+ ld R3, $endbss
+ ld R0, R3
+ sub R0, $begbss
+ jr EQ, 1f
+ sra R0
+ push *RR2, $0
+ dec R0
+ jr EQ, 1f
+ ldl RR4, RR2
+ dec R5, $2
+ lddr *RR4, *RR2, R0
+1:
+ ldb RL0, $10 ! echo newline
+ sc $4
+ ldl RR14, $0
+ push *RR14, envp
+ push *RR14, argv
+ push *RR14, $1
+ calr _m_a_i_n
+ ldl RR14, $0xC00017FC
+ sc $0
+
+.bss
+begbss:
+.data
+hol0:
+ .word 0,0 ! line no
+ .word 0,0 ! file
+trppc:
+ .word 0
+trpim:
+ .word 0
+argv:
+envp:
+ .word 1f
+ .word 0
+1: .asciz "program"
+reghp:
+ .word endbss
--- /dev/null
+.define inn
+
+!bitnr in R1
+!size (bytes) in R2
+inn:
+ ld R3, R2
+ sra R2
+ ldk R0, $0
+ div RR0, $020 !R0: bitnr, R1: wordnr
+ cp R1, R2
+ jr UGE, 1f !R1 must be < R2
+ inc R1, $2 !R1 contains nr of words from top stack
+ sla R1
+ ld R1, RR14(R1)
+ bit R1, R0
+ jr EQ, 1f
+ ldk R0, $1
+ jr 2f
+1: ldk R0, $0
+2: ld R1, R3
+ popl RR2, *RR14
+ add R15, R1
+ jp *RR2
--- /dev/null
+.define lar
+
+!R1 contains description address
+!R3 contains element number
+!base address is on stack
+lar:
+ popl saveret, *RR14
+ sub R3, 0(R1)
+ ld R0, 4(R1) !nr of bytes per element
+ mult RR2, R0
+ add R3, *RR14
+ add R3, R0
+ sra R0 !nr of words per element
+ jr EQ, 1f
+ dec R3, $2
+ lddr *RR14, *RR2, R0
+ inc R15, $2
+ jr 2f
+1: ldb RL2, -1(R3)
+ ldb RH2, $0
+ ld *RR14, R2
+2: ldl RR2, saveret
+ jp *RR2
--- /dev/null
+.define los2
+
+los2:
+ popl saveret, *RR14
+ pop R0, *RR14 !object size
+ ldk R2, $0
+ pop R3, *RR14 !address of object
+ cp R0, $1
+ jr NE, 1f
+ ldb RL0, *RR2
+ push *RR14, R0
+ jr 2f
+1: add R3, R0
+ dec R3, $2
+ dec R15, $2
+ sra R0
+ lddr *RR14, *RR2, R0
+ inc R15, $2
+2: pushl *RR14, saveret
+ ret
--- /dev/null
+.define mon
+
+mon:
+ popl saveret, *RR14
+ pop R0, *RR14 ! iocode
+ cp R0, $1 ! exit
+ jr NE, read
+ inc R15, $2
+ sc $EXIT
+read: cp R0, $3 ! read
+ jr NE, write
+ pop R0, *RR14 ! dummy; all input from stdin
+ pop R1, *RR14 ! ptr to buffer
+ pop R2, *RR14 ! nr of bytes to be read
+ ld R3, R1
+ cp R2, $0
+ jr EQ, 6f
+1: sc $2 ! read character into RL0
+ cpb RL0, $004 ! \^D
+ jr EQ, 6f
+ cpb RL0, $015 ! \cr
+ jr NE, 2f
+ ldb RL0, $012
+2: sc $4 ! echo
+ cpb RL0, $010 ! \^H
+ jr NE, 3f
+ cp R1, R3
+ jr EQ, 5f
+ dec R1
+ jr 5f
+3: cpb RL0, $0100 ! \@
+ jr NE, 4f
+ ld R1, R3
+ ldb RL0, $012
+ sc $4
+ jr 5f
+4: ldb 0(R1), RL0
+ inc R1
+ cpb RL0, $012 ! \nl
+ jr EQ, 6f
+5: djnz R2, 1b
+6: sub R1, R3 ! nr of bytes read
+ push *RR14, R1
+ push *RR14, $0
+ jr retu
+write: cp R0, $4 ! write
+ jr NE, open
+ pop R0, *RR14 ! dummy; all output to stdout
+ pop R1, *RR14 ! ptr to buffer
+ pop R2, *RR14 ! nr of bytes to be written
+ ld R3, R2
+ cp R2, $0
+ jr EQ, 8f
+9: ld R0, $5000 ! counter to delay printing a little
+7: djnz R0, 7b
+ ldb RL0, 0(R1)
+ sc $4
+ inc R1
+ djnz R2, 9b
+8: sub R3, R2 ! nr of bytes written
+ push *RR14, R3
+ push *RR14, $0
+ jr retu
+open: cp R0, $5 ! open
+ jr close
+ jr NE, close
+ ld *RR14, $0
+ ld 2(R15), $0
+ jr retu
+close: cp R0, $6 ! close
+ jr NE, ioctl
+ ld *RR14, $0
+ jr retu
+ioctl: cp R0, $54 ! ioctl
+ jr NE, err
+ inc R15, $4
+ ld *RR14, $0
+retu: ldl RR2, saveret
+ jp *RR2
+err: push *RR14, saveret
+ push *RR14, $EBADMON
+ calr trp
+ ret
--- /dev/null
+.define noop
+
+noop:
+ push *RR14, hol0
+ push *RR14, $fmt
+ calr prf
+ ret
+.data
+fmt: .asciz "test %d\n"
--- /dev/null
+.define prf
+
+prf:
+ ld R0, hol0+4 !pointer to filename
+ cp R0, $0
+ jr EQ, 1f
+ ld R2, R0
+ ld R1, $40
+3: !test filename on bad characters
+ ldb R3, 0(R2)
+ cpb R3, $0
+ jr EQ, 2f
+ cpb R3, $0177
+ jr GE, 1f
+ cpb R3, $040
+ jr LT, 1f
+ inc R2
+ djnz R1, 3b
+ clrb 0(R2)
+2: push *RR14, hol0
+ ld R1, R15
+ push *RR14, R1
+ push *RR14, R0
+ push *RR14, $fmt1
+ calr printf
+ popl saveprf, *RR14 !return address
+ calr printf !because of call from 'noop'
+ pushl *RR14, saveprf
+ ret
+1: ld R0, $name
+ jr 2b
+.data
+fmt1: .asciz "%s, sp = %x, line %d:\n"
+name: .asciz "_unknown file_"
+saveprf:
+ .long 0
--- /dev/null
+.define printf
+
+printf:
+ popl saveret, *RR14
+ ldm savereg, R4, $10
+ ld R3, $buff !R3 is pointer to a buffer, in which
+ !we built the string to be printed.
+ pop R2, *RR14 !R2 is pointer to format-string
+prloop:
+ ldb RL0, 0(R2)
+ testb RL0
+ jr EQ, ready
+ inc R2
+ cpb RL0, $045 ! '%'?
+ jr NE, 1f
+ ldb RL0, 0(R2)
+ inc R2
+ cpb RL0, $0163 ! 's'?
+ jr EQ, 3f
+ cpb RL0, $0170 ! 'x'?
+ ld R4, $16 ! print number hexadecimal
+ jr EQ, 2f
+ cpb RL0, $0144 ! 'd'?
+ ld R4, $10 ! print number decimal
+ jr EQ, 2f
+ cpb RL0, $0157 ! 'o'?
+ ld R4, $8 ! print number octal
+ jr EQ, 2f
+1: ldb 0(R3), RL0
+ inc R3
+ jr prloop
+2: !in case of %x, %d or %o
+ pop R1, *RR14
+ test R1
+ jr PL, 4f
+ cp R4, $10
+ jr NE, 4f ! print only '-' in case of %d
+ ldb 0(R3), $055 ! '-'
+ inc R3
+ neg R1
+4: calr printn
+ jr prloop
+3: !in case of %s
+ pop R1, *RR14
+6: ldb RL0, 0(R1)
+ testb RL0
+ jr EQ, prloop
+ inc R1
+ ldb 0(R3), RL0
+ inc R3
+ jr 6b
+ready: !now really print the string we built in the buffer
+ ldb 0(R3), RL0 !end string with '\0'
+ sub R3, $buff-1 !R3 contains the number of characters
+ ld R1, $buff
+7: ldb RL0, 0(R1)
+ inc R1
+ sc $4
+ djnz R3, 7b
+ ldm R4, savereg, $10
+ pushl *RR14, saveret
+ ret
+
+printn:
+ ldk R0, $0
+ div RR0, R4 !%x, %d or %o determined by R4
+ test R1
+ jr EQ, 5f !if quotient is '0' printn is ready
+ push *RR14, R0 !push remainder onto the stack
+ calr printn
+ pop R0, *RR14
+5: add R0, $060
+ cp R0, $071 !'9'
+ jr LE, 8f
+ add R0, $7
+8: ldb 0(R3), RL0
+ inc R3
+ ret
+
+.data
+buff:
+ .space 256
--- /dev/null
+.define rck
+
+rck:
+ ld R0, RR14($4)
+ cp R0, 0(R1)
+ jr LT, 1f
+ cp R0, 2(R1)
+ jr LE, 2f
+1: push *RR14, $ERANGE
+ calr trp
+2: ret
--- /dev/null
+.define rmu2
+
+rmu2:
+ popl saveret, *RR14
+ pop R2, *RR14
+ pop R1, *RR14
+ test R2
+ jr MI, 1f
+ ldk R0, $0
+ div RR0, R2
+2: pushl *RR14, saveret
+ ret
+1: ld R0, R1
+ cp R2, R1
+ jp UGT, 2b
+ sub R0, R2
+ jp 2b
--- /dev/null
+.define rmu4
+
+rmu4:
+ popl saveret, *RR14
+ ldm savereg, R4, $10
+ popl RR4, *RR14
+ popl RR2, *RR14
+ testl RR4
+ jr MI, 1f
+ ldl RR0, $0
+ divl RQ0, RR4
+ jr 2f
+1: ldl RR0, RR2
+ cpl RR4, RR2
+ jr UGT, 2f
+ sub RR0, RR4
+2: ldm R4, savereg, $10
+ pushl *RR14, saveret
+ ret
--- /dev/null
+.define sar
+
+!R1 contains description address
+!R3 contains element number
+!base address is on stack
+sar:
+ popl saveret, *RR14
+ sub R3, 0(R1)
+ ld R0, 4(R1) !nr of bytes per element
+ mult RR2, R0
+ add R3, *RR14
+ inc R15, $2
+ sra R0 !nr of words per element
+ jr EQ, 1f
+ ldir *RR2, *RR14, R0
+ jr 2f
+1: pop R1, *RR14
+ ldb *RR2, RL1
+2: ldl RR2, saveret
+ jp *RR2
--- /dev/null
+.define saveret
+.define savereg
+
+.data
+saveret:
+ .long 0
+savereg:
+ .space 20
--- /dev/null
+.define strhp
+
+strhp:
+ popl RR2, *RR14
+ pop R0, *RR14
+ ld reghp, R0 !heappointer must be < stackpointer.
+ cp R0, R15
+ jp ULT, *RR2
+ push *RR14, $EHEAP
+ jr fatal
--- /dev/null
+.define sts2
+
+sts2:
+ popl saveret, *RR14
+ pop R0, *RR14 !object size
+ ldk R2, $0
+ pop R3, *RR14 !address of object
+ cp R0, $1
+ jr NE, 1f
+ pop R0, *RR14
+ ldb *RR2, RL0
+ jr 2f
+1: sra R0
+ ldir *RR2, *RR14, R0
+2: pushl *RR14, saveret
+ ret
--- /dev/null
+.define trp, fatal
+
+fatal:
+ calr trp
+ sc $EXIT
+
+trp:
+ push *RR14, R1
+ inc R15, $2
+ popl saveret, *RR14
+ pop R1, *RR14 !trap number in R1
+ pushl *RR14, saveret
+ push *RR14, R0
+ dec R15, $2
+ cp R1, $16
+ jr UGE, 1f
+ ld R0, trpim
+ bit R0, R1
+ jr NE, 2f !ignore
+1: sub R15, $24
+ ldm *RR14, R2, $12
+ push *RR14, R1
+ ld R1, trppc
+ cp R1, $0
+ jr EQ, 3f
+ clr trppc
+ call 0(R1)
+ inc R15, $2
+ ldm R2, *RR14, $12
+ add R15, $24
+2: pop R1, *RR14
+ pop R0, *RR14
+ ret
+3: push *RR14, $err
+ calr printf
+ sc $EXIT
+.data
+err: .asciz "trap error %d\n"
--- /dev/null
+.define unknown
+
+unknown:
+ push *RR14, $EODDZ
+ jr fatal
--- /dev/null
+.define xset
+
+!bitnr in R1
+!size (bytes) in R0
+xset:
+ popl saveret, *RR14
+ sra R0
+ ld R2, R0
+1: push *RR14, $0
+ djnz R0, 1b
+ div RR0, $020 !R0: bitnr, R1: wordnr
+ cp R1, R2
+ jr UGE, 2f
+ ldk R2, $0
+ set R2, R0
+ sla R1
+ ld RR14(R1), R2
+3: pushl *RR14, saveret
+ ret
+2: push *RR14, $ESET
+ calr trp
+ jr 3b