Subject: XB AL source

From: Owen Brand <[email-masked]>
Date: Sun, 31 Jan 2010 09:26:42 -0500

Okay guys... Here's what I've got to work with here.  First I've  
listed the XB program I compiled... I wanted to check speed XB versus  
AL, and so the compiler took my simple 3 line program, and gave me a  
source code.  For the compiler, the source code that is spit out upon  
compilation must reside in the same DSK as the two RUNTIME programs...  
I have listed the XB code, the compiled source, and the source for  
both runtime programs.  Alot of scrolling here, so I apologize.  I  
haven't assembled my code yet.  It must be assembled before it can be  
run.  Apparently the Funnelweb assembler is preferred by the author of  
this compiler, but I believe that any will work.  So... the order of  
the listed codes below is like this...

1) XB code
2) Compiled Source
3) Runtime1 (came with the compiler)
4) Runtime2 (came with the compiler)

**XB code:
100 CALL CLEAR :: CALL SCREEN(6) :: CALL SPRITE(#1,100,2,30,30,0,15)
110 I=1
120 DISPLAY AT(I,I+1):"X";
125 I=I+1
130 GOTO 120

Compiled XB program source

        DEF RUN,CON
RUNEA  B @RUNEA5
FRSTLN
L100
        DATA CLEAR
        DATA SCREEN,NC1
...SPRITE..NC2.NC3.NC4.NC5.NC5.NC6.NC7..
L110
        DATA LET,NV1,NC2
L120
        DATA ADD,NV1,NC2,NT1
        DATA PRINT,NV1,COMMA,NT1,COLON,SC1,SEMI
L125
        DATA ADD,NV1,NC2,NT1
        DATA LET,NV1,NT1
L130
        DATA GOTO,L120
LASTLN DATA STOP
OPTBAS DATA 0
NC0
ZERO   DATA 0
ONE    DATA 1
PI     DATA 3
RND    DATA 0
NC1    DATA 6
NC2    DATA 1
NC3    DATA 100
NC4    DATA 2
NC5    DATA 30
NC6    DATA 0
NC7    DATA 15
NV0
NV1    DATA 0 I
NT1    DATA 0
SC0
SC1    DATA SC1+2
        BYTE 1,88
        EVEN
SV0
SA0
NA0
FRSTDT
LASTDT
        EVEN
        COPY "DSK2.RUNTIME1"
        COPY "DSK2.RUNTIME2"
        END

Runtime1::

*RUNTIME MODULE FOR INTEGER ARITHMETIC

*VSBW   DATA BLWPWS   We use a BL @VSBW for speed
*       DATA VSBW1    R0 and R1 set up same

VMBW   DATA BLWPWS
        DATA VMBW1

VSBR   DATA BLWPWS
        DATA VSBR1

VMBR   DATA BLWPWS
        DATA VMBR1

VWTR   DATA BLWPWS
        DATA VWTR1

KSCAN  DATA BLWPWS
        DATA KSC1

ERR    DATA >2038
        DATA >2090

KSC1   LWPI >83E0
        MOV R11,@BLWPWS+22
        BL @>000E
        LWPI BLWPWS
        MOV R11,@>83F6
        RTWP

*VSBW1  BL @VSBW2
*       MOVB @>0002(R13),@>8C00
*       RTWP

VMBW1  BL @VSBW2
VMBW2  MOVB *R1+,@>8C00
        DEC R2
        JNE VMBW2
        RTWP

VSBR1  BL @VSBR2
        MOVB @>8800,@>0002(R13)
        RTWP

VMBR1  BL @VSBR2
VMBR2  MOVB @>8800,*R1+
        DEC R2
        JNE VMBR2
        RTWP

VWTR1  MOV *R13,R1
        MOVB @>0001(R13),@>8C02
        ORI R1,>8000
        MOVB R1,@>8C02
        RTWP

VSBW2  LI R1,>4000
        JMP VSB4
VSBR2  CLR R1
VSB4   MOV *R13,R2
        MOVB @BLWPWS+5,@>8C02
        SOC R1,R2
        MOVB R2,@>8C02
        MOV @>0002(R13),R1
        MOV @>0004(R13),R2
        B *R11

FRSTST EQU >A100       address of start of string buffer space

WKSP   EQU >8300
BLWPWS EQU >8320        !BLWPWS must follow WKSP
STRPAD BSS 64            temp storage for PAD >8300 to >833F
GPBUFF BSS 256
STKPNT DATA 0            stack pointer
        DATA 0            backpointer for NULLST
NULLST DATA 0            a null string for initialize
SCRNPT DATA 0            points to current position on screen
DATPNT DATA 0            points to current position in DATA statements
NXTSTR DATA 0            points to next string space for creating  
strings
XBEA5  DATA 0            MSB is flag for xb/ea5 0 if xb, <>0 if ea5

******************
SWPPAD MOV R11,@>83E6
        MOV R0,@>83E8
        LWPI >83E0
        LI R0,>8300
        LI R1,STRPAD

SWPPA1 MOV *R1,R2
        MOV *R0,*R1+
        MOV R2,*R0+
        CI R0,>8340
        JNE SWPPA1
        CLR @>83C4
        MOV R4,R0
        B *R3
******************

*RGSTRS DATA >8000,>81E0,>8200,>8320       VDP registers
*       DATA >8400,>8506,>8600,>8717

ERROR  MOVB @XBEA5,R1
        JEQ ERROR1
ERROR2 LIMI 2          if in EA5 then freeze till quit key pressed
        LIMI 0
        JMP ERROR2

ERROR1 BL @SWPPAD      report error
        BLWP @ERR

CLRSCN MOV R11,R10

        MOVB @XBEA5,R0   Checking whether in XB
        JNE CLRSC1

        BL @>0020        scans for Fctn 4
        JEQ XBRTN
CLRSC1 B *R10

XBRTN  MOVB @XBEA5,R0
        JEQ XBRTN1
        BLWP @>0000      no place to go to if in EA5, so quit
XBRTN1 BL @SWPPAD
        B @>006A

GASIZE LI R7,1           \
GASIZ1 MOV *R10+,R5
        JEQ GASIZ2
        INC R5
        S @OPTBAS,R5       used by start when initializing variables
        MOV R7,R6
        MPY R5,R6
        JMP GASIZ1
GASIZ2 B *R11            /

RUNEA5 SETO @XBEA5
        SETO R0
        JMP RUN0

CON    CLR R0        GPLWS used here
        JMP RUN0

RUN    SETO R0       GPLWS used here
        CLR @XBEA5

RUN0   BL @SWPPAD
        LWPI WKSP

        MOV @>83E0,R0
        JEQ CON1         if eq then call link("con")

        MOV @XBEA5,R0
        JEQ STAR0        running from xb

        CLR R0
        MOVB R0,@>837C
        BLWP @GPLLNK
        DATA >27E3     load characters, colors

        LI R2,32       \
        LI R0,>0800
        LI R1,>1000
LDCLR1 BL @VSBW        fill color table with >10
        INC R0
        DEC R2
        JNE LDCLR1     /

        LI R0,>0320    \
        BLWP @VWTR
*DCLR2 MOVB *R0+,@>8C02  sets vdp registers
*      DEC R1
*      JNE LDCLR2     /

STAR0  LI R10,NV0
STAR1  CI R10,SC0
        JEQ STAR2
        CLR *R10+
        JMP STAR1
STAR2  LI R10,SV0
        LI R2,NULLST
STAR3  CI R10,SA0
        JEQ STAR4
        MOV R2,*R10+
        JMP STAR3
STAR4  CI R10,NA0
        JEQ STAR6
        BL @GASIZE
STAR5  MOV R2,*R10+
        DEC R7
        JNE STAR5
        JMP STAR4
STAR6  CI R10,FRSTDT
        JEQ STAR8
        BL @GASIZE
STAR7  CLR *R10+
        DEC R7
        JNE STAR7
        JMP STAR6

STAR8  LI R13,FRSTLN     start program from 1st line

        MOV @XBEA5,R0
        JEQ STAR9
        LI R14,RUNEA      all memory above RUNEA is free for stack etc.
        JMP STAR10

STAR9  MOV @>8386,R14    HIGHEST F REE ADDRESS-makes sure program  
doesn't hit XB
        DEC  
R14                                                          program
        ANDI R14,>FFFE
STAR10 MOV R14,@STKPNT
        LI R14,>42E2
        MOV R14,@SCRNPT
        LI R14,FRSTDT
        MOV R14,@DATPNT
        LI R14,FRSTST
        MOV R14,@NXTSTR

        LI R14,SA0        pointer to start of array space
        LI R15,GPBUFF     pointer to start of runtime module

CON1   LI R0,CLRSCN
        MOV R0,@>83C4     interrupt hook scans for fctn 4
        MOVB @>8379,@>83C0  random # seed

RTN    LIMI 2            the main loop, all subs come back to here
        LIMI 0
        MOV *R13+,R12
        B *R12

*BLWP @GETARR
*DATA 4
*gets pointer to actual element in array & puts into R4

GETARR DATA BLWPWS-6,GETAR  R13 of WKSP becomes R0 of subroutine's wksp
GETAR  MOV *R14+,R12     get following word of data after BLWP @GETARR
        SLA R12,1          multiply x 2
        A R13,R12         R12 points to R? in WKSP that points to  
array header
        MOV *R12,R3        R3 points to array header
        MOV R3,R10
        BL @GASIZE        r7 will have # elements in array

        CLR R6            R6 will end up with offset in array
GETAR1 MOV *R3+,R5       get dim from array header
        JEQ GETAR2        if a zero then done
        INC R5
        S @OPTBAS,R5
        MOV R7,R8
        CLR R7            prepare for divide
        DIV R5,R7
        MOV *R0+,R9
        MOV *R9,R9
        S @OPTBAS,R9
        MPY R7,R9
        A R10,R6
        JMP GETAR1

GETAR2 SLA R6,1          mpy x2 because each element takes 1 word
        A R6,R3
        MOV R3,*R12
        RTWP

GET4   MOV *R13+,R3
        C R3,R14
        JLT GET3
        BLWP @GETARR
        DATA 3
GET3   MOV *R13+,R4
        C R4,R14
        JLT GET2
        BLWP @GETARR
        DATA 4
GET2   MOV *R13+,R5
        C R5,R14
        JLT GET1
        BLWP @GETARR
        DATA 5
GET1   MOV *R13+,R6
        C R6,R14
        JLT GET0
        BLWP @GETARR
        DATA 6
GET0   B *R11

*** 
*** 
*** 
**********************************************************************
*BLWP  
@CSN  
                                                                    *
*put address of string into calling R0; after BLWP R0 will contain the  
number *
*** 
*** 
*** 
**********************************************************************
CSN    DATA BLWPWS,CSN1

CSN1   MOV *R13,R8
        MOVB *R8+,R9
        SRL R9,8
        A R8,R9
        CLR R12
        CLR R6
        LI R4,10
CSN2   C R8,R9
        JEQ CSN4
        MOVB *R8+,R7
        SRL R7,8
        MOV R6,R6    idea here is that if we're into the digits of the  
string
        JNE CSN3     then dont need to look for +,-, or space
        CI R7,>0020  space
        JEQ CSN2
        CI R7,>002B  +
        JEQ CSN2
        CI R7,>002D  -
        JNE CSN3
        INV R12
        JMP CSN2

CSN3   AI R7,-48
        CI R7,9
        JH CSN4
        MOV R6,R5
        MPY R4,R5
        A R7,R6
        JMP CSN2

CSN4   MOV R12,R12
        JEQ CSN5
        NEG R6
CSN5   MOV R6,*R13
        RTWP

**************************************************************
* BLWP @CNS  Convert integer number into a string            *
*            R6: contains integer to be converted            *
*            Results into GPBUFF+2
**************************************************************
CNS    DATA BLWPWS,CNS1

CNS1   LI R1,GPBUFF+2
        MOV @12(R13),R9   number to convert into R9
        JNE CNS1A         jump if n.e. 0

        LI R3,>0130       string for "0"
        MOV R3,*R1        into buffer
        JMP CNS9          and go back

CNS1A  LI R2,GPBUFF+3
        LI R3,10000
        LI R5,10
        CLR R7            length of string

        MOV R9,R11        store number being converted, and see if  
negative
        JGT CNS2          jump if positive

        LI R0,>2D00       minus sign
        MOVB R0,*R2+
        NEG R9

CNS2   CLR R8
        DIV R3,R8

        MOV R8,R8         if R8 <> 0 after divide then add it to string
        JNE CNS7

        MOV R7,R7         R7=length of string; if it's zero then don't  
add
        JEQ CNS3          a leading zero to string

CNS7   AI R8,48
        SWPB R8
        MOVB R8,*R2+
        INC R7
CNS3   MOV R3,R4
        CLR R3
        DIV R5,R3
        MOV R3,R3
        JNE CNS2

        MOV R11,R11      \
        JGT CNS8          If number being converted was negative then  
we need to
        INC R7           / inc string length because of minus sign

CNS8   SWPB R7
        MOVB R7,*R1
CNS9   RTWP
**********************
SQR    BL @GET2
        MOV *R5,R10
        JLT SQRERR

        MOV R10,R0
        MOV R10,R3
        INC R0
SQR5   SRL R3,2
        JEQ SQR1
        SRL R0,1
        JMP SQR5

SQR1   CLR R1
        MOV R10,R2
        DIV R0,R1
        MOV R0,R3   store r0
        A R1,R0
        SRL R0,1
        C R0,R3
        JEQ SQR2    I.E. IF NO CHANGE THEN FOUND IT
        JGT SQR1
        S R1,R3
        ABS R3
        DEC R3
        JNE SQR1
SQR2   MOV R0,*R6
        B @RTN
SQRERR LI R0,>1C00       bad argument
        B @ERROR
********************
POS    BL @GET4
        MOV *R5,R5
        DECT R5
POS1   INC R5
        MOV *R3,R8
        MOV *R4,R10
        MOVB *R8+,R7
        SRL R7,8
        MOVB *R10+,R9
        SRL R9,8
        MOV R5,R0
        A R9,R0
        C R7,R0
        JLT POS0
        A R5,R8
POS2   CB *R10+,*R8+
        JNE POS1
        DEC R9
        JNE POS2
        INC R5
        JMP POS3
POS0   CLR R5
POS3   MOV R5,*R6
        B @RTN
**********************
JOYST  BL @GET3
        MOVB @1(R4),@>8374
        BLWP @KSCAN
        MOVB @>8377,R2
        SRA R2,8
        MOV R2,*R5
        MOVB @>8376,R2
        SRA R2,8
        MOV R2,*R6
        B @RTN
**********************
SOUND  BL @GET1
        MOV *R6,R6
        JLT SOUND2
SOUND1 MOVB @>83CE,R0
        JEQ SOUND3
        LIMI 2
        LIMI 0
        JMP SOUND1
SOUND2 ABS R6
SOUND3 AI R6,8
        LI R4,6
        MPY R4,R6
        LI R4,100
        DIV R4,R6
        MOV R6,R6
        JNE SOUND4
        INC R6
SOUND4 SWPB R6
        MOVB R6,@>83CE

        LI R9,>8400
        LI R0,>7000
SOUND5 BL @GET2
        MOV *R6,R6
        SLA R6,7
        MOV *R5,R1
        JGT SOUND6
        ABS R1
        DEC R1
        SWPB R1
        AI R1,>E000
        MOVB R1,*R9
        AI R6,>F000
        JMP SOUND8
SOUND6 LI R2,>0001
        MOV R1,R3
        SRL R3,1
        AI R3,>B4F5
        JNC SOUND7
        INC R2
SOUND7 DIV R1,R2
        MOV R2,R4
        SLA R4,4
        SRC R2,4
        SRL R2,4
        AI R0,>1000
        A R0,R2
        MOVB R2,*R9
        MOVB R4,*R9
        AI R0,>1000
        A R0,R6
SOUND8 MOVB R6,*R9

        C *R13,R15
        JLT SOUND5

        LI R0,>0379
        LI R1,SNDOFF
        LI R2,6
        BLWP @VMBW
        MOV R0,@>83CC
        SOCB @SOUND6+3,@>83FD
        B @RTN

SNDOFF DATA >049F,>BFDF,>FF00
******************************
QMARK  BYTE 2,63,32,0

INPUT  BL @GET1
        C *R13,R15
        JL INPUT2
        LI R2,QMARK
        JMP INPUT3
INPUT2 MOV *R6,R2
        BL @GET1
INPUT3 MOV R6,R10

        MOV @SCRNPT,R0
        B @PRINT3+2

INPUT4 ANDI R0,>0FFF
        MOV R0,@>8320
        MOV R0,@>832A
        LI R4,>035D
        MOV R4,@>835E
        BLWP @GPLLNK
        DATA >2858

        MOV @>8320,R0     points to start
        MOV @>832A,R2     points to end

        LI R7,GPBUFF+1
        MOV R7,R4
        CLR R5            will have length
        CLR R1

INPUT5 C R0,R2           \
        JHE INPUT7
        BLWP @VSBR
        CI R1,>7F00
        JEQ INPUT6         puts string into GPBUFF
        AI R1,->6000
        MOVB R1,*R4+
        INC R5
INPUT6 INC R0
        JMP INPUT5        /

INPUT7 MOV R5,R5
        JEQ INPU10

INPUT8 DEC R4            \
        CB *R4,@QMARK+2    a space
        JNE INPUT9         trim trailing spaces
        DEC R5
        JGT INPUT8
        JMP INPU10        /

INPUT9 CB *R7+,@QMARK+2  \
        JNE INPU11         trim leading spaces
        DEC R5
        JGT INPUT9        /

INPU10 INC R7            \
INPU11 DECT R7            move length byte
        SWPB R5
        MOVB R5,*R7       /

        MOV R7,R0
        MOV R10,R6
        BL @ASTRNG
        JEQ INPU12

        BLWP @CSN         \
        MOV R0,*R6         a number
        JMP INPU13        /

INPU12 MOV R6,R1
        BLWP @STRSTR      a string

INPU13 BLWP @SCROLL
        MOV R0,@SCRNPT
        B @RTN

Runtime 2:::

GPLWS  EQU >83E0
GR4    EQU GPLWS+8
GR6    EQU GPLWS+12
LDGADD EQU >60
XTAB27 EQU >200E
GETSTK EQU >166C

GPLLNK DATA GLNKWS
        DATA GLINK1

RTNAD  DATA XMLRTN
GXMLAD DATA >176C
        DATA >50

GLNKWS EQU $->18
        BSS >08

GLINK1 MOV @>83C4,@OLDINT     Store user interrupt
        CLR @>83C4             Turn off user interrupt
        MOV *R11,@GR4
        MOV *R14+,@GR6
        MOV @XTAB27,R12
        MOV R9,@XTAB27
        LWPI GPLWS
        BL *R4
        MOV @GXMLAD,@>8302(R4)
        INCT @>8373
        B @LDGADD

XMLRTN MOV @GETSTK,R4
        BL *R4
        LWPI GLNKWS
        MOV R12,@XTAB27
        MOV @OLDINT,@>83C4     Restore user interrupt
        RTWP

*DSRLNK

PUTSTK EQU >50
TYPE   EQU >836D
NAMLEN EQU >8356
VWA    EQU >8C02
VRD    EQU >8800
GR4LB  EQU >83E9
GSTAT  EQU >837C

DSRLNK DATA DSRWS,DLINK1

DSRWS  EQU $
DR3LB  EQU $+7
DLINK1 MOV R12,R12
        JNE DLINK3
        LWPI GPLWS
        MOV @PUTSTK,R4
        BL *R4
        LI R4,>11
        MOVB R4,@>402(R13)
        JMP DLINK2
        DATA 0
        DATA 0,0,0
DLINK2 MOVB @GR4LB,@>402(R13)
        MOV @GETSTK,R5
        MOVB *R13,@DSRAD1
        INCT @DSRADD
        BL *R5
        LWPI DSRWS
        LI R12,>2000
DLINK3 INC R14
        MOVB *R14+,@TYPE
        MOV @NAMLEN,R3
        AI R3,-8

        BLWP @GPLLNK
DSRADD BYTE >03
DSRAD1 BYTE >00
        MOVB @DR3LB,@VWA
        MOVB R3,@VWA
        SZCB R12,R15
        MOVB @VRD,R3
        SRL R3,5
        MOVB R3,*R13
        JNE SETEQ
        COC @GSTAT,R12
        JNE DSREND
SETEQ  SOCB R12,R15
DSREND RTWP
*** 
*** 
*** 
***********************************************************************
OLDINT BSS 2             A buffer to store the old interrupt
*** 
*** 
*** 
***********************************************************************
***************************
LEN    BL @GET2
        MOV *R5,R5
LEN1   MOVB *R5,R4
        SRL R4,8
        MOV R4,*R6
        B @RTN
***************************
ABS    BL @GET2
        MOV *R5,*R6
        ABS *R6
        B @RTN
***************************
SGN    BL @GET2
        CLR *R6
        MOV *R5,R4
        JEQ SGN2
        JGT SGN1
        DECT *R6
SGN1   INC *R6
SGN2   B @RTN
***************************
ASC    BL @GET2
        MOV *R5,R5
        INC R5
        JMP LEN1
*************************
CHRS   BL @GET2
        MOV R6,R1
        LI R0,WKSP+6
        MOV *R5,R3
        ANDI R3,>00FF
        AI R3,>0100
        BLWP @STRSTR
        B @RTN
***************************
STRS   BL @GET2
        MOV R6,R1
        MOV *R5,R6
        BLWP @CNS
        LI R0,GPBUFF+2
        BLWP @STRSTR
        B @RTN
***************************
CONCAT BL @GET3
        MOV *R4,R4
        MOV *R5,R5
        LI R0,GPBUFF
        MOV R0,R1
        MOVB *R4,*R1
        AB *R5,*R1+
        JNC CONCA3
        SETO *R0
CONCA3 MOVB *R4+,R3
        JEQ CONCA4
        SRL R3,8
CONCA1 MOVB *R4+,*R1+
        DEC R3
        JNE CONCA1
CONCA4 MOVB *R5+,R3
        JEQ CONCA5
        SRL R3,8
CONCA2 CI R1,GPBUFF+256
        JHE CONCA5
        MOVB *R5+,*R1+
        DEC R3
        JNE CONCA2
CONCA5 MOV R6,R1
        BLWP @STRSTR
        B @RTN
***************************
VAL    BL @GET2
        MOV *R5,R0
        BLWP @CSN
        MOV R0,*R6
        B @RTN
***************************
INT    BL @GET2
        MOV *R5,*R6
        B @RTN
***************************

SEGS   LI R0,GPBUFF
        MOV R0,R7
        CLR *R7      in case of null string
        BL @GET4
        MOV *R3,R3
        MOVB *R3,R2
        SRL R2,8
        MOV *R4,R4
        MOV *R5,R5
        JEQ SEGS3
        C R4,R2      pointer past end of string?
        JGT SEGS3

        S R4,R2
        INC R2
        C R2,R5
        JHE SEGS1
        MOV R2,R5
SEGS1  MOVB @WKSP+11,*R7+
        A R4,R3
SEGS2  MOVB *R3+,*R7+
        DEC R5
        JNE SEGS2
SEGS3  MOV R6,R1
        BLWP @STRSTR
        B @RTN

*****************************
CGT    LI R2,>4000    0100 R2
        JMP CEQ1       0100 R3

CLT    CLR R2         0000 R2
CLT1   CLR R3         0000 R3
        JMP CMPARE

CEQ    LI R2,>2000    0010 R2
CEQ1   MOV R2,R3      0010 R3
        JMP CMPARE

CNE    LI R2,>4000    0100 R2
        JMP CLT1       0000 R3

CLE    LI R2,>2000    0010 R2
        JMP CLT1       0000 R3

CGE    LI R2,>2000    0010 R2
        LI R3,>4000    0100

CMPARE BL @GET3
        MOV R6,R7
        MOV R5,R6
        BL @ASTRNG
        JNE CMPAR5

        MOV *R4,R4      compare strings
        MOV *R6,R6
        MOVB *R4+,R10
        SRL R10,8       r10 has length of string at R4
        MOVB *R6+,R11
        SRL R11,8       R11 has length of string at R6
        C R10,R11
        JL CMPAR1
        MOV R11,R12
        JMP CMPAR2
CMPAR1 MOV R10,R12
CMPAR2 JEQ CMPAR4      shortest length to R12; if zero don't compare  
strings
CMPAR3 CB *R4+,*R6+
        JNE CMPAR6
        DEC R12
        JNE CMPAR3
CMPAR4 C R10,R11
        JMP CMPAR6

CMPAR5 C *R4,*R6
CMPAR6 STST R9
        ANDI R9,>6000
        C R2,R9
        JEQ CMPAR7
        C R3,R9
        JEQ CMPAR7
        CLR *R7
        JMP CMPAR8
CMPAR7 SETO *R7
CMPAR8 B @RTN

*****************************
IF     BL @GET1
        MOV *R6,R6
        JNE IF2
        INCT R13
        C *R13,R15
        JH IF3
IF2    MOV *R13,R13
IF3    B @RTN
*****************************

MINUS  BL @GET2
        MOV *R5,*R6
        NEG *R6
        B @RTN
*****************************
MLTPLY BL @GET3

        CI R4,RND
        JEQ RAND2
        CI R5,RND
        JEQ RAND1

        MOV *R5,R7
        MPY *R4,R7
        MOV R8,*R6
        B @RTN

RAND1  MOV R4,R5
RAND2  MOV @>83C0,R1
        CI R1,>C800     \
        JL RAND5         attempt to auto randomize
        MOVB @>8379,R1  /
RAND5  LI R2,>6FE5
        MPY R1,R2
        AI R3,>7AB9
        MOV R3,@>83C0
        MOV *R5,R5

RAND3  C R2,R5
        JL RAND4
        SRL R2,1
        JMP RAND3

RAND4  SWPB R3
        DIV R5,R2
        MOV R3,*R6
        B @RTN
*****************************
DIVIDE BL @GET3
        CLR R10      FLAG
        CLR R7
        MOV *R4,R8
        JLT DIVID1
        JMP DIVID2
DIVID1 INV R10      if # being divided is <0 then flag=ffff
        NEG R8
DIVID2 MOV *R5,R3
        JLT DIVID3
        JMP DIVID4

DIVID3 INV R10
        NEG R3

DIVID4 DIV R3,R7
        MOV R10,R10
        JEQ DIVID5
        MOV R8,R8
        JEQ DIVID6
        INC R7
DIVID6 NEG R7
DIVID5 MOV R7,*R6
        B @RTN
*****************************
ADD    BL @GET3
        MOV *R4,*R6
        A *R5,*R6
        B @RTN
*****************************
SBTRCT BL @GET3
        MOV *R4,*R6
        S *R5,*R6
        B @RTN
*****************************
NOT    BL @GET2
        MOV *R5,*R6
        INV *R6
        B @RTN
*****************************
AND    BL @GET3
        MOV *R5,*R6
        MOV *R4,R8
        INV R8
        SZC R8,*R6
        B @RTN
*****************************
XOR    BL @GET3
        MOV *R5,R8
        XOR *R4,R8
        MOV R8,*R6
        B @RTN
*****************************
OR     BL @GET3
        MOV *R5,*R6
        SOC *R4,*R6
        B @RTN
*****************************

READ   C *R13,R15         is it an instruction
        JH READBK         yes, all done with read
        BL @GET1          otherwise get address of pointer
        MOV @DATPNT,R8    data pointer to R8
        CI R8,LASTDT      out of data statements?
        JEQ READER        yep, report error
        MOVB *R8,R7
        SRL R7,8          length to R7
        INC R7            add 1 for length byte
        MOV R7,R9
        A R8,R9           R9 points to next data in data section
        MOV R9,@DATPNT    update data pointer
        BL @ASTRNG        a string?
        JEQ READ2         if yes goto READ2
        MOV R8,R0         R0 points to length byte of string
        BLWP @CSN         string to number
        MOV R0,*R6        update numeric variable
        JMP READ          keep going

READ2  MOV R8,R0         string address into R0
        MOV R6,R1         pointer to string
        BLWP @STRSTR
        JMP READ

READBK B @RTN

READER LI R0,>2100
        BL @ERROR        DATA ERROR

********************
*BLWP @STRSTR - stores a string in the string buffer space
*Calling R0 points to string
*Calling R1 has address of pointer i.e. after GET1 put R6 into R1
*******************************
STRSTR DATA BLWPWS,STRST1

STRST1 MOV *R13,R0
        MOV @2(R13),R1

        MOV *R1,R4
        CLR @-2(R4)

        MOVB *R0,R3
        SRL R3,8
        INC R3
STRST2 MOV R3,R4
        AI R4,3
        ANDI R4,>FFFE
        MOV @NXTSTR,R2
        A R2,R4
        C R4,@STKPNT
        JLE STRST3
        DECT R0      R0 gets doctored if GARBAG moves string
        BL @GARBAG
        INCT R0
        JMP STRST2

STRST3 MOV R4,@NXTSTR
        MOV R1,*R2+
        MOV R2,*R1
STRST4 MOVB *R0+,*R2+
        DEC R3
        JGT STRST4
        RTWP
*************
*BL @GARBAG  does a garbage collection & reports mem. error if necessary
*************
GARBAG LI R5,FRSTST
        MOV R5,R6
GARBA1 C R6,@NXTSTR
        JEQ GARBA5
        MOV @2(R6),R9
        SRL R9,8
        AI R9,4
        ANDI R9,>FFFE
        MOV *R6,R7
        JEQ GARBA2
        C R5,R6
        JNE GARBA3
        A R9,R5
GARBA2 A R9,R6
        JMP GARBA1
GARBA3 MOV R5,*R7
        INCT *R7

        C R6,R0       \
        JNE GARBA4     move R0 pointer in STRSTR if GARBAG moves string
        MOV R5,R0     /
GARBA4 MOV *R6+,*R5+
        DECT R9
        JNE GARBA4
        JMP GARBA1

GARBA5 C R5,R6
        JNE GARBA6
        CLR @>83C4
        LI R0,>0B00
        BL @ERROR
GARBA6 MOV R5,@NXTSTR
        B *R11

*****************************
RESTOR C *R13,R15
        JH RESTO1
        MOV *R13+,R0
        JMP RESTO2
RESTO1 LI R0,FRSTDT
RESTO2 MOV R0,@DATPNT
         B @RTN
*****************************
LET    BL @GET2
        BL @ASTRNG
        JEQ LET1
        MOV *R6,*R5
        JMP LET2
LET1   MOV R5,R1
        MOV *R6,R0
        BLWP @STRSTR
LET2   B @RTN
*****************************
STOP   B @XBRTN
*****************************
ONGOTO BL @GET1
        MOV *R6,R6
        DEC R6
        SLA R6,1
        A R6,R13
*****************************
GOTO   MOV *R13,R13
        B @RTN
*****************************
ONGOSU BL @GET1
        MOV *R6,R6
        DEC R6
        SLA R6,1
        A R13,R6
        MOV *R6,R8
ONGOS1 C *R13,R15        \
        JH GOSUB1          read through line numbers till R13
        INCT R13           points to next instruction
        JMP ONGOS1        /
*****************************
GOSUB  MOV *R13+,R8
GOSUB1 DECT @STKPNT
        C @NXTSTR,@STKPNT
        JLE GOSUB2
        BL @GARBAG
GOSUB2 MOV @STKPNT,R12
        MOV R13,*R12
        MOV R8,R13
        B @RTN
*****************************
RETURN MOV @STKPNT,R8
*      CI R8,FRSTLN
*      JL ONWARD, ELSE REPORT RETURN W/O GOSUB
        MOV *R8,R13
        INCT @STKPNT
        B @RTN
*****************************
FOR    BL @GET4        !!!NEXT MUST occur after FOR in BASIC program
        MOV *R4,*R3
        MOV *R6,R8       test whether step is pos or neg
        JLT FORX1
        C *R4,*R5
        JGT FORX4        pos step; if 1st # bigger than 2nd then bypass
        JMP FORX2
FORX1  C *R5,*R4        neg step; if 2nd # bigger than 1st then bypass
        JGT FORX4
FORX2  MOV *R5,*R13+
        MOV *R6,*R13+
FORX3  B @RTN

FORX4  MOV R13,R5       pointer to R5
        AI R5,-8         to jibe with NEXT address
        AI R13,4         bypass 2 temp variables
        LI R4,NEXT
FORX5  C *R13+,R4       look for NEXT
        JNE FORX5
        C *R13+,R5       found NEXT, check if right one
        JNE FORX5
        JMP FORX3        return

NEXT   MOV R13,R12       store R13 for noe
        MOV *R13,R13      get pointer to variable name
        MOV *R13+,R7      get address of variable in R7

        LI R0,3           3 variables to bypas
NEXT10 MOV *R13+,R1
        C R1,R14          is this variable an array?
        JLT NEXT12        no array, jump
NEXT11 MOV *R1+,R2       bypass the right # elements in array
        JEQ NEXT12        when zero is found then done with elements
        INCT R13
        JMP NEXT11
NEXT12 DEC R0
        JNE NEXT10

        MOV *R13+,R5      actual limit to R5; step to R6 (not pointers!)
        MOV *R13+,R6

        MOV *R7,R1
        A R6,*R7
        MOV R6,R8
        JLT NEXT1         if LT then step is negative
        C *R7,R1
        JLT DONE
        C *R7,R5         positive step; if R7>R5 then done
        JMP NEXT2
NEXT1  C *R7,R1
        JGT DONE
        C R5,*R7         Negative step; compare limit with variable
NEXT2  JGT DONE
        B @RTN

DONE   MOV R12,R13
        INCT R13
        B @RTN
***************************
KEY    BL @GET3
        MOV *R4,R4
        SWPB R4
        MOVB R4,@>8374
        BLWP @KSCAN
        MOVB @>8375,R3
        SRL R3,8
        MOV R3,*R5
        CLR R2
        CI R3,>00FF
        JEQ KEY3
        MOV @>837C,R1
        COC @HX2000,R1
        JNE KEY2
        INCT R2
KEY2   DEC R2
KEY3   MOV R2,*R6
        B @RTN

HX2000 DATA >2000
*************************
SCREEN BL @GET1
        MOV *R6,R0
        DEC R0
        AI R0,>0710       REGISTER 7, foreground=black
        BLWP @VWTR
        B @RTN
***************************
COLOR  BL @GET3          WORKS LIKE XB
        MOV *R4,R0
        AI R0,>080F
        MOV *R5,R1
        DEC R1
        SLA R1,4
        A *R6,R1
        DEC R1
        SWPB R1
        BL @VSBW
        C *R13,R15
        JLT COLOR
        B @RTN
****************************
CHAR   BL @GET2
        MOV *R5,R0
        SLA R0,3
        AI R0,>0300
        LI R1,GPBUFF
        MOV R1,R3
        MOV *R6,R6
        MOVB *R6+,R5
        SRL R5,8
        MOV R5,R2
        JNE CHAR1
        INC R2
CHAR1  AI R2,15
        ANDI R2,>FFF0
        MOV R2,R4
        SRL R2,1
CHAR2  BL @CHARS1
        MOV R7,R8
        SLA R8,4
        BL @CHARS1
        A R7,R8
        SWPB R8
        MOVB R8,*R3+
        DECT R4
        JNE CHAR2
        BLWP @VMBW
        C *R13,R15
        JLT CHAR
        B @RTN

CHARS1 DEC R5
        JLT CHARS3
        SETO R7
CHARS2 INC R7
        CB @CHARTB(R7),*R6
        JNE CHARS2
        JMP CHARS4
CHARS3 CLR R7
CHARS4 INC R6
        B *R11

CHARTB TEXT '0123456789ABCDEF'

*******************************
CLEAR  CLR R0
        LI R1,>8000
        LI R2,768
        BL @VSBW
        JMP CLEAR2
CLEAR1 MOVB R1,@>8C00
CLEAR2 DEC R2
        JNE CLEAR1
        B @RTN
****************************
GCHAR  BL @GET3
        MOV *R4,R0
        MOV *R5,R2
        DEC R0
        DEC R2
        SLA R0,5
        A R2,R0
        SWPB R0
        MOVB R0,@>8C02
        SWPB R0
        MOVB R0,@>8C02
        NOP            !need  to kill time when reading
        MOVB @>8800,R1
        AI R1,>A000
        SRL R1,8
        MOV R1,*R6
        B @RTN
****************************
VCHAR  BL @HCHGAD
VCHAR1 BL @VSBW
        DEC R6
        JEQ HCHAR1
        AI R0,>0020       down 1 row
        CI R0,>4300       off bottom?
        JL VCHAR1         no, keep looping
        AI R0,>FD01       back up to top of screen, 1 col over to right
        CI R0,>4020       if not  in top row then row1,col1
        JL VCHAR1
        CLR R0
        JMP VCHAR1
***************************
HCHAR  BL @HCHGAD
HCHAR4 BL @VSBW          Note use of BL, not BLWP
HCHAR3 DEC R6
        JEQ HCHAR1
        INC R0
        CI R0,>4300
        JL HCHAR2
        CLR R0
        JMP HCHAR4
HCHAR2 MOVB R1,@>8C00
        JMP HCHAR3
HCHAR1 B @RTN

VSBW   ORI R0,>4000      WRITE OPERATION
        SWPB R0
        MOVB R0,@>8C02
        SWPB R0
        MOVB R0,@>8C02
        MOVB R1,@>8C00
        B *R11

HCHGAD MOV R11,R10
        BL @GET3
        MOV *R4,R0    ROW to R0
        MOV *R5,R2    COL to R2
        MOV *R6,R1    ASCII to R1
        C *R13,R15    See if next word is a number or an instruction
        JLT HCHARX    optional number included
        LI R6,1
        JMP HCHARY
HCHARX BL @GET1
        MOV *R6,R6
HCHARY DEC R0
        DEC R2
        SLA R0,5
        A R2,R0
        SWPB R1
        AI R1,>6000
        B *R10

******************************

PRINT  MOV @SCRNPT,R0
        MOV R0,R9         R9 will be positive
        CLR R10           flag so print knows when to return to INPUT
        JMP PRINT2
PRINT1 CLR R9
PRINT2 MOV *R13,R8
        CI R8,SEMI
        JL PRINT9
        CI R8,TAB
        JH PRINBK
        B *R8

PRINT9 C R8,R15
        JH PRINBK

        BL @GET1
        BL @ASTRNG
        JEQ PRINT3
        SETO R8
        MOV *R6,R6
        BLWP @CNS
        LI R2,GPBUFF+2
        MOV R6,R6
        JLT PRINT4
        MOVB *R2,@-1(R2)
        INC @-2(R2)
        LI R3,>2000
        MOVB R3,*R2
        DEC R2
        JMP PRINT4
PRINT3 MOV *R6,R2
        CLR R8

PRINT4 MOVB *R2+,R6
        JEQ PRINT7
        SRL R6,8
        CI R0,>42E2        at beginning of line?
        JEQ PRINT5
        MOV R6,R7
        A R0,R7
        CI R7,>42FE
        JH PRINT6
PRINT5 MOVB *R2+,R1
        AI R1,>6000
        BL @VSBW
        INC R0
        DEC R6
        JEQ PRINT7
        CI R0,>42FE
        JLT PRINT5
PRINT6 BLWP @SCROLL
        JMP PRINT5

PRINT7 MOV R10,R10
        JEQ PRINT8
        B @INPUT4
PRINT8 MOV R8,R8
        JEQ PRINT1
        CI R0,>42FE
        JHE PRINT1
        LI R1,>8000
        BL @VSBW
        INC R0
        JMP PRINT1

PRINBK MOV R9,R9
        JLT PRINB3
        JEQ PRINB2
        ANDI R0,>0FFF
PRINB2 LI R5,>42E2
        BL @COMMA5
PRINB3 MOV R0,@SCRNPT
        B @RTN

SEMI   SETO R9
        INCT R13
        JMP PRINT2
COMMA  CI R0,>42F0
        JL COMMA1
COLON  CI R0,>42E2
        JNE COLON1
        LI R0,>02E2
COLON1 LI R5,>42E2
        JMP COMMA2
COMMA1 LI R5,>42F0
COMMA2 BL @COMMA5
        JMP SEMI

TAB    INCT R13
        BL @GET1
        LI R5,>42E1
        A *R6,R5
        BL @COMMA5
        JMP PRINT1

COMMA5 MOV R11,R12
        LI R1,>8000
COMMA6 C R0,R5
        JEQ COMMA8
        CI R0,>42FE
        JL COMMA7
        BLWP @SCROLL
        JMP COMMA6
COMMA7 BL @VSBW
        INC R0
        JMP COMMA6
COMMA8 B *R12

***********************
*BL @ASTRNG  returns EQ if R6 points to a string, NE if R6 points to  
number
***********************
ASTRNG CI R6,SC0
        JL ASTRN1
        CI R6,NA0
        JH ASTRN1
        C R6,R6
        JMP ASTRN2
ASTRN1 C R6,R13          guaranteed Not equal
ASTRN2 B *R11

**********************
*BLWP @SCROLL scrolls screen, sets R0 calling = >42E2
**********************

SCROLL DATA BLWPWS,SCROB

*TEST OF FAST SCROLL!
SCROB  LI R5,>8800
        LI R6,>8C00
        LI R7,>8C02
        LI R0,>3F48
SCROB1 LI R1,GPBUFF+20
        AI R0,>C0D8
        MOVB @BLWPWS+1,*R7
        MOVB R0,*R7
        LI R8,8
SCROB2 MOVB *R5,*R1+
        MOVB *R5,*R1+
        MOVB *R5,*R1+
        MOVB *R5,*R1+
        MOVB *R5,*R1+
        MOVB *R5,*R1+
        MOVB *R5,*R1+
        MOVB *R5,*R1+
        MOVB *R5,*R1+
        MOVB *R5,*R1+
        MOVB *R5,*R1+
        MOVB *R5,*R1+
        MOVB *R5,*R1+
        MOVB *R5,*R1+
        MOVB *R5,*R1+
        MOVB *R5,*R1+
        MOVB *R5,*R1+
        MOVB *R5,*R1+
        MOVB *R5,*R1+
        MOVB *R5,*R1+
        MOVB *R5,*R1+
        MOVB *R5,*R1+
        MOVB *R5,*R1+
        DEC R8
        JNE SCROB2
        LI R1,GPBUFF+20
        AI R0,>3FE0
        MOVB @BLWPWS+1,*R7
        MOVB R0,*R7
        LI R8,8
SCROB3 MOVB *R1+,*R6
        MOVB *R1+,*R6
        MOVB *R1+,*R6
        MOVB *R1+,*R6
        MOVB *R1+,*R6
        MOVB *R1+,*R6
        MOVB *R1+,*R6
        MOVB *R1+,*R6
        MOVB *R1+,*R6
        MOVB *R1+,*R6
        MOVB *R1+,*R6
        MOVB *R1+,*R6
        MOVB *R1+,*R6
        MOVB *R1+,*R6
        MOVB *R1+,*R6
        MOVB *R1+,*R6
        MOVB *R1+,*R6
        MOVB *R1+,*R6
        MOVB *R1+,*R6
        MOVB *R1+,*R6
        MOVB *R1+,*R6
        MOVB *R1+,*R6
        MOVB *R1+,*R6
        DEC R8
        JNE SCROB3

        CI R0,>4228
        JNE SCROB1

        LI R1,>7F80
        MOVB R1,*R6
        LI R5,28
        MOVB R1,*R6
        SWPB R1
SCROB4 MOVB R1,*R6
        DEC R5
        JNE SCROB4
        SWPB R1
        MOVB R1,*R6
        NOP
        MOVB R1,*R6

        LI R0,>42E2
        MOV R0,*R13
        RTWP

*SCRLXB BLWP @>2018  CHANGE IF USED!!!!!
*      DATA >0026
*      LI R0,>42E2
*      MOV R0,*R13
*      RTWP
SLAST

Owen Brand
**Oprysoft**
Opry99er.com

---

From: fdos <[email-masked]>
Date: Sun, 31 Jan 2010 23:39:00 -0700

Owen,

Not surprisingly some of the copied support AL source code (runtime1 & 
runtime2) was lifted right out of TI FORTH; namely, GPLLINK & DSRLNK, 
maybe more.  This AL source code is even easy for me to follow, as it is 
also structured much like TI FORTH (meaning the technique used must be 
common for this type of application, but I will leave that for the AL 
gurus to comment on.  I will try to study it some more, however, time, 
time allowing (no time).

Bill S

Owen Brand wrote:
>  
> 
> 
> Okay guys... Here's what I've got to work with here.  First I've listed 
> the XB program I compiled... I wanted to check speed XB versus AL, and 
> so the compiler took my simple 3 line program, and gave me a source 
> code.  For the compiler, the source code that is spit out upon 
> compilation must reside in the same DSK as the two RUNTIME programs... I 
> have listed the XB code, the compiled source, and the source for both 
> runtime programs.  Alot of scrolling here, so I apologize.  I haven't 
> assembled my code yet.  It must be assembled before it can be 
> this compiler, but I believe that any will work.  So... the order of the 
> listed codes below is like this...
> < div> 
> 1) XB code
> 2) Compiled Source
> ***XB code:*
> *Compiled XB program source*
>  
>        DEF RUN,CON
> RUNEA  B @RUNEA5
> FRSTLN
> L100
>        DATA CLEAR
>        DATA SCREEN,NC1
>     ;    COPY "DSK2.RUNTIME2"
> *Runtime1::*
>        JNE V MBR2
> BLWPWS EQU >83 20        !BLWPWS must follow WKSP
> NXTSTR DATA 0            points to next string space for creating strings
> XBEA5  DATA 0      ;       MSB is flag for xb/ea5 0 if xb, <>0 if ea5
>  
> ******************
> SWPPAD MOV R11,@>83E6
>        MOV R0,@>83E8
>        LWPI >83E0
>        LI R0,>8300
>        LI R1,STRPAD
>  
> SWPPA1 MOV *R1,R2
>        MOV *R0,*R1+
>        MOV R2,*R0+
>        CI R0,>8340
>        JNE SWPPA1
>        CLR @>83C4
>        MOV R4,R0
>        B *R3
> ******************
>  
> *       DATA >8400,>8506,>8600,>87 17
>  
> ERROR  MOVB @XBEA5,R1
>        JEQ ERROR1
>        BLWP @>0000      no place t o go to if in EA5, so quit
> XBRTN1 BL @SWPPAD
>        B @>006A
>  
> GASIZE LI R7,1           \
> GASIZ1 MOV *R10+,R5
>        JEQ GASIZ2
>        INC R5
> RUN    ; SETO R0       GPLWS used here
>        CLR @XBEA5
>  
> RUN0   BL @SWPPAD
>        LWPI WKSP
>  
>        MOV @>83E0,R0
>        JEQ ST AR4
>        LI R14,RUNEA &nb sp;    all memory above RUNEA is free for stack etc.
>        JMP STAR10
>  
>        DEC R14                                                          
> program
>        LI R14,FR STST
> GETARR DATA BLWPWS-6,GETAR& nbsp; R13 of WKSP becomes R0 of subroutine's 
> wksp
>        A R13,R12         R12 points to R? in WKSP that points to array 
> header
>       ;  JEQ GETAR2        if a zero then done
>        INC R5
>        S @OPTBAS,R5
>        MOV R7,R8
>        RTWP* 
> *******************************************************************************
> *BLWP 
> @CSN                                                                    *
> *******************************************************************************
> CSN    DATA BLWPWS,CSN1
>  
> CSN1   MOV *R13,R8
>        MOVB *R8+,R9
>        SRL R9,8
>        A R8,R9
>         CLR R12
>        CLR R6
>        LI R4,10
> CSN2   C R8,R9
>        JEQ CSN4
>        MOVB *R8+,R7
>        SRL R7,8
>        MOV R6,R6    idea here is that if we're into the digits of the string
>        LI R3,10000 <x-apple-data-detectors://0>
>        LI <x-a pple-data-detectors://0> R5,10
>        CLR R7            length of string
>  
>        MOV R9,R11        store number being converted, and see if negative
>  &nb sp;     MOV R7,R7         R7=length of string; if it's zero then 
> don't add
>        JGT CNS8          If number being converted was negative then we 
> need to
>        INC R7   ;         / inc string length because of minus sign
>  
> CNS8   SWPB R7
>        MOVB R7,*R1
> CNS9   RTWP
> **********************
> SQR    BL @GET2
>        MOV *R5,R10
>        JLT SQRERR
>  
>        MOV R10,R0
>        MOV R10,R3
>        INC R0
> SQR5   SRL R3,2
>        JEQ SQR1
>        SRL R0,1
>        JMP SQR5
>  
> SQR1   CLR R1
>        MOV R10,R2
>        DIV R0,R1
>        MOV R0,R3   store r0
>        A R1,R0
>   &n bsp;    SRL R0,1
>        C R0,R3
>    &nb sp;   SRL R7,8
>   &n bsp;    JNE SOUND4
>  &nb sp;     AI R3,>B4F5
> & nbsp;      MOV R4,@>835E
>        JEQ INPUT6     &nbs p;   puts string into GPBUFF
>        AI R1,->6000
>        MOVB R1,*R4+
>        INC R5
> INPUT6 INC R0
>        JMP INPUT5        /
>  
> INPUT7 MOV R5,R5
>        JEQ INPU10
>  
> INPUT8 DEC R4            \
>        CB *R4,@QMARK+2    a space
>        JNE INPU1 1         trim leading spaces
>        DEC R5
>        JGT INPUT9        /
>  
> INPU10 INC R7            \
>  &nb sp;     JMP INPU13        /
> * *
> * *
> * *
> * *
> * *
> * *
> * *
> * *
> **Runtime 2:::**
>        MOV @OLDINT,@>83C4   ;   Restore user interrupt
>        RTWP
>  
> *DSRLNK
>  
> PUTSTK EQU >50
> TYPE   EQU >836D
> NAMLEN EQU >8356
> VWA    EQU >8C02
> VRD    EQU >8800
> GR4LB  EQU >83E9
> GSTAT  EQU >837C
>  
> DSRLNK DATA DSRWS,DLINK1
>  
> DSRWS  EQU $
> DR3LB  EQU $+7
> DLINK1 MOV R12,R12
>        JNE DLINK3
>        LWPI GPLWS
>        MOV @PUTSTK,R4
>        BL *R4
>        LI R4,>11
>        MOVB R4,@>402(R13)
>        JMP DLINK2
>        DATA 0
>        DATA 0,0,0
>        MOV @ GETSTK,R5
> &n bsp;      JNE DSREND
> ********************************************************************************
> ********************************************************************************
>        B @RTN****************************
> SGN    BL @GET2
>        CLR *R6
>        MOV *R5,R4
>        JEQ SGN2
>        JGT SGN1
>        DECT *R6
> SGN1   INC *R6
> SGN2   B @RTN
>        BLWP @STRSTR*       B @RTN
> INT    BL @GE T2
>        ; C R2,R5
> CMPAR2 JEQ CMPAR4      shortest length to R12; if zero don't compare strings
> CMPAR3 CB *R4+,*R6+
>        JNE CMPAR6
>        DEC R12
>        JNE CMPAR3
> CMPAR4 C R10,R11
>        JMP CMPAR6
>  
> CMPAR5 C *R4,*R6
> CMPAR6 STST R9
>    &n bsp;   ANDI R9,>6000
>        C R2,R9
>        JEQ CMPAR7
>        C R3,R9
>        JEQ CMPAR7
>        CLR *R7
>        JMP CMPAR8
> CMPAR7 SETO *R7
> CMPAR8 B @RTN
>  
>      &nbs p; B @RTN
>    &nbs p;   MOV R3,@>83C0
>      ;   B @RTN
>        INC R7     &nb sp;      add 1 for length byte
>        MOV R7,R9
>        JMP READ   ;        keep going
>   & nbsp;    CLR @-2(R4)
>    &nb sp;   DEC R3
>        INCT *R 7
>      ;   JMP RESTO2
>   &nb sp;    B @RTN
>  &nbs p;     BL @GARBAG
>        C *R4 ,*R5
>  &n bsp;     C *R13+,R5       found NEXT, check if right one
>        JNE FORX5
>        JMP FORX3        return
>  
>  
> &nbs p;      MOV R3,*R5
> COLOR  BL @GET3 &n bsp;        WORKS LIKE XB
>        MOV *R4,R0
>        AI R0,>080F
>        MOV *R5,R1
>        DEC R1
>        SLA R1,4
>        A *R6,R1
>        DEC R1
>        SWPB R1
>        BL @VSBW
>        C *R13,R15
>        JLT COLOR
>        B @RTN
> &n bsp;      MOV *R6,R6
>      &nb sp; C *R13,R15
> *********** *****************
> GCHAR  BL @GET3
>        MOV *R4,R0
>        MOV *R5,R2
>        DEC R0
>        DEC R2
>        SLA R0,5
>        A R2,R0
>        SWPB R0
>        MOVB R0,@>8C02
>        SWPB R0
>        MOVB R0,@>8C02
> **************** ************
> VCHAR  BL @HCHGAD
> VCHAR1 BL @VSBW
>        DEC R6
>        JEQ HCHAR1
>        AI R0,>0020       down 1 row
>        CI R0,>4300       off bottom?
> HCHAR4 BL @VSBW &n bsp;        Note use of BL, not BLWP
> HCHAR3 DEC R6
>        JEQ HCHAR1
>        INC R0
>        CI R0,>4300
>        JL HCHAR2
>        CLR R0
>        JMP HCHAR4
> HCHAR2 MOVB R1,@>8C00
>        JMP HCHAR3
> HCHAR1 B @RTN
>  
>  
>        A R0,R 7
>   & nbsp;    INC R0
> *BL @ASTRNG  returns EQ if R6 points to a string, NE if R6 points to number
> ***********************
> ASTRNG CI R6,SC0
>     & nbsp;  JL ASTRN1
>        CI R6,NA0
>        JH ASTRN1
>        C R6,R6
>        JMP ASTRN2
>       ;  MOVB *R5,*R1+
> *      DATA > ;0026
> Opry99er.com <http://Opry99er.com>
>

---

From: fdos <[email-masked]>
Date: Mon, 01 Feb 2010 00:19:18 -0700

Mark,

Did you not notice this?  The more I study this code the more I'm 
convinced that they rewrote the TI FORTH interpreter & compiler for TI 
BASIC/XB.  Cool idea if it's true, and it would mean that we may be able 
to improve it or refine it, and yYou can make it faster using some of 
your Forth (may need slight modification) routines,  What a blast from 
the past, no?

Bill S

fdos wrote:
> ------------------------------------
> 
> Yahoo! Groups Links
> 
> 
> 
>

---

From: mark wills <[email-masked]>
Date: Mon, 1 Feb 2010 00:00:26 -0800 (PST)

>DATA PRINT,NV1,COMMA, NT1,COLON, SC1,SEMI

Yes Bill! I think you are right! Look at that above, that's a line of FORTH source! It's compiling Forth code!

Fascinating! They must have a much more complex compiler than Forth's though, since WORD in Forth just looks for white-space. So something like A=INT(RND*12)+1 would never work! It would have to be A = INT ( RND * 12 ) + 1  - then you would have a chance of decoding it using a standard Forth compiler.

Very interesting.

Charles Moore wrote a BASIC interpreter in Forth for fun. I have the magazine (in PDF) with the code in.

Mark.

>
>From: fdos <[email-masked]>
>To: [email-masked]
>Sent: Mon, 1 February, 2010 8:19:18
>Subject: Re: [TI994A] XB AL source
>
> >
>
>
>
>
>  >
>>      
> 
>Mark,
>
>>>> 100 CALL CLEAR :: CALL SCREEN(6) :: CALL SPRITE(#1,100, 2,30,30,0, 15)
>>>> 110 I=1
>>>> 120 DISPLAY AT(I,I+1):"X" ;
>>>> 125 I=I+1
>>>> 130 GOTO 120
>>>> 
>>>> ...SPRITE..NC2. NC3.NC4.NC5. NC5.NC6.NC7. .
>>>> L110
>>>>        DATA LET,NV1,NC2
>>>> L120
>>>>        DATA ADD,NV1,NC2, NT1
>>>>        DATA PRINT,NV1,COMMA, NT1,COLON, SC1,SEMI
>>>> L125
>>>>        DATA ADD,NV1,NC2, NT1
>>>>        DATA LET,NV1,NT1
>>>> L130
>>>>        DATA GOTO,L120
>>>> LASTLN DATA STOP
>>>> OPTBAS DATA 0
>>>> NC0
>>>> ZERO   DATA 0
>>>> ONE    DATA 1
>>>> PI     DATA 3
>>>> RND    DATA 0
>>>> NC1    DATA 6
>>>> NC2    DATA 1
>>>> NC3    DATA 100
>>>> NC4    DATA 2
>>>> NC5    DATA 30
>>>> NC6    DATA 0
>>>> NC7    DATA 15
>>>> NV0
>>>> NV1    DATA 0 I
>>>> NT1    DATA 0 
>>>> SC0
>>>> SC1    DATA SC1+2 
>>>>        BYTE 1,88
>>>>        EVEN
>>>> SV0
>>>> SA0
>>>> NA0
>>>> FRSTDT
>>>> LASTDT
>>>>        EVEN
>>>>        COPY "DSK2.RUNTIME1"
>>>>     ;    COPY "DSK2.RUNTIME2"
>>>>        END
>>>> 
>>>> 
>>>> 
>>>> *Runtime1::*
>>>> 
>>>> 
>>>>        MOV R11,@BLWPWS+ 22
>>>> *       MOVB @>0002(R13), @>8C00
>>>> *       RTWP
>>>> 
>>>> VMBW1  BL @VSBW2
>>>> VMBW2  MOVB *R1+,@>8C00
>>>>        DEC R2
>>>>        JNE VMBW2
>>>>        RTWP
>>>> 
>>>> VSBR1  BL @VSBR2
>>>>        MOVB @>8800,@>0002( R13)
>>>>        RTWP
>>>> 
>>>> VMBR1  BL @VSBR2
>>>> VMBR2  MOVB @>8800,*R1+
>>>>        DEC R2
>>>>        JNE V MBR2
>>>>        RTWP
>>>> 
>>>> VWTR1  MOV *R13,R1
>>>>        MOVB @>0001(R13), @>8C02
>>>>        ORI R1,>8000
>>>>        MOVB R1,@>8C02
>>>>        RTWP
>>>> 
>>>> VSBW2  LI R1,>4000
>>>>        JMP VSB4
>>>> VSBR2  CLR R1
>>>> VSB4   MOV *R13,R2
>>>>        MOVB @BLWPWS+5,@> 8C02
>>>>        SOC R1,R2
>>>>        MOVB R2,@>8C02
>>>>        MOV @>0002(R13), R1
>>>>        MOV @>0004(R13), R2
>>>>        B *R11
>>>> 
>>>> 
>>>> ************ ******
>>>> ************ ******
>>>> *RGSTRS DATA >8000,>81E0, >8200,>8320       VDP registers
>>>> *       DATA >8400,>8506, >8600,>87 17
>>>> 
>>>> ERROR  MOVB @XBEA5,R1
>>>>        JEQ ERROR1
>>>> ************ ********* ********* ********* ********* ********* ********* ********* ****
>>>> *BLWP 
>>>> @CSN                                                                    *
>>>> ************ ********* ********* ********* ********* ********* ********* ********* ****
>>>> CSN    DATA BLWPWS,CSN1
>>>> 
>>>> CSN1   MOV *R13,R8
>>>>        MOVB *R8+,R9
>>>>        SRL R9,8
>>>>        A R8,R9
>>>>         CLR R12
>>>>        CLR R6
>>>>        LI R4,10
>>>> CSN2   C R8,R9
>>>>        JEQ CSN4
>>>>        MOVB *R8+,R7
>>>>        SRL R7,8
>>>> ************ ********* ********* ********* ********* ********* *****
>>>> ************ ********* ********* ********* ********* ********* *****
>>>> CNS    DATA BLWPWS,CNS1
>>>> 
>>>> CNS1   LI R1,GPBUFF+2
>>>>        LI R3,10000 <x-apple-data- detectors: //0>
>>>>        LI <x-a pple-data-detectors ://0> R5,10
>>>>        CLR R7            length of string
>>>> 
>>>> ************ ********* *
>>>> ************ ********
>>>> ************ ********* *
>>>> ************ ********* *
>>>>        SOCB @SOUND6+3,@> 83FD
>>>> SNDOFF DATA >049F,>BFDF, >FF00
>>>> ************ ********* *********
>>>> QMARK  BYTE 2,63,32,0
>>>> 
>>>> INPUT  BL @GET1
>>>>        C *R13,R15
>>>>        JL INPUT2
>>>>        LI R2,QMARK
>>>>        JMP INPUT3
>>>> INPUT2 MOV *R6,R2
>>>>        BL @GET1
>>>> INPUT3 MOV R6,R10
>>>> 
>>>>        MOV @SCRNPT,R0
>>>>        B @PRINT3+2
>>>> 
>>>> INPUT4 ANDI R0,>0FFF
>>>>        MOV R0,@>8320
>>>>        MOV R0,@>832A
>>>>        LI R4,>035D
>>>> & nbsp;      MOV R4,@>835E
>>>>        BLWP @GPLLNK
>>>>        DATA >2858
>>>> 
>>>> INPUT9 CB *R7+,@QMARK+ 2  \
>>>>        MOV @GXMLAD,@>8302( R4)
>>>> DLINK2 MOVB @GR4LB,@>402( R13)
>>>>        MOV @ GETSTK,R5
>>>>        MOVB *R13,@DSRAD1
>>>>        INCT @DSRADD
>>>>        BL *R5
>>>>        LWPI DSRWS
>>>>        LI R12,>2000
>>>> DLINK3 INC R14
>>>>        MOVB *R14+,@TYPE
>>>>        MOV @NAMLEN,R3
>>>>        AI R3,-8
>>>> 
>>>>        BLWP @GPLLNK
>>>> DSRADD BYTE >03
>>>> DSRAD1 BYTE >00
>>>>        MOVB @DR3LB,@VWA
>>>>        MOVB R3,@VWA
>>>>        SZCB R12,R15
>>>>        MOVB @VRD,R3
>>>>        SRL R3,5
>>>>        MOVB R3,*R13
>>>>        JNE SETEQ
>>>>        COC @GSTAT,R12
>>>> &n bsp;      JNE DSREND
>>>> SETEQ  SOCB R12,R15
>>>> DSREND RTWP
>>>> ************ ********* ********* ********* ********* ********* ********* ********* *****
>>>> ************ ********* ********* ********* ********* ********* ********* ********* *****
>>>> ************ ********* ******
>>>> LEN    BL @GET2
>>>>        MOV *R5,R5
>>>> LEN1   MOVB *R5,R4
>>>>        SRL R4,8
>>>>        MOV R4,*R6
>>>>        B @RTN
>>>> ************ ********* ******
>>>> ABS    BL @GET2
>>>>        MOV *R5,*R6
>>>>        ABS *R6
>>>>        B @RTN******** ********* ********* **
>>>> SGN    BL @GET2
>>>>        CLR *R6
>>>>        MOV *R5,R4
>>>>        JEQ SGN2
>>>>        JGT SGN1
>>>>        DECT *R6
>>>> SGN1   INC *R6
>>>> SGN2   B @RTN
>>>> ************ ********* ******
>>>> ASC    BL @GET2
>>>>        MOV *R5,R5
>>>>        INC R5
>>>>        JMP LEN1
>>>> ************ ********* ****
>>>> CHRS   BL @GET2
>>>>        MOV R6,R1
>>>>        LI R0,WKSP+6
>>>>        MOV *R5,R3
>>>>        ANDI R3,>00FF
>>>>        AI R3,>0100
>>>>        BLWP @STRSTR*       B @RTN
>>>> ************ ********* ******
>>>> STRS   BL @GET2
>>>>        MOV R6,R1
>>>>        MOV *R5,R6
>>>>        BLWP @CNS
>>>>        LI R0,GPBUFF+2
>>>>        BLWP @STRSTR
>>>>        B @RTN
>>>> ************ ********* ******
>>>> CONCAT BL @GET3
>>>>        MOV *R4,R4
>>>>        MOV *R5,R5
>>>>        LI R0,GPBUFF
>>>>        MOV R0,R1
>>>>        MOVB *R4,*R1
>>>>        AB *R5,*R1+
>>>>        JNC CONCA3
>>>>        SETO *R0
>>>> CONCA3 MOVB *R4+,R3
>>>>        JEQ CONCA4
>>>>         SRL R3,8
>>>> CONCA1 MOVB *R4+,*R1+
>>>>        DEC R3
>>>>        JNE CONCA1
>>>> CONCA4 MOVB *R5+,R3
>>>>        JEQ CONCA5
>>>>        SRL R3,8
>>>> CONCA2 CI R1,GPBUFF+256
>>>>        JHE CONCA5
>>>>        MOVB *R5+,*R1+
>>>>        DEC R3
>>>>        JNE CONCA2
>>>> CONCA5 MOV R6,R1
>>>>        BLWP @STRSTR
>>>>        B @RTN
>>>> ************ ********* ******
>>>> VAL    BL @GET2
>>>>        MOV *R5,R0
>>>>        BLWP @CSN
>>>>        MOV R0,*R6
>>>>        B @RTN
>>>> ************ ********* ******
>>>> INT    BL @GE T2
>>>>        MOV *R5,*R6
>>>>        B @RTN
>>>> ************ ********* ******
>>>> 
>>>> SEGS   LI R0,GPBUFF
>>>>        MOV R0,R7
>>>> ************ ********* ********
>>>> CGT    LI R2,>4000    0100 R2
>>>>        JMP CEQ1       0100 R3
>>>> 
>>>> CLT    CLR R2         0000 R2
>>>> CLT1   CLR R3         0000 R3
>>>>        JMP CMPARE
>>>> 
>>>> CEQ    LI R2,>2000    0010 R2
>>>> CEQ1    MOV R2,R3      0010 R3
>>>>        JMP CMPARE
>>>> 
>>>> CNE    LI R2,>4000    0100 R2
>>>>        JMP CLT1       0000 R3
>>>> 
>>>> CLE    LI R2,>2000    0010 R2
>>>>        JMP CLT1       0000 R3
>>>> 
>>>> CGE    LI R2,>2000    0010 R2
>>>>        LI R3,>4000    0100
>>>> 
>>>> CMPARE BL @GET3
>>>>        MOV R6,R7
>>>>        MOV R5,R6
>>>>        BL @ASTRNG
>>>>        JNE CMPAR5
>>>> 
>>>> ************ ********* ********
>>>> IF     BL @GET1
>>>>        MOV *R6,R6
>>>>        JNE IF2
>>>>        INCT R13
>>>>        C *R13,R15
>>>>        JH IF3
>>>> IF2    MOV *R13,R13
>>>> IF3    B @RTN
>>>> ************ ********* ********
>>>> 
>>>> MINUS  BL @GET2
>>>>        MOV *R5,*R6
>>>>        NEG *R6
>>>>      &nbs p; B @RTN
>>>> ************ ********* ********
>>>> MLTPLY BL @GET3
>>>> 
>>>>        CI R4,RND
>>>>        JEQ RAND2
>>>>        CI R5,RND
>>>>        JEQ RAND1
>>>> 
>>>>        MOV *R5,R7
>>>>        MPY *R4,R7
>>>>        MOV R8,*R6
>>>>        B @RTN
>>>> 
>>>> RAND1  MOV R4,R5
>>>> RAND2  MOV @>83C0,R1
>>>>        CI R1,>C800     \
>>>> ************ ********* ********
>>>> DIVIDE BL @GET3
>>>>        CLR R10      FLAG
>>>>        CLR R7
>>>>        MOV *R4,R8
>>>>        JLT DIVID1
>>>>        JMP DIVID2
>>>> ************ ********* ********
>>>> ADD    BL @GET3
>>>>        MOV *R4,*R6
>>>>        A *R5,*R6
>>>>        B @RTN
>>>> ************ ********* ********
>>>> SBTRCT BL @GET3
>>>>        MOV *R4,*R6
>>>>        S *R5,*R6
>>>>        B @RTN
>>>> ************ ********* ********
>>>> NOT     BL @GET2
>>>>        MOV *R5,*R6
>>>>        INV *R6
>>>>        B @RTN
>>>> ************ ********* ********
>>>> AND    BL @GET3
>>>>        MOV *R5,*R6
>>>>        MOV *R4,R8
>>>>        INV R8
>>>>        SZC R8,*R6
>>>>        B @RTN
>>>> ************ ********* ********
>>>> XOR    BL @GET3
>>>>        MOV *R5,R8
>>>>        XOR *R4,R8
>>>>        MOV R8,*R6
>>>>        B @RTN
>>>> ************ ********* ********
>>>> OR     BL @GET3
>>>>        MOV *R5,*R6
>>>>        SOC *R4,*R6
>>>>      ;   B @RTN
>>>> ************ ********* ********
>>>> 
>>>> ************ ********
>>>> ************ ********* ********* *
>>>> ************ *
>>>> ************ *
>>>> ************ ********* ********
>>>> RESTOR C *R13,R15
>>>>        JH RESTO1
>>>>        MOV *R13+,R0
>>>>      ;   JMP RESTO2
>>>> RESTO1 LI R0,FRSTDT
>>>> RESTO2 MOV R0,@DATPNT
>>>>         B @RTN
>>>> ************ ********* ********
>>>> LET    BL @GET2
>>>>        BL @ASTRNG
>>>>        JEQ LET1
>>>>        MOV *R6,*R5
>>>>        JMP LET2
>>>> LET1   MOV R5,R1
>>>>        MOV *R6,R0
>>>>        BLWP @STRSTR
>>>> LET2   B @RTN
>>>> ************ ********* ********
>>>> STOP   B @XBRTN
>>>> ************ ********* ********
>>>> ONGOTO BL @GET1
>>>>        MOV *R6,R6
>>>>        DEC R6
>>>>        SLA R6,1
>>>>        A R6,R13
>>>> ************ ********* ********
>>>> GOTO   MOV *R13,R13
>>>>   &nb sp;    B @RTN
>>>> ************ ********* ********
>>>> ONGOSU BL @GET1
>>>>        MOV *R6,R6
>>>>        DEC R6
>>>>        SLA R6,1
>>>>        A R13,R6
>>>>        MOV *R6,R8
>>>> ONGOS1 C *R13,R15        \
>>>> ************ ********* ********
>>>> GOSUB  MOV *R13+,R8
>>>> GOSUB1 DECT @STKPNT
>>>>        C @NXTSTR,@STKPNT
>>>>        JLE GOSUB2
>>>>  &nbs p;     BL @GARBAG
>>>> GOSUB2 MOV @STKPNT,R12
>>>>        MOV R13,*R12
>>>>        MOV R8,R13
>>>>        B @RTN
>>>> ************ ********* ********
>>>> RETURN MOV @STKPNT,R8
>>>> *      CI R8,FRSTLN
>>>> ************ ********* ********
>>>> ************ ********* ******
>>>> KEY    BL @GET3
>>>>        MOV *R4,R4
>>>>        SWPB R4
>>>>        MOVB R4,@>8374
>>>>        BLWP @KSCAN
>>>>        MOVB @>8375,R3
>>>>        SRL R3,8
>>>> &nbs p;      MOV R3,*R5
>>>>        CLR R2
>>>>        CI R3,>00FF
>>>>        JEQ KEY3
>>>>        MOV @>837C,R1
>>>>        COC @HX2000,R1
>>>>        JNE KEY2
>>>>        INCT R2
>>>> KEY2   DEC R2
>>>> KEY3   MOV R2,*R6
>>>>        B @RTN
>>>> 
>>>> HX2000 DATA >2000
>>>> ************ ********* ****
>>>> SCREEN BL @GET1
>>>>        MOV *R6,R0
>>>>        DEC R0
>>>> ************ ********* ******
>>>> ************ ********* *******
>>>> CHAR   BL @GET2
>>>>        MOV *R5,R0
>>>>        SLA R0,3
>>>>        AI R0,>0300
>>>>        LI R1,GPBUFF
>>>>        MOV R1,R3
>>>> &n bsp;      MOV *R6,R6
>>>>        MOVB *R6+,R5
>>>>        SRL R5,8
>>>>        MOV R5,R2
>>>>        JNE CHAR1
>>>>        INC R2
>>>> CHAR1  AI R2,15
>>>>        ANDI R2,>FFF0
>>>>        MOV R2,R4
>>>>        SRL R2,1
>>>> CHAR2  BL @CHARS1
>>>>        MOV R7,R8
>>>>        SLA R8,4
>>>>        BL @CHARS1
>>>>        A R7,R8
>>>>        SWPB R8
>>>>        MOVB R8,*R3+
>>>>        DECT R4
>>>>        JNE CHAR2
>>>>        BLWP @VMBW
>>>>      &nb sp; C *R13,R15
>>>>        JLT CHAR
>>>>        B @RTN
>>>> 
>>>> CHARS1 DEC R5
>>>>        JLT CHARS3
>>>>        SETO R7
>>>> CHARS2 INC R7
>>>>        CB @CHARTB(R7), *R6
>>>>        JNE CHARS2
>>>>        JMP CHARS4
>>>> CHARS3 CLR R7
>>>> CHARS4 INC R6
>>>>        B *R11
>>>> 
>>>> ************ ********* ********* *
>>>> CLEAR  CLR R0
>>>>        LI R1,>8000
>>>>        LI R2,768
>>>>        BL @VSBW
>>>>        JMP CLEAR2
>>>> CLEAR1 MOVB R1,@>8C00
>>>> CLEAR2 DEC R2
>>>>        JNE CLEAR1
>>>>        B @RTN
>>>> *********** ************ *****
>>>> GCHAR  BL @GET3
>>>>        MOV *R4,R0
>>>>        MOV *R5,R2
>>>>        DEC R0
>>>>        DEC R2
>>>>        SLA R0,5
>>>>        A R2,R0
>>>>        SWPB R0
>>>>        MOVB R0,@>8C02
>>>>        SWPB R0
>>>>        MOVB R0,@>8C02
>>>> ************ **** ************
>>>> VCHAR  BL @HCHGAD
>>>> VCHAR1 BL @VSBW
>>>>        DEC R6
>>>>        JEQ HCHAR1
>>>>        AI R0,>0020       down 1 row
>>>>        CI R0,>4300       off bottom?
>>>> ************ ********* ******
>>>> HCHAR  BL @HCHGAD
>>>> ************ ********* *********
>>>> 
>>>> PRINT  MOV @SCRNPT,R0
>>>> ************ ********* **
>>>> ************ ********* **
>>>> ASTRNG CI R6,SC0
>>>>     & nbsp;  JL ASTRN1
>>>>        CI R6,NA0
>>>>        JH ASTRN1
>>>>        C R6,R6
>>>>        JMP ASTRN2
>>>> ************ ********* *
>>>> ************ ********* *
>>>> Opry99er.com <http://Opry99er. com>
>>>>
>>> 
>>> 
>>> ------------ --------- --------- ------
>>> 
>>> Yahoo! Groups Links
>>> 
>>> 
>>> 
>>> 
>
>

---

From: fdos <[email-masked]>
Date: Mon, 01 Feb 2010 08:10:12 -0700

Mark,

It's a two stage operation as it compiles the XB code (merge format) to 
AL source that has to be assembled to get an object file, so the XB code 
is linked into the "Forth" like engine (interpreter) right in the 
source, but this is then the final product unless it gets converted to 
an EA5 image.

Another project to consider once you finish your Forth cart, yes? :-)

Bill S

mark wills wrote:
> Fascinating! They must have a much more complex compiler than Forth's 
> though, since WORD in Forth just looks for white-space. So something 
> like A=INT(RND*12)+1 would never work! It would have to be A = INT ( RND 
> * 12 ) + 1  - then you would have a chance of decoding it using a 
> standard Forth compiler.
> 
> Very interesting.
> 
>     *From:* fdos <[email-masked]>
>     *To:* [email-masked]
>     *Sent:* Mon, 1 February, 2010 8:19:18
>     *Subject:* Re: [TI994A] XB AL source
> 
>      
> 
>     Mark,
> 
>     listed
>      >> Opry99er.com <http://Opry99er. com <http://Opry99er.com>>
>      >>
>      >
>      >

---

From: Owen Brand <[email-masked]>
Date: Mon, 1 Feb 2010 10:56:51 -0500

Bill---
     I am very interested to learn about this compiler.  I  
successfully compiled a small XB program into source, then attempted  
assembly twice.  The first was wholly unsuccessful-- the second  
attempt worked fine except for two syntax errors?  Anyway, the  
assembled code ran , but it was not the program I wrote.  Very strange  
what it did.  Anyway, with your knowledge of the Forth compiler---  
perhaps you could give it a look see and maybe we could figure it  
out... I could email you the .arc file containing runtime routines,  
compiler, docs, and the works.... I'd love to be able to make it work  
for me as opposed to the other way round.  Lemme know.  Thanks!!

Owen Brand
**Oprysoft**
Opry99er.com

---

From: mark wills <[email-masked]>
Date: Mon, 1 Feb 2010 08:12:54 -0800 (PST)

Owen,

If yu have it in a format compatible classic99 can you send it to me also? I'll give it a look-see...

Mark

>
>From: Owen Brand <[email-masked]>
>To: "[email-masked]" <[email-masked]>
>Sent: Mon, 1 February, 2010 15:56:51
>assembly twice. The first was wholly unsuccessful- - the second 
>On Feb 1, 2010, at 10:10 AM, fdos <fdosbrs@frontiernet .net> wrote:
>
>> Mark,
>>
>>> like A=INT(RND*12) +1 would never work! It would have to be A = INT 
>>> ( RND
>>> *From:* fdos <fdosbrs@frontiernet .net>
>>> *To:* TI994A@yahoogroups. com
>>>>> Opry99er.com <http://Opry99er. com <http://Opry99er. com>>
>>>>>
>>>>
>>>>

---

From: Owen Brand <[email-masked]>
Date: Mon, 1 Feb 2010 11:17:32 -0500

Abso-frickin-lutely.  Thanks Mark, and yea, it IS Classic99  
compatible.  I'll email it to you now.  Check your mail in  
5....4....3....2.........

Owen Brand
**Oprysoft**
Opry99er.com

On Feb 1, 2010, at 11:12 AM, mark wills <[email-masked]>  
wrote:

> >> Yes Bill! I think you are right! Look at that above, that's a  
> line of
> >> FORTH source! It's compiling Forth code!
> >>
> >> Charles Moore wrote a BASIC interpreter in Forth for fun. I have  
> the
> >> magazine (in PDF) with the code in.
> >>
> >> Mark.
> >>
> >>

---

From: fdos <[email-masked]>
Date: Mon, 01 Feb 2010 09:31:54 -0700

Owen,

This compiler is very interesting to me, but my biggest problem is time 
to do everything I have on my plate, and am committed to do; TI BASIC+ & 
X4th99 primarily, but in that process I need to have my very important 
TI Win98SE PC peripheral doing everything I need it to, so that my time 
is optimized and not wasted.  I continue to have problems in certain 
areas of that peripheral operation.

If you send it (V9T9.dsk image please) I will check it out more than I 
already have as time allows.

Bill S

Owen Brand wrote:
> On Feb 1, 2010, at 10:10 AM, fdos <[email-masked] 
> <mailto:fdosbrs%40frontiernet.net>> wrote:
> 
>  > Mark,
>  >
>  >> *From:* fdos <[email-masked] 
> <mailto:fdosbrs%40frontiernet.net>>
>  >> *To:* [email-masked] <mailto:TI994A%40yahoogroups.com>
>  >>>> Opry99er.com <http://Opry99er. com <http://Opry99er.com 
> <http://Opry99er.com>>>
>  >>>>
>  >>>
>  >>>