ASMB,R,Q,C
      HED <<RTE BASIC - COMMANDS-SEG/#5>>     92076-1X006 REV.2040
      NAM BASC5,5 92076-1X006 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:  BASC5
*   SOURCE: 92076-18006 
*   RELOC:  PART OF 92076-16001 
*   PGRM:   B.J.L.
* 
* 
* 
************************************************************* 
* 
* 
      ENT BASC5 
      EXT SGMNT,TRAP,PRMT,INTCK,FNDPS,EXEC,LURQ 
      EXT LOGLU,FCONT,CLOSE,CREAT,PURGE,NAMF,READF,XQPRG
      EXT RUN,PLIST,LOADT,DIGCK,WRITF,NAMR,OPENF,.SBT 
      EXT FINDV,WRITE,OUTER,GETCR,BCKSP 
      COM TEMPS(32),PNTRS(81),FILBF(16),FLDCB(144),SPEC(10) 
* 
*PNTRS INCREASED TO 81  800727********************* 
* REMOVED IDRPL,IDRPD 800327*********************** 
*ADDED BCKSP TO EXTERNALS  800318****************** 
*TEMPS INCREASED TO 32  800107******************* 
*****ADDED CALL TO NAMR,OPENF,.SBT 790823**************** 
*PNTRS INCREASED TO 79  790830*************************** 
*PNTRS INCREASED TO 80  791010*************************** 
*****REMOVED CALL TO OPEN 790828************************* 
****ADDED CALL TO XQPRG  790905***************************
***************************************** 
*                                       * 
*    SEGMENT #5: EXECUTE THE COMMAND    * 
*                                       * 
***************************************** 
* 
*  THIS PART OF THE INTERPRETER IS LOADED BY THE BASIC MAIN CONTROL 
*    WHENEVER A STATEMENT IS FOUND THAT DOES NOT START WITH A STATE-
*    MENT NUMBER.THE STATEMENT IS THEN CHECKED TO SEE IF IT IS
*    A LEGAL COMMAND WITH PROPER SYNTAX. IF SO THE CORRECT COMMAND
*    ROUTINE IS EXECUTED AND CONTROL RETURNED TO
*    MAIN CONTROL, ELSE AN ERROR MESSAGE IS PRINTED.
      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
****************************790712***************************** 
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 790830********************************
**********************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*******
***************************790830*****************************
*READR NOP         **REMOVED 790828**** 
*PUNCH NOP         **REMOVED 790828***
***************************************************************** 
      SKP 
TEMPT BSS 24        TEMPORARIES 
      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 
.6    DEC 6 
.7    DEC 7 
.8    DEC 8 
.10   DEC 10
.12   DEC 12
.16   DEC 16
.31   DEC 31
.32   DEC 32
B40   EQU .32 
.43   DEC 43
.45   DEC 45
.48   DEC 48
.64   DEC 64
.103  DEC 103 
.128  DEC 128 
.9999 DEC 9999
B13   OCT 13
B14   OCT 14
B54   OCT 54
B72   OCT 72
B105  OCT 105 
B200  OCT 200 
B377  OCT 377 
B176  OCT 176000
M1    DEC -1
M2    DEC -2
M6    DEC -6
M17   DEC -17        **CHANGED FROM 16 TO 17 790829*************
M20   DEC -20 
M32   DEC -32 
M128  DEC -128
M2000 DEC -2000    **ADDED 790823*******
MAXSN DEC -10000
#OP   OCT 43         ***CHANGED 790927***** 
LOCK  OCT 100001
HOLD  NOP           **800122**
*UNLKA OCT 100000         ****REMOVED 790822**************
MAXCT DEC -16383
MSK0  OCT 377 
OPMSK OCT 77000 
HIMSK OCT 177400
ERBS  DEF ERR-1 
TEMAD DEF TEMP8     BIT BUCKET
DCBAD DEF FLDCB     DATA CONTRL BLK ADDRS 
LENGC EQU LUOUT-FWAM
LENCM ABS LENGC 
PMESS DEF *+1 
      OCT 6412
      SKP 
* 
CMDCT DEC -17       -NUMBER OF COMMANDS 
* 
CMDS  EQU * 
* 
* 
*     COMMAND MNEMONICS START HERE
* 
      OCT 3 
      ASC 2,RUN     EXECUTE PROGRAM 
* 
      OCT 3 
      ASC 2,DEL     DELETE PROGRAM
* 
      OCT 4 
      ASC 2,SAVE    SAVE PROGRAM
* 
      OCT 4 
      ASC 2,LIST    LIST PROGRAM
* 
      OCT 4 
      ASC 2,LOAD    LOAD PROGRAM
* 
      OCT 3 
      ASC 2,BYE     TERMINATE BASIC 
* 
      OCT 5 
      ASC 3,PURGE   PURGE FILE NAME 
* 
      OCT 5 
      ASC 3,MERGE   MERGE PROGRAM 
* 
      DEC 6 
      ASC 3,RENAME  RENAME FILE 
* 
      DEC 7 
      ASC 4,REPLACE SAVE PROGRAM WITH SAME NAME 
* 
      DEC 6 
      ASC 3,CREATE  CREATE A DATA FILE
* 
      DEC 6 
      ASC 3,TABLES  SET UP B & M TABLE NAMES
* 
      DEC 5 
      ASC 3,CSAVE   COMPILED SAVED
* 
      DEC 6 
      ASC 3,REWIND  REWIND TAPE 
* 
      DEC 4 
      ASC 2,WEOF    WRITE END-OF-FILE 
* 
      DEC 5 
      ASC 3,SKIPF   SKIP FILE FORWARD 
* 
      DEC 5 
      ASC 3,BACKF   SKIP FILE REVERSE 
* 
* 
**********************************************************************
* 
* 
*     THE FOLLOWING TABLE DEFINES ENTRY POINTS FOR EXECUTION
*     OF COMMANDS.
* 
**********************************************************************
* 
* 
* 
* 
CMDEX DEF *+1 
      DEF $RUN      EXECUTE PROGRAM 
      DEF $DEL      DELETE
      DEF $SAVE     SAVE
      DEF $LIST     LIST
      DEF $LOAD     LOAD
      DEF $BYE      TERMINATE BASIC 
      DEF $PURG     PURGE FILE NAME 
      DEF $MERG     MERGE PROGRAM 
      DEF $RNAM     RENAME FILE 
      DEF $RPLC     SAVE PROGRAM WITH SAME NAME 
      DEF $CREA     CREATE DATA FILE
      DEF $TABL     SET UP B & M TABLE NAMES
      DEF $CSAV     COMPILED SAVE 
      DEF $REW      REWIND TAPE 
      DEF $WEOF     WRITE END-OF-FILE 
      DEF $SKIP     SKIP FILE FORWARD 
      DEF $BACK     SKIP FILE REVERSE 
      SKP 
*************************** 
*                         * 
* CHECK FOR LEGAL COMMAND * 
*                         * 
*************************** 
* 
BASC5 NOP 
*********************REMOVED 790712*************************
*     LDA PFLAG     IS THIS INITIALIZATION?*****
*     CPA .9999 
*     RSS           YES, GO GET SEGMENT'S FWAM AND LWAM 
*     JMP BAS5C     NO, CONTINUE EXECUTION
*     JSB GMS.C 
*     JMP ROTAT     RET. TO MAIN FOR FWAM AND LWAM CHECK***** 
*****************************790713**************************** 
      LDA DCBAD     SET UP DATA CONTRL
      STA DCB         ADDRESS FOR COMMANDS
      STA LISTF     SET FOR NO LIST CONDITION 
      LDA .32       SETUP 
      STA BLANK       TO SKIP BLANKS
* 
      LDA FWAMB     COMPUTE 
      CMA,INA         LENGTH OF 
      ADA PBPTR         PROGRAM 
      INA 
      STA LENPG           FOR 'CSAVE' 
* 
      LDA PFLAG     CHAIN 
      CPA .2          STATEMENT?
      JMP $CHAN     YES!
      CPA .3        RELOAD MNEMONIC TABLE?
      JMP LDMTB     YES, LOAD MNEMONIC TABLE
      LDA SBPTR,I   GET FIRST LETTER
      CPA DLMTR     PRINT NEXT LINE COMMAND?
      JMP PNEXT     YES, DO IT TO IT
      LDB CMDCT     SEARCH FOR LEGAL COMMAND
      JSB TBSRH 
       DEF CMDS 
      JMP LOAD6     CAN'T FIND HERE SO LOOK IN SEG6 
      ADA CMDCT     DETERMINE ORDINAL # IN B&M TABLE
      CMA,INA 
      ADA COUNT 
      ADA CMDEX     INCREMENT TO ENTRY PT ADDRESS 
      LDA 0,I       GET ADDRESS OF COMMAND
      RSS           PEEL
      LDA 0,I           OFF 
      RAL,CLE,SLA,ERA       INDIRECTS 
      JMP *-2 
      JMP 0,I       EXECUTE THE COMMAND 
* 
LDMTB JSB LOADM     LOAD MNEMONIC TABLE 
      JMP PRMT       GO TO 'READY'
* 
LOAD6 CLA           SET FLAG SO 
      STA PFLAG       WE CAN GET COMMANDS IN SEG 6
      LDB .6        LOAD
      JMP SGMNT       SEGMENT#6 FOR REST OF COMMANDS
* 
* 
      SKP 
*      HERE FOR:   DEL [<LIMITS>] 
* 
$DEL   JSB GETCR    FETCH NEXT CHARACTER
      JMP DEL1      EOF!
      CPA B105      'E'?
      JMP DEL2      YES, MAYBE 'DELETE'?
**************************ADDED800327*******************************
      STB SPTP1     SAVE B IN CASE
      LDB M1        INDICATE FROM DELETE
      STB DLFLG 
      LDB SPTP1 
**************************800327*********************************** 
      JSB PGOLM    NO, FETCH LINE #'S 
      NOP           EOF DETECTED? 
      CLA          ZERO OUT DELETE FLAG *800327*
      STA DLFLG 
      LDA LOLIM     GET PROGRAM'S 
      LDB HILIM       LIMITS AND
      STA TEMP4         SAVE DESTINATION ADDRESS
CLPR1 CPB PBPTR     ALL OF PROGRAM MOVED? 
      JMP CLPR2     YES 
      LDA 1,I       NO, MOVE WORD FROM SOURCE TO
      STA TEMP4,I     DESTINATION ADDRESS 
      ISZ TEMP4     INCREMENT DESTINATION ADDRESS 
      INB           INCREMENT SOURCE ADDRESS
      JMP CLPR1 
CLPR2 LDA TEMP4     SET END-OF-PROGRAM
      STA PBPTR       POINTER 
      JMP PRMT
DEL1  JSB SCR       DELETE PROGRAM
      CLA           ZERO OUT INDICATOR FOR DEL *800701* 
      STA OCCNT     **800701**
      JMP PRMT      RETURN
* 
DEL2  CCB           SEARCH FOR
      JSB TBSRH       'ETE' 
      DEF ETE 
      JMP CERR1-1   NOT FOUND 
      JMP $DEL      OK! 
* 
*EDEL  CLA           CLEAR OUT LINE NUMBER COUNTER 
*     STA .LNUM 
*     JMP CERR1-1 
*REMOVED ABOVE ON 800318********* 
* 
ETE   OCT 3 
      ASC 2,ETE 
* 
SPTP1 NOP        *800326* 
SPTP2 NOP        *800326* 
DLFLG NOP        *800327* 
      SPC 3 
*      HERE FOR:   PURGE < FILE NAME : SC : LU >
* 
$PURG JSB GETCR     GET FIRST CHARACTER 
********************CHANGED 790822*************************** 
      JMP CERR1-1   ISSUE BAD COMMAND ERROR 
*     JMP PRMT      EOF DETECTED! 
*     CPA B54       DELIMITER?
*     JMP $PURG     YES, GET NEXT CHAR
************************************790822************************
*************************ADDED 791009*****************************
      JSB CKCOM     CHECK FOR COMMA 
      JMP CERR1-1   EOL SENSED! ERROR 
******************************791009******************************
      JSB NAMD0     GET NAME:SC:LU
      DEF NAME
      JSB PURGE     PURGE FILE NAME 
      DEF *+6 
      DEF DCB,I 
      DEF FERR
      DEF NAME
      DEF SC
      DEF LU
      JSB CKERR     CHECK FOR FILE ERROR
      JMP PRMT      NO! 
      SKP 
* 
*      HERE FOR:  RUN [<LIMITS>]<FILE NAME> 
* 
$RUN  JSB GETCR      FETCH NEXT CHAR
      JMP RUN       EOF!
      JSB CKCOM     CHECK FOR COMMA *800416*
      JMP RUN       JUST GO RUN ANYWAY
      JSB LIMCK     LIMITS LEGAL
      LDB LOLIM     SET UP
      STB LORUN       RUN 
      LDB HILIM         LIMITS
      STB HIRUN           FOR EXECUTION 
      LDB .1        RESTORE 
      STB LOLIM       LIMITS
      LDB .9999         SO ALL
      STB HILIM           OF PROG GETS LOADED 
      CPA .10       LOAD PROGRAM? 
      JMP RUN       NO! 
      JSB CKCOM 
      JMP RUN 
      JSB CK#       CHECK FOR # 
      JSB FROMS     ****SET FRMTO FLAG=2 FOR READ  791002 
      JSB NAMD0     GET NAME:SC:LU
      DEF NAME
*************************ADDED 800320********************************** 
      LDA NAME     CHECK FOR BIT BUCKET 
      SZA,RSS      IF USED ERROR
      JMP BITER 
*****************************800320************************************ 
      LDA .5        SET TO PRETEND ITS
      STA PFLAG       A CHAIN TO LOAD AND EXEC
      JSB FOPEN     OPEN PROGRAM
      JSB SCR       DELETE CURRENT PROGRAM
      LDA TYP       CSAVED
      CPA .10         PROGRAM?
      RSS           YES!
      JMP LOADT     NO! 
      LDA REC#      SAVE RECORD 
      STA JREC        NUMBER
      JSB GTCSA     LOAD CSAVED PROGRAM 
      LDA JREC      RESTORE 
      STA REC#        RECORD NUMBER 
      JMP RUN       RUNIT 
* 
* 
      SKP 
******************ADDED 790822**********************************
* 
* 
* THIS ROUTINE CHECKS FOR THE #LU CONDITION IN A COMMAND.  IF 
* THERE IS A # SIGN THEN IT IS IGNORED AND THE NEXT CHARACTER 
* IS RETRIEVED TO BE PARSED BY NAMR. IF AN EOL IS FOUND THE LU
* FILENAME NOT SPECIFIED IS ISSUED. 
* 
*          A= NEXT CHARACTER ON ENTRY AND EXIT
* 
* 
CK#   NOP 
      CPA #OP       CHECK FOR # 
*********************CHANGED 790924*******************************
      JMP CK11      IGNOR IT!!! 
      JMP CK#,I     NO # SENSED 
CK11  JSB GETCR     GO GET NEXT CHAR. 
      JMP STERR     EOL SENSED, ERROR 
***************************ADDED 791009************************** 
      JSB CKCOM     CHECK FOR COMMA 
      JMP STERR     EOL! ERROR
******************************791009****************************
      JMP CK#,I     GO ON RETURN
**************************790924********************************* 
* 
*      HERE FOR:  SAVE,CHANGE OR LIST [<LIMITS>]<FILE NAME> 
* 
$RPLC CCA           SET PURGE 
*     STA TEMP6       FLAG ***REMOVED 790822********* 
      STA PFLAG         AND LU TEST FLAG
      JMP SAVE1 
* 
*  LISTF=0 FOR LIST COMMAND AND # 0 FOR SAVE OR REPLACE 
* 
$LIST CLA           SET DEFAULT TO
      STA LISTF       KEYBOARD AND SET
      JMP $SAVE+1       LIST FLAG FOR TYPE 0 FILE 
      SPC 1 
$SAVE CCA           SET 
      STA PFLAG       LU TEST FLAG
      CLA           RESET 
SAVE1 STA TEMP6       PURGE FLAG
*************************CHANGED 800418********************************** 
      JSB GETCR 
      JMP PREP      EOL SENSED, CHECK FOR LIST
      JSB CKCOM     CHECK FOR COMMA 
      JMP PREP      EOL SENSE, ERROR
      STB SAVB
      LDB PBUFF     INITIALIZE
      STB LOLIM       LIMITS
      LDB PBPTR         TO INCLUDE
      STB HILIM           ALL OF PROGRAM
      LDB SAVB      *800417*
      JSB PGOLM      GET PROGRAM LIMITS 
      JMP SAVE4    EOL SENSED ***CHANGED 790822****** 
      JSB CKCOM 
      JMP SAVE4   
      JSB CK#       CHECK FOR #LU AND IGNOR # 
      JSB ONS       **SET FRMTO FLAG=1 FOR WRITE 791002 
      JSB NAMD0     GET NAME:SC:CR
      DEF NAME
      CLA,INA       SET PFLAG FOR 
      STA PFLAG       FILE OUTPUT 
      LDA TEMP6     IS THERE
      SZA             A PURGE REQUIRED
      JMP SAVE2     YES!
SAVE3 JSB FOPEN     NO, OPEN OR CREATE FILE 
      JMP PLIST 
* 
SAVE2 JSB PURGE     PURGE FILE
      DEF *+6         WITH
      DEF DCB,I         NAME
      DEF FERR            THAT IS 
      DEF NAME              SAME
      DEF SC
      DEF LU
      LDA FERR      IS FILE 
      CPA M6          NOT THERE 
      RSS           NO, SO CONTINUE 
      JSB CKERR     WAS THERE A FILE ERROR? 
      LDA DCB       IS THIS 
      ADA .2          A 
      LDA 0,I           TYPE 10 
      CPA .10             FILE ?
      JMP $CSA1         YES, CSAVE IT 
      JMP SAVE3           OTHERWISE DO REGULAR SAVE 
* 
************************ADDED 790822****************************
SAVE4 LDA PFLAG     CHECK FOR LIST COMMAND
      SSA,RSS       IS ONLY COMMAND HERE WITH DEFAULT 
      JMP PLIST     *800417*IS LIST.  GO PREPARE FOR LIST 
      JMP STERR     ISSUE ERROR OF NO LU/FILENAME 
* 
*ADDED 800418** 
PREP  LDA PFLAG     CHECK FOR LIST WITH NO LIMITS 
      SSA 
      JMP STERR     NOT A LIST SO ERROR 
      LDB PBUFF     *800417 ADDED*
      STB LOLIM 
      LDB PBPTR 
      STB HILIM 
      JMP PLIST 
* 
SAVB  NOP           *800416** 
*******************************790822*****************************
* 
      SKP 
* 
*     HERE FOR:   >/     LIST NEXT LINE 
* 
PNEXT JSB GETCR     GET FIRST CHAR
      JMP PNEX2     EOF, NO STMT #
      JSB DIGCK     NUMBER? 
******************************ADDED 800321************************* 
      JMP SLERR     MAKE SURE NO EDIT CAN BE DONE 
******************************800321******************************* 
      ADA .48 
      JSB INTIN     FETCH NUMBER
      DEF MAXSN 
      SZB,RSS       ZERO? 
      JMP ERROR     YES, BAD! 
CER14 LDA 1 
      JMP PNEX3 
* 
PNEX2 LDA .LNUM     GET CURRENT LINE #
      CPA .9999     LAST STATEMENT OF PROG? 
****REMOVED LABEL 'PNEX1' 790822********************************* 
      CLA           YES!
      INA           NO, GET 
PNEX3 JSB FNDPS         AND DETERMINE WHAT
      JMP PNEX5           THE NEXT ONE
      NOP                   IF ANY
PNEX4 LDA 1,I       THEN
      STA .LNUM       SET UP
      STB LOLIM         LIMITS
      INA 
      JSB FNDPS     FIND
      NOP             POSITION
      NOP               OF NEXT 
      STB HILIM           STATEMENT 
      JMP PLIST             ONE LINE ONLY 
* 
PNEX5 CLA,INA       TRY ONCE THROUGH
      JSB FNDPS       THE ENTIRE
      JMP CER14-1   NOT THERE, ERROR
      NOP 
      JMP PNEX4     FOUND 
* 
*******************************ADDED 800321**************************** 
SLERR LDB ASCER 
      STB .OTBF,I 
      JMP CERR1-1 
* 
ASCER ASC 1,ER
* 
**********************************800321******************************
      SPC 3 
*      HERE FOR:  BYE 
* 
* 
$BYE  JSB FCLOS     CLOSE ANY OPEN FILE 
      LDA .2        OPEN
      JSB TRAP        UP
      NOP               TRAP TABLE
* 
      LDA MNNAM     ANY B&M 
      SZA             TABLE?
      JMP BYE1      YES!
* 
BYE3  JSB EXEC      TERMINATE BASIC PROGRAM 
      DEF *+2 
      DEF .6
* 
BYE1  LDA FWAMM,I   SETUP 
      STA TEMP1     SUBROUTINE COUNTER
      LDB FWAMB     SETUP BRANCH TABLE PTR
      STB TEMP2 
BYE2  LDA 1,I       GET OVERLAY NAME
      STA TEMP3     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 TEMP3 
      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*********************************** 
      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 BYE3      YES!
* 
NAM   ASC 3,BSXXXX      **CHANGED 790822******************
TCODE OCT 100012    TERMINATE W/0 ERROR 
AB    ASC 1,AB
B     EQU 1        *800205* 
HOLD1 NOP          *800205* 
      SKP 
* 
*     HERE FOR :   CSAVE <FILE NAME>
* 
$CSAV JSB GETCR     GET FIRST CHAR
*********CHANGED 790822*****************************
      JMP STERR     EOL IS A NO-NO
************************ADDED 791009*************************** 
      JSB CKCOM     CHECK FOR COMMA 
      JMP STERR     EOL, ERROR
******************************791009******************************* 
      JSB CK#       CHECK FOR #LU 
*     JMP CERR1-1   ILLEGAL EOF 
      JSB ONS       SET FRMTO FLAG=1 FOR WRITE 791002 
***************************790822***********************
      JSB NAMD0     FETCH FILE NAME:SC:LU 
      DEF NAME
* 
$CSA1 LDA LENCM     COMPUTE 
      ADA LENPG       SIZE OF 
      CLB 
      DIV .128            SAVED IN
      INA                   NUMBER OF 
      STA TEMP7               BLOCKS
* 
      JSB CREAT     CREATE
      DEF *+8         A TYPE 10 
      DEF DCB,I         FILE FOR
      DEF FERR            SAVING
      DEF NAME              A SEMI-COMPILED 
      DEF TEMP7               PROGRAM 
      DEF .10                   WITHOUT 
      DEF SC                      EXTENTS 
      DEF LU
* 
      JSB CKERR     ERROR?
* 
      JSB WRITF     WRITE 
      DEF *+5         OUT 
      DEF DCB,I         THE COMMON
      DEF FERR            AREA
      DEF FWAM              THAT CONTAINS 
      DEF LENCM               ALL THE 
* 
      JSB CKERR     ERRORS? 
* 
      JSB WRITF     WRITE 
      DEF *+5         OUT 
      DEF DCB,I         ALL 
      DEF FERR            OF
      DEF FWAMB,I           THE 
      DEF LENPG               PROGRAM 
* 
      JSB CKERR     ERROR?
* 
      JSB FCLOS     CLOSE THE CSAVE FILE
* 
      JSB CKERR     ERRORS? 
* 
      JMP PRMT      GO BACK TO 'READY'
* 
LISTF BSS 1         LIST FLAG 
LENPG BSS 1         LENGTH OF PROGRAM 
      SKP 
* 
*      HERE FOR:  LOAD OR MERGE [<LIMITS>]<FILE NAME> 
* 
$MERG CCA           SET FLAG SO 'ACTST' DOESN'T OVERLAY STMTS 
      STA MERGF       IN SYNTAX SEGMENT 
* 
*$LOAD CCA          ***REMOVED 790822*****
*     STA PFLAG     SET FOR DEFAULT INPUT **REMOVED 790822****
$LOAD JSB GETCR      GET NEXT CHAR  **CHANGED 790822***** 
      JMP STERR     EOL! ISSUE ERROR  **790822**
      JSB CKCOM     CHECK FOR COMMAN *800416* 
      JMP STERR     EOL, ERROR
      JSB LIMCK      FETCH PROG LIMITS
      CPA .10        EOF ?
      JMP STERR       YES, ISSUE ERROR!!!  **CHANGED 790822** 
      JSB CKCOM 
      JMP STERR      COMMA? YES, ERROR
      JSB CK#       CHECK FOR #LU     **ADDED 790822***** 
      JSB FROMS      SET FRMTO FLAG=2 FOR READ 791002 
      JSB NAMD0     GET NAME:SC:CR
      DEF NAME
****************************ADDED 800320*************************** 
      LDA NAME     CHECK FOR BIT BUCKET 
      SZA,RSS      IF 0 THEN FORCE FMP ERROR
      JMP BITER 
******************************800320******************************* 
      CLA,INA       SET PFLAG FOR 
      STA PFLAG       FILE INPUT
      JSB FOPEN     OPEN OR CREATE FILE 
      LDA MERGF     IS THIS A 
      SZA,RSS         'MERGE'?
      JSB SCR       NO, DELETE PROGRAM! 
      LDA TYP       IS THIS 
      SZA,RSS       TYPE 0 FILE GO LOAD   *791231*
      JMP LODIT     SYNTAX WILL CATCH ERRORS *791231* 
      CPA .10         A 'CSAVED' PROGRAM? 
      JMP SAVEC     YES  *CHANGED 790712**
*****************************790712************** 
      CPA .3        IS IT A TYPE 3? 
      JMP LODIT     LOAD IT 
      CPA .4        IS IT A TYPE 4? 
      JMP LODIT     LOAD IT 
      JMP CER1      NO, ISSUE A BAD FILE ERROR
**********************************790712*************** 
LODIT JMP LOADT     NO, LOAD AND CHECK SYNTAX 
SAVEC JSB GTCSA     LOAD CSAVED FILE
      JMP PRMT      GO TO 'READY' 
* 
LTAPE LDA MERGF     IS THIS 
      SZA,RSS         A 'MERGE'?
      JSB SCR       NO, DELETE PROG IN MEMORY 
      JMP LOADT 
* 
****************************ADDED 800320****************************
BITER LDA M17 
      STA FERR       FORCE IN FMP ERROR 
      JMP CKERR 
********************************800320******************************
* 
*  LOAD A 'CSAVE'D' FILE
* 
* 
* 
GTCSA NOP 
      LDA FWAMB     SAVE CURRENT
      LDB LWBM
      DST TEMP4       LIMITS OF THIS PROG 
      JSB READF     READ
      DEF *+6         IN
      DEF DCB,I         COMMON
      DEF FERR            BLOCK 
      DEF FWAM              OF
      DEF LENCM               NEW 
      DEF TEMP3                 PROGRAM 
      LDA TEMP3     ARE RECORD
      CPA LENCM       LENGTHS THE SAME? 
      RSS           YES, MAY BE OK THEN 
      JSB OOPS      NO, IN COMPATIBLE 'CSAVE' *791119*
      JSB CKERR     ANY OTHER ERROR?
      SKP 
      JSB READF     READ
      DEF *+4         MAIN
      DEF DCB,I         BODY
      DEF FERR            OF
      DEF FWAMB,I           PROGRAM 
      JSB CKERR     ANY OTHER ERRORS? 
* 
      DLD TEMP4     RETRIEVE OLD BOUNDARIES 
      CPA FWAMB     IS IT THE SAME? 
      RSS           YES 
      JMP OOPS      NO, INCOMPATIBLE CSAVE!  *791119* 
      CPB LWBM      IS END BOUNDARY THE SAME? 
      RSS           OK, RETURN
      JMP OOPS      NO, INCOMPATIBLE 'CSAVE' *791119* 
      LDA MNNAM     ANY 
      SZA             TABLES? 
      JSB LOADM     YES, MAKE SURE B&M TABLES ARE STUFFED IN
      JMP GTCSA,I 
* 
OOPS  CLA            CLEAR OUT LINE NUMBER COUNTER *791119* 
      STA .LNUM 
      JSB ERROR 
CER12 EQU * 
*                     **791119* 
      SKP 
* 
*     HERE FOR:   100 CHAIN <FILE NAME> [,STMT #] 
* 
$CHAN 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. 8 
*        UNDER EEND 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 MSK0
      IOR B200
      STA LUOUT     SAVE THE LU WORD
      STB HOLD      **SAVE B BEFORE NEW CALL TO 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 
* 
      LDA LORUN     SAVE RUN
      STA LORN        START STMT NUMBER 
      LDA TEMP8     FILE NAME 
      STA ICCNT       COUNT 
      LDB TEMP7     FILE NAME 
      STB INBFA       ADDRESS 
      JSB GETCR     GET THE FIRST CHAR
      JSB ERROR     NONE FOUND
* 
CERR1 JSB NAMD0     CHECK NAME FORMAT 
      DEF NAME
      LDA .2        SET FRMTO FLAG=2 FOR READ 791002
      STA FRMTO 
      LDA MNNAM     ANY B&M 
      SZA             TABLES? 
      JSB LOADM     YES,LOAD MNEMONIC TABLE 
      JSB FOPEN     OPEN FILE 
      LDA TYP       IS IT A 'CSAVE' 
      CPA .10         FILE? 
      JMP CSAVE     YES 
      CPA .6        PROGRAM FILE? 
      JMP PROG      YES!
      CPA .4        ASCII FILE? 
      RSS           YES!
      CPA .3        ASCII FILE? 
      RSS           YES!
CER1  JSB ERROR     BAD FILE TYPE******790712********** 
CER16 EQU * 
      JSB SCR       DEL CURRENT PROGRAM 
      JMP LOADT     LOAD PROGRAM
CSAVE JSB SCR 
      JSB GTCSA     LOAD CSAVE FILE 
      LDA LORN      RESTORE STARTING STMT 
      STA LORUN       NUMBER
      LDA .9999     SET HI RUN
      STA HIRUN       STMT NUMBER 
      JMP RUN       RUN THE PROGRAM 
* 
*    HERE FOR SCHEDULE A NON-BASIC PROGRAM (TYPE 6 FILE)
* 
********************************REMOVED 790905************************* 
*PROG  JSB LOGLU     GET LU IN ASCII
*      DEF *+2
*      DEF FERR 
*      CPA .1        SYSTEM CONSOLE?
*      JMP OLDNM     YES, DONT MODIFY NAME
*      CLB           CONVERT
*      DIV .10
*      ALF,ALF         TO ASCII 
*      ADB 0
*      ADB ASC00
*      CLA
*      RRR 8
*      IOR B40
*      STA NWNAM+2
*      STB TEMP3
*      LDB ADNAM     ADDR OF NAME 
*      LDA 1,I
*      AND B377      IS 
*      CPA B40         SECOND CHAR A SPACE
*      JMP SPAC2     YES! 
*      LDA 1,I
*NA1   STA NWNAM
*      INB
*      LDA 1,I       IS 
*      ALF,ALF         THIRD CHAR 
*      AND B377          A
*      CPA B40             SPACE? 
*      JMP SPAC3     YES! 
*      LDA 1,I
*      AND HIMSK
*      IOR TEMP3     MASK IN 1ST LU DIGIT 
*NA2   STA NWNAM+1
*RPPRG JSB IDRPL     REPLACE PROGRM(:RP,PROG) 
*      DEF *+4
*      DEF DCB,I
*      DEF FERR 
*      DEF NWNAM
*      LDA FERR 
*      SZA
*      JMP PROG1
*PROG2 JSB EXEC      SCHEDULE 
*      DEF *+5
*      DEF SCHD        PROGRAM
*NAMM  DEF NWNAM
*      DEF TTYPR         WITH WAIT
*      DEF PRINT
**
*      JSB ERROR     BAD SCHEDULE REQUEST 
*CER20 EQU *
*      LDA FERR      HAS PROGRAM
*      CPA .23         BEEN RP'D BY SOME ONE ELSE?
*      JMP PROG3     YES, DONT RELEASE IT THEN
*      JSB IDRPD     RELEASE ID SEG 
*      DEF *+3
*      DEF NWNAM
*      DEF FERR 
*PROG3 CLB
*      STB TEMP3     CLEAR ERROR FLAG 
*      LDA .3 
*      STA SLSTM     SET SLOW STMT FLAG FOR END-OF-PROGRM 
*      LDB .8 
*      JMP SGMNT     GO TO SEGMENT 8
**
*PROG1 CPA .23       DUPLICATE PROG 
*      JMP DUP       OK, GO SCHEDULE HIM/HER
*      CPA M15       ILLEGAL NAME?
*      JMP ERROR     YES! **CHANGED 790822****
*CERR3 EQU *          **ADDED 790822****
*      CPA .14       ID SEG FOUND OR NON AVAIL? 
*      JSB ERROR     REQD ID SEG NOT FOUND OR NONE AVAIL! 
*CER17 EQU *
*      CPA .16       NOT ON LU2 OR 3? 
**     JSB ERROR     PROGRM NOT ON LU 2 OR 3! **CHANGED 790822****
**CER18 EQU *          **REMOVED 790822**** 
*      CPA .19       NOT SET UP ON CURRENT SYSTEM?
*      JSB ERROR     NO!
*CER19 JMP CERR1-1
**
*DUP   LDA ADNAM
*      STA NAMM 
*      JMP PROG2
**
*SPAC2 LDA 1,I
*      AND HIMSK
*      IOR R.        MASK IN PERIOD 
*      JMP NA1
**
*OLDNM DLD NAME      USE OLD
*      DST NWNAM
*      LDA NAME+2 
*      STA NWNAM+2
*      JMP RPPRG     RP PROGRAM 
**
*SPAC3 LDA TEMP3
*      IOR L.        MASK IN PERIOD 
*      JMP NA2
**
*LORN  BSS 1
*SCHD  OCT 100027 
*R.    OCT 56 
*L.    OCT 27000
*NWNAM BSS 3
*ADNAM DEF NAME 
*ANAME DEF NWNAM
*M15   DEC -15
*ASC00 ASC 1,00 
*.14   DEC 14 
*.19   DEC 19 
*.23   DEC 23 
****************************790905************************************* 
* 
* 
* 
*  THIS SECTION IS ADDED TO UTILIZE THE 'XQPRG' ROUTINE TO SCHEDULE 
*  A NON-BASIC PROGRAM INSTEAD OF 'IDRPL' AND 'IDRPD'.
* 
*  NOTE: ERRORS 7 THRU 10 RETURNED FROM XQPRG ARE IGNORED AS
*        "IMPOSSIBLE TO GET ERRORS".
* 
****ADDED 790905******************************************************
* 
*  INITIALIZE AND BUFFER AND POINTERS 
* 
PROG  LDA PTBUF     INITIALIZE POINTER
      STA BUFPT     TO PARAMETER BUFFER 
      LDA TTYPR     MOVE IN THE TWO 
      STA BUFPT,I   PARAMETERS PASSED BEFORE
      ISZ BUFPT     INTO THE PASSING BUFFER 
      LDA PRINT     ALSO ZERO OUT THE REMAINING 
      STA BUFPT,I   3 WORDS OF THIS BUFFER. 
      CLA 
STUFF ISZ BUFPT 
      STA BUFPT,I 
      ISZ M3
      JMP STUFF 
* 
*  SCHEDULE THE PROGRAM 
* 
PROG1 JSB XQPRG     SCHEDULE THE PROGRAM
      DEF PROG2     WITHOUT WAIT
      DEF SDCB      **791114**
      DEF .24 
      DEF NAME      NAME FROM COMMON
      DEF BUFFR     PARAMETER BUFFER
      DEF DUMMY     DON'T CARE STRING 
      DEF .0        DON'T CARE STRING LENGTH
      DEF BUFFR     RETURN STUFF (NOTE: OLD FMP ERROR IS
*                   PASSED IN FIRST WORD HERE)
      DEF IERR      XQPRG'S ERRORS
      DEF .0        DON'T CARE SEC. CODE
      DEF .0        DON'T CARE CRN# 
* 
*  CHECK FOR ERRORS 
* 
PROG2 LDA IERR
      SZA,RSS       WAS THERE AN ERROR? 
      JMP PROG3     NO!!! 
      CPA .1        A DUP. PROG ERROR?
      JMP ERROR     YES 
CER18 CPA .2        NOT RIGHT OR ENOUGH ID'S? 
      JMP ERROR     YES 
CER17 CPA .6        NOT ON RIGHT SYS.?
      JMP ERROR     YES 
CER19 CPA .3        PROGRAM NOT FOUND?
      JMP FORCE     YES 
      CPA .4        FILE OPEN, ETC.?
      JMP FORCE     YES 
      CPA .5        FILE CLOSE ERROR? 
      RSS 
      JSB ERROR     "LAST RESORT" ERROR 
CER20 EQU * 
* 
*  IF FMP ERROR FORCE INTO FERR PROCESSING
* 
FORCE LDA BUFFR     PICK UP THE FMP ERROR 
      STA FERR      RETURNED IN BUFFER
      JSB CKERR     GO ISSUE FMP ERROR
* 
*  EXIT POINT 
* 
PROG3 CLB           CLEAR ERROR FLAG
      STB TEMP3 
      LDA .3
      STA SLSTM     SET SLOW STMT FLAG FOR END-OF-PROGRAM 
      LDB .8        GO TO SEGMENT 8 
      JMP SGMNT 
* 
SDCB  BSS 144 
BUFFR BSS 5 
.24   DEC 24
DUMMY NOP 
IERR  NOP 
M3    DEC -3
PTBUF DEF BUFFR 
BUFPT NOP 
********************790905******************************************
LORN  BSS 1 
      SKP 
* 
*       HERE FOR:  RENAME <CURRENT FILE NAME>,<NEW FILE NAME> 
* 
$RNAM JSB GETCR     GET FIRST CHARACTER 
      JMP CERR1-1    IF EOF THEN ERROR
****************************ADDED 791009*************************** 
      JSB CKCOM     CHECK FOR COMMA 
      JMP CERR1-1   EOL, ERROR
****************************791009********************************* 
      JSB NAMD0     GET CURRENT NAME:SC:CR
      DEF NAME
*     JSB DELM      CHECK FOR DELIMITER **REMOVED 790822*** 
      CPA .10       IS THIS AN EOL? *791009*
      JMP CERR1-1   YES, ERROR          *791009 
      JSB GETCR     NO, WAS A COMMA, GET NEXT CHAR
      JMP CERR1-1   EOL, ERROR
      JSB NAMD0     GET THE **CHANGED 790822**
      DEF NNAME       NEW 
*     DEC -7            NAME:SC:CR  **REMOVED 790822****
      JSB NAMF      CHANGE
      DEF *+7         THE 
      DEF DCB,I 
      DEF FERR          OLD NAME
      DEF NAME            TO THE
      DEF NNAME             NEW NAME
      DEF SC
      DEF LU
      JSB CKERR     WAS THERE A FILE ERROR? 
      JMP PRMT      NO! 
      SKP 
* 
*     HERE FOR:   CREATE <FILE NAME>,<FILE SIZE>
* 
$CREA JSB GETCR     GET THE FIRST CHAR OF NAME
      JMP CERR1-1   NO NAME FOUND 
***************************ADDED 791009**************************** 
      JSB CKCOM     CHECK FOR COMMA 
      JMP CERR1-1   EOL, ERROR
***************************791009****************************** 
*     CPA B54       ALLOW COMMA AS DELIMITER**REMOVED 790822**
*     JMP $CREA       **REMOVED 790822****************
      JSB NAMD0     GET THE NAME:SC:CR
      DEF NAME
      CPA .10       IS THIS AN EOL? *791009*
      JMP CREA2     YES, NO STATEMENT # *791009 
*     JSB DELM      CHECK DELIMITER  **REMOVED 790822**** 
      JSB GETCR     NO, GET FIRST CHARACTER OF SIZE 
      JMP CREA2     NO SIZE PARAMETER 
      JSB DIGCK     NUMBER? *791009*
      JSB ERROR     NO, ERROR****791009***
CERR9 EQU *         *791009** 
      ADA .48       RECONSTRUCT CHARACTER 
      JSB INTIN     CONVERT IT
      DEF MAXCT   **800220 CHANGED TO -16383 MAX. 
      SZB,RSS      **800220*  CHECK FOR ERROR CONDITION 
      JMP CERR9-1  **800220** YES, ERROR
CREA3 STB LNGTH     SAVE FILE SIZE
      JSB CREAT     CREATE
      DEF *+8         A FILE
      DEF DCB,I         WITH THE
      DEF FERR            SIZE SPECIFIED
      DEF NAME              AND OF TYPE 
      DEF LNGTH               ONE 
      DEF .1                    WHICH INDICATES A 
      DEF SC                      A BASIC DATA FILE 
      DEF LU
      JSB CKERR     CHECK FOR FILE ERROR
* 
*  WRITE EOFS IN DATA FILE
* 
      LDA LNGTH     SET UP
      CMA,INA         NO. OF RECORDS
      STA TEMP4         COUNTER 
      LDA DCB       FILL
      ADA .16 
      STA TEMP3       BUFFER
      STA TEMP5 
      CCA 
      LDB M128          WITH
      STA TEMP3,I 
      ISZ TEMP3           EOF 
      INB,SZB 
      JMP *-3               MARKS 
CREA1 JSB WRITF     WRITE 
      DEF *+6         RECORD FULL 
      DEF DCB,I         OF ALL
      DEF FERR            MINUS 
      DEF TEMP5,I           ONES
      DEF .128                WHICH ARE 
      DEF .0                    EOF MARKS 
      JSB CKERR     ANY ERRORS? 
      ISZ TEMP4     FINISHED? 
      JMP CREA1     NOT DONE! 
      JMP PRMT      RETURN TO BASIC 
* 
CREA2 LDB .1        SET FILE SIZE TO 1 BLOCK
      JMP CREA3       WHEN NO SIZE PRESENT
      SKP 
* 
*     HERE FOR:    TABLES <BRANCH TBL FILE>,<MNEMONIC TBL FILE> 
* 
$TABL LDA PBUFF     IS THERE A
      CPA PBPTR       PROGRAM IN MEMORY ? 
      RSS               NO, OK TO PROCEED 
      JSB ERROR         YES, ERROR -- DO NOT DISTURB
CER10 EQU *               EXISTING TABLES 
      JSB GETCR     GET FIRST CHARACTER 
      JMP CERR1-1   IF EOL IT IS BAD
*     JSB DELM      DELIMITER?  **REMOVED 790822**
*     JMP CER10     YES, GET NEXT CHARACTER **REMOVED 790822*** 
*************************ADDED 791009************************** 
      JSB CKCOM     CHECK FOR COMMA 
      JMP CERR1-1   EOL, ERROR
*****************************791009**************************** 
      JSB NAMD0     GET BRANCH TABLE
       DEF BRNAM      FILE NAME 
*     JSB DELM      CHECK DELIMITER  *DELETED 791009* 
      CPA .10       IS THIS AN EOL? *791009*
      JMP CERR1-1   YES, ERROR
      JSB GETCR     NO, GET NEXT CHARACTER
      JMP CERR1-1   IF EOL HERE ITS BAD 
      JSB NAMD0     GET MNEMONIC TABLE
       DEF MNNAM      FILE NAME 
      JSB OPENF     OPEN     **CHANGED 790822****** 
      DEF *+7 
      DEF DCB,I       BRANCH
      DEF FERR
      DEF BRNAM         TABLE FILE
      DEF .0              EXCLUSIVE 
      DEF BRNAM+3 
      DEF BRNAM+4 
      JSB XCKER     FMP ERROR?
      LDA FWAMB     REMOVE OLD TABLE
      STA FWAM        POINTERS
      STA TEMP4 
LOAD4 JSB READF     READ
      DEF *+6 
      DEF DCB,I       BRANCH TABLE
      DEF FERR
      DEF TEMP4,I       INTO MEMORY 
      DEF .9999 
      DEF TEMP3           LOCATED BEFORE PROG 
* 
      LDB TEMP3 
      CPB M1        EOF READ? 
      JMP LOAD5     YES 
      ADB TEMP4     NO, SET NEW READ
      STB TEMP4         INDEX 
      STB PBUFF         AND PROG
      STB PBPTR           PTRS
      STB FWAM
      JMP LOAD4     NO, READ SOME MORE
LOAD5 JSB XCKER     FMP ERROR?
* 
      JSB LOADM     LOAD MNEMONIC TABLE 
      LDA TEMP4     IS THIS    *800627*BUG FIX* 
*     ADA FWAMM       MNEMONIC  **REMOVED 800717**
      CMA,INA           TABLE 
      ADA FWAM            TOO 
      SSA                   BIG?
      JSB LERRX     YES!, REPORT ERROR AND NULL 
CERR4 EQU *           MNEMONIC AND BRANCH TABLES
      SKP 
      LDA FWAMM,I   ARE THE 
      AND B176        B&M TABLES
      CPA B176          IN THE CORRECT ORDER? 
      JMP PRMT      YES 
      JSB LERRX     NO, REPORT ERROR AND NULL 
CER15 EQU *           MNEMONIC AND BRANCH TABLES
* 
*  READ MNEMONIC TABLE INTO SPACE BETWEEN LONGEST 
*  SEGMENT AND NEXT TO LONGEST SEGMENT
* 
LOADM NOP 
      JSB OPENF     OPEN     **CHANGED 790828***
      DEF *+7         MNEMONIC
      DEF DCB,I         TABLE 
      DEF FERR            FILE
      DEF MNNAM 
      DEF .0                EXCLUSIVE 
      DEF MNNAM+3 
      DEF MNNAM+4 
      JSB XCKER     FMP 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 TEMP3 
      LDB TEMP3 
      CPB M1        EOF READ? 
      JMP LOAD7     YES 
      ADB TEMP4     NO, SET NEW READ
      STB TEMP4         INDEX 
* 
      JMP LOAD3     NO, READ SOME MORE
LOAD7 JSB XCKER     FMP ERROR?
      JSB FCLOS       NO, RELEASE MNEMONIC TABLE
      JMP LOADM,I       AND RETURN
      SKP 
* 
*     HERE FOR:    REWIND <TYPE 0 FILE NAME>
* 
$REW  LDA .4        SET CONTROL 
      JMP FCNT        REWIND
      SPC 1 
$WEOF LDA .1        SET CONTROL 
      JMP FCNT        WRITE EOF 
      SPC 1 
$SKIP LDA B13       SET CONTROL 
      JMP FCNT        FOR SKIP FILE FORWARD 
      SPC 1 
$BACK LDA B14       SET CONTROL FOR BACK SPACE FILE 
FCNT  RRL 6         SET UP
      STA ICODE       CONTROL WORD
* 
      JSB GETCR     GET FIRST CHAR
      JMP CERR1-1   NO NAME FOUND 
*************************ADDED 791009****************************** 
      JSB CKCOM     CHECK FOR COMMA 
      JMP CERR1-1   EOL, ERROR
      JSB CK#       CHECK FOR # 
*****************************791009******************************** 
      JSB NAMD0     GET THE NAME OF THE DEVICE**790822**
      DEF NAME
*     DEC -7         **REMOVED 790822*********************
      JSB OPENF     TRY           **CHANGED 790822**********
      DEF *+4         TO
      DEF DCB,I         OPEN
      DEF FERR            THE 
      DEF NAME              DEVICE FILE 
      JSB CKERR     CHECK FOR ERROR 
**********************REMOVED 790822************************* 
*     LDA DCB       CHECK IF THIS 
*     ADA .2          IS A TYPE 0 
*     LDA 0,I           FILE
*     SZA                 TYPE 0? 
*     JMP CER11-1   NO! 
* 
**********************************790822************************
      JSB FCONT     PERFORM 
      DEF *+4         THE 
      DEF DCB,I         OPERATION 
      DEF FERR
      DEF ICODE 
      JSB CKERR     ANY ERRORS? 
      JMP PRMT      NO! 
* 
ICODE BSS 1 
      SKP 
**********************************
*                                *
*  CHECK FOR FILE MANAGER ERROR  *
*                                *
**********************************
* 
CKERR NOP 
      LDA FERR      IS THERE
      SSA,RSS         AN ERROR? 
      JMP CKERR,I   NO! 
CKER1 CLB           RESET 
      STB PFLAG       FILE FLAG 
      STB .LNUM             AND NO LINE NO. FLAG
CKER2 STA TEMP3     SAVE ERROR **CHANGED 790822************** 
      JSB FCLOS     CLOSE WHATEVER FILE IS OPEN 
      JMP OUTER       AND GO TO ERROR PROCESSOR 
* 
**********************ADDED 790822***************************** 
STERR LDA M2000     FORCE NOT SPECIFIED LU/FILENAME ERROR 
      JMP CKER1     *CHANGED 791009** 
*************************790822************************** 
* 
XCKER NOP           CHECK FATAL TABLES ERRORS 
      LDA FERR      IS THERE
      SSA,RSS         ANY ERROR ? 
      JMP XCKER,I       NO
      CLB               YES, NULL 
      STB MNNAM           MNEMONIC AND
      STB BRNAM             BRANCH TABLES 
      JMP CKER1 
      SPC 2 
LERRX NOP           ROUTINE TO REPORT FATAL TABLES ERRORS 
      CLA           NULL
      STA MNNAM       MNEMONIC AND
      STA BRNAM         BRANCH TABLES 
      LDA LERRX           AND FAKE A JSB
      STA ERROR             TO 'ERROR'
      JMP ERROR+1 
      SPC 2 
FCLOS NOP           ROUTINE TO CLOSE AN OPEN FILE 
      JSB CLOSE 
       DEF *+4
       DEF DCB,I
       DEF FERR 
       DEF .0 
      JMP FCLOS,I 
      SKP 
* 
*************************** 
*                         * 
*  OPEN OR CREATE A FILE  * 
*                         * 
*************************** 
* 
*  FRMTO FLAG = 1 (WRITE)  OR  = 2 (READ) 
* 
* 
FOPEN NOP 
      JSB OPENF     TRY TO OPEN **CHANGED 790822***** 
      DEF *+7         FILE TO SEE IF
      DEF DCB,I         IS ALREADY
      DEF FERR            THERE 
      DEF NAME
      DEF .1
      DEF SC
      DEF LU
* 
      LDA FERR      IS OPEN A SUCCESS?
      SSA           (IS THIS A READ?)  791002***************
      JMP LOAD1     NO! IT'S A POSSIBLE WRITE 791002********
* 
      LDB DCB       RETRIEVE TYPE WORD FOR LATER
***************READDED THESE NEXT THREE LINES 791001********* 
       ADB .2          USE
       LDA 1,I
       STA TYP
**************************REMOVED 790822********************* 
*      SZA                 FILE 
*      JMP LOAD2     NO!
*      ADB .4        YES, NOW 
*      LDA 1,I         CHECK TO 
*      RAL               SEE IF 
*      CPA .3              READ/WRITE BITS ARE OK 
*      JMP FOPEN,I   A READ AND WRITE DEVICE IS A-OK
*      CPA FRMTO     COMPLETE AGREEMENT?
*      JSB ERROR     READ/WRITE DISAGREEMENT
*CERR6 JMP FOPEN,I   OK!
**
***************DELETED 791231*******************************
*     LDA CKLU      TYPE WORD FROM NAMR CALL
*     CPA .1        IS THIS A WRITE TO LU?
************************************************************* 
      SZA,RSS      TYPE 0 FILE CHECK *791231* 
      JMP FOPEN,I   YES 
***************READDED 791002*******************************
      LDA FRMTO     NO,THEN IS THIS A READ? 
       CPA .2 
       JMP FOPEN,I   YES, OK!!! 
       JSB ERROR     DUPLICATE NAME ON WRITE
CERR5 EQU * 
**********************791002***************************** 
*LOAD1 LDA LISTF     IS THIS
*     SZA,RSS         A 'LIST'? 
*     JSB ERROR     NO, NO TYPE 0 FILE FOUND
*CER11 EQU *
* 
********************READDED 791002****************************
LOAD1 LDA FRMTO     IS THIS A 
      CPA .2          READ? 
      JSB CKERR     YES, CAN'T FIND IT
*********************ADDED 791008*****************************
      LDA CKLU      CHECK FOR ERROR ON LU WRITE 
      CPA .1        IS LU WRITE?
      JSB CKERR     ISSUE FMP ERROR 
*************************791008*******************************
**********************************791002************************* 
      JSB CREAT     NO, ITS A FILE WRITE
      DEF *+8 
      DEF DCB,I       SO WE MUST
      DEF FERR
      DEF NAME          TRY TO CREATE 
      DEF .12 
      DEF .4              A TYPE 4 FILE 
      DEF SC
      DEF LU                  OF 12 BLOCKS LONG 
* 
      JSB CKERR     WAS THERE A FILE ERROR? 
      JMP FOPEN,I   NO! 
* 
      SKP 
* 
******************************************* 
*                                         * 
* TABLE SEARCH FOR MULTICHARACTER SYMBOLS * 
*                                         * 
******************************************* 
TBSRH NOP 
      STA SBPTR,I 
      LDA TBSRH,I 
      RSS           PEEL
      LDA 0,I           OFF 
      RAL,CLE,SLA,ERA       INDIRECTS 
      JMP *-2 
      ISZ TBSRH 
      STA TABLE     STORE TABLE ADDRESS 
      STB LNGTH     STORE -(NUMBER OF ENTRIES)
      LDA INBFA     SAVE
      STA TEMP3       INPUT 
      LDA ICCNT           BUFFER
      STA TEMP4           STATUS
      LDA SBPTR     INITIALIZE END-OF-SYMBOL
      STA SMEND       POINTER 
      CLA,INA       COUNT FIRST CHARACTER OF
      STA SLENG       SYMBOL
      LDA SBPTR,I   FETCH PARTIAL SYMBOL
      ALF,ALF       LEFT-JUSTIFY
      IOR .32         FIRST CHARACTER AND 
      STA SBPTR,I       APPEND BLANK
TSRC1 JSB GETCR     FETCH NEXT CHARACTER
      JMP TSRC9     END-OF-STATEMENT
      LDB SLENG     CHECK FOR 
      CPB .8          IMPOSSIBLE LENGTH 
      JMP TSRC9 
      SLB           EVEN-NUMBERED CHARACTER?
      JMP TSRC2     YES 
      ISZ SMEND     NO, FETCH FRESH WORD, 
      ALF,ALF         LEFT-JUSTIFY CHARACTER, 
      IOR .32           APPEND BLANK, 
      JMP TSR10 
TSRC2 ADA M32       DELETE BLANK, 
      ADA SMEND,I     FILL SECOND CHARACTER,
TSR10 STA SMEND,I       AND STORE 
      ISZ SLENG     COUNT IT
      LDB LNGTH     INITIALIZE TABLE LENGTH 
      STB COUNT       COUNTER 
      LDA TABLE 
TSRC3 STA TBLPT     SET TABLE POINTER 
      LDA TBLPT,I   EXTRACT SYMBOL LENGTH 
      AND .7          FROM TABLE AND COMPARE
      CPA SLENG         WITH CURRENT SYMBOL 
      JMP TSRC5     EQUAL?
TSRC4 ADA .3        DIFFERENT,
      ARS             UPDATE
      ADA TBLPT         TABLE POINTER 
      ISZ COUNT     MORE ENTRIES? 
      JMP TSRC3     YES 
      JMP TSRC1     NO
* 
      SKP 
TSRC5 LDB TBLPT     SET POINTER TO
      STB TSPTR       TABLE SYMBOL
      LDB SBPTR     SET (B) TO INPUT
      JMP TSRC7       SYMBOL POINTER
TSRC6 CPB SMEND     ALL OF SYMBOL CONSIDERED? 
      JMP TSRC8     YES, MATCH OCCURRED 
      INB           NO, INCREMENT 
TSRC7 ISZ TSPTR       SYMBOL POINTERS 
      LDA TSPTR,I   FETCH WORD FROM TABLE 
      CPA 1,I       MATCH WITH INPUT SYMBOL?
      JMP TSRC6     YES 
      LDA SLENG     NO, WRONG 
      JMP TSRC4       SYMBOL
TSRC8 LDA TBLPT,I   EXTRACT 
      AND OPMSK       SYMBOL CODE 
      STA SBPTR,I 
      ISZ TBSRH         AND RETURN VIA
      JMP TBSRH,I         'SUCCESS' EXIT
TSRC9 LDA TEMP3     RESTORE 
      STA INBFA       INPUT 
      LDA TEMP4         BUFFER
      STA ICCNT           STATUS
      LDA SBPTR,I   GET ORIGINAL CHAR 
      ALF,ALF        POSITION IT
      AND MSK0        ISOLATE IT
      JMP TBSRH,I   'FAILURE' EXIT
      SKP 
* 
******************************************************
* 
*      FIND REQUESTED PROGRAM CORE LIMITS 
* 
*      CALL SEQ:  (A)=NEXT CHAR 
*                 JSB PGOLM 
*      RETURN:    P+1: EOF DETECTED 
*                 P+2: MORE INPUT TO COME 
*                 (A)=NEXT CHAR 
*                 LOLIM=LOW CORE LIMIT
*                 HILIM=HI CORE LIMIT 
* 
***************************************************** 
* 
PGOLM NOP 
      JSB LIMCK      FETCH PROGRAM LIMITS 
      STA TEMP5      SAVE NEXT CHAR 
      LDA LOLIM 
      JSB FNDPS      FIND POSITION
       NOP            OF 1ST STATEMENT
       NOP
      STB LOLIM       SAVE IT 
      LDA HILIM 
      INA 
      JSB FNDPS      FIND POSITION
       NOP            OF LAST STATEMENT 
       NOP
      STB HILIM       SAVE IT 
      LDA TEMP5      RETRIEVE NEXT CHAR 
      CPA .10        EOF ?? 
      JMP PGOLM,I    YES, TAKE P+1 RETURN 
      ISZ PGOLM 
      JMP PGOLM,I    NO, TAKE P+2 EXIT
* 
* 
      SKP 
********************************************************
* 
*      FETCH PROGRAM LIMITS FROM INPUT BUFFER 
*      ACCORDING TO THE FOLLOWING SYNTAX: 
*          ...<NULL>... 
*          ...<LIM1>... 
*          ...<LIM1><DELIMITER><LIM2>...
*      CALL SEQ:  (A)=NEXT CHAR 
*                 JSB LIMCK 
*      RETURN:    (A)=NEXT CHAR 
*                    LOLIM = LO LIMIT ; HILIM = HIGH LIMIT
* 
********************************************************
* 
LIMCK NOP 
      CLB,INB        SET UP 
      STB LOLIM       DEFAULT LIMITS
      LDB .9999       1-9999
      STB HILIM 
      LDB M2
      STB TEMP4 
      JMP LIM1       CHANGED 800418** 
LIM3  JSB GETCR      FETCH NEXT CHAR
      JMP OUTLM      CHANGED 800418** 
LIM1  JSB DELM       DELIMITER ?
      JMP LIM3        YES, IGNORE 
      CPA .43       PLUS? 
      JMP LIM3      YES!
      CPA .45       MINUS?
      JMP CERR2-1   YES, VERY BAD 
      JSB DIGCK      DIGIT ?
      JMP NODIG      GO CHECK FOR DELETE *800327* 
      ADA .48        YES, 
      JSB INTIN      FETCH #
       DEF MAXSN       &
      SZB,RSS       ZERO? 
      JMP CERR2-1   YES, BAD
      STB HILIM      SAVE IT
      ISZ TEMP4       DONE ?
      RSS 
      JMP LIM2
      STB LOLIM      NO, CONTINUE 
      JMP LIM1
LIM2  INB            INSURE 
      CMB,INB         LOLIM<=HILIM
      ADB LOLIM 
      SSB,RSS 
      JSB ERROR     INVALID LIMITS
CERR2 LDB .32        OK, SET UP FOR 
      STB BLANK       FREE FORMAT INPUT 
**CHANGED 800418***** 
      CPA .10       CHECK FOR EOL CONDITION 
      JMP LIMCK,I   IF SO, JUST RETURN WITH A=EOL 
      JSB GETCR     ELSE, GET NEXT CHAR.
OUTLM LDA .10       INDICATE EOL CONDITION
      JMP LIMCK,I   JUST RETURN.
* 
*************************ADDED 800327********************************** 
NODIG STB SPTP2       SAVE B IN CASE
      LDB DLFLG 
      SZB             IF ZERO NOT FROM DELETE 
      JMP NODG2       MUST ISSUE ERROR OTHERWISE
NODG1 LDB SPTP2 
      JMP LIMCK,I     RETURN AS IN OLD WAY
NODG2 LDB TEMP4       CHECK FOR ONE LIMIT ONLY
      SZB,RSS         ONE?
      JMP CERR2-1     NO, ERROR 
      CPA .10         WAS CHAR AN EOF?
      JMP NODG1       YES, RETURN LIKE NORMAL 
      JMP CERR2-1     NO,ERROR
********************************800327********************************* 
      SKP 
***************************ADDED 791009************************** 
* 
* 
*  COMMA CHECKING ROUTINE 
* 
* 
***************************************************************** 
* 
* 
*  THIS ROUTINE CHECKS FOR A COMMA IN THE COMMAND BEFORE PARSING
*  WITH NAMR.  THE CALLING SEQUENCE IS: 
* 
* 
*       JSB CKCOM 
*       P+1        EOL WAS SENSED 
*       P+2        CONTINUE EXECUTION 
* 
*  IF A COMMA WAS FOUND, AND THE NEXT CHARACTER WAS NOT AN EOL, 
*  THEN  A=NEXT CHARACTER.
* 
*  IF NO COMMA WAS FOUND, A=CURRENT CHARACTER.
* 
* 
***************************************************************** 
* 
CKCOM NOP 
      CPA B54       IS THIS A COMMA 
      JMP GOGET     YES, GET NEXT CHAR. 
XHERE ISZ CKCOM     CONTINUE EXECUTION
      JMP CKCOM,I   RETURN
GOGET JSB GETCR     GET NEXT CHAR.
      JMP CKCOM,I   EOL RETURN
      JMP XHERE     GOT CHAR. 
*****************************791009*******************************
      SKP 
* 
****************************************************
* 
*     DELM WILL TEST FOR A DELIMITER
* 
****************************************************
* 
DELM  NOP 
      CPA .32       BLANK?
      JMP DELM,I    YES, P+1 RETURN 
      CPA B54       COMMA?
      JMP DELM,I    YES 
      ISZ DELM      NEITHER TAKE
      JMP DELM,I      P+2 RETURN
* 
* 
* 
* 
***************************************************** 
* 
*      INTIN WILL BUILD AN INTEGER FROM INPUT 
* 
*      CALL SEQ: (A)=CURRENT CHAR 
*                JSB INTIN
*                DEF (MAX #)
*     RETURN:    (B)=INTEGER
* 
***************************************************** 
* 
INTIN NOP 
      STA TEMP5      SAVE CUR. CHAR.
      LDA INTIN,I 
      RSS           PEEL
      LDA 0,I           OFF 
      RAL,CLE,SLA,ERA       INDIRECTS 
      JMP *-2 
      STA INTI1        ALLOWABLE
      ISZ INTIN         LIMIT 
      LDA SBPTR      SAVE 
      STA TEMP1       SBPTR 
      LDA TEMAD        STATUS 
      STA SBPTR 
      LDA TEMP5      RECOVER CUR.CHAR.
      JSB INTCK      FETCH INTEGER
INTI1  BSS 1
      CLB             ***791227***
      STA TEMP5 
      LDA TEMP1      RESTORE
      STA SBPTR       SBPTR STATUS
      LDA TEMP5 
      JMP INTIN,I 
* 
      SKP 
****************************************************
* 
*      SET FROM / TO FLAG 
* 
* 
***************************************************** 
* 
***************************READDED 791002************************ 
ONS   NOP 
       CLB,INB       SET FROM-TO FLAG TO ONE
       STB FRMTO     FRMTO FLAG=1 FOR "ON"
       JMP ONS,I
**
FROMS NOP 
       LDB .2        FRMTO FLAG=2 FOR "FROM"
       STB FRMTO
       JMP FROMS,I
* 
***************************791002********************************** 
****************************************************
* 
*      SCRATCH SUBROUTINE 
* 
*      CALL SEQ:  JSB SCR 
*      RETURN:    P+1: NORMAL 
* 
*************************************************** 
* 
SCR   NOP 
      LDA FWAM
      STA PBUFF     SET PROGRAM BUFFER ADDRESS
      STA PBPTR     SET PROGRAM BUFFER POINTER
      LDA .32       INITIALIZE
      STA BLANK       DELETE CHARACTER FOR GETCR
      CLA           SET LINE NUMBER 
      STA .LNUM       TO 0 INITIALLY
      JMP SCR,I 
      SKP 
* 
*     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 
****************************CHANGED 790822************************* 
* THE ROUTINE 'NAMR' IS USED TO PARSE THE FILENAME OR LU SPECIFIED
* IN THE COMMANDS.  THIS WAY THE FMP ROUTINES OF 'OPENF', 'READF',
* 'WRITF' CAN BE USED TO FURTHER THE INDEPENDENCE OF BASIC FROM 
* THE SYSTEM. 
* 
      ISZ NAMD0     INCREMENT FOR RETURN
      CLB           CLEAR CHAR. COUNT AND RESET THE STARTING
      STB LENTH     CHAR. POINTER FOR NAMR
      STB FEOL      CLEAR DONE FLAG *791009*
      LDB .1
      STB ISTRC 
      LDB M3        SET UP WORD COUNTER **791008
      STB DUM3      ****791008
      LDB DEST      SET UP SOURCE BUFFER
TOP   JSB .SBT      TO BE PARSED BY NAMR
      ISZ LENTH     INCREMENT CHAR. COUNT 
      STB STORE 
      JSB GETCR     GET THE NEXT CHARACTER
      JMP MOST      EOL!! DONE *791009* 
*********************************ADDED 791009*********************
      CPA B54       IF COMMA GO PARSE AND 
      JMP DONE      RETURN
*****************************791009*******************************
      LDB STORE     GO GET MORE 
      JMP TOP 
MOST  LDA .10       SET EOL INDICATOR *791009*
      STA FEOL       *791009* 
* 
DONE  JSB NAMR      PARSE THE NAME
      DEF REPT
      DEF BUFR      RESULTING BUFFER
      DEF NAMBF     SOURCE BUFFER 
      DEF LENTH     # OF CHAR. TO PARSE 
      DEF ISTRC     CHAR. POSITION 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. 
* 
**********************ADDED 791008*********************************** 
REPT  LDA DUM1      GET ADDRESS TO RESULTING
      STA POINT     BUFFER
************************791008**************************************
REPT1 LDA POINT,I   PICK UP RESULTING BUFFER 791008 
      STA NAMA,I    MOVE TO NAME IN COMMON WITH 790927
      ISZ POINT     SECURITY CODE AND CRN#
      ISZ NAMA      BEHIND THE 3-WORD NAME 790927 
******************CHANGED 790928********************************* 
      ISZ DUM3      SINCE WORD 4 IS TYPE WORD ONLY 791008 
      JMP REPT1     MOVE IN 1ST 3 WORDS  791008 
**********************ADDED 791008******************************* 
      LDA POINT,I   PICK UP TYPE WORD FOR FOPEN 
      STA CKLU
************************791008*********************************** 
      ISZ POINT     INCREMENT TO SECURITY CODE
      LDA POINT,I 
      STA NAMA,I
      ISZ POINT     INCREMENT TO CRN# 
      ISZ NAMA
      LDA POINT,I 
      STA NAMA,I
********************************790928***************************** 
      LDA FEOL    *EOL FLAG=10 IF EOL ELSE 0 791009 
      JMP NAMD0,I 
* 
CKLU  NOP           **791008
FEOL  NOP           **791009
NAMA  BSS 1 
BUFR  BSS 10
DUM1  DEF BUFR      *791008 
POINT NOP           *791008 
ISTRC NOP 
LENTH NOP 
STORE NOP 
DUM3  NOP      **791008 
DEST  DBL NAMBF 
NAMBF BSS 14
***************************790822*******************************
**********************REMOVED 790822****************************
*      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
*CER13 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 
*      JSB ERROR     NOT A NUMBER, INVALID LU 
*CERR8 ISZ NAMA        SAVE LU VALUE
*      STB NAMA,I 
*      JMP NAMD0,I   RETURN 
*      SPC 1
*SPACE ASC 1, 
*      SPC 1
**
**     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
**     ISEITHER 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 *
      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
      SPC 2 
      SKP 
*********************** 
*                     * 
* PRINT ERROR MESSAGE * 
*                     * 
*********************** 
ERROR NOP 
      CLA           RESET 
      STA PFLAG       FILE FLAG 
      STA .LNUM         AND DO NOT PRINT LINE # FLAG
      LDB ERROR     ERROR SOURCE IN (B) 
      LDA ERBS      ERROR ADDRESS IN (A)
      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 .103      ACCOUNT FOR LENGTH OF TABLE 
******************USED IN SEG. 2 STREN FOR OFFSET***************
**************IF CHANGED HERE, CHANGE IN SEG. 2 ALSO************
      STA TEMP3     SAVE IT 
      JMP OUTER     PRINT ERROR MESSAGE 
      SKP 
*************** 
*             * 
* ERROR TABLE * 
*             * 
*************** 
ERR   DEF CERR1     NOT A VALID COMMAND 
      DEF CERR2     INVALID LIMITS
      DEF CERR3     INVALID FILE NAME 
      DEF CERR4     NOT ENOUGH ROOM MNEMONIC TABLE
      DEF CERR5     DUPLICATE FILE NAME   **ZEROED  790823* 
      DEF CERR6     READ FROM WRITE DEVICE **ZEROED  790823***
      DEF CERR8     INVALID LU        **ZEROED  790823*** 
      DEF CERR9     ILLEGAL FILE SIZE     **791227**
      DEF CER10     DEL OR SAVE PROG BEFORE USING TABLE COMND 
      DEF CER11     NO TYPE 0 FILE FOUND **ZEROED  790823** 
      DEF CER12     INCOMPATIBLE 'CSAVE' PROGRAM
      DEF CER13     INVALID SECURITY CODE  **ZEROED  790823***
      DEF CER14     INVALID STATEMENT NUMBER
      DEF CER15     INCORRECT TABLE ORDER 
      DEF CER16     ILLEGAL FILE TYPE 
      DEF CER17     REQD ID SEG NOT FOUND OR NONE AVAIL 
      DEF CER18     DUPLICATE PROGRAM NAME  **CHANGED 790905***** 
      DEF CER19     FILE NOT SET UP ON CURRENT SYSTEM 
      DEF CER20     ERROR RETURN FROM SCHEDULE REQUEST
* 
****************************ADDED 790823*************************** 
CERR6 NOP 
CERR8 NOP 
CER11 NOP 
CER13 NOP 
CERR3 NOP          ADDED 790905 
******************************************************************* 
TEMP  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
COUNT EQU TEMPT+1 
JREC  EQU TEMPT+2 
FRMTO EQU TEMPT+3 
TABLE EQU TEMPT+4 
SMEND EQU TEMPT+5 
SLENG EQU TEMPT+6 
TBLPT EQU TEMPT+7 
TSPTR EQU TEMPT+8 
LNGTH EQU TEMPT+9 
FERR  EQU TEMPT+10
TYP   EQU TEMPT+11
NAME  EQU TEMPT+12  ARRAY OF 5 WORDS
SC    EQU TEMPT+15
LU    EQU TEMPT+16
NNAME EQU TEMPT+17  ARRAY OF 5 WORDS *791008
* 
      END BASC5