      HED EXECUTION UTILITY ROUTINES
**                         ** 
***  INTEGERIZE A NUMBER  *** 
**                         ** 
* 
*  ENTER WITH A FLOATING POINT NUMBER IN (A) AND (B). 
*  IF EXPONENT EXCEEDS 23, NUMBER HAS INTEGER SIGNIFICANCE; 
*  EXIT TO (P+1).  ALL OTHER CASES EXIT TO (P+2) WITH 32-BIT
*  INTEGER RIGHT JUSTIFIED IN (A) AND (B).  ON EXIT (O) = 0 
*  IF NUMBER IS EXACTLY REPRESENTABLE AS A 16-BIT INTEGER.
*  IF EXPONENT IS NEGATIVE, TRUNCATE TO 0 OR -1 APPROPRIATELY 
*  AND LET (O) = 1.  OTHERWISE RIGHT JUSTIFY INTEGER AND EXIT 
*  WITH LAST BIT LOST IN (E). 
* 
#IFIX STA TEMP6     SAVE (A)
      STO           SET 'NOT ONE-WORD INTEGER' MODE 
      JSB .FLUN     UNPACK (B)
      SSA           NEGATIVE EXPONENT?
      JMP IFIX3     YES 
      ADA .-16      NO, EXPONENET 
      SSA             <= 15?
      CLO           YES 
      ADA .-8       NO, EXPONENT
      SSA,RSS         <= 23?
      JMP IFIX,I    NO, ALL SIGNIFICANCE IS INTEGER 
      ADA .-8       YES, MOVE BINARY POINT TO END OF
      STA EXP         (B) AND SAVE SHIFT COUNT
      LDA TEMP6     RETRIEVE (A)
      JMP IFIX2 
IFIX1 CLE,SLA,ARS   SHIFT (A) RIGHT 
      CME           SHIFT 
      SLB,ERB         (B) RIGHT 
      STO           LOST A 1
IFIX2 ISZ EXP       ALL SHIFTS DONE?
      JMP IFIX1     NO
      ISZ IFIX      YES 
      JMP IFIX,I
IFIX3 LDA TEMP6     RETRIEVE (A)
      CLE,SSA       TRUNCATE
      CCA,RSS         TO
      CLA,RSS           -1
      CCB,RSS            OR 
      CLB                   0 
      JMP IFIX3-2 2C
      SKP 
**                             ** 
***  GET NEXT FILE ITEM TYPE  *** 
**                             ** 
* 
*  THE NEXT ITEM IN THE FILE, NUMBER, STRING, END-OF-FILE, OR 
*  END-OF-RECORD, IS IDENTIFIED AND UPON EXIT (B) =1,2,3, OR 4
*  RESPECTIVELY.  EORFL = -1 WILL IGNORE END-OF-RECORD'S AND
*  RETURN WITH THE FIRST OF THE OTHER ITEMS ENCOUNTERED.
* 
GTTY1 LDA FILE#     REQUEST 
      JSB RQSTR       NEXT RECORD 
#GTTY CCB           LOAD ACTIVE 
      ADB FBASE       AND LIMIT 
      DLD 1,I           RECORD POINTERS 
      CPA 1         PHYSICAL END OF RECORD? 
      JMP GTTY3     YES 
      LDA 1,I       NO, LOAD WORD 
      CLB,INB         OF RECORD 
      CPA EOR       END-OF-RECORD?
      JMP GTTY3     YES 
      CPA EOF       NO, END-OF-FILE?
      JMP GTTY4     YES 
      AND M256      NO
      CPA B1000     STRING? 
      INB           YES, (B) = 2
GTTY2 LDA 1         SET (A) = (B) 
      JMP GTTYP,I 
GTTY3 LDB FBASE     PHYSICAL
      ADB .-4         END 
      DLD 1,I           OF
      CPA 1               FILE? 
      JMP GTTY5     YES 
      CCB           NO
      CPB EORFL     EOR'S WANTED? 
      JMP GTTY1     NO
      LDB .+2       YES, SET (B) = 4
GTTY4 ADB .+2       (B) = 3 
      JMP GTTY2 2
GTTY5 LDA .+3       (B) = 3 3 
      JMP GTTYP,I 
      SKP 
**
***   PUSH DOWN OPERATOR STACK
**
* 
*  ALLOCATE AN ENTRY ON THE OPERATOR STACK. 
*  (A) IS NOT CHANGED Dm
* 
#PSHS LDB PBPTR     ADVANCE 
      ADB .+2       STACK POINTER 
      CMB           USER
      ADB LWAUS       SPACE 
      SSB               OVERFLOW? 
      JSB RERRS+10,I
      ISZ PBPTR     NO, ALLOCATE
      ISZ PBPTR       STORAGE 
      JMP PSHST,I 
**                             ** 
***  ROUND NUMBER TO INTEGER  *** 
**                             ** 
* qq
*  ENTER WITH NUMBER IN (A) AND (B).  EXIT TO (P+2) IF
*  INTEGER FORM (ROUNDED AS NEEDED) IS POSITIVE AND NOT 
*  LARGER THAN 15 BITS, ELSE EXIT TO (P+1).  ON EXIT TO 
*  (P+2), (B) HOLDS THE INTEGER BIASED BY -1. 
* 
#SBFX JSB IFIX      TRUNCATE NUMBER 
      JMP SBFIX,I   NUMBER TOO LARGE
      SZA           INTEGER OVERFLOW? 
      JMP SBFIX,I   YES 
      SEZ,RSS       NO, ROUNDING BIT? 
      ADB .-1       NO, BIAS INTEGER BY -1
      SSB,RSS       YES, POSITIVE RESULT? 
      ISZ SBFIX     YES 
      JMP SBFIX,I   NO
* 
NUSE4 BSS 4         NOT USED                     [D]
* qq
* qq
*  ROUTINE USED BY POWERFAIL/AUTO RESTART 
*  TO DO A DISC TRANSFER. 
* 
CHECK NOP 
      JSB DISC,I    START TRANSFER. 
      LDA ENDSK     WAIT FOR COMPLETION.
      SZA 
      JMP *-2 
      CLF 0         TURN OFF INTERRUPT. 
      JMP CHECK,I Ix
* qq
* qq
      SKP 
**                      **
***  REQUEST A RECORD  ***
**                      **
* 
*  UPON ENTRY (A) HOLDS A FILE NUMBER (POSITIVE FOR A READ
*  REQUEST, NEGATIVE FOR A WRITE REQUEST) AND (B) SPECIFIES 
*  VALIDATION OF THE FILE'S EXISTENCE ( (B) = -2) OR THE FILE 
*  RECORD TO BE PUT IN THE FILE BUFFER ( (B) = -1 REQUESTS
*  THE RECORD WHICH FOLLOWS THE ONE CURRENTLY IN THE BUFFER,
*  (B) >= 0 REQUESTS RECORD (B)+1 ).  EXIT TO ERROR IF THE
*  FILE DOES NOT EXIST OR A WRITE REQUEST IS GIVEN FOR A
*  READ-ONLY FILE.  EXIT TO THE END-OF-FILE CODE IF THE 
*  REQUESTED RECORD DOES NOT EXIST.  OTHERWISE, THE DIRTY 
*  BIT IS EXAMINED TO DETERMINE IF THE FILE BUFFER SHOULD 
*  BE WRITTEN BACK TO DISC. 
*  A READ REQUEST READS THE REQUESTED RECORD INTO THE BUFFER; 
*  A WRITE REQUEST MERELY INITIALIZES THE BUFFER TO 'EMPTY'.
*  THE FILE TABLE IS UPDATED TO REFLECT THE CHANGES.
* *q
#RQST STB RQ2       SAVE RECORD REFERENCE 
      CCB           GET 1'S COMPLEMENT
      SSA             OF FILE NUMBER AND
      CLB,RSS           SET RQ1 = -1 FOR A
      CMA                 READ REQUEST OR 0 
      STB RQ1               FOR A WRITE REQUEST 
      ADA FCNTR     DOES REQUESTED
      CMA,SSA,RSS     FILE EXIST? 
      JSB RERRS+35,I  NO
      ADA FCNTR     YES 
      MPY .+7       SET POINTER 
      ADA FILTB       TO FILE TABLE 
      STA FBASE         ENTRY 
      LDA FBASE,I   LOAD NUMBER OF RECORDS
      ISZ FBASE     BIT 15 =1 
      ISZ FBASE 
      CCB,CLE 
      SSA           READ-ONLY FILE? 
      CPB RQ1       YES, READ REQUEST?
      ELA,CLE,SLA,ERA    YES, CLEAR BIT 15 AND SKIP 
      JSB RERRS+36,I  NO
      AND B1777 
      LDB RQ2       FILE VALIDATION 
      CPB .-2         ONLY? 
      JMP RQST5+2   YES 
      ISZ RQ2       NO, RECORD SPECIFIED? 
      JMP RQST2     YES 
      LDB FBASE,I   NO, LOAD OLD RECORD ADDRESS 
      CMB,SZB,RSS   NULL RECORD?
      JMP RQST2     YES 
      ISZ FBASE     NO, COMPUTE 
      ADB FBASE,I 
      CMB,SLB         NEW 
      ADB 0 
       BRS              RECORD
      INB,RSS             NUMBER
RQST2 ISZ FBASE 
      CMA,INA       DOES
      ADA 1           RECORD
      SSA               EXIST?
      JMP *+4       YES 
      ISZ FBASE     NO, CORRECT FBASE 
      ISZ FBASE 
      JMP FDT4A,I     FOR EOF EXIT CHECK
      ADA 1 
      IOR .+1       COMPUTE 
      BLS             DISC
      SSA               ADDRESS 
      LDA 1               OF NEW
      ADA FBASE,I           RECORD
      STA RQ2       SAVE IT 
      ISZ FBASE     SET POINTER 
      LDB FBASE,I 
      ADB M128     TO BEGINNING                  X] 
      ISZ FBASE 
      STB FBASE,I       OF RECORD BUFFER
      STB RQ3       SAVE ADDRESS OF BUFFER
      LDB FBASE     MOVE TO 
      ADB .-3         DISC
      STB FBASE         ADDRESSES 
      CPA FBASE,I   OLD AND NEW RECORDS THE SAME? 
      JMP RQST3     YES 
      JSB WRBUF     NO, WRITE OLD RECORD TO DISC
      ISZ RQ1      READ REQUEST?
      JMP RQST4     NO
      LDA RQ2       YES 
      LDB M128      READ IN                             [X] 
      CLF 0 
      STB WORD
      LDB RQ3         REQUESTED 
      ADB FLGBT 
      JSB DISC,I
      LDA ENDSK         RECORD
      SZA 
      JMP *-2 
      JMP RQST5 5{
RQST3 ISZ RQ1       WRITE REQUEST?
      RSS           YES 
      JMP RQST5     NO
RQST4 LDB EOR       SCRATCH RECORD
      STB RQ3,I       WITH END-OF-RECORD MARK 
RQST5 LDA RQ2       SET DISC ADDRESS OF 
      STA FBASE,I     NEW RECORD INTO FILE TABLE
      LDB FBASE     MOVE POINTER
      ADB .+3         TO REFERENCE
      STB FBASE         RECORD POINTER
      JMP RQSTR,I 
      SKP Pl
**                        **
*** STORE ITEM IN FILE  *** 
**                        **
* 
*  UPON ENTRY (B) INDICATES WHAT IS TO BE WRITTEN ON THE FILE:
*  (B) = -1 WRITES AN END-OF-FILE MARK, (B) = -2 WRITES A TWO-
*  WORD FLOATING POINT NUMBER, (B) = -3 WRITES A STRING.  IF
*  THE RECORD CANNOT ACCOMMODATE THE QUANTITY, A SERIAL WRITE 
*  WILL PLACE IT IN THE FOLLOWING RECORD WHILE A RECORD WRITE 
*  WILL EXIT TO THE END-OF-FILE CODE. 
* 
#FILS STB FILT      SAVE REQUEST TYPE 
      CCB           LOAD
      ADB FBASE       ACTIVE AND LIMIT
      DLD 1,I           RECORD POINTERS 
      CPA 1         RECORD FULL?
      JMP FILS1     YES 
      STB DADRR     NO, SAVE ACTIVE POINTER 
      ISZ FILT      EOF REQUEST?
      JMP FILS2     NO
      CCA           YES,OVERLAY PREVIOUS
      STA 1,I         EOR OR EOF WITH EOF MARK
FILS7 LDB FBASE     MAKE POINTER TO FIRST WORD OF 
      ADB .-5         FILE TABLE ENTRY. 
      LDA 1,I       SET 
      IOR BIT14       DIRTY 
      STA 1,I           BIT.
      JMP FILST,I 
FILS2 ISZ FILT      STRING? 
      JMP FILS6     YES 
      ADB .+2       NO
FILS3 CMA,INA       COMPARE PROSPECTIVE 
      ADA 1           ACTIVE POINTER WITH 
      CMA,INA           END-OF-RECORD POINTER 
      SSA           OVERFLOW? 
      JMP FILS0     YES S[
      STB FBASE,I   NO, SAVE NEW ACTIVE POINTER 
      SZA,RSS       RECORD EXACTLY FULL?
      JMP FILS4     YES 
      LDA EOR       NO, FOLLOW ENTRY SPACE
      STA 1,I         WITH EOR MARK 
FILS4 ISZ FILT     STRING?  
      JMP FILS5     NO
      LDA TNULL     YES 
      CMA           COMPUTE AND 
      IOR B1000       STORE STRING
      STA DADRR,I       HEADER WORD 
      LDA FSCHA     TRANSFER
      JSB TRSTR       STRING
      JMP FILS7 7

FILS5 DLD SBPTR,I   TRANSFER
      DST DADRR,I     NUMBER
      JMP FILS7 
FILS6 INB           COMPUTE 
      BLS             DESTINATION 
      STB TEMP5         ADDRESS 
      CMB,INB       COMPUTE 
      ADB TNULL       RECORD
      CMB,INB           SPACE 
      BRS                 REQUIRED
      JMP FILS3 
FILS0 LDA EOR       INSURE EOR MARK 
      STA DADRR,I     ENDS PRESENT RECORD 
      LDA .-2       RESTORE 
      ADA FILT       REQUEST
      STA FILT        TYPE
FILS1 CCB 
      CPB RCRD#     SERIAL WRITE? 
      RSS           YES SY
      JMP FDT4A,I   NO
      LDA FILE#     REQUEST 
      CMA             RECORD
      JSB RQSTR         TO WRITE
      JMP #FILS+1 
      HED ARITHMETIC SUBROUTINES
**                                    **
***  ADD TWO FLOATING POINT NUMBERS  ***
**                                    **
#FAD  STA A1       SET POINTER TO 2ND ARG 
      LDA .FAD,I
      STA A2
      LDA A1
      OCT 105000   FAD A2,I 
      DEF A2,I
      ISZ .FAD
      SOC C
      JSB OUCHK    OVERFLOW OR UNDERFLOW
      JMP .FAD,I
**                                         ** 
***  SUBTRACT TWO FLOATING POINT NUMBERS  *** 
**                                        **  
#FSB  STA A1       SEtPOINTER TO 2ND ARG  
      LDA .FSB,I
      STA A2
      LDA A1AK
      OCT 105020   FSB A2,I 
      DEF A2,I
      ISZ .FSB
      SOC 
      JSB OUCHK K
      JMP .FSB,I
**                                         ** 
***  MULTIPLY TWO FLOATING POINT NUMBERS  *** 
**                                         ** 
#FMP  STA A1       SET POINTER TO 2ND ARG 
      LDA .FMP,I
      STA A2
      LDA A1
      OCT 105040   FMP A2,I 
      DEF A2,I
      ISZ .FMP
      SOC 
      JSB OUCHK 
      JMP .FMP,I
**                                       ** 
***  DIVIDE TWO FLOATING POINT NUMBERS  *** 
**                                       ** 
#FDV  STA A1
      LDA .FDV,I
      STA A2
      LDA A1
      OCT 105060   FDV A2,I 
      DEF A2,I
      ISZ .FDV
      SOC 
      JSB OUCHK 
      JMP .FDV,I
* 
*     CHECK OVERFLOW OR UNDERFLOW CONDITION 
* 
#OUCK  STA A1      SAVE REGISTERS 
      STB A2
      SZA 
      JMP OUCK2    UNDERFLOW
      JSB CHOUF 
      JSB WERRS+6,I 
OUCK1 LDA A1
      LDB A2
      JMP OUCHK,I 
OUCK2 JSB CHOUF 
      JSB WERRS+5,I   OVERFLOW
      JMP OUCK1 
**                             ** 
***  TAKE ARITHMETIC INVERSE  *** 
**                             ** 
* 
*  ENTER WITH A FLOATING POINT NUMBER IN (A) ABD (B). 
*  EXIT WITH ITS ARITHMETIC INVERSE IN (A) AND (B). 
* 
#ARIN DST A1        SAVE NUMBER 
      CLA             SUBTRACT
      CLB               IT
      OCT 105020          FROM
      DEF A1                ZERO
      JMP ARINV,I 
**                               ** 
***  UNPACK LOW WORD OF NUMBER  *** 
**                               ** 
* 
*  ENTER WITH LOW WORD OF FLOATING POINT NUMBER IN (B). 
*  EXIT WITH EXPONENT IN (A) AND MANTISSA IN (B). 
* *q
#FLUN CLA           EXTRACT 
      LSR 8           EXPONENT
      ALF,ALF           IN (A) AND
      BLF,BLF             MANTISSA IN (B) 
      SLA,RAR       NEGATIVE EXPONENT?
      IOR SMSK      YES, FILL IN LEADING BITS 
      JMP .FLUN,I   NO
      HED ERROR ROUTINES
* 
*  WHILE READING A PROGRAM IN 'TAPE' MODE, ERRONEOUS STATEMENTS 
*  ARE REPLACED WITH ERROR PSUEDO-STATEMENTS.  THESE ARE THREE
*  WORD 'STATEMENTS':  THE STATEMENT NUMBER, THE LENGTH (ALWAYS 
*  3), AND THE ERROR NUMBER.  SINCE BITS 15-9 ARE CLEAR IN WORD 
*  THREE, ERRORS HAVE A STATEMENT TYPE OF 0.  ERRCT HOLDS A 
*  COUNT OF THE EMBEDDED ERRORS AND THE USER'S BIT OF TERR IS 
*  SET IF ANY EMBEDDED ERRORS EXIST.  ADDITIONALLY, THE 'OUT-OF-
*  STORAGE' ERROR SETS SYMTB = 1 TO ASSIST SYNTAX.  ALL STATEMENTS
*  WITH A SEQUENCE NUMBER OF ZERO WILL BE COLLAPSED INTO A SINGLE 
*  ERROR AND UNDER/OVERFLOWS IN NUMERICAL CONSTANTS ARE NOT 
*  REPORTED.
* 
**                             ** 
***  OUTPUT TAPE MODE ERRORS  *** 
**                             ** 
* 
*  UPON ENTRY ALL EMBEDDED ERRORS ARE STRIPPED FROM THE PROGRAM 
*  AND STORED BELOW IT AS TWO-WORD QUANTITIES (THE LENGTH WORD
*  IS DROPPED).  FOLLOWING THIS THE ERRORS ARE PRINTED ONE BY 
*  ONE WITH LINE NUMBERS.  AFTER PRINTING ALL ERRORS (OR, IF THE
*  USER ABORTS THE ERROR PRINTING, AFTER THE USER TYPES THE NEXT
*  LINE) EVERYTHING IS CLEANED UP AND A MESSAGE PRINTED TO SAY
*  THE LAST RECEIVED INPUT HAS BEEN IGNORED.
* 
TAPER CLA           FIRST 
      CPA ERRCT       ENTRY?
      JMP TAPE5     NO
      STA SYMTB     YES, RESET 'OUT OF STORAGE' FLAG
      LDA PBPTR     INITIALIZE
      STA SPTR
      LDB PBUFF       PROGRAM 
      STB DEST
      STB SOURC         POINTERS
*                               * 
**  STRIP OUT EMBEDDED ERRORS  ** 
*                               * 
TAPE1 INB           SET (B) 
      LDA 1           TO FIRST WORD 
      ADB 1,I           OF NEXT 
      ADB .-1             PROGRAM STATEMENT 
      INA           IS THE
      LDA 0,I         CURRENT STATEMENT 
      AND OPMSK         OF TYPE 
      SZA                 'ERROR' ? 
      JMP TAPE1     NO
      LDA SOURC     YES, LOAD SOURCE ADDRESS
      STB SOURC     SET SOURCE TO NEW VALUE 
      ADB .-3       JUXTAPOSED
      CPA 1           ERRORS? 
      JMP TAPE2     YES, NO MOVE NEEDED 
      CPA DEST      NO, FIRST ERROR ENCOUNTERED?
      JMP TAPE6     YES 
      JSB MOVER     NO, DELETE PRIOR ERROR(S) 
TAPE2 LDB PBPTR     ENOUGH
      STB TAP0
      INB             USER SPACE
      CPB LWAUS 
      JMP TAPE7         TO TRANSFER 
      INB 
      CPB LWAUS           ERROR?
      JMP TAPE7     NO
      STB PBPTR     YES, APPEND TWO WORDS 
      LDB 0,I       TRANSFER
      STB TAP0,I      LINE NUMBER 
      ISZ TAP0
      ADA .+2       TRANSFER
      LDB 0,I         ERROR 
      STB TAP0,I        NUMBER
      LDB SOURC     RETRIEVE POINTER TO STATEMENT 
      CCA           DECREMENT 
      ADA ERRCT       ERROR 
      STA ERRCT         COUNTER 
      SZA           ALL ERRORS DELETED? 
      JMP TAPE1     NO
      CPB SPTR      YES, PROGRAM REMAINING? 
      JMP TAPE3     NON.
      LDA SOURC     YES, SLIDE UP 
      LDB SPTR        OVER LAST 
      JSB MOVER         ERROR(S)
*                           * 
**  OUTPUT ERROR MESSAGES  ** 
*                           * 
TAPE3 LDA RETAD     SET 
      STA SERR        RETURN ADDRESS
      LDA WERRA     FAKE
      CMA,INA         'WARNING ONLY'
      STA LT5           ERROR MODE
TAPE4 CCB           FORCE 
      STB LT6         LINE NUMBER 
      LDB SPTR,I    MAKE LINE NUMBER OF 
      STB .LNUM       CURRENT ERROR ACCESSIBLE
      ISZ SPTR      LOAD
      LDA SPTR,I      ERROR NUMBER
      CLB           EXIT TO 
      JMP SERR1+3       ERROR PRINTER 
RETAD DEF *+1 
      ISZ SPTR      MORE
      LDA SPTR
      CPA PBPTR       ERRORS? 
      RSS           NO
      JMP TAPE4     YES 
TAPE5 LDA DEST      CORRECT POINTER TO
      STA PBPTR       LAST WORD +1 OF PROGRAM 
      CLF 0 
      LDA TERR      TURN
      AND CMSK  ERROR FLAG                       X] 
      STA TERR         OFF                       X] 
      STF 0 
      JSB RERRS+33,I  EMIT PARTING SHOT 
* 
TAPE6 STB DEST      SET DESTINATION POINTER 
      LDA 1           TO FIRST ERROR ENCOUNTERED
      JMP TAPE2 
TAPE7 STA TAP1      SAVE SOURCE ADDRESS 
      CMA,INA       COMPUTE SIZE OF AREA
      ADA DEST        TO BE RECLAIMED 
      STA TAP0          AND SAVE IT 
      ADA SPTR      RESET POINTER TO
      STA SPTR        LAST WORD +1 OF PROGRAM 
      LDB SOURC     SET POINTER TO
      ADB TAP0        NEXT STATEMENT
      STB SOURC         TO NEW VALUE
      LDA TAP1      RETRIEVE SOURCE ADDRESS 
      LDB PBPTR     RECLAIM 
      JSB MOVER       SPACE 
      LDB DEST      SET NEW POINTER TO
      STB PBPTR       PROTECTED AREA
      LDA SOURC     COMPUTE POINTER TO
      ADA .-3         CURRENT ERROR STATEMENT 
      STA DEST      SET NEW DESTINATION POINTER 
      JMP TAPE2+1 
**                              **
***  MOVE BLOCK TO LOWER CORE  ***
**                              **
* 
*  UPON ENTRY (B) POINTS TO THE LAST WORD +1 TO BE MOVED AND
*  (A) POINTS TO THE FIRST WORD TO BE MOVED.  DEST POINTS TO THE
*  FIRST WORD OF THE DESTINATION SPACE. 
* 
#MOVE STB NUMPT     SAVE POINTER TO LAST WORD+1  [E]
      LDB 0,I       TRANSFER
      STB DEST,I      WORD
      ISZ DEST      BUMP
      INA             POINTERS
      CPA NUMPT     DONE?                        [E]
      JMP MOVER,I   YES 
      JMP #MOVE+1   NO
* 
***   OUTPUT AN ERROR MESSAGE 
* 
#SERR CCA          COMPUTE                       X] 
      ADA SERR                                   X] 
      LDA 0,I      AND SAVE                      X] 
      ADA SERRA                                  X] 
      AND B777     ERROR NUMBER.                 X] 
      STA LT3                                    X] 
      ADA RERRA                                  X] 
      STA LT5      SYNTAX                        X] 
      SSA,RSS      ERROR?                        X] 
      JMP SERR1    NO                            X] 
      LDA TAPEF    YES,                          X] 
      AND LMSK      TAPE                         X] 
      SZA            MODE?                       X] 
      JMP SERR6    YES                           X] 
      CLB          NO                            X] 
      LDA SYMTB     IS SYMTB A FLAG?              (D) 
      CPA .+4       CHECK                         (D) 
      STB SYMTB     YES                           (D) 
      STB LT2      OUTPUT                        X] 
      LDA ASCER     'ERROR'                      X] 
      STA LT1        AND                         X] 
      LDA .-3         WAIT                       X] 
      JSB OUTST        FOR                       X] 
      JSB SCHIN,I       INPUT                    X] 
      CCA          SET                          X]
      ADA LBUFA,I   BUFFER                      X]
      STA BADDR      POINTER                    X]
      JSB GETCR    CARRIAGE RETURN ONLY?         X] 
      JMP SERR4    YES                           X] 
* 
***   PRINT ERROR MESSAGE 
* 
SERR1 LDA LT3                      [X]
*                                                X] 
      CLB          LOAD                          X] 
      STB LT6                                    X] 
      RRR 4         BIDRANT                      X] 
      STB LT3                                    X] 
      ADA DSERR      ADDRESS                     X] 
      LDB 0,I                                    X] 
      CLA           BLOCK THE CLOCK               (D) 
      STA DCLC1,I                                 (D) 
      LDA LT3       COMPUTE                       (D) 
      RAL                                         (D) 
      AND .+1       SECTOR                        (D) 
      ADA 1                                       (D) 
      LDB M128      AND                           (D) 
      STB WORD                                    (D) 
      LDB #LIBI     READ IT                       (D) 
      JSB DISC,I                                  (D) 
      LDA ENDSK     WAIT FOR                      (D) 
      SZA           DISC TRANSFER                 (D) 
      JMP *-2       TO COMPLETE                   (D) 
      STA LIB                                     (D) 
      LDB DEST      SAVE                          (D) 
      STB MVNDT     DEST                          (D) 
      LDB ERSCA     SET UP FOR                    (D) 
      STB LT1       ERROR STATEMENT               (D) 
      STB DEST      TRANSFER                      (D) 
      LDA LT3       COMPUTE                       (D) 
      ALF,ALF       MESSAGE ADDRESS               (D) 
      AND .112                                    (D) 
      ADA #LIB#                                   (D) 
      LDB .+17      MOVE MESSAGE TO               (D) 
      ADB 0         ERSEC BUFFER                  (D) 
      JSB MOVER                                   (D) 
      LDB MVNDT     RESTORE DEST                  (D) 
      STB DEST                                    (D) 
      LDA LT5       WAS THIS AN EXECUTION         (D) 
      SSA,RSS       ERROR?                        (D) 
      JMP SERR5     YES                           (D) 
      LDA B377      NO, OUTPUT A RUBOUT           (D) 
      JSB OUTCR     AND 7 BLANKS                  (D) 
      LDA .-7                                     (D) 
      STA LT3                                     (D) 
      LDA .+40B                                   (D) 
      JSB OUTCR                                   (D) 
      ISZ LT3                                     (D) 
      JMP *-3                                     (D) 
SERR2 LDA DCLC2,I   UNBLOCK THE CLOCK             (D) 
      STA DCLC1,I                                 (D) 
      CCB 
      LDA LT1,I     PRINT LINE NUMBER?
      SSA 
      JMP *+3       NO
      STB LT6       YES, SET FLAG 
      CMA,INA 
      CLB          OUTPUT                        X] 
      STB LT2       ERROR                        X] 
      JSB OUTST      MESSAGE                     X] 
      ISZ LT6      LINE NUMBER FLAG SET?         X] 
      JMP SERR3    NO                            X] 
      LDA LINEA    YES                           X] 
      STA LT1      PRINT                         X] 
      CLB                                        X] 
      LDA .-5       'IN LINE'                    X] 
      JSB OUTST                                  X] 
      LDB .LNUM    OUTPUT                        X] 
      JSB OUTIN    LINE NUMBER                   X] 
SERR3 LDA LT5      'BAD                          X] 
      ADA WERRA     INPUT'                       X] 
      SZA,RSS        ERROR                       X] 
      JMP SERR8    YES                           X] 
      STA LT5      NO - SAVE FOR RETURN CHECK    X] 
      LDA .+15B    OUTPUT                        X] 
      JSB OUTCR     CARRIAGE RETURN              X] 
SERR4 LDA .+12B    OUTPUT                        X] 
      JSB OUTCR     LINE-FEED                    X] 
      LDA LT5      WARNING                       X] 
      SSA          ONLY?                         X] 
      JMP SCHEN,I  NO                            X] 
      CLA          YES                           X] 
SERR8 STA CHRCT                                  X] 
      JMP SERR,I                                 X] 
*                                                X] 
SERR5 JSB ABCK,I    ANY ABORTS?                   (D) 
      LDA .+15B     NO, OUTPUT                    (D) 
      JSB OUTCR     CARRIAGE RETURN              X] 
      LDA .+12B      AND                         X] 
      JSB OUTCR       LINE-FEED                  X] 
      LDA LT5      WARNING                       X] 
      ADA WERRA    ERROR?                        X] 
      SSA,RSS                                    X] 
      JMP SERR2    YES                           X] 
      LDA CHNFG    NO                            X] 
      AND CMSK      CLEAR                        [X]
      STA CHNFG    CHAIN FLAG                    X] 
      LDB MAIN
      ADB .+?TSTA   REMOVE 'USER
      LDA B,I         IS RUNNING' 
      AND RNNBT         AND 'X-OFF' 
      AND XONBT           BITS FROM HIS 
      STA B,I               I/O STATUS
      JMP SERR2                                  X] 
SERR6 LDB PBPTR                                  X] 
      ADB .+2      STORE                         X] 
      LDA LT3      ERROR                         X] 
      STA 1,I      NUMBER                        X] 
      INB          SET POINTER TO                X] 
      STB SBPTR    LAST WORD+1 OF ERROR          X] 
      SZA,RSS      'OUT OF STORAGE' ERROR?       X] 
      ISZ SYMTB    YES                           X] 
      CLF 0        NO                            X] 
      LDA TERR     FIRST                         X] 
      IOR LMSK                                   X] 
      CPA TERR     ERROR?                        X] 
      JMP *+4      NO                            X] 
      STA TERR     YES - SET FLAG                X] 
      CLA          CLEAR                         X] 
      STA ERRCT    ERROR COUNTER                 X] 
      STF 0                                      X] 
      ISZ ERRCT    COUNT ERROR                   X] 
      JSB BCKSP    SEEK                          X] 
SERR7 JSB GETCR    CARRIAGE RETURN               X] 
      JMP ACCSA,I                                X] 
      JMP *-2                                    X] 
MVNDT NOP P{
*                                                X] 
ASCER DEF ERR-1                                  X] 
ERR   OCT 5105                                   X] 
      ASC 2,RROR                                 X] 
LINEA DEF *                                      X] 
      ASC 4, IN LINE                             X] 
      OCT 20000                                  X] 
