TIP: Click on subject to list as thread! ANSI
echo: public_domain
to: All
from: rowan_crowe
date: 1995-10-26 11:50:28
subject: ELEMENT.MOO

Sorry about the sparse commenting....

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''' ELEMENT.MOO                *** released to the public domain ***   '''
'''                                                                    '''
''' Originally by Rowan Crowe, Thursday 26-Oct-1995                    '''
'''   3:635/727{at}fidonet                                                '''
'''   rowan{at}jelly.freeway.DIALix.oz.au                                 '''
'''                                                                    '''
''' Separates a source file into discrete elements such as variable    '''
''' names, commands, functions etc.  If output is redirected to a file '''
''' then sorted, mis-spelt variable names and other errors become      '''
''' immediately apparent.                                              '''
'''                                                                    '''
''' This is handy for languages which do not require strict variable   '''
''' declarations: BASIC, MoonRock etc.                                 '''
'''                                                                    '''
''' Contains inline ASM to speed things up nicely. Due to 80x86 real   '''
''' mode segmentation I have not bothered to cater for source files    '''
''' larger than 64k.                                                   '''
'''                                                                    '''
''' Requires MoonRock compiler:                                        '''
'''   MRC element/-m/-c                                                '''
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

begin def

'#include ffblk.h
''' Uncomment this line for MoonRock v0.15 and above

'#include mrc.h
%EXIT_SUCCESS = 0
%EXIT_FAIL = 1
''' These are the two constants pulled from MRC.H
''' If you are using MoonRock v0.15 or above, comment these and uncomment
''' the #include line preceding it

  strsegsize 64k

  Sub LoadSource:   ' Read the entire source file into memory
  Sub GetLine:      ' Get a line from the source file
  Sub Block:        ' Break up a line into discrete elements
  Sub Setup:        ' General program initialisation
  Sub Element:      ' Main section of code.

  %MaxElementRecords = 10000       ' If you change this you may run
                                   ' out of memory. :-)
  %DiscreteElementsPerLine = 200   ' Just a nice sounding number. Any
                                   ' line with more than 200 discrete
                                   ' variables/commands/keywords is,
                                   ' well, yeah.

  dim bp$[%DiscreteElementsPerLine]

  dim va$[%MaxElementRecords]

  common FMin%, bufseg%, inline$, sourceptr%, eof%, bpp%
  common currentline%, Term$

begin code


''' ************************************************************* '''

call Setup
call Element
end(%EXIT_SUCCESS)


''' ============================================================= '''

sub Block:
tmp$ = inline$
bpp% = 0
while tmp$  ""

  if bpp% > %DiscreteElementsPerLine then
    print "\nInternal error, or line contains more than "
    print %DiscreteElementsPerLine + " discrete elements.\n"
    print ": " + inline$ + "\n"
    end(%EXIT_FAIL)
  endif

  ptr% = sinstr(tmp$, Term$)
  if ptr%  0 then

    ptr2% = ptr% - 1
    if ptr2% > 0 then
      bp$[bpp%] = left(tmp$, ptr2%)
      bpp% = bpp% + 1
    endif

    c% = sbyte(tmp$, ptr%)
    if c%  32 then       ' space
      bp$[bpp%] = mid(tmp$, ptr%, 1)
      bpp% = bpp% + 1
    endif

      ptr2% = ptr% + 1
      tmp$ = mid(tmp$, ptr2%)
      tmp$ = ltrim(tmp$)
      if c% = 34 then      '    "
        p% = cinstr(tmp$, 34)
        if p%  0 then
          p% = p% + 1
          tmp$ = mid(tmp$, p%)
        endif
      endif

  else

    bp$[bpp%] = tmp$
    bpp% = bpp% + 1
    tmp$ = ""

  endif

wend
bpp% = bpp% - 1
return

''' ============================================================= '''

Sub Setup:

Term$ = " \h22'=+-*/(),[]:;"
''' These are the terminators we search for. \h22 is the " character

cmd$ = cmdline : cmd$ = ltrim(cmd$) : cmd$ = ucase(cmd$)

if cmd$ = "" then
  print "Element lister v0.01 [DOS], by Rowan Crowe. (PUBLIC DOMAIN)"
  print "\n\n  Usage:\n    ELEMENT "
  print "\n\nNOTE: Maximum size of source file is 64k.\n"
  end(%EXIT_FAIL)
endif

in$ = ftruename(cmd$)
if in$ = "" then
  print "*fatal*  " + "Invalid filespec passed in commandline.\n"
  end(%EXIT_FAIL)
endif

if not fexist (in$, 7) then
  print "*fatal*  " + "Specified source file not found:
" + in$ + "\n"
  end(%EXIT_FAIL)
endif

FMin% = fopen(in$, readonly)
call LoadSource
fclose(FMin%)

return

' ===================================================================

sub LoadSource:

l& = flen(FMin%)
if l& > 65510 then
  print "*fatal*  " + "source file larger than 64k\n"
  end(%EXIT_FAIL)
endif

f& = freemem(2)  ' far memory
if l& >= f& then
  print "*fatal*  " + "insufficient far memory to load
source file\n"
  print "\nremaining far memory:  " + freemem(2) + "b\n"
  end(%EXIT_FAIL)
endif

size% = flen(FMin%) + 16
bufseg% = farmalloc(size%)

  {at}push  ds
  {at}mov   bx,word ptr ds:[FMin%]
  {at}mov   ds,word ptr ds:[bufseg%]
  {at}mov   ah,3fh
  {at}mov   cx,0ffffh
  {at}xor   dx,dx
  {at}int   21h
  {at}pop   ds
  {at}jnc   __LS_OK
  {at}mov   word ptr ds:[tmpdoserr%], ax
print "*Fatal*  " + "Cannot read source file. DOS returned
error code: " + tmpdoserr% + "\n"
end(%EXIT_FAIL)
LS_OK:
  {at}mov   es,word ptr ds:[bufseg%]
  {at}mov   bx,ax
  {at}mov   word ptr es:[bx],000dh
SourcePtr% = 0
return

sub GetLine:
  currentline% = currentline% + 1
  {at}mov   bx,ds:[inline$]
  {at}call  _mem_free

  {at}push  es
  {at}push  bp
  {at}mov   es,word ptr ds:[bufseg%]
  {at}mov   di,ds:[sourceptr%]
  {at}mov   bp,di
  {at}cmp   byte ptr es:[di],0
  {at}jz    __GL_EOF
  {at}mov   al,13
  {at}mov   cx,0ffffh
  {at}repnz scasb
  {at}mov   bx,di
  {at}sub   bx,bp
  {at}mov   ds:[sourceptr%], di
  {at}mov   cx,bx
  {at}add   bx,2
  {at}call  _mem_alloc
  {at}mov   ds:[inline$],di
  {at}push  di
  {at}add   di,2
  {at}mov   si,bp
  {at}xor   dx,dx        ; size counter
GL_LOOP:
  {at}mov   al, es:[si]
  {at}inc   si
  {at}cmp   al,32
  {at}jb    GL_SKIP
  {at}mov   ds:[di],al
  {at}inc   di
  {at}inc   dx
{at}GL_SKIP:
  {at}loop  __GL_LOOP
  {at}pop   di
  {at}mov   ds:[di],dx
  {at}jmp   __GL_DONE

GL_EOF:
  {at}xor   ax,ax
  {at}mov   word ptr ds:[inline$],ax
  {at}not   ax
  {at}mov   word ptr ds:[eof%],ax

GL_DONE:
  {at}pop   bp
  {at}pop   es
return

Sub Element:

while eof% = FALSE
  call GetLine
  call Block
  if bpp%  -1 then
    for i% = 0 to bpp%
      tmpbp$ = bp$[i%]
'''            ^^^^^^^
''' We could simply use bp$[i%] instead of tmpbp$ below, but
''' using an array variable is slower, so let's make a local copy.

      matched% = FALSE
      for z% = 0 to vaptr%
        if tmpbp$ = va$[z%] then
          matched% = TRUE
          exit for
        endif
      next
      if matched% = FALSE then
        print tmpbp$ + "\n"
        vaptr% = vaptr% + 1
        if vaptr% > %MaxElementRecords then
          print "\n\n\nout of element records (craaasssshhhhhhhhh)\n"
          end(%EXIT_FAIL)
        endif
        va$[vaptr%] = tmpbp$
      endif
    next
  endif
wend
print "\n\n  lines processed:   " + currentline%
print "\n  discrete elements: " + vaptr%
return

---
* Origin: Jelly-Bean software development. (3:635/727.1)
SEEN-BY: 50/99 632/348 998 633/371 634/384 635/503 513 544 727 638/102
SEEN-BY: 639/100 640/230 690/718 711/401 410 413 430 807 808 809 934 713/888
SEEN-BY: 800/1 7877/2809
@PATH: 635/727 632/348 635/503 50/99 711/808 809 934

SOURCE: echomail via fidonet.ozzmosis.com

Email questions or comments to sysop@ipingthereforeiam.com
All parts of this website painstakingly hand-crafted in the U.S.A.!
IPTIA BBS/MUD/Terminal/Game Server List, © 2025 IPTIA Consulting™.