Rev 8097 | Rev 9177 | Go to most recent revision | Show entire file | Regard whitespace | Details | Blame | Last modification | View Log | RSS feed
Rev 8097 | Rev 8859 | ||
---|---|---|---|
Line 1... | Line 1... | ||
1 | (* |
1 | (* |
2 | BSD 2-Clause License |
2 | BSD 2-Clause License |
Line 3... | Line 3... | ||
3 | 3 | ||
4 | Copyright (c) 2018-2020, Anton Krotov |
4 | Copyright (c) 2018-2021, Anton Krotov |
5 | All rights reserved. |
5 | All rights reserved. |
Line 6... | Line 6... | ||
6 | *) |
6 | *) |
Line 14... | Line 14... | ||
14 | 14 | ||
15 | call_stack* = 0; |
15 | call_stack* = 0; |
16 | call_win64* = 1; |
16 | call_win64* = 1; |
Line -... | Line 17... | ||
- | 17 | call_sysv* = 2; |
|
- | 18 | ||
17 | call_sysv* = 2; |
19 | begin_loop* = 1; end_loop* = 2; |
18 | 20 | ||
19 | opJMP* = 0; opLABEL* = 1; opCOPYS* = 2; opGADR* = 3; opCONST* = 4; opLLOAD32* = 5; |
21 | opJMP* = 0; opLABEL* = 1; opCOPYS* = 2; opGADR* = 3; opCONST* = 4; opLLOAD32* = 5; |
20 | opCOPYA* = 6; opCASET* = 7; opMULC* = 8; opMUL* = 9; opDIV* = 10; opMOD* = 11; |
22 | opCOPYA* = 6; opCASET* = 7; opMULC* = 8; opMUL* = 9; opDIV* = 10; opMOD* = 11; |
21 | opDIVL* = 12; opMODL* = 13; opDIVR* = 14; opMODR* = 15; opUMINUS* = 16; |
23 | opDIVL* = 12; opMODL* = 13; opDIVR* = 14; opMODR* = 15; opUMINUS* = 16; |
Line 42... | Line 44... | ||
42 | opINCCB* = 79; opDECCB* = 80; opINCB* = 81; opDECB* = 82; |
44 | opINCCB* = 79; opDECCB* = 80; opINCB* = 81; opDECB* = 82; |
Line 43... | Line 45... | ||
43 | 45 | ||
Line 44... | Line 46... | ||
44 | opCASEL* = 83; opCASER* = 84; opCASELR* = 85; |
46 | opCASEL* = 83; opCASER* = 84; opCASELR* = 85; |
45 | 47 | ||
Line 46... | Line 48... | ||
46 | opPOPSP* = 86; |
48 | opPOPSP* = 86; |
47 | opWIN64CALL* = 87; opWIN64CALLI* = 88; opWIN64CALLP* = 89; opLOOP* = 90; opENDLOOP* = 91; |
49 | opWIN64CALL* = 87; opWIN64CALLI* = 88; opWIN64CALLP* = 89; opAND* = 90; opOR* = 91; |
Line 48... | Line 50... | ||
48 | 50 | ||
Line 77... | Line 79... | ||
77 | 79 | ||
78 | opTYPEGD* = 207; opCALLI* = 208; opPUSHIP* = 209; opSAVEIP* = 210; opEQIP* = 211; opNEIP* = 212; |
80 | opTYPEGD* = 207; opCALLI* = 208; opPUSHIP* = 209; opSAVEIP* = 210; opEQIP* = 211; opNEIP* = 212; |
Line 79... | Line 81... | ||
79 | opSAVE16C* = 213; opWCHR* = 214; opHANDLER* = 215; |
81 | opSAVE16C* = 213; opWCHR* = 214; opHANDLER* = 215; |
80 | - | ||
Line 81... | Line 82... | ||
81 | opSYSVCALL* = 216; opSYSVCALLI* = 217; opSYSVCALLP* = 218; opFNAME* = 219; |
82 | |
82 | opAND* = 220; opOR* = 221; |
83 | opSYSVCALL* = 216; opSYSVCALLI* = 217; opSYSVCALLP* = 218; opFNAME* = 219; |
83 | 84 | ||
Line 130... | Line 131... | ||
130 | _unpk *= 32; |
131 | _unpk *= 32; |
Line 131... | Line 132... | ||
131 | 132 | ||
Line 132... | Line -... | ||
132 | - | ||
133 | TYPE |
- | |
134 | - | ||
135 | LOCALVAR* = POINTER TO RECORD (LISTS.ITEM) |
- | |
136 | - | ||
137 | offset*, size*, count*: INTEGER |
- | |
138 | 133 | ||
Line 139... | Line 134... | ||
139 | END; |
134 | TYPE |
140 | 135 | ||
141 | COMMAND* = POINTER TO RECORD (LISTS.ITEM) |
136 | COMMAND* = POINTER TO RECORD (LISTS.ITEM) |
142 | 137 | ||
143 | opcode*: INTEGER; |
138 | opcode*: INTEGER; |
144 | param1*: INTEGER; |
- | |
145 | param2*: INTEGER; |
- | |
Line 146... | Line 139... | ||
146 | param3*: INTEGER; |
139 | param1*: INTEGER; |
Line 147... | Line 140... | ||
147 | float*: REAL; |
140 | param2*: INTEGER; |
Line 164... | Line 157... | ||
164 | END; |
157 | END; |
Line 165... | Line 158... | ||
165 | 158 | ||
Line 166... | Line 159... | ||
166 | EXPORT_PROC* = POINTER TO RECORD (LISTS.ITEM) |
159 | EXPORT_PROC* = POINTER TO RECORD (LISTS.ITEM) |
167 | 160 | ||
Line 168... | Line 161... | ||
168 | label*: INTEGER; |
161 | label*: INTEGER; |
Line 169... | Line 162... | ||
169 | name*: SCAN.LEXSTR |
162 | name*: SCAN.IDSTR |
Line 170... | Line 163... | ||
170 | 163 | ||
171 | END; |
164 | END; |
Line 172... | Line 165... | ||
172 | 165 | ||
Line 173... | Line 166... | ||
173 | IMPORT_LIB* = POINTER TO RECORD (LISTS.ITEM) |
166 | IMPORT_LIB* = POINTER TO RECORD (LISTS.ITEM) |
Line 174... | Line 167... | ||
174 | 167 | ||
175 | name*: SCAN.LEXSTR; |
168 | name*: SCAN.TEXTSTR; |
176 | procs*: LISTS.LIST |
169 | procs*: LISTS.LIST |
177 | 170 | ||
Line 178... | Line 171... | ||
178 | END; |
171 | END; |
Line 213... | Line 206... | ||
213 | VAR |
206 | VAR |
Line 214... | Line 207... | ||
214 | 207 | ||
215 | codes*: CODES; |
208 | codes*: CODES; |
Line 216... | Line 209... | ||
216 | CPU: INTEGER; |
209 | CPU: INTEGER; |
Line 217... | Line 210... | ||
217 | 210 | ||
218 | commands, variables: C.COLLECTION; |
211 | commands: C.COLLECTION; |
219 | 212 | ||
Line 245... | Line 238... | ||
245 | citem := C.pop(commands); |
238 | citem := C.pop(commands); |
246 | IF citem = NIL THEN |
239 | IF citem = NIL THEN |
247 | NEW(cmd) |
240 | NEW(cmd) |
248 | ELSE |
241 | ELSE |
249 | cmd := citem(COMMAND) |
242 | cmd := citem(COMMAND) |
250 | END; |
243 | END |
251 | - | ||
252 | cmd.allocReg := FALSE |
- | |
Line 253... | Line 244... | ||
253 | 244 | ||
254 | RETURN cmd |
245 | RETURN cmd |
Line 255... | Line -... | ||
255 | END NewCmd; |
- | |
256 | - | ||
257 | - | ||
258 | PROCEDURE NewVar* (): LOCALVAR; |
- | |
259 | VAR |
- | |
260 | lvar: LOCALVAR; |
- | |
261 | citem: C.ITEM; |
- | |
262 | - | ||
263 | BEGIN |
- | |
264 | citem := C.pop(variables); |
- | |
265 | IF citem = NIL THEN |
- | |
266 | NEW(lvar) |
- | |
267 | ELSE |
- | |
268 | lvar := citem(LOCALVAR) |
- | |
269 | END; |
- | |
270 | - | ||
271 | lvar.count := 0 |
- | |
272 | - | ||
273 | RETURN lvar |
- | |
274 | END NewVar; |
246 | END NewCmd; |
275 | 247 | ||
276 | 248 | ||
277 | PROCEDURE setlast* (cmd: COMMAND); |
249 | PROCEDURE setlast* (cmd: COMMAND); |
Line 491... | Line 463... | ||
491 | 463 | ||
492 | ELSIF (nov.opcode = opSAVEC) & (old_opcode = opGADR) THEN |
464 | ELSIF (nov.opcode = opSAVEC) & (old_opcode = opGADR) THEN |
Line 493... | Line 465... | ||
493 | set(cur, opGADR_SAVEC, param2) |
465 | set(cur, opGADR_SAVEC, param2) |
494 | 466 | ||
Line 495... | Line 467... | ||
495 | ELSIF (nov.opcode = opMULC) & (old_opcode = opMULC) THEN |
467 | ELSIF (nov.opcode = opMULC) & (old_opcode = opMULC) THEN |
496 | cur.param2 := param2 * cur.param2 |
468 | cur.param2 := cur.param2 * param2 |
Line 497... | Line 469... | ||
497 | 469 | ||
498 | ELSIF (nov.opcode = opADDC) & (old_opcode = opADDC) THEN |
470 | ELSIF (nov.opcode = opADDC) & (old_opcode = opADDC) THEN |
499 | cur.param2 := param2 + cur.param2 |
471 | INC(cur.param2, param2) |
- | 472 | ||
- | 473 | ELSE |
|
- | 474 | old_opcode := -1 |
|
- | 475 | END |
|
- | 476 | ||
- | 477 | ELSIF CPU IN {TARGETS.cpuTHUMB, TARGETS.cpuRVM32I, TARGETS.cpuRVM64I} THEN |
|
- | 478 | ||
- | 479 | old_opcode := cur.opcode; |
|
- | 480 | param2 := nov.param2; |
|
- | 481 | ||
- | 482 | IF (old_opcode = opLADR) & (nov.opcode = opSAVE) THEN |
|
- | 483 | cur.opcode := opLADR_SAVE |
|
- | 484 | ELSIF (old_opcode = opLADR) & (nov.opcode = opINCC) THEN |
|
- | 485 | set(cur, opLADR_INCC, param2) |
|
- | 486 | ELSIF (nov.opcode = opMULC) & (old_opcode = opMULC) THEN |
|
- | 487 | cur.param2 := cur.param2 * param2 |
|
- | 488 | ELSIF (nov.opcode = opADDC) & (old_opcode = opADDC) THEN |
|
- | 489 | INC(cur.param2, param2) |
|
500 | 490 | ELSE |
|
501 | ELSE |
491 | old_opcode := -1 |
502 | old_opcode := -1 |
492 | END |
Line 503... | Line 493... | ||
503 | END |
493 | |
Line 581... | Line 571... | ||
581 | BEGIN |
571 | BEGIN |
582 | AddCmd(opcode, 0) |
572 | AddCmd(opcode, 0) |
583 | END AddCmd0; |
573 | END AddCmd0; |
Line 584... | Line -... | ||
584 | - | ||
585 | - | ||
586 | PROCEDURE deleteVarList (list: LISTS.LIST); |
- | |
587 | VAR |
- | |
588 | last: LISTS.ITEM; |
- | |
589 | - | ||
590 | BEGIN |
- | |
591 | WHILE list.last # NIL DO |
- | |
592 | last := LISTS.pop(list); |
- | |
593 | C.push(variables, last) |
- | |
594 | END |
- | |
595 | END deleteVarList; |
- | |
596 | 574 | ||
597 | 575 | ||
598 | PROCEDURE delete (cmd: COMMAND); |
- | |
599 | BEGIN |
- | |
600 | IF cmd.variables # NIL THEN |
- | |
601 | deleteVarList(cmd.variables) |
576 | PROCEDURE delete (cmd: COMMAND); |
602 | END; |
577 | BEGIN |
603 | LISTS.delete(codes.commands, cmd); |
578 | LISTS.delete(codes.commands, cmd); |
Line 624... | Line 599... | ||
624 | LISTS.delete(codes.commands, cur); |
599 | LISTS.delete(codes.commands, cur); |
625 | C.push(commands, cur) |
600 | C.push(commands, cur) |
626 | END delete2; |
601 | END delete2; |
Line 627... | Line 602... | ||
627 | 602 | ||
628 | 603 | ||
629 | PROCEDURE AddJmpCmd* (opcode: INTEGER; label: INTEGER); |
604 | PROCEDURE Jmp* (opcode: INTEGER; label: INTEGER); |
630 | VAR |
605 | VAR |
Line 631... | Line 606... | ||
631 | prev: COMMAND; |
606 | prev: COMMAND; |
Line 647... | Line 622... | ||
647 | AddCmd2(opcode, label, label); |
622 | AddCmd2(opcode, label, label); |
Line 648... | Line 623... | ||
648 | 623 | ||
649 | IF not THEN |
624 | IF not THEN |
650 | delete(prev) |
625 | delete(prev) |
651 | END |
626 | END |
Line 652... | Line 627... | ||
652 | END AddJmpCmd; |
627 | END Jmp; |
653 | 628 | ||
654 | 629 | ||
Line 704... | Line 679... | ||
704 | label := l; |
679 | label := l; |
705 | jz := ~jz |
680 | jz := ~jz |
706 | END; |
681 | END; |
Line 707... | Line 682... | ||
707 | 682 | ||
708 | IF jz THEN |
683 | IF jz THEN |
709 | AddJmpCmd(opJZ, label) |
684 | Jmp(opJZ, label) |
710 | ELSE |
685 | ELSE |
711 | AddJmpCmd(opJNZ, label) |
686 | Jmp(opJNZ, label) |
Line 712... | Line 687... | ||
712 | END; |
687 | END; |
713 | 688 | ||
714 | IF op = opOR THEN |
689 | IF op = opOR THEN |
715 | SetLabel(l) |
690 | SetLabel(l) |
716 | END |
691 | END |
717 | ELSE |
692 | ELSE |
Line 718... | Line 693... | ||
718 | AddJmpCmd(opJZ, label) |
693 | Jmp(opJZ, label) |
719 | END; |
694 | END; |
Line 732... | Line 707... | ||
732 | VAR |
707 | VAR |
733 | label: INTEGER; |
708 | label: INTEGER; |
734 | BEGIN |
709 | BEGIN |
735 | AddCmd(op, t); |
710 | AddCmd(op, t); |
736 | label := NewLabel(); |
711 | label := NewLabel(); |
737 | AddJmpCmd(opJNZ, label); |
712 | Jmp(opJNZ, label); |
738 | OnError(line, error); |
713 | OnError(line, error); |
739 | SetLabel(label) |
714 | SetLabel(label) |
740 | END TypeGuard; |
715 | END TypeGuard; |
Line 787... | Line 762... | ||
787 | BEGIN |
762 | BEGIN |
788 | cmd := NewCmd(); |
763 | cmd := NewCmd(); |
789 | cmd.opcode := opENTER; |
764 | cmd.opcode := opENTER; |
790 | cmd.param1 := label; |
765 | cmd.param1 := label; |
791 | cmd.param3 := params; |
766 | cmd.param3 := params; |
792 | cmd.allocReg := TRUE; |
- | |
793 | insert(codes.last, cmd) |
767 | insert(codes.last, cmd) |
Line 794... | Line 768... | ||
794 | 768 | ||
795 | RETURN codes.last |
769 | RETURN codes.last |
Line 827... | Line 801... | ||
827 | 801 | ||
828 | 802 | ||
829 | PROCEDURE Call* (proc, callconv, fparams: INTEGER); |
803 | PROCEDURE Call* (proc, callconv, fparams: INTEGER); |
830 | BEGIN |
804 | BEGIN |
831 | CASE callconv OF |
805 | CASE callconv OF |
832 | |call_stack: AddJmpCmd(opCALL, proc) |
806 | |call_stack: Jmp(opCALL, proc) |
833 | |call_win64: AddJmpCmd(opWIN64CALL, proc) |
807 | |call_win64: Jmp(opWIN64CALL, proc) |
834 | |call_sysv: AddJmpCmd(opSYSVCALL, proc) |
808 | |call_sysv: Jmp(opSYSVCALL, proc) |
835 | END; |
809 | END; |
Line 836... | Line 810... | ||
836 | codes.last(COMMAND).param2 := fparams |
810 | codes.last(COMMAND).param2 := fparams |
837 | END Call; |
811 | END Call; |
838 | 812 | ||
839 | 813 | ||
840 | PROCEDURE CallImp* (proc: LISTS.ITEM; callconv, fparams: INTEGER); |
814 | PROCEDURE CallImp* (proc: LISTS.ITEM; callconv, fparams: INTEGER); |
841 | BEGIN |
815 | BEGIN |
842 | CASE callconv OF |
816 | CASE callconv OF |
843 | |call_stack: AddJmpCmd(opCALLI, proc(IMPORT_PROC).label) |
817 | |call_stack: Jmp(opCALLI, proc(IMPORT_PROC).label) |
844 | |call_win64: AddJmpCmd(opWIN64CALLI, proc(IMPORT_PROC).label) |
818 | |call_win64: Jmp(opWIN64CALLI, proc(IMPORT_PROC).label) |
Line 858... | Line 832... | ||
858 | END CallP; |
832 | END CallP; |
Line 859... | Line 833... | ||
859 | 833 | ||
860 | 834 | ||
861 | PROCEDURE AssignProc* (proc: INTEGER); |
835 | PROCEDURE AssignProc* (proc: INTEGER); |
862 | BEGIN |
836 | BEGIN |
Line 863... | Line 837... | ||
863 | AddJmpCmd(opSAVEP, proc) |
837 | Jmp(opSAVEP, proc) |
864 | END AssignProc; |
838 | END AssignProc; |
865 | 839 | ||
866 | 840 | ||
Line 867... | Line 841... | ||
867 | PROCEDURE AssignImpProc* (proc: LISTS.ITEM); |
841 | PROCEDURE AssignImpProc* (proc: LISTS.ITEM); |
868 | BEGIN |
842 | BEGIN |
869 | AddJmpCmd(opSAVEIP, proc(IMPORT_PROC).label) |
843 | Jmp(opSAVEIP, proc(IMPORT_PROC).label) |
870 | END AssignImpProc; |
844 | END AssignImpProc; |
Line 871... | Line 845... | ||
871 | 845 | ||
872 | 846 | ||
873 | PROCEDURE PushProc* (proc: INTEGER); |
847 | PROCEDURE PushProc* (proc: INTEGER); |
874 | BEGIN |
848 | BEGIN |
Line 875... | Line 849... | ||
875 | AddJmpCmd(opPUSHP, proc) |
849 | Jmp(opPUSHP, proc) |
876 | END PushProc; |
850 | END PushProc; |
877 | 851 | ||
878 | 852 | ||
879 | PROCEDURE PushImpProc* (proc: LISTS.ITEM); |
853 | PROCEDURE PushImpProc* (proc: LISTS.ITEM); |
880 | BEGIN |
854 | BEGIN |
881 | AddJmpCmd(opPUSHIP, proc(IMPORT_PROC).label) |
855 | Jmp(opPUSHIP, proc(IMPORT_PROC).label) |
882 | END PushImpProc; |
856 | END PushImpProc; |
Line 883... | Line 857... | ||
883 | 857 | ||
884 | 858 | ||
885 | PROCEDURE ProcCmp* (proc: INTEGER; eq: BOOLEAN); |
859 | PROCEDURE ProcCmp* (proc: INTEGER; eq: BOOLEAN); |
886 | BEGIN |
860 | BEGIN |
887 | IF eq THEN |
861 | IF eq THEN |
888 | AddJmpCmd(opEQP, proc) |
862 | Jmp(opEQP, proc) |
889 | ELSE |
863 | ELSE |
890 | AddJmpCmd(opNEP, proc) |
864 | Jmp(opNEP, proc) |
Line 891... | Line 865... | ||
891 | END |
865 | END |
Line 1087... | Line 1061... | ||
1087 | cmd.fname := name; |
1061 | cmd.fname := name; |
1088 | insert(codes.last, cmd) |
1062 | insert(codes.last, cmd) |
1089 | END fname; |
1063 | END fname; |
Line 1090... | Line 1064... | ||
1090 | 1064 | ||
1091 | 1065 | ||
1092 | PROCEDURE AddExp* (label: INTEGER; name: SCAN.LEXSTR); |
1066 | PROCEDURE AddExp* (label: INTEGER; name: SCAN.IDSTR); |
Line 1093... | Line 1067... | ||
1093 | VAR |
1067 | VAR |
1094 | exp: EXPORT_PROC; |
1068 | exp: EXPORT_PROC; |
Line 1099... | Line 1073... | ||
1099 | exp.name := name; |
1073 | exp.name := name; |
1100 | LISTS.push(codes.export, exp) |
1074 | LISTS.push(codes.export, exp) |
1101 | END AddExp; |
1075 | END AddExp; |
Line 1102... | Line 1076... | ||
1102 | 1076 | ||
1103 | 1077 | ||
1104 | PROCEDURE AddImp* (dll, proc: SCAN.LEXSTR): IMPORT_PROC; |
1078 | PROCEDURE AddImp* (dll, proc: SCAN.TEXTSTR): IMPORT_PROC; |
1105 | VAR |
1079 | VAR |
Line 1106... | Line 1080... | ||
1106 | lib: IMPORT_LIB; |
1080 | lib: IMPORT_LIB; |
Line 1160... | Line 1134... | ||
1160 | cmd: COMMAND; |
1134 | cmd: COMMAND; |
1161 | i: INTEGER; |
1135 | i: INTEGER; |
Line 1162... | Line 1136... | ||
1162 | 1136 | ||
1163 | BEGIN |
1137 | BEGIN |
1164 | commands := C.create(); |
- | |
Line 1165... | Line 1138... | ||
1165 | variables := C.create(); |
1138 | commands := C.create(); |
Line 1166... | Line 1139... | ||
1166 | 1139 | ||
1167 | CPU := pCPU; |
1140 | CPU := pCPU; |