wls@astrovax.UUCP (William L. Sebok) (07/13/84)
Part 7 of 8 file with parts before and after "Cut here" lines removed: size = 43551 bytes Checksum = 3007012 ---- 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 ----Cut here. If this line isn't here something is missing----------- -- Bill Sebok Princeton University, Astrophysics {allegra,akgua,burl,cbosgd,decvax,ihnp4,noao,princeton,vax135}!astrovax!wls