
' O2 COMPILER SEED AND LINKER
' ===========================
'
' INSTRUCTION SET
'
' 
' SYM  DESCRIPTION
'
' .    label
' .bssdata  start of uninitialised data section (and end of initialised data)
' ' ;  line comments
'
'
' " '  quotes
'
' $    pad with null bytes '00'
' $$   pad space and align to nearest 4 bytes
'
'
' !    align to nearest (NOP '90' padding in haxadecimal !10 == 16 byte alignment)
'
' /    set position from start of code (pad with nulls)
'
' ( )  block delimiters
'
'
' NUMBER PREFIXES
' 
' nb   decimal byte
' nw   decimal word
' nl   decimal dword/long
' nq   decimal quad
'
' ns   decimal single floating point
' nd   decimal double floating point
'
' hw   hexadecimal word
' hl   hexadecimal long
' hq   hexadecimal quad
' hg   hexadecimal sys (long or quad)
'
'
' 00..ff   hexadecimal bytes
' 000..777 octal bytes
'
'
'LABEL / BLOCK  JUMPS
'
' x    exit block, short relative
' xl   exit block, long relative
' r    repeat block, short relative
' rl   repeat block, long long relative
' g    short relative
' gl   long relative
' gf   long relative forward
' ga   long (relative from start of codestring (absolute)
' gq   quad (relative from start of codestring (absolute)
'
' DATA LINKAGE
'
' gc   code side index
' gd   data side index
'
'
' OTHERS
'
' k    namespace
' sx   epose / make next label visible to outer block
'
'


'--------------------------------------------
sub stretchbuffer(byref s as string,i as sys)
'============================================
dim as sys le=len(s)
if i+4096>le then
  s+=string(i-le+&h8000,chr(0))
end if
end sub


'---------------------------
function HexLink() as string
'===========================
'
' a      ascii byte
' b      general purpose
' c      general purpose
' d      general purpose
' i      source string position
' j      code position
' k      general purpose
' l      length of source
' m      general purpose
' n      general purpose
' s      source  string
' t      code string
' u      general purpose
' v      general purpose
' w      general purpose
' nb()   starting position of current block
' xi()   attributes of foward reference
' xn()   label names
' bkd()  nesting depth of label
' bkn()  namespace of label
' bkp()  position of label
' bkw()  label name
' bke    label list boundary
' neb    current nesting depth
' wd     word
' ke     keyword
' nsw    namespace word
' nsn    namespace array of names
' nse    namespace array last member
' nsi    namespace index
' nsp    namespace lookup index

' ert    global error type
' ers    global error message string
'
'BUFFERS
'
#define sizli 16383
static as sys nb(127),xi(511,4),bkd(sizli),bkn(sizli),bkp(sizli)
static as string xn(sizli),bkw(sizli),nsn(sizli)
'

dim as string s

dim    as sys neb, xib, bke, lnki, lnkj, lnkk, bss
dim    as sys a,b,c,d,i,k,m,n,u,v,w,l,nse,nsi,nsp
dim    as any ptr pt,qt
dim    as string wd,ke,lnkn,nsw

i=1
j=1
s=gsco
l=len(s)
t=string(l*4,chr(0))

ert=0
lnki=0


'open "t.txt" for output as 3 : print #3,s : close 3 'DIAGNOSTIC

'================
'MAIN READER LOOP
'================

linkloop:
'
do ' main loop
  '
  do ' skip space for next word 
      if (i>l)or(asc(s,i)>32) then exit do
      i+=1
  loop
  if i>l then exit do
  '
  stretchbuffer(t,j)
  '
  '---------------
  'INTERPRET CASES
  '===============
  ' 
  do ' case interpret word
    a=ascl(s,i)


    a=ascl(s,i)
    '
    '
    'CHECK FOR VALUES
    select case a
    case &h30 to &h39 : a=48
    case &h41 to &h46 : a=48
    case &h61 to &h66 : a=48
    end select
    '
    select case a
    '
    case 48
    '
    'OCTAL BYTE
    '==========
    '
    if i+2<l then 'octal byte
      if asc(s,i+2)>47 then
        mid(t,j)=chr(wval("&o"+mid(s,i,3)))
        i+=3
        j+=1
        goto linkloop
      end if
    end if
    '
    '
    'HEX BYTE
    '================
    '
    pt=strptr(t)
    qt=strptr(s)
    asm
      mov ecx,[qt]
      add ecx,[i]
      dec ecx 'offset
      dec ecx 'align for hexaval
      mov esi,[pt]
      add esi,[j]
      dec esi 'offset
      call hexaval
      mov [esi],al
    end asm
    i+=2
    j+=1
    goto linkloop
    '
    '
    'HOST SYMBOLS
    '============
    '
    '# variable address
    '
    case 35
    '
    m=i
    do
      i+=1
      if i>l then exit do
      a=asc(s,i): if a<48 then exit do
    loop
    wd=mid(s,m,i-m): m=0
    if len(wd) then m=GetVarPtr(wd)
    if m=0 then ers="Can't find #symbol: "+wd:ert=5: goto exitf
    mk4(t,j,m) : j+=4 ' patch in var addr
    exit do
    '
    'SKIP LINE COMMENTS
    '==================
    '
    case ct1 : endline(s,i) : exit do
    '
    case ct2 : endline(s,i) : exit do
    '
    '
    'IGNORED SYMBOLS / PUNCTUATION
    '=============================
    '
    case 44  : exit do ' skip comma
    '
    case sr1 : exit do ' skip separator (colon / semicolon)
    '
    '
    'QUOTED STRINGS
    '==============
    '
    'WIDE STRING CONVERSION
    '
    case &h77 ' w"  w`
    '
    b=ascl(s,i+1)
    if isq(b) then
      c=i+1 : wd=wrd(s,c)
      stretchbuffer(t,j+4096+lenw*2)
      i+=2
      do
        if i>l then exit do
        a=asc(s,i)
        if a=b then i+=1 : exit do
        mid(t,j)=chr(a)+chr(0) : j+=2
        i+=1
      loop
      exit do 'cases
    end if
    '
    '
    '
    'NOP ALIGNMENT PADDING
    '=====================
    '
    ' ! align to mod m by filling with nops
    '
    case 33
    '
    m=wval("&h"+mid(s,i+1,8)) 'HEXADECIMAL
    v=(j-1) and (m-1)
    v=m-v
    if v<m then
      stretchbuffer(t,j+v)
      mid(t,j)=string(v,chr(&h90))
      j+=v 'round up
    end if
    exit do
    '
    '
    '$ MAKE BLOCK OF NULLS $$ ALIGNED UP TO 16 BYTES
    '===============================================
    '
    case 36 ' $ reserve space 
    '
    m=0
    if asc(s,i+1)=36 then m=16 : i+=1 ' $$ ALIGN  UP TO 16
    v=wval("&h"+mid(s,i+1,9)) 'VALUE ASSUMED HEXADECIMAL
    a=j
    j+=v
    if m then
      v=(j-1) and (m-1) ' HEX MODULUS
      v=m-v
      if v<m then j+=v
    end if
    stretchbuffer(t,j)
    mid(t,a)=string(j-a,chr(0))
    exit do
    '
    '
    '/ SET ADDRESS OR /+ ALIGNMENT OFFSET
    '====================================
    '
    case 47 ' / set offset
    '
    i+=1
    a=asc(s,i) : if a=43 then i+=1
    v=wval("&h"+mid(s,i,8)) 'VALUE ASSUMED HEXADECIMAL
    if a=43 then v=((j-1) \ v) * v + v 'round up with v even when already aligned
    if j>v+1 then
      ert=22
      ers="Location already occupied "+hexci(v)+" p"+hexci(j)
      goto exitf
    end if
    stretchbuffer(t,j+v)
    j=v+1
    exit do
    '
    '
    'j EMBED BINARY
    '==============
    '
    case &h6a
    '
    i+=1
    wd=wrd(s,i)
    a=wval(wd)
    v=len(ebd(a))+4 'terminate with at least 4 nulls
    roundup(v,cpuw)
    stretchbuffer(t,j+v)
    mid(t,j)=ebd(a)
    j+=v
    exit do
    '
    '
    'k NAMESPACE
    '===========
    '    
    case &h6b
    '
    i+=1
    skiplspace(s,i)
    if ise(ascn) then
      nsi=0
    else
      wd=wword(s,i)
      for a=nse to 1 step-1 'CHECK FOR PREV NAMESPACE MATCH
        if wd=nsn(a) then
          nsi=a : a=-1 : exit for
        end if
      next
      if a<>-1 then
        nse+=1 : nsn(nse)=wd : nsi=nse
      end if
    end if
    exit do
    '
    '
    '--------------------
    'BEGINING OF NEW NEST
    '====================
    '
    case lbr : neb+=1:nb(neb)=j:i+=1:exit do '(
    '
    case rbr ')
    '
    b=bke
    do
      b-=1 : if b<0 then exit do
      if bkd(b)<neb then bke=b+1 : exit do
    loop
    '
    end select
    '
    'ASCII STRING
    '============
    '
    '
    if isq(a) then ' quote types
      m=i+1
      do
        i+=1
        if i>l then exit do
        if asc(s,i)=a then exit do
      loop
      mid(t,j)=mid(s,m,i-m): j+=i-m: i+=1
      exit do ' cases
    end if
    '
    '
    '------------------------
    'END-OF-NEST OR DOT LABEL
    '========================
    '
    if (a=rbr)or(a=46) then ') . fwd refs only
      ke=""
      nsp=0
      '
      'LABELS
      '------
      '
      c=0
      if a=46 then 
        i+=1 : ke=wword(s,i)
        '
        'CHECK FOR EXPLICIT NAMESPACE ::
        a=instr(ke,"::")
        if a then
          nsw=left(ke,a-1)
          ke=mid(ke,a+2)
          for a=nse to 1 step-1
            if nsn(a)=nsw then nsp=a : exit for
          next
          if nsp=0 then nse+=1 : nsp=nse : nsn(nse)=nsw
        end if
        '
        ascw=asc(ke)
        if ascw=&h62 then
          if ke="bssdata" then bss=j 'offset of bss (uninitialised data section)
        end if
        i-=2
        v=ascl(ke,1)*256 : a=ascl(ke,2)
        if a<48 then a=32
        if nsp then c=nsp else c=nsi
        v+=a ' 2 significant letters
        '
        'REGISTER LABEL
        bkw(bke)=ke      'keyword
        bkp(bke)=j       'binary position
        bkd(bke)=neb     'nesting depth
        bkn(bke)=c       'namespace
        bke+=1 :  ' record dot label
        a=v
      end if
      '
      '
      '--------------------
      'RESOLVE FORWARD REFS
      '====================
      '
      if xib>0 then
        v=xib-1
        '
        '-------------------
        'SCAN FWD REFS TABLE
        '===================
        '
        do
          if v<0 then exit do
          '
          '
          d=0                'OK FLAG
          b=xi(v,4)          'FORWARD REFERENCE NAMESPACE
          if b<0 then
            if c=-b then
              d=1            'MATCHING EXPLICIT NAMESPACE
            end if
          else
            if c=b then
              d=1            'MATCHING IMPLICIT NAMESPACE
            elseif c=0 then
              d=1            'ACCEPTING NULL NAME SPACE
            end if
          end if
          '
          if (xi(v,1)=a)and(xi(v,2)>=neb)and(d)and(xn(v)=ke) then
            '
            'FWD REF RECORD IDENTIFIED
            '-------------------------
            '
            m=xi(v,0) 'LOCATION TO PATCH
            '
            do
              '
              'CHECK LONG / QUAD ADDRESSES
              '--------------------
              '
              w=xi(v,3) 'LINK MODE
              '
              if m<0 then
                '
                select case w
                '
                case &h61 'LONG LINKAGE 'A'
                  '
                  mk4(t,-m,j-1) : exit do 'ABSOLUTE (OFFSET FROM 0) 32 BITS
                  '
                case &h71 'QUAD LINKAGE 'Q'
                  '
                  mk8(t,-m,j-1) : exit do  'ABSOLUTE (OFFSET FROM 0) 64 BITS
                  '
                case else 'L' LONG RELATIVE 'F' LONG FORWARD RELATIVE
                  '
                  mk4(t,-m,j+m-4) : exit do 'RELATIVE ADDRESS
                  '
                end select
                '
              end if 'm<0
              '
              'OTHERWISE SHORT LINKAGE
              '-----------------------
              '
              n=(j-m-1)
              '
              if (n<0)or(n>127) then
                ers=ke+" Jump out of range (-128..+127) "+str(n)
                ert=2 : goto exitf
              end if
              mid(t,m)=chr(n)
              exit do
            loop 'END OF CASES
            '
            'CLEAR RECORD ON RESOLVED LINKS
            '
            xi(v,1)=0 : xi(v,2)=0 : xn(v)="" 
          end if
          v-=1
        loop 'END OF FWD REFS LINKs
        '
        '
        '-------------------------
        'CONSOLIDATE FWD REFS LIST
        '=========================
        '
        v=0 : m=0
        do
          m+=1
          if xi(v,1)<>0 then
            '
            'transfer reference to a lower nesting level
            '
            if a=rbr then
              if xi(v,2)>=neb then xi(v,2)=neb-1
            end if
            v+=1 : continue do 'PRESERVE
          end if
          if m>=xib then exit do 'END OF LIST
          if xi(m,1)=0 then continue do 'M EMPTY
          xi(v,0)=xi(m,0) : xi(v,1)=xi(m,1) : xi(v,2)=xi(m,2) : xi(v,3)=xi(m,3) : xi(v,4)=xi(m,4)
          xn(v)=xn(m)
          if a=rbr then
            if xi(v,2)>=neb then xi(v,2)=neb-1
          end if
          xi(m,0)=0 : xi(m,1)=0 : xi(m,2)=0 : xi(m,3)=0 : xi(m,4)=0 : xn(m)="" ' clear m
          v+=1
        loop
        xib=v
      end if
      '
      '
      '--------------------------
      'CHECK FOR CLOSE OF NESTING
      '==========================
      '
      if a=rbr then
        neb-=1 ' )
        if neb<0 then ers="Linker found too many right brackets":ert=4: goto exitf
        '
        '---------------------
        'CONSOLIDATE BACK LIST
        '=====================
        '
        'remove label references that were within the nest
        '
        v=0 : m=0
        do
          if m>=bke then exit do
          if bkd(m)>neb then m+=1 : continue do 'REMOVE
          if m>v then 
            bkw(v)=bkw(m) : bkp(v)=bkp(m) : bkn(v)=bkn(m) : bkd(v)=bkd(m)
            bkw(m)=""
          end if
          v+=1 : m+=1
        loop
        bke=v
      end if
      i+=1 : exit do
    end if
    '
    m=ascl(s,i+1)
    '
    '
    '--------------------
    'G JUMP ADDRESSES ETC
    '====================
    '
    if a=&h67 then
      '
      i+=1
      if m>32 then i+=1
      ke=wword(s,i)
      nsp=0
      '
      'CHECK FOR EXPLICIT NAMESPACE ::
      a=instr(ke,"::")
      if a then
        nsw=left(ke,a-1)
        ke=mid(ke,a+2)
        for a=nse to 1 step-1
          if nsn(a)=nsw then nsp=a : exit for
        next
        if nsp=0 then nse+=1 : nsp=nse : nsn(nse)=nsw
      end if
      '
      i-=1
      v=ascl(ke,1)*256 : a=ascl(ke,2)
      if a<48 then a=32
      v+=a ' 2 significant letters, initial search filter
      '
      '----------------
      'G INTERPRETATION
      '================
      '
      b=bke
      '
      'LINKAGE MODES
      '-------------
      '
      select case m
      case &h66 : b=0 : m=&h6c                                 'gf LONG FWD REF ONLY
      case &h73 : b=0 : m=&h00                                 'gs SHORT FWD REF ONLY
      case &h63 :                                              'gc
        ape(lnkc,lnki,"    ") : mk4(lnkc,lnki-3,j)             'CODE SIDE DATA LINK ADDRESS
        ape(lnkn,lnkk,"    ") : mk4(lnkn,lnkk-3,wval("&h"+ke)) 'CODE SIDE DATA LINK NUMBER
        mid(t,j)=mkl(0)
        j+=4
        goto nexw
      case &h64 :                                              'gd
        ape(lnkd,lnkj,"    ") : mk4(lnkd,lnkj-3,j)             'DATA SIDE DATA LINK LIST
        goto nexw
      end select
      '
      '
      'SEARCH BACKWARDS FOR LABEL
      '--------------------------
      '
      do
        b-=1:if b<0 then exit do
        'if (ke=bkw(b))and(bkd(b)<=neb) then
        c=bkn(b)
        d=0
        if nsp then
          if c=nsp then d=1 'MATCH EXPLICIT NAMESPACE REFERENCE
        else
          if c=nsi then d=1 'MATCH IMPLICIT NAMESPACE REFERENCE
          if c=0 then d=1   'ACCEPT NULL NAMESPACE LABEL
        end if
        '
        if ke=bkw(b)and(d) then
          '
          n=bkp(b)-j 'ADDRESS DIFFERENCE
          '
          'LONG / QUAD ADDRESSES
          '
          if m=&h67 then
            if cpuw=8 then m=&h71 else m=&h61 'G' system 64 bit or 32 bit
          end if
          '
          select case m
          case &h61
            mk4(t,j,n+j-1) : j+=4 : goto nexw ' A LONG OFFSET FROM 0 (32 BIT)
          case &h71
            mk8(t,j,n+j-1) : j+=8 : goto nexw ' A QUAD OFFSET FROM 0 (64 BIT)
          case &h6c
            mk4(t,j,n-4) : j+=4 : goto nexw   ' L LONG RELATIVE
          end select
          '
          n-=1
          '
          'CHECK JUMP RANGE
          '----------------
          '
          if (n<-128)or(n>127) then
            ers=ke+" jump out of range (-128..+127) "+str(n)
            ert=2: goto exitf ' short jump out of range
          end if
          '
          'SHORT JUMP
          '----------
          '
          mid(t,j)=chr(n and 255) : j+=1:goto nexw
        end if
      loop
      '
      'NOT FOUND
      '
      '------------------
      'LOG AS FORWARD REF
      '==================
      '
      if m=&h67 then 'c'
        if cpuw=8 then m=&h71 else m=&h61 'system 'q' 64 bit or 'a' 32 bit
      end if
      '
      if nsp then c=-nsp else c=nsi
      '
      xn(xib)=ke
     'xi(xib,0)     'POSITION CODE (NEGATIVE INDICATES LONG LINK)
      xi(xib,1)=v   '2 LETTER ENCODING
      xi(xib,2)=neb 'NESTING LEVEL
      xi(xib,3)=m   'LINKAGE MODE CODE
      xi(xib,4)=c   'NAMESPACE CODE
      a=0
      if (m=&h6c)or(m=&h61)or(m=&h71) then
        xi(xib,0)=-j : xib+=1 : j+=4 'RESERVE SPACE
        if m=&h71 then j+=4 'RESERVE EXTRA SPACE FOR QUAD
        exit do' g
      end if
      '
      xi(xib,0)=j : xib+=1 : j+=1 : exit do' g  'OTHERWISE SHORT
      '
    end if 'G INSTRUCTION
    '
    '
    '-----------
    'X EXIT NEST
    '===========
    '
    'LOG AS FWD REFERENCE
    '
    if a=&h78 then
      xn(xib)="":n=neb
      if (m>48)and(m<58) then n=neb+49-m: m=&h6c
      if n<0 then n=0
      if nsp then c=-nsp else c=nsi
      xi(xib,2)=n
      xi(xib,4)=c
      if m=&h6c then
        i+=1 : xi(xib,0)=-j : xi(xib,1)=rbr : xib+=1 : j+=4 : exit do' xl x2 x3 exit
      else
        xi(xib,0)=j : xi(xib,1)=rbr : xib+=1 : j+=1: exit do' x exit
      end if
    end if
    '
    '
    '-------------
    'R REPEAT NEST
    '=============
    '
    if a=&h72 then 
      if m=&h6c then i+=1:v=nb(neb)-j-4: mk4(t,j,v) : j+=4:exit do ' r repeat
      v=nb(neb)-j-1
      if v<-128 then
        ers="'Repeat' out of range (-128..+127) "+str(v)
        ert=3: goto exitf ' short loop out of range
      end if
      mid(t,j)=chr(v and &hff):j+=1:exit do
    end if
    '
    '
    '======
    'VALUES
    '======
    '
    '
    'otherwise assume a decimal octal or hex code
    '
    '---------------------
    'H HEXADECIMAL NUMBERS
    '=====================
    '
    if a=&h68 then
      i+=2
      pt=strptr(t)
      qt=strptr(s)
      '
      asm
        mov ecx,[qt]
        add ecx,[i]
        dec ecx 'offset
        rhgap:
          mov al,[ecx]
          inc ecx
          cmp al,0
          jz xhgap
          cmp al,32
          jle rhgap
        xhgap:
        dec ecx
        dec ecx 'align for hexaval
        mov esi,[pt]
        add esi,[j]
        dec esi 'offset
        call hexaval
        mov cl,[m]
        '
        cmp cl,&h77 'w' word
        jnz hexl4
        mov [esi],ax
        mov eax,2
        jmp xhexli
        '
        hexl4:
        cmp cl,&h6c 'l' long
        jnz hexl8
        chexl4:
        mov [esi],eax
        mov eax,4
        jmp xhexli
        '
        hexl8:
        cmp cl,&h71 'q' quad
        jnz hexlg
        chexl8:
        mov [esi],eax
        mov [esi+4],edx
        mov eax,8
        jmp xhexli
        '
        hexlg:
        cmp cl,&h67 'g' system (4 or 8 byte)
        jnz xhexli
        cmp dword ptr cpuw,8
        jnz chexl4
        jmp chexl8
        '
        mov eax,0 'no interpretation
        '
        xhexli:
        '
        add [j],eax
      end asm
      '
      skipspace(s,i)
      exit do
    end if
    '
    '
    '-----------------
    'N DECIMAL NUMBERS
    '=================
    '
    if a=&h6e then
      i+=2
      pt=strptr(t)
      qt=strptr(s)
      '
      asm
        mov ecx,[qt]
        add ecx,[i]
        dec ecx 'offset
        mov esi,[pt]
        add esi,[j]
        dec esi 'offset
        rngap:
          mov al,[ecx]
          inc ecx
          cmp al,0
          jz xngap
          cmp al,32
          jle rngap
        xngap:
          dec ecx
          push ecx
          call ascii_to_float
          mov al,[m]
          '
          cmp al,&h77 'w' word
          jnz numl4
          fistp word ptr [esi]
          mov eax,2
          jmp xnumli
          '
        numl4:
          cmp al,&h6c 'l' long
          jnz numl8
          cnuml4:
          fistp dword ptr [esi]
          mov eax,4
          jmp xnumli
          '
        numl8:
          cmp al,&h71 'q' quad
          jnz numlg
          cnuml8:
          fistp qword ptr [esi]
          mov eax,8
          jmp xnumli
          '
        numlg:
          cmp al,&h67 'g' system (4 or 8 byte)
          jnz numl1
          cmp dword ptr cpuw,8           
          jnz cnuml4
          jmp cnuml8
          '
        numl1:
          cmp al,&h62 'b' byte
          jnz numfl4
          fistp word ptr [esi]
          mov eax,1
          jmp xnumli
          '
        numfl4:
          cmp al,&h73 's' single
          jnz numfl8
          fstp dword ptr [esi]
          mov eax,4
          jmp xnumli
          '
        numfl8:
          cmp al,&h64 'd' double
          jnz xnumli
          fstp qword ptr [esi]
          mov eax,8
          jmp xnumli
          '
        xnumli:
          '
          add [j],eax
          '
        end asm
        '
        skipspace(s,i)
      exit do
    end if
    '
    '
    exit do ' always drop out
    '
  loop 'END CASES
  '
  '=====
  nexw:
  '=====
  '
  do ' find delimiting char before next word 
    if (i>l)or(asc(s,i)<=32) then exit do
    i+=1
  loop
  '
  if xib>sizli then ert=15 : goto exitf ' ref limit
loop
'
'=====
exitf:
'=====
'
'
'LINK INITIALISED DATA TO CODE
'=============================
'
'first get offset of uninitialised data (bss)
'this value is stored in ebx therefore
'data is accessed as a negative offset from this position
'
'
'-------------------------------------------------
'HEADER | CODE | DATA | BSS | EDATA | IDATA | RSRC
'-------------------------------------------------
'
'
n=lnki-1
for m=1 to n step 4    'LIST OF DATA LINKS
  a=midval(lnkc,m)     'GET CODE PATCH LOCATION
  b=midval(lnkn,m)*4-3 'DATA INDEX
  c=midval(lnkd,b)-bss 'DATA LOCATION RELATIVE TO .bssdata
  mk4(t,a,c+4)         'PATCH DATA LOCATION INTO CODE (1st 4 bytes gives length)
next
'
'
'CHECK FOR ERRORS
'===============
'
if j<2 then ers="No code to generate":ert=10
if (ert=0)and(xib>0) then
  ers="Linker found unidentified names:"
  v=xib:a=0
  '
  do
    v-=1:if v<0 then exit do
    a=xi(v,1)
    ers+=cr+nsn(abs(xi(v,4)))+"::"+xn(v)+chr(9)+"level "+str(xi(v,2))
  loop
  '
  ers+=cr
  ert=1000000+xi(xib-1,1) 'unresolved refs
end if
'
if ert>0 then
  function=chr(&hc3)
else
  function=left(t,j-1)
end if
'
end function


