An example of Scope Checking in M2000

This code is in a module A

We do this: Start M2000 Environment, Write Edit A and press Ente then rpaste the code press Esc write A press Enter. Just so simple. Write Save example1 so now you can do next time Load example1. Use New if you have another, or better write Start press enter to make a soft reset. Also you can clear variables only (and static variables) using Clear. You can empty the Stack of values using Flush.

Function Master {
    Module Alfa {
        Gosub 100
        Global M=1000
        \\ delta print 1000
        delta
        End
    100    Print Module(Beta)=False
        Print Module(Delta)=True
        Return
    }
    Group Object1 {
        Function Master {
            =M
        }
        Module Final Beta {
            \\ delta print 500
            delta
            alfa()
            Sub alfa()
                Local N=@Kappa(3)
                Global M=N
                \\ delta print 1500
                Delta
                Print This.Master()=1500
                N=@Kappa(6)
                \\ change value of M, not shadow M like Global M
                M<=N
                \\ delta print 9000
                Delta
                Print .Master()=9000
            End Sub
            Function Kappa(K)
                =M*K
            End Function
        }
    }
    Module Global Delta {
        Goto name1
        \\ a remark here
    
    name1:
        Print Module(Alfa)=False
        Print Module(Beta)=False
        Print Module(Delta)=True
        Print M
    }
    
    \\ This is the program
    K=100
    Global M=500
    Alfa
    Object1.Beta
    Print Object1.Master()=500
    Print K=100, M=500
}

Call Master()
\\ No variables exist after the return from Master()
Print Valid(M)=False

Dynamic & Lexical Scope in M2000, and lifetime of entities

Dynamic Scope
This example run in a module
(print 3 and 1)

\\ x isn't global
\\ but x is visible from subs in this module
x=1
f()
Print x
sub g()
      Print x
      x=2
end sub

sub f()
      local x=3
      g()
end sub


Lexical Scope
This example run in a module and return 1 and 2. We need to make Global x and Global g(), and also to change a global value we need to use <= and not a  simple =
(print 1 and 2)

Global x=1
Function Global g {
     Print x
     \\ for globals we have to use <=
     x<=2
}
Function f {
      \\ x=3 make a local x, or if x exist as local then change value to 3
      \\ but local x make always a new variable
      \\ so Local x,x,x make three x and last one is visible.
      Local x=3
      Call g()
}
Call f()
Print x


Lexical Scope using only one global x
(print 1 and 2)

Global x=1
Function f {
      Function g {
           Print x
           \\ for globals we have to use <=
           x<=2
      }
      x=3
      Call g()
}
Call f()
Print x

Dynamic Scope using functions
(print 3 and 1)
We use Call Local which call functions with parent name. So each time scope is the same. Here x=3 in Function F can't make a local x, we have to use Local x=3.

x=1
Function g {
     Print x
     x=2
}
Function f {
      Local x=3
      Call local g()
}
Call Local f()
Print x

Dynamic Scope using Global to shadow global

\\ Dynamic scope
Global b=5
Function Global foo {
      a=b+5
      =a
}
Function bar {
      Global b=2
      =foo()
}

Print foo()
Print bar()


Print 10 and 7

Lexical (Static) Scope  (just not using global b in bar)

\\ Static Scope
Global b=5
Function Global foo {
      a=b+5
      =a
}
Function bar {
      b=2
      =foo()
}

Print foo()
Print bar()

print 10 and 10

Lifetime of an entity

Entities are named values/containers (we say variables, but include constants) and named code
A name scope begins where first time interpret assign value, or perform a declaration which automatic assign zero/empty_string/empty_array values. This is not true for subs, because subs names searched once from the bottom, when we call them, and in an another call interpreter use a hash table to get entry point for them. The same happen for labels, numeric or named, for Goto and Gosub (simple routines, exactly like Basic's), interpreter use a hash table to find them. These hash tables cleared after the use of an Inline statement. Lables/Subs can called from any direction. Block {} of code are exit using goto.


Function something {
      \\ test simple goto (else 200 is same like else goto 200)
      \\ and simple routines using gosub
      x=1
      {
            gosub alfa
            {
                  gosub alfa
                  {
                        gosub alfa
                       if x>1 else 200
                  }
                  Print "ok2"
            }
      200 Print "ok3"
      210 x++
      220 if x<5 then loop
      }
      Print "ok4"
      exit
      alfa:
      Print "ok"
      Return
}
Call Something()






A clear command inside a module/function clear variables from that module/function and newer. A clear command in manual mode clear every variable, global and static, and perform garbage collection. Using command Flush Garbage we can perform garbage collection without clearing variables.
Named entities have lifetime of parent (entity which defines entities). Global entities have same lifetime as normal.

Threads (have no name but a handler) normally have also lifetime same as parent module/function, except for those threads that starts in a thread, so they have no parent.

Com external objects, or internal Com like GUI elements (Forms, Controls), and properties for them (early bindings to objects), have also life time  same of parent. Pointers for them are "smart" which means that one pointer only exist for one object, and every time we need a pointer as a copy of pointer, we get just  a reference to first name which hold the actual pointer
Groups (standard objects of M2000), are value types and can be named, so have lifetime of parent, or can be copied in containers, and then can be leave until a new group replace them or when containers get out of scope.
Arrays, Inventories (inventory, an association list with hash table), Stacks are three type of containers, and handled by pointers. Arrays are two kinds, those arrays that can be copied, and those that can be passed by pointer. In each case, using stack to pass an array always passed a pointer to array, end when we pop the array we get a pointer to a copy of array or a copy of pointer to array depends of where we read, if we read pointer to a name with parenthesis "()" then we get a copy (shallow copies, for containers in containers, but copies for groups in containers), else if we read a simple name (without ( or  % or $ as last symbol) we get pointer to array. There is no null pointer for containers. There are empty containers, or a starting value of a double, and then this can be change to a pointer to a container, and can get any type of container, but no a double value (is a Missing Object error)

Event objects are value types, so we get always a copy, and these leave like any named entity. Events hold code for functions, and sometimes we want some functions to run in a group context because are functions belonging to groups, or in module context, changing function to act as module, replacing the name appropriate and automatic (Using a Lazy$() function, see example below), we say that these functions utilize another context (parent group or parent module). If we get a copy of event and later call event (means raise event), calling all functions inside (multicast), and if some of them utilize another context, maybe we get an error if any of these functions is out of context.

Lambda functions may have closures as local for them, and any call of them (recursive call using Lambda() or lambda$() as name of function). Lambda functions are value types, we can copy them. Containers as closures copied by pointer (so they passed by reference). A lambda function has own context as a black box. Each lambda function has a name without parenthesis to use it as an entity and a name with parenthesis to call the included function. If we pass by reference a lamda function, as function reference then we miss the object, and all variables inside lambda object. If we pass by reference the lambda object then we get all, closures and the included function. If we pass by value we get a copy of all (except those closures that are pointers, so we get a copy of that pointers)

Lifetime for a Bag for static variables. Each call from a parent to a child may hold a bag of static variables. These variables can be cleared if parent bag cleared. Functions that are called by Events objects that are used by forms, feed global bag,so we have to clear global bag manual from M2000 terminal.
Static variables created per calling object (first object is the terminal's execution object, and all other are children, or children of children). So static variables can be erased if a clear command executed at parent, except for terminal, which has no parent, and clear then clear all static variables.

Static modules/functions are those in level 0, and are visible in terminal mode. They can erased using New, erase modules/functions list, or Start (warm reset for M2000 runtime environment), or using remove for removing the newest of them. They can change definition using Set Load (like load from terminal) or using load from terminal. Also we can change definition by editing it as it run, but edited definition can be used next time, or when we call a sub or using goto to a label (which first time we use in the first code, after edit command)

A Sub is named code in module or function, and uses parent context, all parent context is visible in sub, but also can make temporary variables and modules/functions. Subs have no static variables, they use parent static variables.
A For object {} block define a block for temporary definitions. A for This {} block can be used any where for temporary definitions.


Scope
Static A after local A is an error, we can't mix static and local with same name. Local A after static A has same effect but no error happen. If we perform A++ then local A change, not static A, and always we read static A first.


A Local A shadow Global A, for lifetime of local one. A second Local A shadow old Local A, for life time of second one.

Any local variable is visible in module/Function/Sub/For object block, where defined
Any Global variable is visible from where we define it., but we can shadow it with a local with same name.

If we use global const x=123456 then we have to use inside a child module "const x" without value to make a reference as local x to prevent a new local by using X=10

Check Visibility by code
We can check if a variable is visible using Valid(). We can check if a module/function exist using module$(). We can't examine if a sub exist.
local modules/functions are not visible by child modules and parent modules. This hold for variables.
We can decorate a module by replacing a inner module definition at calling, and for that call only, using a parent module. Module Decoration is a way to handle code inside module at calling. functions and subs can't decorated.
We can load libraries, as local/global modules/functions. Loading as global may we change existing globals, if we use Set Load nameoledib. To get global without altering global with same names, we have to explicity define modules as globals in library. So we load library as local and get modules as globals, shadowing any global with same name.

A group in a container has all data encapsulated (closed for altering). When we use it, interpreter open it using a hidden name, and at the end all data closed again. We can define private and public members for groups. Also we can define class members (members that is no actual members of group, but act as members). A local member (variable) in a closed group always intialised at the opening, and never save value, but can alter value in lifetime of opening. A local member in a named group (not in container) never be referenced, among other members when we pass group by reference (and this is a way to check if a group is a reference or not). A reference of group is a new group which have all members passed by reference, on another group. (it is not a pointer to group). In a reference of group we can add members, but this addition wasn't performed in first group)/

A SuperClass is a group with an internal pointer to a closed group, with no members. When we asign a superclass or a group with superclass in a name then performed a copy of all members of superclass (except those members that we defined as unique to super class) plus a setting to group internal superclass pointer to that superclass. A group may have many sub groups and each sub group may have own super class. Superclasses can't hold pointer to any superclass. When we use For SuperClass {} to access superclass, interpreter open superclass, but always allow one time opening,and if second time happen before first closed then an error occur. Superclass used for holding common members. If no pointer to superclass exist then superclass removed.

A Class definition is a function which return a group. A class is always global, except those class definitions inside classes or groups which are member to group.

Group A {
      X=10
}
Module alfa (&B) {
      Group B {
            Y=30
      }
      Module delta (&C) {
            Group C {
                  Module XY {
                        Print .X*.Y
                  }
            }
            C.X/=2
            Push C
      }
      delta &B
}
alfa &A
A.X+=100
Print A.X
Read AA
AA.XY
Rem : list  \\ unhide List to see list of variables)



Example for changing code using editor as code runs.
edit a
(open editor for module A)
inline "edit "+module$
goto 100
(press esc to exit)
When run this, using A as command in M2000 terminal, you get editor with context above. So delete all and leave first line empty then write from second line 100 Print "Ok"
\\ one line left
100 Print "Ok"

(Press Exit) and now you get Ok because interpreter search from second line for label 100, and found it. If no label 100 exist then goto used as exit. A goto to a not exist label is an exit (same for a Gosub to a non exist label, but Gosub to a non exist sub is an error).

\\ Example of using user event in a Form
\\ use clear before enter this module to clear all conainers for static variables
clear
Declare alfa form event aa
X=1
Function that {
      Stack
      Static Y=100
      ' show all messages which they don't use arguments by reference
      ' using Lazy$() we push this function at the same lexical scope as
      ' parent, which is the same for X, so X is visible
      X++
      Y++
      Print X, Y

}
Function that1 {
      Static X=10000
      Stack
      X++
      Print X
      if X>10020 then {
            Drop : Read &Form1
            Print Type$(Form1)
            Method Form1, "CloseNow"
      }
      ' get same message
      ' but X isn't visible
      refresh
}
Event aa New Lazy$(&that()), &that1()
method alfa,"show", 1
Declare alfa nothing

Mini Lisp (Μ2000 code, 2 versions)

Παράδειγμα γραμμένο σε Μ2000. Ένας μίνι μεταφραστής της Lisp . Αυτόν έφτιαχνα πριν μερικές βδομάδες και μου ήρθε ιδέα να προχωρήσω τη γλώσσα, και πράγματι βρήκα πολλά και νέα πράγματα και μικροπροβλήματα που έλυσα.
Ανοίγουμε τον διερμηνευτή, γράφουμε Σ Α ώστε να ανοίξει η Συγγραφή (ο διορθωτής), με το τμήμα Α που θα βάλουμε το κώδικα παρακάτω και μας εμφανίζει αυτό (έχω αλλάξει σε 60 χαρακτήρες τη κονσόλα, ενώ στο πρόγραμμα γράφει 80)

Ο χρόνος εκτέλεσης δεν μας πειράζει εδώ. Χρησιμοποιώ Windows 7 σε VirtualBox σε Linux.

Εκτελούμε το παρακάτω δοκιμαστικό πρόγραμμα σε Mini Lisp, αν μια λέξη στην αρχή μιας λίστας ( ) δεν την γνωρίζει ο διερμηνευτής τότε την γυρνάει σαν αποτέλεσμα! Οι εντολές έχουν σημειωθεί με bold (με το χέρι...)

"hello there this is a string"  ; this is going to result
(write 1223345.788)(defvar Hello "M2000")(write Hello)
(write 121 "Hello again...")
(eq 7 7)(write (list 1 2 4 5))(defvar A (+ 7 9 13 1 5 7) ) (write A  (- A 10) (* A 3) (/ 5 2))
(defvar (a b c d) 100)(write a b c d)(setq a (+ a 1))(write '(a =) a)(write (car '(a b c))(cdr '(a b c))) ; remark
(write (cons 'a '(b c)))(write George 'Karras)(write (eq a 101))
(this is written as result)(write '(This written before results) (+ a 1))
(quote (Hello 1 There a b))  '(Hello 2 There a b)(eq 5 5)
(loop (write a) (eq a 107) (setq a (+ a 1))) (write (list 1 A (+ A 1) 3 4 5))
(write 1 A (+ A 1) 3 4 5)
(write (If t 5 6))  (write ok)
(write (If nil (list 1 2 3) (list 4 5 6)))
(write (If nil 5 6))
(write (If t (list 1 2 3) (list 4 5 6)))

Profiler
EntryLevel =0
Module forall {  
      Local MyAcc$
      Document MyAcc$
      Clear Buffer$  \\ through old object and get a new one /  = is For append
      Call Local Parser(level,  &MyAcc$)
}
Module Comm {
      Read proc$
      Call ! Local forall
      Local dummy$=paragraph$(MyAcc$,-1,-1)
      Local a, d, acc
      Long a, d=forward(MyAcc$, a)  \\ there is a  backward() function too
      If d<>0 Then {
      Select Case proc$
      Case "+"
      { While a<>0 { acc+=Val(paragraph$(MyAcc$, (a))) }}
      Case "-"
            {         If a<>0 Then   acc=Val(paragraph$(MyAcc$, (a))) 
                       While a<>0 { acc-=Val(paragraph$(MyAcc$, (a)))  }}
      Case "*"
            { acc=1: While a<>0 { acc*=Val(paragraph$(MyAcc$, (a))) }}
      Else  '  Case "/"
            { acc=1
                  If a<>0 Then  acc=Val(paragraph$(MyAcc$, (a))) 
                  While a<>0 { acc/=Val(paragraph$(MyAcc$, (a))) }}
      End Select    
       Accum$=Format$("{0}", acc)+nl$
      } 
}
Module CommWrite {
      Call ! Local forall
      Print "Lisp:";
      Local i, f=Doc.Par(MyAcc$)
      If f>1 Then {
      f--  : If f>1 Then Print "(";
      For i=1 to f
            Print paragraph$(MyAcc$, i); : If i<f Then  Print " ";
      Next i
      }
      If f>1 Then { Print ")" } Else Print
}
Module LoopLisp {
      Local dummy$ : Clear Buffer$
      cnt++ : Local backhere=cnt
      Local mylevel=level
      {
            Call Local Parser(myLevel, &Accum$)
            dummy$=paragraph$(Accum$,-1,-1)     \\ throw  last nl$
            dummy$= paragraph$(Accum$,-1,-1)
            Accum$=nl$  \\ insert  last nl$
            If dummy$="t" Then Exit
            cnt=backhere
            level=mylevel
            loop   
      }          
}
Module MyList {
      Local MyAcc$
      Document MyAcc$ : Clear Buffer$
      Call Local Parser(level, &MyAcc$)
      Accum$="("+Trim$(Replace$(nl$," ", MyAcc$))+")"+nl$       
}
Module Myif {
      Call ! Local forall
      If paragraph$(MyAcc$, 1)="t" Then {
            Accum$=paragraph$(MyAcc$, 2)+nl$
      } else {
            Accum$=paragraph$(MyAcc$, 3)+nl$
      }
}
Module DefVar {
      Local MyAcc$, Iddoc$
      Document MyAcc$, Iddoc$ : Clear Buffer$
      cnt++
      Call Local Parser(level,  &Iddoc$, True)
      Call Local Parser(level,  &MyAcc$)
      Local id$=paragraph$(Iddoc$, 1,-1)  \\ third parameter If is -1 Then delete the paragraph 
      If id$="" Then Error "No name For variable"
      While Doc.Par(iddoc$)>0 {
            Call Local PrintNewLine "Var :"+id$
            If not exist(Mem,id$) Then {
                  Append Mem, id$:=MyAcc$
            } Else Error "Variable "+id$+" already defined"
           id$=paragraph$(Iddoc$, 1,-1)
      }
}
Module SetVar {
      Local MyAcc$, Iddoc$
      Document MyAcc$, Iddoc$ : Clear Buffer$
      cnt++
      Call Local Parser(level, &Iddoc$, True)
      cnt--
      Call Local Parser(level, &MyAcc$)
      Local id$=paragraph$(Iddoc$, 1,-1)  \\ third parameter If is -1 Then delete the paragraph 
      If id$="" Then Error "No name For variable"
      While Doc.Par(iddoc$)>0 {
            Call Local PrintNewLine "Var :"+id$
            If exist(Mem,id$) Then {
                  Return Mem, id$:=MyAcc$
            } Else Error "No such variable"
           id$=paragraph$(Iddoc$, 1,-1)
      }
}
Module Cons {
      Call ! Local forall
      Accum$=MyAcc$
}
Module Remark {
     while cnt<=tmproof {
           cnt++
           If mid$(a$, cnt,2)=nl$ Then cnt++ : exit
     }
}
Module String {
     Local check=cnt
     Clear Buffer$ : numeric=false
     while cnt<=tmproof {
           cnt++
           If mid$(a$, cnt,1)=qu$ Then exit
     }
     if cnt-check>1 Then { Buffer$=Mid$(a$,check, cnt-check+1)} Else Buffer$={""}
}
Module  PrintBuffer {
      If Doc.Len(Buffer$)>0 Then {
                  If exist(Mem, Buffer$) and not GetQuote Then {
                       Accum$=Mem$(Buffer$)
                  } else   Accum$=Buffer$+nl$
            Call Local PrintNewLine Buffer$
            Clear Buffer$ : prints++
      }
}
Module PrintNewLine {
      Read New What$
     If mess Then Print what$
}
Module StopChar {
      Read New val    
      com = val=1
      level+=val
      If GetQuote And level<=EntryLevel Then Call Local PrintBuffer : GetQuote=false: tmproof=cnt : Exit
      If val<>0 Then Local oldprints=prints : prints=0
      Call Local PrintBuffer
      If profil=1 And val=-1 Then If prints=0 Then If oldprints=prints Then Buffer$="()" : Call Local PrintBuffer
      profil=val
}
Module StopCharZero {
      If GetQuote And level=EntryLevel Then Call Local PrintBuffer:GetQuote=false: tmproof=cnt : Exit
      If com Then Call Local CheckCommand
      If not com Then Call Local PrintBuffer : Exit
}
Module StorePeriod {
      If Doc.Len(Buffer$)=0 Then Call Local StoreNumeric : Exit
      If numeric Else Call Local StoreLabel : Exit  \\ see Else, same as If not numeric Then
      If Instr(Buffer$,".")>0 Then Call Local PrintBuffer
      Call Local StoreNumeric
}
Module StoreSign {
      If Doc.Len(Buffer$)>0 And numeric Then Call Local PrintBuffer : Call Local  StoreNumeric : Exit
      Call Local StoreNumeric  \\ maybe numeric=False so this is like storelabel...
}
Module StoreNumeric {
      If Doc.Len(Buffer$)=0 Then  numeric=True 
      buffer$=one$
}
Module StoreLabel {
      numeric=False
      buffer$=one$
}
Module CheckCommand {
      com=false
      If GetQuote Then Exit
      If numeric Then {
            If Doc.Len(Buffer$)=1 Then If Instr("*/+-",Buffer$)>0 Then Exit
            Exit
      }
      If Exist(commands, Buffer$) Then Inline "Call Local "+Eval$(commands)
}
Module Sym {
      Read new w$
      Call ! Local forall
      If Evall(quote$(paragraph$(MyAcc$, 1) )+ w$+ Quote$(paragraph$(MyAcc$, 2) )) Then {
       Accum$=t$  } Else  Accum$=nil$
}
Module Quote {
      Clear Buffer$
      cnt++
      Call Local Parser(level, &Accum$, True)
      cnt--
}
Module Car {
      Call ! Local forall     
      Accum$=paragraph$(MyAcc$, 1)+nl$
}
Module Cdr {
      Call ! Local forall     
      Local drop$=paragraph$(MyAcc$, 1,-1)
      Accum$=MyAcc$
}
Module Eq {
      Call ! Local forall
      If paragraph$(MyAcc$, 1)=paragraph$(MyAcc$, 2) Then {
            Accum$=t$
      } Else  Accum$=nil$
}
Function Parser {
      Read New EntryLevel,  &Back$
      Local GetQuote  
      Read ? GetQuote  \\ this is an optional argument For Parser
      Local tmproof=roof, Accum$
      Document Accum$
{
      If level<EntryLevel Then cnt-- : Back$=Accum$ : Exit
      one$=mid$(a$,cnt,1)
      \\ warning in each Case one command in one line or use { } For multiple commands/lines
      \\ no empty lines allowed. 
      Select Case one$
      Case  qu$
            Call Local String
      Case ";"  \\ remark
            Call Local Remark
      Case "'"  \\ quote
            Call Local Quote
      Case "("
            Call Local StopChar, 1 ''StopChar(1)
      Case ")"
            Call Local StopChar, -1 ''StopChar(-1)
      Case " ", Ch10$, Ch13$  ' white space too
            Call Local StopCharZero
      Case "0" to "9"
            Call Local StoreNumeric
      Case "."
            Call Local StorePeriod
      Case "-", "+"
            Call Local StoreNumeric
      Else
            Call Local StoreLabel
      End Select
      cnt++
      If cnt<=tmproof Then Restart
      Back$=Accum$
      }
}
\\ Mini lisp ver 0.01
Clear \\ clear variables
Flush \\ empty stack
Form 80,48
Print "MiniLisp Ver 0.01"
Scroll Split  Row  \\ make this row start of scrolling screen
\\ A simple lisp interpreter written in M2000 by George Karras
\\For Documents "=" is For append text. Clear a$, give a new object Document.
Document a$={
                        "hello there this is a string"  ; this is going to result
                        (write 1223345.788)(defvar Hello "M2000")(write Hello)
                        (write 121 "Hello again...")
                        (eq 7 7)(write (list 1 2 4 5))(defvar A (+ 7 9 13 1 5 7) ) (write A  (- A 10) (* A 3) (/ 5 2))
                        (defvar (a b c d) 100)(write a b c d)(setq a (+ a 1))(write '(a =) a)(write (car '(a b c))(cdr '(a b c))) ; remark
                        (write (cons 'a '(b c)))(write George 'Karras)(write (eq a 101))
                        (this is written as result)(write '(This written before results) (+ a 1))
                        (quote (Hello 1 There a b))  '(Hello 2 There a b)(eq 5 5)
                        (loop (write a) (eq a 107) (setq a (+ a 1))) (write (list 1 A (+ A 1) 3 4 5))
                        (write 1 A (+ A 1) 3 4 5)
                        (write (If t 5 6))  (write ok)
                        (write (If nil (list 1 2 3) (list 4 5 6)))
                        (write (If nil 5 6))
                        (write (If t (list 1 2 3) (list 4 5 6)))

                        }                       
Print "Parse:";
Report a$
Print
nl$={
} \\ nl$ is new line
Let level=0, one$="", numeric=False, prints=0, com=False, profil=1, ch10$=chr$(10),ch13$=chr$(13), qu$=chr$(34)
Let mess=false '\\true   \\ For messages
Let cnt=1, roof=len(a$), comlevel=-1 
' no command
Document Buffer$, Result$
\\ Inventory is a hash table.
Inventory commands="+":="Comm {+}",  "-":="Comm {-}" , "*":="Comm {*}", "/":="Comm {/}", "write":="CommWrite", "car":="Car", "cdr":="Cdr", "cons":="Cons",  "defvar":="DefVar", "eq":="Eq", "setq":="SetVar", "quote":="Quote", "loop":="loopLisp",">":="Sym {>}" ,"<":="Sym {<}", ">=":="Sym{>=}","<=":="Sym{<=}", "<>":="Sym{<>}", "list":="MyList","If":="Myif"
Clear t$, nil$
\\ we want a paragraph only - with new line
Inventory mem  \\ For variables
t$="t"+nl$
nil$="nil"+nl$
Append Mem, "t":=t$,"nil":=nil$
Try ok {  Call Local Parser(level,  &Result$)}
If Error or Not Ok Then Print Error$
If level>0 Then Error "more ("
If Not Mess Then {
      Report 2, "Results" 
      Report Replace$(nl$," ", Result$)
}
Print Timecount

Το παραπάνω πρόγραμμα με Ρουτίνες αντί για τμήματα. Ο σκοπός εδώ είναι να μειωθεί η χρήση του stack του exe, και οι ρουτίνες στη Μ2000 χρησιμοποιούν δικό τους σωρό επιστροφής, και για το λόγο αυτό έχουν μεγάλο αριθμό για κλήσεις με αναδρομή (μπορεί κανείς να θέσει όριο 100000, και το βάζουμε μόνο για να πετύχουμε τα τυχόν λάθη στο κώδικα). Πρέπει όμως να μην κάνουμε κλήση ρουτίνας μέσα από μπλόκ { } γιατί τα μπλόκ καλούν συνάρτηση εσωτερικά άρα χρησιμοποιούν τον στάνταρ σωρό του exe. Όπου καλούμε την Parser() προσέχουμε να μην είναι μέσα σε μπλοκ. (αφήνουμε τα μπλοκ για άμεσες επαναλήψεις).
Επιπλέον στο πρόγραμμα μπήκε μια βελτιστοποίηση στον Parser με πρόσθετη Κατάσταση που σημαίνει ότι η αναζήτηση στη κατάσταση γίνεται άμεσα. Βέβαια δεν έχει μεγάλη διαφορά, γιατί ακόμα και ο χρόνος χρήσης του κλειδιού στην Κατάσταση σε σχέση με το κλειδί στην Select Case, μπορεί να μην είναι τόσο καλύτερος, ειδικά αν το Select Case είναι μικρό. Πάντως εδώ κερδίζουμε.
Τα goto, και τα Gosub (όλες οι ρουτίνες καλούνται με Gosub, απλά είναι προαιρετικό να το γράψουμε, εκτός και αν υπάρχει πίνακας με ίδιο όνομα, και έτσι φαίνονται οι ρουτίνες από τις παρενθέσεις, σαν συναρτήσεις χωρίς να επιστρέφουν τιμή). Οι ρουτίνες βλέπουν ότι βλέπουμε και στο τμήμα που τρέχουν, δηλαδή και τις άλλες ρουτίνες και τον εαυτό τους, και τις μεταβλητές του τμήματος.

X=10
Gosub Alfa()
Alfa()   \\ same as Gosub Alfa()
List \\ here we see only one X=10, M not exist


Sub Alfa()
Local X=20, Μ=10

List  \\ here we see X=10 and X=20 and M=10
End Sub

Υπάρχει και άλλος τύπος ρουτινών με ετικέτα με γράμματα ή αριθμό αλλά αυτές δεν καθορίζουν προσωρινό χώρο για μεταβλητές. Σε κάθε περίπτωση η έκδοση 8.4 καταγράφει τις θέσεις μετά την πρώτη αναζήτηση και στην δεύτερη τις βρίσκει από πίνακα κατακερματισμού (Hash Table), όπως βρίσκει και τα Τμήματα/Συναρτήσεις (παλαιότερα δεν γίνονταν αυτό).

Profiler
EntryLevel =0
\\ Mini lisp ver 0.02
Clear \\ clear variables
Flush \\ empty stack
Form 60,48
Print "MiniLisp Ver 0.02"
Scroll Split  Row  \\ make this row start of scrolling screen
\\ A simple lisp interpreter written in M2000 by George Karras
\\For Documents "=" is For append text. Clear a$, give a new object Document.
Document a$={
                        "hello there this is a string"  ; this is going to result
                        (write 1223345.788)(defvar Hello "M2000")(write Hello)
                        (write 121 "Hello again...")
                        (eq 7 7)(write (list 1 2 4 5))(defvar A (+ 7 9 13 1 5 7) ) (write A  (- A 10) (* A 3) (/ 5 2))
                        (defvar (a b c d) 100)(write a b c d)(setq a (+ a 1))(write '(a =) a)(write (car '(a b c))(cdr '(a b c))) ; remark
                        (write (cons 'a '(b c)))(write George 'Karras)(write (eq a 101))
                        (this is written as result)(write '(This written before results) (+ a 1))
                        (quote (Hello 1 There a b))  '(Hello 2 There a b)(eq 5 5)
                        (loop (write a) (eq a 107) (setq a (+ a 1))) (write (list 1 A (+ A 1) 3 4 5))
                        (write 1 A (+ A 1) 3 4 5)
                        (write (If t 5 6))  (write ok)
                        (write (If nil (list 1 2 3) (list 4 5 6)))
                        (write (If nil 5 6))
                        (write (If t (list 1 2 3) (list 4 5 6)))


                        }                         
Print "Parse:";
Report a$
Print
nl$={
} \\ nl$ is new line
Let level=0, one$="", numeric=False, prints=0, com=False, profil=1, ch10$=chr$(10),ch13$=chr$(13), qu$=chr$(34)
Let mess=false '\\true   \\ For messages
Let cnt=1, roof=len(a$), comlevel=-1 
Global Inventory TopGun = chr$(34):="String()", ";":="Remark()", "'":="Quote()", "(":="StopChar(1)", ")":="StopChar(-1)", " ":="StopCharZero()",  Chr$(10):="StopCharZero()", Ch13$ :="StopCharZero()", ".":="StorePeriod()", "-":="StoreNumeric()", "+":="StoreNumeric()"
For i=0 to 9: Append TopGun, str$(i,"0"):="StoreNumeric()" : Next i
Document Buffer$, Result$
\\ Inventory is a hash table.
Inventory commands="+":="Comm({+})",  "-":="Comm({-})" , "*":="Comm({*})", "/":="Comm({/})", "write":="CommWrite()", "car":="Car()", "cdr":="Cdr()", "cons":="Cons()",  "defvar":="DefVar()", "eq":="Eq()", "setq":="SetVar()", "quote":="Quote()", "loop":="loopLisp()",">":="Sym({>})" ,"<":="Sym({<})", ">=":="Sym({>=})","<=":="Sym({<=})", "<>":="Sym({<>})", "list":="MyList()","If":="Myif()"
Clear t$, nil$
\\ we want a paragraph only - with new line
Inventory mem  \\ For variables
t$="t"+nl$
nil$="nil"+nl$
Append Mem, "t":=t$,"nil":=nil$
Try ok {  Parser(level,  &Result$)}
If Error or Not Ok Then Print Error$
If level>0 Then Error "more ("
If Not Mess Then {
      Report 2, "Results" 
      Report Replace$(nl$," ", Result$)
}
Print Timecount
Sub StoreNumeric()
      If Doc.Len(Buffer$)=0 Then  numeric=True 
      buffer$=one$
End Sub
Sub StoreLabel()
      numeric=False
      buffer$=one$
End Sub
Sub Comm()
      Read proc$
      Local MyAcc$
      Document MyAcc$:Clear Buffer$:Parser(level,  &MyAcc$)
      Local dummy$=paragraph$(MyAcc$,-1,-1)
      Local a, d, acc
      Long a, d=forward(MyAcc$, a)  \\ there is a  backward() function too
      If d<>0 Then {
      Select Case proc$
      Case "+"
      { While a<>0 { acc+=Val(paragraph$(MyAcc$, (a))) }}
      Case "-"
            {         If a<>0 Then   acc=Val(paragraph$(MyAcc$, (a))) 
                       While a<>0 { acc-=Val(paragraph$(MyAcc$, (a)))  }}
      Case "*"
            { acc=1: While a<>0 { acc*=Val(paragraph$(MyAcc$, (a))) }}
      Else  '  Case "/"
            { acc=1
                  If a<>0 Then  acc=Val(paragraph$(MyAcc$, (a))) 
                  While a<>0 { acc/=Val(paragraph$(MyAcc$, (a))) }}
      End Select    
       Accum$=Format$("{0}", acc)+nl$
      } 
End Sub
Sub CommWrite()
      Local MyAcc$
      Document MyAcc$ : Clear Buffer$: Parser(level,  &MyAcc$)
      Print "Lisp:";
      Local i, f=Doc.Par(MyAcc$)
      If f>1 Then { 
            f--  : If f>1 Then Print "(";
            For i=1 to f {
                  Print paragraph$(MyAcc$, i); 
                  If i<f Then  Print " ";
            }
      }
      If f>1 Then { Print ")" } Else Print
End Sub
Sub LoopLisp()
      Local dummy$ : Clear Buffer$
      cnt++ : Local backhere=cnt
      Local mylevel=level
loop1:
      Parser(myLevel, &Accum$)
      dummy$=paragraph$(Accum$,-1,-1)     \\ throw  last nl$
      dummy$= paragraph$(Accum$,-1,-1)
      Accum$=nl$  \\ insert  last nl$
      If dummy$="t" Then Exit Sub
      cnt=backhere
      level=mylevel
      goto loop1
End Sub
Sub  MyList()
      Local MyAcc$
      Document MyAcc$ : Clear Buffer$
      Parser(level, &MyAcc$)
      Accum$="("+Trim$(Replace$(nl$," ", MyAcc$))+")"+nl$       
End Sub
Sub Myif()
      Local MyAcc$
      Document MyAcc$:Clear Buffer$:Parser(level,  &MyAcc$)
      If paragraph$(MyAcc$, 1)="t" Then {
            Accum$=paragraph$(MyAcc$, 2)+nl$
      } else {
            Accum$=paragraph$(MyAcc$, 3)+nl$
      }
End Sub
Sub DefVar()
      Local MyAcc$, Iddoc$
      Document MyAcc$, Iddoc$ : Clear Buffer$
      cnt++ : Parser(level,  &Iddoc$, True) :      Parser(level,  &MyAcc$)
      Local id$=paragraph$(Iddoc$, 1,-1)  \\ third parameter If is -1 Then delete the paragraph 
      If id$="" Then Error "No name For variable"
      While Doc.Par(iddoc$)>0 {
            PrintNewLine("Var :"+id$)
            If not exist(Mem,id$) Then {
                  Append Mem, id$:=MyAcc$
            } Else Error "Variable "+id$+" already defined"
           id$=paragraph$(Iddoc$, 1,-1)
      }
End Sub
Sub SetVar()
      Local MyAcc$, Iddoc$
      Document MyAcc$, Iddoc$ : Clear Buffer$
      cnt++:Parser(level, &Iddoc$, True):cnt--:Parser(level, &MyAcc$)
      Local id$=paragraph$(Iddoc$, 1,-1)  \\ third parameter If is -1 Then delete the paragraph 
      If id$="" Then Error "No name For variable"
      While Doc.Par(iddoc$)>0 {
            PrintNewLine("Var :"+id$)
            If exist(Mem,id$) Then {
                  Return Mem, id$:=MyAcc$
            } Else Error "No such variable"
           id$=paragraph$(Iddoc$, 1,-1)
      }
End Sub
Sub Cons()
      Local MyAcc$
      Document MyAcc$: Clear Buffer$: Parser(level,  &MyAcc$)
      Accum$=MyAcc$
End Sub
Sub Remark()
     while cnt<=tmproof {cnt++:If mid$(a$, cnt,2)=nl$ Then cnt++ : Exit
}
End Sub
Sub String()
     Local check=cnt :Clear Buffer$ : numeric=false
     while cnt<=tmproof {cnt++:If mid$(a$, cnt,1)=qu$ Then exit
     }
     if cnt-check>1 Then { Buffer$=Mid$(a$,check, cnt-check+1)} Else Buffer$={""}
End Sub
Sub PrintBuffer()
      If Doc.Len(Buffer$)=0 Then Exit Sub
      If exist(Mem, Buffer$) and not GetQuote Then {
           Accum$=Mem$(Buffer$)
      } else Accum$=Buffer$+nl$
      PrintNewLine(Buffer$)
      Clear Buffer$ : prints++
End Sub
Sub PrintNewLine(What$)
     If mess Then Print what$
End Sub
Sub StopChar(val)
      com = val=1
      level+=val
      If GetQuote And level<=EntryLevel Then PrintBuffer() : GetQuote=false: tmproof=cnt : Exit Sub
      If val<>0 Then Local oldprints=prints : prints=0
      PrintBuffer()
      If profil=1 And val=-1 Then If prints=0 Then If oldprints=prints Then Buffer$="()" : PrintBuffer()
      profil=val
End Sub
Sub StopCharZero()
      If GetQuote And level=EntryLevel Then PrintBuffer():GetQuote=false: tmproof=cnt : Exit Sub
      If com Then CheckCommand()
      If not com Then PrintBuffer()
End Sub
Sub StorePeriod()
      If Doc.Len(Buffer$)=0 Then StoreNumeric() : Exit Sub
      If numeric Else StoreLabel() : Exit Sub  \\ see Else, same as If not numeric Then
      If Instr(Buffer$,".")>0 Then PrintBuffer()
      StoreNumeric()
End Sub
Sub StoreSign()
      If Doc.Len(Buffer$)>0 And numeric Then PrintBuffer() : StoreNumeric() : Exit Sub
      StoreNumeric()  \\ maybe numeric=False so this is like storelabel...
End Sub
Sub CheckCommand()
      com=false
      If Not GetQuote Then If Exist(commands, Buffer$) Then { Inline Eval$(commands)}
End Sub
Sub Sym(w$)
      Local MyAcc$
      Document MyAcc$:Clear Buffer$:Parser(level,  &MyAcc$)
      If Evall(quote$(paragraph$(MyAcc$, 1) )+ w$+ Quote$(paragraph$(MyAcc$, 2) )) Then {
       Accum$=t$  } Else  Accum$=nil$
End Sub
Sub Quote()
      Clear Buffer$:  cnt++: Parser(level, &Accum$, True): cnt--
End Sub
Sub Car()
      Local MyAcc$
      Document MyAcc$:Clear Buffer$:Parser(level,  &MyAcc$)
      Accum$=paragraph$(MyAcc$, 1)+nl$
End Sub
Sub Cdr()
      Local MyAcc$
      Document MyAcc$:Clear Buffer$:Parser(level,  &MyAcc$)
      Local drop$=paragraph$(MyAcc$, 1,-1)
      Accum$=MyAcc$
End Sub
Sub Eq()
      Local MyAcc$
      Document MyAcc$:Clear Buffer$:Parser(level,  &MyAcc$)
      If paragraph$(MyAcc$, 1)=paragraph$(MyAcc$, 2) Then {
            Accum$=t$
      } Else  Accum$=nil$
End SUb
Sub Parser(EntryLevel,  &Back$)
      Local GetQuote  
      Read ? GetQuote  \\ this is an optional argument For Parser
      Local tmproof=roof, Accum$
      Document Accum$
100 If level<EntryLevel Then cnt-- : Back$=Accum$ : Exit Sub
      one$=mid$(a$,cnt,1)
      If exist(TopGun, one$) then 200
      StoreLabel()
      cnt++ :If cnt<=tmproof then 100
      Back$=Accum$
      Exit Sub  
200 inline Eval$(TopGun)
      cnt++ :If cnt<=tmproof then 100
      Back$=Accum$
End Sub

H Sub Parser μπορούσε να δοθεί έτσι, χωρίς τη χρήση της κατάστασης TopGun (λίστα με Hash table) η οποία όμως είναι κατι τις πιο αργή. Το βάζω εδώ για να κάνετε δοκιμή!
Προσοχή: Στις εξόδους από Sub χρειάζεται το Exit Sub, ενώ σε block τo απλό Exit. Στα μπλοκ ο κώδικας ανήκει σε μια συνάρτηση που όταν πάρει το Exit απλά επιστρέφει, ενώ το Exit Sub τραβάει την επιστροφή από τον ειδικό σωρό. Αν το ξεχάσουμε τότε στο επόμενο End Sub θα γυρίσουμε "αλλού για αλλού".

Sub Parser(EntryLevel, &Back$)
      Local GetQuote
      Read ? GetQuote \\ this is an optional argument For Parser
      Local tmproof=roof, Accum$
      Document Accum$
100 If level<EntryLevel Then cnt-- : Back$=Accum$ : Exit Sub
      one$=mid$(a$,cnt,1)
      \\ warning in each Case one command in one line or use { } For multiple commands/lines
      \\ no empty lines allowed.
      Select Case one$
      Case qu$
            String()
      Case ";"  \\ remark
            Remark()
      Case "'"  \\ quote
            Quote()
      Case "("
            StopChar(1)
      Case ")"
            StopChar(-1)
      Case " ", Ch10$, Ch13$ ' white space too
            StopCharZero()
      Case "0" to "9"
            StoreNumeric()
      Case "."
            StorePeriod()
      Case "-", "+"
            StoreNumeric()
      Else
            StoreLabel()
      End Select
      cnt++
      if cnt<=tmproof then 100
      Back$=Accum$

End Sub