'
'                     Домашний ассемблер для 8086
'

OPTION BASE 1

$include "signal.inc"
$include "phase0.inc"
$include "phase1.inc"
$include "phase2.inc"
$include "putlab.inc"
$include "findlab.inc"
$include "convdat.inc"
$include "cmd0.inc"
$include "putref.inc"
$include "extref.inc"
$include "presstr.inc"
$include "stringi.inc"
$include "frame.inc"

SUB InitHeap INLINE
$inline "e:\tb\bin\initheap.bin"
END SUB
SUB PutVar INLINE
$inline "e:\tb\bin\putvar.bin"
END SUB
SUB GetVar INLINE
$inline "e:\tb\bin\getvar.bin"
END SUB
SUB FreSpace INLINE
$inline "e:\tb\bin\frespace.bin"
END SUB

SUB Init(SS&(1),PtrArea&)
Local k%,i%,l%,S%,O%,S1%,O1%,Size%
k%=UBOUND(SS&(1))
l%=LBOUND(SS&(1))
Size%=(k%-l%+1%)
S%=VarSeg(SS&(l%))
O%=VarPtr(SS&(l%))
Call InitHeap(PtrArea&,S%,O%,Size%)
END SUB

SUB PutLine(SSS$)
Shared StrCount%,LPAGE%,CPAGE%
Local  PP$

print #1,SSS$
incr StrCount%
if StrCount% > (LPAGE%-5%) then

   Call Stringi(CPAGE%,PP$,"###")
   print #1,""
   print #1," Page "+PP$+Space$(22%)+_
            "The Home Assembler (C) V1.3 by Boris L. Faifel"
   print #1,""
   print #1," Org  Object code              Source statement"
   print #1,""
   StrCount%=1%
   incr CPage%
end if

END SUB

Dim LabTab$     (200%)
Dim OrgTab%     (200%)
Dim EquTAB$     (2%,100%)
Dim LEX$        (20%)
Dim TYP%        (20%)

Dim RefLab$     (200%)
Dim RefDisp%    (200%)
Dim RefSize%    (200%)

Dim OpLen%      (1000%)
Dim CodeSource& (8192%)
Dim CodeObject& (8192%)
Dim CodeMessg&  (2048%)

'<<<<<<<<<<<<<<<<<<<<<<<<< НАЧАЛО ВЫПОЛНЕНИЯ >>>>>>>>>>>>>>>>>>>>>>>>>

         CLS
         Color 14%,0%

         Call Init(CodeSource&(),PTR.SOURCE&)
         Call Init(CodeObject&(),PTR.OBJECT&)
         Call Init(CodeMessg&() ,PTR.MESSG&)

         Page%     =1%
         PtrLab%   =1%
         PtrRef%   =1%
         PtrEQU%   =1%
         ORGBEG%   =256%
         ORIGIN%   =256%
         CommCount%=1%
         DEBUG%    =0%
         ErrCount% =0%
         StrCount% =1%
         NLine%    =0%
         LPAGE%    =50%
         CPAGE%    =1%
         SigPage%  =0%

         call frame ( 2%,_     ' стиль pамки
                    &H0B,_     ' атpибут
                     22%,_     ' левый веpхний
                     10%,_     ' левый веpхний
                     48%,_     ' пpавый нижний
                     15%,_     ' пpавый нижний
     "Home Assembler 1.3")     ' имя окна

         ON ERROR GOTO ERRHANDL

         CMD.LINE$=COMMAND$
         if CMD.LINE$="" then GOTO SHOW.HELP

         k%=INSTR(CMD.LINE$," ")

         if k%=0% or k%=len(CMD.LINE$) then GOTO SHOW.HELP

         l%=len(CMD.LINE$)
         FI$=left$ (CMD.LINE$,(k%-1%))
         FO$=right$(CMD.LINE$,(l%-k%))

         OPEN "I",#1,FI$

         SI=0
         SO=LOF(1)

         DO WHILE EOF(1)=0%

GET.INSTR:

            RESULT$=""

            line input #1,SS$

            incr NLine%

            SI=SI+len(SS$)+2

            locate 11%,27%
            Print "SOURCE LINE:";INT((SI/SO)*100);"%";

            if SS$="" then goto GET.INSTR

            '-------- БЛОК ОБРАБОТКИ ДИРЕКТИВ ---------

            Call PresStr(SS$,QQ$)

            if left$(QQ$,4%)="ORG=" then
               l%=len(QQ$)
               ORGBEG%=VAL(right$(QQ$,(l%-4%)))
               ORIGIN%=ORGBEG%
               SigOrg%=1%
               GOTO GET.INSTR
            end if

            if left$(QQ$,5%)="PAGE=" then
               if SigPage% = 0% then
                  l%=len(QQ$)
                  LPAGE%=VAL(right$(QQ$,(l%-5%)))
                  SigPage%=1%
               end if
               GOTO GET.INSTR
            end if

            Call Stringi(CommCount%,PSOUR$,"####")
            Call PutVar(PTR.SOURCE&,PSOUR$,SS$)

            if left$(SS$,1%)=";" then
               incr CommCount%
               goto GET.INSTR
            end if

REPEAT:

            Call PHASE0(SS$,LAB$,REP$,CODE$,OP1$,OP2$,T1%,T2%)

            '########### МАКРО-ОБРАБОТКА #########

            SigMacro%=0%
            for i%=1% to (PtrEqu%-1%)
                for j%=1% to Klex%
                    if  UCASE$(EquTab$(1%,i%))=LEX$(j%) then
                        LEX$(j%)=EquTab$(2%,i%)
                        incr SigMacro%
                        EXIT FOR
                    end if
                next j%
            next i%

            if SigMacro% <> 0% then
               SS$=""
               for i%=1% to Klex%
                   SS$=SS$+" "+LEX$(i%)
               next i%
               GOTO REPEAT
            end if

            if CODE$="" then
               incr CommCount%
               goto GET.INSTR
            end if

            if CODE$="END" then
               incr CommCount%
               goto OUT.FILE
            end if

            if CODE$="DB" then
               if BYTES$ <> "" then
                  RESULT$=RESULT$+BYTES$
                  LCOM%=LCOM%+len(BYTES$)
               end if
               GOTO PUT.OBJ
            end if

            if CODE$="DW" then
               if WORDS$ <> "" then
                  RESULT$=RESULT$+WORDS$
                  LCOM%=LCOM%+len(WORDS$)
               end if
               GOTO PUT.OBJ
            end if

            O1.R.M%=-1%
            O1.REGISTR%=-1%
            O1.W%=-1%
            O1.SEGM%=-1%
            O1.MODD%=-1%
            O1.MEM$=""
            O1.DAT$=""
            O1.DISP%=0%

            O2.R.M%=-1%
            O2.REGISTR%=-1%
            O2.W%=-1%
            O2.SEGM%=-1%
            O2.MODD%=-1%
            O2.MEM$=""
            O2.DAT$=""
            O2.DISP%=0%

            if OP1$ <> "" then

               call phase1(OP1$,T1%)
               O1.R.M%=R.M%
               O1.REGISTR%=REGISTR%
               O1.W%=W%
               O1.SEGM%=SEGM%
               O1.MEM$=MEM$
               O1.DAT$=DAT$
               O1.MODD%=MODD%
               O1.DISP%=DISP%
            end if

            if OP2$ <> "" then
               call phase1(OP2$,T2%)
               O2.R.M%=R.M%
               O2.REGISTR%=REGISTR%
               O2.W%=W%
               O2.SEGM%=SEGM%
               O2.MEM$=MEM$
               O2.DAT$=DAT$
               O2.MODD%=MODD%
               O2.DISP%=DISP%
            end if

            call PHASE2(LABEL$,REP$,CODE$,OP1$,OP2$,RESULT$)

PUT.OBJ:

            Call Stringi(CommCount%,POBJ$,"####")
            Call PutVar(PTR.OBJECT&,POBJ$,RESULT$)

            OpLen%(CommCount%)=len(RESULT$)

            RESULT$=""

            incr CommCount%

         WEND

OUT.FILE:

         close #1

         locate 11%,27%
         Print "SOURCE LINE: 100 %";

         Call ExtRef

         '<<<<<<<<<<<< ГЕНЕРАЦИЯ ОБЪЕКТНОГО КОДА >>>>>>>>>>>>>

         IF ErrCount% = 0% THEN

            open "B",#1,FO$

            LO&=LOF(1)
            if LO& <> 0 then
               close #1
               KILL FO$
               open "B",#1,FO$
            end if

            for i%=1% to (CommCount%-1%)
                Call Stringi(i%,POBJ$,"####")
                ObjectCode$=""
                Call GetVar(PTR.OBJECT&,POBJ$,ObjectCode$)
                put$ #1,ObjectCode$
                Locate 13%,27%
                S1=i%
                S2=CommCount%-1%
                SS%=INT((S1/S2)*100)
                Print "OBJECT CODE:";SS%;"%";
            next i%
            close #1

         END IF

         '<<<<<<<<<<<<<<< ВЫВОД ВЫХОДНОГО ЛИСТИНГА >>>>>>>>>>>

         OPEN "O",#1,"A.OUT"
         ORIGIN%=ORGBEG%

         Call Stringi(CPAGE%,PP$,"###")
         print #1,""
         print #1," Page "+PP$+Space$(22%)+_
                  "The Home Assembler (C) V1.3 by Boris L. Faifel"
         print #1,""
         print #1," Org  Object code              Source statement"
         print #1,""

         incr CPAGE%

         for i%=1% to (CommCount%-1%)

             Call Stringi(i%,POBJ$,"####")
             ObjectCode$=""
             Call GetVar(PTR.OBJECT&,POBJ$,ObjectCode$)

             l%=len(ObjectCode$)
             StrOut$=Space$(120%)

             ORG$=HEX$(ORIGIN%)
             u%=len(ORG$)
             if u% < 4% then ORG$=String$((4%-u%),"0")+ORG$
             mid$(StrOut$,1%,4%)=ORG$

             SourceCode$=""
             Call Stringi(i%,PSOUR$,"####")
             Call GetVar(PTR.SOURCE&,PSOUR$,SourceCode$)

             ll%=len(SourceCode$)
             mid$(StrOut$,32%,ll%)=SourceCode$
             q%=6%

             for j%=1% to l%
                 S$=mid$(ObjectCode$,j%,1%)
                 H$=HEX$(asc(S$))
                 if len(H$)=1% then H$="0"+H$
                 mid$(StrOut$,q%,3%)=" "+H$
                 incr ORIGIN%
                 q%=q%+3%
                 if q% > 28% then
                    Call PutLine(StrOut$)
                    StrOut$=Space$(120%)
                    ORG$=HEX$(ORIGIN%)
                    u%=len(ORG$)
                    if u% < 4% then ORG$=String$((4%-u%),"0")+ORG$
                    mid$(StrOut$,1%,4%)=ORG$
                    q%=6%
                 end if
             next j%

             if Right$(StrOut$,113%) <> Space$(113%) then
                Call PutLine(StrOut$)
             end if

             ErrMsg$=""
             Call Stringi(i%,PMSG$,"####")
             Call GetVar(PTR.MESSG&,PMSG$,ErrMsg$)

             if ErrMsg$ <> "" then
                Call PutLine(Space$(39%)+"*** "+ErrMsg$)
             end if

             Locate 14%,27%
             S1=i%
             S2=CommCount%-1%
             SS%=INT((S1/S2)*100)
             Print "LISTING    :";SS%;"%";

         next i%

         if StrCount% > 1% then
            for i%=1% to (50%-StrCount%)
                print #1,""
            next i%
         end if

         close #1

         STOP

'##################### Обработчик ошибок #######################

ERRHANDL:

 if ERR = 255% then

    Call Stringi(CommCount%,PMSG$,"####")

    SELECT CASE ERRCODE%
    CASE 0%
         ErrMsg$="Ошибка в изобр. числа"
         Call PutVar(PTR.MESSG&,PMSG$,ErrMsg$)
         incr CommCount%
         incr ErrCount%
         RESUME GET.INSTR
    CASE 1%
         ErrMsg$="Нет разделителя"
         Call PutVar(PTR.MESSG&,PMSG$,ErrMsg$)
         incr CommCount%
         incr ErrCount%
         RESUME GET.INSTR
    CASE 2%
         ErrMsg$="Не закрыты кавычки"
         Call PutVar(PTR.MESSG&,PMSG$,ErrMsg$)
         incr CommCount%
         incr ErrCount%
         RESUME GET.INSTR
    CASE 3%
         ErrMsg$="DB/DW без операндов"
         Call PutVar(PTR.MESSG&,PMSG$,ErrMsg$)
         incr CommCount%
         incr ErrCount%
         RESUME GET.INSTR
    CASE 4%
         ErrMsg$="Повт. метки DB/DW"+LBDUP$
         Call PutVar(PTR.MESSG&,PMSG$,ErrMsg$)
         incr CommCount%
         incr ErrCount%
         RESUME GET.INSTR
    CASE 5%
         ErrMsg$="Метка сост. из :"
         Call PutVar(PTR.MESSG&,PMSG$,ErrMsg$)
         incr CommCount%
         incr ErrCount%
         RESUME GET.INSTR
    CASE 6%
         ErrMsg$="Повт. ком. метки "+LBDUP$
         Call PutVar(PTR.MESSG&,PMSG$,ErrMsg$)
         incr CommCount%
         incr ErrCount%
         RESUME GET.INSTR
    CASE 7%
         ErrMsg$="REP без кода операции"
         Call PutVar(PTR.MESSG&,PMSG$,ErrMsg$)
         incr CommCount%
         incr ErrCount%
         RESUME GET.INSTR
    CASE 8%
         ErrMsg$="К-во лексем превыш. допустимое"
         Call PutVar(PTR.MESSG&,PMSG$,ErrMsg$)
         incr CommCount%
         incr ErrCount%
         RESUME GET.INSTR
    CASE 9%
         ErrMsg$="BYTE/WORD/DWORD без PTR"
         Call PutVar(PTR.MESSG&,PMSG$,ErrMsg$)
         incr CommCount%
         incr ErrCount%
         RESUME GET.INSTR
    CASE 10%
         ErrMsg$="Переполнение табл. меток"
         Call PutVar(PTR.MESSG&,PMSG$,ErrMsg$)
         incr CommCount%
         incr ErrCount%
         RESUME GET.INSTR
    CASE 101%
         ErrMsg$="Нет закр квадр. скобки"
         Call PutVar(PTR.MESSG&,PMSG$,ErrMsg$)
         incr CommCount%
         incr ErrCount%
         RESUME GET.INSTR
    CASE 102%
         ErrMsg$="Недопуст. символ в адресном выражении"
         Call PutVar(PTR.MESSG&,PMSG$,ErrMsg$)
         incr CommCount%
         incr ErrCount%
         RESUME GET.INSTR
    CASE 103%
         ErrMsg$="Недопуст. комбинация инд. регистров"
         Call PutVar(PTR.MESSG&,PMSG$,ErrMsg$)
         incr CommCount%
         incr ErrCount%
         RESUME GET.INSTR
    CASE 201%
         ErrMsg$="Отсутствует необходимый операнд"
         Call PutVar(PTR.MESSG&,PMSG$,ErrMsg$)
         incr CommCount%
         incr ErrCount%
         RESUME GET.INSTR
    CASE 202%
         ErrMsg$="Не распознан код операции"
         Call PutVar(PTR.MESSG&,PMSG$,ErrMsg$)
         incr CommCount%
         incr ErrCount%
         RESUME GET.INSTR
    CASE 203%
         ErrMsg$="Несоответствие длин операндов"
         Call PutVar(PTR.MESSG&,PMSG$,ErrMsg$)
         incr CommCount%
         incr ErrCount%
         RESUME GET.INSTR
    CASE 204%
         ErrMsg$="Два явных сегмента в одной команде"
         Call PutVar(PTR.MESSG&,PMSG$,ErrMsg$)
         incr CommCount%
         incr ErrCount%
         RESUME GET.INSTR
    CASE 205%
         ErrMsg$="Лишний операнд"
         Call PutVar(PTR.MESSG&,PMSG$,ErrMsg$)
         incr CommCount%
         incr ErrCount%
         RESUME GET.INSTR
    CASE 206%
         ErrMsg$="Неверен/пропущен размер операнда"
         Call PutVar(PTR.MESSG&,PMSG$,ErrMsg$)
         incr CommCount%
         incr ErrCount%
         RESUME GET.INSTR
    CASE 300%
         ErrMsg$="Переход более чем на 127 байтов"
         Call PutVar(PTR.MESSG&,PMSG$,ErrMsg$)
         incr CommCount%
         incr ErrCount%
         RESUME NEXT.REF
    CASE 301%
         ErrMsg$="Не задан размер операнда"
         Call PutVar(PTR.MESSG&,PMSG$,ErrMsg$)
         incr CommCount%
         incr ErrCount%
         RESUME GET.INSTR
    END SELECT

    print "Внутренняя ошибка! код=";ERRCODE%
    incr CommCount%
    incr ErrCount%
    RESUME GET.INSTR

 end if

 CLS
 locate 12%,20%
 print "Ошибка! код=";ERR;" PC=";ERADR
 locate 13%,20%
 Print "Строка: ";NLine%

 STOP

SHOW.HELP:

 print "Запуск: ASM ИМЯ-ASM ИМЯ-COM"
 STOP
