Stack'taki pisligi temizlemek

Başlatan bunalmis, 28 Mayıs 2011, 14:12:34

z

Asagidaki gibi iki fonksiyon yazmak zorundayim. Ancak bu kodlama stack overflowa neden olacaktir.

function Fnk1():boolean
begin
             Fnk2();
end;

function Fnk2():boolean
begin
             Fnk1();
end;


Ancak asagidaki kod stack sorununu cozecektir. Delphide ClrPislik isini gorecek komutumuz varmi?

function Fnk1():boolean
begin
             ClrPislik(); 
             Fnk2();
end;

function Fnk2():boolean
begin
             ClrPislik();
             Fnk1();
end;

Bana e^st de diyebilirsiniz.   www.cncdesigner.com

t2

Mantık hatası var. fonksiyonlar birbirine bağımlı olup bu gibi işler olmayacak işlerdir

Tagli

Bir çeşit recursive fonksiyon örneği. Bunlarda bir bitiş şartı gerekir. Sürekli olarak birbirlerini çağırmalarının mümkün olacağını sanmıyorum, bu mutlaka belli bir sayıdan sonra sona ermeli.

Eğer bu şekilde çağırma sürekli devam etmek zorundaysa, sorun başka bir yöntemle çözülmeli. Bir hocamız, recursive olarak yazılabilen her işlemin, normal yöntemlerle de (for döngüleri gibi) yazılabilmesinin teorik olarak mümkün olduğunu söylemişti.

Ayrıca bunalmis hocam, bildiğim kadarıyla sen performansa önem verirsin. Recursive fonksiyonlar ciddi anlamda performans kaybına neden olurlar ve son çare olmadıkça kullanılmamaları tavsiye edilir.
Gökçe Tağlıoğlu

Burak B

@bunalmis hocam teorik olarak ne kadar derine ineceksin ? Bu soruyu sorma sebebim fonksiyonlarına girdiğin ve stacki kirletecek olan değişkenler veya parametreler v.s. değil işlemcinin her bir CALL komutu ile saklamak zorunda olduğu geri dönüş adresleri. Eğer geri dönüş adresine kadar stackte saklananlar sonraki çağrımda seni pek alakadar etmeyecekse. Geri dönüş adreslerini bir bellek bölgesinde oluşturduğun özel bir tabloda barındır (Mesela Derinlik,Adres mantığıyla) ve gerektiğinde fonksiyon sonunda nereye dönmek istiyorsan oraya tablodaki adrese göre pop ve RET etmek süretiyle geri dön. Ancak bu çok dikkat gerektire nested bir durum herşeyi göz önünde bulundurmazsan büyük sorunların olabilir. Böylece stacki dönüş adresleri için meşgül etmek zorunda kalmazsın ve stackin şişmemiş olur. Yani bir nevi PC nin belleği kadar stackin olur. :) Tabi buna göre her iki fonksiyonunuda düzenlemelisin. Ayrcıa sürekli olarak birbirlerini çağıran iki  fonksiyona eğer bir şart ile sonlanmayacaklarsa neden ihtiyacın olduğunu merak ettim doğrusu. Çünkü bunlara başka alternatiflerde öngörülebilir.

Alıntı yapılan: Tagli - 28 Mayıs 2011, 15:19:24
...Bir hocamız, recursive olarak yazılabilen her işlemin, normal yöntemlerle de (for döngüleri gibi) yazılabilmesinin teorik olarak mümkün olduğunu söylemişti...

Ayrıca bunalmis hocam, bildiğim kadarıyla sen performansa önem verirsin. Recursive fonksiyonlar ciddi anlamda performans kaybına neden olurlar ve son çare olmadıkça kullanılmamaları tavsiye edilir.

@Tagli' nin hocası çok haklı. o kısımları delphi içinden ASM ile kodlarsan JMP ile işini daha rahat görürsün. Yukarıda anlattıklarıma ek olarak unutmamak gerekir ki altyordamlara CALL ile dallanıp RET ile geri dönülür ve bu stacki etkiler. Peki ya RET yerine JMP kullanırsam ve stacki düzeltirsem. ;)

Umarım bir fikir kırıntısı verebilmişimdir.
"... a healthy dose of paranoia leads to better systems." Jack Ganssle

mufitsozen

sayin @bunalmis recursive bir yapi, obur arkadaslarin soyledigi gibi bitis sart olmadan olmaz (ornegin 5! de sayiyi 1er kucultup 1 oldugunda "return" etmeye baslariz.)

Fakat senin yapmaya calistigin eger herhangi bir noktadan baslarda bir yere "JMP" etmeye yakin birsey ise (ki assembler kullananlar boyle tehlikeli yapilari kullanmaya bayilirlar, sonrada ortaya cikan hatalari bulmak icin 6 ay ugrasirlar  :( ) bu diger dillerdeki (ornegin c++) exception handling'e benzer, bir exception yapildiginda o exception'i yakalayan bir noktaya kadar geri donulur. Seninde ASMde boyle bir hata durumunu basit bir sekilde yapmak icin bu soruyu sordugunu tahmin ediyorum. Bunun icin biraz az bilinen ve oldukca tehlikeli oldugu icin kullanimi baska bir cozum yoksa tavsiye edilmeyen bir yontem setjump/longjump'dir.

Herhangi bir C kitabindan bu bahsi inceleyebilirsin.
Aptalca bir soru yoktur ve hiç kimse soru sormayı bırakana kadar aptal olmaz.

z

Delphi bir fonksiyona giderken return adresi disinda stack'a daha baska neler atiyor bilmiyorum. Sadece SP yi return adresi atlayacak sekilde hareket ettirsem sorun cozulmeyebilir.
Bu yuzden hazir Delphi fonksiyonu varsa SP ile oynamama gerek kalmaz.

Neden boyle bir seye ihtiyacim oldu?

Elimde X bir islemci icin asm kodlarla yazilmis program var.
Bu asm kodlarin delphi karsiliklariyla programi delphiye cevirdim. Bu nedenle  bahsettigim sorun olustu.

Yukarida basit olsun diye verdigim Fnk1 ve Fnk2 nin iclerinde bir yerde  fonksiyondan cikis yapiliyor.
Programi tek fonksiyon icinde yazabilirdim Goto tipi komutlar sorun olusturmaz fakat Call tipi komutlari Delphide kullanamiyorum.

Bu yuzden asm kodlamada atlama yada cagrilma labellarini fonksiyon olarak yazdim.




Bana e^st de diyebilirsiniz.   www.cncdesigner.com

mufitsozen

#6
@bunalmis hocam, ben hep c dusundugumden mesaja biraz yanlis/eksik cevap vermisim.  :'(


ID: 21336, JmpLib - C RTL setjmp/longjmp in Delphi baslikli cozumu incelerseniz umarim Delphide istediginiz seyi yapar.

http://cc.embarcadero.com/item/21336

Ama bundanda iyisi eger Delphide exception handling var ise, stacki rewind edeceginiz noktaya bir exceotion handler yazip, en asagidanda o exception'i yaratmak (kendiniz bir user -exception yaratabilirsiniz, vede ilk olmaniz gereken bnoktada catch eder, donmek istediginiz noktadada o exception'i raise edersiniz.

Yok ben setjmp/longjmp benzeri bir sey yapmak istesem nasil  olur derseniz size ilave bir ornek:

http://thallium-software.assoc.pagespro-orange.fr/fibers.en.html bu ornek kodda, " PasJmp: This unit provide a SetJmp/LongJmp mechanism for delphi, like sejmp.h in standard ansi/c. " der

Aptalca bir soru yoktur ve hiç kimse soru sormayı bırakana kadar aptal olmaz.

Burak B

@bunalmis hocam Call tipi komutları delphi içinden kullanabilirsiniz.

http://delphi.about.com/library/bluc/text/uc052501a.htm

Düzeltme: Tabi bu durum hangi sürümü kullandığınıza göre değişebilir. Yeni UNICODE sürümlerde hiç denemedim.
"... a healthy dose of paranoia leads to better systems." Jack Ganssle

t2

#8
function Fnk1():boolean
begin
             Fnk2();
end;

function Fnk2():boolean
begin
             Fnk1();
end;


Alıntı YapNeden boyle bir seye ihtiyacim oldu?

Böyle bir şeye gerçekten ihtiyacınız olduğunu sanmıyorum.
bir fonksiyon hesaplama yapacak başka bir fonksiyona ihtiyaç duyuyor fakat o da bu fonksiyona ihtiyaç duyoyor. 

Call tipi komutlar da ne? Delphi ile yazacağınız fonksiyonlar yetersiz mi kalıyor? 

Burak B

@t2, @bunalmis hocmaın bunlara ihtiyacı varmı kendisi daha iyi bilir ancak;

Bağlı Listeler(Linked Lists), Yapay Zeka, 3B Geometri Eliminasyonu (3D Geometry Culling), Kriptografi, Dosya Sistemleri, Veri Tabanı Sistemleri, v.s. bu tip iç içe (nested ve recursive) fonksiyonları çok kullanır.

CALL ASM dilinde alt yordam çağrısı yapmak için kullanılan bir komuttur. Bu komut her cağrıldığında stacke geri dönüş değerini saklar ve RET komutunu bekler. @bunalmis hocanın kodlarda işlemeyi bir şart durdurmazsa Buffer overflow kaçınılmazdır.

Buffer overflow; programın asıl kodunun ezilmesi sonucu ortaya çıkan bir sorundur. Eğer dikkat edilmezse başınıza ÇOK büyük işler açabilir. Buna programınızın çökmesi gibi basit bir durum örnek gösterilebileceği gibi tüm sisteminizin ele geçirilmesi hatta donanımınıza sızılıp firmware modifikasyonu sonucu donanımınızın zombiye dönüştürülmesi gibi atomaltı super duper ultra durumlarda örnek teşkil edebilir.




"... a healthy dose of paranoia leads to better systems." Jack Ganssle

z

Normalde boyle bir kod yazmam fakat simdi yazmak zorundayim.

Sorun henuz cozulmedi, gelen cevaplarda verilen linkleri de henuz tek tek ziyaret etmedim.

Elimde Bir kac K lik asm program var.

Her bir satiri tek tek Delphi kodlara ceviriyorum.

Ornegin asm kod su sekilde;

           
Label1:   BLA
               BLA
               BLA
               JZ     Label2       ; Sorun burasi    
               BLA
               CALL Label2           
               BLA           
Label2:   BLA
               BLA           
               RET



Bunu delphiye su sekilde donusturuyorum

function Label1():boolean;
begin
               Delphi BLA BLA
               Delphi BLA BLA

               if Z then
                  begin
                       Label2();
                       exit;
                   end;  

               Delphi BLA BLA
               Delphi BLA BLA
               Label2();
end;


Simdi burada yaptigim en buyuk hata Label2 ye goto ile atlamak yerine fonksiyonmus gibi cagirmak. Haliyle bu call isleminde Delphi stacka donus adresini atiyor
ve bunu geri cekecek bir mekanizma yok. Bu mekanizmayi ancak ben ornegin Label1 basinda kendim yapmaliyim.


eger Delphide asagidaki gibi fonksiyon yazilabilseydi hic sorunum kalmayacakti.


function Label1():boolean;
begin
               Delphi BLA BLA
               Delphi BLA BLA

               if Z then
                  begin
                       Label2();
                       exit;
                   end; 

               Delphi BLA BLA
               Delphi BLA BLA

function Label2():boolean;
begin
               Delphi BLA BLA
               Delphi BLA BLA
end;
end;

Tum sorunum bundan ibaret
Bana e^st de diyebilirsiniz.   www.cncdesigner.com

Burak B

#11
@bunalmis hocam yazılamadığını kim söyledi :)

procedure TForm1.Button1Click(Sender: TObject) ;
   function IsSmall(const sStr:string):boolean;
   begin
    //IsSmall returns True if sStr is in lowercase, False otherwise
    Result:=LowerCase(sStr)=sStr;
   end;
 begin
   //IsSmall can only be uses inside Button1 OnClick event
   if IsSmall(Edit1.Text) then
    ShowMessage('All small caps in Edit1.Text')
   else
    ShowMessage('Not all small caps in Edit1.Text') ;
 end;


Daha gelişmiş bir örnek;
http://www.delphi3000.com/articles/article_2786.asp?SK=
"... a healthy dose of paranoia leads to better systems." Jack Ganssle

Burak B

Bu örnekte işinizi görmezse tüm kodunuzu delphi ile kullanabileceğiniz şekilde ASM hali ile derleyebilirsiniz.
"... a healthy dose of paranoia leads to better systems." Jack Ganssle

z

@Bytemaster

Yazilamadigini sandigim yaziliyormus. Sagolasin.

@Gerbay

kodlar asagida

Alıntı Yap
;*****************************************************************************
;*                                                                           *
;*                    MCS-BASIC-52 V1.31 Source Listing                      *
;*                           12/1986 till 11/2001                            *
;*       The original source code of V1.1 (BASIC.SRC and FP52.SRC) by        *
;*            Intel Corporation, Embedded Controller Operations              *
;*                             is public donain                              *
;*                                                                           *
;*****************************************************************************
;
;*****************************************************************************
;* General alterations made by D. Wulf, 12/1999.                             *
;* e-mail: Detlef.Wulf@onlinehome.de                                         *
;*****************************************************************************
;
;  The following general alterations are made to the original source code:
;
;  - The original source code had 2 files BASIC.SRC and FP52.SRC those have
;    been incorporated into this file for easy of assembly.
;
;  - All absolute and relativ jumps and calls without labels were provided
;    with labels.
;
;  - All machine code in the original source, coded in databytes are replaced
;    by the menomics.
;
;  - One routine in the source was different to the ROM code and is replaced
;    by the ROM code.
;
;  - Some "ORG" statements between BASIC and floating point code are remarked
;    out.
;
;  - To get room for new code the "ego message" had to be disabled.
;    (Remarked with "Sorry")
;
;  - To get more room for new code the "FPROG" command had to be disabled.
;    (Remarked with "get room")
;
;*****************************************************************************
;* Bugfixes for MCS-52-BASIC from D. Karmann, 8/1993.                        *
;* e-mail: dankarmann@lucent.com                                             *
;*****************************************************************************
;
;  - Corrected Intel bug to allow BASIC autoboot EPROM at 8000H with user
;    command extensions to work.
;    (Remarked as Karmann 1)
;
;  - Corrected Intel bug to that discarded the 'F' in any variable ending in
;    F, FP, FPR and FPRO and followed by a space.
;    (Remarked as Karmann 2)
;
;*****************************************************************************
;* Bugfix and performance for MCS-52-BASIC from                              *
;* D. Mudric and Z. Stojsavljevic descipt in                                 *
;* Elektor Electronics magazine german issue 3/1992.                         *
;*****************************************************************************
;
;  - Modifications to the unprocess a BASIC line routine.
;    (Remarked as Elektor 1)
;
;  - Modifications to the floating point subtraction routine.
;    (Remarked as Elektor 2)
;
;  - HEX to BIN performance improvements.
;    (Remarked as Elektor 3)
;
; The same article describes a fix for the multiplication underflow bug, but
; the fixes did not work.
;
; The multiplicaton underflow bug is now (V1.31) really fixed by D. Wulf!
;    (Remarked as Wulf 1)
;
;*****************************************************************************
;* Change UV-EPROM to EEPROM programming from R. Skowronek, 4/1996           *
;* e-mail: r.skowronek@kfa-juelich.de                                        *
;*****************************************************************************
;
; This altered section of code writes the ram resident Basic program to
; EEPROM just like the ROM resident Basic interpreter writes to UV-EPROMs.
; The EEPROM is connected just like a RAM, i.e. it uses /wr on pin 27
; and gets it's adresses from the real address lines, i.e. the only
; difference from the normal setup is the use of the /wr line instead of
; P1.4, which supplies the program pulse for UV-EPROMs. Now MCS-BASIC-52
; can be located in externally ROM and is non the less able to programm
; EEPROMs!
; (Remarked as Skowronek)
;
; The original code from R. Skowronek didn't support the "PGM" statement
; this feature is added by D. Wulf.
; Memory is now limited to 32K bytes RAM, because memory tests above it
; would change the EEPROM.
;
;*****************************************************************************
;* Change timer 0 from 13 bit to 16 bit counter mode to use XTAL up to 78MHz *
;* from D. Wulf 1/2000                                                       *
;*****************************************************************************
;
; The max. value for XTAL is now 78627473 Hz, for use BASIC-52 with
; Dallas 80C320 high speed / low power microcontroller (33 MHz).
; The defaut crystal value is still 11059200 Hz. You can set it with
; XTAL or patch the souce code at
;
;   17F1H = 11
;   17F0H = 05
;   17EFH = 92
;   17EEH = 00
;
; with a new crystal value.
; (Remarket as Wulf 2)
;
;*****************************************************************************
;* New baudrate detection from D. Wulf 1/2000                                *
;*****************************************************************************
;
; The new baudrate detection uses timer 2 for time measurement in state of
; the code loop timing. So the Dallas 80C320 and other controllers can be
; used. Also at higher clock speeds the baudrate will detect automaticly.
; (Remarked as Wulf 3)
;
;*****************************************************************************
;* New processor type detection from D. Wulf 2/2000                          *
;*****************************************************************************
;
; A new reset routine detects the processor type. So BASIC-52 V1.3 can be
; used with the following controllers:
;
; 8032, 87C52#, Dallas 80C320, 80515*#, 80517*#, 80517A#, 80528, 80535*,
; 80537*, 80575 or similars.
;
; - On processor types marked with the "*" only two different autodetect
;   baudrates, depending on the crystal are possible.
; - The processor types marked with the "#" have internal ROM, so BASIC-52
;   V1.3 can be located there, because it is still only 8K bytes long!
;
; (Remarked as Wulf 4)
;
;*****************************************************************************
;* OPBYTE 43H for POP from H.-J. Boehling 1/2000                             *
;* e-mail: H-Boehling@gmx.de                                                 *
;*****************************************************************************
;
; A feature of BASIC-52 is the ability to add up to 16 custom keywords
; representing commands or instructions that you define with assembler
; routines. For using system routines in your assembler code there are
; operation bytes (for more information see Intels "MCS BASIC-52 MANUAL").
; In the original souce code is no OPCODE to put a value from argument
; stack and store in a variable.
; With BASIC-52 V1.3 you can use OPBYTE 43H which does the same than the
; "POP" statement.
; (Remarked as Boehling 1)
;
;*****************************************************************************
;* Reset millisecond counter on "TIME=" from H.-J. Boehling 2/2000           *
;*****************************************************************************
;
; The command "TIME=0" now zeros the millisecond register so that TIME
; returns with zero.
; (Remarked as Boehling 2)
;
;*****************************************************************************
;* New command "ERASE" by H.-J. Boehling 2/2000                              *
;*****************************************************************************
;
; To erase an EEPROM (fill 16K byte up to 8000H with 0FFH) the new command
; "ERASE" is implemented. It takes 2 min. and 45 sec. to erase the 16K bytes!
; (Remarked as Boehling 3)
;
;*****************************************************************************
;* Correct "ASC(x)" bug by D. Wulf 2/2000                                    *
;*****************************************************************************
;
; BASIC-51 V1.1 gives erroneous results for the "ASC(x)" funktion if "x" is
; one of the following signs : *, +, -, /, <, =, > or ?.
; BASIC-51 V1.3 returns the correct values.
; (Remarked as Wulf 5)
;
;*****************************************************************************
;*****************************************************************************
; To indicate the new version the start message is changed from
; *MCS-51(tm) BASIC V1.1* to
; *MCS-BASIC-52 V1.31*
;
; H.-J. Boehling, D. Wulf 11/26/2001
;*****************************************************************************
;
T2CON   EQU   0C8H ; This three lines are necessary for MS-DOS freeware
TL2   EQU   0CCH ; MCS-51 Family Cross Assembler  ASEM-51 V1.2
TH2   EQU   0CDH ; from W.W. Heinz (e-mail: ww@andiunx.m.isar.de)
;
   ;**************************************************************
   ;
   ; TRAP VECTORS TO MONITOR
   ;
   ; RESET TAG (0AAH) ---------2001H
   ;
   ; TAG LOCATION (5AH) ------ 2002H
   ;
   ; EXTERNAL INTERRUPT 0 ---- 2040H
   ;
   ; COMMAND MODE ENTRY ------ 2048H
   ;
   ; SERIAL PORT ------------- 2050H
   ;
   ; MONITOR (BUBBLE) OUTPUT - 2058H
   ;
   ; MONITOR (BUBBLE) INPUT -- 2060H
   ;
   ; MONITOR (BUBBLE) CSTS --- 2068H
   ;
   ; GET USER JUMP VECTOR ---- 2070H
   ;
   ; GET USER LOOKUP VECTOR -- 2078H
   ;
   ; PRINT AT VECTOR --------- 2080H
   ;
   ; INTERRUPT PWM ----------- 2088H
   ;
   ; EXTERNAL RESET ---------- 2090H
   ;
   ; USER OUTPUT-------------- 4030H
   ;
   ; USER INPUT -------------- 4033H
   ;
   ; USER CSTS --------------- 4036H
   ;
   ; USER RESET -------------- 4039H
   ;
   ; USER DEFINED PRINT @ ---  403CH
   ;
   ;***************************************************************
   ;
   ;***************************************************************
   ;
   ; MCS - 52  -  8K BASIC VERSION 1.3
   ;
   ;***************************************************************
   ;
   AJMP   CRST      ;START THE PROGRAM
   ADDC   A,@R1
   ;
   ORG   3H
   ;
   ;***************************************************************
   ;
   ;EXTERNAL INTERRUPT 0
   ;
   ;***************************************************************
   ;
   JB   DRQ,STQ    ;SEE IF DMA IS SET
   PUSH   PSW      ;SAVE THE STATUS
   LJMP   4003H      ;JUMP TO USER IF NOT SET
   ;
   ORG   0BH
   ;
   ;***************************************************************
   ;
   ;TIMER 0 OVERFLOW INTERRUPT
   ;
   ;***************************************************************
   ;
   PUSH   PSW      ;SAVE THE STATUS
   JB   C_BIT,STJ   ;SEE IF USER WANTS INTERRUPT
   LJMP   400BH      ;EXIT IF USER WANTS INTERRUPTS
   ;
   ORG   13H
   ;
   ;***************************************************************
   ;
   ;EXTERNAL INTERRUPT 1
   ;
   ;***************************************************************
   ;
   JB   INTBIT,STK
   PUSH   PSW
   LJMP   4013H
   ;
   ;
   ORG   1BH
   ;
   ;***************************************************************
   ;
   ;TIMER 1 OVERFLOW INTERRUPT
   ;
   ;***************************************************************
   ;
   PUSH   PSW
   LJMP   CKS_I
   ;
STJ:   LJMP   I_DR      ;DO THE INTERRUPT
   ;
   ;***************************************************************
   ;
   ;SERIAL PORT INTERRUPT
   ;
   ;***************************************************************
   ;
   ORG   23H
   ;
   PUSH   PSW
   JB   SPINT,STU   ;SEE IF MONITOR EANTS INTERRUPT
   LJMP   4023H
   ;
   ORG   2BH
   ;
   ;**************************************************************
   ;
   ;TIMER 2 OVERFLOW INTERRUPT
   ;
   ;**************************************************************
   ;
   PUSH   PSW
   LJMP   402BH
   ;
   ;**************************************************************
   ;
   ;USER ENTRY
   ;
   ;**************************************************************
   ;
   ORG   30H
   ;
   LJMP   IBLK      ;LINK TO USER BLOCK
   ;
STQ:   JB   I_T0,STS   ;SEE IF MONITOR WANTS IT
   CLR   DACK
   JNB   P3.2,$      ;WAIT FOR DMA TO END
   SETB   DACK
   RETI
   ;
STS:   LJMP   2040H      ;GO TO THE MONITOR
   ;
STK:   SETB   INTPEN      ;TELL BASIC AN INTERRUPT WAS RECEIVED
   RETI
   ;
STU:   LJMP   2050H      ;SERIAL PORT INTERRUPT
   ;
   ;
   ;**************************************************************
   ;
   ; This is the equate table for 8052 basic.
   ;
   ;**************************************************************
   ;
   ; The register to direct equates for CJNE instructions.
   ;
R0B0   EQU   0
R1B0   EQU   1
R2B0   EQU   2
R3B0   EQU   3
R4B0   EQU   4
R5B0   EQU   5
R6B0   EQU   6
R7B0   EQU   7
   ;
   ; Register bank 1 contains the text pointer
   ; and the arg stack pointer.
   ;
TXAL   EQU   8      ;R0 BANK 1 = TEXT POINTER LOW
ASTKA   EQU   9      ;R1 BANK 1 = ARG STACK
TXAH   EQU   10      ;R2 BANK 1 = TEXT POINTER HIGH
   ;
   ; Now five temporary locations that are used by basic.
   ;
TEMP1   EQU   11
TEMP2   EQU   12
TEMP3   EQU   13
TEMP4   EQU   14
TEMP5   EQU   15
   ;
   ; Register bank 2 contains the read text pointer
   ; and the control stack pointer.
   ;
RTXAL   EQU   16      ;R0 BANK 2 = READ TEXT POINTER LOW
CSTKA   EQU   17      ;R1 BANK 2 = CONTROL STACK POINTER
RTXAH   EQU   18      ;R2 BANK 2 = READ TEXT POINTER HIGH
   ;
   ; Now some internal system equates.
   ;
BOFAH   EQU   19      ;START OF THE BASIC PROGRAM, HIGH BYTE
BOFAL   EQU   20      ;START OF THE BASIC PROGRAM, LOW BYTE
NULLCT   EQU   21      ;NULL COUNT
PHEAD   EQU   22      ;PRINT HEAD POSITION
FORMAT   EQU   23
   ;
   ; Register bank 3 is for the user and can be loaded
   ; by basic
   ;
   ;
   ;
   ; Now everything else is used by basic.
   ; First the bit locations, these use bytes 34, 35, 36, 37 and 38
   ;
OTS      BIT   16   ;34.0-ON TIME INSTRUCTION EXECUTED
INPROG      BIT   17   ;34.1-INTERRUPT IN PROCESS
INTBIT      BIT   18   ;34.2-INTERRUPT SET BIT
ON_ERR      BIT   19   ;34.3-ON ERROR EXECUTED
OTI      BIT   20   ;34.4-ON TIME INTERRUPT IN PROGRESS
LINEB      BIT   21   ;34.5-LINE CHANGE OCCURED
INTPEN      BIT   22   ;34.6-INTERRUPT PENDING BIT
CONB      BIT   23   ;34.7-CAN CONTINUE IF SET
GTRD      BIT   24   ;35.0-READ GET LOCATION
LPB      BIT   25   ;35.1-PRINT TO LINE PRINTER PORT
CKS_B      BIT   26   ;35.2-FOR PWM INTERRUPT
COB      BIT   27   ;35.3-CONSOLE OUT BIT
            ;     0 = SERIAL PORT
            ;     1 = LINE PRINTER
COUB      BIT   28   ;35.4-USER CONSOLE OUT BIT
            ;     0 = SERIAL PORT
            ;     1 = USER DRIVER
INBIT      BIT   29   ;35.5-INITIALIZATION BIT
CIUB      BIT   30   ;35.6-USER CONSOLE IN BIT
            ;     0 = SERIAL PORT
            ;     1 = USER ROUTINE
SPINT      BIT   31   ;35.7-SERIAL PORT INTERRUPT
STOPBIT    BIT   32   ;36.0-PROGRAM STOP ENCOUNTERED
U_IDL      BIT   33   ;36.1-USER IDLE BREAK
INP_B      BIT   34   ;36.2-SET DURING INPUT INSTRUCTION
;DCMPXZ    BIT   35   ;36.3-DCMPX ZERO FLAG
ARGF      BIT   36   ;36.4-ARG STACK HAS A VALUE
RETBIT      BIT   37   ;36.5-RET FROM INTERRUPT EXECUTED
I_T0      BIT   38   ;36.6-TRAP INTERRUPT ZERO TO MON
UPB      BIT   39   ;36.7-SET WHEN @ IS VALID

;
;*****************************************************************************
;****** Sorry - but the ego message had to be disabled ***********************
;
;JKBIT      BIT   40   ;37.0-WB TRIGGER We use the bit for detect
;
mul_underflow   BIT   40   ;37.0-mul_limit_case
;
;*****************************************************************************
;
ENDBIT      BIT   41   ;37.1-GET END OF PROGRAM
UBIT      BIT   42   ;37.2-FOR DIM STATEMENT
ISAV      BIT   43   ;37.3-SAVE INTERRUPT STATUS
BO      BIT   44   ;37.4-BUBBLE OUTPUT
XBIT      BIT   45   ;37.5-EXTERNAL PROGRAM PRESENT
C_BIT      BIT   46   ;37.6-SET WHEN CLOCK RUNNING
DIRF      BIT   47   ;37.7-DIRECT INPUT MODE
NO_C      BIT   48   ;38.0-NO CONTROL C
DRQ      BIT   49   ;38.1-DMA ENABLED
BI      BIT   50   ;38.2-BUBBLE INPUT
;
;*****************************************************************************
;****** Disable Intel programming for to get room ****************************
;
;INTELB    BIT   51   ;38.3-INTELLIGENT PROM PROGRAMMING
;
;*****************************************************************************
;
C0ORX1      BIT   52   ;38.4-PRINT FROM ROM OR RAM
CNT_S      BIT   53   ;38.5-CONTROL S ENCOUNTERED
ZSURP      BIT   54   ;38.6-ZERO SUPRESS
HMODE      BIT   55   ;38.7-HEX MODE PRINT
LP      BIT   P1.7   ;SOFTWARE LINE PRINTER
DACK      BIT   P1.6   ;DMA ACK
;*****************************************************************************
;
;PROMV      BIT   P1.5   ;TURN ON PROM VOLTAGE
;PROMP      BIT   P1.4   ;PROM PULSE
;ALED      BIT   P1.3   ;ALE DISABLE
;
;*****************************************************************************
T_BIT      BIT   P1.2   ;I/O TOGGLE BIT
BD      BIT   0DFH   ;Baudrategenerator 805x7,x5
   ;
   ;
   ; The next location is a bit addressable byte counter
   ;
BABC   EQU   39
   ;
   ; Now floating point and the other temps
   ;
   ; FP Uses to locations 03CH
   ;
   ; Now the stack designators.
   ;
SPSAV   EQU   3EH
S_LEN   EQU   3FH
T_HH   EQU   40H
T_LL   EQU   41H
INTXAH   EQU   42H
INTXAL   EQU   43H
MT1   EQU   45H
MT2   EQU   46H
MILLIV   EQU   47H      ;Real Time Clock 5 millisec.
TVH   EQU   48H      ;Real Time Clock high byte
TVL   EQU   49H      ;Real Time Clock low byte
SAVE_T   EQU   4AH
SP_H   EQU   4BH      ;SERIAL PORT TIME OUT
SP_L   EQU   4CH
CMNDSP   EQU   4DH      ;SYSTEM STACK POINTER
PCON0   EQU   87H      ;PCON SFR
S0RELL   EQU   0AAH      ;S0RELL 805x7A SFR
S0RELH   EQU   0BAH      ;S0RELH 805x7A SFR
RCAPH2   EQU   0CBH      ;RCAPH2 8052 SFR
RCAPL2   EQU   0CAH      ;RCAPL2 8052 SFR
ADCON   EQU   0D8H      ;ADCON 805xx SFR
DAPR   EQU   0DAH      ;DAPR 805xx SFR
IRAMTOP EQU   0FFH      ;TOP OF RAM
STACKTP EQU   0FEH      ;ARG AND CONTROL STACK TOPS
   ;
   ; The character equates
   ;
CR   EQU   0DH      ;CARRIAGE RETURN
LF   EQU   0AH      ;LINE FEED
BELL   EQU   07H      ;BELL CHARACTER
BS   EQU   08H      ;BACK SPACE
CNTRLC   EQU   03H      ;CONTROL C
CNTRLD   EQU   04H      ;CONTROL D
NULL   EQU   00H      ;NULL
   ;
   ; The new baud rate constants
   ;
B4800   EQU   0B2H      ;Timervalue for 4800 baud
B9600   EQU   0D9H      ;Timervalue for 9600 baud
   ;
   ;
   ; The internal system equates
   ;
LINLEN   EQU   73      ;THE LENGTH OF AN INPUT LINE
EOF   EQU   01      ;END OF FILE CHARACTER
ASTKAH   EQU   01      ;ASTKA IS IN PAGE 1 OF RAM
CSTKAH   EQU   00      ;CSTKA IS IN PAGE 0 OF RAM
FTYPE   EQU   01      ;CONTROL STACK "FOR"
GTYPE   EQU   02      ;CONTROL STACK "GOSUB"
DTYPE   EQU   03      ;DO-WHILE/UNTIL TYPE
ROMADR   EQU   8000H      ;LOCATION OF ROM
   ;
   ; The floating point equates
   ;
FPSIZ   EQU   6      ;NO. OF BYTES IN A FLOATING NUM
DIGIT   EQU   FPSIZ-2    ;THE MANTISSA OF A FLOATING NUM
STESIZ   EQU   FPSIZ+3    ;SIZE OF SYMBOL ADJUSTED TABLE ELEMENT
;FP_BASE EQU    1993H       ;BASE OF FLOATING POINT ROUTINES
PSTART   EQU   512      ;START OF A PROGRAM IN RAM
FSIZE   EQU   FPSIZ+FPSIZ+2+2+1
   ;
   ;**************************************************************
   ;
USENT:   ; User entry jump table
   ;
   ;**************************************************************
   ;
   DW   CMND1      ;(00, 00H)COMMAND MODE JUMP
   DW   IFIX      ;(01, 01H)CONVERT FP TO INT
   DW   PUSHAS      ;(02, 02H)PUSH VALUE ONTO ARG STACK
   DW   POPAS      ;(03, 03H)POP VALUE OFF ARG STACK
   DW   PG1      ;(04, 04H)PROGRAM A PROM
   DW   INLINE      ;(05, 05H)INPUT A LINE
   DW   UPRNT      ;(06, 06H)PRINT A LINR
   DW   CRLF      ;(07, 07H)OUTPUT A CRLF
   ;
   ;**************************************************************
   ;
   ; This is the operation jump table for arithmetics
   ;
   ;**************************************************************
   ;
OPTAB:   DW   ALPAR      ;(08, 08H)LEFT PAREN
   DW   AEXP      ;(09, 09H)EXPONENTAION
   DW   AMUL      ;(10, 0AH)FP MUL
   DW   AADD      ;(11, 0BH)FLOATING POINT ADD
   DW   ADIV      ;(12, 0CH)FLOATING POINT DIVIDE
   DW   ASUB      ;(13, 0DH)FLOATING POINT SUBTRACTION
   DW   AXRL      ;(14, 0EH)XOR
   DW   AANL      ;(15, 0FH)AND
   DW   AORL      ;(16, 10H)OR
   DW   ANEG      ;(17, 11H)NEGATE
   DW   AEQ      ;(18, 12H)EQUAL
   DW   AGE      ;(19, 13H)GREATER THAN OR EQUAL
   DW   ALE      ;(20, 14H)LESS THAN OR EQUAL
   DW   ANE      ;(21, 15H)NOT EQUAL
   DW   ALT      ;(22, 16H)LESS THAN
   DW   AGT      ;(23, 17H)GREATER THAN
   ;
   ;***************************************************************
   ;
   ; This is the jump table for unary operators
   ;
   ;***************************************************************
   ;
   DW   AABS      ;(24, 18H)ABSOLUTE VALUE
   DW   AINT      ;(25, 19H)INTEGER OPERATOR
   DW   ASGN      ;(26, 1AH)SIGN OPERATOR
   DW   ANOT      ;(27, 1BH)ONE'S COMPLEMENT
   DW   ACOS      ;(28, 1CH)COSINE
   DW   ATAN      ;(29, 1DH)TANGENT
   DW   ASIN      ;(30, 1EH)SINE
   DW   ASQR      ;(31, 1FH)SQUARE ROOT
   DW   ACBYTE      ;(32, 20H)READ CODE
   DW   AETOX      ;(33, 21H)E TO THE X
   DW   AATAN      ;(34, 22H)ARC TANGENT
   DW   ALN      ;(35, 23H)NATURAL LOG
   DW   ADBYTE      ;(36, 24H)READ DATA MEMORY
   DW   AXBYTE      ;(37, 25H)READ EXTERNAL MEMORY
   DW   PIPI      ;(38, 26H)PI
   DW   ARND      ;(39, 27H)RANDOM NUMBER
   DW   AGET      ;(40, 28H)GET INPUT CHARACTER
   DW   AFREE      ;(41, 29H)COMPUTE #BYTES FREE
   DW   ALEN      ;(42, 2AH) COMPUTE LEN OF PORGRAM
   DW   AXTAL      ;(43, 2BH) CRYSTAL
   DW   PMTOP      ;(44, 2CH)TOP OF MEMORY
   DW   ATIME      ;(45, 2DH) TIME
   DW   A_IE      ;(46, 2EH) IE
   DW   A_IP      ;(47, 2FH) IP
   DW   ATIM0      ;(48, 30H) TIMER 0
   DW   ATIM1      ;(49, 31H) TIMER 1
   DW   ATIM2      ;(50, 32H) TIMER 2
   DW   AT2CON      ;(51, 33H) T2CON
   DW   ATCON      ;(52, 34H) TCON
   DW   ATMOD      ;(53, 35H) ATMOD
   DW   ARCAP2      ;(54, 36H) RCAP2
   DW   AP1      ;(55, 37H) P1
   DW   APCON      ;(56, 38H) PCON
   DW   EXPRB      ;(57, 39H) EVALUATE AN EXPRESSION
   DW   AXTAL1      ;(58, 3AH) CALCULATE CRYSTAL
   DW   LINE      ;(59, 3BH) EDIT A LINE
   DW   PP      ;(60, 3CH) PROCESS A LINE
   DW   UPPL0      ;(61, 3DH) UNPROCESS A LINE
   DW   VAR      ;(62, 3EH) FIND A VARIABLE
   DW   GC      ;(63, 3FH) GET A CHARACTER
   DW   GCI      ;(64, 40H) GET CHARACTER AND INCREMENT
   DW   INCHAR      ;(65, 41H) INPUT A CHARACTER
   DW   CRUN      ;(66, 42H) RUN A PROGRAM
;
;*****************************************************************************
;****** OPBYTE 43H for POP ***************************************************
;****** Boehling 1 ***********************************************************
;
   dw   SPOP      ;(67, 43H) POP a value to a variable
;
;*****************************************************************************
;

OPBOL:   DB   1      ;
   ;
   DB   15      ;LEFT PAREN
   DB   14      ;EXPONENTIAN **
   DB   10      ;MUL
   DB   8      ;ADD
   DB   10      ;DIVIDE
   DB   8      ;SUB
   DB   3      ;XOR
   DB   5      ;AND
   DB   4      ;OR
   DB   12      ;NEGATE
   DB   6      ;EQ
   DB   6      ;GT
   DB   6      ;LT
   DB   6      ;NE
   DB   6      ;LE
   DB   6      ;GE
   ;
UOPBOL: DB   15      ;AABS
   DB   15      ;AAINT
   DB   15      ;ASGN
   DB   15      ;ANOT
   DB   15      ;ACOS
   DB   15      ;ATAN
   DB   15      ;ASIN
   DB   15      ;ASQR
   DB   15      ;ACBYTE
   DB   15      ;E TO THE X
   DB   15      ;AATAN
   DB   15      ;NATURAL LOG
   DB   15      ;DBYTE
   DB   15      ;XBYTE
   ;
   ;***************************************************************
   ;
   ; The ASCII printed messages.
   ;
   ;***************************************************************
   ;
STP:   DB   'STOP"'
   ;
IAN:   DB   'TRY AGAIN"'
   ;
RDYS:   DB   'READY"'
   ;
INS:   DB   ' - IN LINE "'
   ;
   ;**************************************************************
   ;
   ; This is the command jump table
   ;
   ;**************************************************************
   ;
CMNDD:   DW   CRUN      ;RUN
   DW   CLIST      ;LIST
   DW   CNULL      ;NULL
   DW   CNEW      ;NEW
   DW   CCONT      ;CONTINUE
   DW   CPROG      ;PROGRAM A PROM
   DW   CXFER      ;TRANSFER FROM ROM TO RAM
   DW   CRAM      ;RAM MODE
   DW   CROM      ;ROM MODE
;
;*****************************************************************************
;****** Disable Intel programming for to get room ****************************
;
;   DW   CIPROG      ;INTELLIGENT PROM PROGRAMMING
;
;*****************************************************************************
;
   dw   CERASE      ;Erase an EEPROM
;
   ;***************************************************************
   ;
   ; This is the statement jump table.
   ;
   ;**************************************************************
   ;
STATD:   ;
   DW   SLET      ;LET      80H
   DW   SCLR      ;CLEAR      81H
   DW   SPUSH      ;PUSH VAR   82H
   DW   SGOTO      ;GO TO      83H
   DW   STONE      ;TONE      84H
   DW   SPH0      ;PRINT MODE 0   85H
   DW   SUI      ;USER INPUT   86H
   DW   SUO      ;USER OUTPUT   87H
   DW   SPOP      ;POP VAR   88H
   DW   SPRINT      ;PRINT      89H
   DW   SCALL      ;CALL      8AH
   DW   SDIMX      ;DIMENSION   8BH
   DW   STRING      ;STRING ALLO   8CH
   DW   SBAUD      ;SET BAUD   8DH
   DW   SCLOCK      ;CLOCK      8EH
   DW   SPH1      ;PRINT MODE 1   8FH
   ;
   ; No direct mode from here on
   ;
   DW   SSTOP      ;STOP      90H
   DW   SOT      ;ON TIME   91H
   DW   SONEXT      ;ON EXT INT   92H
   DW   SRETI      ;RET FROM INT   93H
   DW   S_DO      ;DO      94H
   DW   SRESTR      ;RESTOR    95H
   DW   WCR      ;REM      96H
   DW   SNEXT      ;NEXT      97H
   DW   SONERR      ;ON ERROR   98H
   DW   S_ON      ;ON      99H
   DW   SINPUT      ;INPUT      9AH
   DW   SREAD      ;READ      9BH
   DW   FINDCR      ;DATA      9CH
   DW   SRETRN      ;RETURN    9DH
   DW   SIF      ;IF      9EH
   DW   SGOSUB      ;GOSUB      9FH
   DW   SFOR      ;FOR      A0H
   DW   SWHILE      ;WHILE      A1H
   DW   SUNTIL      ;UNTIL      A2H
   DW   CMND1      ;END      A3H
   DW   I_DL      ;IDLE      A4H
   DW   ST_A      ;STORE AT   A5H
   DW   LD_A      ;LOAD AT   A6H
   DW   PGU      ;PGM      A7H
   DW   RROM      ;RUN A ROM   A9H
   ;
   ;**************************************************************
   ;
TOKTAB: ; This is the basic token table
   ;
   ;**************************************************************
   ;
   ; First the tokens for statements
   ;
   DB   80H      ;LET TOKEN
   DB   'LET'
   ;
   DB   81H      ;CLEAR TOKEN
   DB   'CLEAR'
   ;
   DB   82H      ;PUSH TOKEN
   DB   'PUSH'
   ;
T_GOTO   EQU   83H
   ;
   DB   83H      ;GO TO TOKEN
   DB   'GOTO'
   ;
   DB   84H      ;TOGGLE TOKEN
   DB   'PWM'
   ;
   DB   85H      ;PRINT HEX MODE 0
   DB   'PH0.'
   ;
   DB   86H      ;USER IN TOKEN
   DB   'UI'
   ;
   DB   87H      ;USER OUT TOKEN
   DB   'UO'
   ;
   DB   88H      ;POP TOKEN
   DB   'POP'
   ;
   DB   89H      ;PRINT TOKEN
   DB   'PRINT'
   DB   89H
   DB   'P.'            ;P. ALSO MEANS PRINT
   DB   89H      ;? ALSO
   DB   '?'
   ;
   DB   8AH      ;CALL TOKEN
   DB   'CALL'
   ;
   DB   8BH      ;DIMENSION TOKEN
   DB   'DIM'
   ;
   DB   8CH      ;STRING TOKEN
   DB   'STRING'
   ;
   DB   8DH      ;SET BAUD RATE
   DB   'BAUD'
   ;
   DB   8EH      ;CLOCK
   DB   'CLOCK'
   ;
   DB   8FH      ;PRINT HEX MODE 1
   DB   'PH1.'
   ;
T_STOP   EQU   90H      ;STOP TOKEN
   DB   T_STOP
   DB   'STOP'
   ;
T_DIR   EQU   T_STOP      ;NO DIRECT FROM HERE ON
   ;
   DB   T_STOP+1   ;ON TIMER INTERRUPT
   DB   'ONTIME'
   ;
   DB   T_STOP+2   ;ON EXTERNAL INTERRUPT
   DB   'ONEX1'
   ;
   DB   T_STOP+3   ;RETURN FROM INTERRUPT
   DB   'RETI'
   ;
   DB   T_STOP+4   ;DO TOKEN
   DB   'DO'
   ;
   DB   T_STOP+5   ;RESTORE TOKEN
   DB   'RESTORE'
   ;
T_REM   EQU   T_STOP+6   ;REMARK TOKEN
   DB   T_REM
   DB   'REM'
   ;
   DB   T_REM+1    ;NEXT TOKEN
   DB   'NEXT'
   ;
   DB   T_REM+2    ;ON ERROR TOKEN
   DB   'ONERR'
   ;
   DB   T_REM+3    ;ON TOKEN
   DB   'ON'
   ;
   DB   T_REM+4    ;INPUT
   DB   'INPUT'
   ;
   DB   T_REM+5    ;READ
   DB   'READ'
   ;
T_DATA   EQU   T_REM+6    ;DATA
   DB   T_DATA
   DB   'DATA'
   ;
   DB   T_DATA+1   ;RETURN
   DB   'RETURN'
   ;
   DB   T_DATA+2   ;IF
   DB   'IF'
   ;
T_GOSB   EQU   T_DATA+3   ;GOSUB
   DB   T_GOSB
   DB   'GOSUB'
   ;
   DB   T_GOSB+1   ;FOR
   DB   'FOR'
   ;
   DB   T_GOSB+2   ;WHILE
   DB   'WHILE'
   ;
   DB   T_GOSB+3   ;UNTIL
   DB   'UNTIL'
   ;
   DB   T_GOSB+4   ;END
   DB   'END'
   ;
T_LAST   EQU   T_GOSB+5   ;LAST INITIAL TOKEN
   ;
T_TAB   EQU   T_LAST      ;TAB TOKEN
   DB   T_TAB
   DB   'TAB'
   ;
T_THEN   EQU   T_LAST+1   ;THEN TOKEN
   DB   T_THEN
   DB   'THEN'
   ;
T_TO   EQU   T_LAST+2   ;TO TOKEN
   DB   T_TO
   DB   'TO'
   ;
T_STEP   EQU   T_LAST+3   ;STEP TOKEN
   DB   T_STEP
   DB   'STEP'
   ;
T_ELSE   EQU   T_LAST+4   ;ELSE TOKEN
   DB   T_ELSE
   DB   'ELSE'
   ;
T_SPC   EQU   T_LAST+5   ;SPACE TOKEN
   DB   T_SPC
   DB   'SPC'
   ;
T_CR   EQU   T_LAST+6
   DB   T_CR
   DB   'CR'
   ;
   DB   T_CR+1
   DB   'IDLE'
   ;
   DB   T_CR+2
   DB   'ST@'
   ;
   DB   T_CR+3
   DB   'LD@'
   ;
   DB   T_CR+4
   DB   'PGM'
   ;
   DB   T_CR+5
   DB   'RROM'
   ;
   ; Operator tokens
   ;
T_LPAR   EQU   0E0H      ;LEFT PAREN
   DB   T_LPAR
   DB   '('
   ;
   DB   T_LPAR+1   ;EXPONENTIAN
   DB   '**'
   ;
   DB   T_LPAR+2   ;FP MULTIPLY
   DB   '*'
   ;
T_ADD   EQU   T_LPAR+3
   DB   T_LPAR+3   ;ADD TOKEN
   DB   '+'
   ;
   DB   T_LPAR+4   ;DIVIDE TOKEN
   DB   '/'
   ;
T_SUB   EQU   T_LPAR+5   ;SUBTRACT TOKEN
   DB   T_SUB
   DB   '-'
   ;
   DB   T_LPAR+6   ;LOGICAL EXCLUSIVE OR
   DB   '.XOR.'
   ;
   DB   T_LPAR+7   ;LOGICAL AND
   DB   '.AND.'
   ;
   DB   T_LPAR+8   ;LOGICAL OR
   DB   '.OR.'
   ;
T_NEG   EQU   T_LPAR+9
   ;
T_EQU   EQU   T_LPAR+10   ;EQUAL
   DB   T_EQU
   DB   '='
   ;
   DB   T_LPAR+11   ;GREATER THAN OR EQUAL
   DB   '>='
   ;
   DB   T_LPAR+12   ;LESS THAN OR EQUAL
   DB   '<='
   ;
   DB   T_LPAR+13   ;NOT EQUAL
   DB   '<>'
   ;
   DB   T_LPAR+14   ;LESS THAN
   DB   '<'
   ;
   DB   T_LPAR+15   ;GREATER THAN
   DB   '>'
   ;
   ;
T_UOP   EQU   0B0H      ;UNARY OP BASE TOKEN
   ;
   DB   T_UOP      ;ABS TOKEN
   DB   'ABS'
   ;
   DB   T_UOP+1    ;INTEGER TOKEN
   DB   'INT'
   ;
   DB   T_UOP+2    ;SIGN TOKEN
   DB   'SGN'
   ;
   DB   T_UOP+3    ;GET TOKEN
   DB   'NOT'
   ;
   DB   T_UOP+4    ;COSINE TOKEN
   DB   'COS'
   ;
   DB   T_UOP+5    ;TANGENT TOKEN
   DB   'TAN'
   ;
   DB   T_UOP+6    ;SINE TOKEN
   DB   'SIN'
   ;
   DB   T_UOP+7    ;SQUARE ROOT TOKEN
   DB   'SQR'
   ;
   DB   T_UOP+8    ;CBYTE TOKEN
   DB   'CBY'
   ;
   DB   T_UOP+9    ;EXP (E TO THE X) TOKEN
   DB   'EXP'
   ;
   DB   T_UOP+10
   DB   'ATN'
   ;
   DB   T_UOP+11
   DB   'LOG'
   ;
   DB   T_UOP+12   ;DBYTE TOKEN
   DB   'DBY'
   ;
   DB   T_UOP+13   ;XBYTE TOKEN
   DB   'XBY'
   ;
T_ULAST EQU   T_UOP+14   ;LAST OPERATOR NEEDING PARENS
   ;
   DB   T_ULAST
   DB   'PI'
   ;
   DB   T_ULAST+1   ;RND TOKEN
   DB   'RND'
   ;
   DB   T_ULAST+2   ;GET TOKEN
   DB   'GET'
   ;
   DB   T_ULAST+3   ;FREE TOKEN
   DB   'FREE'
   ;
   DB   T_ULAST+4   ;LEN TOKEN
   DB   'LEN'
   ;
T_XTAL   EQU   T_ULAST+5   ;CRYSTAL TOKEN
   DB   T_XTAL
   DB   'XTAL'
   ;
T_MTOP   EQU   T_ULAST+6   ;MTOP
   DB   T_MTOP
   DB   'MTOP'
   ;
T_IE   EQU   T_ULAST+8   ;IE REGISTER
   DB   T_IE
   DB   'IE'
   ;
T_IP   EQU   T_ULAST+9   ;IP REGISTER
   DB   T_IP
   DB   'IP'
   ;
TMR0   EQU   T_ULAST+10   ;TIMER 0
   DB   TMR0
   DB   'TIMER0'
   ;
TMR1   EQU   T_ULAST+11   ;TIMER 1
   DB   TMR1
   DB   'TIMER1'
   ;
TMR2   EQU   T_ULAST+12   ;TIMER 2
   DB   TMR2
   DB   'TIMER2'
   ;
T_TIME   EQU   T_ULAST+7   ;TIME
   DB   T_TIME
   DB   'TIME'
   ;
TT2C   EQU   T_ULAST+13   ;T2CON
   DB   TT2C
   DB   'T2CON'
   ;
TTC   EQU   T_ULAST+14   ;TCON
   DB   TTC
   DB   'TCON'
   ;
TTM   EQU   T_ULAST+15   ;TMOD
   DB   TTM
   DB   'TMOD'
   ;
TRC2   EQU   T_ULAST+16   ;RCAP2
   DB   TRC2
   DB   'RCAP2'
   ;
T_P1   EQU   T_ULAST+17   ;P1
   DB   T_P1
   DB   'PORT1'
   ;
T_PC   EQU   T_ULAST+18   ;PCON
   DB   T_PC
   DB   'PCON'
   ;
T_ASC   EQU   T_ULAST+19   ;ASC TOKEN
   DB   T_ASC
   DB   'ASC('
   ;
T_USE   EQU   T_ULAST+20   ;USING TOKEN
   DB   T_USE
   DB   'USING('
   DB   T_USE
   DB   'U.('
   ;
T_CHR   EQU   T_ULAST+21   ;CHR TOKEN
   DB   T_CHR
   DB   'CHR('
   ;
T_CMND   EQU   0F0H      ;COMMAND BASE
   ;
   DB   0F0H      ;RUN TOKEN
   DB   'RUN'
   ;
   DB   0F1H      ;LIST TOKEN
   DB   'LIST'
   ;
   DB   0F2H      ;NULL TOKEN
   DB   'NULL'
   ;
   DB   0F3H      ;NEW TOKEN
   DB   'NEW'
   ;
   DB   0F4H      ;CONTINUE TOKEN
   DB   'CONT'
   ;
   DB   0F5H      ;PROGRAM TOKEN
   DB   'PROG'
   ;
   DB   0F6H      ;TRANSFER TOKEN
   DB   'XFER'
   ;
   DB   0F7H      ;RAM MODE
   DB   'RAM'
   ;
   DB   0F8H      ;ROM MODE
   DB   'ROM'
;
;
;*****************************************************************************
;****** Disable Intel programming for to get room ****************************
;
;   DB   0F9H      ;INTELLIGENT PROM PROGRAMMING
;   DB   'FPROG'
;
;*****************************************************************************
;****** New command "ERASE" to fill an EEPROM with 0FFH  *********************
;****** Boehling 3 ***********************************************************
;
   db   0F9H      ;Erase an EEPROM
   db   'ERASE'
;
;*****************************************************************************
;****** Karmann 2 Bugfix *****************************************************
;
   db   0feh      ;dummy token and
   db   07fh      ;unused dummy char
;
;****** continue with original code: *****************************************
;
   DB   0FFH      ;END OF TABLE
   ;
EIG:   DB   'EXTRA IGNORED"'
   ;
EXA:   DB   'A-STACK"'
   ;
EXC:   DB   'C-STACK"'
   ;
   ;**************************************************************
   ;
CRST:   ; This performs system initialzation, it was moved here so the
   ; new power on reset functions could be tested in an 8751.
   ;
   ;**************************************************************
   ;
   ; First, initialize SFR's
   ;
   MOV   SCON,#5AH   ;INITIALIZE SFR'S
;
;*****************************************************************************
;****** Use XTAL up to 47 MHz ************************************************
;****** Wulf 2 ***************************************************************
;
;   MOV   TMOD,#10H
;
   mov   TMOD,#11H   ;Use 16 bit mode of timer 0
;
;*****************************************************************************
;
   MOV   TCON,#54H
   MOV   T2CON,#34H
;   DB   75H      ;MOV DIRECT, # OP CODE
;   DB   0C8H      ;T2CON LOCATION
;   DB   34H      ;CONFIGURATION BYTE
   ;
   MOV   DPTR,#2001H   ;READ CODE AT 2001H
   CLR   A
   MOVC   A,@A+DPTR
   CJNE   A,#0AAH,CRST1   ;IF IT IS AN AAH, DO USER RESET
   LCALL   2090H
   ;
CRST1:   MOV   R0,#IRAMTOP   ;PUT THE TOP OF RAM IN R0
   CLR   A      ;ZERO THE ACC
   ;
CRST2:   MOV   @R0,A      ;CLEAR INTERNAL MEMORY
   DJNZ   R0,CRST2   ;LOOP TIL DONE
   ;
   ; Now, test the external memory
   ;
   MOV   SPSAV,#CMNDSP   ;SET UP THE STACK
   MOV   SP,SPSAV
;
;*****************************************************************************
;****** Karmann 1 Bugfix *****************************************************
;
   lcall   TEST_USER   ;chek for user command extensions
;
;****** continue with original code: *****************************************
;
   MOV   BOFAH,#HIGH ROMADR
   MOV   BOFAL,#LOW ROMADR+17
   MOV   DPTR,#ROMADR   ;GET THE BYTE AT 8000H
   MOVX   A,@DPTR
   CLR   C
   SUBB   A,#31H      ;FOR BIAS
   MOV   MT1,A      ;SAVE IN DIRECT MATH LOC
   CLR   ACC.2      ;SAVE FOR RESET
   MOV   R7,A      ;SAVE IT IN R7
   INC   DPTR
   ACALL   L31DPI      ;SAVE BAUD RATE
   LCALL   RCL
   INC   DPTR      ;GET MEMTOP
   ACALL   L31DPI
   MOV   DPTR,#5FH   ;READ THE EXTERNAL BYTE
   MOVX   A,@DPTR
   MOV   DPTR,#0    ;ESTABLISH BASE FOR CLEAR
   CJNE   A,#0A5H,CRS   ;Erase the memory
   MOV   A,MT1
   CLR   ACC.0      ;CLEAR BIT ONE
   XRL   A,#4H
   JZ   CR2
   ;
CRS:   CJNE   R7,#2,CRS1
   SJMP   CRS2
CRS1:   CJNE   R7,#3,CR0
CRS2:   ACALL   CL_1
   SJMP   CR1
   ;
CR0:   MOV   R3,DPH      ;SAVE THE DPTR
   MOV   R1,DPL
   INC   DPTR
   MOV   A,#5AH
   MOVX   @DPTR,A    ;Test external memory
   MOVX   A,@DPTR
   CJNE   A,#5AH,CR1
   CLR   A
   MOVX   @DPTR,A
;
;*****************************************************************************
;******* Skowronek alterations to programm EEPROM's in state of UV-EPROM's ***
;
;   CJNE   R3,#0E0H,CR0
;
   CJNE   R3,#HIGH ROMADR-1,CR0   ;Stop the test at 8000H because
   CJNE   R1,#LOW ROMADR-2,CR0   ;EEPROM starts here
;
;*****************************************************************************
;
CR1:   CJNE   R3,#03H,CR11   ;NEED THIS MUCH RAM
CR11:   JC   CRST
   MOV   DPTR,#MEMTOP   ;SAVE MEMTOP
   ACALL   S31DP2      ;SAVE MEMTOP AND SEED RCELL
   ACALL   CNEW      ;CLEAR THE MEMORY AND SET UP POINTERS
   ;
CR2:   ACALL   RC1      ;SET UP STACKS IF NOT DONE
   ;
   LCALL   AXTAL0      ;DO THE CRYSTAL
   MOV   A,MT1      ;GET THE RESET BYTE
   CJNE   A,#5,CR20
   LCALL   4039H
CR20:   JNC   BG1      ;CHECK FOR 0,1,2,3, OR 4
   JNB   ACC.0,BG3   ;NO RUN IF WRONG TYPE
   MOV   DPTR,#ROMADR+16
   MOVX   A,@DPTR    ;READ THE BYTE
   CJNE   A,#55H,BG3
   LJMP   CRUN
;
;*****************************************************************************
;******* New baudrate detection **********************************************
;******* Wulf 3 alteration 1 *************************************************
;
;BG1:    CLR    A       ;DO BAUD RATE
;    MOV    R3,A
;    MOV    R1,A
;    MOV    R0,#4
;    JB    RXD,$       ;LOOP UNTIL A CHARACTER IS RECEIVED
;   ;
;BG2:    DJNZ    R0,$       ;FOUR CLOCKS, IN LOOP
;    CALL    DEC3211    ;NINE CLOCKS
;    MOV    R0,#2       ;ONE CLOCK
;    JNB    RXD,BG2    ;TWO CLOCKS, LOOP UNTIL DONE
;    JB    RXD,$       ;WAIT FOR STOP CHARACTER TO END
;    JNB    RXD,$
;
;*****************************************************************************
;******* New processor type detection ****************************************
;******* Wulf 4 **************************************************************
;
BG1:   clr   a
   mov   t2con,a
   mov   TH2,#0FFh
   mov   TL2,#0F8h
   jb   rxd,$
   mov   t2con,#5   ;Timer2 start
   jnb   rxd,$
   mov   t2con,a    ;Timer2 stop
   jb   rxd,$
   jnb   rxd,$
   call   sercalc    ;r3=timer2 MSB default
   ;
   cjne   a,ADCON,BG10   ;jump if A/D processor like 805x5
BG14:   mov   a,S0RELL
   cjne   a,#B9600,BG2   ;jump if not 805x7A
   mov   a,r3
   anl   S0RELH,a
   mov   S0RELL,r1   ;start Baudratetimer 805X7A
   sjmp   BG11
   ;
BG10:   cjne   r1,#B9600,BG12   ;jump if wrong fast baud rate
BG11:   orl   PCON0,#080h   ;setb smod for fast mode
   sjmp   BG13
   ;
BG12:   cjne   r1,#B4800,BG14   ;jump if wrong slow baudrate
BG13:   setb   BD      ;enable baudrategenerator
   sjmp   BG15
   ;
BG2:   mov   t2con,#34h   ;configure Timer2 as baudrate generator
BG15:   CALL   RCL      ;LOAD THE TIMER
;
;****** Original code from here **********************************************
;
BG3:   MOV   DPTR,#S_N   ;GET THE MESSAGE
   ACALL   CRP      ;PRINT IT
   LJMP   CRAM
   ;
   ;***************************************************************
   ;
   ; CIPROG AND CPROG - Program a prom
   ;
   ;***************************************************************
   ;
PG8:   MOV   R7,#00H    ;PROGRAM ONE BYTE AT A TIME
   MOV   R6,#01H
   MOV   R2,#HIGH ROMADR-1
   MOV   R0,#LOW ROMADR-1;LOAD PROM ADDRESS
   ACALL   PG101
   INC   R6
   MOV   A,RCAPH2
;   DB   0E5H      ;MOV A DIRECT OP CODE
;   DB   0CBH      ;ADDRESS OF R2CAP HIGH
   ACALL   PG101
   MOV   A,RCAPL2
;   DB   0E5H      ;MOV A, DIRECT OP CODE
;   DB   0CAH      ;R2CAP LOW
   MOV   R6,#3
   MOV   R1,#LOW MEMTOP-1
   MOV   R3,#HIGH MEMTOP
   ACALL   PG101      ;SAVE MEMTOP
   SJMP   PGR
;
;
;*****************************************************************************
;****** Skowronek alterations to programm EEPROM's in state of UV-EPROM's ****
;****** Support the "PGM" statement was added by D. Wulf *********************
;****** Disable Intel programming and code optimize by H.-J. Boehling ********
;
;CIPROG: MOV   DPTR,#IPROGS   ;LOAD IPROG LOCATION
;   SETB   INTELB
;   SJMP   CPROG1      ;GO DO PROG
;   ;
;CPROG: MOV   DPTR,#PROGS   ;LOAD PROG LOCATION
;   CLR   INTELB
;   ;
;CPROG1: ACALL   LD_T      ;LOAD THE TIMER
;   CLR   PROMV      ;TURN ON THE PROM VOLTAGE
;   CALL   DELTST      ;SEE IF A CR
;   JNZ   PG8      ;SAVE TIMER IF SO
;   MOV   R4,#0FEH
;   SETB   INBIT
;   ACALL   ROMFD      ;GET THE ROM ADDRESS OF THE LAST LOCATION
;   CALL   TEMPD      ;SAVE THE ADDRESS
;   MOV   A,R4      ;GET COUNT
;   CPL   A
;   CALL   TWO_R2      ;PUT IT ON THE STACK
;   CALL   FP_BASE7   ;OUTPUT IT
;   ACALL   CCAL      ;GET THE PROGRAM
;   ACALL   CRLF      ;DO CRLF
;   MOV   R0,TEMP4   ;GET ADDRESS
;   MOV   R2,TEMP5
;   MOV   A,#55H      ;LOAD SIGNIFIER
;   INC   R6      ;LOAD LEN + 1
;   CJNE   R6,#00,CPROG2
;   INC   R7
;CPROG2: ACALL    PG102
;
;PGR:   SETB   PROMV
;   AJMP   C_K
;
;PG1:   MOV   P2,R3      ;GET THE BYTE TO PROGRAM
;   MOVX   A,@R1
;PG101:  LCALL    INC3210    ;BUMP POINTERS
;PG102:  MOV    R5,#1       ;SET UP INTELLIGENT COUMTER
;
;PG2:   MOV   R4,A      ;SAVE THE BYTE IN R4
;   ACALL   PG7      ;PROGRAM THE BYTE
;   ACALL   PG9
;   JB   INTELB,PG4   ;SEE IF INTELLIGENT PROGRAMMING
;
;PG3:   XRL   A,R4
;   JNZ   PG6      ;ERROR IF NOT THE SAME
;   CALL   DEC76      ;BUMP THE COUNTERS
;   JNZ   PG1      ;LOOP IF NOT DONE
;   ANL   PSW,#11100111B   ;INSURE RB0
;PG31:    RET
;
;PG4:   XRL   A,R4      ;SEE IF PROGRAMMED
;   JNZ   PG5      ;JUMP IF NOT
;   MOV   A,R4      ;GET THE DATA BACK
;   ACALL   PG7      ;PROGRAM THE LOCATION
;PG41:    ACALL    ZRO       ;AGAIN
;   ACALL   ZRO      ;AND AGAIN
;   ACALL   ZRO      ;AND AGAIN
;   DJNZ   R5,PG41    ;KEEP DOING IT
;   ACALL   PG9      ;RESET PROG
;   SJMP   PG3      ;FINISH THE LOOP
;
;PG5:   INC   R5      ;BUMP THE COUNTER
;   MOV   A,R4      ;GET THE BYTE
;   CJNE   R5,#25,PG2   ;SEE IF TRIED 25 TIMES
;
;PG6:   SETB   PROMV      ;TURN OFF PROM VOLTAGE
;   MOV   PSW,#0      ;INSURE RB0
;   JNB   DIRF,PG31   ;EXIT IF IN RUN MODE
;   MOV   DPTR,#E16X   ;PROGRAMMING ERROR
;
;ERRLK: LJMP   ERROR      ;PROCESS THE ERROR
;
;PG7:   MOV   P0,R0      ;SET UP THE PORTS
;   MOV   P2,R2      ;LATCH LOW ORDER ADDRESS
;   ACALL   PG11      ;DELAY FOR 8748/9
;   CLR   ALED
;   MOV   P0,A      ;PUT DATA ON THE PORT
;   ;
;ZRO:   NOP         ;SETTLEING TIME + FP ZERO
;   NOP
;   NOP
;   NOP
;   NOP
;   NOP
;   ACALL   PG11      ;DELAY A WHILE
;   CLR   PROMP      ;START PROGRAMMING
;   ACALL   TIMER_LOAD   ;START THE TIMER
;   JNB   TF1,$      ;WAIT FOR PART TO PROGRAM
;   RET         ;EXIT
;
;PG9:   SETB   PROMP
;   ACALL   PG11      ;DELAY FOR A WHILE
;   JNB   P3.2,$      ;LOOP FOR EEPROMS
;   MOV   P0,#0FFH
;   CLR   P3.7      ;LOWER READ
;   ACALL   PG11
;   MOV   A,P0      ;READ THE PORT
;   SETB   P3.7
;   SETB   ALED
;   RET
;
;PG11:   MOV   TEMP5,#12   ;DELAY 30uS AT 12 MHZ
;   DJNZ   TEMP5,$
;   RET
;
;   ;**************************************************************
;   ;
;PGU:   ;PROGRAM A PROM FOR THE USER
;   ;
;   ;**************************************************************
;
;   CLR   PROMV      ;TURN ON THE VOLTAGE
;   MOV   PSW,#00011000B   ;SELECT RB3
;   ACALL   PG1      ;DO IT
;   SETB   PROMV      ;TURN IT OFF
;   RET
;
;****** alteredet code starts here: ******************************************
;
CPROG:   MOV   DPTR,#PROGS   ;LOAD PROG LOCATION
   ;
CPROG1: ACALL   LD_T      ;LOAD THE TIMER
   CALL   DELTST      ;SEE IF A CR
   JNZ   PG8      ;SAVE TIMER IF SO
   MOV   R4,#0FEH
   SETB   INBIT
   ACALL   ROMFD      ;GET THE ROM ADDRESS OF THE LAST LOCATION
   CALL   TEMPD      ;SAVE THE ADDRESS
   MOV   A,R4      ;GET COUNT
   CPL   A
   CALL   TWO_R2      ;PUT IT ON THE STACK
   CALL   FP_BASE7   ;OUTPUT IT
   ACALL   CCAL      ;GET THE PROGRAM
   ACALL   CRLF      ;DO CRLF
   MOV   R0,TEMP4   ;GET ADDRESS
   MOV   R2,TEMP5
   MOV   A,#55H      ;LOAD SIGNIFIER
   INC   R6      ;LOAD LEN + 1
   INC   R7
CPROG2: ACALL   PG2
   ;
PGR:   AJMP   C_K      ;Exit to command mode
   ;
PG101:   INC   R7
   CJNE   R6,#0,PG4
   DEC   R7
   SJMP   PG4
   ;
PG10:   INC   R7
   ;
PG1:   MOV   P2,R3      ;GET THE BYTE TO PROGRAM
   MOVX   A,@R1
PG4:   LCALL   INC3210    ;BUMP POINTERS
   ;
PG2:   ACALL   PG7      ;Write the byte
   JNZ   PG5      ;exit if error
   DJNZ   R6,PG1
   DJNZ   R7,PG1      ;LOOP IF NOT DONE
   ;
PG5:   ANL   PSW,#11100111B   ;INSURE RB0
   JZ   PG31      ;Jump if none error
   ;
PG6:   JNB   DIRF,PG31   ;EXIT IF IN RUN MODE
   MOV   DPTR,#E16X   ;PROGRAMMING ERROR
ERRLK:   LJMP   ERROR      ;PROCESS THE ERROR
   ;
   ;
PG7:   MOV   R4,A      ;SAVE THE BYTE IN R4 for error detect
   mov   dph,r2      ;load data pointer with eeprom address
   mov   dpl,r0
   movx   @dptr,a    ;write the byte
   DB   07DH      ;mov    r5,#0
   ;
ZRO:   NOP
   NOP         ;SETTLEING TIME + FP ZERO
   NOP         ;Atenttion. This 6 NOP's a not only
   NOP         ;for settleing time, it is also the
   NOP         ;floating point zero!
   NOP
   MOV   TEMP5,#12   ;DELAY 30uS AT 12 MHZ
   DJNZ   TEMP5,$
   ACALL   TIMER_LOAD   ;START THE TIMER
   JNB   TF1,$      ;WAIT FOR PART TO PROGRAM
   movx   A,@DPTR    ;Read back for error detect
   xrl   A,R4      ;Test for error
   jz   PG31
   djnz   r5,ZRO
PG31:   RET
   ;
   ;**************************************************************
   ;
PGU:   ;PROGRAM A PROM FOR THE USER (statement 'PGM')
   ;
   ;**************************************************************
   ;
   MOV   PSW,#00011000B   ;SELECT RB3
   CJNE   R6,#0,PG10
   SJMP   PG1
;
;*****************************************************************************
;****** The new command "ERASE" to fill a EEPROM with 0FFH *******************
;****** Boehling 3 ***********************************************************
;
CERASE: mov   R7,#40H       ;Erase 16K byte
   mov   R6,#00H
   mov   R2,#HIGH ROMADR-1   ;Startaddress EEPROM
   mov   R0,#LOW ROMADR-1
   mov   DPTR,#PROGS      ;Point to EEPROM timeing
   acall   LD_T         ;Load the timer
   ;
ERA1:   lcall   INC3210       ;Bump pointers
   mov   A,#0FFH       ;Fill the EEPROM with 0FFH
   acall   PG7         ;Write the byte
   jnz   PG6         ;Exit if error
   DJNZ   R6,ERA1
   DJNZ   R7,ERA1       ;Do the loop
   ajmp   C_K         ;Exit to command mode
;
;*****************************************************************************
;
;****** continue with original code: *****************************************
   ;
   ;*************************************************************
   ;
CCAL:   ; Set up for prom moves
   ; R3:R1 gets source
   ; R7:R6 gets # of bytes
   ;
   ;*************************************************************
   ;
   ACALL   GETEND      ;GET THE LAST LOCATION
   INC   DPTR      ;BUMP TO LOAD EOF
   MOV   R3,BOFAH
   MOV   R1,BOFAL   ;RESTORE START
   CLR   C      ;PREPARE FOR SUBB
   MOV   A,DPL      ;SUB DPTR - BOFA > R7:R6
   SUBB   A,R1
   MOV   R6,A
   MOV   A,DPH
   SUBB   A,R3
   MOV   R7,A
CCAL1:   RET
   ;
   ;**************************************************************
   ;
TIMER_LOAD:; Load the timer
   ;
   ;*************************************************************
   ;
   ACALL   CCAL1      ;DELAY FOUR CLOCKS
TIMER_LOAD1:
   CLR   TR1      ;STOP IT WHILE IT'S LOADED
   MOV   TH1,T_HH
   MOV   TL1,T_LL
   CLR   TF1      ;CLEAR THE OVERFLOW FLAG
   SETB   TR1      ;START IT NOW
   RET
   ;
   ;***************************************************************
   ;
CROM:   ; The command action routine - ROM - Run out of rom
   ;
   ;***************************************************************
   ;
   CLR   CONB      ;CAN'T CONTINUE IF MODE CHANGE
   ACALL   RO1      ;DO IT
   ;
C_K:   LJMP   CL3      ;EXIT
   ;
;RO1:    CALL    INTGER    ;SEE IF INTGER PRESENT
;    MOV    R4,R0B0   ;SAVE THE NUMBER
;    JNC    $+4
;    MOV    R4,#01H   ;ONE IF NO INTEGER PRESENT
;   ACALL   ROMFD      ;FIND THE PROGRAM
;
RO1:   CALL   DELTST
   MOV   R4,#1
   JNC   RO11
   CALL   ONE
   MOV   R4,A
;
RO11:   ACALL   ROMFD
   CJNE   R4,#0,RFX   ;EXIT IF R4 <> 0
   INC   DPTR      ;BUMP PAST TAG
   MOV   BOFAH,DPH   ;SAVE THE ADDRESS
   MOV   BOFAL,DPL
   RET
   ;
ROMFD:   MOV   DPTR,#ROMADR+16 ;START OF USER PROGRAM
   ;
RF1:   MOVX   A,@DPTR    ;GET THE BYTE
   CJNE   A,#55H,RF3   ;SEE IF PROPER TAG
   DJNZ   R4,RF2      ;BUMP COUNTER
   ;
RFX:   RET         ;DPTR HAS THE START ADDRESS
   ;
RF2:   INC   DPTR      ;BUMP PAST TAG
   ACALL   G5
   INC   DPTR      ;BUMP TO NEXT PROGRAM
   SJMP   RF1      ;DO IT AGAIN
   ;
RF3:   JBC   INBIT,RFX   ;EXIT IF SET
   ;
NOGO:   MOV   DPTR,#NOROM
   AJMP   ERRLK
   ;
   ;***************************************************************
   ;
L20DPI: ; load R2:R0 with the location the DPTR is pointing to
   ;
   ;***************************************************************
   ;
   MOVX   A,@DPTR
   MOV   R2,A
   INC   DPTR
   MOVX   A,@DPTR
   MOV   R0,A
   RET         ;DON'T BUMP DPTR
   ;
   ;***************************************************************
   ;
X31DP:   ; swap R3:R1 with DPTR
   ;
   ;***************************************************************
   ;
   XCH   A,R3
   XCH   A,DPH
   XCH   A,R3
   XCH   A,R1
   XCH   A,DPL
   XCH   A,R1
   RET
   ;
   ;***************************************************************
   ;
LD_T:   ; Load the timer save location with the value the DPTR is
   ; pointing to.
   ;
   ;****************************************************************
   ;
   MOVX   A,@DPTR
   MOV   T_HH,A
   INC   DPTR
   MOVX   A,@DPTR
   MOV   T_LL,A
   RET
   ;
   ;
   ;***************************************************************
   ;
   ;GETLIN - FIND THE LOCATION OF THE LINE NUMBER IN R3:R1
   ;     IF ACC = 0 THE LINE WAS NOT FOUND I.E. R3:R1
   ;     WAS TOO BIG, ELSE ACC <> 0 AND THE DPTR POINTS
   ;     AT THE LINE THAT IS GREATER THAN OR EQUAL TO THE
   ;     VALUE IN R3:R1.
   ;
   ;***************************************************************
   ;
GETEND: SETB   ENDBIT      ;GET THE END OF THE PROGRAM
   ;
GETLIN: CALL   DP_B      ;GET BEGINNING ADDRESS
   ;
G1:   CALL   B_C
   JZ   G3      ;EXIT WITH A ZERO IN A IF AT END
   INC   DPTR      ;POINT AT THE LINE NUMBER
   JB   ENDBIT,G2   ;SEE IF WE WANT TO FIND THE END
   ACALL   DCMPX      ;SEE IF (DPTR) = R3:R1
   ACALL   DECDP      ;POINT AT LINE COUNT
   MOVX   A,@DPTR    ;PUT LINE LENGTH INTO ACC
   JB   UBIT,G3    ;EXIT IF EQUAL
   JC   G3      ;SEE IF LESS THAN OR ZERO
   ;
G2:   ACALL   ADDPTR      ;ADD IT TO DPTR
   SJMP   G1      ;LOOP
   ;
G3:   CLR   ENDBIT      ;RESET ENDBIT
   RET         ;EXIT
   ;
G4:   MOV   DPTR,#PSTART   ;DO RAM
   ;
G5:   SETB   ENDBIT
   SJMP   G1      ;NOW DO TEST
   ;
   ;***************************************************************
   ;
   ; LDPTRI - Load the DATA POINTER with the value it is pointing
   ;      to - DPH = (DPTR) , DPL = (DPTR+1)
   ;
   ; acc gets wasted
   ;
   ;***************************************************************
   ;
LDPTRI: MOVX   A,@DPTR    ;GET THE HIGH BYTE
   PUSH   ACC      ;SAVE IT
   INC   DPTR      ;BUMP THE POINTER
   MOVX   A,@DPTR    ;GET THE LOW BYTE
   MOV   DPL,A      ;PUT IT IN DPL
   POP   DPH      ;GET THE HIGH BYTE
   RET         ;GO BACK
   ;
   ;***************************************************************
   ;
   ;L31DPI - LOAD R3 WITH (DPTR) AND R1 WITH (DPTR+1)
   ;
   ;ACC GETS CLOBBERED
   ;
   ;***************************************************************
   ;
L31DPI: MOVX   A,@DPTR    ;GET THE HIGH BYTE
   MOV   R3,A      ;PUT IT IN THE REG
   INC   DPTR      ;BUMP THE POINTER
   MOVX   A,@DPTR    ;GET THE NEXT BYTE
   MOV   R1,A      ;SAVE IT
   RET
   ;
   ;***************************************************************
   ;
   ;DECDP - DECREMENT THE DATA POINTER - USED TO SAVE SPACE
   ;
   ;***************************************************************
   ;
DECDP2: ACALL   DECDP
   ;
DECDP:   XCH   A,DPL      ;GET DPL
   JNZ   DECDP1      ;BUMP IF ZERO
   DEC   DPH
DECDP1: DEC   A      ;DECREMENT IT
   XCH   A,DPL      ;GET A BACK
   RET         ;EXIT
   ;
   ;***************************************************************
   ;
   ;DCMPX - DOUBLE COMPARE - COMPARE (DPTR) TO R3:R1
   ;R3:R1 - (DPTR) = SET CARRY FLAG
   ;
   ;IF R3:R1 > (DPTR) THEN C = 0
   ;IF R3:R1 < (DPTR) THEN C = 1
   ;IF R3:R1 = (DPTR) THEN C = 0
   ;
   ;***************************************************************
   ;
DCMPX:   CLR   UBIT      ;ASSUME NOT EQUAL
   MOVX   A,@DPTR    ;GET THE BYTE
   CJNE   A,R3B0,D1   ;IF A IS GREATER THAN R3 THEN NO CARRY
            ;WHICH IS R3<@DPTR = NO CARRY AND
            ;R3>@DPTR CARRY IS SET
   INC   DPTR      ;BUMP THE DATA POINTER
   MOVX   A,@DPTR    ;GET THE BYTE
   ACALL   DECDP      ;PUT DPTR BACK
   CJNE   A,R1B0,D1   ;DO THE COMPARE
   CPL   C      ;FLIP CARRY
   ;
   CPL   UBIT      ;SET IT
D1:   CPL   C      ;GET THE CARRY RIGHT
   RET         ;EXIT
   ;
   ;***************************************************************
   ;
   ; ADDPTR - Add acc to the dptr
   ;
   ; acc gets wasted
   ;
   ;***************************************************************
   ;
ADDPTR: ADD   A,DPL      ;ADD THE ACC TO DPL
   MOV   DPL,A      ;PUT IT IN DPL
   JNC   ADDPTR1    ;JUMP IF NO CARRY
   INC   DPH      ;BUMP DPH
ADDPTR1:RET         ;EXIT
   ;
   ;*************************************************************
   ;
LCLR:   ; Set up the storage allocation
   ;
   ;*************************************************************
   ;
   ACALL   ICLR      ;CLEAR THE INTERRUPTS
   ACALL   G4      ;PUT END ADDRESS INTO DPTR
   MOV   A,#6      ;ADJUST MATRIX SPACE
   ACALL   ADDPTR      ;ADD FOR PROPER BOUNDS
   ACALL   X31DP      ;PUT MATRIX BOUNDS IN R3:R1
   MOV   DPTR,#MT_ALL   ;SAVE R3:R1 IN MATRIX FREE SPACE
   ACALL   S31DP      ;DPTR POINTS TO MEMTOP
   ACALL   L31DPI      ;LOAD MEMTOP INTO R3:R1
   MOV   DPTR,#STR_AL   ;GET MEMORY ALLOCATED FOR STRINGS
   ACALL   LDPTRI
   CALL   DUBSUB      ;R3:R1 = MEMTOP - STRING ALLOCATION
   MOV   DPTR,#VARTOP   ;SAVE R3:R1 IN VARTOP
   ;
   ; FALL THRU TO S31DP2
   ;
   ;***************************************************************
   ;
   ;S31DP - STORE R3 INTO (DPTR) AND R1 INTO (DPTR+1)
   ;
   ;ACC GETS CLOBBERED
   ;
   ;***************************************************************
   ;
S31DP2: ACALL   S31DP      ;DO IT TWICE
   ;
S31DP:   MOV   A,R3      ;GET R3 INTO ACC
   MOVX   @DPTR,A    ;STORE IT
   INC   DPTR      ;BUMP DPTR
   MOV   A,R1      ;GET R1
   MOVX   @DPTR,A    ;STORE IT
   INC   DPTR      ;BUMP IT AGAIN TO SAVE PROGRAM SPACE
   RET         ;GO BACK
   ;
   ;
   ;***************************************************************
   ;
STRING: ; Allocate memory for strings
   ;
   ;***************************************************************
   ;
   LCALL   TWO      ;R3:R1 = NUMBER, R2:R0 = LEN
   MOV   DPTR,#STR_AL   ;SAVE STRING ALLOCATION
   ACALL   S31DP
   INC   R6      ;BUMP
   MOV   S_LEN,R6   ;SAVE STRING LENGTH
   AJMP   RCLEAR      ;CLEAR AND SET IT UP
   ;
   ;***************************************************************
   ;
   ; F_VAR - Find   the variable in symbol table
   ;     R7:R6 contain the variable name
   ;     If not found create a zero entry and set the carry
   ;     R2:R0 has the address of variable on return
   ;
   ;***************************************************************
   ;
F_VAR:   MOV   DPTR,#VARTOP   ;PUT VARTOP IN DPTR
   ACALL   LDPTRI
   ACALL   DECDP2      ;ADJUST DPTR FOR LOOKUP
   ;
F_VAR0: MOVX   A,@DPTR    ;LOAD THE VARIABLE
   JZ   F_VAR2      ;TEST IF AT THE END OF THE TABLE
   INC   DPTR      ;BUMP FOR NEXT BYTE
   CJNE   A,R7B0,F_VAR1   ;SEE IF MATCH
   MOVX   A,@DPTR    ;LOAD THE NAME
   CJNE   A,R6B0,F_VAR1
   ;
   ; Found the variable now adjust and put in R2:R0
   ;
DLD:   MOV   A,DPL      ;R2:R0 = DPTR-2
   SUBB   A,#2
   MOV   R0,A
   MOV   A,DPH
   SUBB   A,#0      ;CARRY IS CLEARED
   MOV   R2,A
   RET
   ;
F_VAR1: MOV   A,DPL      ;SUBTRACT THE STACK SIZE+ADJUST
   CLR   C
   SUBB   A,#STESIZ
   MOV   DPL,A      ;RESTORE DPL
   JNC   F_VAR0
   DEC   DPH
   SJMP   F_VAR0      ;CONTINUE COMPARE
   ;
   ;
   ; Add the entry to the symbol table
   ;
F_VAR2: LCALL   R76S      ;SAVE R7 AND R6
   CLR   C
   ACALL   DLD      ;BUMP THE POINTER TO GET ENTRY ADDRESS
   ;
   ; Adjust pointer and save storage allocation
   ; and make sure we aren't wiping anything out
   ; First calculate new storage allocation
   ;
   MOV   A,R0
   SUBB   A,#STESIZ-3   ;NEED THIS MUCH RAM
   MOV   R1,A
   MOV   A,R2
   SUBB   A,#0
   MOV   R3,A
   ;
   ; Now save the new storage allocation
   ;
   MOV   DPTR,#ST_ALL
   CALL   S31DP      ;SAVE STORAGE ALLOCATION
   ;
   ; Now make sure we didn't blow it, by wiping out MT_ALL
   ;
   ACALL   DCMPX      ;COMPARE STORAGE ALLOCATION
   JC   CCLR3      ;ERROR IF CARRY
   SETB   C      ;DID NOT FIND ENTRY
   RET         ;EXIT IF TEST IS OK
   ;
   ;***************************************************************
   ;
   ; Command action routine - NEW
   ;
   ;***************************************************************
   ;
CNEW:   MOV   DPTR,#PSTART   ;SAVE THE START OF PROGRAM
   MOV   A,#EOF      ;END OF FILE
   MOVX   @DPTR,A    ;PUT IT IN MEMORY
   ;
   ; falls thru
   ;
   ;*****************************************************************
   ;
   ; The statement action routine - CLEAR
   ;
   ;*****************************************************************
   ;
CNEW1:   CLR   LINEB      ;SET UP FOR RUN AND GOTO
   ;
RCLEAR: ACALL   LCLR      ;CLEAR THE INTERRUPTS, SET UP MATRICES
   MOV   DPTR,#MEMTOP   ;PUT MEMTOP IN R3:R1
   ACALL   L31DPI
   ACALL   G4      ;DPTR GETS END ADDRESS
   ACALL   CL_1      ;CLEAR THE MEMORY
   ;
RC1:   MOV   DPTR,#STACKTP   ;POINT AT CONTROL STACK TOP
   CLR   A      ;CONTROL UNDERFLOW
   ;
RC2:   MOVX   @DPTR,A    ;SAVE IN MEMORY
   MOV   CSTKA,#STACKTP
   MOV   ASTKA,#STACKTP
   CLR   CONB      ;CAN'T CONTINUE
   RET
   ;
   ;***************************************************************
   ;
   ; Loop until the memory is cleared
   ;
   ;***************************************************************
   ;
CL_1:   INC   DPTR      ;BUMP MEMORY POINTER
   CLR   A      ;CLEAR THE MEMORY
   MOVX   @DPTR,A    ;CLEAR THE RAM
   MOVX   A,@DPTR    ;READ IT
   JNZ   CCLR3      ;MAKE SURE IT IS CLEARED
   MOV   A,R3      ;GET POINTER FOR COMPARE
   CJNE   A,DPH,CL_1   ;SEE TO LOOP
   MOV   A,R1      ;NOW TEST LOW BYTE
   CJNE   A,DPL,CL_1
   ;
CL_2:   RET
   ;
CCLR3:   JMP   TB      ;ALLOCATED MEMORY DOESN'T EXSIST
   ;
   ;**************************************************************
   ;
SCLR:   ;En
Bana e^st de diyebilirsiniz.   www.cncdesigner.com

z

Bana e^st de diyebilirsiniz.   www.cncdesigner.com