ASMB,R,Q,C
      HED <<RTE-BASIC - EXECUTE/SEG #8>>      92076-1X009 REV.2040
      NAM BASC8,5 92076-1X009 REV.2040 800727 92076-16001 
* 
* 
* 
**************************************************************
* (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979.  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:     BASC8 
*   SOURCE:   92076-18009 
*   RELOC:    PART OF 92076-16001 
*   PGRM:     B.J.L.
* 
* 
      ENT BASC8 
      EXT IFBRK,TRAP,RDYPT,OUTER,OUTLN,OUTIN,WRITE,FINDV
      EXT FLOAT,IFIX,PRNIN,REED,COMFL,DIGCK,GETCR,NAMR
      EXT SGMNT,EXEC,CLOSE,READF,WRITF,OPENF,.SBT,PURGE 
      COM TEMPS(32),PNTRS(81),FILBF(16),FLDCB(144),SPEC(10) 
* 
*PNTRS INCREASED TO 81  800727***** 
*TEMPS INCREASED TO 32  800107********************
*****ADDED CALLS TO OPENF, .SBT, NAMR  798023*****
*****ADDED CALLS TO PURGE  790904*****************
*PNTRS INCREASED TO 79  790831**************************************
*PNTRS INCREASED TO 80  791010**************************************
*****REMOVED CALLS TO OPEN 790829*****************
***************************************** 
*                                       * 
*    SEGMENT #8: EXECUTE THE PROGRAM    * 
*                                       * 
***************************************** 
* 
*  THIS PART OF THE INTERPRETER IS LOADED BY THE EXECUTE PHASE OF 
*    BASIC TO PERFORM CERTAIN FUNCTION WHICH ARE NOT TIME CRITICAL. 
*    CONTROL IS PASSED TO THIS SEGMENT WITH THE VARIABLE 'XSEG7' IN-
*    DICATING WHICH FUNCTION IS TO BE PERFORMED.  AFTER COMPLETION OF 
*    THE FUNCTION, CONTROL IS RETURNED TO EXECUTE SEGMENT 4 AND 
*    EXECUTION OF THE USER'S PROGRAM IS RESUMED.
      SKP 
*************************** 
*                         * 
* 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
*******CHANGED FOR L USAGE OF GETST 790409********************* 
TTYPR EQU PNTRS+34  CONSOLE TTY L.U. #
TTYP1 EQU PNTRS+35  3RD AND 4TH CHAR
TTYP2 EQU PNTRS+36  5TH AND 6TH CHAR
TTYP3 EQU PNTRS+37  SECURITY CODE OF FILE 
TTYP4 EQU PNTRS+38  CRN # OF FILE 
****************************************************************
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
****************************790713****************************
COMN  EQU PNTRS+57  COMMAND FILE NAME:SC:CRN
MANT1 EQU PNTRS+62  MANTISSA #1 
MANT2 EQU PNTRS+63  MANTISSA #2 
EXPNT EQU PNTRS+64  EXPONENT
*************************CHANGED 790831****************************** 
*************************CHANGED 791010****************************** 
INNAM EQU PNTRS+65  NAME RTN. FROM CRETS (3 WORDS)
INNUM EQU PNTRS+68  SCRATCH FILE # AND COUNTER
HSTPT EQU PNTRS+69  HIGH-STACK POINTER
TSTPT EQU PNTRS+70  TEMPORARY STACK POINTER 
LSTPT EQU PNTRS+71  LOW-STACK POINTER 
LSTAK EQU PNTRS+72  LOW-STACK ADDRESS 
PRADD EQU PNTRS+73  PROGRAM EXECUTION 
DSTRT EQU PNTRS+74  DATA
NXTDT EQU PNTRS+75    STATEMENT 
DCCNT EQU PNTRS+76      POINTERS
NXTST EQU PNTRS+77      NEXT STMT NUMBER 
*********MOVED FROM BEHIND TTYPR FOR L 790409******** 
PRINT EQU PNTRS+78     LISTING LU#
ERTTY EQU PNTRS+79     ERROR LU#
TRAPF EQU PNTRS+80  TRAP BUSY FLAG  800727******
************************790831******************************
*READR NOP              **REMOVED 790828*** 
*PUNCH NOP              **REMOVED 790828*** 
********************************************************************
      SKP 
TEMPT BSS 7 
      SPC 1 
ERBS  DEF ERR-1 
DCBAD DEF FLDCB     ADDRESS OF DATA CONTROL BLOCK 
      SPC 1 
      SUP PRESS MULTIPLE LISTINGS 
      SPC 1 
.0    DEC 0 
.1    DEC 1 
.2    DEC 2 
.3    DEC 3 
.4    DEC 4 
.5    DEC 5 
*.7    DEC 7           **REMOVED 790823*****
*.8    DEC 8          **REMOVED 790823******
.10   DEC 10
.13   DEC 13
.15   DEC 15
.31   DEC 31
.16   DEC 16
.32   DEC 32
.43   DEC 43
.45   DEC 45
.48   DEC 48
.64   DEC 64
.128  DEC 128 
.9999 DEC 9999
B40   EQU .32        ***791227*** 
B54  OCT 54 
B72  OCT 72 
B177 OCT 177
B200 OCT 200
B377 OCT 377
HIMSK OCT 177400
*INF   OCT 77777      **REMOVED 790823******
MNEG  OCT 100000
DSERR OCT 140000
M1    DEC -1
M2    DEC -2
M3    DEC -3       *****ADDED 790928************
*M4    DEC -4          **REMOVED 790823************ 
M5    DEC -5
M6    DEC -6
M10   DEC -10 
M16   DEC -16 
M17   DEC -17       ***ADDED 790829*****************
M20   DEC -20 
M32   DEC -32 
PMESS DEF *+1 
      OCT 6412
      ASC 4,PAUSE  _                                       :
QMARK DEF *+1 
      ASC 1,??
AMESS DEF *+1 
      OCT 6412
      ASC 15,OPERATOR TERMINATION IN LINE _    :
GO    ASC 1,GO
CTRLQ OCT 10400 
HOLD  NOP            ADDED *800122* 
      SKP 
* 
********************************* 
*                               * 
*  OVERFLOW STMT ADDRESS TABLE  * 
*                               * 
********************************* 
* 
XECTB DEF *         STATEMENT ADDRESS TABLE 
      DEF EASSN     1-ASSIGN STMT 
      DEF EPAZ      2-PAUSE STMT
      DEF EEND      3-STOP END STMT 
      DEF OPEND     4-END STMT
* 
      SKP 
****************************************
*                                      *
* EXECUTE THE OVERFLOW STMT FROM SEG 4 *
*                                      *
****************************************
* 
BASC8 NOP 
*****************************REMOVED 790713******************** 
*     LDA PFLAG     IS THIS INITIALIZATION?*****
*     CPA .9999 
*     RSS           YES, GO GET SEGMENT'S FWAM AND LWAM 
*     JMP BAS8C     NO, CONTINUE EXECUTION
*     JSB GMS.C 
*     JMP ROTAT     RET. TO MAIN FOR FWAM AND LWAM CHECK***** 
******************************790713**************************
      LDA SLSTM     EXECUTE 
      ADA XECTB       REQUEST 
      LDA 0,I           FROM SEGMENT 4
      JMP 0,I 
* 
      SPC 3 
* 
********************************* 
*                               * 
*  RETURN TO SEG 4 TO CONTINUE  * 
*                               * 
********************************* 
* 
XEC4  LDB .4        LOAD SEGMENT#4
      JMP SGMNT 
      SKP 
********************* 
*                   * 
**  EXECUTE PAUSE  ** 
*                   * 
********************* 
* 
EPAZ  LDA M10       WRITE 
      LDB PMESS       'PAUSE' 
      JSB WRITE         MESSAGE 
      JSB PRNIN     INITIALIZE FOR NUMBER 
      ISZ TEMPS 
      LDB TEMPS     ANY 
      CPB PRADD       PARAMETER?
      JMP EPAZ1     NO! 
      ISZ TEMPS 
      DLD TEMPS,I   GET PARAMETER 
      JSB IFIX      INTEGERIZE
EPAZ2 JSB OUTIN     PRINT NUMBER
      JSB OUTLN 
EPAZ3 LDA M2        READ
      LDB .INBF     INPUT 
      JSB REED        'GO'
      LDA .INBF,I 
      CPA GO        'GO'? 
      JMP XEC4      YES!
      AND HIMSK 
      CPA CTRLQ     ABORT PROGRAM?
      JMP OPND1       YES, BUT DO NOT PUSH AND SHOVE
      LDA M2        NO, SO
      LDB QMARK       OUTPUT
      JSB WRITE         DOUBLE '??' 
      JMP EPAZ3 
EPAZ1 CLA           ZERO
      JMP EPAZ2       PAUSE 
      SKP 
************************
*                      *
**  EXECUTE END/STOP  **
*                      *
************************
* 
* 
OPEND JSB IFBRK     CLEAR ATTENTION 
      DEF *+1         BIT 
OPND1 LDA ERTTY     SET UP
      STA LUOUT       ERROR LU
      LDB AMESS     PRINT 
      LDA M32         MESSAGE 
      JSB WRITE         INDICATING
      JSB PRNIN           OPERATOR
      LDA .LNUM             TERMINATION 
      JSB OUTIN               OF
      JSB OUTLN                 PROGRAM 
EEND  LDA INNUM     INVOKE?  **CHANGED 790831******** 
      SZA 
      JMP INVK0     YES!
      LDA M16       NO,OUTPUT 
      STA TEMP4 
EEND2 LDA FILBK,I     ANY 
**************************CHANGED 800210**************************
      SSA,RSS           IS THIS AN *
      JMP EEN           NO
      CMA,INA           YES,CHECK FOR FILE OPEN IN SON
      JMP EEN1
EEN   SZA,RSS 
      JMP EEND3         PARTIALLY 
EEN1  STA DCB 
************************************800210*************************** 
      ADA .16 
      STA TEMP6           FILLED BUFFERS
      JSB WRREC     NO, OUTPUT BUFFERS
EEND3 ISZ FILBK 
      ISZ TEMP4     THROUGH WITH ALL 16?
      JMP EEND2     NO! 
      SPC 1 
      LDB FCORE     SET UP POINTER
      ADB M20         TO OUTPUT ANY 
      STB TEMP4         PARTIAL LINES 
*********************************************************************** 
* NOTE: IF ANYTHING CHANGES IN HERE BE SURE TO CHANGE SEG. 5 UNDER
*       $CHAN ALSO!!!!!!!!!!!!! 
*********************************************************************** 
LULOP LDA TEMP4,I           IN THE LU TABLE 
      SZA,RSS       IS THIS SLOT ASSIGNED ? 
       JMP LUNXT      NO, TRY THE NEXT ONE
      ALF,ALF         YES, ISOLATE THE LU 
      AND B377
      IOR B200
      STA LUOUT     SAVE THE LU WORD
      STB HOLD      SAVE B SINCE USED BY FINDV *800122* 
      JSB FINDV       AND DISCOVER THE EQUIPMENT TYPE 
      LDB HOLD       RESTORE B FOR OLD WAY *800122* 
      STA 1 
      ADA M17       IS THIS DEVICE TYPE **CHANGED 790829*** 
      SSA,RSS           < 21(8) ? 
      JMP LUNXT           NO, TRY THE NEXT
      STA FLTYP           YES, SET FOR NON-FILE WRITE 
      CLA           SET UP A NULL 
      LDB PMESS       WRITE OPERATION 
      JSB WRITE         ON THIS LU
LUNXT ISZ TEMP4     POINT TO THE NEXT LU WORD 
      LDA TEMP4       AND CHECK IF
      CPA FCORE         WE ARE DONE 
      RSS                 YES 
      JMP LULOP           NO, GO BACK FOR ANOTHER 
      SPC 3 
      SPC 3 
*  CHECK IF 'INVOKED' 
      SPC 3 
INVK0 LDA INNUM     INVOKED?  **CHANGED 790831***** 
      SZA,RSS 
      JMP LUNX1     NOT INVOKE, CONTINUE. 
*     LDA INLOC       **REMOVED 790831***** 
      LDB TEMP3     LOOK FOR ERROR??
      SZB 
*********************CHANGED 790904*************************************
      JMP EREND     YEP, GO PROCESS ERROR 
*********************REMOVED 790831*********************************
*      LDB .2        SET THE LU#
*      SSA           15=1 FOR LU # 3
*      LDB .3        SET TO 3 
*      STB DLU#      SAVE FOR RELEASE TRACKS
*      ADB .64       TURN ON BINARY BIT 
*      STB SWCND     SET CONWORD
*      AND B177      GET NUMBER OF TRACKS 
*      STA TK#       SAVE FOR READ
*      STA TK#1      SAVE FOR RELASE  BR
*      LDA INLOC     GET START TRACK
*      ASR 7         TO LOW ORDER 
*      AND B377      MASK START TRACK 
*      STA STRK#     SAVE FOR READ
*      STA STRK1     SAVE FOR RELEASE 
*      CLA           SET
*      STA STSEC     START SECT TO ZERO 
*      LDA LENCM       SET  LENG
*      STA SBLNG     TO   COMMON AREA 
*      LDA CMADR     STARTING ADDRESS OF COMMON 
*      STA SBUF      BUF START ADDR 
*      JSB SREAD     READ  COMMON FROM DISC 
*      AND DSERR     LOOK AT BITS 15-14 
*      SZA           DISC ERROR?
*      JMP DERR      YES
*      CPB LENCM       READ LENCM WORDS?
*      RSS           YES  CONTINUE
*      JMP DERR      NO DISC ERR
*      LDA FWAMB     CALCULATE
*      CMA,INA             LENGTH 
*      ADA SYMTA                OF THE
*      INA           BUMP FOR THAT LAST 
*      STA LENPG                     PROGRAM
*      LDA INTKZ     GET TRACK SIZE 
*      ADA M512      BUMP DOWN FOR FIRST PROG WRITE 
*      STA TMLND     TEMP DISC LENGTH 
*      LDA .4        SET STARTING 
*      STA STSEC     SECTOR  NUMBER 
*      LDA FWAMB     START PROG ADDRESS 
*      STA TEMAD     TEMP PROG ADDR.
*      STA SBUF      START BUF ADRR 
*      LDA LENPG     PROGRAM LENGTH 
*      STA TMLNP     TEMP LENGTH OF PROG TO GO
*INVK1 LDA TMLND     CURRENT TRACK SIZE 
*      CMA,INA
*      ADA TMLNP     SUB FROM TO GO SIZE
*      SSA           LAST READ??? 
*      JMP INVK2     YES COMPLETE 
*      STA TMLNP     UPDATE PROG TO GO
*      LDA TMLND     GET TRACK SIZE 
*      STA SBLNG     BUF LENGTH 
*      ADA TEMAD     RUNNING PROG ADDR
*      STA TEMAD     UPDATE TO NEXT 
*      JMP INVK3     GO WRITE 
*INVK2 LDA TMLNP     TEMP PROG LENGTH 
*      STA SBLNG     MAKE BUFF LENGTH 
*      CLA           SET TO 
*      STA TMLNP     ZERO FOR FINISH
*INVK3 JSB SREAD     READ FROM DISC 
*      AND DSERR     LOOKAT BITS 15-14
*      SZA           DISC ERROR?
*      JMP DERR      YES
*      CPB SBLNG     READ ENOUGH??
*      RSS           YES, CONTINUE
*      JMP DERR      NOT RIGHT NUMBER OF WORDS
*      CLA           ARE WE 
*      CPA TMLNP     ALL FINISHED???
*      JMP INVK4     YES GO RELEASE TRACKS
*      STA STSEC     NO, START AT SECTOR ZERO 
*      ISZ STRK#     BUMP TRACK NO
*      LDA INTKZ     UPDATE TRACK SIZE
*      STA TMLND     FOR NEXT READ
*      LDA TEMAD     RUNNING ADDRESS
*      STA SBUF      FOR NEXT READ
*      JMP INVK1     READ  AGAIN
*      SPC 1
**
*INVK4 JSB RETK      RELEASE TRACKS 
*      LDA .2        SET
*      STA SLSTM     SLOW STATEMENT FLAG
*      JMP XEC4      CONTINUE 
*      SPC 1
**
************************ADDED 790823******************
**
*DERR  JSB ERROR
*CERR2 EQU *
**************************790823******************************
**  READ  PROGRAM TRACKS
**
*      SPC 1
*SREAD NOP
*      JSB EXEC      THROUGH EXEC 
*      DEF SRRET     RETURN 
*      DEF .1        READ 
*      DEF SWCND     CON WORD 
*      DEF SBUF,I    BUFF ADDR
*      DEF SBLNG     LENGTH 
*      DEF STRK#     TRACK NUMBER 
*      DEF STSEC     STARTING SECTOR
*SRRET JMP SREAD,I   RETURN 
*      SPC 1
**
**  RELEASE TRACKS  SUBROUTINE
**
*      SPC 1
*RETK  NOP           ENTER
*      JSB EXEC      GO 
*      DEF RERET
*      DEF .5        REL TRACKS REQUEST 
*      DEF TK#1      NUMBER OF TRACKS 
*      DEF STRK1     STARTING TRACK NUMBER
*      DEF DLU#      DISC LU NUMBER 
*RERET JMP RETK,I    RETURN 
*      SPC 1
*TK#   BSS 1
*TK#1  BSS 1
*STRK# BSS 1
*STRK1 BSS 1         BR 
*DLU#  BSS 1
*LENPG BSS 1
*SWCND BSS 1
*SBUF  BSS 1
*SBLNG BSS 1
*CMADR DEF TEMPS
*LENC  EQU SPEC-TEMPS+10  ***CHANGE IF COMMON CHANGES***
*LENCM ABS LENC 
*STSEC BSS 1
*TEMAD BSS 1
*TMLND BSS 1
*TMLNP BSS 1
*M512  DEC -512 
**
*      SPC 3
**
**************************790904**********************************
************************ADDED 791014******************************
      LDA INNAM+2   CHECK FOR LEVEL OF INVOKE 
      ADA M1        THERE IS MORE THEN ONE LEVEL DECREMENT
      STA INNAM+2   TO GET RIGHT SCRATCH FILE.
INVK2 LDA LENCM     GET COMMON LENGTH 
**************************791014*********************************** 
      STA SBLNG     AND SAVE FOR READ 
      LDA CMADR     GET STARTING ADDRESS COMMON 
      STA SBUF      AND SAVE FOR READ 
**************************ADDED 791010****************************
      JSB OPENF     GO OPEN INVOKER 
      DEF INVK3 
      DEF SDCB      SEG. 8'S PRIVATE DCB  791014
      DEF FERR
      DEF INNAM 
      DEF .1
INVK3 JSB CKERR     CHECK FOR FMP ERROR 
****************************791010********************************
      JSB SREAD     GO READ COMMON
      LDA LEN       CHECK FOR INCOMPATIBLITY
      CPA LENCM 
      RSS           FITS! 
      JMP ERFIL     ISSUE INCOMPATIABLE FILE AND PURGE
INVK4 LDA FWAMB     CALCULATE PROGRAM LENGTH
      CMA,INA 
      ADA SYMTA 
      INA 
      STA SBLNG 
      LDA FWAMB     STARTING  ADDR. OF PROG.
      STA SBUF      AND SAVE FOR READ 
      JSB SREAD     GO READ PROGRAM IN
      LDB LEN 
      CPB SBLNG     INCOMPATIBLITY ERROR
      JMP DONE      PURGE THE FILE FOR FINISH 
ERFIL LDA .1        SET ERROR FLAGTCH FILE
      STA FLAGR 
      JMP PURIT 
DONE  CLA 
      STA FLAGR 
PURIT JSB PURGE     PURGE THE FILE
      DEF TEST
      DEF SDCB      SEG. 8'S PRIVATE DCB 791014 
      DEF FERR
      DEF INNAM 
TEST  JSB CKERR     CHECK FOR FILE ERROR
      LDA FLAGR     CHECK FOR ERROR ENTRY 
      CPA .1
      JMP ERROR 
*************************ADDED 791014****************************** 
CERR1 LDA .2        INDICATE SLOW STATMENT FROM 
      STA SLSTM     SEGMENT 8 TO CONTINUE EXECUTION 
      JMP XEC4
******************************791014******************************* 
* 
SREAD NOP 
      JSB READF 
      DEF SRED1 
      DEF SDCB     SEG. 8'S PRIVATE DCB 791014
      DEF FERR
SBUF  DEF 0         **791012** SO NOT WORRY ABOUT INDIRECTS 
      DEF SBLNG    *791010* 
      DEF LEN 
*************************ADDED 791014**************************** 
SRED1 LDA FERR      WAS THERE A FMP ERROR?
      SSA,RSS 
      JMP SREAD,I   NO
      STA DFERR     YES, CLOSE INVOKER FILE 
      JSB CLOSE     SO NOT TO CONVICT WITH
      DEF SRED2     WRITF CALL FOR ERROR
      DEF SDCB      WRITING. SEG. 8'S PRIVATE DCB  791014 
      DEF FERR
      DEF .0
SRED2 LDA DFERR     GO PRINT MESSAGE
      STA TEMP3 
      JMP OUTER 
*************************************791014********************** 
* 
* 
*LENPG NOP     *791010* 
LEN   NOP 
SBLNG BSS 1 
CMADR DEF TEMPS 
LENC  EQU FLDCB-TEMPS       **791012**
LENCM ABS LENC       *791010* 
FLAGR NOP 
DFERR NOP 
DZERO OCT 30060      ASCII 00 791014
SDCB  BSS 144        **791014** 
* 
* 
*****************************790904************************************** 
LUNX1 JSB IFBRK     CLEAR ATTENTION 
      DEF *+1 
* 
      JSB STREN     REPLACE GOTO <ABS ADDR> WITH STMT NUMBERS 
* 
      LDA MNNAM     IS THERE IS A MNEMONIC
      SZA             TO BE RELOADED? 
      JMP GETBM     YES, LOAD MNEMONIC TBL
*************************CHANGED 790904*********************************
EREND JSB PURGE     PURGE THE SCRATCH FILE
      DEF EEND4 
      DEF SDCB     SEG. 8'S PRIVATE DCB 791014
      DEF FERR
      DEF INNAM 
*******************CHANGED 790924****************************** 
EEND4 LDA FERR      CHECK FOR -6 ERROR
      CPA M6        IF THERE IS ONE IGNOR IT!!!!! 
      RSS 
*************************790924******************************** 
      JSB CKERR     CHECK FOR FMP ERROR 
      CLA           CLEAR 
*****************************790904***********************************
      STA SLSTM       SEG 8 FLAG
      LDA .2        CLEAR 
      JSB TRAP        TRAP TABLE
       NOP
      CCA           CLEAR TYPE 0
      STA FLTYP       FILE FLAG 
      LDA TEMP3     WAS THIS AN 
      SZA             ERROR EXIT ?
      JMP OUTER         YES ! 
      STA .LNUM     RESET POINTER TO START OF PROGRAM 
      INA           IS INPUT FROM 
      CPA REC#        COMMAND FILE? 
      JMP RDYPT         NO, GO TO READY 
      JMP COMFL         YES, GO BACK TO COMMAND FILE
* 
GETBM JSB LOADM     LOAD B & M TABLES 
****REMOVED LABEL 'BYE1' 790823**** 
      LDA FWAMM,I   SETUP 
      STA TEMP1     SUBROUTINE COUNTER
      LDB FWAMB     SETUP BRANCH TABLE PTR
      STB TEMP2 
BYE2  LDA 1,I       GET OVERLAY NAME
      STA TEMP5     CALL # AND SUB INDEX
      ALF,RAL       CONVERT FG PROG NAME
      AND .31        TO ASCII 
      IOR .64       LETTER ID FIRST 
      ALF,ALF 
      STA TEMP9      THEN 
      LDA TEMP5 
      RRR 6           TWO 
      AND .31 
      CLB             DIGITS
      DIV .10 
      IOR .48          IN 
      IOR TEMP9       DECIMAL 
***********************ADDED 800205**************************************** 
      STA HOLD1 
      LDA B 
      ADA .48 
      ALF,ALF 
      IOR B40 
      STA B 
      LDA HOLD1 
*****************************800205**************************************** 
      ADB .48 
      BLF,BLF 
      IOR B40       **791227**
      CPA NAM+1     SAME AS LAST? 
      RSS           YES!
      JMP BYE4      NO, STORE IT! 
      CPB NAM+2     LAST CHAR SAME? 
      JMP BYE5      YES, GO TO NEXT NAME! 
BYE4  DST NAM+1     SET NEW NAME
      JSB EXEC      SCHEDULE OVERLAYS 
      DEF *+4         TO ABORT THEMSELVES 
      DEF TCODE         WITHOUT WAIT
      DEF NAM             AND WITHOUT ERRORS
      DEF AB
      NOP 
BYE5  LDB TEMP2     INCREMENT 
      ADB .4          TO NEXT 
      STB TEMP2         ENTRY 
      ISZ TEMP1     END OF SUBS?
      JMP BYE2      NO! 
      JMP EEND4     YES!
* 
NAM   ASC 3,BSXXXX       **CHANGED 790823*****
TCODE OCT 100012    TERMINATE W/0 ERROR 
AB    ASC 1,AB
B     EQU 1        *800205* 
HOLD1 NOP          *800205* 
      SKP 
********************************************************************* 
*                                                                   *
*  THIS ROUTINE REPLACE ALL ABSOLUTE GOTO <ABS ADDR> WITH STMT #'S  * 
*                                                                   * 
********************************************************************* 
STREN NOP 
      LDA PBUFF 
      STA RENQ
      ADA M1
      STA RENP      SEEK EMBEDDED 
REN12 JSB RENSK     STATEMENT REFERENCES
      JMP STREN,I   NONE LEFT 
      LDA RENP,I    IF REFERENCE IS 
      CPA COMMA     COMMA?
      JMP REN12     YES, CONTINUE MIGHT BE GOTO-OF ETC. 
      JSB RENS0     SET STMT NUMBER TO ABSOLUTE ADDRESS 
      JMP REN12 
* 
RENSK NOP 
      LDB M5
      STB RENCT     SET 'IF' COUNTER
      LDB PSTIF 
      STB RENAD     SET PAST IF STMT PTR
      ISZ RENP      INCREMENT POINTER 
      LDB RENQ      ADDRESS OF BEGINNING OF NEXT STMT 
      LDA USFLG     PRINT USING 
      SZA             LAST STMT?
      JMP RENS2     YES, SKIP OVER REST OF STMT!
      LDB RENQ
      CPB RENP      STATEMENT FINISHED? 
      JMP RENS2     YES 
RENS1 ISZ RENSK     NO, RETURN WITH RENP
      JMP RENSK,I   SET TO NEXT REFERENCE 
      STB RENQ      UPDATE TO NEXT STATEMENT
RENS2 CLA           SET PRINT USING 
      STA USFLG       CLEAR 
      CPB PBPTR     PROGRAM EXHAUSTED?
      JMP RENSK,I   YES 
      STB RENR      SAVE CURRENT STATEMENT ADDRS
      ISZ RENQ
      LDB RENQ
      ISZ RENQ      EXTRACT 
      LDA RENQ,I    STATEMENT 
      AND OPMSK     TYPE
      ADB 1,I       SET (B) TO
      ADB M1        NEXT STATEMENT
      CPA RESOP     <RESTORE STATEMENT> ? 
      JMP RENS5     YES 
      CPA GOTOP     NO, <GOTO STATEMENT> ?
      JMP RENS3     YES 
      CPA GOSOP     NO, <GOSUB STATEMENT>?
      JMP RENS3     YES 
      CPA FALOP     NO, <FAIL STATEMENT>? 
      JMP RENS3     YES 
      CPA CALOP     NO, <CALL STATEMENT>? 
      RSS           YES 
*     CPA TRPOP     NO, <TRAP STATEMENT>? *800421** 
*     RSS           YES!  *800421** 
      CPA PRTOP     NO, <PRINT USING STATEMENT>?
      RSS           YES!
      CPA IFOP      NO, <IF STATEMENT>? 
      RSS           YES!
      JMP RENS2-1 
      LDA RENAD,I   GET PAST 'IF' OPERATOR
RENS3 IOR INTFL     CREATE REFERNCE HEADER
      STB RENQ      SET POINTER TO NEXT STMT
      ADB M1        SET PTR TO
RENS4 STB RENP        PROSPECTIVE HEADER? 
      ADB M1
      CPB RENR      END OF STATEMENT? 
      JMP RENS6     YES!
RENS8 CPA 1,I       PRECEDED BY REFERENCE HEADER? 
      JMP RENS7     YES 
      ISZ RENAD     GOTO NEXT OPERATOR
      LDA RENAD,I     PAST 'IF' 
      IOR INTFL 
      ISZ RENCT     DONE? 
      JMP RENS8     NO! 
      LDA PSTIF 
      STA RENAD 
      LDA M5
      STA RENCT 
      LDA OFOP      YES, LOAD HEADER FOR
      CPA 1,I 
      JMP RENS1 
      LDA USEOP     PRINT USING?
      CPA 1,I 
      JMP RENS1 
      JMP RENS4     REFERENCE LIST
RENS5 CPA RENQ,I    ANY REFERENCE?
      JMP RENS2-1   NO
      JMP RENS3     YES 
RENS6 LDB RENQ      'THEN','GOTO', OR 'GOSUB' 
      JMP RENS2       NOT FOUND 
* 
RENS7 CPA USEOP     <PRINT USING>?
      STA USFLG     YES, SET 'PRINT USING' FLAG SO AS TO SKIP REST OF STMT
      JMP RENS1 
* 
RENS0 NOP 
      LDA RENP,I    GET STMT NUMBER 
      LDA 0,I 
      STA RENP,I    STUFF IN STMT NUMBER
      JMP RENS0,I 
* 
* 
INTFL OCT 100003
RENCT DEC -3
RENAD DEF THNOP 
RENP  BSS 1 
RENQ  BSS 1 
RENR  BSS 1 
USFLG NOP 
COMMA OCT 102003
PSTIF DEF *+1       THESE 
THNOP OCT 60000       SIX 
GOTOP OCT 37000         ITEMS MUST
GOSOP OCT 43000           BE CONTIGUOUS 
RESOP OCT 55000             **
PRTOP OCT 53000 
IFOP  OCT 40000 
OFOP  OCT 177003
TRPOP OCT 66000 
USEOP OCT 161003
FALOP OCT 57000 
CALOP OCT 50000 
OPMSK OCT 77000 
      SKP 
**********************
*                    *
**  EXECUTE ASSIGN  **
*                    *
**********************
* 
EASSN LDA TEMP6     SET UP
      STA ICCNT       FILE NAME COUNT 
      LDB TEMP7     SET UP
      STB INBFA       FILE NAME ADDRESS 
      JSB GETCR     GET FIRST CHAR OF 
      NOP             FILE NAME 
********ADDED 790823****************************************
*THIS NEW PIECE OF CODE UTILIZIES THE RLIB ROUTINE 'NAMR' 
*TO PARSE THE FILENAME OR LU SPECIFIED IN THE 'FILES' 
*STATEMENT.  THIS WAY THE FMP ROUTINES OF 'OPENF', 'READF', 
*'WRITF' CAN BE USED TO FURTHER THE INDEPENDENCE OF BASIC 
*FROM THE SYSTEM. 
* 
* 
      CLB           CLEAR CHAR. COUNT AND RESET THE STARTING
      STB LENTH     CHAR. POINTER FOR NAMR
      LDB .1
      STB ISTRC 
      LDB M3       SET UP WORD COUNTER **791008 
      STB DUM3     **791008 
      LDB DEST      MOVE THE NAME TO BE PARSED FROM 
      STB STORE     INPUT BUFFER TO NAMR'S BUFFER 
TOP   JSB .SBT
      ISZ LENTH     INCREMENT CHAR. COUNT 
      STB STORE 
      JSB GETCR     RETRIEVE NEXT CHAR. 
      JMP DONE1      EOL? YES     ******CHANGED 790904***** 
      LDB STORE     NO
      JMP TOP       GO AGAIN FOR MORE!!!
* 
DONE1 JSB NAMR      PARSE THE NAME  *****CHANGED 790904****** 
      DEF REPT
      DEF BUFR      RESULTING BUFFER
      DEF NAMBF     SOURCE BUFFER 
      DEF LENTH     # OF CHAR. TO PARSE 
      DEF ISTRC     STARTING CHAR. IN STRING
* 
*DUE TO THE REQUIREMENT OF NAMR'S RESULTING BUFFER BEING OF 
*SIZE OF 10 WORDS, THE NAME MUST BE MOVED TO THE OLD NAME 
*BUFFER IN BASIC FOR CONVERSION EASE. 
* 
REPT  LDA POINT,I   PICK UP RESULTING BUFFER
      STA PNTLU,I   MOVE TO NAME IN COMMON WITH 791005
      ISZ POINT     SECURITY CODE AND CRN#
      ISZ PNTLU     BEHIND THE 3-WORD NAME
*******************CHANGED 790928*****************************
      ISZ DUM3     **791008 
      JMP REPT
      ISZ POINT     INCREMENT PASS TYPE WORD 4
      LDA POINT,I   MOVE SECURITY CODE AND CRN# 
      STA PNTLU,I   **791005**
      ISZ POINT 
      ISZ PNTLU 
      LDA POINT,I 
      STA PNTLU,I   **791005**
****************************790928******************************
***************************790823***********************
*     JSB NAMD0     SET UP FOR **REMOVED 790823*********
*     DEF NAME        FILE MGR OPEN **REMOVED 790823******* 
      DLD TEMP8,I   GET FILE NUMBER 
      JSB IFIX      MAKE INTEGER
      STA 1 
      CMB,INB       IS IT GREATER 
      ADB M16         THAN 17 
      SSB,RSS 
      JMP GTERR     YES 
      ADA M1        NO,   GET 
      ADA FILBK       POINTER 
      LDB 0,I           TO DCB
      SZB,RSS       IS THERE A DCB ASSIGNED?
      JMP GTERR     NO, CAN'T GO FROM HERE
      SSB           HAS IT BEEN OPENED YET? 
      JMP EASS1     NO, SO DO IT ALREADY
EASS2 STB TEMP7 
      ADB .15       CLEAR 
      CLA             IF 'END'
      STA 1,I           FLAG
      JSB OPENF     OPEN      ***CHANGED 790829*****
      DEF *+7 
      DEF TEMP7,I     NEW 
      DEF FERR
      DEF NAME          FILE
      DEF .1
      DEF SC              AND CLOSE OLD 
      DEF LU
      SSA,RSS       ANY ERRORS
      CLA           NO,SET FOR NO ERROR 
EASS3 JSB FLOAT     MAKE FLT PT 
      DST TEMP9,I   YES , PASS ERROR TO BASIC 
      JMP XEC4
* 
EASS1 CMB,INB       DCB 
      STB 0,I         POINTER 
      JMP EASS2 
* 
GTERR LDA M5        SET FOR ILLEGAL 
      JMP EASS3       FILE NUMBER ERROR 
********************ADDED 790823***************************** 
BUFR  BSS 10        **791008
POINT DEF BUFR
PNTLU DEF NAME
ISTRC NOP 
LENTH NOP 
STORE NOP 
DEST  DBL NAMBF 
NAMBF BSS 14
DUM3  NOP          **791008 
*****************************790823*****************************
      SKP 
* 
*  READ MNEMONIC TABLE INTO SPACE BETWEEN LONGEST 
*  SEGMENT AND NEXT TO LONGEST SEGMENT
* 
LOADM NOP 
      LDA DCBAD     SET UP
      STA DCB         DATA CONTROL BLOCK
      JSB OPENF     OPEN      ***CHANGED 790829*******
      DEF *+7         MNEMONIC
      DEF DCB,I         TABLE 
      DEF FERR            FILE
      DEF MNNAM 
      DEF .0
      DEF MNNAM+3 
      DEF MNNAM+4 
      JSB CKERR     ERROR?
      LDA FWAMM     SET STARTING
      STA TEMP4       ADDRESS OF MNEMONIC TBL 
LOAD3 JSB READF     READ
      DEF *+6 
      DEF DCB,I       MNEMONIC
      DEF FERR
      DEF TEMP4,I       TABLE 
      DEF .9999           INTO CORE 
      DEF TEMP6 
      LDB TEMP6 
      CPB M1        EOF READ? 
      JMP LOAD7     YES 
      ADB TEMP4     NO, SET NEW READ
      STB TEMP4         INDEX 
* 
      JMP LOAD3     NO, READ SOME MORE
LOAD7 JSB CKERR     ERROR?
      JSB CLOSE     CLOSE 
      DEF *+4 
      DEF DCB,I       THE 
      DEF FERR
      DEF .0            FILE
      JSB CKERR 
      JMP LOADM,I 
      SKP 
**********************************
*                                *
*  WRITE OUT REMAINDER OF FILES  *
*                                *
**********************************
* 
WRREC NOP 
      LDB DCB       IS
      ADB .2          FILE
      LDB 1,I             TYPE 0? 
      SZB,RSS 
      JMP WRXIT     YES, CLOSE IT 
      LDB DCB       HAS 
      ADB .13         BUFFER
*     JSB RDCB1     (CHECK FOR NEW DCB)***OUT FOR L 
      LDA 1,I           BEEN
      SLA,RSS             WRITTEN ON? 
      JMP WRXIT     NO, SO DON'T WRITE
      AND MNEG      YES, CLEAR IT 
*     JSB WDCBB     (CHECK FOR NEW DCB)***OUT FOR L 
      STA 1,I 
      INB           NOW CORRECT 
      CCA             RECORD
      ADA 1,I           COUNTER 
      SZA                 UNLESS
      STA 1,I                START OF FILE
      ADB M2        RESET 
      LDA DCB         WORD
      ADA .16           LOCATION
      STA 1,I 
      JSB WRITF       OUT 
      DEF *+6           NEXT
      DEF DCB,I           RECORD
      DEF FERR
      DEF TEMP6,I 
      DEF .128
      DEF .0
      JSB CKERR     CHECK FOR ERROR 
WRXIT JSB CLOSE     CLOSE 
      DEF *+4 
      DEF DCB,I       THE 
      DEF FERR
      DEF .0            FILE
      JMP WRREC,I 
* 
* 
CKERR NOP 
      LDA FERR      IS THERE
      SSA,RSS         A FILE MANAGER ERROR? 
      JMP CKERR,I   NO! 
      STA TEMP3     YES!
      JMP OUTER     PRINT MESSAGE AND ABORT 
      SKP 
**********************************************************************
* 
*THIS ROUTINE WILL UPDATE THE IB AND WR BITS IN THE NEW DCB WORD 7
*BASED ON INFORMATIOIN IN THE OLD DCB WORD 13.  SINCE BASIC 
*ASSUMES THE INFORMATION TO BE IN WORD 13, THIS ROUTINE WILL ALLOW
*FOR AN EASY CONVERSION TO THE NEW DCB LAYOUT.
* 
*UPON ENTRY THE A AND B REGISTERS ARE AS FOLLOWS: 
* 
*     A=VALUE OF THE OLD DCB WORD 13
*     B=ADDRESS TO THE OLD DCB WORD 13
* 
*A TEST IS DONE ON THE ENTRY POINT $BMON WHICH WILL HAVE BIT 0
*SET IF THE HOST SYSTEM IS AN RTE-4B OR THE NEW DCB LAYOUT. 
* 
*RETURN POINTS: 
* 
*     P+1 FOR THE OLD DCB-TYPE SYSTEMS
*     P+2 FOR THE NEW DCB-TYPE SYSTEMS
* 
*UPON RETURN, THE A AND B REGISTERS WILL HAVE THE SAME VALUES AS UPON 
*ENTRY. 
* 
************************************************************************
*WDCBB NOP
*     STA ASTOR     SAVE THE A AND B REGS.
*     STB BSTOR 
*     LDA $BMON     IS THIS A 4B SYSTEM? A(0)=1 
*     SLA 
*     JMP DCB4B     YES,GO UPDATE WORD 7
*     LDA ASTOR     NO, RESTORE THE A 
*     JMP WDCBB,I   AND RETURN TO P+1 
*DCB4B ADB M6        PICK UP NEW DCB WORD 7 
*     STB ADDR1 
*     LDA 1,I 
*     LDB ASTOR     CHECK VALUES IN OLD DCB 
*     SSB,RSS       FOR IB=1
*     JMP CLIB1     NO
*     IOR .4        YES 
*CHKWR SLB,RSS       AND WR=1 
*     JMP CLWR      NO
*     IOR .1        YES 
*PUTIT STA ADDR1,I   AND STORE IN WORD 7
*     LDA ASTOR     RESTORE ORG. VALUE OF A AND 
*     LDB BSTOR     B 
*     ISZ WDCBB     AND RETURN TO P+2 
*     JMP WDCBB,I 
*CLIB1 AND M5        CLEAR IB (BIT2) IN NEW DCB 
*     JMP CHKWR 
*CLWR  AND M2        CLEAR WR (BIT1) IN NEW DCB 
*     JMP PUTIT 
*ASTOR NOP
*BSTOR NOP
*ADDR1 NOP
*ASTR1 NOP
      SKP 
**********************************************************************
* 
*THIS ROUTINE WILL TAKE THE VALUES FOR THE IB AND WR BITS IN THE
*NEW DCB WORD 7 AND POSITION THEM INTO THE FORMAT FOR THE OLD DCB 
*WORD 13.  THE TWO DIFFERENT DCB'S ARE: 
* 
*      OLD DCB WORD 13: 
* 
*      15                     1  0
*      IB                    EF  WR 
* 
*      NEW DCB WORD 7:
* 
*      15                  2  1  0
*      SC                 IB EF WR
* 
*SINCE BASIC ASSUMES THIS FLAG INFORMATION TO BE IN WORD 13, THIS ROUTINE 
*WILL ALLOW FOR AN EASY CONVERSION TO THE NEW DCB LAYOUT. 
* 
*UPON ENTRY THE A AND B REGISTERS ARE AS FOLLOWS: 
* 
*     A IS MEANINGLESS
*     B=ADDRESS TO THE OLD DCB WORD 13
* 
*A TEST IS DONE ON THE ENTRY POINT $BMON WHICH WILL HAVE BIT 0 SET
*IF THE HOST SYSTEM IS AN RTE-4B OR THE NEW DCB LAYOUT. 
* 
*RETURN POINTS: 
* 
*     P+1 FOR THE OLD DCB TYPE SYSTEMS
*     P+2 FOR THE NEW DCB TYPE SYSTEMS
* 
*UPON RETURN, THE REGISTERS WILL BE AS FOLLOWS: 
* 
*     A=VALUE OF THE IB AND WR BITS IN THE WORD 13 FORMAT 
*     B=ADDRESS TO THE OLD DCB WORD 13
* 
**********************************************************************
*RDCB1 NOP
*     STB BSTOR     SAVE ADDR. OF OLD DCB WORD 13 
*     LDB $BMON     IS THIS A 4B SYSTEM? B(0)=1 
*     SLB 
*     JMP B4DCB     YES, GO POSITION THE IB AND WR BITS 
*     LDB BSTOR     NO, RESTORE THE ADDR. AND 
*     JMP RDCB1,I   RETURN TO P+1 
*B4DCB LDB DCB       GET WORD 7 OF NEW DCB
*     ADB .7
*     LDA 1,I 
*     STA ASTOR 
*     AND .4        CHECK FOR IB (BIT2) SET 
*     SZA,RSS 
*     JMP CL15      NO, CLEAR BIT 15
*     LDA ASTOR     YES, SET BIT 15 
*     IOR MNEG      WITH MASK 100000
*B4END AND INTFL    MASK OFF MEANINGLESS BITS (100003)
*     LDB BSTOR     RESTORE ADDR. AND 
*     ISZ RDCB1     RETURN TO P+2 
*     JMP RDCB1,I 
*CL15  LDA ASTOR     CLEAR BIT 15 
*     AND INF       WITH MASK 77777 
*     JMP B4END 
      SKP 
**********************REMOVED 790823*********************** 
**     SUBROUTINE TO DECODE NAME PRAMS
**     CALLING SEQUENCE 
**     JSB NAMD0
**     DEF NAME 
**     A REG= CURRENT CHAR
**     UPON RETURN
**     NAME, NAME+1, NAME+2 = FILE NAME 
**     NAME+3 = SECURITY CODE 
**     NAME+4 = LOGICAL UNIT
**
*NAMD0 NOP
*      LDB NAMD0,I   GET NAME BUFFER ADDR 
*      STB NAMA        AND SAVE IT IN NAME PTR
*      ISZ NAMD0
*      ADB .3 
*      STB GETNM     SAVE PTR TO SC WORD
*      CLB           GET A ZERO 
*      STB GETNM,I     AND CLEAR SC AND LU
*      ISZ GETNM
*      STB GETNM,I
*      JSB LNAME     GET NAME...A REG 0,IGNORE SPACES 
*NAMA  BSS 1         BUFFER WHERE TO PUT NAME 
*      DEC -7        MAX LENGTH + 1 
*      LDB NAMA      STEP POINTER 
*      ADB .3          TO SECURITY
*      STB NAMA          CODE SLOT
*      SPC 1
**     AT THIS POINT WE HAVE MOVED THE NAME IN
*      SPC 1
*      JSB CHRCK     CHECK FOR END OF LINE
*      JMP NAMD0,I   YES...TERMINATE ROUTINE
*      JSB GETNM     GET NUMBER 
*      RSS           NOT NUMERIC
*      JMP NMDCD     NUMERIC SAVE SC CODE 
*      JSB CHRCK     CHECK FOR DELEM. 
*      JMP NAMD0,I   END OF LINE
*      JMP NMDCE     NO SECURITY CODE 
*      ALF,ALF       SHIFT TO HIGH ORDER
*      STA NAMA,I      SAVE TOP HALF OF SECURITY CODE 
*      JSB GETCR     GET NEXT CHAR
*      LDA .10
*      STA 1         SAVE CHAR
*      JSB CHRCK     TERMINATOR 
*      NOP           EOF...SET FOR SPACE
*      LDA .32       GET A SPACE
*      IOR NAMA,I      OR IN BOTTOM HALF OF SECURITY WORD 
*      STA NAMA,I      SAVE COMPLETE SECURITY CODE
*      LDA 1         GET CHARACTER AGAIN
*      JSB CHRCK     ARE WE DONE? 
*      JMP NAMD0,I   YES...RETURN 
*      JMP NMDCF     YES...GO PROCESS LU
*      JSB GETCR     GET ANOTHER CHARACTER
*      LDA .10       EOF! 
*      RSS           NO...CHECK NEXT CHAR...MUST BE A ":" 
*NMDCD STB NAMA,I      SAVE NUMERIC SECUITY CODE
*NMDCE JSB CHRCK     CHECK FOR TERMINATOR 
*      JMP NAMD0,I   DONE 
*      RSS           CONTINUE...GOT A : 
*      JSB ERROR     INVALID SECURITY CODE
*CERR1 EQU *
*      SPC 1
**     WE NOW HAVE PROCESSED THE NAME AND SECURITY CODE 
**     NOW WE ARE GOING TO PROCESS LU 
*      SPC 1
*NMDCF JSB GETNM     GET NUMBER 
*DERR  JSB ERROR     NOT A NUMBER, INVALID LU 
*CERR2 ISZ NAMA        SAVE LU VALUE
*      STB NAMA,I 
*      JMP NAMD0,I   RETURN 
*      SPC 1
*SPACE ASC 1, 
*      SPC 2
**
**     SUBROUTINE TO GET A FLOATING POINT NUMBER
**     CONVERT IT, AND RETURN IT IN THE B REG 
**     THE A REG=NEXT CHAR
**     CALLING SEQUENCE 
**     JSB GETNM
**     UNABLE TO CONVERT RETURN 
**     CONVERTED RETURN 
**     B REG=NUMBER 
**
*GETNM NOP
*      JSB GETCR     GET NEXT CHAR
*      LDA .10
*      CPA .10       EOF? 
*      JMP GETNM,I   YES, RETURN
*      CLB,CLE       CLEAR E AND B REG
*      STB TEMP1     CLEAR OUT SUM WORD 
*      STB TEMP2     CLEAR OUT DIGIT RECIEVED WORD
*      CPA .43       IS IT A "+"
*      CCE           SET E=READ ANOTHER CHAR
*      CPA .45       IS IT A "-"
*      CCB,CCE       SET B=-1, SET E=READ ANOTHER CHAR
*      STB SIGN      SAVE SIGN
*      SEZ,RSS       READ ANOTHER CHAR? 
*      JMP *+3       NO!
*GTNMA JSB GETCR     YES
*      LDA .10       EOF! 
*      JSB DIGCK     GO SEE IF DIGIT IS NUMERIC 
*      JMP GTNMB     NOT NUMERIC...DONE CONVERSION
*      LDA TEMP1     GET PARTICAL SUM IN A REG
*      STB TEMP1     DIGCK RETURN NUMBER IN BOTH A AND B REG
*      MPY .10       MULTIPLY PARTICAL SUM BY 10
*      ADA TEMP1     AND IN NEXT DIGIT
*      STA TEMP1     SAVE NEW SUM 
*      ISZ TEMP2     SET FOR RECIEVED A DIGIT 
*      JMP GTNMA     GET NEXT DIGIT 
*      SPC 1
*GTNMB LDB TEMP2     DID WE GET ANY DIGITS? 
*      SZB,RSS
*      JMP GETNM,I   NO 
*      LDB SIGN      GET SIGN 
*      CLE,ERB       IF NEGATIVE, SET E REG 
*      LDB TEMP1     GET BINARY VALUE 
*      SEZ           NEGATIVE VALUE?
*      CMB,INB       YES...NEGATE RESULT
*      ISZ GETNM     GET DIGIT RETURN 
*      JMP GETNM,I   RETURN 
*      SPC 2
*      SKP
**
**     SUBROUTINE TO CHECK IF A CHARACTER IN THE A REG
**     IS EITHER AN END OF LINE ".10" OR A : "B72"
**     CALLING SEQUENCE 
**     JSB CHRCK
**     END OF LINE RETURN 
**     COLEN RETURN 
**     NEITHER RETURN 
**     A REG CONTAINS THE CHARACTER 
**     B AND E REG NOT CHANGED
**
*CHRCK NOP
*      CPA .10       IS IT END OF LINE? 
*      JMP CHRCK,I   YES...EOL RETURN 
*      CPA B54       IS IT A ","? 
*      JMP CHRCK,I   YES...TREAT AS A EOL 
*      ISZ CHRCK
*      CPA B72       IS IT A ":"
*      JMP CHRCK,I   ":" RETURN 
*      ISZ CHRCK
*      JMP CHRCK,I   NO DELM RETURN 
*      SKP
**
**     ROUTINE TO MOVE NAME INTO NAME BUFFER
**     CALLING SEQUENCE 
**     JSB LNAME
**     DEF BUFFER ADDRESS WHERE TO STORE NAME 
**     DEC -MAX # OF CHARACTERS +1
**     RETURN...A REG = DEL CHAR
**
*LNAME NOP
*      STA TEMP5     SAVE CURRENT CHAR
*      LDA LNAME,I   GET ADDRESS OF NAME BUFFER 
*      LDB SPACE     CLEAR
*      STB 0,I
*      INA             NAME 
*      STB 0,I
*      INA
*      STB 0,I           BUFFER 
*      LDA LNAME,I   RECOVER NAME BUFFER ADDRESS
*      ISZ LNAME     GET TO NEXT PARM 
*      CLE,ELA       CONVERT TO BYTE ADDRESS
*      STA TEMP1     SAVE BYTE ADDRESS
*      LDA LNAME,I   GET MAX LENGTH +1
*      ISZ LNAME     GET TO RETURN ADDRESS
*      STA TEMP2     SAVE FOR DOWN COUNTER
*      LDA TEMP5     GET CURRENT CHAR 
*LMDCD JSB CHRCK     CHECK FOR DELEMETER
*      NOP
*      JMP LNAME,I   HIT ONE
*      LDB TEMP1     GT BYTE ADDRESS
*      JSB SBYTE     SAVE CHARACTER 
*      JSB GETCR     GET NEXT CHARACTER 
*      LDA .10
*      CPA .10       EOF? 
*      JMP LNAME,I   YES, RETURN! 
*      ISZ TEMP1     GET NEXT CHAR ADDRESS
*      ISZ TEMP2     OUT OF ROOM? 
*      JMP LMDCD     NO..CONTINUE 
*      JSB ERROR     INVALID FILE NAME
*CERR3 EQU *
*********************************790823************************** 
      SPC 2 
      SKP 
      SPC 3 
* 
*     SUBROUTINE TO STORE A BYTE
*     CALLING SEQUENCE
*     JSB SYBTE 
*     A REG CONTAINS BYTE 
*     B REG CONTAINS BYTE ADDRESS 
* 
SBYTE NOP 
      AND B377      MASK ALL BUT LOWER 8 BITS 
      STA TEMP7     SAVE IN TEMP LOCATION 
      CLE,ERB       CHANGE FROM BYTE TO WORD ADD
      LDA 1,I       GET WORD
      SEZ,RSS       RIGHT OR LEFT HALF
      ALF,ALF       LEFT
      AND HIMSK     MASK ALL BUT UPPER 8 BITS 
      IOR TEMP7     OR IN NEW BYTE
      SEZ,RSS       LEFT OR RIGHT 
      ALF,ALF       LEFT
      STA 1,I       STORE WORD BACK 
      ELB,CLE       GET BYTE ADDRESS AGAIN
      JMP SBYTE,I   RETURN
* 
*********************** 
*                     * 
* PRINT ERROR MESSAGE * 
*                     * 
*********************** 
ERROR NOP 
      LDA ERBS      ERROR ADDRESS IN (A)
      LDB ERROR     ERROR SOURCE IN (B) 
      INA           MOVE TO NEXT ERROR
      CPB 0,I       SAME AS ACTUAL ERROR? 
      CMA,INA,RSS   YES, MAKE ERROR NEGATIVE
      JMP *-3       NO
      ADA ERBS      MAKE ERROR POSITIVE 
      CMA,INA 
      ADA .45       ACCOUNT FOR SHORTENED TABLE 
      STA TEMP3     SAVE IT 
      JMP OUTER     PRINT ERROR MESSAGE 
      SKP 
*************** 
*             * 
* ERROR TABLE * 
*             * 
*************** 
ERR   DEF * 
      DEF CERR1     INCOMPATIABLE INVOKE PROGRAM
      DEF CERR2     INVALID LU
      DEF CERR3     INVALID FILE NAME 
* 
*********************ADDED 790823******************** 
CERR3 NOP 
CERR2 NOP 
***************************************************** 
NFMT  EQU TEMPS+1 
TEMP1 EQU TEMPS+2 
TEMP2 EQU TEMPS+3 
TEMP3 EQU TEMPS+4 
TEMP4 EQU TEMPS+5 
TEMP5 EQU TEMPS+6 
TEMP6 EQU TEMPS+7 
TEMP7 EQU TEMPS+8 
TEMP8 EQU TEMPS+9 
TEMP9 EQU TEMPS+10
TEM10 EQU TEMPS+11
FERR  EQU TEMPT+1   FILE ERROR FLAG 
NAME  EQU TEMPT+2 
SC    EQU TEMPT+5 
LU    EQU TEMPT+6 
* 
      END BASC8