ASMB,R,B,L,C
      HED 2313B VERIF -- CODE PROCEDURES  8/22/73 
* 
* 
* THIS ASSEMBLY LANGUAGE PROGRAM
*    CONTAINS 12 CODE PROCEDURES USED 
*    BY THE 2313B VERIFICATION PROGRAM. 
* 
*    IT ALSO CONTAINS A PROGRAM FOR CONFIGURING 
*    AND A NUMBER OF SERVICE SUB-ROUTINES USED
*    BY THE PROCEDURES
* 
*  THE DIFFERENT PROCEDURES ARE IDENTIFIED
*    BY THEIR ENTRY POINTS. 
* 
*      1. ADDR  - FORMS ADDRESSES FOR 2313B CALL
*      2. INTRP - COMMAND INTERPRETER 
*      3. CNVRT - CONVERTS DATA TO VOLTAGE
*      4. DESCR - PRINTS INSTRUCTIONS 
*      5. EXIT  - SET-UP AND CHECK FOR ESCAPE 
*      6. DELAY - DELAYS FOR SPECIFIED TIME (MSEC)
*      7. ISSUE - SET UP OR CLEAR SS/H TEST 
*      8. HISTO - HISTOGRAM ROUTINE 
*      9. DSPLY - REGISTER DISPLAY ROUTINE
*     10. STATP - COMPUTES AVG, P-P, HIGH, LOW, & RMS 
*     11. INTER - INTERLACE LLMPX CARDS 
*     12. CNFGR - RECONFIGURE BCS AND CONFIGURE DSPLY/HISTO 
*     13. READX - READS FROM TTY OR PHOTOREADER WITH ENTRY
*                 POINTS: READ1, READ2, READ3, READ4, READR 
*     14. GNCHK - CHECKS AND CONVERTS LLMPX GAINS 
* 
* 
      NAM CODES 
      ENT ADDR,INTRP,CNVRT,DESCR,STATP,INTER,DSPLY
      ENT HISTO,EXIT,CNFGR,DELAY,GONLY,ISSUE
      ENT READ4,READ1,READ3,READ2,READR,GNCHK 
      EXT .IOC.,.DIO.,.IOI.,.SQT.,SQRT,.IOR.
      EXT FLOAT,.FDV,.DTA.,.ENTR,.RTOI,.IAR.
      SUP 
      HED 2313B VERIF -- CODE PROCEDURES -- ADDR  8/22/73 
**********************************************
*                                            *
*  ADDR -- FORMS ADDRESSES FOR CALL TO 2313  *
*                                            *
**********************************************
      SPC 1 
*  THE BOX, CARD, AND CHANNEL ARE COMBINED
*  TO FORM THE 2313B MULTIPLEXER ADDRESS. 
* 
      SPC 2 
BOX   NOP 
CARD  NOP 
CHAN  NOP 
      SPC 1 
ADDR  NOP 
      JSB .ENTR 
      DEF BOX 
      SPC 2 
*                  ** FORM PROPER ADDRESS **
      SPC 1 
      LDA BOX,I     GET BOX ADDRESS 
      ALF,ALF         AND POSITION
      RAL               IT PROPERLY 
      STA B           SAVE
      SPC 1 
      LDA CARD,I    GET CARD ADDRESS
      ALF,RAL         AND POSITION IT 
      IOR B         COMBINE 
      SPC 1 
      IOR CHAN,I    COMBINE WITH CHAN NUMBER
      STA CHAN,I    RETURN WORD TO ALGOL
      JMP ADDR,I
      SPC 2 
***************** 
*               * 
*  END OF ADDR  * 
*               * 
***************** 
      HED 2313B VERIF -- CODE PROCEDURES -- INTRP  8/22/73
**********************************
*                                *
*  INTRP -- COMMAND INTERPRETER  *
*                                *
**********************************
      SPC 1 
*  THE PROMPTER IS ISSUED BY THIS PROCEDURE.
* 
*  THE COMMAND IS SCANNED AND THE PROPER
*  INDICATORS SET FOR THE ALGOL.
* 
*  ERRORS IN COMMANDS ARE TRAPPED AND THE 
*  PROMPTER IS RE-ISSUED. 
* 
*  WHEN SETTING THE PACER, ITS PARAMETERS ARE 
*  REQUESTED AND READ.
      SPC 2 
WHERE NOP 
SC.   NOP 
TC.   NOP 
RS.   NOP 
BS.   NOP 
SS.   NOP 
HI.   NOP 
DI.   NOP 
LADRS NOP 
CO.   NOP 
LAD.  NOP 
RPTOK NOP 
GONLY NOP 
LOOP  NOP 
PACED NOP 
RATE  NOP 
RANGE NOP 
EXTSS NOP 
LSTOK NOP 
BATCH NOP 
      SPC 1 
INTRP NOP 
      JSB .ENTR 
      DEF WHERE 
      SKP 
      LDA CO.,I     PRINT 
      SSA             CONDITIONS? 
      JMP .COND         YES 
      SPC 1 
START JSB .IOC.     WRITE OUT 
      OCT 20002       THE 
      JMP *-2           PROMPTER (>)
      DEF CMND            AND HOLD
ONE   DEC 1                 THE LINE
      SPC 1 
      JSB READ4     \\\\\\\\\\\ 
      DEF *+4       READ IN    \
      DEF DEVYC       THE       > 
      DEF MIN1          COMMAND/
      DEF PIN       /////////// 
      SPC 1 
      CLB           CLEAR 
      LDA DI.,I       DATA DISPLAY
      SSA               IN SWITCH 
      OTB 1               REGISTER
      SPC 1 
      LDA DESC      IS THE
      AND UPPER       INPUT A 
      CPA ASTER         COMMENT?
      JMP START           YES 
      SPC 1 
      LDA DESC      CHECK COMMAND:
      CPA LI        LIST? 
      JMP LISTR       YES 
      CPA RE        REPEAT? 
      JMP REPET       YES 
      CPA SE        SET A CONDITION?
      JMP SET         MAYBE 
      CPA CL        CLEAR A CONDITION?
      JMP CLEAR       YES 
      SPC 1 
      CPA CO        PRINT CONDITIONS? 
      JMP COND        YES 
      SPC 1 
      CPA BA        GO TAPE?
      JMP BAT         YES 
      CPA TY        GO KEYBOARD?
      JMP TYPE1       YES 
      SKP 
GO.ON LDA NB12      INITIALIZE
      STA CNTR1       COUNTERS
      LDA IASC          AND 
      STA PNTR1           POINTERS
      LDA NB10              FOR 
      STA CNTR                FINDING 
      LDA PARAM                 TEST TO 
      STA PNTR                    BE CALLED 
AGAIN LDA PNTR1,I   HAS A TEST
      CPA DESC        BEEN FOUND
      JMP EKUAL         YES 
      ISZ PNTR1         NO - POINT TO NEXT TEST 
      ISZ CNTR1     CHECKED ALL TESTS & FOUND NONE? 
      JMP AGAIN       NO - LOOK AGAIN 
ERRR  JSB ERROR       YES - WRITE "??"
      JMP START     GO GIVE PROMPTER AGAIN
EKUAL INB           TEST HAS BEEN FOUND - INC TEST #
      ISZ PNTR      ADVANCE TEST BOOLEAN POINTER
      ISZ CNTR      INC CNTR FOR VALID TEST BOOLEAN 
ZERO  NOP 
      ISZ CNTR1     DONE? 
      JMP EKUAL       NO
      STB WHERE,I     YES - SET TEST INDICATOR
      CCB           FORM "TRUE" 
      LDA PNTR,I    GET BOOLEAN 
      STA PNTR        LOCATION
      LDA CNTR      CHECK FOR VALID 
      SSA,RSS         TEST BOOLEAN? 
      JMP INTRP,I       NO
      SPC 1 
      CLA 
      STA SC.,I     \\\\\\\\\\\ 
      STA TC.,I                \
      STA RS.,I     CLEAR       \ 
      STA BS.,I       PREVIOUS   >
      STA SS.,I         COMMAND / 
      STA HI.,I                /
      STA DI.,I     /////////// 
      SPC 1 
      STB PNTR,I    SET TRUE INTO TEST
      JMP INTRP,I   GO BACK TO ALGOL
      SKP 
LISTR LDA LSTOK,I   IS THERE
      SSA             A DATA BUFFER TO LIST?
      JMP GO.ON         YES 
      JMP ERRR          NO
      SPC 1 
REPET LDA RPTOK,I   IS THERE A TEST 
      SSA             THAT CAN BE REPEATED? 
      JMP GO.ON         YES 
      JMP ERRR          NO
      SPC 1 
SET   LDA DES       WHAT IS THE THIRD CHAR? 
      AND UPPER     WAS IT A T? 
      CPA T 
      RSS             YES - SO IT IS SET
      JMP GO.ON       NO - SO MUST BE SEQUENTIAL
      CCB           GET CONDITION 
      LDA ST          TO BE SET 
      RSS 
      SPC 1 
CLEAR LDA FROM      GET COND TO BE CLEARED
      ALF,ALF       POSITION AND
      AND B377        ISOLATE FIRST CHARACTER 
      CPA P         PACER COND? 
      JMP PCR         YES 
      CPA R         REPEAT COND?
      JMP LOP         YES 
      CPA G         GAIN MODE COND? 
      JMP GNLY        YES 
      CPA L         LAD COND? 
      JMP LAST        YES 
      CPA BK        GAIN CONSTANT?
      JMP SCODE       YES 
      CPA D         SET DELAY?
      JMP SETD        YES 
      CPA ALL       CLEAR ALL CONDITIONS? 
      JMP CLRAL       YES 
      JMP ERRR      INVALID COND - WRITE "??" 
      SPC 2 
LOP   STA LSTOK,I   CLEAR LIST CAPABILITY 
      STB LOOP,I    SET OR CLEAR LOOP CONDITION 
      JMP START     RE-ISSUE PROMPTER 
      SKP 
CLRAL SSB           CLEAR REQUEST?
      JMP ERRR        NO
      STB LOOP,I      YES - CLEAR LOOP
      STB PACED,I           CLEAR PACER 
      LDA GONLY,I   IS GAIN 
      SSA             SET?
      STB RPTOK,I       YES-CLEAR REPEAT
      STB GONLY,I       NO -CLEAR GAIN-ONLY 
      STB LAD.,I            CLEAR LAD 
      JMP SETD2             CLEAR DELAY 
      SPC 1 
BAT   LDA FIVE      \\\\\\\\\\\ 
LBL1  JMP LBL2 OR NOP (NO P.R.)\
      CLB,RSS                   \ 
TYPE1 LDB ABRT      SET TAPE OR  \
      STB LBL4      KEYBOARD MODE > 
      LDA ONE                    /
LBL2  STA DEVYC                 / 
      STA BATCH,I              /
      JMP START     /////////// 
      SPC 1 
GNLY  STB GONLY,I   SET OR CLEAR
      CLA           CLEAR 
      STA RPTOK,I     REPEATOK
      STA LSTOK,I       AND LISTOK
      JMP START     RE-ISSUE PROMPTER 
      SPC 1 
PCR   STB PACED,I   SET OR CLEAR PACE MODE
      SSB,RSS         SET?
      JMP START         NO - RE-ISSUE PROMPTER
      SPC 1 
L61   JSB .IOC.     REQUEST 
      OCT 20002       PACER 
      JMP *-2           PERIOD
      DEF MSG2            AND 
      DEC -15              MULTIPLIER 
      LDA B400
      STA PIN 
      STA OUTBF 
      JSB READ2     READ IN 
      DEF L9          THE PERIOD
      DEF DEVYC         AND 
      DEF TWO             MULTIPLIER
      DEF PIN               IN
      DEF OUTBF               FREE-FIELD
L9    LDB PIN       SAVE
      STB RATE,I      RATE
      RBL,CLE,SLB,ERB PERIOD <0?
      JMP PCR           YES - ABORT 
      LDB OUTBF     SAVE
      STB RANGE,I     RANGE 
      SKP 
      RBL,CLE,SLB,ERB  ABORT? 
      JMP PCR            YES
      BRS,BRS       CHECK THE 
      BRS             MULTIPLIER
      SZB               FOR >7? 
      JMP L10             BAD - WRITE " ??" 
      LDB RATE,I
      ADB NB400 
      SSB           IS PERIOD >377 (DEC 255)? 
      JMP *+3         NO
L10   JSB ERROR       YES - WRITE " ??" 
      JMP L61                 ASK AGAIN 
L12   JSB .IOC.     REQUEST 
      OCT 20002       EXTERNAL
      JMP *-2           START/STOP
      DEF FEXT
      DEC 8 
      CLA 
      STA PIN 
      JSB READ1     READ
      DEF L70         IN
      DEF DEVYC         YES 
      DEF MIN1            OR
      DEF PIN              NO 
L70   LDB PIN       GET ANSWER
      CPB NO        IS IT NO? 
      JMP NOT         YES 
      CPB YES         NO - IS IT YES? 
      JMP IS                 YES
      CPB AB                 NO - IS IT ABORT?
      JMP PCR                       YES 
      JMP L12                       NO - ASK AGAIN
IS    CCB,RSS       FOR YES ANSWER SET TRUE VALUE 
NOT   CLB,INB       FOR NO ANSWER SET FALSE VALUE 
      STB EXTSS,I   SET BOOLEAN VALUE IN ALGOL
      JMP START     RE-ISSUE PROMPTER 
      SKP 
LAST  STB LAD.,I    SET OR CLEAR LAD
      SSB,RSS       SET?
      JMP START       NO
      JSB CADDR       YES - GET LAD CARD ADDRS
      JMP LAST      ABORT 
      STA LADRS,I 
      JMP START 
      SPC 1 
CADDR NOP 
L90   JSB .IOC.     REQUEST 
      OCT 20002       CARD
      JMP *-2           ADDRESS 
      DEF MSG3
      DEC -9
      LDA B400
      STA PIN 
      STA OUTBF 
      JSB READ2     READ
      DEF L100        IN THE
      DEF DEVYC         BOX 
      DEF TWO             AND CARD
      DEF PIN               ADDRESS 
      DEF OUTBF 
      SPC 1 
L100  LDB PIN 
      RBL,CLE,SLB,ERB  ABORT? 
      JMP ABRT2          YES
      BRS,BRS       CHECK THE 
      BRS             BOX ADDRESS 
      SZB,RSS           FOR >7? 
      JMP *+3             OK
L101  JSB ERROR           BAD - WRITE " ??" 
      JMP L90                     ASK AGAIN 
      LDB OUTBF 
      RBL,CLE,SLB,ERB  ABORT? 
      JMP ABRT2          YES
      ADB NB14      CHECK THE CARD ADDRESS
      SSB,RSS         FOR >11?
      JMP L101          BAD - WRITE " ??" 
      LDB PIN       POSITION THE
      BLF,BLF         BOX 
      RBL               ADDRESS 
      LDA OUTBF     POSITION THE
      ALF,RAL         CARD ADDRESS
      IOR B         FORM FULL ADDRESS 
      ISZ CADDR     VALID RETURN
ABRT2 JMP CADDR,I 
      SKP 
.COND JSB .IOC.     PRINT OUT 
      OCT 20002       " COND:"
      JMP *-2 
      DEF MSG4
      DEC 3 
      SPC 1 
COND  CLB 
      STB CO.,I     CLEAR COND REQUEST
      STB OUTBF       INDICATOR 
      LDA PACED,I   PACED 
      SSA,RSS         CONDITION?
      JMP LABL1         NO - GO ON
      LDA P             YES - SET UP
      IOR SPACE                 P TO PRINT
      ADB .CO.. 
      STA B,I 
      ISZ OUTBF 
      SPC 1 
LABL1 LDA LOOP,I    REPEAT
      SSA,RSS         CONDITION?
      JMP LABL2         NO - GO ON
      LDA R             YES - SET UP
      IOR SPACE                 R TO PRINT
      LDB OUTBF 
      ADB .CO.. 
      STA B,I 
      ISZ OUTBF 
      SPC 1 
LABL2 LDA DELC      DELAY 
      SSA,RSS         CONDITION?
      JMP LABL3         NO - GO ON
      LDA D             YES - SET UP
      IOR SPACE                 D TO PRINT
      LDB OUTBF 
      ADB .CO.. 
      STA B,I 
      ISZ OUTBF 
      SPC 1 
LABL3 LDA GONLY,I   GAIN MODE 
      SSA,RSS         CONDITION?
      JMP LABL4         NO - GO ON
      LDA G             YES - SET UP
      IOR SPACE               G TO PRINT
      LDB OUTBF 
      ADB .CO.. 
      STA B,I 
      ISZ OUTBF 
      SKP 
LABL4 LDA LAD.,I    LAD 
      SSA,RSS         CONDITION?
      JMP LABL5         NO - GO ON
      LDA L             YES - SET UP
      IOR SPACE                 L TO PRINT
      LDB OUTBF 
      ADB .CO.. 
      STA B,I 
      ISZ OUTBF 
      SPC 1 
LABL5 LDB OUTBF     SET OUTPUT PRINT
      STB LABL7       LENGTH FOR CONDITIONS 
      SZB           WERE THERE ANY COND?
      JMP LABL6       YES - GO PRINT THEM 
      LDA NO          NO - SET UP 
      STA .CO..,I            NONE TO PRINT
      CLB,INB 
      LDA NE
      ADB .CO.. 
      STA B,I 
      LDA TWO       SET PRINT LENGTH
      STA LABL7       FOR NONE
      SPC 1 
LABL6 JSB .IOC.     PRINT 
      OCT 20002       CONDITIONS
      JMP *-2           OR
.CO.. DEF TOP             NONE
LABL7 NOP 
      SPC 1 
      JMP START 
      SKP 
SCODE SSB,RSS       SET K?
      JMP START       NO
      SPC 1 
SCO   JSB .IOC.     REQUEST 
      OCT 20002       CARD
      JMP *-2           ADDRESS 
      DEF MSG6            AND 
      DEC -14               GAIN
      LDA B400
      STA PIN 
      STA OUTBF 
      JSB READ2     READ IN BOX 
      DEF SCO1        AND CARD
      DEF DEVYC         LOCATION
      DEF TWO 
      DEF PIN 
      DEF OUTBF 
SCO1  JSB READR     READ IN 
      DEF SCO2        GAIN
      DEF DEVYC 
      DEF ZERO
      DEF DA
SCO2  LDB PIN 
      RBL,CLE,SLB,ERB  ABORT? 
      JMP START          YES
      BRS,BRS        CHECK THE
      BRS              BOX ADDRESS
      SZB,RSS            FOR >7?
      JMP *+3              OK 
SCO3  JSB ERROR            BAD - ASK
      JMP SCO                AGAIN
      LDB OUTBF 
      RBL,CLE,SLB,ERB  ABORT? 
      JMP START          YES
      ADB NB14       CHECK THE CARD ADDRESS 
      SSB,RSS          FOR >11? 
      JMP SCO3           BAD - ASK AGAIN
      LDB PIN       POSITION
      BLF,BLF         THE BOX 
      RBL               ADDRESS 
      LDA OUTBF     POSITION THE
      ALF,RAL         CARD ADDRESS
      IOR B         FORM FULL ADDRESS 
      IOR BIT14     GOOD ADDRESS- FORM
      STA PIN         CONTROL WORD & STORE
      SKP 
      JSB GNCHK     VALID GAIN? 
      DEF SCO4
      DEF OUTBF 
      DEF DA
SCO4  LDA OUTBF 
      SSA           ABORT CONDITION?
      JMP START       YES 
      CPA B8          NO - VALID GAIN?
      JMP KSD              NO 
      CLB 
      STB SC,I
      JSB EXIT      TURN ON KEYBD 
      DEF EOL         ABORT FEATURE 
      DEF MIN1
      DEF START 
EOL   LDA PIN 
      JSB PROG              PROGRAM 
      LDA OUTBF               LLMPX TO
      JSB PROG                  REQ. GAIN 
      JSB CLRIT 
      JMP START 
      SPC 1 
KSD   JSB ERROR 
      JMP SCO 
      SKP 
SETD  SSB,RSS       SET DELAY?
      JMP SETD2       NO
      SPC 1 
OHYA  JSB .IOC.     YES- REQUEST
      OCT 20002       DELAY 
      JMP *-2           VALUE 
      DEF MSG7
      DEC -9
      SPC 1 
      JSB READ1     READ IN 
      DEF SETD1       DELAY 
      DEF DEVYC         VALUE 
      DEF ONE             (# OF 
      DEF PIN               MILLISECONDS) 
      SPC 1 
SETD1 LDB PIN 
      RBL,CLE,SLB,ERB    ABORT? 
      JMP START            YES
      LDA TEST2            NO 
      ADA MIN1
      ADA B         DELAY>
      SSA             10,000? 
      JMP KPIX        NO - OK 
      JSB ERROR       YES - TOO 
      JMP OHYA          MANY
      SPC 1 
KPIX  CMB,INB       SET COUNTER FOR 
SETD2 STB DELC        # OF MILLISECONDS 
      JMP START 
      SPC 2 
******************
*                *
*  END OF INTRP  *
*                *
******************
      HED 2313B VERIF -- CODE PROCEDURES -- CNVRT  8/22/73
******************************************* 
*                                         * 
*  CNVRT -- CONVERT DATA TO REAL VOLTAGE  * 
*                                         * 
******************************************* 
      SPC 1 
*  THIS ROUTINE TAKES INTEGER DATA STORED 
*  IN THE UPPER 12 BITS OF EACH WORD OF 
*  AN INTEGER ARRAY (IN THIS CASE, THE
*  UPPER HALF OF THE REAL ARRAY - DATA) 
*  AND CONVERTS IT TO REAL VOLTAGE
*  STORING IT IN A REAL ARRAY (DATA). 
* 
*  TWO GAINS ARE USED ALTERNATING BUT 
*  BOTH WILL OFTEN BE THE SAME. 
      SPC 2 
VOLTS NOP 
DATA  NOP 
GAIN1 NOP 
GAIN2 NOP 
FIRST NOP 
NUMBR NOP 
      SPC 1 
CNVRT NOP 
      JSB .ENTR 
      DEF VOLTS 
      SPC 1 
*                   ** INITIALIZE **
      SPC 1 
      DLD GAIN1,I   OBTAIN
      DST FGAIN       GAIN1 
      DLD GAIN2,I   OBTAIN
      DST SGAIN       GAIN2 
      LDA NUMBR,I   SET COUNTER 
      CMA,INA         FOR NUMBER OF READINGS
      STA NUMBR         TO BE CONVERTED 
      LDA DATA      SET INPUT BUFFER
      ADA FIRST,I     POINTER TO STARTING 
      STA DATA          POINT 
      LDA FIRST,I   SET OUTPUT BUFFER 
      ALS             POINTER 
      ADA VOLTS         TO STARTING 
      STA VOLTS           POINT 
      SKP 
      LDA TEST      SET UP ALTERNATING TEST 
MORE  STA DESC      SAVE ALTERNATING TEST 
      LDB XL3       GET SECOND GAIN 
      SLA           FIRST OR SECOND?
      LDB XL2         FIRST - GET FIRST GAIN
      STB XL4       SET PROPER GAIN 
      LDA DATA,I    GET RAW DATA WORD 
      ARS,ARS       DIVIDE BY 16
      ARS,ARS         (RIGHT JUSTIFY) 
      JSB FLOAT     MAKE INTO REAL NUMBER 
      FMP .005      MAKE IT VOLTAGE 
      JSB .FDV      ADJUST VOLTAGE
XL4   DEF FGAIN       BY AMOUNT OF GAIN 
      STA VOLTS,I   STORE 
      ISZ VOLTS       VOLTAGE 
      STB VOLTS,I       IN OUTPUT 
      ISZ VOLTS           ARRAY (INTO ALGOL)
      ISZ DATA      NEXT DATA 
      ISZ NUMBR     DONE? 
      RSS             NO
      JMP CNVRT,I     YES - RETURN TO ALGOL 
      LDA DESC      GET ALTERNATING TEST
      RAR           SWITCH ALTERNATING TEST 
      JMP MORE      NEXT DATA 
      SPC 2 
******************
*                *
*  END OF CNVRT  *
*                *
******************
      HED 2313B VERIF -- CODE PROCEDURES -- DESCR  8/22/73
*********************************************** 
*                                             * 
*  DESCR -- OUTPUT ASCII STRING FROM BUFFERS  * 
*                                             * 
*********************************************** 
      SPC 1 
*  THIS ROUTINE PRINTS THE CONTENTS 
*  OF THE BUFFER AREA AS ASCII
*  CHARACTERS.
* 
*  THIS ROUTINE IS THEN DESTROYED 
*  BY USING IT AND THE BSS AT ITS 
*  END AS A STRING BUFFER FOR READX.
*  AND AS STORAGE PARAMETERS FOR VARIOUS ROUTINES.
      SPC 2 
      ORB 
LOC   NOP 
      SPC 1 
DESCR NOP 
      JSB .ENTR 
      DEF LOC 
      SPC 1 
L1000 JSB .IOC.     REQUEST ANSWER
CBLOC OCT 20002       TO " WANT 
INCH  JMP *-2           DIRECTIONS?"
MINCD DEF MSG5
DA    DEC -19 
      SPC 1 
NCHLO JSB .IOC.     READ
SUM   OCT 10401       THE 
KTVU  JMP *-2           ANSWER
      DEF PIN             (YES OR NO) 
      DEC 1 
      SPC 1 
      JSB CHECK     IS ANSWER READY?
      LDA PIN         YES 
      CPA NO        NO? 
      JMP DESCR,I     RIGHT - GET OUT 
      CPA YES       YES?
      RSS             RIGHT - CONTINUE
      JMP L1000       NEITHER - SO ASK AGAIN
      SPC 1 
      LDA LOC       GET BUFFER ADRS 
      JSB DESC        AND CALL PRINT ROUTINE
      SPC 1 
      JMP DESCR,I 
      SKP 
DESC  NOP 
DES   STA *+2       SAVE BUFFER ADRS
ST    RSS 
FROM  NOP 
      SPC 1 
ATEST LDA LNGTH     SET LENGTH OF 
GNCOD STA CNTR        ASCII STRING (WORDS)
OUTPT LIA 1         ESCAPE? 
FGAIN SSA           / 
      JMP DESC,I      YES 
I     LDA FROM,I    GET CHARACTER PAIR
J     ALF,ALF        POSITION 
K     STA OUTBF       AND PUT IN BUFFER 
MASK  JSB .IOC.     OUTPUT
COU1  OCT 20002       THE CHARACTER 
      JMP *-2           PAIR
SGAIN DEF OUTBF           FOLLOWED BY 
      DEC -3                A LEFT ARROW (_)
ASAVE ISZ FROM      NEXT WORD 
TEMP  ISZ CNTR      DONE? 
      JMP OUTPT       NO - NEXT CHAR PAIR 
AVG   JMP DESC,I      YES - BACK TO ALGOL 
      SPC 1 
LNGTH DEC -701
      SPC 1 
*                   ** EXTRA BUFFER AREA FOR ** 
*                   ** INPUT STRINGS         ** 
      SPC 1 
MSG5  ASC 10, WANT DIRECTIONS? _                                   *
TOP   BSS 2 
BOTOM BSS 2 
EQTAD OCT 17
      ORR 
      SPC 2 
******************
*                *
*  END OF DESCR  *
*                *
******************
      HED 2313B VERIF -- CODE PROCEDURES -- EXIT  8/22/73 
********************************************* 
*                                           * 
*  EXIT -- SET UP AND CHECK TTY FOR ESCAPE  * 
*                                           * 
********************************************* 
      SPC 1 
*  THE TTY TRAP CELL LINK IS MADE 
*  TO POINT AT I.EX BELOW SO THAT 
*  AN INTERRUPT FROM THE TTY COMES HERE.
* 
*  THE LINK IS RESTORED ON INTERRUPT AND
*  CONTROL SENT TO A LABEL PASSED IN THE CALL.
* 
*  A CLEAR REQUEST HERE RESTORES THE LINK.
* 
*  THE 2313B TRAP CELL IS RESTORED WHENEVER 
*  THE TTY LINK IS RESTORED.
      SPC 2 
TEST1 NOP 
LABEL NOP 
      SPC 1 
EXIT  NOP 
      JSB .ENTR 
      DEF TEST1 
      SPC 1 
      LDA TEST1,I 
LBL4  INA,SZA       SET UP? 
      JMP RSET        NO - GO CLEAR IT
      JSB CHECK       YES - IS TTY BUSY?
      LDA TTYIN     GET NEW TRAP CELL LINK
      STA TTYL,I    SET UP LINK 
      LDA INTTY     GET TTY INPUT MODE WORD AND 
OTA1  OTA TTY         OUTPUT
STCC1 STC TTY,C     ENCODE THE TTY FOR INPUT
      JMP EXIT,I
      SPC 1 
RSET  JSB CLRIT     GO CLEAR
      JMP EXIT,I
      SPC 1 
I.EX  NOP           INTERRUPT ENTRY POINT 
      JSB CLRIT     GO CLEAR
      JMP LABEL,I   GO TO ALGOL INTERRUPT POINT 
      SPC 1 
CLRIT NOP 
      LDA TTYLC     GET BCS TTY LINK
CLC1  CLC TTY       TURN OFF TTY
STF1  STF TTY       RESTORE FLAG
      STA TTYL,I    RESTORE TRAP LINK 
CLC2  CLC .2313     TURN OFF 2313B
      LDA TCC       RESTORE 
      STA SC,I        TRAP CELL 
STF2  STF .2313 
      JMP CLRIT,I 
      SPC 1 
*                   **  END OF EXIT  ** 
                                                                                                                                  