ASMB,R,Q,C
      HED <<RTE BASIC - COMMANDS-SEG/#5>>     92101-16007 REV.2040
      NAM BASC5,5 92101-16007 REV.2040 800803 
* 
* 
* 
* 
**************************************************************
* (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1975.  ALL RIGHTS    *
* RESERVED.  NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, RE- *
* PRODUCED, OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITH-  *
* OUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY.  *
**************************************************************
* 
* 
* 
*      NAME:      BASC5 
*      SOURCE:    PART OF 92101-18007 
*      RELOC:     PART OF 92101-16007 
*      PGMR:      B.J.L.
* 
* 
* 
************************************************************* 
* 
* 
      ENT BASC5 
      EXT IDRPL,IDRPD,SGMNT,TRAP,PRMT,INTCK,FNDPS,EXEC,LURQ 
      EXT LOGLU,FCONT,OPEN,CLOSE,CREAT,PURGE,NAMF,READF 
      EXT RUN,PLIST,LOADT,DIGCK,WRITF 
      EXT FINDV,WRITE,OUTER,GETCR 
      EXT GMS.C,ROTAT 
      COM TEMPS(32),PNTRS(75),FILBF(16),FLDCB(144),SPEC(10) 
* 
* INCREASED PNTRS TO 75 *2040*800803**
* 
*INCREASED TEMPS SIZE TO 32 *800131*BL* 
* 
***************************************** 
*                                       * 
*    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
TTYPR EQU PNTRS+34  CONSOLE TTY L.U. #
PRINT EQU PNTRS+35  LISTING L.U. #
READR EQU PNTRS+36  AUXILLIARY INPUT L.U. # 
PUNCH EQU PNTRS+37  AUXILLIARY OUTPUT L.U. #
ERTTY EQU PNTRS+38  ERROR LIST OUTPUT L.U. #
DCB   EQU PNTRS+39  DATA CONTROL BLOCK ADDRESS
FILBK EQU PNTRS+40  FILE CONTROL BLOCK ADDRESS
PFLAG EQU PNTRS+41  SAVE,LOAD FILE FLAG 
LOLIM EQU PNTRS+42  LOW LIMITS OF PROGRAM 
HILIM EQU PNTRS+43  HIGH LIMITS OF PROGRAM
LORUN EQU PNTRS+44  LOW RUN LIMITS
HIRUN EQU PNTRS+45  HIGH RUN LIMITS 
SLSTM EQU PNTRS+46  EXECUTE SLOW STMTS
LOTRC EQU PNTRS+47  LOW TRACE LIMITS
HITRC EQU PNTRS+48  HIGH TRACE LIMITS 
BRKP1 EQU PNTRS+49  BREAK POINT #1
BRKP2 EQU PNTRS+50  BREAK POINT #2
BRKP3 EQU PNTRS+51  BREAK POINT #3
BRKP4 EQU PNTRS+52  BREAK POINT #4
SMFLG EQU PNTRS+53  SIMULATE FLAG 
TYPE  EQU PNTRS+54  PARTIAL LINE CHARACTER COUNT
DLMTR EQU PNTRS+55  CHAR EDIT DELIMITER 
MERGF EQU PNTRS+56  MERGE FLAG
COMN  EQU PNTRS+57  COMMAND FILE NAME 
MANT1 EQU PNTRS+60  MANTISSA #1 
MANT2 EQU PNTRS+61  MANTISSA #2 
EXPNT EQU PNTRS+62  EXPONENT
INLOC EQU PNTRS+63  INV. LOC. LU,STRK,#TKRS BR. 
INTKZ EQU PNTRS+64  TRACK SIZE ON DISC FOR INV. BR. 
HSTPT EQU PNTRS+65  HIGH-STACK POINTER         BR.
TSTPT EQU PNTRS+66  TEMPORARY STACK POINTER    BR.
LSTPT EQU PNTRS+67  LOW-STACK POINTER          BR.
LSTAK EQU PNTRS+68  LOW-STACK ADDRESS          BR.
PRADD EQU PNTRS+69  PROGRAM EXECUTION          BR.
DSTRT EQU PNTRS+70  DATA                       BR.
NXTDT EQU PNTRS+71    STATEMENT                BR.
DCCNT EQU PNTRS+72      POINTERS               BR.
NXTST EQU PNTRS+73      NEXT STMT NUMBER 
TRAPF EQU PNTRS+74  TRAP BUSY FLAG *2040*800803*
      SKP 
TEMPT BSS 22        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
.100  DEC 100      *2013*BL*CHANGED 
.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
M16   DEC -16 
M20   DEC -20 
M32   DEC -32 
M128  DEC -128
MAXSN DEC -10000
LOCK  OCT 100001
UNLKA OCT 100000
MAXCT OCT 177777
MSK0  OCT 377 
OPMSK OCT 77000 
HIMSK OCT 177400
TBFLG NOP            *2013*BL*
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 
      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***** 
BAS5C 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
*2013*BL*ADD* 
      CLA          ZERO TABLE FLAG
      STA TBFLG 
*2013*BL* 
* 
      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'?
      JSB PGOLM    NO, FETCH LINE #'S 
      NOP           EOF DETECTED? 
      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
*ADDED*2040*800803* 
      CLA 
      STA OCCNT 
*2040*800803* 
      JMP PRMT      RETURN
* 
DEL2  CCB           SEARCH FOR
      JSB TBSRH       'ETE' 
      DEF ETE 
      JMP CERR1-1   NOT FOUND 
      JMP $DEL      OK! 
* 
ETE   OCT 3 
      ASC 2,ETE 
* 
      SPC 3 
*      HERE FOR:   PURGE < FILE NAME : SC : LU >
* 
$PURG JSB GETCR     GET FIRST CHARACTER 
      JMP PRMT      EOF DETECTED! 
      CPA B54       DELIMITER?
      JMP $PURG     YES, GET NEXT CHAR
      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>] FROM <FILE NAME> 
* 
$RUN  JSB GETCR      FETCH NEXT CHAR
      JMP RUN       EOF!
      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 FROMS     CHECK "FROM" SYNTAX 
      JSB NAMD0     GET NAME:SC:LU
      DEF NAME
      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 
* 
*      HERE FOR:  SAVE,CHANGE OR LIST [<LIMITS>] ON <FILE NAME> 
* 
$RPLC CCA           SET PURGE 
      STA TEMP6       FLAG
      STA PFLAG         AND PUNCH 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 DEFAULT TO
      STA PFLAG       PUNCH DEVICE
      CLA           RESET 
SAVE1 STA TEMP6       PURGE FLAG
      LDA PBUFF     INITIALIZE
      STA LOLIM       LIMITS
      LDA PBPTR         TO INCLUDE
      STA HILIM           ALL OF PROGRAM
      JSB GETCR      FETCH NEXT NON-BLANK CHAR
      JMP PLIST     EOF!
      JSB PGOLM      GET PROGRAM LIMITS 
       JMP PLIST      EOF DETECTED, ASSUME DEFAULT
      JSB ONS        MORE, CHECK "ON" SYNTAX
      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 
* 
      SKP 
* 
*     HERE FOR:   >/     LIST NEXT LINE 
* 
PNEXT JSB GETCR     GET FIRST CHAR
      JMP PNEX2     EOF, NO STMT #
      JSB DIGCK     NUMBER? 
*2040*BL*800321*
      JMP SLERR     MAKE SURE NO FURTHER EDITS
*2040*BL
      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? 
PNEX1 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 
*2040*BL*800321 
SLERR LDB ASCER 
      STB .OTBF,I 
      JMP CERR1-1 
* 
ASCER ASC 1,ER
*2040*BL* 
* 
      SPC 3 
*      HERE FOR:  BYE 
* 
* NOTE: IF ANY CHANGES HERE, CHANGE SEG 8 ALSO STARTING AT BYE1.
* 
* 
$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 
*2013*BL*ADD* 
      STA HOLD1 
      LDA B         PICK UP SECOND WORD FOR MASKING 
      ADA .48 
      ALF,ALF 
      IOR B40 
      STA B 
      LDA HOLD1 
*2013*BL* 
      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,%BXXXX
TCODE OCT 100012    TERMINATE W/0 ERROR 
AB    ASC 1,AB
B     EQU 1         *2013*ADD*BL* 
HOLD1 NOP           *2013*ADD*BL
      SKP 
* 
*     HERE FOR :   CSAVE ON <FILE NAME> 
* 
$CSAV JSB GETCR     GET FIRST CHAR
      JMP CERR1-1   ILLEGAL EOF 
      JSB ONS       CHECK 'ON' SYNTAX 
      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>] FROM <FILE NAME> 
* 
$MERG CCA           SET FLAG SO 'ACTST' DOESN'T OVERLAY STMTS 
      STA MERGF       IN SYNTAX SEGMENT 
* 
$LOAD CCA 
      STA PFLAG     SET FOR DEFAULT INPUT 
      JSB GETCR      GET NEXT CHAR
      JMP LTAPE     LOAD FROM DEFAULT DEVICE
      JSB LIMCK      FETCH PROG LIMITS
      CPA .10        EOF ?
      JMP LTAPE       YES, USE DEFAULT DEVICE 
      JSB FROMS      CHECK "FROM"SYNTAX 
      JSB NAMD0     GET NAME:SC:CR
      DEF NAME
      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 
      CPA .10         A 'CSAVED' PROGRAM? 
      JMP SAVEC         YES      *2001*BL***R: RSS
* 
*2001*BL***ADD
* 
      CPA .3        IS IT TYPE 3? 
      JMP LODIT       YES 
      CPA .4        IS IT TYPE 4? 
      JMP LODIT       YES 
      JMP CER1        NO, ERROR 
* 
*2001*BL* 
* 
LODIT JMP LOADT     NO, LD & CHK SYNTAX  *2001*BL***R: JMP LOADT
SAVEC JSB GTCSA     LOAD CSAVED FILE     *2001*BL***R: JSB GTCSA
      JMP PRMT      GO TO 'READY' 
* 
LTAPE LDA MERGF     IS THIS 
      SZA,RSS         A 'MERGE'?
      JSB SCR       NO, DELETE PROG IN MEMORY 
      JMP LOADT 
* 
* 
*  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 ERROR     NO, IN COMPATIBLE 'CSAVE' 
CER12 EQU * 
      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 CER12-1   NO, INCOMPATIBLE CSAVE! 
      CPB LWBM      IS END BOUNDARY THE SAME? 
      RSS           OK, RETURN
      JMP CER12-1   NO, INCOMPATIBLE 'CSAVE'
      LDA MNNAM     ANY 
      SZA             TABLES? 
      JSB LOADM     YES, MAKE SURE B&M TABLES ARE STUFFED IN
      JMP GTCSA,I 
      SKP 
* 
*     HERE FOR:   100 CHAIN <FILE NAME> [,STMT #] 
* 
$CHAN LDB FCORE     SET UP POINTER
      ADB M20         TO OUTPUT ANY 
      STB TEMP4         PARTIAL LINES 
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
      JSB FINDV       AND DISCOVER THE EQUIPMENT TYPE 
      STA 1 
      ADA M16       IS THIS DEVICE TYPE 
      SSA,RSS           < 20(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 
      STA FRMTO       FLAG FOR READ 
      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  *2001*BL***R: JSB ERROR
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)
* 
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 CERR3-1   YES!
      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!
CER18 EQU * 
      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