wls@astrovax.UUCP (William L. Sebok) (06/26/84)
part 7 of 8
---- Cut here and extract with sh not csh-----
mkdir ./vaxforth
/bin/echo 'Extracting ./vaxforth/forth2.S'
sed 's/^X//' <<'//go.sysin dd *' >./vaxforth/forth2.S
X/* ================================================================= */
X/* input interpreting words
* delim WORD --- addr
* imbedded newlines in "unix character" files are handled
* here: >LOC is incremented and >IN zeroed if at least
* 200 bytes from end. Can't handle this in FIND because
* we may not necessarily be seeing forth words if we are
* reading from this as a data stream.
*
* Preceeding delimiters are skipped ONLY if delimiter is
* Blank (this is slightly non-standard). Mainly this drops
* the old rule that strings can't be zero length (otherwise
* the trailing delimiter is interpreted as a leading delimiter).
*
* If delimiter is Blank, then Tab is also accepted as a
* delimiter.
*/
9: .word 9b-fdc7
9: .set fdc7,9b
.long 020021107540 /* WORD (basic input stream parser) */
word: tstl blk(%u) /* get block being interpreted */
beql 1f /* if not terminal then interpret block */
movl blk(%u),-(%s)
bsbw block
brb 2f
1: movl msgbuf(%u),-(%s)/* if terminal then get message buffer */
2: movl (%s)+,r0 /* get buffer */
addl2 in(%u),r0 /* add offset */
movl %h,r1 /* current h to r */
clrb (r1)+ /* init this counter to zero */
cmpl (%s),$BLANK /* delimiter BLANK? */
bneq srchlp /* if not, then don't skip initial delimiters */
skplup: movzbl (r0)+,r2 /* unexpected end of line? */
beql stfdel /* exit for end-of-line action. */
cmpb r2,$NL /* newline? */
bneq 1f
bsbb nl
brb skplup
1: cmpb r2,(%s) /* is character a delimiter? */
beql skplup /* yes. */
cmpb r2,$TAB /* is character a tab? */
beql skplup
decl r0
srchlp: movb (r0),r2 /* have we reached the end of line? */
beql stfdel /* yes */
incl r0
cmpb r2,$NL /* newline? */
bneq 2f
bsbb nl
jbr stfdel
2: cmpb (%s),$BLANK /* delimiter BLANK? */
bneq 3f
cmpb r2,$TAB /* tab? */
beql stfdel
3: cmpb r2,(%s) /* delimiter? */
beql stfdel
movb r2,(r1)+ /* transfer one byte to dictionary */
incb (%h) /* inc byte counter (at beg. of entry) */
jbr srchlp /* get another character. */
stfdel: movb r2,(r1) /* put delimiter in buffer */
subl3 -4(%s),r0,in(%u) /* subtract buffer beginning */
movl %h,(%s) /* return string address */
rsb
X/* Handle imbedded newlines */
nl: cmpl blk(%u),$CHANBOT
bgequ 1f
decl r0
moval stfdel,(%r) /* if regular block \n == \0 */
rsb
1: cmpl in(%u),$(BUFLEN-200)
bgeq 2f
rsb
2: movl *darea(%u),r0
mnegl $1,locat(r0) /* mark buffer stale. */
addl2 in(%u),floc(%u)
clrl in(%u)
moval word,(%r) /* restart */
rsb
X/* =================================================================== */
X/* Convert a Character String to a Number. */
X/* d1 addr CONVERT d2 addr */
.set N.NEG,0x100
.set N.FLT,0x200
.set N.DBL,0x400
.set N.SNG,0x8000
conv: addl3 (%s)+,$1,r2 /* pointer (start at addr + 1) */
movl (%s)+,r6 /* get high precision part */
movl (%s)+,r4 /* get low precision part */
movzbl base(%u),r1 /* get base */
movw $N.SNG,r3 /* clear flags */
cmpb (r2),$'+ /* plus sign? */
beql 0f /* yes, ignore. */
cmpb (r2),$'- /* is first char "-" */
bneq nmloop /* no */
bisw2 $N.NEG,r3 /* mark negative */
0: incl r2 /* skip character */
nmloop: cvtbl (r2)+,r0 /* get char */
cmpb r0,$'9 /* is it above ascii 9? */
bleq 2f /* no */
cmpb r0,$'a /* lowercase? */
blss 1f
subl2 $('a-'A),r0 /* convert to uppercase. */
1: cmpb r0,$'A /* is it a letter? */
blss notdig /* no */
subl2 $7,r0 /* convert to digit */
2: subl2 $'0,r0 /* convert to number */
blss notdig /* legimate integer? */
cmpl r0,r1 /* within current base? */
bgeq notdig /* no */
tstw r3
blss muldig /* do not increment digit count if single */
incb r3 /* mark another digit */
X/* Multiply by BASE and add digit */
muldig: mull2 r1,r6 /* multiply high precision part */
tstl r4
blss 1f
emul r4,r1,r0,r4 /* multiply low precision part */
addl2 r5,r6 /* fold together */
brb nmloop /* get next digit */
1: emul r4,r1,r0,r4 /* multiply low precision part */
addl2 r1,r5 /* adjust */
addl2 r5,r6 /* fold together */
brb nmloop
notdig: cmpb r0,$(',-'0) /* anything less than comma is bad */
blss endnum
cmpb r0,$('/-'0) /* anything gr than / is bad */
bgtr endnum
bicw2 $N.SNG,r3 /* mark it not single */
cmpb r0,$('.-'0)
bneq nmloop
bisw2 $N.FLT,r3 /* period means floating */
brb nmloop /* continue */
endnum: tstl r6 /* any high precision part */
beql tstsng /* no */
bicw2 $N.SNG,r3 /* yes, mark double */
tstsng: bitw $N.NEG,r3 /* negative number? */
beql 4f /* no */
mnegl r4,r4
adwc $0,r6
mnegl r6,r6
4: decl r2 /* back up to point to offending char */
movl r4,-(%s) /* save low precision part */
movl r6,-(%s) /* save high precision part */
movl r2,-(%s) /* save char pointer */
cvtwl r3,dpl(%u)
rsb
fltest: movl (%s),r0 /* get addr */
cmpb (r0),$'e /* exponent? */
beql 1f
cmpb (r0),$'E /* exponent? */
beql 1f
cmpb (r0),$'d /* double exponent? */
beql 0f
cmpb (r0),$'D
beql 0f
tstl (%r)+ /* if not floating we are done */
rsb
0: bisw2 $N.DBL,dpl(%u) /* mark double */
1: movl dpl(%u),(%s) /* save number flag */
bicl2 $N.SNG,(%s) /* clear single int */
bisw2 $N.FLT,(%s) /* mark floating */
clrq -(%s) /* init exponent */
movl r0,-(%s) /* save address */
bsbw conv /* get exponent */
movl (%s)+,r2
tstl (%s)+ /* ignore high part of exponent */
movl (%s)+,r0 /* get exponent */
movl (%s)+,r1 /* get old dpl */
subb2 r0,r1 /* subtract off exponent */
cvtwl r1,dpl(%u) /* put dpl back */
movl r2,-(%s) /* put addr back */
rsb
9: .word 9b-fdc3
9: .set fdc3,9b
.long 02530707470 /* CONVERT */
convert:
bsbw conv
bsbw fltest
rsb
X/* Compile the shortest possible instruction to put an integer on the stack */
_clrs: clrl -(%s)
9: .word 9b-fdcc
9: .set fdcc,9b
.long IM+011025204470 /* LITERAL */
lit: movl (%s)+,r0 /* get number */
bneq 1f /* zero? */
movw _clrs,(%h)+ /* compile clrl -(s) */
rsb
1: movzbl $(0x70+s),-(%s)
movl r0,-(%s) /* set up s -) xxx # operand */
movzbl $0x8f,-(%s)
tstl r0
blss 2f
movzbl r0,r1
cmpl r0,r1
jeql _movzbl /* compile _movzbl if adequate */
movzwl r0,r1
cmpl r0,r1
jeql _movzwl /* otherwise, compile _movzwl if adequate */
jbr _movl /* otherwise, compile _movl */
2: cmpl r0,$-64 /* is it small negative? */
bleq 3f /* no */
mnegl r0,4(%s) /* take absolute value */
jbr _mnegl /* and compile mnegl (will use literal mode)*/
3: cvtbl r0,r1
cmpl r0,r1
jeql _cvtbl /* compile cvtbl if adequate */
cvtwl r0,r1
cmpl r0,r1
jeql _cvtwl /* otherwise compile cvtwl if adequate */
jbr _movl /* otherwise compile _movl */
_clrqs: clrq -(%s)
X/* Compile double integer constant */
9: .word 9b-fdc2
9: .set fdc2,9b
.long IM+02520446300 /* 2LITERAL */
litq: movq (%s)+,r0
bneq 1f /* zero? */
movw _clrqs,(%h)+ /* yes, then compile clrq -(s) */
rsb
1: movzbl $0x70+s,-(%s)
movq r0,-(%s)
movzbl $0x8f,-(%s) /* set up s -) xxx # operands */
jbr _movq
_clrff: clrf -(%f)
X/* compile single precision floating Number */
9: .word 9b-fdc6
9: .set fdc6,9b
.long IM+02520446000 /* FLITERAL */
flit: tstf (%f) /* zero */
bneq 1f /* no */
tstf (%f)+
movw _clrff,(%h)+ /* yes, then compile clrf -(%f) */
rsb
1: movzbl $(0x70+f),-(%s)
movzbl $0x8f,-(%s) /* set up f -) xxx # operands */
jbr _movf
_clrfd: clrd -(%f)
X/* Compile double precision floating number */
9: .word 9b-fdc4
9: .set fdc4,9b
.long IM+02520446000 /* DLITERAL */
dlit: tstd (%f) /* zero? */
bneq 1f /* no */
tstd (%f)+
movw _clrfd,(%h)+ /* yes, then compile clrf -(%f) */
rsb
1: movzbl $(0x70+f),-(%f)
movzbl $0x8f,-(%s) /* set up f -) xxx # operands */
jbr _movd
X/* What Shall We do with a Number? */
cnmbr: subl3 %h,(%s)+,r0 /* delim loc - len of string */
decl r0
cmpb r0,(%h) /* cmp with actual len of string */
beql 1f /* error if less than */
movl $E.QUER,r0
jbr abort /* we got troubles */
1: bitw $N.FLT,dpl(%u) /* floating point? */
beql cmint /* no */
bsbw dabs
cvtld (%s)+,-(%f)
beql 2f
addw2 $0x1000,(%f) /* x 2**32 */
2: cvtld (%s)+,r3
bgeq 3f
addf2 $0x5080,r3
3: addd2 (%f)+,r3
cvtbd base(%u),r1 /* float base */
cvtbl dpl(%u),r0 /* get exponent */
beql cmflt /* zero? then no need to do anything */
bgeq 5f /* positive? */
4: muld2 r1,r3
aoblss $0,r0,4b
jbr cmflt
5: divd2 r1,r3
sobgtr r0,5b
cmflt: bitw $N.NEG,dpl(%u) /* Negative? */
beql 1f
mnegd r3,r3
1: bitw $N.DBL,dpl(%u) /* double precision? */
bneq cmdbl /* yes */
cvtdf r3,-(%f) /* move onto floating point stack */
jlbs state(%u),flit /* compile mode? */
rsb
cmdbl: movd r3,-(%f) /* move onto floating point stack */
jlbs state(%u),dlit /* compile mode? */
rsb
cmint: tstw dpl(%u) /* single? */
bgeq 1f /* no, leave double on the stack */
tstl (%s)+ /* if single, pop one. */
1: blbc state(%u),8f /* enough if execute mode */
tstw dpl(%u) /* single? */
jlss lit /* compile int */
jbr litq /* compile double int */
.byte 8f-0f
9: .word 9b-fdcf
9: .set fdcf,9b
.long INL+06005201450 /* OCTAL */
0: movl $8,base(%u)
8: rsb
.byte 8f-0f
9: .word 9b-fdc4
9: .set fdc4,9b
.long INL+06444142470 /* DECIMAL */
0: movl $10,base(%u)
8: rsb
.byte 8f-0f
9: .word 9b-fdc8
9: .set fdc8,9b
.long INL+020201402430 /* HEX */
0: movl $16,base(%u)
8: rsb
.byte 8f-0f
9: .word 9b-fdc2
9: .set fdc2,9b
.long INL+011004704460 /* BINARY */
0: movl $2,base(%u)
8: rsb
X/* =================================================================== */
X/* Error handling and System Reset Words */
9: .word 9b-fdc1
9: .set fdc1,9b
.long 020120452540 /* QUIT */
quit:
movl rbot(%u),%r /* reset return stack to bottom */
movl msgbuf0(%u),msgbuf(%u) /* reset msgbuf */
#ifdef COPROCESS
X/* Unlock Buffers */
movl darea(%u),r2 /* get buff descriptor */
movl (r2)+,r0 /* get buff */
movl (r2),r1 /* get buffer count */
1: cmpl own(r0),%u
bneq 2f
clrb lock(r0)
clrl own(r0)
2: movl (r0),r0
sobgtr r1,1b
#endif
clrl blk(%u) /* interpret from keyboard */
clrl in(%u) /* start at first byte */
movl quitadd(%u),r0
beql 6f
clrl quitadd(%u) /* clear to prevent recursive behavior */
subl2 $6,r0 /* go to code address */
jsb (r0) /* do it */
6: jbr newlin /* get new line and go to goloop */
9: .word 9b-fdcd
9: .set fdcd,9b
.long 0515142470 /* MESSAGE */
messag: movl (%s)+,r0 /* get message number */
movzbl msglen[r0],-(%r) /* get length of message */
movzwl msgstr[r0],-(%s) /* get location of message */
clrl -(%s)
movl msgfil,-(%s)
bsbw s_seek /* find message in file */
tstl (%s)+
blss 4f
movl %r,-(%s) /* stack contains count as 1st byte */
bsbw spush /* reserve space on string stack */
moval 1(%c),-(%s) /* address */
movl (%r)+,-(%s) /* recall count */
movl msgfil,-(%s) /* file descriptor */
bsbw s_read
tstl (%s)+
blss 6f
jbr sdot /* print it */
3: .ascii " Unable to seek on Message File!!!"
4: tstl (%r)+
moval 3b,-(%s)
movl $(4b-3b),-(%s)
brw type
5: .ascii " Unable to read Message File!!!"
6: bsbw sdrop
moval 5b,-(%s)
movl $(6b-5b),-(%s)
brw type
X/* Check for various error conditions before continuing compilation.*/
check:
cmpl %r,ssbot(%u) /* has r stack overflowed into string stack? */
bgtru 1f /* no */
movl $E.ROVER,r0
jbr abort
1:
cmpl %f,sbot(%u) /* has flt stack overflowed into param stack? */
bgtru 2f /* no */
movl $E.FOVER,r0
jbr abort
2:
cmpl %f,fsbot(%u) /* has flt stack underflowed. */
blequ 3f /* no */
movl $E.FEMPT,r0
jbr abort
3:
cmpl %s,sbot(%u) /* is stack pointer below bottom? */
blequ 4f /* no */
movl $E.SBOT,r0 /* yes, abort */
jbr abort
4:
movl $E.DFULL,r2 /* prepare message just in case. */
movl %h,r0
pushal goloop /* chksiz also used by ALLOT */
chksiz: moval FREESIZE(r0),r0 /* add allowed free area size */
cmpl r0,%s /* overflow into stack region? */
bgequ 5f /* yes */
bisl2 $01777,r0 /* round upward to next */
incl r0 /* even block */
cmpl r0,sbreak /* same as previous memory break? */
beql 7f /* yes, then done. */
movl r0,sbreak
pushl r0
X/*
* We must use the chmk rather than a call to the C _brk routine as the C
* brk routine maintains local variables that are incompatible with the forth
* environment
*/
pushl $1
movl %r,ap
#ifdef BSD4_2
# define SYS_brk 17 /* Grrrr... */
chmk $SYS_brk
#else
chmk $break
#endif
bcs 5f
addl2 $8,%r
7: rsb
5: movl r2,r0 /* get error msg. */
jbr abort
9: .word 9b-fdc1
9: .set fdc1,9b
.long 012074606050 /* ALLOT */
addl2 %h,(%s)
movl (%s),r0
movl $E.ADOVF,r2 /* prepare message */
bsbw chksiz
movl (%s)+,%h
rsb
X/* Signal handling. */
#ifdef FPROMPT
.align 1
ctrlz: .word 0x0000
movl owner,%u
bsbw treset
#ifdef BSD4_2
pushl $0
calls $1,_sigsetmask
#endif
calls $0,_getpid
pushl $18
pushl r0
calls $2,_kill /* process stops here */
pushal ctrlz
pushl $18
calls $2,_signal
ret
#endif
.align 1
ctrlc: .word 3
pushal ctrlc
pushl $2
clrl -(%s)
brb resig
.align 1
e.inst: .word 3
pushal e.inst
pushl $4
movl $E.INSTR,-(%s)
brb resig
.align 1
e.flt: .word 3
pushal e.flt
pushl $8
movl $E.FLT,-(%s)
brb resig
.align 1
e.bus: .word 3
pushal e.bus
pushl $10
movl $E.BUS,-(%s)
brb resig
.align 1
e.addr: .word 3
pushal e.addr
pushl $11
movl $E.ADDR,-(%s)
brb resig
.align 1
e.sarg: .word 3
pushal e.sarg
pushl $12
movl $E.SARG,-(%s)
/* fall into */
resig: calls $2,_signal
addl2 $32,%r
tabort: movc3 $80,(%r),trpad0 /* save stack frame for debugging */
#ifdef BSD4_2
pushl $0
calls $1,_sigsetmask
#endif
brb questn
9: .word 9b-fdc1
9: .set fdc1,9b
.long 012110741050 /* ABORT */
aabort: clrl r0
jbr abort
9: .word 9b-adc5
9: .set adc5,9b
.long 07511102560 /* UERROR (UNIX system call error) */
uerror: addl2 $U.ERR,r0 /* add offset into message table */
jbr abort
9: .word 9b-fdc1
9: .set fdc1,9b
.long 012114252500 /* QUESTION */
questn: movl (%s),r0 /* get message number */
abort:
movl owner,%u /* restore u */
movl rbot(%u),%r /* restore r */
movl sbot(%u),%s /* restore s */
movl fsbot(%u),%f /* restore floating point stack */
movl ssbot(%u),%c /* restore string stack */
movl typer0(%u),typer(%u) /* reset typer */
movl reader0(%u),reader(%u) /* reset reader */
clrl state(%u) /* reset to execution state */
movl $1,lcknt(%u) /* only one buffer locked */
movl blk(%u),(%s) /* save block number for later inspection. */
movl r0,-(%s) /* examine message number */
0: bgtr quest
mnegl (%s),(%s) /* if <0 don't print name of offender.*/
bgtr qarea
tstl (%s)+
brb pcr /* if zero print just <cr> */
quest: movl %h,-(%s)
bsbw count
bsbw type /* print name of offender */
qarea: bsbw messag
pcr: bsbw cr
brw quit
9: .word 9b-fdc8
9: .set fdc8,9b
.long 020201012430 /* HUP turn on signals */
hup: pushal ctrlc /* ^C */
pushl $2
bsbb signl
pushal e.inst
pushl $4
bsbb signl /* Illegal Instruction */
pushal e.flt
pushl $8
bsbb signl /* Floating point exception */
pushal e.bus
pushl $10
bsbb signl /* Bus Error */
pushal e.addr
pushl $11
bsbb signl /* Illegal Address */
pushal e.sarg
pushl $12
bsbb signl /* Error in System Call args. */
pushl $1
pushl $13
bsbb signl /* Write on broken pipe. */
#ifdef FPROMPT
pushal ctrlz
pushl $18
bsbb signl /* keyboard stop */
#endif
rsb
signl: movl (%r)+,r6
calls $2,_signal
jmp (r6)
9: .word 9b-fdce
9: .set fdce,9b
.long 010124407450 /* NOHUP turn off signals */
nohup: pushl $1
pushl $2
bsbb signl /* ^C */
rsb
X/* ========================================================================== */
X/* Various System Constants */
9: .word 9b-fdcf
9: .set fdcf,9b
.long 0510250000 /* OPERATOR */
moval user,-(%s)
rsb
9: .word 9b-fdc4
9: .set fdc4,9b
.long 020201007530 /* TOP */
movl utop,-(%s)
rsb
9: .word 9b-fdc5
9: .set fdc5,9b
.long 011045307050 /* ENVIR loc of environment strings */
movl envir,-(%s)
rsb
9: .word 9b-fdc5
9: .set fdc5,9b
.long 02550451550 /* USIZE size of user area */
movl $usiz,-(%s)
rsb
9: .word 9b-fdcd
9: .set fdcd,9b
.long 04430351460 /* MSGFIL */
movl msgfil,-(%s)
rsb
.byte 8f-0f
9: .word 9b-fdc5
9: .set fdc5,9b
.long INL+020111102540 /* UERR */
0: movl $U.ERR,-(%s)
8: rsb
9: .word 9b-fdc4
9: .set fdc4,9b
.long 02005011160 /* TRPADD */
moval trpadd,-(%s)
rsb
9: .word 9b-fdc6
9: .set fdc6,9b
.long 020201400530 /* VAX */
0: bsbw stri
.ascii "\003vax"
rsb
9: .word 9b-fdcd
9: .set fdcd,9b
.long 020040140440 /* MACH */
brb 0b
9: .word 9b-fdc6
9: .set fdc6,9b
.long 020110442040 /* FDIR */
bsbw stri
.byte 8f-0f
0: .ascii FDIR
8: rsb
#ifdef BSD4_2
9: .word 9b-fdc4
9: .set fdc4,9b
.long IM+011413127360 /* 4.2BSD */
#endif
X/* ======================================================================== */
X/* Assembler Dictionary (Resident Assembler) */
.set OP_MASK,1
.set OP_BOFF,2
.set OP_WOFF,3
.set OP_BYTE,4
.set OP_WORD,5
.set OP_LONG,6
.set OP_QUAD,7
.set OP_FLT,8
.set OP_DBL,9
.set OP_OCT,10
.set OP_GFLT,11
.set OP_HFLT,12
9: .word 9b-adcf
9: .set adcf,9b
.long 020202010020 /* OP assemble a VAX instruction */
bsbw create
cvtlb (%s)+,(%h)+
1: cvtlb (%s)+,(%h)+ /* compile into parameter byte string */
bneq 1b /* null byte ends string */
bsbw semcod
op: movl (%r)+,r6 /* get parameter */
oploop: movzbl (r6)+,r5 /* get param */
bneq 0f /* end of params */
rsb /* yes, return */
0: cmpb r5,$OP_MASK /* mask operand? */
bneq 1f
cvtlw (%s)+,(%h)+ /* compile directly */
brb oploop
1: cmpb r5,$13 /* opcode? */
blssu 2f
movb r5,(%h)+ /* compile 2nd byte of 2 byte opcode */
brb oploop
2: cmpb r5,$OP_BYTE
blssu 3f
bsbb opcod /* handle normal operand */
brb oploop
3: subl3 %h,(%s)+,r0 /* handle displacement operand */
decl r0
cmpb r5,$OP_BOFF /* byte displacement? */
bneq 4f
movb r0,(%h)+ /* compile byte displacement */
brb oploop
4: subw3 $1,r0,(%h)+ /* compile word displacement */
brb oploop
opcod: movl (%s)+,r0
cmpl r0,$0xff /* address? */
blequ 1f
tstl -(%s) /* if address, back up */
movzbl $0xAF,r0 /* and compile byte relative (if possible) */
1: movb r0,(%h)+ /* compile operand code */
cmpb r0,$0xA0 /* relative? */
bgequ oprel
cmpb r0,$0x10
bgequ 2f
addb2 $0x50,-1(%h) /* convert to register mode */
2: cmpv $4,$4,r0,$4 /* indexed? */
bneq 3f
decl r6 /* back up operand pointer */
rsb
3: cmpb r0,$0x9f /* absolute? */
bneq 4f
movl (%s)+,(%h)+ /* compile absolute */
rsb
4: cmpb r0,$0x8f /* immediate? */
beql opcon /* compile immediate */
rsb
oprel: clrl r2
cmpzv $0,$4,r0,$0xf /* relative mode? */
bneq by
subl2 %h,(%s) /* if relative, compute displacement */
decl (%s)
incl r2 /* flag it */
by: cvtbl (%s),r1
cmpl r1,(%s) /* does it fit within byte? */
bneq wo
cvtlb (%s)+,(%h)+ /* compile byte */
rsb
wo: addb2 $0x20,-1(%h) /* convert to word indexed */
blbc r2,1f /* relative? */
decl (%s) /* account for extra displacement byte */
1: cvtwl (%s),r1 /* does it fit within word? */
cmpl r1,(%s)
bneq lo
cvtlw (%s)+,(%h)+ /* compile word */
rsb
lo: addb2 $0x20,-1(%h) /* convert to long relative */
blbc r2,1f /* relative? */
subl3 $2,(%s)+,(%h)+ /* account for 2 more bytes in displacement */
rsb
1: movl (%s)+,(%h)+ /* compile long */
rsb
opcon: caseb r5,$OP_BYTE,$OP_DBL
1: .word bycon-1b
.word wocon-1b
.word locon-1b
.word qucon-1b
.word flcon-1b
.word dbcon-1b
bycon: cvtlb (%s)+,r1
bsbb tslit
movb r1,(%h)+ /* compile byte constant */
rsb
wocon: cvtlw (%s)+,r1
bsbb tslit
movw r1,(%h)+ /* compile word constant */
rsb
locon: movl (%s)+,r1
bsbb tslit
movl r1,(%h)+ /* compile long constant */
rsb
qucon: movq (%s)+,r1
tstl r2 /* anything in upper part? */
bneq 1f
bsbb tslit
1: movq r1,(%h)+ /* compile quad constant */
rsb
flcon: movf (%f)+,r1
bsbb ftslit
movf r1,(%h)+ /* compile flt constant */
rsb
dbcon: movd (%f)+,r1
tstl r2 /* anything in low precision part? */
bneq 1f
bsbb ftslit
1: movd r1,(%h)+
rsb
tslit: cmpl r1,$63 /* within range for literal mode */
bgtru 1f
movb r1,-1(%h) /* compile literal mode */
tstl (%r)+ /* don't return */
1: rsb
ftslit: bicl3 $0x03f0,r1,r0 /* isolate bits which must 0x4000 */
cmpl r0,$0x4000 /* is it a possible flt literal */
bneq 1f
extzv $4,$6,r1,r0 /* extract relevant bits */
movb r0,-1(%h) /* and compile them */
tstl (%r)+ /* don't return (we're done) */
1: rsb
X/* Register Names */
9: .word 9b-adc5
9: .set adc5,9b
.long 020202020110 /* U (points to current user area) */
movl $7,-(%s)
rsb
9: .word 9b-adc8
9: .set adc8,9b
.long 020202020010 /* H (points to beginning of free area) */
movl $8,-(%s)
rsb
9: .word 9b-adc3
9: .set adc3,9b
.long 020202020010 /* C (points to top of string stack) */
movl $9,-(%s)
rsb
9: .word 9b-adc6
9: .set adc6,9b
.long 020202020010 /* F (points to top of floating point stack) */
movl $10,-(%s)
rsb
9: .word 9b-adc3
9: .set adc3,9b
.long 020202020110 /* S (points to top of parameter stack) */
movl $11,-(%s)
rsb
9: .word 9b-adc2
9: .set adc2,9b
.long 020202020110 /* R (points to top of return stack) */
movl $14,-(%s)
rsb
X/* Addressing Modes */
9: .word 9b-adc9
9: .set adc9,9b
.long 020202020210 /* ) */
cmpl (%s),$0xf
bgtru 1f
bisb2 $0x60,(%s) /* convert to register deferred mode */
rsb
1: cmpl (%s),$0xff
blequ 2f
movzbl $0xbf,-(%s) /* convert addr to relative deferred */
rsb
2: addb2 $0x10,(%s)
rsb
9: .word 9b-adc9
9: .set adc9,9b
.long 020202025620 /* )+ */
addb2 $0x80,(%s)
rsb
9: .word 9b-adcd
9: .set adcd,9b
.long 020202024620 /* -) */
addb2 $0x70,(%s)
rsb
9: .word 9b-adcd
9: .set adcd,9b
.long 020202020110 /* ] */
addb2 $0x40,(%s)
rsb
9: .word 9b-adc9
9: .set adc9,9b
.long 020202024620 /* )) */
addb2 $0xa0,(%s)
rsb
9: .word 9b-adc3
9: .set adc3,9b
.long 020202020210 /* # (immediate mode) */
movl $0x8f,-(%s)
rsb
9: .word 9b-adc0
9: .set adc0,9b
.long 020202021420 /* @# (absolute mode) */
movl $0x9f,-(%s)
rsb
9: .word 9b-adc2
9: .set adc2,9b
.long 020202024520 /* R) (relative mode -- default) */
movl $0xaf,-(%s)
rsb
X/* Instruction Set */
9: .word 9b-adc2
9: .set adc2,9b
.long 020200442530 /* REI */
movb $2,(%h)+
rsb
9: .word 9b-adc2
9: .set adc2,9b
.long 020201202530 /* RET */
movb $4,(%h)+
rsb
9: .word 9b-adc2
9: .set adc2,9b
.long 020200111530 /* RSB */
movb $5,(%h)+
rsb
9: .word 9b-adc9
9: .set adc9,9b
.long 014024207050 /* INDEX */
bsbw op
.byte 0x0a,OP_LONG,OP_LONG,OP_LONG,OP_LONG,OP_LONG,OP_LONG,0
9: .word 9b-adc3
9: .set adc3,9b
.long 0020200151030 /* CRC */
bsbw op
.byte 0x0b,OP_LONG,OP_LONG,OP_WORD,OP_LONG,0
9: .word 9b-adc9
9: .set adc9,9b
.long 012505147060 /* INSQUE */
bsbw op
.byte 0x0e,OP_LONG,OP_LONG,0
9: .word 9b-adc2
9: .set adc2,9b
.long 0012504642560 /* REMQUE */
bsbw op
.byte 0x0f,OP_LONG,OP_LONG,0
9: .word 9b-adca
9: .set adca,9b
.long 0020200111430 /* JSB */
bsbw op
.byte 0x16,OP_LONG,0
9: .word 9b-adca
9: .set adca,9b
.long 020201006430 /* JMP */
bsbw op
.byte 0x17,OP_LONG,0
9: .word 9b-adcd
9: .set adcd,9b
.long 031415307450 /* MOVC3 */
bsbw op
.byte 0x28,OP_WORD,OP_LONG,OP_LONG,0
9: .word 9b-adc3
9: .set adc3,9b
.long 031415006450 /* CMPC3 */
bsbw op
.byte 0x29,OP_WORD,OP_LONG,OP_LONG,0
9: .word 9b-adc3
9: .set adc3,9b
.long 01470041550 /* SCANC */
bsbw op
.byte 0x2a,OP_WORD,OP_LONG,OP_LONG,OP_BYTE,0
9: .word 9b-adc3
9: .set adc3,9b
.long 01470050150 /* SPANC */
bsbw op
.byte 0x2b,OP_WORD,OP_LONG,OP_LONG,OP_BYTE,0
9: .word 9b-adcd
9: .set adcd,9b
.long 032415307450 /* MOVC5 */
bsbw op
.byte 0x2c,OP_WORD,OP_LONG,OP_BYTE,OP_WORD,OP_LONG,0
9: .word 9b-adc3
9: .set adc3,9b
.long 032415006450 /* CMPC5 */
bsbw op
.byte 0x2d,OP_WORD,OP_LONG,OP_BYTE,OP_WORD,OP_LONG,0
9: .word 9b-adcd
9: .set adcd,9b
.long 01521307450 /* MOVTC */
bsbw op
.byte 0x2e,OP_WORD,OP_LONG,OP_BYTE,OP_LONG,OP_WORD,OP_LONG,0
9: .word 9b-adcd
9: .set adcd,9b
.long 012521307460 /* MOVTUC */
bsbw op
.byte 0x2F,OP_WORD,OP_LONG,OP_BYTE,OP_LONG,OP_WORD,OP_LONG,0
9: .word 9b-adc3
9: .set adc3,9b
.long 06135213050 /* CVTWL */
_cvtwl: bsbw op
.byte 0x32,OP_WORD,OP_LONG,0
9: .word 9b-adc3
9: .set adc3,9b
.long 01135213050 /* CVTWB */
bsbw op
.byte 0x33,OP_WORD,OP_BYTE,0
9: .word 9b-adcd
9: .set adcd,9b
.long 04015200460 /* MATCHC */
bsbw op
.byte 0x39,OP_WORD,OP_LONG,OP_WORD,OP_LONG,0
9: .word 9b-adcc
9: .set adcc,9b
.long 020014147440 /* LOCC */
bsbw op
.byte 0x3a,OP_BYTE,OP_WORD,OP_LONG,0
9: .word 9b-adc3
9: .set adc3,9b
.long 020015005540 /* SKPC */
bsbw op
.byte 0x3b,OP_BYTE,OP_WORD,OP_LONG,0
9: .word 9b-adcd
9: .set adcd,9b
.long 06135513050 /* MVZWL */
_movzwl:
bsbw op
.byte 0x3c,OP_WORD,OP_LONG,0
9: .word 9b-adc1
9: .set adc1,9b
.long 020134101440 /* ACBW */
bsbw op
.byte 0x3d,OP_WORD,OP_WORD,OP_WORD,OP_WOFF,0
9: .word 9b-adcd
9: .set adcd,9b
.long 013405307450 /* MOVAW */
bsbw op
.byte 0x3e,OP_WORD,OP_LONG,0
9: .word 9b-adc0
9: .set adc0,9b
.long 013405152550 /* PUSAW */
bsbw op
.byte 0x3f,OP_WORD,0
9: .word 9b-adc1
9: .set adc1,9b
.long 031030202050 /* ADDF2 */
bsbw op
.byte 0x40,OP_FLT,OP_FLT,0
9: .word 9b-adc1
9: .set adc1,9b
.long 031430202050 /* ADDF3 */
bsbw op
.byte 0x41,OP_FLT,OP_FLT,OP_FLT,0
9: .word 9b-adc3
9: .set adc3,9b
.long 031030112550 /* SUBF2 */
bsbw op
.byte 0x42,OP_FLT,OP_FLT,0
9: .word 9b-adc3
9: .set adc3,9b
.long 031430112550 /* SUBF3 */
bsbw op
.byte 0x43,OP_FLT,OP_FLT,OP_FLT,0
9: .word 9b-adcd
9: .set adcd,9b
.long 031030612450 /* MULF2 */
bsbw op
.byte 0x44,OP_FLT,OP_FLT,0
9: .word 9b-adcd
9: .set adcd,9b
.long 031430612450 /* MULF3 */
bsbw op
.byte 0x45,OP_FLT,OP_FLT,OP_FLT,0
9: .word 9b-adc4
9: .set adc4,9b
.long 031031304450 /* DIVF2 */
bsbw op
.byte 0x46,OP_FLT,OP_FLT,0
9: .word 9b-adc4
9: .set adc4,9b
.long 031431304450 /* DIVF3 */
bsbw op
.byte 0x47,OP_FLT,OP_FLT,OP_FLT,0
9: .word 9b-adc3
9: .set adc3,9b
.long 01031213050 /* CVTFB */
bsbw op
.byte 0x48,OP_FLT,OP_BYTE,0
9: .word 9b-adc3
9: .set adc3,9b
.long 013431213050 /* CVTFW */
bsbw op
.byte 0x49,OP_FLT,OP_WORD,0
9: .word 9b-adc3
9: .set adc3,9b
.long 06031213050 /* CVTFL */
bsbw op
.byte 0x4a,OP_FLT,OP_LONG,0
9: .word 9b-adc3
9: .set adc3,9b
.long 03111213060 /* CVTRFL */
bsbw op
.byte 0x4b,OP_FLT,OP_LONG,0
9: .word 9b-adc4
9: .set adc4,9b
.long 031431304450 /* DIVF3 */
bsbw op
.byte 0x47,OP_FLT,OP_FLT,OP_FLT,0
9: .word 9b-adc3
9: .set adc3,9b
.long 03011213050 /* CVTBF */
bsbw op
.byte 0x4c,OP_BYTE,OP_FLT,0
9: .word 9b-adc3
9: .set adc3,9b
.long 03135213050 /* CVTWF */
bsbw op
.byte 0x4d,OP_WORD,OP_FLT,0
9: .word 9b-adc4
9: .set adc4,9b
.long 031431304450 /* DIVF3 */
bsbw op
.byte 0x47,OP_FLT,OP_FLT,OP_FLT,0
9: .word 9b-adc3
9: .set adc3,9b
.long 03061213050 /* CVTLF */
bsbw op
.byte 0x4e,OP_LONG,OP_FLT,0
9: .word 9b-adc4
9: .set adc4,9b
.long 031431304450 /* DIVF3 */
bsbw op
.byte 0x47,OP_FLT,OP_FLT,OP_FLT,0
9: .word 9b-adc1
9: .set adc1,9b
.long 020030101440 /* ACBF */
bsbw op
.byte 0x4f,OP_FLT,OP_FLT,OP_FLT,OP_WOFF,0
9: .word 9b-adcd
9: .set adcd,9b
.long 020031307440 /* MOVF */
_movf: bsbw op
.byte 0x50,OP_FLT,OP_FLT,0
9: .word 9b-adc3
9: .set adc3,9b
.long 020031006440 /* CMPF */
bsbw op
.byte 0x51,OP_FLT,OP_FLT,0
9: .word 9b-adcd
9: .set adcd,9b
.long 03034247050 /* MNEGF */
bsbw op
.byte 0x52,OP_FLT,OP_FLT,0
9: .word 9b-adc4
9: .set adc4,9b
.long 020031211540 /* TSTF */
bsbw op
.byte 0x53,OP_FLT,0
9: .word 9b-adc5
9: .set adc5,9b
.long 03020746450 /* EMODF */
bsbw op
.byte 0x54,OP_FLT,OP_BYTE,OP_FLT,OP_LONG,OP_FLT,0
9: .word 9b-adc0
9: .set adc0,9b
.long 03144607550 /* POLYF */
bsbw op
.byte 0x55,OP_FLT,OP_WORD,OP_BYTE
9: .word 9b-adc3
9: .set adc3,9b
.long 02031213050 /* CVTFD */
bsbw op
.byte 0x56,OP_FLT,OP_DBL,0
9: .word 9b-adcd
9: .set adcd,9b
.long 020021307440 /* MOVD */
_movd: bsbw op
.byte 0x70,OP_DBL,OP_DBL,0
9: .word 9b-adc1
9: .set adc1,9b
.long 020060411440 /* ASHL */
bsbw op
.byte 0x78,OP_BYTE,OP_LONG,OP_LONG,0
9: .word 9b-adc1
9: .set adc1,9b
.long 020104411440 /* ASHQ */
bsbw op
.byte 0x79,OP_BYTE,OP_QUAD,OP_QUAD,0
9: .word 9b-adc5
9: .set adc5,9b
.long 020061246440 /* EMUL */
bsbw op
.byte 0x7a,OP_LONG,OP_LONG,OP_LONG,OP_QUAD,0
9: .word 9b-adc5
9: .set adc5,9b
.long 020130442040 /* EDIV */
bsbw op
.byte 0x7b,OP_LONG,OP_QUAD,OP_LONG,OP_LONG,0
9: .word 9b-adc3
9: .set adc3,9b
.long 020105106040 /* CLRQ */
bsbw op
.byte 0x7c,OP_QUAD,0
9: .word 9b-adcd
9: .set adcd,9b
.long 020105307440 /* MOVQ */
_movq: bsbw op
.byte 0x7d,OP_QUAD,OP_QUAD,0
9: .word 9b-adcd
9: .set adcd,9b
.long 010405307450 /* MOVAQ */
bsbw op
.byte 0x7e,OP_QUAD,OP_LONG,0
9: .word 9b-adc0
9: .set adc0,9b
.long 010405152550 /* PUSAQ */
bsbw op
.byte 0x7f,OP_QUAD,0
9: .word 9b-adc1
9: .set adc1,9b
.long 031010202050 /* ADDB2 */
bsbw op
.byte 0x80,OP_BYTE,OP_BYTE,0
9: .word 9b-adc1
9: .set adc1,9b
.long 031410202050 /* ADBB3 */
bsbw op
.byte 0x81,OP_BYTE,OP_BYTE,OP_BYTE,0
9: .word 9b-adc3
9: .set adc3,9b
.long 031010112550 /* SUBB2 */
bsbw op
.byte 0x82,OP_BYTE,OP_BYTE,0
9: .word 9b-adc3
9: .set adc3,9b
.long 031410112550 /* SUBB3 */
bsbw op
.byte 0x83,OP_BYTE,OP_BYTE,OP_BYTE,0
9: .word 9b-adcd
9: .set adcd,9b
.long 031010612450 /* MULB2 */
bsbw op
.byte 0x84,OP_BYTE,OP_BYTE,0
9: .word 9b-adcd
9: .set adcd,9b
.long 031410612450 /* MULB3 */
bsbw op
.byte 0x85,OP_BYTE,OP_BYTE,OP_BYTE,0
9: .word 9b-adc4
9: .set adc4,9b
.long 031011304450 /* DIVB2 */
bsbw op
.byte 0x86,OP_BYTE,OP_BYTE,0
9: .word 9b-adc4
9: .set adc4,9b
.long 031411304450 /* DIVB3 */
bsbw op
.byte 0x87,OP_BYTE,OP_BYTE,OP_BYTE,0
9: .word 9b-adc2
9: .set adc2,9b
.long 031011144450 /* BISB2 */
bsbw op
.byte 0x88,OP_BYTE,OP_BYTE,0
9: .word 9b-adc2
9: .set adc2,9b
.long 031411144450 /* BISB3 */
bsbw op
.byte 0x89,OP_BYTE,OP_BYTE,OP_BYTE,0
9: .word 9b-adc2
9: .set adc2,9b
.long 031010144450 /* BICB2 */
bsbw op
.byte 0x8a,OP_BYTE,OP_BYTE,0
9: .word 9b-adc2
9: .set adc2,9b
.long 031410144450 /* BICB3 */
bsbw op
.byte 0x8b,OP_BYTE,OP_BYTE,OP_BYTE,0
9: .word 9b-adc8
9: .set adc8,9b
.long 031011107550 /* XORB2 */
bsbw op
.byte 0x8c,OP_BYTE,OP_BYTE,0
9: .word 9b-adc8
9: .set adc8,9b
.long 031411107550 /* XORB3 */
bsbw op
.byte 0x8d,OP_BYTE,OP_BYTE,OP_BYTE,0
9: .word 9b-adcd
9: .set adcd,9b
.long 01034247050 /* MNEGB */
bsbw op
.byte 0x8e,OP_BYTE,OP_BYTE,0
9: .word 9b-adc3
9: .set adc3,9b
.long 01025140450 /* CASEB */
bsbw op
.byte 0x8f,OP_BYTE,OP_BYTE,OP_BYTE,0
9: .word 9b-adcd
9: .set adcd,9b
.long 020011307440 /* MOVB */
bsbw op
.byte 0x90,OP_BYTE,OP_BYTE,0
9: .word 9b-adc3
9: .set adc3,9b
.long 020011006440 /* CMPB */
bsbw op
.byte 0x91,OP_BYTE,OP_BYTE,0
9: .word 9b-adcd
9: .set adcd,9b
.long 01064741450 /* MCOMB */
bsbw op
.byte 0x92,OP_BYTE,OP_BYTE,0
9: .word 9b-adc2
9: .set adc2,9b
.long 020011204440 /* BITB */
bsbw op
.byte 0x93,OP_BYTE,OP_BYTE,0
9: .word 9b-adc3
9: .set adc3,9b
.long 020011106040 /* CMPB */
bsbw op
.byte 0x94,OP_BYTE,0
9: .word 9b-adc4
9: .set adc4,9b
.long 020011211540 /* TSTB */
bsbw op
.byte 0x95,OP_BYTE,0
9: .word 9b-adc9
9: .set adc9,9b
.long 020010147040 /* INCB */
bsbw op
.byte 0x96,OP_BYTE,0
9: .word 9b-adc4
9: .set adc4,9b
.long 020010142440 /* DECB */
bsbw op
.byte 0x97,OP_BYTE,0
9: .word 9b-adc3
9: .set adc3,9b
.long 06011213050 /* CVTBL */
_cvtbl: bsbw op
.byte 0x98,OP_BYTE,OP_LONG,0
9: .word 9b-adc3
9: .set adc3,9b
.long 013411213050 /* CVTBW */
_cvtbw: bsbw op
.byte 0x99,OP_BYTE,OP_WORD,0
9: .word 9b-adcd
9: .set adcd,9b
.long 06011513050 /* MVZBL */
_movzbl:
bsbw op
.byte 0x9a,OP_BYTE,OP_LONG,0
9: .word 9b-adcd
9: .set adcd,9b
.long 013411513050 /* MVZBW */
_movzbw:
bsbw op
.byte 0x9b,OP_BYTE,OP_WORD,0
9: .word 9b-adc2
9: .set adc2,9b
.long 020061207540 /* ROTL */
bsbw op
.byte 0x9c,OP_BYTE,OP_LONG,OP_LONG,0
9: .word 9b-adc1
9: .set adc1,9b
.long 020010101440 /* ACBB */
bsbw op
.byte 0x9d,OP_BYTE,OP_BYTE,OP_BYTE,OP_WOFF,0
9: .word 9b-adcd
9: .set adcd,9b
.long 01005307450 /* MOVAB */
bsbw op
.byte 0x9e,OP_BYTE,OP_LONG,0
9: .word 9b-adc0
9: .set adc0,9b
.long 01005152550 /* PUSAB */
bsbw op
.byte 0x9f,OP_BYTE,0
9: .word 9b-adc1
9: .set adc1,9b
.long 031134202050 /* ADDW2 */
bsbw op
.byte 0xa0,OP_WORD,OP_WORD,0
9: .word 9b-adc1
9: .set adc1,9b
.long 031534202050 /* ADDW3 */
bsbw op
.byte 0xa1,OP_WORD,OP_WORD,OP_WORD,0
9: .word 9b-adc3
9: .set adc3,9b
.long 031134112550 /* SUBW2 */
bsbw op
.byte 0xa2,OP_WORD,OP_WORD,0
9: .word 9b-adc3
9: .set adc3,9b
.long 031534112550 /* SUBW3 */
bsbw op
.byte 0xa3,OP_WORD,OP_WORD,OP_WORD,0
9: .word 9b-adcd
9: .set adcd,9b
.long 031134612450 /* MULW2 */
bsbw op
.byte 0xa4,OP_WORD,OP_WORD,0
9: .word 9b-adcd
9: .set adcd,9b
.long 031534612450 /* MULW3 */
bsbw op
.byte 0xa5,OP_WORD,OP_WORD,OP_WORD,0
9: .word 9b-adc4
9: .set adc4,9b
.long 031135304450 /* DIVW2 */
bsbw op
.byte 0xa6,OP_WORD,OP_WORD,0
9: .word 9b-adc4
9: .set adc4,9b
.long 031535304450 /* DIVW3 */
bsbw op
.byte 0xa7,OP_WORD,OP_WORD,OP_WORD,0
9: .word 9b-adc2
9: .set adc2,9b
.long 031135144450 /* BISW2 */
bsbw op
.byte 0xa8,OP_WORD,OP_WORD,0
9: .word 9b-adc2
9: .set adc2,9b
.long 031535144450 /* BISW3 */
bsbw op
.byte 0xa9,OP_WORD,OP_WORD,OP_WORD,0
9: .word 9b-adc2
9: .set adc2,9b
.long 031134144450 /* BICW2 */
bsbw op
.byte 0xaa,OP_WORD,OP_WORD,0
9: .word 9b-adc2
9: .set adc2,9b
.long 031534144450 /* BICW3 */
bsbw op
.byte 0xab,OP_WORD,OP_WORD,OP_WORD,0
9: .word 9b-adc8
9: .set adc8,9b
.long 031135107550 /* XORW2 */
bsbw op
.byte 0xac,OP_WORD,OP_WORD,0
9: .word 9b-adc8
9: .set adc8,9b
.long 031535107550 /* XORW3 */
bsbw op
.byte 0xad,OP_WORD,OP_WORD,OP_WORD,0
9: .word 9b-adcd
9: .set adcd,9b
.long 013434247050 /* MNEGW */
bsbw op
.byte 0x0ae,OP_WORD,OP_WORD,0
9: .word 9b-adc3
9: .set adc3,9b
.long 013425140450 /* CASEW */
bsbw op
.byte 0xaf,OP_WORD,OP_WORD,OP_WORD,0
9: .word 9b-adcd
9: .set adcd,9b
.long 020135307440 /* MOVW */
bsbw op
.byte 0xb0,OP_WORD,OP_WORD,0
9: .word 9b-adc3
9: .set adc3,9b
.long 020135006440 /* CMPW */
bsbw op
.byte 0xb1,OP_WORD,OP_WORD,0
9: .word 9b-adcd
9: .set adcd,9b
.long 013464741450 /* MCOMW */
bsbw op
.byte 0xb2,OP_WORD,OP_WORD,0
9: .word 9b-adc2
9: .set adc2,9b
.long 020135204440 /* BITW */
bsbw op
.byte 0xb3,OP_WORD,OP_WORD,0
9: .word 9b-adc3
9: .set adc3,9b
.long 020135106040 /* CLRW */
bsbw op
.byte 0xb4,OP_WORD,0
9: .word 9b-adc4
9: .set adc4,9b
.long 020135211540 /* TSTW */
bsbw op
.byte 0xb5,OP_WORD,0
9: .word 9b-adc9
9: .set adc9,9b
.long 020134147040 /* INCW */
bsbw op
.byte 0xb6,OP_WORD,0
9: .word 9b-adc4
9: .set adc4,9b
.long 020134142440 /* DECW */
bsbw op
.byte 0xb7,OP_WORD,0
9: .word 9b-adc2
9: .set adc2,9b
.long 011501144460 /* BISPSW */
bsbw op
.byte 0xb8,OP_MASK,0
9: .word 9b-adc2
9: .set adc2,9b
.long 011500144460 /* BICPSW */
bsbw op
.byte 0xb9,OP_MASK,0
9: .word 9b-adc0
9: .set adc0,9b
.long 020111007540 /* POPR */
bsbw op
.byte 0xba,OP_MASK,0
9: .word 9b-adc0
9: .set adc0,9b
.long 011041152550 /* PUSHR */
bsbw op
.byte 0xbb,OP_MASK,0
9: .word 9b-adc3
9: .set adc3,9b
.long 020054644040 /* CHMK */
bsbw op
.byte 0xbc,OP_MASK,0
9: .word 9b-adc1
9: .set adc1,9b
.long 031060202050 /* ADDL2 */
bsbw op
.byte 0xc0,OP_LONG,OP_LONG,0
9: .word 9b-adc1
9: .set adc1,9b
.long 031460202050 /* ADDL3 */
bsbw op
.byte 0xc1,OP_LONG,OP_LONG,OP_LONG,0
9: .word 9b-adc3
9: .set adc3,9b
.long 031060112550 /* SUBL2 */
bsbw op
.byte 0xc2,OP_LONG,OP_LONG,0
9: .word 9b-adc3
9: .set adc3,9b
.long 031460112550 /* SUBL3 */
bsbw op
.byte 0xc3,OP_LONG,OP_LONG,OP_LONG,0
9: .word 9b-adcd
9: .set adcd,9b
.long 031060612450 /* MULL2 */
bsbw op
.byte 0xc4,OP_LONG,OP_LONG,0
9: .word 9b-adcd
9: .set adcd,9b
.long 031460612450 /* MULL3 */
bsbw op
.byte 0xc5,OP_LONG,OP_LONG,OP_LONG,0
9: .word 9b-adc4
9: .set adc4,9b
.long 031061304450 /* DIVL2 */
bsbw op
.byte 0xc6,OP_LONG,OP_LONG,0
9: .word 9b-adc4
9: .set adc4,9b
.long 031461304450 /* DIVL3 */
bsbw op
.byte 0xc7,OP_LONG,OP_LONG,OP_LONG,0
9: .word 9b-adc2
9: .set adc2,9b
.long 031061144450 /* BISL2 */
bsbw op
.byte 0xc8,OP_LONG,OP_LONG,0
9: .word 9b-adc2
9: .set adc2,9b
.long 031461144450 /* BISL3 */
bsbw op
.byte 0xc9,OP_LONG,OP_LONG,OP_LONG,0
9: .word 9b-adc2
9: .set adc2,9b
.long 031060144450 /* BICL2 */
bsbw op
.byte 0xca,OP_LONG,OP_LONG,0
9: .word 9b-adc2
9: .set adc2,9b
.long 031460144450 /* BICL3 */
bsbw op
.byte 0xcb,OP_LONG,OP_LONG,OP_LONG,0
9: .word 9b-adc8
9: .set adc8,9b
.long 031061107550 /* XORL2 */
bsbw op
.byte 0xcc,OP_LONG,OP_LONG,0
9: .word 9b-adc8
9: .set adc8,9b
.long 031461107550 /* XORL3 */
bsbw op
.byte 0xcd,OP_LONG,OP_LONG,OP_LONG,0
9: .word 9b-adcd
9: .set adcd,9b
.long 06034247050 /* MNEGL */
_mnegl: bsbw op
.byte 0xce,OP_LONG,OP_LONG,0
9: .word 9b-adc3
9: .set adc3,9b
.long 06025140450 /* CASEL */
bsbw op
.byte 0xcf,OP_LONG,OP_LONG,OP_LONG,0
9: .word 9b-adcd
9: .set adcd,9b
.long 020061307440 /* MOVL */
_movl: bsbw op
.byte 0xd0,OP_LONG,OP_LONG,0
9: .word 9b-adc3
9: .set adc3,9b
.long 020061006440 /* CMPL */
bsbw op
.byte 0xd1,OP_LONG,OP_LONG,0
9: .word 9b-adcd
9: .set adcd,9b
.long 06064741450 /* MCOML */
bsbw op
.byte 0xd2,OP_LONG,OP_LONG,0
9: .word 9b-adc2
9: .set adc2,9b
.long 020061204440 /* BITL */
bsbw op
.byte 0xd3,OP_LONG,OP_LONG,0
9: .word 9b-adc3
9: .set adc3,9b
.long 020061106040 /* CLRL */
bsbw op
.byte 0xd4,OP_LONG,0
9: .word 9b-adc4
9: .set adc4,9b
.long 020061211540 /* TSTL */
bsbw op
.byte 0xd5,OP_LONG,0
9: .word 9b-adc9
9: .set adc9,9b
.long 020060147040 /* INCL */
bsbw op
.byte 0xd6,OP_LONG,0
9: .word 9b-adc4
9: .set adc4,9b
.long 020060142440 /* DECL */
bsbw op
.byte 0xd7,OP_LONG,0
9: .word 9b-adc1
9: .set adc1,9b
.long 020015342040 /* ADWC */
bsbw op
.byte 0xd8,OP_LONG,OP_LONG,0
9: .word 9b-adc3
9: .set adc3,9b
.long 020015341140 /* SBWC */
bsbw op
.byte 0xd9,OP_LONG,OP_LONG,0
9: .word 9b-adcd
9: .set adcd,9b
.long 011501307460 /* MOVPSL */
bsbw op
.byte 0xdc,OP_LONG,0
9: .word 9b-adc0
9: .set adc0,9b
.long 06041152550 /* PUSHL */
bsbw op
.byte 0xdd,OP_LONG,0
9: .word 9b-adcd
9: .set adcd,9b
.long 06005307450 /* MOVAL */
bsbw op
.byte 0xde,OP_LONG,OP_LONG,0
9: .word 9b-adc0
9: .set adc0,9b
.long 06005152550 /* PUSAL */
bsbw op
.byte 0xdf,OP_LONG,0
9: .word 9b-adc2
9: .set adc2,9b
.long 020201141030 /* BBS */
bsbw op
.byte 0xe0,OP_LONG,OP_BYTE,OP_BYTE,0
9: .word 9b-adc2
9: .set adc2,9b
.long 020200141030 /* BBC */
bsbw op
.byte 0xe1,OP_LONG,OP_BYTE,OP_BYTE,0
9: .word 9b-adc2
9: .set adc2,9b
.long 020115141040 /* BBSS */
bsbw op
.byte 0xe2,OP_LONG,OP_BYTE,OP_BYTE,0
9: .word 9b-adc2
9: .set adc2,9b
.long 020114141040 /* BBCS */
bsbw op
.byte 0xe3,OP_LONG,OP_BYTE,OP_BYTE,0
9: .word 9b-adc2
9: .set adc2,9b
.long 020015141040 /* BBSC */
bsbw op
.byte 0xe4,OP_LONG,OP_BYTE,OP_BYTE,0
9: .word 9b-adc2
9: .set adc2,9b
.long 020014141040 /* BBCC */
bsbw op
.byte 0xe5,OP_LONG,OP_BYTE,OP_BYTE,0
9: .word 9b-adc2
9: .set adc2,9b
.long 020114106040 /* BLBS */
bsbw op
.byte 0xe8,OP_LONG,OP_BOFF,0
9: .word 9b-adc2
9: .set adc2,9b
.long 020014106040 /* BLBC */
bsbw op
.byte 0xe9,OP_LONG,OP_BOFF,0
9: .word 9b-adc6
9: .set adc6,9b
.long 020201143030 /* FFS */
bsbw op
.byte 0xea,OP_LONG,OP_BYTE,OP_BYTE,OP_LONG,0
9: .word 9b-adc6
9: .set adc6,9b
.long 020200143030 /* FFC */
bsbw op
.byte 0xeb,OP_LONG,OP_BYTE,OP_BYTE,OP_LONG,0
9: .word 9b-adc3
9: .set adc3,9b
.long 020131006440 /* CMPV */
bsbw op
.byte 0xec,OP_LONG,OP_BYTE,OP_BYTE,OP_LONG,0
9: .word 9b-adc3
9: .set adc3,9b
.long 013151006450 /* CMPVZ */
bsbw op
.byte 0xed,OP_LONG,OP_BYTE,OP_BYTE,OP_LONG,0
9: .word 9b-adc5
9: .set adc5,9b
.long 020131214040 /* EXTV */
bsbw op
.byte 0xee,OP_LONG,OP_BYTE,OP_BYTE,OP_LONG,0
9: .word 9b-adc5
9: .set adc5,9b
.long 013151214050 /* EXTZV */
bsbw op
.byte 0xef,OP_LONG,OP_BYTE,OP_BYTE,OP_LONG,0
9: .word 9b-adc9
9: .set adc9,9b
.long 020131147040 /* INSV */
bsbw op
.byte 0xf0,OP_LONG,OP_LONG,OP_BYTE,OP_BYTE,0
9: .word 9b-adc1
9: .set adc1,9b
.long 020060101440 /* ACBL */
_acbl: bsbw op
.byte 0xf1,OP_LONG,OP_LONG,OP_LONG,OP_WOFF,0
9: .word 9b-adc1
9: .set adc1,9b
.long 011460107460 /* AOBLSS */
bsbw op
.byte 0xf2,OP_LONG,OP_LONG,OP_BOFF,0
9: .word 9b-adc1
9: .set adc1,9b
.long 02460107460 /* AOBLEQ */
_aobleq:
bsbw op
.byte 0xf3,OP_LONG,OP_LONG,OP_BOFF,0
9: .word 9b-adc3
9: .set adc3,9b
.long 02434107560 /* SOBGEQ */
bsbw op
.byte 0xf4,OP_LONG,OP_BOFF,0
9: .word 9b-adc3
9: .set adc3,9b
.long 012034107560 /* SOBGTR */
bsbw op
.byte 0xf5,OP_LONG,OP_BOFF,0
9: .word 9b-adc3
9: .set adc3,9b
.long 01061213050 /* CVTLB */
bsbw op
.byte 0xf6,OP_LONG,OP_BYTE,0
9: .word 9b-adc3
9: .set adc3,9b
.long 013461213050 /* CVTLW */
bsbw op
.byte 0xf7,OP_LONG,OP_WORD,0
9: .word 9b-adc3
9: .set adc3,9b
.long 03460600450 /* CALLG */
bsbw op
.byte 0xf9,OP_LONG,OP_BYTE,0
9: .word 9b-adc3
9: .set adc3,9b
.long 011460600450 /* CALLS */
bsbw op
.byte 0xfa,OP_LONG,OP_BYTE,0
X/* Condition Codes */
9: .word 9b-adc0
9: .set adc0,9b
.long 020203736330 /* 0<> */
movl $0x12,-(%s)
rsb
9: .word 9b-adc0
9: .set adc0,9b
.long 020202036720 /* 0= */
movl $0x13,-(%s)
rsb
9: .word 9b-adc0
9: .set adc0,9b
.long 020202037320 /* 0> */
movl $0x14,-(%s)
rsb
9: .word 9b-adc0
9: .set adc0,9b
.long 020203676330 /* 0<= */
movl $0x15,-(%s)
rsb
9: .word 9b-adc0
9: .set adc0,9b
.long 020203677330 /* 0>= */
movl $0x18,-(%s)
rsb
9: .word 9b-adc0
9: .set adc0,9b
.long 020202036320 /* 0< */
movl $0x19,-(%s)
rsb
9: .word 9b-adc8
9: .set adc8,9b
.long 020202004420 /* HI */
movl $0x1a,-(%s)
rsb
9: .word 9b-adc1
9: .set adc1,9b
.long 020202013320 /* 1V */
movl $0x1d,-(%s)
rsb
9: .word 9b-adc1
9: .set adc1,9b
.long 020202001720 /* 1C */
movl $0x1f,-(%s)
rsb
9: .word 9b-adcc
9: .set adcc,9b
.long 020202007420 /* LO */
movl $0x1f,-(%s)
rsb
9: .word 9b-adce
9: .set adce,9b
.long 020201207430 /* NOT */
anot: xorb2 $1,(%s)
rsb
9: .word 9b-adc5
9: .set adc5,9b
.long 06045207150 /* UNTIL */
auntil: cvtlb (%s)+,(%h)+
subl3 %h,(%s)+,r0
decl r0
cvtbl r0,r1
cmpl r0,r1
bneq 1f
xorb2 $1,-1(%h)
movb r0,(%h)+
rsb
1: movw $0x3103,(%h)+ /* compile 3 byte offset & brw opcode */
subw3 $3,r0,(%h)+
rsb
9: .word 9b-adca
9: .set adca,9b
.long 020011141040 /* jbsb */
_jbsb: subl3 %h,(%s)+,r0
subl2 $2,r0
cvtbl r0,r1
cmpl r0,r1
bneq 1f
movb $0x10,(%h)+ /* compile bsbb */
movb r0,(%h)+
rsb
1: decl r0
cvtwl r0,r1
cmpl r0,r1
bneq 2f
movb $0x30,(%h)+ /* compile bsbw */
movw r0,(%h)+
rsb
2: movw $0x9f16,(%h)+ /* compile jsb *$ */
movl -4(%s),(%h)+
rsb
9: .word 9b-adc2
9: .set adc2,9b
.long 020202011020 /* BR */
_br: pushl %h /* save h */
bsbw _jbsb
incb *(%r)+
rsb
9: .word 9b-adc9
9: .set adc9,9b
.long 020202003020 /* IF */
aif: cvtlb (%s),(%h)+ /* compile branch opcode */
movw $0x3103,(%h)+ /* compile displacement of 3 and BRW opcode */
clrw (%h)+ /* reserve space for BRW displacement */
movl %h,(%s) /* remember position */
rsb
X/* Note in this implementation ASSEMBLER THEN is same as FORTH THEN */
X/* ASSEMBLER ELSE is same as FORTH ELSE */
#ifdef COPROCESS
9: .word 9b-adc7
9: .set adc7,9b
.long 020120440540 /* WAIT */
moval c_wait,-(%s)
rsb
#endif
9: .word 9b-adc1
9: .set adc1,9b
.long 012110741050 /* ABORT */
moval abort,-(%s)
rsb
//go.sysin dd *
made=TRUE
if [ $made = TRUE ]; then
/bin/chmod 644 ./vaxforth/forth2.S
/bin/echo -n ' '; /bin/ls -ld ./vaxforth/forth2.S
fi
exit
--
Bill Sebok Princeton University, Astrophysics
{allegra,akgua,burl,cbosgd,decvax,ihnp4,kpno,princeton,vax135}!astrovax!wls