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)<C THEN 1760
1757  GOTO 60
1760  FOR J=1 TO 16
1770  B=B*2+(A>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 
