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;
Mantık hatası var. fonksiyonlar birbirine bağımlı olup bu gibi işler olmayacak işlerdir
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.
@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.
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.
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.
@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
@bunalmis hocam Call tipi komutları delphi içinden kullanabilirsiniz.
http://delphi.about.com/library/bluc/text/uc052501a.htm (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.
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?
@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.
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
@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= (http://www.delphi3000.com/articles/article_2786.asp?SK=)
Bu örnekte işinizi görmezse tüm kodunuzu delphi ile kullanabileceğiniz şekilde ASM hali ile derleyebilirsiniz.
@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
Donenin kasigi kirilsin.