m40.s

0600 / machine language assist 0601 / for 11/40 0602 0603 / non-UNIX instructions 0604 mfpi = 6500^tst 0605 mtpi = 6600^tst 0606 wait = 1 0607 rtt = 6 0608 reset = 5 0609 0610 /* ------------------------ */ 0611 .globl start, _end, _edata, _main 0612 start: 0613 bit $1,SSR0 0614 bne start / loop if restart 0615 reset 0616 0617 / initialize systems segments 0618 0619 mov $KISA0,r0 0620 mov $KISD0,r1 0621 mov $200,r4 0622 clr r2 0623 mov $6,r3 0624 1: 0625 mov r2,(r0)+ 0626 mov $77406,(r1)+ / 4k rw 0627 add r4,r2 0628 sob r3,1b 0629 0630 / initialize user segment 0631 0632 mov $_end+63.,r2 0633 ash $-6,r2 0634 bic $!1777,r2 0635 mov r2,(r0)+ / ksr6 = sysu 0636 mov $usize-1\<8|6,(r1)+ 0637 0638 / initialize io segment 0639 / set up counts on supervisor segments 0640 0641 mov $IO,(r0)+ 0642 mov $77406,(r1)+ / rw 4k 0643 0644 / get a sp and start segmentation 0645 0646 mov $_u+[usize*64.],sp 0647 inc SSR0 0648 0649 / clear bss 0650 0651 mov $_edata,r0 0652 1: 0653 clr (r0)+ 0654 cmp r0,$_end 0655 blo 1b 0656 0657 / clear user block 0658 0659 mov $_u,r0 0660 1: 0661 clr (r0)+ 0662 cmp r0,$_u+[usize*64.] 0663 blo 1b 0664 0665 / set up previous mode and call main 0666 / on return, enter user mode at 0R 0667 0668 mov $30000,PS 0669 jsr pc,_main 0670 mov $170000,-(sp) 0671 clr -(sp) 0672 rtt 0673 0674 /* ------------------------ */ 0675 .globl _clearseg 0676 _clearseg: 0677 mov PS,-(sp) 0678 mov UISA0,-(sp) 0679 mov $30340,PS 0680 mov 6(sp),UISA0 0681 mov UISD0,-(sp) 0682 mov $6,UISD0 0683 clr r0 0684 mov $32.,r1 0685 1: 0686 clr -(sp) 0687 mtpi (r0)+ 0688 sob r1,1b 0689 mov (sp)+,UISD0 0690 mov (sp)+,UISA0 0691 mov (sp)+,PS 0692 rts pc 0693 0694 /* ------------------------ */ 0695 .globl _copyseg 0696 _copyseg: 0697 mov PS,-(sp) 0698 mov UISA0,-(sp) 0699 mov UISA1,-(sp) 0700 mov $30340,PS 0701 mov 10(sp),UISA0 0702 mov 12(sp),UISA1 0703 mov UISD0,-(sp) 0704 mov UISD1,-(sp) 0705 mov $6,UISD0 0706 mov $6,UISD1 0707 mov r2,-(sp) 0708 clr r0 0709 mov $8192.,r1 0710 mov $32.,r2 0711 1: 0712 mfpi (r0)+ 0713 mtpi (r1)+ 0714 sob r2,1b 0715 mov (sp)+,r2 0716 mov (sp)+,UISD1 0717 mov (sp)+,UISD0 0718 mov (sp)+,UISA1 0719 mov (sp)+,UISA0 0720 mov (sp)+,PS 0721 rts pc 0722 0723 /* ------------------------ */ 0724 .globl _savu, _retu, _aretu 0725 _savu: 0726 bis $340,PS 0727 mov (sp)+,r1 0728 mov (sp),r0 0729 mov sp,(r0)+ 0730 mov r5,(r0)+ 0731 bic $340,PS 0732 jmp (r1) 0733 0734 _aretu: 0735 bis $340,PS 0736 mov (sp)+,r1 0737 mov (sp),r0 0738 br 1f 0739 0740 _retu: 0741 bis $340,PS 0742 mov (sp)+,r1 0743 mov (sp),KISA6 0744 mov $_u,r0 0745 1: 0746 mov (r0)+,sp 0747 mov (r0)+,r5 0748 bic $340,PS 0749 jmp (r1) 0750 0751 /* ------------------------ */ 0752 .globl trap, call 0753 /* ------------------------ */ 0754 .globl _trap 0755 trap: 0756 mov PS,-4(sp) 0757 tst nofault 0758 bne 1f 0759 mov SSR0,ssr 0760 mov SSR2,ssr+4 0761 mov $1,SSR0 0762 jsr r0,call1; _trap 0763 / no return 0764 1: 0765 mov $1,SSR0 0766 mov nofault,(sp) 0767 rtt 0768 0769 /* ------------------------ */ 0770 .globl _runrun, _swtch 0771 call1: 0772 tst -(sp) 0773 bic $340,PS 0774 br 1f 0775 0776 call: 0777 mov PS,-(sp) 0778 1: 0779 mov r1,-(sp) 0780 mfpi sp 0781 mov 4(sp),-(sp) 0782 bic $!37,(sp) 0783 bit $30000,PS 0784 beq 1f 0785 jsr pc,*(r0)+ 0786 2: 0787 bis $340,PS 0788 tstb _runrun 0789 beq 2f 0790 bic $340,PS 0791 jsr pc,_swtch 0792 br 2b 0793 2: 0794 tst (sp)+ 0795 mtpi sp 0796 br 2f 0797 1: 0798 bis $30000,PS 0799 jsr pc,*(r0)+ 0800 cmp (sp)+,(sp)+ 0801 2: 0802 mov (sp)+,r1 0803 tst (sp)+ 0804 mov (sp)+,r0 0805 rtt 0806 /* ------------------------ */ 0807 .globl _fubyte, _subyte 0808 /* ------------------------ */ 0809 .globl _fuibyte, _suibyte 0810 /* ------------------------ */ 0811 .globl _fuword, _suword 0812 /* ------------------------ */ 0813 .globl _fuiword, _suiword 0814 _fuibyte: 0815 _fubyte: 0816 mov 2(sp),r1 0817 bic $1,r1 0818 jsr pc,gword 0819 cmp r1,2(sp) 0820 beq 1f 0821 swab r0 0822 1: 0823 bic $!377,r0 0824 rts pc 0825 0826 _suibyte: 0827 _subyte: 0828 mov 2(sp),r1 0829 bic $1,r1 0830 jsr pc,gword 0831 mov r0,-(sp) 0832 cmp r1,4(sp) 0833 beq 1f 0834 movb 6(sp),1(sp) 0835 br 2f 0836 1: 0837 movb 6(sp),(sp) 0838 2: 0839 mov (sp)+,r0 0840 jsr pc,pword 0841 clr r0 0842 rts pc 0843 0844 _fuiword: 0845 _fuword: 0846 mov 2(sp),r1 0847 fuword: 0848 jsr pc,gword 0849 rts pc 0850 0851 gword: 0852 mov PS,-(sp) 0853 bis $340,PS 0854 mov nofault,-(sp) 0855 mov $err,nofault 0856 mfpi (r1) 0857 mov (sp)+,r0 0858 br 1f 0859 0860 _suiword: 0861 _suword: 0862 mov 2(sp),r1 0863 mov 4(sp),r0 0864 suword: 0865 jsr pc,pword 0866 rts pc 0867 0868 pword: 0869 mov PS,-(sp) 0870 bis $340,PS 0871 mov nofault,-(sp) 0872 mov $err,nofault 0873 mov r0,-(sp) 0874 mtpi (r1) 0875 1: 0876 mov (sp)+,nofault 0877 mov (sp)+,PS 0878 rts pc 0879 0880 err: 0881 mov (sp)+,nofault 0882 mov (sp)+,PS 0883 tst (sp)+ 0884 mov $-1,r0 0885 rts pc 0886 0887 /* ------------------------ */ 0888 .globl _savfp, _display 0889 _savfp: 0890 _display: 0891 rts pc 0892 0893 /* ------------------------ */ 0894 .globl _incupc 0895 _incupc: 0896 mov r2,-(sp) 0897 mov 6(sp),r2 / base of prof with base,leng,off,scale 0898 mov 4(sp),r0 / pc 0899 sub 4(r2),r0 / offset 0900 clc 0901 ror r0 0902 mul 6(r2),r0 / scale 0903 ashc $-14.,r0 0904 inc r1 0905 bic $1,r1 0906 cmp r1,2(r2) / length 0907 bhis 1f 0908 add (r2),r1 / base 0909 mov nofault,-(sp) 0910 mov $2f,nofault 0911 mfpi (r1) 0912 inc (sp) 0913 mtpi (r1) 0914 br 3f 0915 2: 0916 clr 6(r2) 0917 3: 0918 mov (sp)+,nofault 0919 1: 0920 mov (sp)+,r2 0921 rts pc 0922 0923 / Character list get/put 0924 0925 /* ------------------------ */ 0926 .globl _getc, _putc 0927 /* ------------------------ */ 0928 .globl _cfreelist 0929 0930 _getc: 0931 mov 2(sp),r1 0932 mov PS,-(sp) 0933 mov r2,-(sp) 0934 bis $340,PS 0935 bic $100,PS / spl 5 0936 mov 2(r1),r2 / first ptr 0937 beq 9f / empty 0938 movb (r2)+,r0 / character 0939 bic $!377,r0 0940 mov r2,2(r1) 0941 dec (r1)+ / count 0942 bne 1f 0943 clr (r1)+ 0944 clr (r1)+ / last block 0945 br 2f 0946 1: 0947 bit $7,r2 0948 bne 3f 0949 mov -10(r2),(r1) / next block 0950 add $2,(r1) 0951 2: 0952 dec r2 0953 bic $7,r2 0954 mov _cfreelist,(r2) 0955 mov r2,_cfreelist 0956 3: 0957 mov (sp)+,r2 0958 mov (sp)+,PS 0959 rts pc 0960 9: 0961 clr 4(r1) 0962 mov $-1,r0 0963 mov (sp)+,r2 0964 mov (sp)+,PS 0965 rts pc 0966 0967 _putc: 0968 mov 2(sp),r0 0969 mov 4(sp),r1 0970 mov PS,-(sp) 0971 mov r2,-(sp) 0972 mov r3,-(sp) 0973 bis $340,PS 0974 bic $100,PS / spl 5 0975 mov 4(r1),r2 / last ptr 0976 bne 1f 0977 mov _cfreelist,r2 0978 beq 9f 0979 mov (r2),_cfreelist 0980 clr (r2)+ 0981 mov r2,2(r1) / first ptr 0982 br 2f 0983 1: 0984 bit $7,r2 0985 bne 2f 0986 mov _cfreelist,r3 0987 beq 9f 0988 mov (r3),_cfreelist 0989 mov r3,-10(r2) 0990 mov r3,r2 0991 clr (r2)+ 0992 2: 0993 movb r0,(r2)+ 0994 mov r2,4(r1) 0995 inc (r1) / count 0996 clr r0 0997 mov (sp)+,r3 0998 mov (sp)+,r2 0999 mov (sp)+,PS 1000 rts pc 1001 9: 1002 mov pc,r0 1003 mov (sp)+,r3 1004 mov (sp)+,r2 1005 mov (sp)+,PS 1006 rts pc 1007 1008 /* ------------------------ */ 1009 .globl _backup 1010 /* ------------------------ */ 1011 .globl _regloc 1012 _backup: 1013 mov 2(sp),ssr+2 1014 mov r2,-(sp) 1015 jsr pc,backup 1016 mov r2,ssr+2 1017 mov (sp)+,r2 1018 movb jflg,r0 1019 bne 2f 1020 mov 2(sp),r0 1021 movb ssr+2,r1 1022 jsr pc,1f 1023 movb ssr+3,r1 1024 jsr pc,1f 1025 movb _regloc+7,r1 1026 asl r1 1027 add r0,r1 1028 mov ssr+4,(r1) 1029 clr r0 1030 2: 1031 rts pc 1032 1: 1033 mov r1,-(sp) 1034 asr (sp) 1035 asr (sp) 1036 asr (sp) 1037 bic $!7,r1 1038 movb _regloc(r1),r1 1039 asl r1 1040 add r0,r1 1041 sub (sp)+,(r1) 1042 rts pc 1043 1044 / hard part 1045 / simulate the ssr2 register missing on 11/40 1046 1047 backup: 1048 clr r2 / backup register ssr1 1049 mov $1,bflg / clrs jflg 1050 mov ssr+4,r0 1051 jsr pc,fetch 1052 mov r0,r1 1053 ash $-11.,r0 1054 bic $!36,r0 1055 jmp *0f(r0) 1056 0: t00; t01; t02; t03; t04; t05; t06; t07 1057 t10; t11; t12; t13; t14; t15; t16; t17 1058 1059 t00: 1060 clrb bflg 1061 1062 t10: 1063 mov r1,r0 1064 swab r0 1065 bic $!16,r0 1066 jmp *0f(r0) 1067 0: u0; u1; u2; u3; u4; u5; u6; u7 1068 1069 u6: / single op, m[tf]pi, sxt, illegal 1070 bit $400,r1 1071 beq u5 / all but m[tf], sxt 1072 bit $200,r1 1073 beq 1f / mfpi 1074 bit $100,r1 1075 bne u5 / sxt 1076 1077 / simulate mtpi with double (sp)+,dd 1078 bic $4000,r1 / turn instr into (sp)+ 1079 br t01 1080 1081 / simulate mfpi with double ss,-(sp) 1082 1: 1083 ash $6,r1 1084 bis $46,r1 / -(sp) 1085 br t01 1086 1087 u4: / jsr 1088 mov r1,r0 1089 jsr pc,setreg / assume no fault 1090 bis $173000,r2 / -2 from sp 1091 rts pc 1092 1093 t07: / EIS 1094 clrb bflg 1095 1096 u0: / jmp, swab 1097 u5: / single op 1098 mov r1,r0 1099 br setreg 1100 1101 t01: / mov 1102 t02: / cmp 1103 t03: / bit 1104 t04: / bic 1105 t05: / bis 1106 t06: / add 1107 t16: / sub 1108 clrb bflg 1109 1110 t11: / movb 1111 t12: / cmpb 1112 t13: / bitb 1113 t14: / bicb 1114 t15: / bisb 1115 mov r1,r0 1116 ash $-6,r0 1117 jsr pc,setreg 1118 swab r2 1119 mov r1,r0 1120 jsr pc,setreg 1121 1122 / if delta(dest) is zero, 1123 / no need to fetch source 1124 1125 bit $370,r2 1126 beq 1f 1127 1128 / if mode(source) is R, 1129 / no fault is possible 1130 1131 bit $7000,r1 1132 beq 1f 1133 1134 / if reg(source) is reg(dest), 1135 / too bad. 1136 1137 mov r2,-(sp) 1138 bic $174370,(sp) 1139 cmpb 1(sp),(sp)+ 1140 beq t17 1141 1142 / start source cycle 1143 / pick up value of reg 1144 1145 mov r1,r0 1146 ash $-6,r0 1147 bic $!7,r0 1148 movb _regloc(r0),r0 1149 asl r0 1150 add ssr+2,r0 1151 mov (r0),r0 1152 1153 / if reg has been incremented, 1154 / must decrement it before fetch 1155 1156 bit $174000,r2 1157 ble 2f 1158 dec r0 1159 bit $10000,r2 1160 beq 2f 1161 dec r0 1162 2: 1163 1164 / if mode is 6,7 fetch and add X(R) to R 1165 1166 bit $4000,r1 1167 beq 2f 1168 bit $2000,r1 1169 beq 2f 1170 mov r0,-(sp) 1171 mov ssr+4,r0 1172 add $2,r0 1173 jsr pc,fetch 1174 add (sp)+,r0 1175 2: 1176 1177 / fetch operand 1178 / if mode is 3,5,7 fetch * 1179 1180 jsr pc,fetch 1181 bit $1000,r1 1182 beq 1f 1183 bit $6000,r1 1184 bne fetch 1185 1: 1186 rts pc 1187 1188 t17: / illegal 1189 u1: / br 1190 u2: / br 1191 u3: / br 1192 u7: / illegal 1193 incb jflg 1194 rts pc 1195 1196 setreg: 1197 mov r0,-(sp) 1198 bic $!7,r0 1199 bis r0,r2 1200 mov (sp)+,r0 1201 ash $-3,r0 1202 bic $!7,r0 1203 movb 0f(r0),r0 1204 tstb bflg 1205 beq 1f 1206 bit $2,r2 1207 beq 2f 1208 bit $4,r2 1209 beq 2f 1210 1: 1211 cmp r0,$20 1212 beq 2f 1213 cmp r0,$-20 1214 beq 2f 1215 asl r0 1216 2: 1217 bisb r0,r2 1218 rts pc 1219 1220 0: .byte 0,0,10,20,-10,-20,0,0 1221 1222 fetch: 1223 bic $1,r0 1224 mov nofault,-(sp) 1225 mov $1f,nofault 1226 mfpi (r0) 1227 mov (sp)+,r0 1228 mov (sp)+,nofault 1229 rts pc 1230 1231 1: 1232 mov (sp)+,nofault 1233 clrb r2 / clear out dest on fault 1234 mov $-1,r0 1235 rts pc 1236 1237 .bss 1238 bflg: .=.+1 1239 jflg: .=.+1 1240 .text 1241 1242 /* ------------------------ */ 1243 .globl _copyin, _copyout 1244 _copyin: 1245 jsr pc,copsu 1246 1: 1247 mfpi (r0)+ 1248 mov (sp)+,(r1)+ 1249 sob r2,1b 1250 br 2f 1251 1252 _copyout: 1253 jsr pc,copsu 1254 1: 1255 mov (r0)+,-(sp) 1256 mtpi (r1)+ 1257 sob r2,1b 1258 2: 1259 mov (sp)+,nofault 1260 mov (sp)+,r2 1261 clr r0 1262 rts pc 1263 1264 copsu: 1265 mov (sp)+,r0 1266 mov r2,-(sp) 1267 mov nofault,-(sp) 1268 mov r0,-(sp) 1269 mov 10(sp),r0 1270 mov 12(sp),r1 1271 mov 14(sp),r2 1272 asr r2 1273 mov $1f,nofault 1274 rts pc 1275 1276 1: 1277 mov (sp)+,nofault 1278 mov (sp)+,r2 1279 mov $-1,r0 1280 rts pc 1281 1282 /* ------------------------ */ 1283 .globl _idle 1284 _idle: 1285 mov PS,-(sp) 1286 bic $340,PS 1287 wait 1288 mov (sp)+,PS 1289 rts pc 1290 1291 /* ------------------------ */ 1292 .globl _spl0, _spl1, _spl4, _spl5, _spl6, _spl7 1293 _spl0: 1294 bic $340,PS 1295 rts pc 1296 1297 _spl1: 1298 bis $40,PS 1299 bic $300,PS 1300 rts pc 1301 1302 _spl4: 1303 _spl5: 1304 bis $340,PS 1305 bic $100,PS 1306 rts pc 1307 1308 _spl6: 1309 bis $340,PS 1310 bic $40,PS 1311 rts pc 1312 1313 _spl7: 1314 bis $340,PS 1315 rts pc 1316 1317 /* ------------------------ */ 1318 .globl _dpadd 1319 _dpadd: 1320 mov 2(sp),r0 1321 add 4(sp),2(r0) 1322 adc (r0) 1323 rts pc 1324 1325 /* ------------------------ */ 1326 .globl _dpcmp 1327 _dpcmp: 1328 mov 2(sp),r0 1329 mov 4(sp),r1 1330 sub 6(sp),r0 1331 sub 8(sp),r1 1332 sbc r0 1333 bge 1f 1334 cmp r0,$-1 1335 bne 2f 1336 cmp r1,$-512. 1337 bhi 3f 1338 2: 1339 mov $-512.,r0 1340 rts pc 1341 1: 1342 bne 2f 1343 cmp r1,$512. 1344 blo 3f 1345 2: 1346 mov $512.,r1 1347 3: 1348 mov r1,r0 1349 rts pc 1350 1351 /* ------------------------ */ 1352 .globl dump 1353 dump: 1354 bit $1,SSR0 1355 bne dump 1356 1357 / save regs r0,r1,r2,r3,r4,r5,r6,KIA6 1358 / starting at abs location 4 1359 1360 mov r0,4 1361 mov $6,r0 1362 mov r1,(r0)+ 1363 mov r2,(r0)+ 1364 mov r3,(r0)+ 1365 mov r4,(r0)+ 1366 mov r5,(r0)+ 1367 mov sp,(r0)+ 1368 mov KISA6,(r0)+ 1369 1370 / dump all of core (ie to first mt error) 1371 / onto mag tape. (9 track or 7 track 'binary') 1372 1373 mov $MTC,r0 1374 mov $60004,(r0)+ 1375 clr 2(r0) 1376 1: 1377 mov $-512.,(r0) 1378 inc -(r0) 1379 2: 1380 tstb (r0) 1381 bge 2b 1382 tst (r0)+ 1383 bge 1b 1384 reset 1385 1386 / end of file and loop 1387 1388 mov $60007,-(r0) 1389 br . 1390 1391 /* ------------------------ */ 1392 .globl _ldiv 1393 _ldiv: 1394 clr r0 1395 mov 2(sp),r1 1396 div 4(sp),r0 1397 rts pc 1398 1399 /* ------------------------ */ 1400 .globl _lrem 1401 _lrem: 1402 clr r0 1403 mov 2(sp),r1 1404 div 4(sp),r0 1405 mov r1,r0 1406 rts pc 1407 1408 /* ------------------------ */ 1409 .globl _lshift 1410 _lshift: 1411 mov 2(sp),r1 1412 mov (r1)+,r0 1413 mov (r1),r1 1414 ashc 4(sp),r0 1415 mov r1,r0 1416 rts pc 1417 1418 /* ------------------------ */ 1419 .globl csv 1420 csv: 1421 mov r5,r0 1422 mov sp,r5 1423 mov r4,-(sp) 1424 mov r3,-(sp) 1425 mov r2,-(sp) 1426 jsr pc,(r0) 1427 1428 /* ------------------------ */ 1429 .globl cret 1430 cret: 1431 mov r5,r1 1432 mov -(r1),r4 1433 mov -(r1),r3 1434 mov -(r1),r2 1435 mov r5,sp 1436 mov (sp)+,r5 1437 rts pc 1438 1439 /* ------------------------ */ 1440 .globl _u 1441 _u = 140000 1442 usize = 16. 1443 1444 PS = 177776 1445 SSR0 = 177572 1446 SSR2 = 177576 1447 KISA0 = 172340 1448 KISA6 = 172354 1449 KISD0 = 172300 1450 MTC = 172522 1451 UISA0 = 177640 1452 UISA1 = 177642 1453 UISD0 = 177600 1454 UISD1 = 177602 1455 IO = 7600 1456 1457 .data 1458 /* ------------------------ */ 1459 .globl _ka6, _cputype 1460 _ka6: KISA6 1461 _cputype:40. 1462 1463 .bss 1464 /* ------------------------ */ 1465 .globl nofault, ssr, badtrap 1466 nofault:.=.+2 1467 ssr: .=.+6 1468 badtrap:.=.+2 1469 1470 1471 1472 1473 1474 1475 1476 1477 1478 1479 1480 1481 1482 1483 1484 1485 1486 1487 1488 1489 1490 1491 1492 1493 1494 1495 1496 1497 1498 1499