1 (* ============================================================ *)
2 (* ClassUtil is the module which writes java classs file *)
3 (* structures *)
4 (* Copyright (c) John Gough 1999, 2000. *)
5 (* Modified DWC September, 2000. *)
6 (* ============================================================ *)
10 IMPORT
11 GPCPcopyright,
12 RTS,
13 Console,
16 FileNames,
17 GPFiles,
26 (* ============================================================ *)
28 CONST
34 (* ============================================================ *)
35 (* ============================================================ *)
36 (* Java Class File Format *)
37 (* *)
38 (* Classfile { u4 magic; *)
39 (* u2 minor_version; *)
40 (* u2 major_version; *)
41 (* u2 constant_pool_count; *)
42 (* cp_info constant_pool[constant_pool_count]; *)
43 (* u2 access_flags; *)
44 (* u2 this_class; *)
45 (* u2 super_class; *)
46 (* u2 interfaces_count; *)
47 (* u2 interfaces[interfaces_count]; *)
48 (* u2 fields_count; *)
49 (* field_info fields[field_count]; *)
50 (* u2 methods_count; *)
51 (* method_info methods[method_count]; *)
52 (* u2 attributes_count; *)
53 (* attribute_info attributes[attribute_count]; *)
54 (* } *)
55 (* *)
56 (* ============================================================ *)
58 CONST
59 (* magic = -889275714; (* 0xCAFEBABE *) *)
65 (* ============================================================ *)
226 (* ============================================================ *)
230 (* ============================================================ *)
232 VAR
266 VAR
277 (* ============================================================ *)
284 (* ============================================================ *)
285 (* Constant Pool Stuff *)
286 (* ============================================================ *)
289 VAR
292 BEGIN
304 ELSE
311 VAR
314 BEGIN
326 VAR
329 BEGIN
343 VAR
346 BEGIN
361 VAR
364 BEGIN
378 VAR
381 BEGIN
395 VAR
398 BEGIN
405 ELSE
412 VAR
415 BEGIN
432 VAR
435 BEGIN
453 VAR
456 BEGIN
474 VAR
477 BEGIN
494 VAR
497 BEGIN
510 VAR
513 BEGIN
526 VAR
529 BEGIN
542 VAR
545 BEGIN
557 (* ============================================================ *)
558 (* Constructor Method *)
559 (* ============================================================ *)
564 (* ------------------------------------------------- *)
567 BEGIN
572 (* ------------------------------------------------- *)
576 BEGIN
580 ps := BOX(ps^ + genSep + fn);
581 ELSE
582 ps := BOX(ps^ + fn);
583 END;
584 RETURN ps;
585 END GetFullPath;
586 (* ------------------------------------------------- *)
587 BEGIN
589 ptr := GetFullPath(fileName);
590 ELSE
591 ptr := BOX(fileName$);
592 END;
593 Warp(ptr);
594 (*
596 *
597 * srcFileName := L.strToCharOpen(CSt.srcNam);
598 * NEW(f);
599 *
600 * f.file := F.createPath(fileName);
601 *)
602 srcFileName := BOX(CSt.srcNam$);
603 NEW(fil);
604 fil.file := F.createPath(ptr);
606 IF fil.file = NIL THEN RETURN NIL; END;
607 (*
609 * Console.WriteString(ptr);
610 * Console.WriteLn;
611 *)
612 fil.access := 0;
613 NEW(fil.cp.pool,initSize);
614 fil.cp.tide := 1;
615 fil.thisClassIx := 0;
616 fil.superClassIx := 0;
617 fil.numInterfaces := 0;
618 fil.numFields := 0;
619 fil.numMethods := 0;
620 fil.srcFileIx := AddUTF(fil.cp,srcFileName);
621 fil.srcFileAttIx := AddUTF(fil.cp,srcFileStr);
622 fil.codeAttIx := AddUTF(fil.cp,codeStr);
623 fil.exceptAttIx := 0;
624 fil.lineNumTabIx := 0;
625 fil.jlExceptIx := 0;
626 RETURN fil;
627 END newClassFile;
629 PROCEDURE (cf : ClassFile) StartModClass*(mod : Id.BlkId);
630 BEGIN
631 cf.access := Jvm.acc_public + Jvm.acc_final + Jvm.acc_super;
632 cf.thisClassIx := AddModClassRef(cf.cp,mod);
633 cf.superClassIx := AddClassRef(cf.cp,object);
634 END StartModClass;
636 PROCEDURE^ (cf : ClassFile) AddInterface*(interface : Ty.Record),NEW;
638 PROCEDURE (cf : ClassFile)StartRecClass*(rec : Ty.Record);
639 VAR
640 clsId : D.Idnt;
641 impRec : D.Type;
642 recAcc : INTEGER;
643 index : INTEGER;
644 BEGIN
645 recAcc := Jvm.acc_super;
646 IF rec.recAtt = Ty.noAtt THEN
647 recAcc := recAcc + Jvm.acc_final;
648 ELSIF rec.recAtt = Ty.isAbs THEN
649 recAcc := recAcc + Jvm.acc_abstract;
650 END;
651 IF rec.bindTp = NIL THEN
652 clsId := rec.idnt;
653 ELSE
654 clsId := rec.bindTp.idnt;
655 END;
656 IF clsId # NIL THEN
657 IF clsId.vMod = D.pubMode THEN
658 recAcc := recAcc + Jvm.acc_public;
659 ELSIF clsId.vMod = D.prvMode THEN
660 recAcc := recAcc + Jvm.acc_package;
661 END;
662 END;
663 cf.access := recAcc;
664 cf.thisClassIx := AddRecClassRef(cf.cp,rec);
665 IF rec.baseTp IS Ty.Record THEN
666 IF rec.baseTp.xName = NIL THEN J.MkRecName(rec.baseTp(Ty.Record)); END;
667 cf.superClassIx := AddClassRef(cf.cp,rec.baseTp.xName);
668 ELSE
669 cf.superClassIx := AddClassRef(cf.cp,object);
670 END;
671 (*
672 * Emit interface declarations (if any)
673 *)
674 IF rec.interfaces.tide > 0 THEN
675 FOR index := 0 TO rec.interfaces.tide-1 DO
676 impRec := rec.interfaces.a[index];
677 cf.AddInterface(impRec.boundRecTp()(Ty.Record));
678 END;
679 END;
680 END StartRecClass;
682 (* ============================================================ *)
683 (* Java Class File Stuff *)
684 (* ============================================================ *)
686 PROCEDURE (cf : ClassFile) InitFields*(numFields : INTEGER);
687 BEGIN
688 NEW(cf.fields,numFields);
689 END InitFields;
691 PROCEDURE (cf : ClassFile) AddField*(field : FieldInfo),NEW;
692 CONST
693 incSize = 10;
694 VAR
695 tmp : POINTER TO ARRAY OF FieldInfo;
696 i : INTEGER;
697 BEGIN
698 IF cf.fields = NIL THEN
699 NEW(cf.fields,incSize);
700 ELSIF cf.numFields >= LEN(cf.fields) THEN
701 tmp := cf.fields;
702 NEW(cf.fields,cf.numFields+incSize);
703 FOR i := 0 TO cf.numFields-1 DO
704 cf.fields[i] := tmp[i];
705 END;
706 END;
707 cf.fields[cf.numFields] := field;
708 INC(cf.numFields);
709 END AddField;
711 PROCEDURE (cf : ClassFile) InitMethods*(numMethods : INTEGER);
712 BEGIN
713 NEW(cf.methods,numMethods);
714 END InitMethods;
716 PROCEDURE (cf : ClassFile)AddMethod*(method : MethodInfo),NEW;
717 CONST
718 incSize = 10;
719 VAR
720 tmp : POINTER TO ARRAY OF MethodInfo;
721 i : INTEGER;
722 BEGIN
723 IF cf.methods = NIL THEN
724 NEW(cf.methods,incSize);
725 ELSIF cf.numMethods >= LEN(cf.methods) THEN
726 tmp := cf.methods;
727 NEW(cf.methods,cf.numMethods+incSize);
728 FOR i := 0 TO cf.numMethods-1 DO
729 cf.methods[i] := tmp[i];
730 END;
731 END;
732 cf.methods[cf.numMethods] := method;
733 INC(cf.numMethods);
734 END AddMethod;
736 PROCEDURE (cf : ClassFile) InitInterfaces*(numInterfaces : INTEGER),NEW;
737 BEGIN
738 NEW(cf.interfaces,numInterfaces);
739 END InitInterfaces;
741 PROCEDURE (cf : ClassFile) AddInterface*(interface : Ty.Record),NEW;
742 CONST
743 incSize = 10;
744 VAR
745 tmp : POINTER TO ARRAY OF INTEGER;
746 i, intIx : INTEGER;
747 BEGIN
748 IF cf.interfaces = NIL THEN
749 NEW(cf.interfaces,incSize);
750 ELSIF cf.numInterfaces >= LEN(cf.interfaces) THEN
751 tmp := cf.interfaces;
752 NEW(cf.interfaces,cf.numInterfaces+incSize);
753 FOR i := 0 TO cf.numInterfaces-1 DO
754 cf.interfaces[i] := tmp[i];
755 END;
756 END;
757 IF interface.xName = NIL THEN J.MkRecName(interface); END;
758 intIx := AddRecClassRef(cf.cp,interface);
759 cf.interfaces[cf.numInterfaces] := intIx;
760 INC(cf.numInterfaces);
761 END AddInterface;
763 (* ============================================================ *)
764 (* FieldInfo Methods *)
765 (* ============================================================ *)
767 PROCEDURE (cf : ClassFile) EmitField*(field : Id.AbVar);
768 VAR
769 f : FieldInfo;
770 BEGIN
771 NEW(f);
772 CASE field.vMod OF
773 | D.prvMode : f.access := Jvm.acc_package;
774 | D.pubMode : f.access := Jvm.acc_public;
775 | D.rdoMode : f.access := Jvm.acc_public;
776 | D.protect : f.access := Jvm.acc_protected;
777 END;
778 WITH field : Id.VarId DO
779 f.access := f.access + Jvm.acc_static;
780 IF field.varNm = NIL THEN J.MkVarName(field(Id.VarId)); END;
781 f.nameIx := AddUTF(cf.cp,field.varNm);
782 | field : Id.FldId DO
783 f.nameIx := AddUTF(cf.cp,D.getName.ChPtr(field));
784 END;
785 f.descIx := AddUTF(cf.cp, GetTypeName(field.type));
786 f.constValIx := -1; (* constants not currently stored in class file *)
787 cf.AddField(f);
788 END EmitField;
790 (* ============================================================ *)
791 (* MethodInfo Methods *)
792 (* ============================================================ *)
794 PROCEDURE newMethodInfo*(meth : Id.Procs) : MethodInfo;
795 VAR m : MethodInfo;
796 BEGIN
797 NEW(m);
798 m.methId := meth;
799 IF meth = NIL THEN
800 m.localNum := 0;
801 m.maxLocals := 1;
802 ELSE (* Id.BlkId *)
803 m.localNum := meth.rtsFram;
804 m.maxLocals := MAX(meth.rtsFram, 1);
805 END;
806 m.currStack := 0;
807 m.maxStack := 0;
808 NEW(m.codes.code,initSize);
809 m.codes.tide := 0;
810 m.codes.codeLen := 0;
811 m.lineNumTab.tide := 0;
812 RETURN m;
813 END newMethodInfo;
815 (* ------------------------------------------------------------ *)
817 PROCEDURE (cf : ClassFile)StartProc*(proc : Id.Procs);
818 VAR
819 attr : INTEGER;
820 method : Id.MthId;
821 BEGIN
822 cf.meth := newMethodInfo(proc);
823 cf.AddMethod(cf.meth);
824 (*
825 * Compute the method attributes
826 *)
827 IF proc.kind = Id.conMth THEN
828 method := proc(Id.MthId);
829 attr := 0;
830 IF method.mthAtt * Id.mask = {} THEN attr := Jvm.acc_final; END;
831 IF method.mthAtt * Id.mask = Id.isAbs THEN
832 attr := attr + Jvm.acc_abstract;
833 END;
834 IF Id.widen IN method.mthAtt THEN attr := attr + Jvm.acc_public END;
835 ELSE
836 attr := Jvm.acc_static;
837 END;
838 (*
841 * slot! We must thus live with the insecurity of public mode.
842 *
843 * IF proc.vMod = D.pubMode THEN (* explicitly public *)
844 *)
845 IF (proc.vMod = D.pubMode) OR (* explicitly public *)
847 attr := attr + Jvm.acc_public;
848 ELSIF proc.dfScp IS Id.PrcId THEN (* nested procedure *)
849 attr := attr + Jvm.acc_private;
850 END;
851 cf.meth.access := attr;
852 IF (cf.meth.access >= Jvm.acc_abstract) THEN
853 cf.meth.maxLocals := 0;
854 END;
855 cf.meth.nameIx := AddUTF(cf.cp,proc.prcNm);
856 cf.meth.descIx := AddUTF(cf.cp,proc.type.xName);
857 END StartProc;
859 PROCEDURE (cf : ClassFile)isAbstract*() : BOOLEAN;
860 BEGIN
861 RETURN (cf.meth.access >= Jvm.acc_abstract);
862 END isAbstract;
864 (* ------------------------------------------------------------ *)
866 PROCEDURE (cf : ClassFile)getScope*() : D.Scope;
867 BEGIN
868 RETURN cf.meth.methId;
869 END getScope;
871 (* ------------------------------------------------------------ *)
873 PROCEDURE (cf : ClassFile)newLocal*() : INTEGER;
874 VAR ord : INTEGER;
875 BEGIN
876 ord := cf.meth.localNum;
877 INC(cf.meth.localNum);
878 IF cf.meth.localNum > cf.meth.maxLocals THEN
879 cf.meth.maxLocals := cf.meth.localNum;
880 END;
881 RETURN ord;
882 END newLocal;
884 (* ------------------------------------------------------------ *)
886 PROCEDURE (cf : ClassFile)ReleaseLocal*(i : INTEGER);
887 BEGIN
888 (*
889 * If you try to release not in LIFO order, the
890 * location will not be made free again. This is safe!
891 *)
892 IF i+1 = cf.meth.localNum THEN DEC(cf.meth.localNum) END;
893 END ReleaseLocal;
895 (* ------------------------------------------------------------ *)
897 PROCEDURE (cf : ClassFile)markTop*() : INTEGER;
898 BEGIN
899 RETURN cf.meth.localNum;
900 END markTop;
902 (* ------------------------------------------------------------ *)
904 PROCEDURE (cf : ClassFile)ReleaseAll*(m : INTEGER);
905 BEGIN
906 cf.meth.localNum := m;
907 END ReleaseAll;
909 (* ------------------------------------------------------------ *)
911 PROCEDURE (cf : ClassFile)getDepth*() : INTEGER;
912 BEGIN RETURN cf.meth.currStack END getDepth;
914 (* ------------------------------------------ *)
916 PROCEDURE (cf : ClassFile)setDepth*(i : INTEGER);
917 BEGIN cf.meth.currStack := i END setDepth;
920 (* ============================================================ *)
921 (* Init Methods *)
922 (* ============================================================ *)
924 PROCEDURE (cf : ClassFile)ClinitHead*();
925 VAR
926 meth : MethodInfo;
927 returned : BOOLEAN;
928 BEGIN
929 meth := newMethodInfo(NIL);
930 cf.AddMethod(meth);
931 meth.access := pubStat;
932 meth.nameIx := AddUTF(cf.cp,clinit);
933 meth.descIx := AddUTF(cf.cp,noArgVoid);
934 cf.meth := meth;
935 END ClinitHead;
937 (* ============================================================ *)
939 PROCEDURE (cf : ClassFile)VoidTail*();
940 BEGIN
941 cf.Code(Jvm.opc_return);
942 END VoidTail;
944 (* ============================================================ *)
946 PROCEDURE^ (cf : ClassFile)CallS*(code : INTEGER;
947 IN className : L.CharOpen;
948 IN procName : L.CharOpen;
949 IN signature : L.CharOpen;
950 argL,retL : INTEGER),NEW;
952 (* ============================================================ *)
954 PROCEDURE (cf : ClassFile)MainHead*();
955 VAR
956 meth : MethodInfo;
957 returned : BOOLEAN;
958 BEGIN
959 meth := newMethodInfo(NIL);
960 cf.AddMethod(meth);
961 meth.access := pubStat;
962 meth.nameIx := AddUTF(cf.cp,main);
963 meth.descIx := AddUTF(cf.cp,mainSig);
964 cf.meth := meth;
965 (*
966 * Save the command-line arguments to the RTS.
967 *)
968 cf.Code(Jvm.opc_aload_0);
969 cf.CallS(Jvm.opc_invokestatic,CPmainClass,putArgs,mainSig,1,0);
970 END MainHead;
972 (* ============================================================ *)
974 PROCEDURE (cf : ClassFile)ModNoArgInit*();
975 VAR
976 meth : MethodInfo;
977 BEGIN
978 meth := newMethodInfo(NIL);
979 cf.AddMethod(meth);
980 meth.access := Jvm.acc_public;
981 meth.nameIx := AddUTF(cf.cp,init);
982 meth.descIx := AddUTF(cf.cp,noArgVoid);
983 cf.meth := meth;
984 cf.Code(Jvm.opc_aload_0);
985 cf.CallS(Jvm.opc_invokespecial,object,init,noArgVoid,1,0);
986 cf.Code(Jvm.opc_return);
987 END ModNoArgInit;
989 (* ---------------------------------------------------- *)
991 PROCEDURE (cf : ClassFile)RecMakeInit*(rec : Ty.Record;
992 prc : Id.PrcId);
993 VAR meth : MethodInfo;
994 pTp : Ty.Procedure;
995 signature : L.CharOpen;
996 BEGIN
997 IF (prc = NIL) &
998 ((D.noNew IN rec.xAttr) OR (D.xCtor IN rec.xAttr)) THEN
999 RETURN; (* PREMATURE RETURN HERE *)
1000 END;
1001 meth := newMethodInfo(prc);
1002 cf.AddMethod(meth);
1003 cf.meth := meth;
1004 cf.Code(Jvm.opc_aload_0);
1005 meth.access := Jvm.acc_public;
1006 meth.nameIx := AddUTF(cf.cp,init);
1007 (*
1008 * Get the procedure type, if any.
1009 *)
1010 IF prc # NIL THEN
1011 pTp := prc.type(Ty.Procedure);
1012 J.MkCallAttr(prc, pTp);
1013 signature := pTp.xName;
1014 ELSE
1015 pTp := NIL;
1016 signature := noArgVoid;
1017 END;
1018 meth.descIx := AddUTF(cf.cp,signature);
1019 END RecMakeInit;
1021 (*
1022 * IF pTp # NIL THEN
1023 * (*
1024 * * Copy the args to the super-constructor
1025 * *)
1026 * FOR idx := 0 TO pNm-1 DO cf.GetLocal(pTp.formals.a[idx]) END;
1027 * END;
1028 *)
1030 PROCEDURE (cf : ClassFile)CallSuperCtor*(rec : Ty.Record;
1031 pTy : Ty.Procedure);
1032 VAR idx : INTEGER;
1033 fld : D.Idnt;
1034 pNm : INTEGER;
1035 initClass : L.CharOpen;
1036 signature : L.CharOpen;
1037 BEGIN
1038 IF pTy # NIL THEN
1039 pNm := pTy.formals.tide;
1040 signature := pTy.xName;
1041 ELSE
1042 pNm := 0; (* was 1 *)
1043 signature := noArgVoid;
1044 END;
1045 (*
1046 * Initialize the embedded superclass object.
1047 *)
1048 IF (rec.baseTp # NIL) & (rec.baseTp # G.anyRec) THEN
1049 initClass := rec.baseTp(Ty.Record).xName;
1050 ELSE
1051 initClass := object;
1052 END;
1053 cf.CallS(Jvm.opc_invokespecial, initClass, init, signature, pNm+1, 0);
1054 (*
1055 * Initialize fields, as necessary.
1056 *)
1057 FOR idx := 0 TO rec.fields.tide-1 DO
1058 fld := rec.fields.a[idx];
1059 IF (fld.type IS Ty.Record) OR (fld.type IS Ty.Array) THEN
1060 cf.Code(Jvm.opc_aload_0);
1061 cf.VarInit(fld);
1062 cf.PutGetF(Jvm.opc_putfield, rec, fld(Id.FldId));
1063 END;
1064 END;
1065 (*
1066 * cf.Code(Jvm.opc_return);
1067 *)
1068 END CallSuperCtor;
1070 (* ============================================================ *)
1072 PROCEDURE makeClassVoidArgList(rec : Ty.Record) : L.CharOpen;
1073 BEGIN
1074 IF rec.xName = NIL THEN J.MkRecName(rec); END;
1075 RETURN J.cat3(J.lPar,rec.scopeNm,J.rParV);
1076 END makeClassVoidArgList;
1078 (* ---------------------------------------------------- *)
1080 PROCEDURE (cf : ClassFile)CopyProcHead*(rec : Ty.Record);
1081 VAR
1082 meth : MethodInfo;
1083 BEGIN
1084 meth := newMethodInfo(NIL);
1085 cf.AddMethod(meth);
1086 meth.access := Jvm.acc_public;
1087 meth.nameIx := AddUTF(cf.cp,copy);
1088 meth.descIx := AddUTF(cf.cp,makeClassVoidArgList(rec));
1089 cf.meth := meth;
1090 END CopyProcHead;
1092 (* ============================================================ *)
1093 (* Private Methods *)
1094 (* ============================================================ *)
1096 PROCEDURE (meth : MethodInfo)FixStack(code : INTEGER),NEW;
1097 BEGIN
1098 INC(meth.currStack, Jvm.dl[code]);
1099 IF meth.currStack > meth.maxStack THEN meth.maxStack := meth.currStack END;
1100 END FixStack;
1102 (* ============================================================ *)
1104 PROCEDURE GetTypeName*(typ : D.Type) : L.CharOpen;
1105 VAR
1106 arrayName : L.CharOpenSeq;
1107 arrayTy : D.Type;
1108 BEGIN
1109 WITH typ : Ty.Base DO
1110 RETURN typ.xName;
1111 | typ : Ty.Vector DO
1112 IF typ.xName = NIL THEN J.MkVecName(typ) END;
1113 RETURN typ.xName;
1114 | typ : Ty.Procedure DO
1115 IF typ.xName = NIL THEN J.MkProcTypeName(typ) END;
1116 RETURN typ.hostClass.scopeNm;
1117 | typ : Ty.Array DO
1118 IF typ.xName = NIL THEN
1119 L.InitCharOpenSeq(arrayName,3);
1120 arrayTy := typ;
1121 WHILE arrayTy IS Ty.Array DO
1122 L.AppendCharOpen(arrayName,J.brac);
1123 arrayTy := arrayTy(Ty.Array).elemTp;
1124 END;
1125 L.AppendCharOpen(arrayName,GetTypeName(arrayTy));
1126 typ.xName := L.arrayCat(arrayName);
1127 END;
1128 ASSERT(typ.xName # NIL);
1129 RETURN typ.xName;
1130 | typ : Ty.Record DO
1131 IF typ.xName = NIL THEN J.MkRecName(typ) END;
1132 RETURN typ.scopeNm;
1133 | typ : Ty.Enum DO
1134 RETURN G.intTp.xName;
1135 | typ : Ty.Pointer DO
1136 RETURN GetTypeName(typ.boundTp);
1137 | typ : Ty.Opaque DO
1138 IF typ.xName = NIL THEN J.MkAliasName(typ) END;
1139 RETURN typ.scopeNm;
1140 END;
1141 END GetTypeName;
1143 (* ============================================================ *)
1144 (* Exported Methods *)
1145 (* ============================================================ *)
1147 PROCEDURE (cf : ClassFile)newLabel*() : J.Label;
1148 VAR
1149 lab : J.Label;
1150 BEGIN
1151 NEW(lab);
1152 lab.defIx := 0;
1153 RETURN lab;
1154 END newLabel;
1156 (* ============================================================ *)
1158 PROCEDURE (cf : ClassFile)getLabelRange*(VAR labs : ARRAY OF J.Label);
1159 VAR
1160 i : INTEGER;
1161 BEGIN
1162 FOR i := 0 TO LEN(labs)-1 DO
1163 NEW(labs[i]);
1164 labs[i].defIx := 0;
1165 END;
1166 END getLabelRange;
1168 (* ============================================================ *)
1170 PROCEDURE (VAR lst : CodeList)AddInstruction(op : Op),NEW;
1171 VAR
1172 tmp : POINTER TO ARRAY OF Op;
1173 i : INTEGER;
1174 BEGIN
1175 ASSERT(lst.code # NIL);
1176 IF lst.tide >= LEN(lst.code) THEN
1177 tmp := lst.code;
1178 NEW(lst.code,2 * lst.tide);
1179 FOR i := 0 TO lst.tide-1 DO
1180 lst.code[i] := tmp[i];
1181 END;
1182 END;
1183 lst.code[lst.tide] := op;
1184 INC(lst.tide);
1185 END AddInstruction;
1187 (* -------------------------------------------- *)
1189 PROCEDURE (cf : ClassFile)DefLab*(lab : J.Label);
1190 BEGIN
1191 ASSERT(lab.defIx = 0);
1192 lab.defIx := cf.meth.codes.codeLen;
1193 END DefLab;
1195 PROCEDURE (cf : ClassFile)DefLabC*(lab : J.Label; IN c : ARRAY OF CHAR);
1196 BEGIN
1197 ASSERT(lab.defIx = 0);
1198 lab.defIx := cf.meth.codes.codeLen;
1199 END DefLabC;
1201 (* -------------------------------------------- *)
1203 PROCEDURE (cf : ClassFile)AddSwitchLab*(lab : J.Label; pos : INTEGER);
1204 VAR
1205 sw : OpSwitch;
1206 BEGIN
1207 sw := cf.meth.codes.code[cf.meth.codes.tide-1](OpSwitch);
1208 sw.offs[pos] := lab;
1209 END AddSwitchLab;
1211 (* -------------------------------------------- *)
1213 PROCEDURE (cf : ClassFile)CodeLb*(code : INTEGER; lab : J.Label);
1214 VAR
1215 tmp : POINTER TO ARRAY OF INTEGER;
1216 i : INTEGER;
1217 op : OpL;
1218 BEGIN
1219 NEW(op);
1220 op.offset := cf.meth.codes.codeLen;
1221 op.op := code;
1222 op.lab := lab;
1223 INC(cf.meth.codes.codeLen,3);
1224 cf.meth.codes.AddInstruction(op);
1225 cf.meth.FixStack(code);
1226 END CodeLb;
1228 (* -------------------------------------------- *)
1230 PROCEDURE (cf : ClassFile)Code*(code : INTEGER);
1231 VAR
1232 op : Op;
1233 BEGIN
1234 NEW(op);
1235 op.offset := cf.meth.codes.codeLen;
1236 op.op := code;
1237 INC(cf.meth.codes.codeLen);
1238 cf.meth.codes.AddInstruction(op);
1239 cf.meth.FixStack(code);
1240 END Code;
1242 (* -------------------------------------------- *)
1244 PROCEDURE (cf : ClassFile)CodeI*(code,val : INTEGER);
1245 VAR
1246 op : OpI;
1247 BEGIN
1248 NEW(op);
1249 op.offset := cf.meth.codes.codeLen;
1250 op.op := code;
1251 op.val := val;
1252 IF (val > maxUnsignedByte) &
1253 (((code >= Jvm.opc_iload) & (code <= Jvm.opc_aload)) OR
1254 ((code >= Jvm.opc_istore) & (code <= Jvm.opc_astore))) THEN
1255 cf.Code(Jvm.opc_wide);
1256 op.numBytes := 2;
1257 INC(cf.meth.codes.codeLen,3);
1258 ELSE
1259 op.numBytes := 1;
1260 INC(cf.meth.codes.codeLen,2);
1261 END;
1262 cf.meth.codes.AddInstruction(op);
1263 cf.meth.FixStack(code);
1264 END CodeI;
1266 (* -------------------------------------------- *)
1268 PROCEDURE (cf : ClassFile)Code2I*(code,val : INTEGER; updateS : BOOLEAN),NEW;
1269 VAR
1270 op : OpI;
1271 BEGIN
1272 NEW(op);
1273 op.offset := cf.meth.codes.codeLen;
1274 op.op := code;
1275 op.val := val;
1276 op.numBytes := 2;
1277 INC(cf.meth.codes.codeLen,3);
1278 cf.meth.codes.AddInstruction(op);
1279 IF updateS THEN cf.meth.FixStack(code); END;
1280 END Code2I;
1282 (* -------------------------------------------- *)
1284 PROCEDURE (cf : ClassFile)Code4I*(code,val : INTEGER),NEW;
1285 VAR
1286 op : OpI;
1287 BEGIN
1288 NEW(op);
1289 op.offset := cf.meth.codes.codeLen;
1290 op.op := code;
1291 op.val := val;
1292 op.numBytes := 4;
1293 INC(cf.meth.codes.codeLen,5);
1294 cf.meth.codes.AddInstruction(op);
1295 cf.meth.FixStack(code);
1296 END Code4I;
1298 (* -------------------------------------------- *)
1300 PROCEDURE (cf : ClassFile)Code2IB*(code,val,bVal : INTEGER;
1301 endZero : BOOLEAN; updateS : BOOLEAN),NEW;
1302 VAR
1303 op : Op2IB;
1304 instSize : INTEGER;
1305 BEGIN
1306 NEW(op);
1307 op.offset := cf.meth.codes.codeLen;
1308 op.op := code;
1309 op.val := val;
1310 op.bVal := bVal;
1311 op.trailingZero := endZero;
1312 IF endZero THEN INC(cf.meth.codes.codeLen,5);
1313 ELSE INC(cf.meth.codes.codeLen,4); END;
1314 cf.meth.codes.AddInstruction(op);
1315 IF updateS THEN cf.meth.FixStack(code); END;
1316 END Code2IB;
1318 (* -------------------------------------------- *)
1320 PROCEDURE (cf : ClassFile)CodeL*(code : INTEGER; num : LONGINT);
1321 VAR
1322 conIx : INTEGER;
1323 BEGIN
1324 conIx := AddConstLong(cf.cp,num);
1325 cf.Code2I(Jvm.opc_ldc2_w, conIx, TRUE);
1326 END CodeL;
1328 PROCEDURE (cf : ClassFile)CodeR*(code : INTEGER; num : REAL; short : BOOLEAN);
1329 VAR
1330 conIx : INTEGER;
1331 BEGIN
1332 IF short THEN
1333 conIx := AddConstFloat(cf.cp,SHORT(num));
1334 IF conIx > maxUnsignedByte THEN
1335 cf.Code2I(Jvm.opc_ldc_w, conIx, TRUE);
1336 ELSE
1337 cf.CodeI(Jvm.opc_ldc, conIx);
1338 END;
1339 ELSE
1340 conIx := AddConstDouble(cf.cp,num);
1341 cf.Code2I(Jvm.opc_ldc2_w, conIx, TRUE);
1342 END;
1343 END CodeR;
1345 (* -------------------------------------------- *)
1347 PROCEDURE (cf : ClassFile)CodeInc*(localIx,incVal : INTEGER);
1348 VAR
1349 op : OpII;
1350 needWide : BOOLEAN;
1351 BEGIN
1352 needWide := (localIx > maxUnsignedByte) OR (incVal < MIN(BYTE)) OR
1353 (incVal > MAX(BYTE));
1354 IF needWide THEN cf.Code(Jvm.opc_wide); END;
1355 NEW(op);
1356 op.offset := cf.meth.codes.codeLen;
1357 op.op := Jvm.opc_iinc;
1358 op.val1 := localIx;
1359 op.val2 := incVal;
1360 IF needWide THEN
1361 op.numBytes := 2;
1362 INC(cf.meth.codes.codeLen,5);
1363 ELSE
1364 op.numBytes := 1;
1365 INC(cf.meth.codes.codeLen,3);
1366 END;
1367 cf.meth.codes.AddInstruction(op);
1368 END CodeInc;
1370 (* -------------------------------------------- *)
1372 PROCEDURE (cf : ClassFile)CodeSwitch*(low,high : INTEGER; defLab : J.Label);
1373 VAR
1374 sw : OpSwitch;
1375 len : INTEGER;
1376 BEGIN
1377 NEW(sw);
1378 sw.offset := cf.meth.codes.codeLen;
1379 sw.op := Jvm.opc_tableswitch;
1380 sw.defLabel := defLab;
1381 sw.low := low;
1382 sw.high := high;
1383 len := high-low+1;
1384 NEW(sw.offs,len);
1385 sw.padding := 3 - (sw.offset MOD 4);
1386 INC(cf.meth.codes.codeLen,13+sw.padding+4*len);
1387 cf.meth.codes.AddInstruction(sw);
1388 cf.meth.FixStack(Jvm.opc_tableswitch);
1389 END CodeSwitch;
1391 (* -------------------------------------------- *)
1393 PROCEDURE (cf : ClassFile)CodeT*(code : INTEGER; ty : D.Type);
1394 VAR
1395 op : OpI;
1396 BEGIN
1397 IF ty IS Ty.Pointer THEN ty := ty(Ty.Pointer).boundTp; END;
1398 NEW(op);
1399 op.offset := cf.meth.codes.codeLen;
1400 op.op := code;
1401 (*
1402 * // old code ...
1403 * op.val := AddRecClassRef(cf.cp,ty(Ty.Record));
1404 * // now new code ...
1405 *)
1406 IF ty IS Ty.Record THEN
1407 op.val := AddRecClassRef(cf.cp, ty(Ty.Record));
1408 ELSE
1409 op.val := AddClassRef(cf.cp, GetTypeName(ty));
1410 END;
1412 op.numBytes := 2;
1413 INC(cf.meth.codes.codeLen,3);
1414 cf.meth.codes.AddInstruction(op);
1415 cf.meth.FixStack(code);
1416 END CodeT;
1418 (* -------------------------------------------- *)
1420 PROCEDURE (cf : ClassFile)CodeC*(code : INTEGER; IN str : ARRAY OF CHAR);
1421 VAR
1422 op : Op;
1423 BEGIN
1424 NEW(op);
1425 op.offset := cf.meth.codes.codeLen;
1426 op.op := code;
1427 INC(cf.meth.codes.codeLen);
1428 cf.meth.codes.AddInstruction(op);
1429 cf.meth.FixStack(code);
1430 END CodeC;
1432 (* -------------------------------------------- *)
1433 PROCEDURE (cf : ClassFile)PushStr*(IN str : L.CharOpen);
1434 (* Use target quoting conventions for the literal string *)
1435 VAR
1436 strIx : INTEGER;
1437 BEGIN
1438 strIx := AddStringRef(cf.cp,str);
1439 IF strIx > maxUnsignedByte THEN
1440 cf.Code2I(Jvm.opc_ldc_w, strIx, TRUE);
1441 ELSE
1442 cf.CodeI(Jvm.opc_ldc, strIx);
1443 END;
1444 END PushStr;
1446 (* ============================================================ *)
1448 PROCEDURE (cf : ClassFile)CallS*(code : INTEGER;
1449 IN className : L.CharOpen;
1450 IN procName : L.CharOpen;
1451 IN signature : L.CharOpen;
1452 argL,retL : INTEGER),NEW;
1453 VAR
1454 cIx,mIx : INTEGER;
1455 BEGIN
1456 ASSERT(code # Jvm.opc_invokeinterface);
1457 cIx := AddClassRef(cf.cp,className);
1458 mIx := AddMethodRef(cf.cp,cIx,procName,signature);
1459 cf.Code2I(code,mIx,FALSE);
1460 INC(cf.meth.currStack, retL-argL);
1461 IF cf.meth.currStack > cf.meth.maxStack THEN
1462 cf.meth.maxStack := cf.meth.currStack;
1463 END;
1464 END CallS;
1466 (* ============================================================ *)
1468 PROCEDURE (cf : ClassFile)CallIT*(code : INTEGER;
1469 proc : Id.Procs;
1470 type : Ty.Procedure);
1471 VAR cIx,mIx : INTEGER;
1472 scp : D.Scope;
1473 BEGIN
1474 IF proc.scopeNm = NIL THEN J.MkProcName(proc) END;
1475 WITH proc : Id.PrcId DO
1476 cIx := AddClassRef(cf.cp,proc.clsNm);
1477 | proc : Id.MthId DO
1478 cIx := AddRecClassRef(cf.cp,proc.bndType(Ty.Record));
1479 END;
1480 IF code = Jvm.opc_invokeinterface THEN
1481 mIx := AddInterfaceMethodRef(cf.cp,cIx,proc.prcNm,proc.type.xName);
1482 cf.Code2IB(code,mIx,type.argN,TRUE,FALSE);
1483 ELSE
1484 mIx := AddMethodRef(cf.cp,cIx,proc.prcNm,proc.type.xName);
1485 cf.Code2I(code,mIx,FALSE);
1486 END;
1487 INC(cf.meth.currStack, type.retN-type.argN);
1488 IF cf.meth.currStack > cf.meth.maxStack THEN
1489 cf.meth.maxStack := cf.meth.currStack;
1490 END;
1491 END CallIT;
1493 (* ============================================================ *)
1495 PROCEDURE (cf : ClassFile)MultiNew*(arrName : L.CharOpen;
1496 dms : INTEGER),NEW;
1497 (* dsc is the array descriptor, dms the number of dimensions *)
1498 VAR
1499 classIx : INTEGER;
1500 BEGIN
1501 classIx := AddClassRef(cf.cp,arrName);
1502 cf.Code2IB(Jvm.opc_multianewarray,classIx,dms,FALSE,TRUE);
1503 DEC(cf.meth.currStack, dms-1);
1504 END MultiNew;
1506 (* ============================================================ *)
1508 PROCEDURE (cf : ClassFile)PutGetS*(code : INTEGER;
1509 blk : Id.BlkId;
1510 fld : Id.VarId);
1511 VAR size : INTEGER;
1512 classIx : INTEGER;
1513 fieldIx : INTEGER;
1514 op : OpI;
1515 (* Emit putstatic and getstatic for static field *)
1516 BEGIN
1517 IF blk.xName = NIL THEN J.MkBlkName(blk) END;
1518 IF fld.varNm = NIL THEN J.MkVarName(fld) END;
1519 IF fld.recTyp = NIL THEN
1520 classIx := AddModClassRef(cf.cp,blk);
1521 ELSE
1522 classIx := AddRecClassRef(cf.cp,fld.recTyp(Ty.Record));
1523 END;
1524 fieldIx := AddFieldRef(cf.cp,classIx,fld.varNm,GetTypeName(fld.type));
1525 NEW(op);
1526 op.offset := cf.meth.codes.codeLen;
1527 op.op := code;
1528 op.val := fieldIx;
1529 op.numBytes := 2;
1530 INC(cf.meth.codes.codeLen,3);
1531 cf.meth.codes.AddInstruction(op);
1532 size := J.jvmSize(fld.type);
1533 IF code = Jvm.opc_getstatic THEN INC(cf.meth.currStack, size);
1534 ELSIF code = Jvm.opc_putstatic THEN DEC(cf.meth.currStack, size);
1535 END;
1536 IF cf.meth.currStack > cf.meth.maxStack THEN
1537 cf.meth.maxStack := cf.meth.currStack
1538 END;
1539 END PutGetS;
1541 (* -------------------------------------------- *)
1543 PROCEDURE (cf : ClassFile)PutGetF*(code : INTEGER;
1544 rec : Ty.Record;
1545 fld : Id.AbVar);
1546 VAR size : INTEGER;
1547 classIx : INTEGER;
1548 fieldIx : INTEGER;
1549 op : OpI;
1550 (* Emit putfield and getfield for record field *)
1551 BEGIN
1552 classIx := AddRecClassRef(cf.cp,rec);
1553 fieldIx := AddFieldRef(cf.cp,classIx,D.getName.ChPtr(fld),
1554 GetTypeName(fld.type));
1555 NEW(op);
1556 op.offset := cf.meth.codes.codeLen;
1557 op.op := code;
1558 op.val := fieldIx;
1559 op.numBytes := 2;
1560 INC(cf.meth.codes.codeLen,3);
1561 cf.meth.codes.AddInstruction(op);
1562 size := J.jvmSize(fld.type);
1563 IF code = Jvm.opc_getfield THEN INC(cf.meth.currStack, size-1);
1564 ELSIF code = Jvm.opc_putfield THEN DEC(cf.meth.currStack, size+1);
1565 END;
1566 IF cf.meth.currStack > cf.meth.maxStack THEN
1567 cf.meth.maxStack := cf.meth.currStack;
1568 END;
1569 END PutGetF;
1571 (* ============================================================ *)
1573 PROCEDURE (cf : ClassFile)Alloc1d*(elTp : D.Type);
1574 VAR
1575 tName : L.CharOpen;
1576 classIx : INTEGER;
1577 BEGIN
1578 WITH elTp : Ty.Base DO
1579 IF (elTp.tpOrd < Ty.anyRec) OR (elTp.tpOrd = Ty.uBytN) THEN
1580 cf.CodeI(Jvm.opc_newarray, typeArr[elTp.tpOrd]);
1581 ELSE
1582 classIx := AddClassRef(cf.cp,object);
1583 cf.Code2I(Jvm.opc_anewarray,classIx,TRUE);
1584 END;
1585 ELSE
1586 IF elTp IS Ty.Pointer THEN elTp := elTp(Ty.Pointer).boundTp; END;
1587 IF elTp IS Ty.Record THEN
1588 classIx := AddRecClassRef(cf.cp,elTp(Ty.Record));
1589 ELSE
1590 classIx := AddClassRef(cf.cp,GetTypeName(elTp));
1591 END;
1592 cf.Code2I(Jvm.opc_anewarray,classIx,TRUE);
1593 END;
1594 END Alloc1d;
1596 (* ============================================================ *)
1598 PROCEDURE (cf : ClassFile)MkNewRecord*(typ : Ty.Record);
1599 VAR
1600 methIx,classIx : INTEGER;
1601 BEGIN
1602 classIx := AddRecClassRef(cf.cp,typ);
1603 cf.Code2I(Jvm.opc_new,classIx,TRUE);
1604 cf.Code(Jvm.opc_dup);
1605 methIx := AddMethodRef(cf.cp,classIx,init,noArgVoid);
1606 cf.Code2I(Jvm.opc_invokespecial,methIx,TRUE);
1607 END MkNewRecord;
1609 (* ============================================================ *)
1611 PROCEDURE (cf : ClassFile)MkNewFixedArray*(topE : D.Type; len0 : INTEGER);
1612 VAR dims : INTEGER;
1613 arTp : Ty.Array;
1614 elTp : D.Type;
1615 BEGIN
1616 (*
1617 // Fixed-size, possibly multi-dimensional arrays.
1618 // The code relies on the semantic property in CP
1619 // that the element-type of a fixed array type cannot
1620 // be an open array. This simplifies the code somewhat.
1621 *)
1622 cf.PushInt(len0);
1623 dims := 1;
1624 elTp := topE;
1625 (*
1626 * Find the number of dimensions ...
1627 *)
1628 LOOP
1629 WITH elTp : Ty.Array DO arTp := elTp ELSE EXIT END;
1630 elTp := arTp.elemTp;
1631 cf.PushInt(arTp.length);
1632 INC(dims);
1633 END;
1634 IF dims = 1 THEN
1635 cf.Alloc1d(elTp);
1636 (*
1637 * Stack is (top) len0, ref...
1638 *)
1639 IF elTp.kind = Ty.recTp THEN cf.Init1dArray(elTp, len0) END;
1640 ELSE
1641 (*
1642 * Allocate the array headers for all dimensions.
1643 * Stack is (top) lenN, ... len0, ref...
1644 *)
1645 cf.MultiNew(cat2(J.brac,GetTypeName(topE)), dims);
1646 (*
1647 * Stack is (top) ref...
1648 *)
1649 IF elTp.kind = Ty.recTp THEN cf.InitNdArray(topE, elTp) END;
1650 END;
1651 END MkNewFixedArray;
1653 (* ============================================================ *)
1655 PROCEDURE (cf : ClassFile)MkNewOpenArray*(arrT : Ty.Array;dims : INTEGER);
1656 VAR elTp : D.Type;
1657 indx : INTEGER;
1658 BEGIN
1659 (*
1660 * Assert: lengths are pushed already...
1661 * and we know from semantic analysis that
1662 * the number of open array dimensions match
1663 * the number of integer LENs in dims.
1664 *)
1665 elTp := arrT;
1666 (*
1667 * Find the number of dimensions ...
1668 *)
1669 FOR indx := 0 TO dims-1 DO
1670 elTp := elTp(Ty.Array).elemTp;
1671 END;
1672 (*
1673 * Allocate the array headers for all _open_ dimensions.
1674 *)
1675 IF dims = 1 THEN
1676 cf.Alloc1d(elTp);
1677 (*
1678 * Stack is now (top) ref ...
1679 * and we _might_ need to initialize the elements.
1680 *)
1681 IF (elTp.kind = Ty.recTp) OR
1682 (elTp.kind = Ty.arrTp) THEN
1683 cf.Init1dArray(elTp, 0);
1684 END;
1685 ELSE
1686 cf.MultiNew(GetTypeName(arrT), dims);
1687 (*
1688 * Stack is now (top) ref ...
1689 * Now we _might_ need to initialize the elements.
1690 *)
1691 IF (elTp.kind = Ty.recTp) OR
1692 (elTp.kind = Ty.arrTp) THEN
1693 cf.InitNdArray(arrT.elemTp, elTp);
1694 END;
1695 END;
1696 END MkNewOpenArray;
1698 (* ============================================================ *)
1700 PROCEDURE (cf : ClassFile)MkArrayCopy*(arrT : Ty.Array);
1701 VAR dims : INTEGER;
1702 elTp : D.Type;
1703 BEGIN
1704 (*
1705 * Assert: we must find the lengths from the runtime
1706 * descriptors. Find the number of dimensions. The
1707 * array to copy is on the top of stack, which reads -
1708 * (top) aRef, ...
1709 *)
1710 elTp := arrT.elemTp;
1711 IF elTp.kind # Ty.arrTp THEN
1712 cf.Code(Jvm.opc_arraylength); (* (top) len0, aRef,... *)
1713 cf.Alloc1d(elTp); (* (top) aRef, ... *)
1714 IF elTp.kind = Ty.recTp THEN cf.Init1dArray(elTp, 0) END; (*0 ==> open*)
1715 ELSE
1716 dims := 1;
1717 REPEAT
1718 (*
1719 * Invariant: an array reference is on the top of
1720 * of the stack, which reads:
1721 * (top) [arRf, lengths,] arRf ...
1722 *)
1723 INC(dims);
1724 elTp := elTp(Ty.Array).elemTp;
1725 cf.Code(Jvm.opc_dup); (* arRf, arRf,... *)
1726 cf.Code(Jvm.opc_arraylength); (* len0, arRf, arRf,... *)
1727 cf.Code(Jvm.opc_swap); (* arRf, len0, arRf,... *)
1728 cf.Code(Jvm.opc_iconst_0); (* 0, arRf, len0, arRf,... *)
1729 cf.Code(Jvm.opc_aaload); (* arRf, len0, arRf,... *)
1730 (*
1731 * Stack reads: (top) arRf, lenN, [lengths,] arRf ...
1732 *)
1733 UNTIL elTp.kind # Ty.arrTp;
1734 (*
1735 * Now get the final length...
1736 *)
1737 cf.Code(Jvm.opc_arraylength);
1738 (*
1739 * Stack reads: (top) lenM, lenN, [lengths,] arRf ...
1740 * Allocate the array headers for all dimensions.
1741 *)
1742 cf.MultiNew(GetTypeName(arrT), dims);
1743 (*
1744 * Stack is (top) ref...
1745 *)
1746 IF elTp.kind = Ty.recTp THEN cf.InitNdArray(arrT.elemTp, elTp) END;
1747 END;
1748 END MkArrayCopy;
1750 (* ============================================================ *)
1752 PROCEDURE (cf : ClassFile)VarInit*(var : D.Idnt);
1753 VAR typ : D.Type;
1754 BEGIN
1755 (*
1756 * Precondition: var is of a type that needs initialization
1757 *)
1758 typ := var.type;
1759 WITH typ : Ty.Record DO
1760 cf.MkNewRecord(typ);
1761 | typ : Ty.Array DO
1762 cf.MkNewFixedArray(typ.elemTp, typ.length);
1763 ELSE
1764 cf.Code(Jvm.opc_aconst_null);
1765 END;
1766 END VarInit;
1768 (* ============================================================ *)
1770 PROCEDURE (cf : ClassFile)ValRecCopy*(typ : Ty.Record);
1771 BEGIN
1772 (*
1773 * Stack at entry is (top) srcRef, dstRef...
1774 *)
1775 IF typ.xName = NIL THEN J.MkRecName(typ) END;
1776 cf.CallS(Jvm.opc_invokevirtual, typ.xName, copy,
1777 makeClassVoidArgList(typ), 2, 0);
1778 END ValRecCopy;
1780 (* ============================================================ *)
1782 PROCEDURE (cf : ClassFile)CallRTS*(ix,args,ret : INTEGER);
1783 VAR
1784 className : L.CharOpen;
1785 BEGIN
1786 IF ix = J.ToUpper THEN
1787 className := charClass;
1788 ELSIF ix = J.DFloor THEN
1789 className := mathClass;
1790 ELSIF ix = J.SysExit THEN
1791 className := sysClass;
1792 ELSE
1793 className := rtsClass;
1794 END;
1795 cf.CallS(Jvm.opc_invokestatic,className,procNames[ix],procSigs[ix],args,ret);
1796 END CallRTS;
1798 (* ============================================================ *)
1800 PROCEDURE (cf : ClassFile)CallGetClass*();
1801 BEGIN
1802 cf.CallS(Jvm.opc_invokevirtual, object, getCls, noArgClass, 1, 1);
1803 END CallGetClass;
1805 (* ============================================================ *)
1807 PROCEDURE (cf : ClassFile)Trap*(IN str : ARRAY OF CHAR);
1808 VAR
1809 clIx : INTEGER;
1810 BEGIN
1811 clIx := AddClassRef(cf.cp,errorClass);
1812 cf.Code2I(Jvm.opc_new,clIx,TRUE);
1813 cf.Code(Jvm.opc_dup);
1814 cf.PushStr(L.strToCharOpen(str));
1815 cf.CallS(Jvm.opc_invokespecial,errorClass,init,errorInitSig,2,0);
1816 cf.Code(Jvm.opc_athrow);
1817 END Trap;
1819 (* ============================================================ *)
1821 PROCEDURE (cf : ClassFile)CaseTrap*(i : INTEGER);
1822 VAR
1823 clIx : INTEGER;
1824 BEGIN
1825 clIx := AddClassRef(cf.cp,errorClass);
1826 cf.Code2I(Jvm.opc_new,clIx,TRUE);
1827 cf.Code(Jvm.opc_dup);
1828 cf.LoadLocal(i, G.intTp);
1829 cf.CallS(Jvm.opc_invokestatic,rtsClass,caseTrap,caseTrapSig,1,1);
1830 cf.CallS(Jvm.opc_invokespecial,errorClass,init,errorInitSig,2,0);
1831 cf.Code(Jvm.opc_athrow);
1832 END CaseTrap;
1834 (* ============================================================ *)
1836 PROCEDURE (cf : ClassFile)WithTrap*(id : D.Idnt);
1837 VAR
1838 clIx : INTEGER;
1839 BEGIN
1840 clIx := AddClassRef(cf.cp,errorClass);
1841 cf.Code2I(Jvm.opc_new,clIx,TRUE);
1842 cf.Code(Jvm.opc_dup);
1843 cf.GetVar(id);
1844 cf.CallS(Jvm.opc_invokestatic,rtsClass,withTrap,withTrapSig,1,1);
1845 cf.CallS(Jvm.opc_invokespecial,errorClass,init,errorInitSig,2,0);
1846 cf.Code(Jvm.opc_athrow);
1847 END WithTrap;
1849 (* ============================================================ *)
1851 PROCEDURE (cf : ClassFile)Line*(nm : INTEGER);
1852 VAR
1853 tmpStart, tmpNum : POINTER TO ARRAY OF INTEGER;
1854 i : INTEGER;
1855 BEGIN
1856 IF cf.lineNumTabIx = 0 THEN
1857 cf.lineNumTabIx := AddUTF(cf.cp,lineNumTabStr);
1858 END;
1859 IF cf.meth.lineNumTab.start = NIL THEN
1860 NEW(cf.meth.lineNumTab.start,initSize);
1861 NEW(cf.meth.lineNumTab.lineNum,initSize);
1862 ELSIF cf.meth.lineNumTab.tide >= LEN(cf.meth.lineNumTab.start) THEN
1863 tmpStart := cf.meth.lineNumTab.start;
1864 tmpNum := cf.meth.lineNumTab.lineNum;
1865 NEW(cf.meth.lineNumTab.start,cf.meth.lineNumTab.tide + initSize);
1866 NEW(cf.meth.lineNumTab.lineNum,cf.meth.lineNumTab.tide + initSize);
1867 FOR i := 0 TO cf.meth.lineNumTab.tide-1 DO
1868 cf.meth.lineNumTab.start[i] := tmpStart[i];
1869 cf.meth.lineNumTab.lineNum[i] := tmpNum[i];
1870 END;
1871 END;
1872 cf.meth.lineNumTab.start[cf.meth.lineNumTab.tide] := cf.meth.codes.codeLen;
1873 cf.meth.lineNumTab.lineNum[cf.meth.lineNumTab.tide] := nm;
1874 INC(cf.meth.lineNumTab.tide);
1875 END Line;
1877 (* ============================================================ *)
1878 (* Namehandling Methods *)
1879 (* ============================================================ *)
1881 PROCEDURE cat2(i,j : L.CharOpen) : L.CharOpen;
1882 BEGIN
1883 L.ResetCharOpenSeq(J.nmArray);
1884 L.AppendCharOpen(J.nmArray, i);
1885 L.AppendCharOpen(J.nmArray, j);
1886 RETURN L.arrayCat(J.nmArray);
1887 END cat2;
1889 (* ------------------------------------------------------------ *)
1892 PROCEDURE (cf : ClassFile)LoadConst*(num : INTEGER);
1893 VAR
1894 conIx : INTEGER;
1895 BEGIN
1896 IF (num >= MIN(SHORTINT)) & (num <= MAX(SHORTINT)) THEN
1897 cf.Code2I(Jvm.opc_sipush, num,TRUE);
1898 ELSE
1899 conIx := AddConstInt(cf.cp,num);
1900 IF conIx > maxUnsignedByte THEN
1901 cf.Code2I(Jvm.opc_ldc_w, conIx,TRUE);
1902 ELSE
1903 cf.CodeI(Jvm.opc_ldc, conIx);
1904 END;
1905 END;
1906 END LoadConst;
1908 (* ------------------------------------------------------------ *)
1910 PROCEDURE (cf : ClassFile)Try*();
1911 VAR start : INTEGER;
1912 BEGIN
1913 NEW(cf.meth.except);
1914 cf.meth.except.start := cf.meth.codes.codeLen;
1915 IF cf.jlExceptIx = 0 THEN
1916 cf.jlExceptIx := AddClassRef(cf.cp,exceptType);
1917 END;
1918 END Try;
1920 (* ------------------------------------------------------------ *)
1922 PROCEDURE (cf : ClassFile)MkNewException*();
1923 BEGIN
1924 IF cf.jlExceptIx = 0 THEN
1925 cf.jlExceptIx := AddClassRef(cf.cp,exceptType);
1926 END;
1927 cf.Code2I(Jvm.opc_new, cf.jlExceptIx,TRUE);
1928 END MkNewException;
1930 PROCEDURE (cf : ClassFile)InitException*();
1931 BEGIN
1932 cf.CallS(Jvm.opc_invokespecial, exceptType, init, errorInitSig, 2, 0);
1933 END InitException;
1935 (* ------------------------------------------------------------ *)
1937 PROCEDURE (cf : ClassFile)Catch*(prc : Id.Procs);
1938 BEGIN
1939 cf.meth.except.endAndHandler := cf.meth.codes.codeLen;
1940 cf.StoreLocal(prc.except.varOrd, NIL);
1941 (*
1942 * Now make sure that the overall stack
1943 * depth computation is correctly initialized
1944 *)
1945 IF cf.meth.maxStack < 1 THEN cf.meth.maxStack := 1 END;
1946 cf.meth.currStack := 0;
1947 END Catch;
1949 (* ============================================================ *)
1950 (* ============================================================ *)
1951 (* Class File Writing Procedures *)
1952 (* ============================================================ *)
1953 (* ============================================================ *)
1955 PROCEDURE u2 (file : F.FILE; val : INTEGER);
1956 VAR
1957 b1,b2 : INTEGER;
1958 BEGIN
1959 b1 := val MOD 256;
1960 b2 := val DIV 256;
1961 F.WriteByte(file,b2);
1962 F.WriteByte(file,b1);
1963 END u2;
1965 (* ------------------------------------------------------------ *)
1967 PROCEDURE u4 (file : F.FILE; val : INTEGER);
1968 VAR
1969 b1,b2,b3,b4 : INTEGER;
1970 BEGIN
1971 b1 := val MOD 256; val := val DIV 256;
1972 b2 := val MOD 256; val := val DIV 256;
1973 b3 := val MOD 256; val := val DIV 256;
1974 b4 := val;
1975 F.WriteByte(file,b4);
1976 F.WriteByte(file,b3);
1977 F.WriteByte(file,b2);
1978 F.WriteByte(file,b1);
1979 END u4;
1981 (* ============================================================ *)
1983 PROCEDURE WriteVal(file : F.FILE; val : INTEGER; numBytes : INTEGER);
1984 BEGIN
1985 CASE numBytes OF
1986 | 1 : F.WriteByte(file,val);
1987 | 2 : u2(file,val);
1988 | 4 : u4(file,val);
1989 END;
1990 END WriteVal;
1992 PROCEDURE (IN codes : CodeList)Dump(file : F.FILE),NEW;
1993 VAR
1994 i,j : INTEGER;
1995 op : Op;
1996 offset : INTEGER;
1997 BEGIN
1998 FOR i := 0 TO codes.tide-1 DO
1999 op := codes.code[i];
2000 F.WriteByte(file,op.op);
2001 WITH op : OpI DO
2002 WriteVal(file,op.val,op.numBytes);
2003 | op : OpII DO
2004 WriteVal(file,op.val1,op.numBytes);
2005 WriteVal(file,op.val2,op.numBytes);
2006 | op : OpL DO
2007 offset := op.lab.defIx - op.offset;
2008 u2(file,offset);
2009 | op : Op2IB DO
2010 u2(file,op.val);
2011 F.WriteByte(file,op.bVal);
2012 IF op.trailingZero THEN F.WriteByte(file,0); END;
2013 | op : OpSwitch DO
2014 FOR j := 0 TO op.padding-1 DO F.WriteByte(file,0); END;
2015 u4(file,(op.defLabel.defIx - op.offset));
2016 u4(file,op.low);
2017 u4(file,op.high);
2018 FOR j := 0 TO LEN(op.offs)-1 DO
2019 offset := op.offs[j].defIx - op.offset;
2020 u4(file,offset);
2021 END;
2022 ELSE (* nothing to do *)
2023 END;
2024 END;
2025 END Dump;
2027 (* ============================================================ *)
2029 PROCEDURE (meth : MethodInfo)Dump(cf : ClassFile),NEW;
2030 VAR
2031 i,len : INTEGER;
2032 linNumAttSize : INTEGER;
2033 BEGIN
2034 u2(cf.file,meth.access);
2035 u2(cf.file,meth.nameIx);
2036 u2(cf.file,meth.descIx);
2037 IF (meth.access >= Jvm.acc_abstract) THEN
2038 u2(cf.file,0); (* no attributes *)
2039 ELSE
2040 u2(cf.file,1); (* only attribute is code *)
2041 (* Start of Code attribute *)
2042 (* Calculate size of code attribute *)
2043 IF meth.lineNumTab.tide > 0 THEN
2044 linNumAttSize := 8 + 4 * meth.lineNumTab.tide;
2045 ELSE
2046 linNumAttSize := 0;
2047 END;
2048 len := 12 + meth.codes.codeLen + linNumAttSize;
2049 IF meth.except # NIL THEN INC(len,8); END;
2050 u2(cf.file,cf.codeAttIx);
2051 u4(cf.file,len);
2052 u2(cf.file,meth.maxStack);
2053 u2(cf.file,meth.maxLocals);
2054 u4(cf.file,meth.codes.codeLen);
2055 meth.codes.Dump(cf.file);
2056 IF meth.except # NIL THEN
2057 u2(cf.file,1);
2058 u2(cf.file,meth.except.start);
2059 u2(cf.file,meth.except.endAndHandler);
2060 u2(cf.file,meth.except.endAndHandler);
2061 u2(cf.file,cf.jlExceptIx);
2062 ELSE
2063 u2(cf.file,0);
2064 END;
2065 IF meth.lineNumTab.tide > 0 THEN
2066 u2(cf.file,1);
2067 (* Start of line number table attribute *)
2068 u2(cf.file,cf.lineNumTabIx);
2069 u4(cf.file,linNumAttSize-6);
2070 u2(cf.file,meth.lineNumTab.tide);
2071 FOR i := 0 TO meth.lineNumTab.tide-1 DO
2072 u2(cf.file,meth.lineNumTab.start[i]);
2073 u2(cf.file,meth.lineNumTab.lineNum[i]);
2074 END;
2075 (* End of line number table attribute *)
2076 ELSE
2077 u2(cf.file,0);
2078 END;
2079 (* End of Code attribute *)
2080 END;
2081 END Dump;
2083 (* ------------------------------------------------------------ *)
2085 PROCEDURE (field : FieldInfo)Dump(cf : ClassFile),NEW;
2086 BEGIN
2087 u2(cf.file,field.access);
2088 u2(cf.file,field.nameIx);
2089 u2(cf.file,field.descIx);
2090 u2(cf.file,0); (* No attributes for fields. ConstantValue is the *)
2091 (* only attribute recognized for fields, but constants *)
2092 (* are not currently stored in the class file *)
2093 END Dump;
2095 (* ============================================================ *)
2097 PROCEDURE (e : CPEntry)Dump(file : F.FILE),NEW,ABSTRACT;
2099 PROCEDURE (u : UTF8)Dump(file : F.FILE);
2100 VAR
2101 buf : POINTER TO ARRAY OF INTEGER;
2102 num : INTEGER;
2103 idx : INTEGER;
2104 chr : INTEGER;
2105 (* ================================= *)
2106 PROCEDURE Expand(VAR b : POINTER TO ARRAY OF INTEGER);
2107 VAR old : POINTER TO ARRAY OF INTEGER; len, idx : INTEGER;
2108 BEGIN
2109 len := LEN(b);
2110 old := b;
2111 NEW(b, len * 2);
2112 FOR idx := 0 TO len-1 DO b[idx] := old[idx] END;
2113 END Expand;
2114 (* ================================= *)
2115 BEGIN
2116 NEW(buf, 128);
2117 num := 0;
2118 idx := 0;
2119 FOR idx := 0 TO LEN(u.val) - 2 DO
2120 chr := ORD(u.val[idx]);
2121 IF num > LEN(buf) - 3 THEN Expand(buf) END;
2122 IF chr <= 7FH THEN
2123 IF chr = 0H THEN (* Modified UTF8! *)
2124 buf[num] := 0C0H; INC(num);
2125 buf[num] := 080H; INC(num);
2126 ELSE
2127 buf[num] := chr; INC(num);
2128 END;
2129 ELSIF chr <= 7FFH THEN
2130 buf[num+1] := 080H + chr MOD 64; chr := chr DIV 64;
2131 buf[num ] := 0C0H + chr; INC(num, 2);
2132 ELSE
2133 buf[num+2] := 080H + chr MOD 64; chr := chr DIV 64;
2134 buf[num+1] := 080H + chr MOD 64; chr := chr DIV 64;
2135 buf[num ] := 0E0H + chr; INC(num, 3);
2136 END;
2137 END;
2138 F.WriteByte(file,Jvm.const_utf8);
2139 u2(file,num);
2140 FOR idx := 0 TO num-1 DO F.WriteByte(file,buf[idx]) END;
2141 END Dump;
2143 PROCEDURE (c : ClassRef)Dump(file : F.FILE);
2144 BEGIN
2145 F.WriteByte(file,Jvm.const_class);
2146 u2(file,c.nameIx);
2147 END Dump;
2149 PROCEDURE (r : Reference)Dump(file : F.FILE);
2150 VAR
2151 tag : INTEGER;
2152 BEGIN
2153 IF r IS MethodRef THEN
2154 tag := Jvm.const_methodref;
2155 ELSIF r IS FieldRef THEN
2156 tag := Jvm.const_fieldref;
2157 ELSE
2158 tag := Jvm.const_interfacemethodref;
2159 END;
2160 F.WriteByte(file,tag);
2161 u2(file,r.classIx);
2162 u2(file,r.nameAndTypeIx);
2163 END Dump;
2165 PROCEDURE (n : NameAndType)Dump(file : F.FILE);
2166 BEGIN
2167 F.WriteByte(file,Jvm.const_nameandtype);
2168 u2(file,n.nameIx);
2169 u2(file,n.descIx);
2170 END Dump;
2172 PROCEDURE (s : StringRef)Dump(file : F.FILE);
2173 BEGIN
2174 F.WriteByte(file,Jvm.const_string);
2175 u2(file,s.stringIx);
2176 END Dump;
2178 PROCEDURE (i : Integer)Dump(file : F.FILE);
2179 BEGIN
2180 F.WriteByte(file,Jvm.const_integer);
2181 u4(file,i.iVal);
2182 END Dump;
2184 PROCEDURE (f : Float)Dump(file : F.FILE);
2185 BEGIN
2186 F.WriteByte(file,Jvm.const_float);
2187 u4(file,RTS.shortRealToIntBits(f.fVal));
2188 END Dump;
2190 PROCEDURE (l : Long)Dump(file : F.FILE);
2191 BEGIN
2192 F.WriteByte(file,Jvm.const_long);
2193 u4(file,RTS.hiInt(l.lVal));
2194 u4(file,RTS.loInt(l.lVal));
2195 END Dump;
2197 PROCEDURE (d : Double)Dump(file : F.FILE);
2198 VAR
2199 rBits : LONGINT;
2200 BEGIN
2201 F.WriteByte(file,Jvm.const_double);
2202 rBits := RTS.realToLongBits(d.dVal);
2203 u4(file,RTS.hiInt(rBits));
2204 u4(file,RTS.loInt(rBits));
2205 END Dump;
2207 (* ============================================================ *)
2209 PROCEDURE (cf : ClassFile)Dump*();
2210 VAR
2211 i,j : INTEGER;
2212 BEGIN
2213 u4(cf.file,RTS.loInt(magic));
2214 u2(cf.file,minorVersion);
2215 u2(cf.file,majorVersion);
2216 u2(cf.file,cf.cp.tide); (* constant pool count *)
2217 FOR i := 1 TO cf.cp.tide-1 DO
2218 IF cf.cp.pool[i] # NIL THEN cf.cp.pool[i].Dump(cf.file); END;
2219 END;
2220 u2(cf.file,cf.access);
2221 u2(cf.file,cf.thisClassIx);
2222 u2(cf.file,cf.superClassIx);
2223 u2(cf.file,cf.numInterfaces);
2224 FOR i := 0 TO cf.numInterfaces-1 DO
2225 u2(cf.file,cf.interfaces[i]);
2226 END;
2227 u2(cf.file,cf.numFields);
2228 FOR i := 0 TO cf.numFields-1 DO
2229 cf.fields[i].Dump(cf);
2230 END;
2231 u2(cf.file,cf.numMethods);
2232 FOR i := 0 TO cf.numMethods-1 DO
2233 cf.methods[i].Dump(cf);
2234 END;
2235 u2(cf.file,1); (* only class file attribute is SourceFile *)
2236 u2(cf.file,cf.srcFileAttIx);
2237 u4(cf.file,2); (* length of source file attribute *)
2238 u2(cf.file,cf.srcFileIx);
2239 F.CloseFile(cf.file);
2240 END Dump;
2242 (* ============================================================ *)
2244 BEGIN
2253 (*
2255 *)
2307 procSigs[J.ModI] := IIretI;
2308 procSigs[J.ModL] := JJretJ;
2309 procSigs[J.DivI] := IIretI;
2310 procSigs[J.DivL] := JJretJ;
2312 procSigs[J.StrCatSA] := L.strToCharOpen(
2314 procSigs[J.StrCatAS] := L.strToCharOpen(
2316 procSigs[J.StrCatSS] := L.strToCharOpen(
2318 procSigs[J.StrLP1] := procSigs[J.StrLen];
2322 procSigs[J.LoadTp2] := L.strToCharOpen(
2325 typeArr[ Ty.boolN] := 4;
2326 typeArr[ Ty.sChrN] := 5;
2327 typeArr[ Ty.charN] := 5;
2328 typeArr[ Ty.byteN] := 8;
2329 typeArr[ Ty.uBytN] := 8;
2330 typeArr[ Ty.sIntN] := 9;
2331 typeArr[ Ty.intN] := 10;
2332 typeArr[ Ty.lIntN] := 11;
2333 typeArr[ Ty.sReaN] := 6;
2334 typeArr[ Ty.realN] := 7;
2335 typeArr[ Ty.setN] := 10;
2336 END ClassUtil.
2337 (* ============================================================ *)
2338 (* ============================================================ *)