|
@@ -311,6 +311,8 @@ VAR
|
|
|
|
|
|
|
|
caseJmp : ARRAY [0..63] OF CARDINAL ;
|
|
caseJmp : ARRAY [0..63] OF CARDINAL ;
|
|
|
caseN : CARDINAL ;
|
|
caseN : CARDINAL ;
|
|
|
|
|
+ lblLo, lblHi : ARRAY [0..31] OF LONGINT ; (* one arm's label list *)
|
|
|
|
|
+ lblJmp : ARRAY [0..63] OF CARDINAL ; (* its body jumps: 1 or 2 per label *)
|
|
|
|
|
|
|
|
pc, dc : CARDINAL ;
|
|
pc, dc : CARDINAL ;
|
|
|
varspc : CARDINAL ;
|
|
varspc : CARDINAL ;
|
|
@@ -4139,6 +4141,7 @@ VAR tok : CARDINAL ;
|
|
|
lo, hi, v : LONGINT ;
|
|
lo, hi, v : LONGINT ;
|
|
|
clso : CARDINAL ;
|
|
clso : CARDINAL ;
|
|
|
i : CARDINAL ;
|
|
i : CARDINAL ;
|
|
|
|
|
+ k, nlbl, nlblJmp, bodyPc, skipJmp : CARDINAL ;
|
|
|
nm : ARRAY [0..MaxName] OF CHAR ;
|
|
nm : ARRAY [0..MaxName] OF CHAR ;
|
|
|
strf : BOOLEAN ;
|
|
strf : BOOLEAN ;
|
|
|
dow : BOOLEAN ;
|
|
dow : BOOLEAN ;
|
|
@@ -4380,43 +4383,117 @@ BEGIN
|
|
|
IF (tok = TkEnd) OR (tok = TkElse) THEN
|
|
IF (tok = TkEnd) OR (tok = TkElse) THEN
|
|
|
EXIT
|
|
EXIT
|
|
|
END ;
|
|
END ;
|
|
|
- (* case label : constant identifier or literal *)
|
|
|
|
|
- IF Alpha (CurCh ()) THEN
|
|
|
|
|
- GetWord () ;
|
|
|
|
|
- IF Search (wrd, i2) AND (symtab [i2].tag = KConst) THEN
|
|
|
|
|
- lo := symtab [i2].lval
|
|
|
|
|
|
|
+ (* Case labels: `v' | `lo..hi', comma-separated, all selecting the
|
|
|
|
|
+ same statement (CALC's `'G', 'I', 'O', 'Q':'). Read the whole list
|
|
|
|
|
+ first; the emission then knows whether this is the one-label path
|
|
|
|
|
+ or a list. *)
|
|
|
|
|
+ nlbl := 0 ;
|
|
|
|
|
+ LOOP
|
|
|
|
|
+ IF Alpha (CurCh ()) THEN
|
|
|
|
|
+ GetWord () ;
|
|
|
|
|
+ IF Search (wrd, i2) AND (symtab [i2].tag = KConst) THEN
|
|
|
|
|
+ lo := symtab [i2].lval
|
|
|
|
|
+ ELSE
|
|
|
|
|
+ Err (EUnknown) ;
|
|
|
|
|
+ RETURN
|
|
|
|
|
+ END
|
|
|
|
|
+ ELSE
|
|
|
|
|
+ RdConst (lo, clso, strf)
|
|
|
|
|
+ END ;
|
|
|
|
|
+ IF MatchRange () THEN
|
|
|
|
|
+ RdConst (hi, clso, strf)
|
|
|
|
|
+ ELSE
|
|
|
|
|
+ hi := lo
|
|
|
|
|
+ END ;
|
|
|
|
|
+ IF nlbl >= 32 THEN
|
|
|
|
|
+ Err (ECompOvf) ;
|
|
|
|
|
+ RETURN
|
|
|
|
|
+ END ;
|
|
|
|
|
+ lblLo [nlbl] := lo ;
|
|
|
|
|
+ lblHi [nlbl] := hi ;
|
|
|
|
|
+ INC (nlbl) ;
|
|
|
|
|
+ IF MatchDelim (',') THEN
|
|
|
|
|
+ Skip ()
|
|
|
ELSE
|
|
ELSE
|
|
|
- Err (EUnknown) ;
|
|
|
|
|
EXIT
|
|
EXIT
|
|
|
END
|
|
END
|
|
|
- ELSE
|
|
|
|
|
- RdConst (lo, clso, strf)
|
|
|
|
|
- END ;
|
|
|
|
|
- IF MatchRange () THEN
|
|
|
|
|
- RdConst (hi, clso, strf)
|
|
|
|
|
- ELSE
|
|
|
|
|
- hi := lo
|
|
|
|
|
END ;
|
|
END ;
|
|
|
|
|
+ Skip () ;
|
|
|
ExpectDelim (':', ENoSemi) ;
|
|
ExpectDelim (':', ENoSemi) ;
|
|
|
|
|
+ IF NOT OK () THEN
|
|
|
|
|
+ RETURN
|
|
|
|
|
+ END ;
|
|
|
EmMovAxSp () ;
|
|
EmMovAxSp () ;
|
|
|
- EmCmpAxi (W16 (lo)) ;
|
|
|
|
|
- zj := EmJcc (85H, 0) ; (* JNZ -> next *)
|
|
|
|
|
- IF hi # lo THEN
|
|
|
|
|
- EmCmpAxi (W16 (hi)) ;
|
|
|
|
|
- zj2 := EmJcc (85H, 0)
|
|
|
|
|
|
|
+ IF nlbl = 1 THEN
|
|
|
|
|
+ (* One label: the original bytes, except that a RANGE is now a
|
|
|
|
|
+ real range. It used to compare AX with lo and then with hi,
|
|
|
|
|
+ both demanding equality, so `1..5' matched NOTHING unless
|
|
|
|
|
+ lo = hi - a silently wrong answer, not an error. *)
|
|
|
|
|
+ lo := lblLo [0] ;
|
|
|
|
|
+ hi := lblHi [0] ;
|
|
|
|
|
+ IF hi = lo THEN
|
|
|
|
|
+ EmCmpAxi (W16 (lo)) ;
|
|
|
|
|
+ zj := EmJcc (85H, 0) ; (* JNZ -> next arm *)
|
|
|
|
|
+ zj2 := 0
|
|
|
|
|
+ ELSE
|
|
|
|
|
+ EmCmpAxi (W16 (lo)) ;
|
|
|
|
|
+ zj := EmJcc (8CH, 0) ; (* JL -> next arm *)
|
|
|
|
|
+ EmCmpAxi (W16 (hi)) ;
|
|
|
|
|
+ zj2 := EmJcc (8FH, 0) (* JG -> next arm *)
|
|
|
|
|
+ END ;
|
|
|
|
|
+ Statmnt () ;
|
|
|
|
|
+ IF caseN >= 64 THEN
|
|
|
|
|
+ Err (ECompOvf) ;
|
|
|
|
|
+ RETURN
|
|
|
|
|
+ END ;
|
|
|
|
|
+ caseJmp [caseN] := EmJmpNear (0) ;
|
|
|
|
|
+ INC (caseN) ;
|
|
|
|
|
+ SetPatTgt (zj, pc) ;
|
|
|
|
|
+ IF zj2 # 0 THEN
|
|
|
|
|
+ SetPatTgt (zj2, pc)
|
|
|
|
|
+ END
|
|
|
ELSE
|
|
ELSE
|
|
|
- zj2 := 0
|
|
|
|
|
- END ;
|
|
|
|
|
- Statmnt () ;
|
|
|
|
|
- IF caseN >= 64 THEN
|
|
|
|
|
- Err (ECompOvf) ;
|
|
|
|
|
- EXIT
|
|
|
|
|
- END ;
|
|
|
|
|
- caseJmp [caseN] := EmJmpNear (0) ;
|
|
|
|
|
- INC (caseN) ;
|
|
|
|
|
- SetPatTgt (zj, pc) ;
|
|
|
|
|
- IF zj2 # 0 THEN
|
|
|
|
|
- SetPatTgt (zj2, pc)
|
|
|
|
|
|
|
+ (* A list. A single label branches INTO the statement; a range
|
|
|
|
|
+ first sends AX below lo to the next label, then `<= hi' to the
|
|
|
|
|
+ body. The body jumps are patched once the body's address is
|
|
|
|
|
+ known, and the no-match EJMP skips the body to the next arm. *)
|
|
|
|
|
+ nlblJmp := 0 ;
|
|
|
|
|
+ FOR k := 0 TO nlbl - 1 DO
|
|
|
|
|
+ IF lblHi [k] = lblLo [k] THEN
|
|
|
|
|
+ EmCmpAxi (W16 (lblLo [k])) ;
|
|
|
|
|
+ lblJmp [nlblJmp] := EmJcc (84H, 0) ; (* JZ -> body *)
|
|
|
|
|
+ INC (nlblJmp)
|
|
|
|
|
+ ELSE
|
|
|
|
|
+ (* `lo <= AX <= hi', built from the two conditions this
|
|
|
|
|
+ compiler declares for a branch (L and G): below lo skips
|
|
|
|
|
+ the label, above hi skips it, otherwise an unconditional
|
|
|
|
|
+ jump enters the body. JLE would be shorter and is legal
|
|
|
|
|
+ 8086, but check_8086's declared condition set is exactly
|
|
|
|
|
+ Z/NZ/L/G (the four the parser's comparisons use), and a
|
|
|
|
|
+ new condition in CASE would rightly be reported there. *)
|
|
|
|
|
+ EmCmpAxi (W16 (lblLo [k])) ;
|
|
|
|
|
+ zj := EmJcc (8CH, 0) ; (* JL -> next label *)
|
|
|
|
|
+ EmCmpAxi (W16 (lblHi [k])) ;
|
|
|
|
|
+ zj2 := EmJcc (8FH, 0) ; (* JG -> next label *)
|
|
|
|
|
+ lblJmp [nlblJmp] := EmJmpNear (0) ; (* in range -> body *)
|
|
|
|
|
+ INC (nlblJmp) ;
|
|
|
|
|
+ SetPatTgt (zj, pc) ;
|
|
|
|
|
+ SetPatTgt (zj2, pc)
|
|
|
|
|
+ END
|
|
|
|
|
+ END ;
|
|
|
|
|
+ skipJmp := EmJmpNear (0) ;
|
|
|
|
|
+ bodyPc := pc ;
|
|
|
|
|
+ FOR k := 0 TO nlblJmp - 1 DO
|
|
|
|
|
+ SetPatTgt (lblJmp [k], bodyPc)
|
|
|
|
|
+ END ;
|
|
|
|
|
+ Statmnt () ;
|
|
|
|
|
+ IF caseN >= 64 THEN
|
|
|
|
|
+ Err (ECompOvf) ;
|
|
|
|
|
+ RETURN
|
|
|
|
|
+ END ;
|
|
|
|
|
+ caseJmp [caseN] := EmJmpNear (0) ;
|
|
|
|
|
+ INC (caseN) ;
|
|
|
|
|
+ SetPatTgt (skipJmp, pc)
|
|
|
END
|
|
END
|
|
|
END ;
|
|
END ;
|
|
|
IF tok = TkElse THEN
|
|
IF tok = TkElse THEN
|