ASMB,R,Q,C
      HED <<RTE BASIC - MAIN CONTROL>>        92101-16001 REV.2040
      NAM BASIC,4,90 92101-16001 REV.2040 800805
* 
* 
**************************************************************
* (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1975.  ALL RIGHTS    *
* RESERVED.  NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, RE- *
* PRODUCED, OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITH-  *
* OUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY.  *
**************************************************************
* 
* 
*     NAME:      BASIC
*     SOURCE:    92101-18001
*     RELOC:     92101-16001
*     PGMR:      B.J.L
* 
* 
************************************************************* 
* 
      ENT SGMNT,FINDV,ERRPT,DRQST,WDRQS,GETCR,OUTCR,BCKSP,LETCK 
      ENT PRMT,REED,WRITE,PEXMK,RDYPT,OUTER,INTCK 
      ENT DIGCK,FNDPS,OUTIN,ENOUT,NUMOT,GETDG,RETCR 
      ENT RPRCS,PRNIN,OUTLN,NUMCK,SSYMT,MVTOH,RUN,COMND 
      ENT NORML,MBY10,DBY10,COMFL,PLIST,LOADT,.IENT,OLNCK 
      ENT ROTAT 
      EXT REIO,.FLUN,EXEC,READF,WRITF 
* 
      EXT ..FCM,.PACK,RMPAR,BASC1 
      EXT GMS.C,OLY.C,$OPSY 
      COM TEMPS(32),PNTRS(75),FILBF(16),FLDCB(144),SPEC(10) 
* 
* INCREASED PNTRS SIZE TO 75 *2040*800803*
* 
* INCREASED TEMPS SIZE TO 32 *800130*BL*
* 
**************************************
*                                    *
*        BASIC MAIN CONTROL          *
*                                    *
**************************************
* 
*  THIS PART OF THE INTERPRETER REMAINS CORE RESIDENT DURING
*    THE EXECUTION OF BASIC. IT INTERPRETS AND EXECUTES ALL 
*    OF THE SYSTEM COMMANDS BY LOADING THE APPROPRIATE SEGMENT
*    AND TRANSFERRING EXECUTION TO IT. UPON COMPLETION, THE 
*    SEGMENTS RETURN EXECUTION TO THIS PROGRAM.IN ADDITION, IT
*    PROVIDES FOR ALL USER COMMUNICATION WITH THE INTERPRETER.
*    THERE ARE 8 SEGMENTS WHICH MAY CALLED BY THE MAIN CONTROL: 
* 
*      SEGMENT #1: CHECKS SYNTAX AND TRANSLITERATES CODE
*      SEGMENT #2: LISTS THE PROGRAM
*      SEGMENT #3: CHECKS THE PROGRAM PRIOR TO EXECUTION
*      SEGMENT #4: EXECUTES THE PROGRAM 
*      SEGMENT #5: EXECUTES COMMANDS
*      SEGMENT #6: EXECUTES MORE COMMANDS 
*      SEGMENT #7: EXECUTES DEBUG COMMANDS
*      SEGMENT #8: EXECUTES NON-TIME DEPENDENT STATEMENTS 
* 
* 
*   TO RUN BASIC USE: 
* 
*      *ON,BASIC,CONSOLE LU,LIST LU,INPUT LU,OUTPUT LU, ERROR LU
* 
*         OR
* 
*      *ON,BASIC,NA,ME,XX,CONSOLE LU,LIST LU
* 
*         WHERE:  NAMEXX =  THE COMMAND FILE NAME 
* 
*************************** 
*                         * 
* CONSTANTS AND VARIABLES * 
*                         * 
*************************** 
* 
FWAM  EQU PNTRS     FIRST WORD OF AVAILABLE MEMORY
LWBM  EQU PNTRS+1   LAST WORD OF AVAILABLE MEMORY 
.INBF EQU PNTRS+2   INPUT BUFFER ADDRESS
SBUFA EQU PNTRS+3   SYNTAX BUFFER ADDRESS 
SYMTA EQU PNTRS+4   START OF SYMBOL TABLE 
SYMTF EQU PNTRS+5   END OF SYMBOL TABLE 
PBUFF EQU PNTRS+6   FIRST WORD OF USER PROGRAM
PBPTR EQU PNTRS+7   LAST WORD+1 OF USER PROGRAM 
INBFA EQU PNTRS+8   INPUT BUFFER POINTER
ICCNT EQU PNTRS+9   INPUT CHARACTER COUNT 
SBPTR EQU PNTRS+10  SYNTAX BUFFER POINTER 
.LNUM EQU PNTRS+11  CURRENT LINE #
FCORE EQU PNTRS+12  START OF FREE CORE
MNNAM EQU PNTRS+13  MNEMONIC TABLE NAME:SC:LU 
BRNAM EQU PNTRS+18  BRANCH TABLE NAME:SC:LU 
FWAMM EQU PNTRS+23  POINTER TO START OF MNEMONIC TABLE
FWAMB EQU PNTRS+24  POINTER TO START OF BRANCH TABLE
.OTBF EQU PNTRS+25  POINTER TO OUTPUT BUFFER 
OCCNT EQU PNTRS+26  OUTPUT CHARACTER COUNT
OTBFA EQU PNTRS+27  POINTER INTO OUTPUT BUFFER
LUOUT EQU PNTRS+28  CURRENT OUTPUT L.U. # 
LUINP EQU PNTRS+29  CURRENT INPUT L.U. #
SIGN  EQU PNTRS+30  SIGN OF CURRENT NUMBER
BLANK EQU PNTRS+31  CURRENT TERMINATION CHAR
REC#  EQU PNTRS+32  COMMAND FILE RECORD NUMBER
FLTYP EQU PNTRS+33  TYPE 0 FILE FLAG
TTYPR EQU PNTRS+34  CONSOLE TTY L.U. #
PRINT EQU PNTRS+35  LISTING L.U. #
READR EQU PNTRS+36  AUXILLIARY INPUT L.U. # 
PUNCH EQU PNTRS+37  AUXILLIARY OUTPUT L.U. #
ERTTY EQU PNTRS+38  ERROR LIST OUTPUT L.U. #
DCB   EQU PNTRS+39  DATA CONTROL BLOCK ADDRESS
FILBK EQU PNTRS+40  FILE CONTROL BLOCK ADDRESS
PFLAG EQU PNTRS+41  SAVE,LOAD FILE FLAG 
LOLIM EQU PNTRS+42  LOW LIMITS OF PROGRAM 
HILIM EQU PNTRS+43  HIGH LIMITS OF PROGRAM
LORUN EQU PNTRS+44  LOW RUN LIMITS
HIRUN EQU PNTRS+45  HIGH RUN LIMITS 
SLSTM EQU PNTRS+46  EXECUTE SLOW STMTS
LOTRC EQU PNTRS+47  LOW TRACE LIMITS
HITRC EQU PNTRS+48  HIGH TRACE LIMITS 
BRKP1 EQU PNTRS+49  BREAK POINT #1
BRKP2 EQU PNTRS+50  BREAK POINT #2
BRKP3 EQU PNTRS+51  BREAK POINT #3
BRKP4 EQU PNTRS+52  BREAK POINT #4
SMFLG EQU PNTRS+53  SIMULATE FLAG 
TYPE  EQU PNTRS+54  PARTIAL LINE CHARACTER COUNT
DLMTR EQU PNTRS+55  CHAR EDIT DELIMITER 
MERGF EQU PNTRS+56  MERGE FLAG
COMN  EQU PNTRS+57  COMMAND FILE NAME 
MANT1 EQU PNTRS+60  MANTISSA #1 
MANT2 EQU PNTRS+61  MANTISSA #2 
EXPNT EQU PNTRS+62  EXPONENT
INLOC EQU PNTRS+63  INV. LOC. LU,STRK,#TKRS 
INTKZ EQU PNTRS+64  TRACK SIZE ON DISC FOR INV. 
HSTPT EQU PNTRS+65  HIGH-STACK POINTER
TSTPT EQU PNTRS+66  TEMPORARY STACK POINTER 
LSTPT EQU PNTRS+67  LOW-STACK POINTER 
LSTAK EQU PNTRS+68  LOW-STACK ADDRESS 
PRADD EQU PNTRS+69  PROGRAM EXECUTION 
DSTRT EQU PNTRS+70  DATA
NXTDT EQU PNTRS+71    STATEMENT 
DCCNT EQU PNTRS+72      POINTERS
NXTST EQU PNTRS+73      NEXT STMT 
TRAPF EQU PNTRS+74  TRAP BUSY FLAG *800803*BL*
SYFLG BSS 1         SYNTAX SEGMENT FLAG 
TEMPT BSS 15
* 
RDYA  DEF READY 
QMRKA DEF QMARK 
ACKNA DEF ACKNW 
      SPC 1 
      SUP PRESS MULTIPLE LISTING
      SPC 1 
.1    DEC 1 
.2    DEC 2 
.3    DEC 3 
.4    DEC 4 
.5    DEC 5 
.6    DEC 6 
.8    DEC 8 
.9    DEC 9 
.12   DEC 12
.15   DEC 15
.26   DEC 26
.32   DEC 32
.36   DEC 36
.39   DEC 39
.40   DEC 40        *2001*MM***ADD
.43   DEC 43
.45   DEC 45
.46   DEC 46
.48   DEC 48
.49   DEC 49
.58   DEC 58
.66   DEC 66        *2001*MM***ADD
.80   DEC 80
.81   DEC 81        *2001*MM***ADD
.132  DEC 132       *2001*MM***ADD
.9999 DEC 9999
B77   OCT 77
E     OCT 105 
B177  OCT 177 
B377  OCT 377       *2001*BL***ADD
B200  OCT 200 
MSK0  OCT 377 
B700  OCT 700 
TENTH OCT 63146 
RCODE OCT 100001
WCODE OCT 100002
HIMSK OCT 174000
MSK   OCT 177400
M1    DEC -1
M2    DEC -2
M4    DEC -4
M5    DEC -5
M6    DEC -6
M7    DEC -7
M8    DEC -8
M9    DEC -9
M14   DEC -14 
M40   DEC -40    *2040*800803     
M80   DEC -80 
D72   OCT -72 
M132  DEC -132      *2001*MM***ADD
M256  DEC -256
D133  OCT -133
M1000 DEC -1000 
M2001 DEC -2001       *2040* 800314 
MSK3  EQU M7
* 
QMARK ASC 1,?_                              : 
ACKNW ASC 1,>_                              : 
READY OCT 6412
      ASC 6,BASIC READY 
SEG   ASC 3,BASC
SGMSK OCT 30040 
HOLD  NOP 
HOLD1 NOP 
SEG#  DEC -9
ERBUF DEF *+1 
      ASC 19,SEGMENT NOT FOUND.  BASIC TERMINATED!
ERLEN DEC -38 
* 
* 
*2001*MM* 
* 
      SKP 
**********************
*                    *
* BASIC MAIN CONTROL *
*                    *
**********************
BASIC NOP           ENTRY 
* 
      JSB RMPAR     FETCH LOGICAL 
      DEF *+2         UNIT NUMBERS
      DEF TTYPR 
      LDA .9999     SET FLAG TO 
      STA PFLAG       TO ENABLE BASIC INIT. 
      CLA           CLEAR INVOKE
      STA INLOC      FLAG FIRST TIME
********************************************************************
      LDA $OPSY     IF RTE-4, THEN USE NEW GMS.C FOR FWAM AND LWAM
      CPA M9        LENGTHS FOR LARGEST SEGMENT AND 
      RSS           2ND LARGEST SEGMENT FWAM'S
      JMP LDB3
      CLA           CLEAR OUT FWAM AND FWAMM
      STA FWAM      LARGEST FWAM
      STA FWAMM     2ND LARGEST FWAM
BASCI ISZ SEG#      NEG. SEGMENT COUNT (INIT. AT -9)
      RSS           STILL SOME LEFT 
      JMP LDB3      DONE! 
      LDB SEG#      GET SEGMENT # AND SET POS.
      CMB,INB 
      CPB .3        WANT TO DO SEG. 3 LAST SINCE IT IS TRUE 
      JMP BASCI     INITIALIZATION SEGEMENT 
      JMP SGMNT     GO LOAD SEGMENT AND GET FWAM AND LWAM 
ROTAT STA HOLD      RET. HERE WITH A=FWAM B=LWAM
      CMA,INA       NEGATE FOR TESTING
      STA HOLD1 
      ADA FWAM      IS THIS LARGEST?
      SSA 
      JMP FINI      YES, REPLACE CURREST FWAM WITH NEW
      LDA HOLD1     IS THIS SECOND LARGEST? 
      ADA FWAMM 
      SSA,RSS 
      JMP BASCI     NO, GET NEXT SEGMENT
      LDA HOLD      YES, REPLACE CURRENT FWAMM WITH NEW 
      STA FWAMM 
      JMP BASCI     GET NEXT SEGMENT
FINI  LDA FWAM      MOVE LARGEST TO 2ND LARGEST 
      STA FWAMM 
      LDA HOLD      REPLACE CURRENT FWAM WITH NEW 
      STA FWAM
      STB TEMP1     AND SAVE THE ASSOCIATED LWAM
      JMP BASCI     GO GET NEXT SEGMENT 
***************************************************************** 
LDB3  LDB .3        GO TO SEG #3 TO INITIALIZE BASIC
      SPC 1 
SGMNT BLF,BLF       LOAD ALL BASIC SEGMENTS HERE
      ADB SGMSK 
      STB SEG+2 
      JSB OLY.C     OVERLAY ROUTINE FROM COMPILER LIB.
       DEF SEG
       ISZ FLTYP
      LDA TTYPR 
      AND MSK0
      CPA TTYPR 
      RSS 
      CLA,INA 
      STA LUOUT 
       LDA ERLEN    HERE IF SEGMENT NOT FOUND BY OLY.C
       LDB ERBUF    PRINT MESSAGE AND TERMINATE 
       JSB WRITE
       JMP BYE
       SPC 1
RDYPT LDA TTYPR     SET UP
      STA LUOUT       INPUT AND 
      STA LUINP         OUTPUT DEVICE UNITS 
      LDA M14       PRINT 
      LDB RDYA        THE BASIC'S 'NAME'
      JSB WRITE         AND 'READY' 
      JMP PRMT      PROMPT! 
      SPC 1 
*  EXECUTION RETURNED HERE FROM SEGMENT #1
      SPC 1 
* 
*  PFLAG MAY HAVE THE FOLLOWING VALUES: 
* 
*     PLFAG = -1  INPUT FROM TAPE 
*     PFLAG = 0   INPUT FROM KEYBOARD 
*     PFLAG = 1   INPUT FROM PROGRAM FILE 
*     PFLAG = 2   INPUT FROM 'CHAIN' OR 'INVOKE' STATEMENT
*     PFLAG = 3   LOAD B&M TABLE FLAG 
*     PFLAG = 4   INPUT FROM COMMAND FILE 
*     PFLAG = 5   RUN A PROGRAM BY NAME 
*     PFLAG = 9999 EXECUTE INITIALIZATION IN SEG 3(ONCE ONLY) 
* 
PEXMK LDA PFLAG 
      CPA .1        FILE? 
      JMP LOADF     YES!
      CPA .2        CHAIN?
      JMP LOADF     YES!
      CPA .5        RUN <PROG NAME>?
      JMP LOADF     YES!
      SZA           IS TAPE FLAG SET? 
      JMP MORTP     GET RECORD FROM PHOTO RDR 
* 
*  EXECUTION RETURNED HERE FROM SEGMENTS #5 AND #6
* 
PRMT  LDA TTYPR     INITIALIZE
      STA LUOUT       INPUT AND 
      STA LUINP         OUTPUT DEVICES UNITS
      CLA,INA       INITIALIZE
      STA LOLIM       LOW LIMIT 
      STA LORUN 
      LDA .9999     INITIALIZE
      STA HILIM       HIGH LIMIT
      STA HIRUN 
      CLA 
      STA SLSTM     CLEAR SLOW STMT FLAG
      STA DRQST     CLEAR DATA REQUEST FLAG 
      STA PFLAG     CLEAR TAPE INPUT FLAG 
      STA SYFLG     CLEAR SYNTAX SEGMENT FLAG 
      STA MERGF     CLEAR OUT MERGE FLAG
      CCA           SET FOR 
      STA FLTYP       NO TYPE 0 I-O 
      LDA REC#      ARE WE IN 
      CPA .1          COMMAND FILE? 
      RSS           NO! 
      JMP COMFL     YES,CONTINUE
      LDA M2
      LDB ACKNA 
      JSB WRITE     PRINT '>' WITH NO CR-LF 
      JMP GTRCD     INPUT RECORD
      SPC 1 
*  WARNING DATA INDICATION-PRINTS EXTRA QUESTION MARK 
      SPC 1 
WDRQS NOP 
      LDA LUINP 
      AND B77        STRIP OFF CONTROL BITS 
      JSB FINDV     IS IT DVR05, SC0 OR DVR00?
      SZA,RSS       DVR00?
      JMP QMK       YES, PRINT QUESTION MARK! 
      CPA .5        DVR05?
      RSS           YES 
      JMP WDRQS,I   NO! 
      SZB           SC=0(KEYBD)?
      JMP WDRQS,I   NO! 
QMK   LDA M2        OUTPUT
      LDB QMRKA 
      JSB WRITE       '?' AND WAIT
      JMP WDRQS,I   RETURN
      SPC 1 
*  PROCESS DATA REQUEST 
      SPC 1 
DRQST NOP 
      LDA FLTYP     TYPE 0 FILE?
      SZA,RSS 
      JMP GTRCD     YES!
      JSB WDRQS     PRINT QUESTION MARK!
      SPC 1 
*  INPUT RECORD FROM TTY
      SPC 1 
GTRCD LDA M80 
      LDB .INBF 
      JSB REED      GET RECORD FROM IT
      SPC 1 
*  PROCESS RECORD 
      SPC 1 
RPRCS CMA           SET A = -1# CHARS 
      STA ICCNT     SET CHAR COUNT
      STA TEMP8     SET FOR ERROR PRINT OUT 
      LDB .INBF     LOAD BUFFER ADDRESS 
      CLE,ELB       SHIFT LEFT,LEAST BIT USED AS
      STB INBFA      ODD/EVEN FLAG
      SZA,RSS        NULL RECORD ?
      JMP GTRCD       YES, INPUT AGAIN
      LDB DRQST 
      SZB,RSS       DATA REQUEST? 
      JMP RPRC0     NO DATA REQUEST,GO CHECK RECORD 
      CLA 
      STA DRQST     CLEAR DATA REQUEST FLAG 
      JMP 1,I         AND FAKE THE RETURN THRU DRQST
      SPC 1 
*  LOAD SYNTAX SEGMENT AND BRANCH TO IT 
      SPC 1 
RPRC0 JSB GETCR     GET FIRST CHARACTER 
       JMP GTRCD      UNLESS THERE ISN'T ONE
CKRCD LDB SBUFA     INITIALIZE SYNTAX 
      STB SBPTR       BUFFER POINTER
      STA 1,I       PUT FIRST CHAR IN SYNTAX BUFFER 
      CPA DLMTR     LIST NEXT LINE COMMAND? 
      JMP COMND     YES, LIST IT! 
      JSB LETCK     IS THIS A LETTER? 
       RSS          NO, GO TO SYNTAX PHASE
      JMP COMND     YES, GO TO COMMAND PHASE
      LDA SYFLG     LOAD SYNTAX SEGMENT FLAG
      SZA           IS SEGMENT IN CORE? 
      JSB BASC1     YES, BRANCH TO IT 
      CCA           SET SYNTAX SEGMENT FLAG 
      STA SYFLG 
* 
      LDB .1        LOAD
      JMP SGMNT       SEGMENT #1
* 
BYE   JSB EXEC      TERMINATE BASIC 
      DEF *+2 
      DEF .6
      SKP 
*  EXECUTION RETURNED HERE WHEN ERROR OCCURS
*    SET FOR PRINTING ERROR MESSAGE 
      SPC 1 
OUTER CCA           SET L.U. NEGATIVE FOR FLAG
      STA LUOUT       TO INDICATE ERROR MESSAGE 
      JMP PLIST     BRANCH TO LIST SEGMENT
      SPC 1 
*  EXECUTION RETURNED HERE AFTER PRINTING ERROR MESSAGE 
*    SET FOR LOADING SYNTAX SEGMENT AGAIN 
      SPC 1 
ERRPT CLA          CLEAR SYNTAX SEGMENT FLAG
      STA SYFLG 
      STA PFLAG       AND FILE FLAG 
      INA           SET FOR END 
      STA REC#        OF COMMAND FILE INPUT 
      JMP PEXMK     GO WAIT FOR INPUT 
* 
*  GO TO SEG 6 TO INPUT COMMAND FILE
* 
COMFL LDA .4        SET FOR 
      STA PFLAG       COMMAND FILE
      LDB .6        LOAD
      JMP SGMNT       SEGMENT #6 FOR COMMAND FILE 
      SKP 
*  PROCESS SYSTEM COMMANDS
      SPC 1 
*  LOAD COMMAND SEGMENT 
      SPC 1 
*     COMES HERE THROUGH SYNTAX SEGMENT (A) CONTAINS FIRST
*     CHARACTER OF COMMAND
* 
COMND CLB           CLEAR SYNTAX FLAG 
      STB SYFLG 
      LDB .5        LOAD SEG#5 FOR
      JMP SGMNT       COMMANDS
      SPC 1 
*  PROCESS 'RUN' COMMAND
      SPC 1 
RUN   LDB .3        LOAD SEG#3
      JMP SGMNT       TO START EXECUTION
      SPC 1 
      SPC 1 
*  PROCESS 'SAVE' & 'LIST' COMMAND
      SPC 1 
PLIST LDB .2        LOAD SEG#2
      JMP SGMNT       TO LIST PROGRAM 
      SPC 1 
*  PROCESS 'LOAD' COMMAND 
      SPC 1 
LOADT LDA PFLAG     IS INPUT
      CPA .1          FROM FLAG?
      JMP LOADF     YES!
      CPA .2        FROM 'CHAIN'
      JMP LOADF     YES!
      CPA .5        RUN <PROG NAME> 
      JMP LOADF     YES!
      LDA READR     SET L.U. TO READER
      STA LUINP 
      AND B77       ISOLATE L.U. #
      IOR B700      MERGE IN FUNCTION CODE
      STA LENTH       SAVE IT 
*2040*800805* 
      JSB EXEC      CALL EXEC 
      DEF LOA1
      DEF AB3        TO SET EOT BIT 
      DEF LENTH 
LOA1  JMP RWERR     NO ABORT RETURN 
*2040*800805* 
* 
MORTP LDA M80 
      LDB .INBF 
      JSB REED      GET RECORD FROM READER
      CPA M1        END OF TAPE?
      JMP RDYPT     YES 
      SZA,RSS 
      JMP MORTP     NULL RECORD 
      CCB           SET PFLAG=-1
      STB PFLAG     SET TAPE INPUT FLAG # 0 
      JMP RPRCS     GO PROCESS RECORD 
* 
LOADF JSB READF     INPUT RECORD
      DEF *+6 
      DEF DCB,I 
      DEF FERR
      DEF .INBF,I 
      DEF .40       *2001*MM***R: DEF .36 
      DEF LENTH 
      JSB CKERR     FILE ERROR? 
      LDA LENTH     EOF?
      SZA,RSS       ZERO LENGTH?
      JMP LOADF     YES, GET ANOTHER
      SSA             ENCOUNTERED?
      JMP LOAD1     YES, CLOSE
      RAL           SET UP
      STA ICCNT       CHAR COUNT FOR INPUT BUFFER 
      JMP RPRCS     NO, PROCESS RECORD
* 
* 
LOAD1 LDA PFLAG     'CHAIN' 
      CPA .2          STATEMENT?
      JMP RUN       YES, RUN PROGRAM
      CPA .5        RUN <PROG NAME>?
      JMP RUN       YES!
      LDA REC#      INPUT FROM COMMAND
      CPA .1          FILE? 
      JMP RDYPT     NO! 
      JMP COMFL     YES!
* 
      SKP 
***********************
*********************** 
*                     * 
* UTILITY SUBROUTINES * 
*                     * 
*********************** 
* 
*  THE FOLLOWING SUBROUTINES ARE USED BY THE SEGMENTS OF THE
*    BASIC INTERPRETER AND THEREFORE ARE CORE RESIDENT. THEY
*    ARE DEFINED IN THE SEGMENTS AS BEING EXTERNAL. 
* 
* 
* 
* 
********************
*                  *
* CHECK FOR LETTER *
*                  *
********************
LETCK NOP          CHARACTER IN (A) 
      LDB 0 
      ADB D133     ASCII 133B 
      SSB,RSS        OR GREATER?
      JMP LETCK,I  YES, EXIT WITH CHARACTER IN (A)
      ADB .26       NO, ASCII 101B
      SSB,RSS        OR GREATER?
      ISZ LETCK     YES 
      JMP LETCK,I  NO 
******************* 
*                 * 
* CHECK FOR DIGIT * 
*                 * 
******************* 
DIGCK NOP          CHARACTER IN (A) 
      LDB 0 
      ADB D72      ASCII 72B
      SSB,RSS        OR GREATER?
      JMP DIGCK,I  YES, RETURN WITH CHARACTER 
      ADB .10       NO, ASCII 60B 
      SSB            OR GREATER?
      JMP DIGCK,I  NO 
      ISZ DIGCK    YES, SET 'SUCCESS' EXIT, 
      LDA 1          LOAD DIGIT INTO (A), 
      JMP DIGCK,I      AND RETURN 
      SKP 
***************************** 
*                           * 
* ADD CHAR TO OUTPUT BUFFER * 
*                           * 
***************************** 
OUTCR NOP           CHARACTER IN (A)
      STA TEMP4     SAVE CHARACTER
      LDA .OTBF     ADDRESS AND OFFSET TO CHECK 
      ADA .66         BUFFER LENGTH  *2001*MM***R: ADA .39
      CPA OTBFA     TRUNCATE ANY CHARACTERS OVER 132 COLUMNS
      JMP OUTCR,I 
      ISZ OCCNT      COUNT CHARACTERS 
      LDB OCCNT     FIRST CHARACTER 
      SLB             OF BUFFER WORD? 
      ISZ OTBFA     YES, MOVE TO FRESH WORD 
      LDA OTBFA,I   LOAD BUFFER WORD
      SLB           SAVE
      ALF,ALF         OTHER 
      AND M256          CHARACTER 
      IOR TEMP4     ADD NEW CHARACTER 
      SLB           POSITION
      ALF,ALF         WORD AND
      STA OTBFA,I       STORE IT
      JMP OUTCR,I 
******************************
*                            *
* GET CHAR FROM INPUT BUFFER *
*                            *
******************************
GETCR NOP 
      ISZ ICCNT     ANY CHARACTERS LEFT?
      RSS 
      JMP GETCR,I   NO, END-OF-FILE EXIT
      LDB INBFA     LOAD BUFFER ADDRESS 
      ISZ INBFA     UPDATE FOR NEXT TIME
      CLE,ERB       SET CHARACTER FLAG
      LDA 1,I       LOAD CURRENT BUFFER WORD
      SEZ,RSS       FIRST CHARACTER?
      ALF,ALF       YES, POSITION IT
      AND B377      MASK EXTRA BITS  *2001*BL***R: AND B177 
      CPA BLANK     BLANK?
      JMP GETCR+1   YES, FETCH NEXT CHARACTER 
      ISZ GETCR     UPDATE RETURN ADDRESS 
      JMP GETCR,I     AND EXIT
*************************** 
*                         * 
* BACKSPACE OVER ONE CHAR * 
*                         * 
*************************** 
BCKSP NOP 
      CCA          BACKSPACE
      ADA ICCNT      OVER 
      STA ICCNT        LAST 
      CCA                CHARACTER IN 
      ADA INBFA            INPUT
      STA INBFA              BUFFER 
      JMP BCKSP,I 
      SKP 
***************************** 
*                           * 
*  INITIALIZE FOR NEW LINE  * 
*                           * 
***************************** 
* 
PRNIN NOP 
      CCA           INITIALIZE
      ADA .OTBF       BUFFER
      STA OTBFA         POINTER 
      CLA           INITIALIZE
      STA OCCNT       CHARACTER COUNTER 
      JMP PRNIN,I 
      SPC 1 
************************* 
*                       * 
* OUTPUT COMPLETED LINE * 
*                       * 
************************* 
OUTLN NOP 
      LDA OCCNT     OUTPUT
      LDB .OTBF       A 
      JSB WRITE         LINE
      JSB PRNIN     CLEAN UP OUTPUT BUFFER
      STA TYPE      RESET PARTIAL LINE COUNTER
      JMP OUTLN,I 
* 
* 
***************************** 
*                           * 
*  CHECK FOR LINE OVERFLOW  * 
*                           * 
***************************** 
* 
*                     AT ENTRY, A = NUMBER OF CHARACTERS
*                                    TO BE OUTPUT, EXCLUSIVE
*                                    OF TRAILING BLANKS.
*                     THIS ROUTINE CHECKS FOR LINES OVER 132
*                     CHARACTERS, AND OUTPUTS THEM BEFORE 
*                     FIGURING THE END OF FIELD FOR NUMERIC 
*                     FORMATTING.  THE END OF FIELD COLUMN
*                     NUMBER IS RETURNED IN TEM10.
* 
OLNCK NOP 
      STA BCKSP     SAVE REQUEST LENGTH TEMPORARILY 
      ADA OCCNT     FIGURE LENGTH OF BUFFER 
      ADA TYPE      FIGURE COLUMN OF RESULT 
      CMA,INA 
      ADA .132      TOO MANY CHARS?  *2001*MM***R: ADA .80
      SSA 
      JSB OUTLN       YES, OUTPUT LINE FIRST
      LDA BCKSP     RECOVER REQUEST LENGTH
      ADA OCCNT       AND FIGURE
      ADA .3            THE END-OF-FIELD
      STA TEM10           COLUMN NUMBER 
      JMP OLNCK,I 
      SKP 
******************************* 
*                             * 
*  FIND OUT THE  DEVICE TYPE  * 
*                             * 
******************************* 
* 
*  ON INPUT (A) = LU NUMBER 
*  ON EXIT  (A) = DVR NUMBER
*           (B) = SUB CHANL NUMBER
* 
FINDV NOP 
      STA SLU       SET UP STATUS EXEC CALL 
      JSB EXEC        TO FETCH EQUIP TYPE CODE
      DEF FIND1         AND SUBCHANNEL NUMBER 
      DEF AB13      *2040*800805*NO ABORT 
      DEF SLU 
      DEF EQT5
      DEF EQT4
      DEF SBCHN 
FIND1 JMP RWERR 
      LDA SBCHN     FETCH SC AND
      AND MSK0        REMOVE DOWN BIT 
      LDB 0         LEAVE IT IN (B) 
      LDA EQT5
      ALF,ALF       FETCH EQUIP CODE
      AND B77 
      JMP FINDV,I 
* 
.13   DEC 13
SLU   NOP 
EQT5  NOP 
EQT4  NOP 
SBCHN NOP 
AB3   OCT 100003      *2040*800805* 
AB13  OCT 100015      *2040*800805* 
* 
      SKP 
********************
*                  *
* FIND A STATEMENT *
*                  *
********************
* 
* UPON ENTRY (A) = SEQUENCE NUMBER  TO BE FOUND. IF (A) 
* IS LARGER THAN ANY SEQUENCE NUMBER IN THE PROGRAM, EXIT 
* TO (P+1) WITH (B) POINTING TO LAST WORD+1 OF THE PROGRAM
* IF (A) FALLS BETWEEN TWO SEQUENCE NUMBERS, EXIT TO (P+2)
* WITH (B) POINTING TO THE STATEMENT WITH THE LARGER SEQUENCE 
* NUMBER. IF A STATEMENT IN THE PROGRAM HAS THE SEQUENCE
* NUMBER THEN EXIT TO (P+3) WITH (B) POINTING TO THIS STATEMENT.
* 
FNDPS NOP 
      STA TEMP3     SAVE SEQUENCE NUMBER
      LDB PBUFF     STARTING ADDRESS
FNDP1 CPB PBPTR     END OF PROGRAM? 
      JMP FNDP4     YES, EXIT VIA (P+1) 
      LDA TEMP3     SUBTRACT PROGRAM
      CMA,INA         SEQUENCE NUMBER FROM
      ADA 1,I         S-BUFFER SEQUENCE NUMBER
      SZA,RSS       EQUAL?
      ISZ FNDPS     YES, SET EXIT TO (P+3)
      SSA,RSS       NO, P-SEQ NO > S-SEQ NO ? 
      JMP FNDP3     YES, SET EXIT TO (P+2)
      LDA 1         POINT (A) TO
      INA             PROGRAM ADDRESS INCREMENT 
      ADB 0,I       COMPUTE NEW ADDRESS 
      JMP FNDP1 
FNDP3 ISZ FNDPS 
FNDP4 STB TEMP3     SAVE STATEMENT ADDRESS
      JMP FNDPS,I 
***************************** 
*                           * 
* MOVE WORDS TO HIGHER CORE * 
*                           * 
***************************** 
MVTOH NOP 
      LDB TEMP2     FETCH SOURCE ADDRESS
MVTO1 CPB TEMP3     ALL RELOCATION DONE?
      JMP MVTOH,I   YES, EXIT 
      CCA           BACK UP 
      ADB 0 
      ADA TEMP4       SOURCE AND
      STA TEMP4         DESTINATION 
      LDA 1,I       MOVE
      STA TEMP4,I     WORD
      JMP MVTO1