1 COM X[2048],Y[10],P,C$[7] 2 COM E,O,L[10] 3 Y[10]=1 4 GOTO 1135 5 REM HPASMB, HP 36806A, 2/74 (HPRUN, PART 3 OF 4) 15 MAT L=ZER 20 E=O=0 30 DIM A[16],B[16],I[16],C[15] 50 P=Y[1] 55 MAT READ C 56 D=L=0 60 I=INT(X[P]/2048)+(X[P]<0)*16 70 IF I<2 THEN 1150 80 A2=32768.*(X[P]<0) 85 A1=X[P]-2048*I+1 90 GOSUB 280 120 P=P+1 150 GOTO I-1 OF 500,850,660,820,580,740,380,380,790,790,900,900,930,930 160 GOTO 60 240 REM--GET-ADR 250 P=P+2 260 A1=X[P-1]+1 270 A2=32768.*(A1<0) 280 IF A1+A2<1 OR A1+A2>2048 THEN 330 290 IF A2 THEN 310 300 RETURN 310 A1=X[A1+A2]+1 320 GOTO 270 330 PRINT "ADR OUT OF RANGE "; 340 FOR J=4 TO 0 STEP -1 350 PRINT USING "#,D";INT((P-1)/8^J)-INT((P-1)/8^(J+1))*8 360 NEXT J 363 PRINT 365 GOTO 1135 370 REM---ADD 380 A=X[I-7] 390 B=X[A1] 400 C=A+B 402 A=A<0 404 B=B<0 410 C=X[I-7]=C+((C<-32768.)-(C>32767))*65536. 415 C=C >= 0 420 O=O OR A=B AND B=C 430 E=E OR A AND B OR (A OR B) AND C 440 GOTO 60 490 REM---AND 500 A=X[1] 505 B=X[A1] 510 C=0 515 FOR J=0 TO 14 520 C=C+2^J*(A-INT(A/2)*2 AND B-INT(B/2)*2) 525 A=INT(A/2) 530 B=INT(B/2) 535 NEXT J 540 X[1]=C-(A<0 AND B<0)*32768. 550 GOTO 60 570 REM---IOR 580 A=X[1] 585 B=X[A1] 590 C=0 595 FOR J=0 TO 14 600 C=C+2^J*(A-INT(A/2)*2 OR B-INT(B/2)*2) 605 A=INT(A/2) 610 B=INT(B/2) 620 NEXT J 630 X[1]=C-(A<0 OR B<0)*32768. 640 GOTO 60 650 REM---XOR 660 A=X[1] 665 B=X[A1] 670 C=0 675 FOR J=0 TO 14 680 C=C+2^J*(A-INT(A/2)*2#B-INT(B/2)*2) 685 A=INT(A/2) 690 B=INT(B/2) 695 NEXT J 700 X[1]=C-((A<0)#(B<0))*32768. 710 GOTO 60 730 REM---ISZ 740 X[A1]=INT(X[A1]+1)-65536.*(X[A1] >= 32767) 750 P=P+(X[A1]=0) 770 GOTO 60 780 REM---CMPAR 790 P=P+(X[I-9]#X[A1]) 800 GOTO 60 810 REM---JMP 820 P=A1 830 GOTO 60 840 REM---JSB 850 IF A1>2044 THEN 960 860 X[A1]=P-1 870 P=A1+1 880 GOTO 60 890 REM---LDA, LDB 900 X[I-11]=X[A1] 910 GOTO 60 920 REM---STA, STB 930 X[A1]=X[I-13] 940 GOTO 60 950 REM---PRINT 960 GOTO A1-2044 OF 4000,1135,970,1040 970 FOR J=P+1 TO X[P] 972 P=J 975 A1=X[P]+1 980 GOSUB 270 985 PRINT USING "#,7D";X[A1] 990 NEXT J 1000 P=J 1010 PRINT 1020 GOTO 60 1030 REM---INPUT 1040 MAT INPUT D[X[P]-P] 1060 FOR J=1 TO X[P]-P 1065 P=P+1 1070 A1=X[P]+1 1075 GOSUB 270 1080 X[A1]=D[J] 1090 NEXT J 1100 P=P+1 1110 GOTO 60 1135 CHAIN "HPASMB",100 1150 IF X[P]<0 THEN 1400 1155 A=X[P] 1157 IF INT(A/1024)-INT(A/2048)*2=0 THEN 2660 1160 FOR J=16 TO 7 STEP -1 1162 I[J]=A-INT(A/2)*2 1164 A=INT(A/2) 1166 NEXT J 1180 A=X[I+1] 1210 A=A*( NOT I[8]) 1220 A=A-(A+A+1)*I[7] 1250 S=I[11] AND (E=I[16]) 1260 E=E AND I[10]=I[9] OR NOT E AND I[9] 1264 F=(A<0) 1266 L=A-INT(A/2)*2 1270 S1=I[12] AND (F=I[16]) OR I[13] AND (L=I[16]) 1275 S=S OR S1 AND (4#(I[12]+I[13]+I[16]+(L#F))) 1280 E=E OR A=-1 AND I[14] 1290 O=O OR A=32767 AND I[14] 1300 A=A+I[14]-(A+I[14]>32767)*65536. 1330 X[I+1]=A 1340 S=S OR I[15] AND (A=0) AND NOT I[16] OR I[16] AND I[15] AND (A#0) 1350 S=S OR I[16] AND I[11]+I[12]+I[13]+I[15]=0 1360 P=P+S+1 1370 GOTO 60 1400 I=INT(X[P]/64) 1410 FOR J=1 TO 15 1420 IF I=C[J] THEN 1460 1430 NEXT J 1440 P=P+1 1450 GOTO 60 1460 GOTO J OF 1500,1700,2070,2120,2170,2310,2410,2460,2500 1470 GOTO J-9 OF 2540,2580,2610,2630,2580,2610 1500 GOSUB 250 1505 A=ABS(X[1]) 1510 B=ABS(X[A1]) 1520 S1=(X[1]<0)#(X[A1]<0) 1530 X[1]=(A-INT(A/256)*256)*(B-INT(B/256)*256) 1540 S=(A-INT(A/256)*256)*INT(B/256)+(B-INT(B/256)*256)*INT(A/256) 1550 X[2]=INT(A/256)*INT(B/256) 1560 X[1]=X[1]+(S-INT(S/256)*256)*256 1570 X[2]=X[2]+INT(S/256)+INT(X[1]/65536.) 1580 X[1]=X[1]-65536.*(X[1]>32767) 1590 IF S1=0 THEN 60 1600 X[1]=-X[1] 1610 X[2]=-X[2]-(X[1]=0)-(X[2]=0) 1620 GOTO 60 1690 REM---DIV 1700 GOSUB 250 1720 S=(X[2]<0)#(X[A1]<0) 1730 C=ABS(X[A1]) 1740 B=ABS(X[2])-(X[2]<0) 1750 A=(X[1]+65536.*(X[1]<0))*(X[2]#-1)+ABS(X[1])*(X[2]=-1) 1753 IF 2*B+(A>32767)32767) 1780 A=(A-32768.*(A>32767))*2+(C <= B) 1790 B=B-C*(C <= B) 1800 NEXT J 1810 X[1]=A*((S=0)-(S=1)) 1820 X[2]=B*((X[2] >= 0)-(X[2]<0)) 1830 GOTO 60 2060 REM-DLD 2070 GOSUB 250 2080 X[1]=X[A1] 2090 X[2]=X[A1+1] 2100 GOTO 60 2110 REM-DST 2120 GOSUB 250 2130 X[A1]=X[1] 2140 X[A1+1]=X[2] 2150 GOTO 60 2160 REM-ASR,LSR 2170 GOSUB 2250 2190 X[2]=INT(B/S1) 2200 X[1]=INT(A/S1)+S2*(A<0)+(B-INT(B/S1)*S1)*S2 2210 X[1]=X[1]-(X[1]>32767)*65536. 2220 X[2]=X[2]+S2*(X[2]<0)* NOT L+D 2230 D=0 2240 GOTO 60 2250 A=X[1] 2252 B=X[2] 2254 C=X[P] 2256 L=INT(C/16)-INT(C/32)*2 2258 S=C-INT(C/16)*16 2260 S=S+16*(S=0) 2262 S1=2^S 2264 S2=2^(16-S) 2266 P=P+1 2268 RETURN 2300 REM-LSL,ASL 2310 GOSUB 2250 2315 X[2]=(B-INT(B/S2)*S2)*S1+(INT(A/S2)+S1*(A<0)) 2320 X[1]=(A-INT(A/S2)*S2)*S1+D 2325 X[1]=X[1]-65536.*(X[1]>32767) 2330 D=0 2335 IF L THEN 2350 2340 X[2]=X[2]-65536.*(X[2]>32767) 2345 GOTO 60 2350 X[2]=X[2]-32768.*((X[2]>32767)+(B<0)) 2352 S3=S2/2 MAX 1 2354 O= NOT (S3>B AND B >= 0 OR -S3 <= B AND B<0) 2355 GOTO 60 2400 REM-RRR 2410 GOSUB 2250 2420 D=(A-INT(A/S1)*S1)*S2 2430 D=D-(D>32767)*65536. 2440 GOTO 2190 2450 REM--RRL 2460 GOSUB 2250 2470 D=INT(B/S2)+S1*(B<0) 2480 GOTO 2315 2490 REM--STO 2500 O=1 2510 P=P+1 2520 GOTO 60 2530 REM--CLO 2540 O=0 2550 P=P+1 2560 GOTO 60 2570 REM--SOC 2580 P=P+1+ NOT O 2585 O=O AND I#-486 2590 GOTO 60 2600 REM--SOS 2610 P=P+1+O 2615 O=O AND I#-493 2620 GOTO 60 2630 REM--HLT 2640 GOTO 1135 2660 REM--SHIFT ROTATE GROUP 2670 I1=X[P] 2680 S1=INT(I1/64)-INT(I1/1024)*16 2690 A=X[I+1] 2700 S2=INT(I1/32)-INT(I1/64)*2 2710 S3=INT(I1/8)-INT(I1/16)*2 2720 S4=I1-INT(I1/8)*8+8*(INT(I1/16)-INT(I1/32)*2) 2730 GOSUB S1-7 OF 2790,2810,2830,2850,2880,2900,2940,2990 2740 E=E AND NOT S2 2750 P=P+1+(S3 AND NOT (A-INT(A/2)*2)) 2760 GOSUB S4-7 OF 2790,2810,2830,2850,2880,2900,2940,2990 2770 X[I+1]=A 2780 GOTO 60 2790 A=(A-INT(A/16384)*16384)*2-32768.*(A<0) 2800 RETURN 2810 A=INT(A/2) 2820 RETURN 2830 A=2*A+(A<0)+((2*A<-32768.)-(2*A>32767))*65536. 2840 RETURN 2850 E1=A-INT(A/2)*2 2860 A=INT(A/2)+32768.*(((A<0) AND NOT E1)-((A >= 0) AND E1)) 2870 RETURN 2880 A=(A-INT(A/16384)*16384)*2 2890 RETURN 2900 E1=A-INT(A/2)*2 2910 A=INT(A/2)+32768.*(((A<0) AND NOT E)-((A >= 0) AND E)) 2920 E=E1 2930 RETURN 2940 E1=(A<0) 2950 A=A*2+E 2960 A=A+((A<-32768.)-(A>32767))*65536. 2970 E=E1 2980 RETURN 2990 A=(A-INT(A/4096)*4096)*16+(INT(A/4096)+(A<0)*16) 3000 A=A-65536.*(A>32767) 3010 RETURN 3020 DATA -510,-508,-478,-476,-504,-512,-503,-511 3030 DATA -495,-487,-494,-501,-496 3035 DATA -486,-493 4000 CHAIN "HPEXEC",100 9999 END