SECTION "LEM2"
GET "AHDR"
LET R.ADR(ADRTYPE,ADR,REGB,REGI,ADSIZE)=VALOF $(
LET T1,T2=0,0
//** DEBUG("R.ADR ARG ITSELF IS %X8 AND !ARG IN HEX %X2*N",ARG,!ARG)
//** DEBUG("R.ADR !ARG=%C*N",!ARG)
IF ARG=0 RESULTIS FALSE
IF R.REGB(REGB,REGI,ADRTYPE) RESULTIS TRUE
IF R.IMM(ADR,ADSIZE,ADRTYPE) RESULTIS TRUE
IF R.REG(@T1,@T2) THEN $(
//** DEBUG("T1= %N, T2= %N*N",T1,T2)
!ADR:=T2
!ADRTYPE:=T1
RESULTIS TRUE
$)
READEXPR(@ARG)
OLDSYMB:=EXPR.TYPE & #X3FF
UNLESS EXPR.TYPE=-1 DO EXPR.TYPE:=EXPR.TYPEﰀ
IF EXPR.TYPE=-1 THEN
UNTIL !ARG=','|!ARG='('|!ARG='*N'|!ARG=' '|!ARG='['
DO ARG:=ARG+1
!ADR:=EXPR.VALUE
IF (PASS=1) & (EXPR.TYPE=-1) THEN SET(!CNT,1)
!ADSIZE:= (EXPR.TYPE=-1)|(EXPR.TYPE~=T.ABS)|(BITSET(!CNT,1)&(PASS=2))|
((EXPR.TYPE=T.ABS)&(EXPR.VALUE>127|EXPR.VALUE<-128))->
1 , 0
!ADRTYPE:=(EXPR.TYPE=-1)->T.ABS,EXPR.TYPE
IF R.TERM(!ARG) RESULTIS TRUE
UNLESS R.REGB(REGB,REGI,ADRTYPE) RESULTIS FALSE
UNLESS R.TERM(!ARG) RESULTIS FALSE
RESULTIS TRUE
$)
//
AND SET(X,Y) BE $(
LET WORDNO=X/16 AND BITNO=(X REM 16)*2+Y
//** DEBUG(" X,Y,WORDNO,BITNO= %N %N %N %N*N",X,Y,WORDNO,BITNO)
INANAL!WORDNO:=(INANAL!WORDNO)|(1<<BITNO)
$)
//
AND BITSET(X,Y) = VALOF $(
LET WORDNO=X/16 AND BITNO=(X REM 16)*2+Y
//** DEBUG("X,Y,WORDNO,BITNO TESTED= %N %N %N %N*N",X,Y,WORDNO,BITNO)
RESULTIS(((INANAL!WORDNO)&(1<<BITNO))~=0)
$)
//
AND R.REGB(REGB,REGI,ADRTYPE)=VALOF $(
LET T=0
//** DEBUG("R.REGB !ARG=%C 1!ARG=%C *N",!ARG,1!ARG)
UNLESS !ARG='(' RESULTIS FALSE
ARG:=ARG+1
T:=(!ARG<<8)+(1!ARG)
IF T=(('B'<<8)+'X') THEN $( !REGB:=3;ARG:=ARG+2 $)
IF T=(('B'<<8)+'P') THEN $( !REGB:=5;ARG:=ARG+2 $)
IF !ARG=')' THEN $( !ADRTYPE:=!ADRTYPE+T.BASE; ARG:=ARG+1;
RESULTIS TRUE $)
IF !ARG=',' THEN ARG:=ARG+1
T:=(!ARG<<8)+(1!ARG)
IF T=(('S'<<8)+'I') THEN $( !REGI:=6; ARG:=ARG+2 $)
IF T=(('D'<<8)+'I') THEN $( !REGI:=7; ARG:=ARG+2 $)
UNLESS !ARG=')' RESULTIS FALSE
ARG:=ARG+1
!ADRTYPE:=!ADRTYPE+T.BASE
RESULTIS TRUE
$)
AND R.IMM(ADR,ADSIZE,ADRTYPE)=VALOF $(
//** DEBUG("R.IMM !ARG=%C*N",!ARG)
UNLESS !ARG='!' RESULTIS FALSE
ARG:=ARG+1
READEXPR(@ARG)
OLDSYMB:=EXPR.TYPE & #X3FF
UNLESS EXPR.TYPE=-1 DO EXPR.TYPE:=EXPR.TYPEﰀ
IF EXPR.TYPE=-1 THEN UNTIL
!ARG=','|!ARG='('|!ARG='['|!ARG='*N'|!ARG=' ' DO ARG:=ARG+1
IF (PASS=1) & (EXPR.TYPE=-1) THEN SET(!CNT,0)
!ADR:=EXPR.VALUE
!ADSIZE:= ((EXPR.TYPE=T.ABS)&(EXPR.VALUE>128))|
(BITSET(!CNT,0)&(PASS=2))|
~ITEMSET|
(EXPR.TYPE~=T.ABS) -> 1,0
!ADRTYPE:=((EXPR.TYPE=-1)->T.ABS,EXPR.TYPE)+T.IM
RESULTIS TRUE
$)
AND R.TERM(CH)=CH=','|CH=' '|CH='*N'|CH=')'|CH='['
AND R.END(CH)=CH=' '|CH='*N' |
R.LOCK(@LOCK)|R.BYTE(@RSIZE)|R.SEG(@SEGOVR)
AND R.LOCK(X)=VALOF $(
//** DEBUG("R.LOCK %C %C %C*N",!ARG,1!ARG,2!ARG)
UNLESS !ARG='[' RESULTIS FALSE
IF 1!ARG='L' THEN $(
!X:=TRUE
UNTIL !ARG=']'| !ARG='*N' DO ARG:=ARG+1
IF !ARG=']' DO $(
ARG:=ARG+1
UNLESS R.END(!ARG) RESULTIS FALSE
RESULTIS TRUE
$)
$)
RESULTIS FALSE
$)
AND R.BYTE(X) = VALOF $(
//** DEBUG("R.BYTE %C %C %C*N",!ARG,1!ARG,2!ARG)
UNLESS !ARG='[' RESULTIS FALSE
IF 1!ARG='B' THEN $(
!X:=0
UNTIL !ARG=']'|!ARG='*N' DO ARG:=ARG+1
IF !ARG=']' DO $(
ARG:=ARG+1
UNLESS R.END(!ARG) RESULTIS FALSE
RESULTIS TRUE
$)
$)
RESULTIS FALSE
$)
AND R.SEG(X)=VALOF $(
LET Y=0
//** DEBUG("R.SEG %C %C %C*N",!ARG,1!ARG,2!ARG)
UNLESS !ARG='[' RESULTIS FALSE
SWITCHON (1!ARG<<8)+(2!ARG) INTO $(
CASE ('E'<<8)+'S':!X:=1;ENDCASE
CASE ('C'<<8)+'S':!X:=2;ENDCASE
CASE ('S'<<8)+'S':!X:=3;ENDCASE
CASE ('D'<<8)+'S':!X:=4;ENDCASE
DEFAULT:!X:=0;ENDCASE
$)
IF !X=0 THEN RESULTIS FALSE
ARG:=ARG+3
UNLESS !ARG=']' RESULTIS FALSE
ARG:=ARG+1
RESULTIS R.END(!ARG)
$)
//
AND R.OUT1(X) BE $(
//** DEBUG("R.OUT1 = %X2*N",X)
P.CODEN!P.CODEV:=X
P.CODEN!P.CODET:=T.ABS
P.CODEN:=P.CODEN+1
$)
AND R.OUT2R(X,Y) BE $(
//** DEBUG("R.OUT2R = %X4 , Y=%X4 ,OLDSYMB = %X4*N",X,Y,OLDSYMB)
IF Y=T.EXT THEN Y:=T.EXT+OLDSYMB
P.CODEN!P.CODEV:=(X>>8)ÿ
P.CODEN!P.CODET:=Y
P.CODEN:=P.CODEN+1
P.CODEN!P.CODEV:=Xÿ
P.CODEN!P.CODET:=Y
P.CODEN:=P.CODEN+1
$)
AND R.OUTADX2(X,Y) BE $(
LET W=(RSIZE=0)|(ADTYPE1=T.R8)->0,1
//** DEBUG("R.OUTADX2 = %X2 %X2 , W = %N*N",X,Y,W)
UNLESS REG1|REG2|IMTRUE|(ADTYPE1=T.RSEG)|(ADTYPE2=T.RSEG)|
(ADTYPE2=0) DO FAULT('S')
R.OUT1(X|W)
R.OUTG(Y)
$)
AND R.OUTADX(X) BE $(
LET Y=X|(TODIR<<1)
AND Z=ADR1<<3
IF ADTYPE1=T.R8 THEN RSIZE:=0 // THIS FORCES W=0
//** DEBUG("R.OUTADX = %X2 , Y = %X2 , Z = %X2*N",X,Y,Z)
R.SWAP()
R.OUTADX2(Y,Z)
$)
AND R.OUTIMA(X) BE $(
LET W=(ADTYPE1=T.R16)->1,0
//** DEBUG("R.OUTIMA = %X2 , W = %N*N",X,W)
R.OUT1(X|W)
IF REL2 THEN $( R.OUT2R(ADR2,ADTYPE2ﰀ) ; RETURN $)
R.OUT1(ADR2)
IF W=0 THEN RETURN
R.OUT1(ADR2>>8)
RETURN
$)
AND R.OUTIMX(X,SW) BE $(
//** DEBUG("R.OUTIMX = %X2 %N*N",X,SW)
R.OUTADX2(X,3!NT)
TEST REL2 THEN R.OUT2R(ADR2,ADTYPE2ﰀ)
ELSE $(
R.OUT1(ADR2)
IF ~SW THEN RETURN
R.OUT1(ADR2>>8)
$)
RETURN
$)
AND R.OUTG(X) BE $(
LET RM,MOD,DISP=0,0,0
//** DEBUG("R.OUTG = %X2*N",X)
SWITCHON ADTYPE1 INTO $(
CASE T.R8:
CASE T.R16:
MOD:=3; RM:=ADR1
R.OUT1(X|(MOD<<6)|RM)
RETURN
CASE T.ABS:
MOD:=0; RM:=6
R.OUT1(X|(MOD<<6)|RM)
R.OUT1(ADR1) ; R.OUT1(ADR1>>8)
RETURN
CASE T.REL:
CASE T.EXT:
MOD:=0;RM:=6
R.OUT1(X|(MOD<<6)|RM)
R.OUT2R(ADR1,ADTYPE1ﰀ)
RETURN
CASE T.ABS+T.BASE:
CASE T.EXT+T.BASE:
CASE T.REL+T.BASE:
CASE T.BASE:
SWITCHON (RB1<<8)+RI1 INTO $(A
CASE (3<<8)+6:RM:=0;ENDCASE
CASE (3<<8)+7:RM:=1;ENDCASE
CASE (5<<8)+6:RM:=2;ENDCASE
CASE (5<<8)+7:RM:=3;ENDCASE
CASE 6: RM:=4;ENDCASE
CASE 7: RM:=5;ENDCASE
CASE 5<<8: RM:=6;ENDCASE
CASE 3<<8: RM:=7;ENDCASE
DEFAULT: RM:=6;ENDCASE
$)A
TEST (~REL1)&(ADR1=0)&(RM~=6)&(~BITSET(!CNT,1)) THEN MOD:=0
ELSE TEST ~REL1&((ADSIZE1=0)|((ADR1=0)&(RM=6))) THEN MOD:=1
ELSE MOD:=2
R.OUT1(X|(MOD<<6)|RM)
IF MOD=0 RETURN
IF MOD=1 THEN $(
R.OUT1(ADR1)
RETURN
$)
IF REL1 THEN $(
R.OUT2R(ADR1,ADTYPE1ﰀ)
RETURN
$)
R.OUT1(ADR1)
R.OUT1(ADR1>>8)
//
$)
$)
//
AND R.SWAP() BE $(
LET A,B,C,D,E=ADTYPE1,ADR1,RB1,RI1,ADSIZE1
ADTYPE1,ADR1,RB1,RI1,ADSIZE1:=ADTYPE2,ADR2,RB2,RI2,ADSIZE2
ADTYPE2,ADR2,RB2,RI2,ADSIZE2:=A,B,C,D,E
//
$)
AND R.REG(TYPE,REG)=VALOF $(
//** DEBUG("R.REG !ARG=%C*N",!ARG)
//** DEBUG("AND 1!ARG AND 2!ARG = %C, %X2*N",1!ARG,2!ARG)
IF ARG=0 RESULTIS FALSE
//** DEBUG("WE IS OK*N")
UNLESS R.TERM(2!ARG) RESULTIS FALSE
//** DEBUG("AND WE AR STILL OK *N")
SWITCHON (!ARG<<8)+(1!ARG) INTO $(
CASE ('A'<<8)+'X': !TYPE:=T.R16; !REG:=0 ; ARG:=ARG+2; RESULTIS TRUE
CASE ('B'<<8)+'X': !TYPE:=T.R16; !REG:=3 ; ARG:=ARG+2; RESULTIS TRUE
CASE ('C'<<8)+'X': !TYPE:=T.R16; !REG:=1 ; ARG:=ARG+2; RESULTIS TRUE
CASE ('D'<<8)+'X': !TYPE:=T.R16; !REG:=2 ; ARG:=ARG+2; RESULTIS TRUE
CASE ('S'<<8)+'P': !TYPE:=T.R16; !REG:=4 ; ARG:=ARG+2; RESULTIS TRUE
CASE ('B'<<8)+'P': !TYPE:=T.R16; !REG:=5 ; ARG:=ARG+2; RESULTIS TRUE
CASE ('S'<<8)+'I': !TYPE:=T.R16; !REG:=6 ; ARG:=ARG+2; RESULTIS TRUE
CASE ('D'<<8)+'I': !TYPE:=T.R16; !REG:=7 ; ARG:=ARG+2; RESULTIS TRUE
CASE ('A'<<8)+'L': !TYPE:=T.R8; !REG:=0 ; ARG:=ARG+2; RESULTIS TRUE
CASE ('C'<<8)+'L': !TYPE:=T.R8; !REG:=1 ; ARG:=ARG+2; RESULTIS TRUE
CASE ('D'<<8)+'L': !TYPE:=T.R8; !REG:=2 ; ARG:=ARG+2; RESULTIS TRUE
CASE ('B'<<8)+'L': !TYPE:=T.R8; !REG:=3 ; ARG:=ARG+2; RESULTIS TRUE
CASE ('A'<<8)+'H': !TYPE:=T.R8; !REG:=4 ; ARG:=ARG+2; RESULTIS TRUE
CASE ('C'<<8)+'H': !TYPE:=T.R8; !REG:=5 ; ARG:=ARG+2; RESULTIS TRUE
CASE ('D'<<8)+'H': !TYPE:=T.R8; !REG:=6 ; ARG:=ARG+2; RESULTIS TRUE
CASE ('B'<<8)+'H': !TYPE:=T.R8; !REG:=7 ; ARG:=ARG+2; RESULTIS TRUE
CASE ('E'<<8)+'S': !TYPE:=T.RSEG; !REG:=0 ; ARG:=ARG+2; RESULTIS TRUE
CASE ('C'<<8)+'S': !TYPE:=T.RSEG; !REG:=1 ; ARG:=ARG+2; RESULTIS TRUE
CASE ('S'<<8)+'S': !TYPE:=T.RSEG; !REG:=2 ; ARG:=ARG+2; RESULTIS TRUE
CASE ('D'<<8)+'S': !TYPE:=T.RSEG; !REG:=3 ; ARG:=ARG+2; RESULTIS TRUE
$)
//** DEBUG("WE HAVE AN ERROR %X4*N",(!ARG<<8)+(1!ARG))
RESULTIS FALSE
$)
.