    1 FMT  ("12009A HP-IB INTERFACE DIAGNOSTIC"/) 
    2 REM  (C) COPYRIGHT HEWLETT-PACKARD CO. ALL RIGHTS RESERVED
    3 REM  SERVICE #24397-16009 REV. 2001 
    4 PRNT 1  
    5 GOSB 880  
    6 GTSC @4000 Z  
    7 CLCC 0  
    8 OTAC @2 Z 
    9 BUF   
   10 BUF  P(64) Q(8) R(64) 
   11 REM  REG 31 CHECK 
   12 LET  P(1)=@125252,@52524,0,@177776  
   14 LET  A=1  
   16 OTA  @31 P(A) 
   18 LIA  @31 C  
   20 SKIF P(A)=C 
   22 GOSB 700  
   23 REM  CARD BUS & DMA CHECK 
   24 LET  A=A+1  
   26 SKIF A=5  
   27 GOTO 16 
   30 OTA  @31 @177777  
   32 LIA  @31 C  
   34 SKIF C=0  
   35 GOSB 705  
   36 OTA  @31 @177776  
   38 GOSB 801  
   41 LIA  @31 C  
   42 SKIF C=0  
   43 GOSB 705  
   45 LET  D=0  
   46 GOSB 805  
   47 STCC @30  
   48 LIA  @30 C  
   49 SKIF D=C.@1777  
   50 GOSB 710  
   51 LET  D=D+1  
   52 SKIF D>@1777  
   53 GOTO 46 
   54 LET  D=@60003 
   55 GOSB 805  
   56 LET  Q(1)=@165000,@2000,P(!),-2 
   57 LET  Q(5)=@61200,@2000,P(!)+1,-2  
   58 GOSB 820  
   60 GOSB 825  
   61 GOSB 740  
   62 SKIF P(1)=P(2)  
   63 GOSB 740  
   64 GOSB 810  
   65 OTA  @31 1  
   66 LET  P(1)=P(1)*-1-1 
   67 SKIF P(1)<0 
   68 GOTO 56 
   70 REM  PHI CHIP/HP-IB CARD CHECK
   72 GOSB 801  
   74 LET  P(1)=@40125,@50252,@10201,@30177,@70140  
   76 LET  P(6)=@20100  
   78 LET  Q(1)=@41000,0,P(!),-6  
   80 GOSB 820  
   82 GOSB 825  
   83 GOSB 725  
   91 LET  C=0  
   92 OTA  @31 @120000  
   94 GOSB 815  
   98 LET  D=D.@120004  
  100 SKIF D=@120004  
  102 GOTO 120  
  104 OTA  @30 @100000  
  106 STCC @30  
  108 LIA  @30 A  
  110 LET  C=C+1  
  112 SKIF C>8  
  114 GOTO 92 
  116 GOSB 725  
  120 OTA  @31 0  
  122 LET  P(1)=@70040,@10220,@20211  
  124 LET  Q(4)=-3  
  126 GOSB 810  
  130 GOSB 820  
  133 GOSB 825  
  134 GOSB 725  
  137 OTA  @31 @120000  
  138 GOSB 815  
  140 GOSB 810  
  141 LET  D=D.@120377  
  142 SKIF D=@120012  
  144 GOSB 725  
  146 LET  P(1)=@10100,@60042,@31114,@21777,@537  
  147 LET  P(6)=@477,@536,@476,8,2  
  148 LET  P(11)=@125,@252,@377,0,@1010 
  149 LET  Q(4)=-15 
  151 OTA  @31 1  
  152 GOSB 820  
  156 GOSB 825  
  157 GOSB 725  
  160 DLY  1000 
  162 OTA  @31 @120000  
  164 GOSB 815  
  166 SKIF @14=D.@14  
  167 GOSB 725  
  168 LIA  @32 B  
  170 SKIF @4400=B.@177400  
  171 GOSB 725  
  178 LET  D=@60040 
  179 GOSB 805  
  180 IBP  R(1) R(15)  CL 
  182 LET  Q(1)=@51200,@101604,R(!),-15 
  184 GOSB 810  
  186 GOSB 820  
  190 GOSB 825  
  191 GOSB 725  
  196 SKIF Q(4)=-4  
  197 GOSB 725  
  200 CPBF P(5) R(1) 11 @177600 
  201 GOSB 725  
  202 SKIF @200=R(1).R(2).R(9).@200 
  203 GOSB 725  
  204 SKIF @101410=R(11)  
  205 GOSB 725  
  206 LIA  @32 B  
  207 SKIF @24000=B.@177400 
  208 GOSB 725  
  210 GOSB 815  
  212 LIA  @32 B  
  214 SKIF @4000=B.@177400  
  215 GOSB 725  
  216 OTA  @31 1  
  217 GOSB 810  
  218 LET  D=@60042 
  219 GOSB 805  
  220 LET  P(15)=8,9,10,11,12 
  221 LET  P(20)=13,14,15 
  222 LET  P(3)=@31100  
  223 OTA  @31 @104 
  224 LET  Q(1)=@51000,@104,P(!),-22  
  225 CLF  @30  
  226 GOSB 820  
  230 WFI  Z 3000 
  231 GOSB 725  
  232 SFC  @20  
  233 GOSB 725  
  234 SFS  @30  
  235 GOSB 725  
  236 LIA  @32 B  
  237 SKIF @6400=B.@177400  
  238 GOSB 725  
  239 CLCC @23  
  240 LIA  @23 B  
  242 SKIF B=-22  
  243 GOSB 725  
  244 OTA  @31 @120000  
  245 GOSB 815  
  246 SKIF D=@121110  
  247 GOSB 725  
  248 OTA  @31 1  
  251 LET  D=@21777 
  252 GOSB 805  
  254 LET  D=@60040 
  256 GOSB 805  
  258 CLF  @30  
  260 LET  Q(2)=4 
  261 GOSB 820  
  264 WFI  Z 3000 
  265 GOSB 725  
  266 SFC  @20  
  267 GOSB 725  
  268 LIA  @23 B  
  269 SKIF B=-1 
  270 GOSB 725  
  272 SFS  @30  
  273 GOSB 725  
  274 GOSB 810  
  275 OTA  @31 @120000  
  276 GOSB 815  
  277 SKIF D=@120000  
  278 GOSB 725  
  279 GOSB 810  
  280 LET  D=@60040 
  281 GOSB 805  
  282 IBP  R(1) R(32)  CL 
  283 LET  Q(1)=@51200,@100604,R(!),-30 
  284 CLF  @30  
  285 GOSB 820  
  287 DLY  1000 
  288 GOSB 810  
  289 LIA  @23 B  
  290 SKIF B=-14  
  291 GOSB 725  
  292 OTA  @31 @120000  
  293 GOSB 815  
  294 SKIF D=@121100  
  295 GOSB 725  
  296 OTA  @31 0  
  297 LET  D=@60040 
  298 GOSB 805  
  299 CLF  @30  
  300 LET  Q(2)=@105614,R(!),-8 
  301 IBP  R(1) R(8)  CL  
  302 GOSB 850  
  303 GOSB 725  
  304 GOSB 825  
  305 GOSB 725  
  310 IBP  R(20) R(28)  CL  
  311 CPBF R(1) R(20) 8 @100000 
  312 GOSB 725  
  313 GOSB 810  
  315 OTA  @31 4  
  320 LET  D=@31200 
  322 GOSB 805  
  324 LET  D=@21777 
  325 GOSB 805  
  326 CLF  @30  
  328 SFC  @30  
  329 GOSB 725  
  330 LET  D=@60062 
  332 GOSB 805  
  334 SFS  @30  
  335 GOSB 725  
  336 OTA  @31 @120000  
  337 GOSB 815  
  338 SKIF D=@121200  
  339 GOSB 725  
  340 LET  P(9)=@574  
  341 LET  Q(1)=@51000,0,P(!),-9  
  342 GOSB 810  
  343 GOSB 820  
  345 GOSB 825  
  346 GOSB 725  
  349 GOSB 810  
  350 IBP  R(1) R(8)  CL  
  351 CLF  @30  
  352 LET  Q(1)=@51200,@100604,R(!),-8  
  353 OTA  @31 0  
  354 LET  D=@60040 
  355 GOSB 805  
  356 GOSB 820  
  357 CLF  @30  
  358 GOSB 825  
  359 GOSB 725  
  362 SFS  @30  
  363 GOSB 725  
  364 SKIF Q(4)=-7  
  365 GOSB 725  
  366 LIA  @32 B  
  367 SKIF @10000=B.@177400 
  368 GOSB 725  
  370 OTA  @32 0  
  371 LIA  @32 B  
  372 SKIF 0=B.@177400  
  373 GOSB 725  
  374 LET  P(9)=@410  
  375 LET  Q(1)=@51000,4,P(!),-9  
  376 CLF  @30  
  377 OTA  @31 @100000  
  378 GOSB 815  
  379 GOSB 810  
  380 GOSB 820  
  381 GOSB 825  
  382 GOSB 725  
  384 SFS  @30  
  385 GOSB 725  
  386 LIA  @32 B  
  387 SKIF @40400=B.@177400 
  388 GOSB 725  
  389 LIA  @32 B  
  390 SKIF @400=B.@177400 
  391 GOSB 725  
  392 OTA  @31 0  
  393 LET  D=@60052 
  394 GOSB 805  
  395 LET  D=@70140 
  396 GOSB 805  
  397 LET  G=@121040  
  398 LET  P(9)=@40377,@50000,@405,@550 
  399 LET  P(2)=@60052,@31040 
  400 LET  Q(1)=@51000,@4,P(!),-12  
  402 CLF  @30  
  403 GOSB 820  
  404 GOSB 825  
  405 GOSB 725  
  410 SFS  @30  
  411 GOSB 725  
  412 LET  E=@550 
  413 LET  F=1  
  414 OTA  @31 @120000  
  415 GOSB 815  
  416 SKIF D=G  
  417 GOSB 725  
  418 OTA  @31 0  
  419 LET  D=E  
  420 GOSB 805  
  421 OTA  @31 @100000  
  422 GOSB 815  
  423 SKIF D=@100000+F  
  424 GOSB 725  
  425 LET  E=E+1  
  426 LET  F=F*2  
  427 SKIF E=@560 
  428 GOTO 414  
  429 SKIF F#0  
  430 GOTO 440  
  432 LET  F=0  
  433 OTA  @31 0  
  434 LET  D=@40000 
  435 GOSB 805  
  436 LET  G=@120000  
  437 LET  E=@550 
  438 GOTO 414  
  440 LET  D=@60042 
  441 GOSB 805  
  442 LET  P(1)=@57477,@57076,@76160  
  443 LET  Q(1)=@71000,@2400,P(!),-6  
  444 CLF  @30  
  445 GOSB 810  
  446 GOSB 820  
  447 GOSB 825  
  448 GOSB 725  
  450 LET  Q(2)=@3002,P(!),-8 
  451 LET  P(1)=@125252,@177777,@52525,0  
  452 GOSB 810  
  453 GOSB 820  
  454 GOSB 825  
  455 GOTO 457  
  456 GOSB 725  
  457 GOSB 810  
  458 LIA  @23 C  
  459 SKIF C=0  
  460 GOSB 725  
  462 OTA  @31 1  
  464 LET  R(1)=@21000  
  465 LET  Q(2)=@62000,R(!),-1  
  466 GOSB 810  
  467 GOSB 820  
  468 GOSB 825  
  469 GOSB 725  
  472 IBP  R(1) R(10)  CL 
  474 LET  Q(1)=@71200,@103000,R(!),-12 
  476 GOSB 810  
  477 GOSB 820  
  478 GOSB 825  
  479 GOSB 725  
  482 SKIF Q(4)=-2  
  483 GOSB 725  
  484 CPBF P(1) R(2) 4 0  
  485 GOSB 725  
  486 OTA  @31 1  
  487 LET  D=@60042 
  488 GOSB 805  
  490 LET  P(1)=@57477  
  492 LET  Q(1)=@71000,@2402,P(!),-2  
  493 REM  ON-LINE TEST 
  494 LET  D=@70200 
  496 GOSB 805  
  498 OTA  @31 @110000  
  499 GOSB 815  
  500 SKIF @10=D.@10  
  501 GOTO 795  
  502 SKIF D=@110310  
  503 GOSB 730  
  504 OTA  @31 0  
  506 LET  D=@31200 
  507 GOSB 805  
  508 LET  D=@21777 
  509 GOSB 805  
  510 SFC  @30  
  511 GOSB 725  
  512 LET  D=@60062 
  513 GOSB 805  
  514 DLY  100  
  516 LET  D=@60042 
  517 GOSB 805  
  518 SFC  @30  
  519 GOSB 730  
  520 OTA  @31 4  
  521 SFS  @30  
  522 GOSB 730  
  523 OTA  @31 @120000  
  524 GOSB 815  
  525 SKIF D=@121200  
  526 GOSB 730  
  527 OTA  @31 @110000  
  528 GOSB 815  
  530 SKIF D=@110230  
  531 GOSB 730  
  532 OTA  @31 0  
  533 LET  D=@70000 
  534 GOSB 805  
  535 LET  D=@70200 
  536 GOSB 805  
  537 LET  D=@60046 
  538 GOSB 805  
  539 SFC  @30  
  540 GOSB 730  
  541 OTA  @31 @24  
  542 SFS  @30  
  543 GOSB 730  
  544 LIA  @32 B  
  545 SKIF @1400=B.@177400  
  546 GOSB 730  
  547 LET  D=@60042 
  548 GOSB 805  
  549 LIA  @32 B  
  550 SKIF @400=B.@177400 
  551 GOSB 730  
  552 CLF  @30  
  553 LET  D=@30777 
  554 GOSB 805  
  555 LET  D=@60062 
  556 GOSB 805  
  557 LET  D=@60042 
  558 GOSB 805  
  559 CLF  @30  
  560 SFC  @30  
  561 GOSB 725  
  562 GOSB 810  
  563 GOSB 820  
  564 GOSB 825  
  565 GOSB 730  
  568 LIA  @32 B  
  569 SKIF @100400=B.@177400  
  570 GOSB 730  
  572 LET  H=0  
  574 LET  P=-1 
  575 LET  P(1)=@31004,@21777 
  576 LET  Q(1)=@51000,0,P(!),-2  
  577 GOSB 810  
  578 GOSB 820  
  579 GOSB 825  
  580 GOSB 730  
  583 LET  P(1)=@476,@537 
  585 LET  P=P+1  
  586 LET  D=@60063 
  587 GOSB 805  
  588 LET  D=@60042 
  589 GOSB 805  
  590 LET  P(3)=P+@540  
  591 SKIF P#@10  
  592 GOTO 900  
  599 REM  INTERACTIVE TEST 
  600 OTA  @31 0  
  601 LET  P(4)=@1002,@60040  
  602 LET  Q(4)=-5  
  603 GOSB 810  
  604 GOSB 820  
  605 GOSB 825  
  606 GOSB 730  
  609 OTA  @31 4  
  610 SFS  @30  
  611 GOTO 575  
  612 OTA  @31 @120000  
  613 GOSB 815  
  614 SKIF D=@121004  
  615 GOSB 730  
  616 OTA  @31 @100000  
  617 GOSB 815  
  618 LET  C=D.@377*@400  
  619 GOSB 815  
  620 LET  C=D.@377+C 
  621 PRNT 1220 P C 
  622 SKIF 0=C.@177400  
  623 GOTO 575  
  628 GOSB 750  
  629 GOTO 575  
  630 PRNT 1040 P 
  631 LET  H=1  
  632 LET  P=P(3) 
  633 LET  P(1)=@537,@477,@536  
  634 LET  P(4)=P.@477  
  635 LET  P(5)=@576  
  636 IBP  P(6) P(15)  R1 
  637 IBP  P(14) P(22)  IN  
  638 LET  P(22)=P(22)+@1000  
  639 LET  P(23)=@477,@537,@476 
  640 LET  P(26)=P.@537 
  641 LET  P(27)=@576,@1020,@537,@477,@60040  
  642 OTA  @31 0  
  643 LET  P(14)=@252,@125  
  644 LET  D=@60042 
  645 GOSB 805  
  646 LET  Q(1)=@51000,@1400,P(!),-31 
  648 GOSB 810  
  649 GOSB 820  
  650 GOSB 825  
  651 GOSB 735  
  654 LET  Q(1)=@51200,@101000,R(!),-16 
  655 IBP  R(1) R(20)  CL 
  656 GOSB 810  
  657 GOSB 820  
  658 GOSB 825  
  659 GOSB 735  
  662 CPBF P(6) R(1) 16 @177400 
  663 GOSB 735  
  664 SKIF @1000=R(16).@1000  
  665 GOSB 735  
  666 OTA  @31 0  
  667 CLF  @30  
  668 LET  P=P.@7 
  669 SKIF P=@7 
  670 GOTO 575  
  672 GOTO 900  
  700 PRNT 1010 
  702 STF  @2 
  704 STOP  
  705 PRNT 1011 
  706 GOTO 702  
  710 PRNT 1020 
  711 GOTO 702  
  715 PRNT 1020 
  716 GOTO 702  
  725 PRNT 1030 
  726 GOTO 702  
  730 PRNT 1035 
  732 GOTO 702  
  735 PRNT 1060 
  736 GOTO 702  
  740 PRNT 1021 
  742 GOTO 702  
  745 PRNT 1111 
  746 GOTO 702  
  750 SKIF D#@101403  
  751 RTN  1  
  752 SKIF D#@101601  
  753 RTN  1  
  754 SKIF D#@101401  
  755 RTN  1  
  756 SKIF D#@101604  
  757 RTN  1  
  770 RTN   
  795 PRNT 1099 
  796 PRNT 1098 
  797 GOTO 6  
  800 REM  SUBROUTINES
  801 CLCC 0  
  802 OTAC @2 Z 
  803 RTN   
  805 OTAC @30 D  
  806 STCC @30  
  807 RTN   
  810 CLCC @23  
  811 CLCC @21  
  812 RTN   
  815 STCC @30  
  816 LIAC @30 D  
  817 RTN   
  820 OTAC @20 Q(!) 
  821 STCC @20  
  822 RTN   
  825 WFI  Z 2000 
  826 RTN   
  827 SFS  @20  
  828 RTN   
  829 RTN  1  
  850 OTA  @31 0  
  851 LET  D=@30777 
  852 GOSB 805  
  853 GOSB 820  
  854 GOSB 825  
  855 GOTO 857  
  856 RTN   
  857 GOSB 810  
  858 LET  D=@31100 
  859 GOSB 805  
  860 GOSB 820  
  861 RTN  1  
  870 LET  A=0  
  871 SFC  @20  
  872 RTN  1  
  873 LET  A=A+1  
  874 SKIF A=1000 
  875 GOTO 871  
  876 RTN   
  880 LET  X=0  
  881 LET  Y=0  
  882 LET  Z=0  
  883 RTN   
  900 SKIF H=1  
  901 PRNT 1050 
  948 OTAC @2 Z 
  950 LIA  @32 B  
  952 SKIF @201=B.@377  
  953 GOTO 6  
  954 LET  X=Y  
  955 LET  Y=Z  
  956 SKIF X#0  
  957 GOTO 6  
  982 SKIF X#Y  
  983 GOTO 6  
 1010 FMT  ("ERROR - CONTROL REGISTER CHECK"/)
 1011 FMT  ("ERROR - CARD RESET"/)
 1020 FMT  ("ERROR - CARD BUS CHECK"/)
 1021 FMT  ("ERROR - DMA CHECK"/) 
 1030 FMT  ("ERROR - PHI CHIP/HP-IB CARD FAILURE"/) 
 1035 FMT  ("ERROR - ON-LINE TEST FAILURE"/)
 1040 FMT  ("DISC CONTROLLER LOOPBACK TEST ON HP-IB ADDR. "I1/) 
 1050 FMT  ("NO HP-IB DISCS FOUND"/)
 1060 FMT  ("ERROR - HP-IB INTERACTIVE TEST FAILURE"/)
 1098 FMT  ("ON-LINE TEST NOT EXECUTED"/) 
 1099 FMT  ("CARD NOT SYSTEM CONTROLLER"/)
 1100 FMT  ("CARD-CARD TEST: SELECT CODES ",K2) 
 1101 FMT  (" AND ",K2/)
 1102 FMT  ("PASS COMPLETE"/) 
 1111 FMT  ("ERROR -  CARD-CARD TEST FAILURE"/) 
 1220 FMT  ("ADDR. "I1" IDENTIFIES WITH "K6" OCTAL"/) 
 1999 PRNT 1102 
 2000 REM  CARD-CARD TEST 
 2001 PRNT 1100 X 
 2002 PRNT 1101 Y 
 2003 LET  F=0  
 2004 CLCC 0  
 2005 IBP  R(1) R(64)  CL 
 2006 LET  P(1)=@537,@477,@536,@440 
 2008 IBP  P(5) P(12)  R1 
 2010 LET  P(13)=@252,@125,@377,@1000,@537  
 2011 LET  P(18)=@477 
 2012 OTAC @2 X 
 2014 LET  D=@70200 
 2016 GOSB 805  
 2018 LET  D=@60062 
 2020 GOSB 805  
 2022 LET  D=@60042 
 2024 GOSB 805  
 2030 OTAC @2 Y 
 2032 LET  D=@70200 
 2034 GOSB 805  
 2038 LET  Q(1)=@41000,@0,P(!),-18  
 2040 LET  Q(5)=@51200,@101000,R(!),-16 
 2042 LET  Q=Q(!)+4 
 2044 OTAC @20 Q  
 2046 STCC @20  
 2048 OTAC @2 X 
 2050 OTAC @20 Q(!) 
 2052 STCC @20  
 2054 OTAC @2 X 
 2058 GOSB 870  
 2061 GOSB 745  
 2062 OTAC @2 Y 
 2066 GOSB 870  
 2069 GOSB 745  
 2070 SKIF Q(8)=-4  
 2071 GOSB 745  
 2072 CPBF P(5) R(1) 12 @177400 
 2073 GOSB 745  
 2080 OTAC @2 X 
 2082 GOSB 805  
 2084 LET  D=@40200 
 2086 GOSB 805  
 2088 OTAC @2 Y 
 2090 LET  D=@60010 
 2092 GOSB 805  
 2094 OTAC @2 X 
 2096 OTA  @31 @100000  
 2098 GOSB 815  
 2100 SKIF @200=D.@200  
 2101 GOSB 745  
 2110 OTAC @2 Y 
 2112 LET  D=@60004 
 2114 GOSB 805  
 2116 OTAC @2 X 
 2118 LIA  @32 B  
 2120 SKIF @1000=B.@1000  
 2121 GOSB 745  
 2128 LET  R(1)=@537,@477,@430,@476,@500  
 2130 LET  R(6)=@1,@431,@537,@477 
 2132 LET  Q(1)=@41000,@0,R(!),-9 
 2134 OTAC @20 Q(!) 
 2136 STCC @20  
 2138 GOSB 870  
 2140 GOSB 745  
 2142 OTA  @31 @100000  
 2144 GOSB 815  
 2146 SKIF @1100=D.@1777  
 2147 GOSB 745  
 2150 CLCC 0  
 2152 OTAC @2 X 
 2154 LET  D=@70200 
 2156 GOSB 805  
 2158 LET  D=@60062 
 2160 GOSB 805  
 2162 LET  D=@60002 
 2164 GOSB 805  
 2166 OTAC @2 Y 
 2168 LET  D=@70200 
 2170 GOSB 805  
 2172 LET  D=@60042 
 2174 GOSB 805  
 2230 OTAC @2 X 
 2232 LET  P(3)=@476,@500,@13 
 2234 LET  Q(1)=@41000,@0,P(!),-5 
 2235 OTA  @31 1  
 2236 OTAC @20 Q(!) 
 2238 STCC @20  
 2240 WFI  X 2000 
 2241 GOSB 745  
 2242 LET  Q(1)=@51200,@101000,R(!),-18 
 2243 IBP  R(1) R(18)  CL 
 2244 LET  Q(5)=@41000,@0,P(!)+5,-11  
 2246 LET  D=@60040 
 2248 GOSB 805  
 2250 LET  D=@21004 
 2252 GOSB 805  
 2254 OTAC @20 Q(!) 
 2256 STCC @20  
 2258 OTAC @2 Y 
 2260 LET  Q=Q(!)+4 
 2262 OTAC @20 Q  
 2264 STCC @20  
 2268 GOSB 870  
 2271 GOSB 745  
 2272 OTAC @2 X 
 2276 GOSB 870  
 2278 GOSB 745  
 2280 CPBF P(6) R(1) 11 @177400 
 2282 GOSB 745  
 2300 LET  A=X  
 2302 LET  X=Y  
 2303 LET  Y=A  
 2304 SKIF F=0  
 2305 GOTO 6  
 2306 LET  F=1  
 2307 GOTO 2004 
 3000 PRGM A PHI REGISTER ACCESS
 3001 LET  Z=0  
 3002 GTSC @4000 Z  
 3003 GOSB 800  
 3005 PRNT 3098 
 3006 INPT $M @N  
 3007 SKIF M#$S 
 3008 GOTO 3002 
 3009 SKIF M=$W 
 3010 GOTO 3030 
 3011 PRNT 3097 
 3012 INPT @O 
 3014 SKIF O=>0 
 3015 GOTO 3005 
 3016 OTA  @31 0  
 3017 LET  O=O.@1777  
 3018 LET  D=N*4096+O 
 3020 GOSB 805  
 3022 SKIF N#0  
 3023 GOTO 3011 
 3030 LET  X=N*4096+@100000 
 3032 OTA  @31 X  
 3034 GOSB 815  
 3036 LET  D=D.@1777  
 3038 PRNT 3096 N D 
 3040 SKIF N=0  
 3042 GOTO 3005 
 3044 PRNT 3095 
 3045 YES? 3030 
 3046 GOTO 3005 
 3095 FMT  ("AGAIN? ")
 3096 FMT  ("REGISTER "I1" = "K4" OCTAL"/)
 3097 FMT  ("DATA? -1 TO END ENTRY: ")
 3098 FMT  ("R/W/S REGISTER? ") 
                                                                                                                            