10 !      LST
20 ! 8610081830
30 ! L$="DISAS+S" for "DISASB+ "
40 ! **************************************************************************
50 ! *                          HP87  PEEK BINARY                             *
60 ! *                         (C) M.A.Cragg  1984                            *
70 ! *                                                                        *
80 ! **************************************************************************
90 ! * Function OPEEKA(address) returns the address found at the entered addr.*
100 !* Function OPEEKB(address) returns the byte found at the entered address.*
110 !* Function OPEEKC(address) returns a 3 byte address from entered address.*
120 !*~~~~~~~~~~~~~~~~~~~~~~~~~ ALL OCTAL VALUES ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~*
130 !**************************************************************************
140 !* OPEERA(OCTaddr,DECrom#) returns the address found at the entered       *
150 !*                                                    address in ext. ROM *
160 !* OPEERB(OCTaddr,DECrom#) returns the byte found at the entered address  *
170 !*                                                            in ext. ROM *
180 !*~~~~~~~~~~~~~~~~~~ ALL OCTAL VALUES EXCEPT ROM NUMBERS~~~~~~~~~~~~~~~~~~*
190 !*                                                                        *
200 !**************************************************************************
210 !*                          Better in pgms:-                              *
220 !* DPEEKA,DPEEKB and DPEEKC have DEC entry adresses and return DEC values.*
230 !* DPEERA and DPEERB for ext.ROMS ditto                                   *
240 !* DSEERA  "  DSEERA  "   "   "   (Keeps looking until Addr/Byte found.   *
250 !*~~~~~~~~~~~~~~~~~~~~~~~~~ ALL DECIMAL VALUES ~~~~~~~~~~~~~~~~~~~~~~~~~~~*
260 !*                                                                        *
270 !**************************************************************************
280 BPGM#    EQU 214
290          NAM 214,DISASB  
300          DEF RUNTIM  
310          DEF ASCIIS  
320          DEF PARSE   
330          DEF ERMSG   
340          DEF INIT    
350 !**************************
360 PARSE    BYT 0,0
365          DEF SCRATP  
370 !**************************
380 RUNTIM   BYT 0,0
390          DEF SCRAT.  
420          DEF DPA1    
430          DEF DPB2    
440          DEF DPRA3   
450          DEF DPC4    
460          DEF OPA5    
470          DEF OPB6    
480          DEF OPRA7   
490          DEF DPRB8   
500          DEF OPRB9   
510          DEF OPC10   
520          DEF DPRC11  
530          DEF OPRC12  
540          DEF O2TA13  
550          DEF O3TA14  
552          DEF OCT.    
554          DEF DEC.    
556          DEF REL.    
560          DEF MAC.    
565          DEF TRIM.   
566          DEF DSRA20  
567          DEF DSRB21  
570          BYT 377,377
580 !**************************
590 ASCIIS   BSZ 0
600          ASP "SCRATCHBIN"
630          ASP "DPEEKA"            ! (DECaddr.in ROMRAM) returns DECaddr.
640          ASP "DPEEKB"            ! (DECaddr.in ROMRAM) returns DECbyte.
650          ASP "DPEERA"            ! (DECaddr.decROM#) returns DECaddr.
660          ASP "DPEEKC"            ! (DECaddr.in RAM) returns 3byte DECaddr.
670          ASP "OPEEKA"            ! (OCTaddr.in ROMRAM) returns OCTaddr.
680          ASP "OPEEKB"            ! (OCTaddr.In ROMRAM) returns OCTbyte.
690          ASP "OPEERA"            ! (OCTaddr,decROM#) returns OCTaddr.)
700          ASP "DPEERB"            ! (DECaddr,decROM#) returns DECbyte.
710          ASP "OPEERB"            ! (OCTaddr,decROM#) returns OCTbyte.
720          ASP "OPEEKC"            ! (OCTaddr.in RAM) returns 3byte DECaddr.
730          ASP "DPEERC"            ! (DECaddr<decROM#) returns 3byte DECaddr.
740          ASP "OPEERC"            ! (OCTaddr<decROM#) returns 3byte OCTaddr.
750          ASP "O2TOA"             ! Convert  2 OCT bytes to oct address.
760          ASP "O3TOA"             ! Convert  3 OCT bytes to oct address.
762          ASP "OCT"
764          ASP "DEC"
766          ASP "REL"               ! REL(Entry# in BINBAS,OCTaddr)
770          ASP "MAC"
775          ASP "TRIM$"
776          ASP "DSEERA"            ! (Start Addr,Finish Addr,ROM#,Seek Addr)
777          ASP "DSEERB"            ! (Start Addr,Finish Addr,ROM#,Seek Byte)
780          BYT 377
790          ASC "6891 .tcO ht42 mp7"
800 DATE     BSZ 0
810 !**************************
820 ERMSG    BYT 200,200,200,200
830          BYT 200,200,200,200,200
840          ASP "NON-OCTAL ARGUMENT." ! ERROR 246 (DEC)
850          ASP "INVALID TABLE ENTRY" ! ERROR 245
860          BYT 377
870 !**************************
880 INIT     BSZ 0
890          RTN 
900 !**************************
910          BYT 40,55
920 REL.     BIN 
930          LDMD R14,=BINTAB  
940          JSB X14,DEC.            ! Convert Address to DEC
950          POMD R60,-R12           ! POP it
960          JSB =CONINT             ! Convert to binary
970          STM R76,R40             ! Save it
980          JSB =ONEB               ! Get table entry #
990          SBB R46,=1              ! Allow for start
1000          JNG ERR     
1010          CMB R46,=5
1020          JCY ERR     
1030          LLB R46                ! Double for table
1040          ADM R46,=BINBAS        ! Make it absolute
1050          LDMD R46,R46           ! Get Binary Base
1060          ADM R46,R40            ! Add Rel address
1070          LDM R55,R46            ! Load for CONBI3
1080          CLB R57                ! Clear MSB
1090          JSB =CONBI3            ! Convert to FP
1100          PUMD R40,+R12
1110          LDMD R14,=BINTAB  
1120          JSB X14,OCT.    
1130          RTN 
1140 !**************************
1150 ERR      LDB R15,=BPGM#   
1160          STBD R15,=ERRBP#  
1170          JSB =ERROR+  
1180 !**************************
1190          BYT 365
1200 !**************************
1210          BYT 20,55
1220 DPA1     BIN                    ! For DEC address in SYSROM/RAM
1230          LDMD R14,=BINTAB       ! Load binary base address
1240          JSB X14,GET3           ! Do the peek
1250 CLR1B    CLB R57                ! Zero 3rd byte
1260          JMP CONV               ! Convert and output
1270 !**************************
1280 GET3     POMD R60,-R12          ! Pop address into R60-67
1290          JSB =CONINT            ! 16 bit unsigned binary conversion
1300          LDMD R55,R76           ! Load the 3 bytes into R55-57
1310          RTN 
1320 !**************************
1330 CONV     JSB =CONBI3            ! Change data to floating point
1340          PUMD R40,+R12          ! Push onto stack.
1350          RTN                    ! Done
1360 !**************************
1370          BYT 20,55
1380 OPA5     BIN                    ! For OCT address in SYSROM/RAM
1390          LDMD R14,=BINTAB       ! Load binary base address
1400          JSB X14,DEC.           ! Convert to DEC.
1410          JSB X14,DPA1           ! Do the peek
1420          JMP DTO+               ! Convert to OCT
1430 !*************************
1440          BYT 20,55
1450 DPC4     BIN                    ! For DEC 3byte SYSROM/RAMaddr
1460          LDMD R14,=BINTAB       ! Load binary base address
1470          JSB X14,GET3           ! Do the peek
1480          JMP CONV               ! Convert and output
1490 !**************************
1500          BYT 20,55
1510 DPB2     BIN                    ! For DEC byte in SYSROM/RAM
1520          LDMD R14,=BINTAB       ! Load binary base address
1530          JSB X14,GET3           ! Do the peek
1540 CLR2B    CLM R56                ! Zero 2 bytes
1550          JMP CONV               ! Convert and output
1560 !**************************
1570          BYT 20,55
1580 OPB6     BIN                    ! For OCT byte in SYSROM/RAM
1590          LDMD R14,=BINTAB       ! Load binary base address
1600          JSB X14,DEC.           ! Convert to DEC
1610          JSB X14,DPB2           ! Do the peek
1620 DTO+     JMP DTO                ! Convert to OCT and output
1630 !**************************
1640          BYT 40,55
1650 DPRA3    BIN                    ! For DEC address in external ROM
1660          LDMD R14,=BINTAB       ! Load binary base address
1670          JSB X14,ROMGET         ! Do the seek
1680          JMP CLR1B              ! Rest already coded
1690 !**************************
1700 CONV+    JMP CONV    
1710 ROMGET   BIN 
1720          JSB =ONEB              ! Get ROM#
1730          LDB R75,R76            ! Save it in R75
1740          POMD R60,-R12          ! Pop address into R60-67
1750          JSB =CONINT            ! 16 bit unsigned conversion
1760          STBD R75,=RSELEC       ! Select ROM
1770          LDMD R55,R76           ! Get 3 bytes from ROM
1780          CLB R75                !
1790          STBD R75,=RSELEC       ! Reselect SYSROM
1800          RTN 
1810 !**************************
1820          BYT 40,55
1830 OPRA7    BIN                    ! For OCT address in external ROM
1840          LDMD R14,=BINTAB       ! Load binary base address
1850          JSB X14,CONROM         ! Convert to DEC
1860          JSB X14,DPRA3          ! Do the peek
1870          JMP DTO                ! Convert to OCT
1880 ! ************************
1890 CONROM   POMD R70,-R12          ! Pop the ROM#
1900          PUMD R70,+R6           ! Save it on R6 stack
1910          JSB X14,DEC.           ! Convert the address to DEC
1920          POMD R70,-R6           ! Pop the ROM#
1930          PUMD R70,+R12          ! Push it back onto R12 stack
1940          RTN 
1950 ! ************************
1960 DTO      JSB X14,OCT.           ! Convert to OCT
1970          RTN 
1980 !**************************
1990          BYT 40,55
2000 DPRB8    BIN                    ! For DEC byte in external ROM
2010          LDMD R14,=BINTAB       ! Load binary base address
2020          JSB X14,ROMGET         ! Get 3 bytes
2030          JMP CLR2B              ! Rest already coded
2040 !*************************
2050          BYT 40,55
2060 OPRB9    BIN 
2070          LDMD R14,=BINTAB       ! Load binary base address
2080          JSB X14,CONROM         ! Convert incoming address to DEC
2090          JSB X14,DPRB8          ! Do the peek
2100 DTO++    JMP DTO                ! Convert to OCT and output
2110 !*************************
2120          BYT 20,55
2130 OPC10    BIN                    ! For OCT 3 byte SYSROM/RAM addr.
2140          LDMD R14,=BINTAB       ! Load binary base address
2150          JSB X14,DEC.           ! Convert to DEC
2160          JSB X14,DPC4           ! Do the peek
2170          JMP DTO                ! Convert to OCT and output
2180 !*************************
2190          BYT 40,55
2200 DPRC11   BIN                    ! For DEC 3 byte ROM addr.
2210          LDMD R14,=BINTAB       ! Load binary base address
2220          JSB X14,ROMGET         ! Do the peek
2230 CONV++   JMP CONV+              ! Rest already coded
2240 !*************************
2250          BYT 40,55
2260 OPRC12   BIN                    ! For OCT 3 byte ROM addr.
2270          LDMD R14,=BINTAB       ! Load binary base address
2280          JSB X14,CONROM         ! Convert to DEC
2290          JSB X14,DPRC11         ! Do the peek
2300 DTO-     JMP DTO                ! Convert to OCT and output
2310 !*************************
2320          BYT 0,60,55
2330 O3TA14   BIN                    ! Convert 3 bytes to OCT address
2340          LDMD R14,=BINTAB       ! Load binary base address
2350          JSB X14,DEC.           ! Convert 1st byte to DEC
2360          JSB =ONEB              ! Convert to 15 bit binary
2370          STB R76,R31            ! Save MSByte
2380 O3+      JSB X14,DEC.           ! Convert 2nd byte to DEC
2390          JSB =ONEB              ! Convert to 15 bit binary
2400          STB R76,R30            ! Save 2nd Byte
2410          JSB X14,DEC.           ! Convert 3rd byte to DEC
2420          JSB =ONEB              ! Convert to 15 bit binary
2430          STB R76,R55            ! Save 3rd Byte
2440          LDM R56,R30            ! Recover 2 bytes from R14 stack
2450          LDMD R14,=BINTAB       ! Load binary base address
2460          JSB X14,CONV           ! Convert address
2470          JMP DTO-               ! Convert address to OCT
2480 !*************************
2490          BYT 40,55
2500 O2TA13   BIN                    ! Convert 2 bytes to OCT address
2510          CLB R31                ! Zero msbyte
2520          LDMD R14,=BINTAB       ! Load binary base address
2530          JMP O3+                ! Rest is done
2540 !*************************
2550 !
2560 ! ***********************************************************
2570          BYT 20,55
2580 DEC.     LDMD R14,=BINTAB  
2590          JSB X14,JL63           !
2600          LDM R36,R20
2610          CMM R36,R34
2620          JCY JL64               ! +6
2630 JL70     JSB =ERROR+  
2640          BYT 13                 ! ERROR 11
2650 ! ---------------------
2660 JL64     LLM R52
2670          CLM R62
2680          ELB R62
2690          CMB R62,=10
2700          JNC JL65               ! +6
2710          LDB R15,=BPGM#   
2720          STBD R15,=ERRBP#  
2730          JSB =ERROR+  
2740          BYT 366                ! ERROR 246
2750 ! ---------------------
2760 JL65     ADM R42,R62
2770          TSB R34
2780          JZR JL66               ! +12
2790          DCB R34
2800          ADM R42,R42
2810          ADM R42,R42
2820          ADM R42,R42
2830          JMP JL64               ! -32
2840 ! ---------------------
2850 JL66     JSB =LAB67   
2860          JSB =LAB68   
2865          LDMD R14,=BINTAB  
2870          RTN 
2880 ! ********************************************************
2890          BYT 20,55
2900 OCT.     LDMD R14,=BINTAB  
2910          JSB X14,JL63           !
2920          LDM R36,R34
2930          CMM R36,=020,000
2940          JNC JL69               ! +14
2950          JNZ JL70               ! -71
2960          CMMD R52,=LAB71   
2970          JZR JL69               ! +4
2980          JCY JL70               ! -101
2990 JL69     TCM R36
3000          LDB R47,=3
3010          JSB =LAB72   
3020          ADM R50,R40
3030          LDM R36,=011,000
3040          LDM R42,=000,222,105,223,211,205
3050          CLB R33
3060          JSB =LAB4    
3070          CLM R50
3080          ARP R40
3090 JL74     CLE 
3100          TSB R37
3110          JLN JL73               ! +4
3120          LLM R40
3130 JL73     ELM R52
3140          LRM R47
3150          ICM R36
3160          ADM R40,R40
3170          ADM R40,R40
3180          ADM R40,R40
3190          DCB R20
3200          JCY JL74               ! -23
3210          STM R50,R40
3220          LDM R36,=021,000
3230          JMP JL66               ! -135
3240 ! --------------------
3250 JL63     JSB =LAB75   
3260          TSM R50
3270          JNZ JL77               ! +7
3280          LDM R4,=201,133        ! GTO 55602
3290 ! ------------------------
3300 JL78     LLM R50
3310 JL77     JLZ JL78               ! -1
3320          LDM R20,=021,000
3330          RTN 
3340 ! ***********************************************************
3350 LAB71    BYT 120,163,166,224,161,150
3360 ! ***********************************************************
3370          BYT 0,56
3380 MAC.     BIN 
3390          LDM R43,=18D,0
3400          DEF DATE    
3410          BYT 0
3420          ADMD R45,=BINTAB  
3430          PUMD R43,+R12
3440          RTN 
3450 ! ***********************************************************
3460 ERROR+   DAD 10220
3470 ERROR    DAD 10224
3480 ERRBP#   DAD 103371
3490 LAB4     DAD 52471
3500 LAB67    DAD 52474
3510 LAB68    DAD 54676
3520 LAB72    DAD 77756
3530 LAB75    DAD 54535
3540 ONEB     DAD 12153
3550 CONBI3   DAD 4516
3560 CONBIN   DAD 4401
3570 ADDROI   DAD 52745
3580 BINTAB   DAD 104070
3590 RSELEC   DAD 177430
3600 GEQ      DAD 62734
3610 SUBROI   DAD 52724
3620 CONINT   DAD 45116
3630 BINBAS   DAD 104073
3640          LNK SCRATS-