*DECK,INPUT 
          IDENT     BASIGEN 
*CALL COPYRITE
          TITLE  BASIGEN
          IPARAMS 
          COMMENT BASIC 3 - INPUT ROUTINES. 
          ENTRY     BASISRT,BATISRT 
          ENTRY     BASIEND,BATIEND 
          ENTRY     BASIREW,BATIREW 
          ENTRY     BATOSRT 
          ENTRY     BATOWRT 
          ENTRY     BATOPRT 
          ENTRY     BATOCON 
          ENTRY     BATEGEN 
          EXT       BASEGEN 
          EXT       BASOTAB 
          EXT       BASOMOV 
          EXT       BASOCLS 
         EXT       BASISCN
          EXT    BASLDMT
          EXT    RNBLOCK,RNLIST,DBUGON
* 
           EXT  COMRUNS 
* 
* 
* AT RUN TIME,
* CALLS MADE TO BASICHK BY SFREAD0 ENSURE ALL 
* DATA OF A LONG STRING ITEM IS PUMPED INTO THE CIO 
* BUFFER IN SUCCESSIVE CHUNKS FOR CONCURRENT
* UNPACKING INTO INPUT CHARACTER BUFFER AND DELIVERY
* TO THE TARGET INPUT ITEM (VARIABLE).
* 
* AT THE TIME SFREAD0 CALLS BASICHK, THE *OUT* POINTER
* IN THE FET HAS NOT BEEN UPDATED TO REFLECT THE
* WORDS OF CIO DATA THAT WAS PREVIOUSLY MOVED 
* TO THE UNPACK BUFFER AND HAS NOW BEEN PROCESSED.
* THEREFORE, IN ORDER TO
* ENSURE THAT BASICHK WILL PUMP MORE NEW DATA INTO
* THE CIO BUFFER WHEN NEEDED, WE SET THE "MINIMUM SPACE"
* FACTOR AT 2*(THE NUMBER OF WORDS THAT CAN BE HELD 
* IN THE UNPACK BUFFER)+1. I.E. BASICHK SEES BEYOND THE 
* WORDS THAT HAVE ALREADY BEEN UNPACKED AND REFRESHES 
* THE CIO BUFFER IF THERE IS LESS THAN A UNPACK BUFFERFUL 
* OF NEW DATA AVAILABLE IN CIO. 
* 
* THE +1 IN THE FORMULA ABOVE IS REQUIRED 
* BECAUSE THE UNPACK ROUTINE LOOKS AT THE 
* NEXT WORD IN THE CIO BUFFER BEYOND THE
* THE WORDS THAT WERE USED TO FILL THE UNPACK 
* BUFFER.  IT DOES THIS TO SEE IF THE UPCOMING
* WORD IS A FULL ZERO BYTE DELIMITER WORD, IN 
* WHICH CASE IT SETS AN -EOL- CHARACTER AT THE
* END OF THE UNPACK BUFFER INSTEAD OF AN -EOB-
* CHARACTER AS WOULD BE FOR INPUT ITEM NOT
* YET COMPLETED.
* PUMPING IN OF MORE DATA FOR AN ITEM CEASES AUTOMATICALLY
* WHEN THE ZBD OF THE ITEM IS DETECTED DURING UNPACKING.
* 
 UNPKLEN  EQU    20              LEN IN CHARS OF THE INPUT UNPACKING BUF
 ICHKMIN  EQU    UNPKLEN*2/10+1   MIN NO OF WDS OF DATA REQD IN R/T CIO 
* 
          EXT    ER141
          EXT    RNDMRD 
          EXT    RNDMWR 
         EXT       STRINP 
          EXT    DLMTNO            NO OF NON-STANDARD DELIMITERS
          EXT    DLMTSW            SET TO 0/1 BY BASISRT ACCORDING AS 
*                                  STANDARD/NONSTANDARD DELIMS ARE USED 
          EXT    DLTKND            SET NON-ZERO IF AT LEAST ONE DELIM 
*                                  IS AN -ESCAPE- CODE COMBO
          EXT    BASCIO=
 CIO=     EQU    BASCIO=
* 
 SUNUSED  MACRO 
          SA1    B5+FETSTAT 
          SA2    B5+FETFRST 
          PX6    B0,X1
          SX7    X2 
          SA6    A1                     SET CHANNEL UNUSED
          MX6    0
          SA7    B5+FETIN 
          SA7    B5+FETOUT              RESET FET 
          SA6    B5+FETCHAR 
         SA1       B5+FETFILE           CLEAR STATUS
         MX6       17 
         LX6       18 
         BX6       -X6*X1 
         SA6       A1 
          ENDM
* 
FLUSH     MACRO                    FLUSH BUFFER IF FILE INTERACTIVE 
          LOCAL  FLUSH1 
          SA1    B5+FETSTAT 
          SB6    WRITFUN           WRITE CODED
          PX6    B6,X1
          LX1    59-18             INTERACTIVE BIT
          PL     X1,FLUSH1         BYPASS IF NOT INTERACTIVE
          SA6    B5+FETSTAT        SET WRITE CODED FUNCTION 
          SX4    -1 
          RJ     BASOTAB           NEW LINE 
          RJ     BASOCLS           FLUSH FILE 
          SX6    B0 
          SA6    NEWPFLG           CLEAR NEW PAGE FLAG
FLUSH1    BSS    0
          ENDM
* 
* 
IWRT      MACRO                    WRITE OUT I BUFFER 
          MX4    59 
          RJ     BASOTAB           NEW LINE 
          SA1    B5+FETSTAT 
          SB6    WRITFUN           WRITE CODED
          PX6    B6,X1
          SA6    A1          SET WRITE CODED FUNCTION 
          RJ     BASOCLS
          ENDM
* 
* 
*CALL,LCORE 
*CALL,ERMNUM
* 
 ERM132   DATA   C* TOO MUCH DATA, RETYPE INPUT * 
          TITLE  BASISRT
* 
*         PROCEDURE INPUT-START 
* 
          DATA      10HBASISRT
*         ENTER  B5=FET ADDRESS 
* 
*         EXIT-  B5 = FET ADDRESS 
* 
*         USES-  ALL AVAILABLE REGISTERS
* 
*         CALLS- BASOMOV
 BASISRT  SPACE  4
  
 BASISRT  PS     0
          NZ   B5,SRT1             JUMP IF FILE ORD WAS NOT ZERO
          SB5    B4+FETCHAN+2      ORD ZERO = JFILE 
 SRT1     BSS    0
         SX6       B0 
         SA6       STRINP     CLEAR STRING INPUT FLAG 
* 
* 
          SA1    FETFNUM+B5        LOAD DELIMITER DESCRIPTOR
          BX6    X1 
          LX6    6                 EXTRACT DELIMITER COUNT AND FLAGS
          MX2    54 
          BX6    -X2*X6 
          ZR     X6,STDLMT         SKIP IF STANDARD DELIMITERS IN USE 
          SA6    DLMTSW            SET FLAG 0/1 
          AX6    3                 ISOLATE DELIM TYPE (NONZERO FLAGS
*                                  DELIMS INVOLVING -ESC- CODES)
          SA6    DLTKND            SET -DELIMITER- TYPE 
          MX3    57 
          BX2    X1 
          LX2    6
          BX7    -X3*X2            PICK OFF DELIMITER COUNT 
          LX6    X7 
          SA6    DLMTNO            SAVE COUNT 
          SB6    12 
          MX3    48 
* 
 NXTDLMT  BSS    0
          LX2    X2,B6             SHIFT ROUND NEXT(1ST) DELIMITER
          BX6    -X3*X2            MASK IT INTO X6
          SA6    A6+1              STORE IT 
          SX7    X7-1              CHECK ON DELIMITER COUNT 
          NZ     X7,NXTDLMT        LOOP WHILE NON-ZERO
          SX6    1                 SET UP NON-STANDARD-DELIMITER FLAG 
* 
 STDLMT   BSS    0
          SA6    DLMTSW            SET DELIMITER FLAG 
          MX6    60 
          SA6    BASLDMT
* 
* 
          SA1    FETSTAT+B5 
          LX1    59-18       INTERACTIVE BIT
          PL     X1,BASISRT  IF NOT INTERACTIVE 
IF0       IFC    EQ,,"OS.NAME",SCOPE ,
* 
* 
          SA5    START01           PICK UP PROMPT CHARACTER 
          SX6    B5 
          SA6    BSTA              SAVE FET POINTER 
          SA1    KOPTION           MOVE PROMPT TO K FILE IF IT
          SB5    X1                   IS INTERACTIVE. 
          SA1    B5+FETSTAT        ELSE MOVE IT TO I FILE 
          LX1    59-18             INTERACTIVE BIT
          NG     X1,BISRT1         BYPASS IF K FILE INTERACTIVE 
          SA1    BSTA 
          SB5    X1                RESTORE FILE POINTER 
          SUNUSED                  CLEAR I BUFFER 
BISRT1    BSS    0
BISRT2    BSS    0
         RJ        BASOMOV              OUTPUT PROMPT 
          IWRT                     WRITE OUT PROMPT TO FILE 
          SA1    BSTA 
          SB5    X1                RESTORE FILE POINTER 
          SUNUSED                  INITIATE I CHANNEL 
          EQ     BASISRT           EXIT 
* 
          ENTRY  START01
* 
START01   DATA   55710000000000000000B  SCOPE INPUT PROMPT
IF0       ELSE
          SA1    FETFRST+B5 
          SX6    X1 
          SA6    FETIN+B5    SET IN = FIRST 
          SA6    FETOUT+B5   SET OUT = FIRST
          MX6    0
          SA6    FETCHAR+B5  CLEAR CHARACTERS PROCESSED 
          SA1    FETFILE+B5 
          MX2    42 
          MX3    59 
          BX6    X2*X1
          BX6    -X3+X6      CLEAR EOR STATUS 
          SA6    A1 
  
*         IN INTERACTIVE MODE, COMPLETE THE *OUTPUT* LINE WITH A
*         -STOP- BYTE (0001) BEFORE REQUESTING *INPUT*. 
  
          SA1    KOPTION
          SA2    X1+FETSTAT 
          LX2    59-18             K-FILE INTERACTIVE BIT 
          PL   X2,BASISRT          EXIT IF NOT INTERACTIVE
          SA2    X1+FETCHAR 
          ZR     X2,BASISRT  IF NO LINE IN BUFFER 
          SX6    B5 
          SB5    X1          SET *OUTPUT* FET POINTER 
          SA6    BSTA        SAVE ENTRY FET POINTER 
*  STOP BYTE MUST GO ON A 12-BIT BOUNDARY 
*  CHECK PHYSICAL DATA IN BUFFER, PAD IF REQUIRED 
          SA1    B5+FETIN          *IN* POINTS TO LAST WD (NOT LWA+1) 
          SA1    X1                X1 = DATA WORD 
          SX2    77B
          SB6    10                B6 = COUNT OF CHARACTERS LEFT
 BST2     BX3    X2*X1             WORK BACKWARD THROUGH WORD 
          NZ   X3,BST3             EXIT IF NONZERO CHAR 
          SB6    B6-1 
          AX1    6
          NZ   B6,BST2             LOOP IF MORE IN WORD 
 BST3     SX1    B6                X1 = COUNT OF 6-BIT CHARS IN WORD
          LX1    59                SEE IF ODD OR EVEN 
          SA5    BSTB        X5 = STOP BYTE 
          MX6    0           RESET ALL OF THE COLON PROCESSING FLAGS
          SA6    =XPRVBLCL
          SA6    =XCOLNBLK
          PL     X1,BST1     SKIP IF EVEN NUMBER OF CHARACTERS
          AX5    6           ELSE ADD 6 BITS OF ZERO IN FRONT OF STP BYT
 BST1     RJ     =XBASOMOV   ENTER THE STOP BYTE
          MX4    59                END THE LINE 
          RJ   =XBASOTAB
          SA1    BSTA 
          SB5    X1          RESTORE FET POINTER
          EQ     BASISRT
  
IF0       ENDIF 
 BSTA     DATA   0           HOLDS FET POINTER
 BSTB     DATA   00010000000000000000B   STOP BYTE
*         END INPUT-START 
* 
          TITLE  BASIEND
* 
*         PROCEDURE INPUT-END 
* 
          DATA      10HBASIEND
*         ENTER  B5=FET ADDRESS 
* 
*         EXIT   B5 = FET ADDRESS 
* 
*         USES   ALL AVAILABLE REGISTERS
* 
*         CALLS  BASICHK
 BASIEND  SPACE  4
  
 BASIEND  PS     0
          SA3    FETSTAT+B5 
          LX3    59-18
          PL     X3,BASIEND  IF BATCH MODE EXIT 
          MX6    59 
          RJ     =XBASISCN
          NZ     B6,BASIEND  IF EOR 
* 
* CHECK TO SEE IF THERE ARE ANY NON-BLANK CHARACTERS
* REMAINING ON INPUT LINE 
* 
 MORE     SA1    B7                GET NEXT CHAR
          SB7    B7+1 
          SX2    101B              X2 = END-OF-LINE 
          IX3    X1-X2
          ZR     X3,BASIEND        BR, ALL DONE 
          SX2    1R                X2 = BLANK 
          IX3    X1-X2
          ZR     X3,MORE           LOOP UNTIL NON-BLANK OR EOL
* 
* TOO MUCH DATA, RETYPE INPUT 
* 
          IFC    EQ,,"OS.NAME",SCOPE ,
* 
          EXT    IMESFLG           INTERACTIVE INPUT ERROR FLAG 
* 
          SX7    1
          SA7    IMESFLG           SET INTERACTIVE INPUT ERROR FLAG 
          SUNUSED                  CLEAR FILE BUFFER
          ENDIF 
          SB7    ERM132 
          SX7    ERMN132
 ER132A   RJ     BASEGEN
          IFC    EQ,,"OS.NAME",SCOPE ,
          SX7    B0 
          SA7    IMESFLG           CLEAR INTERACTIVE INPUT ERR FLAG 
          IWRT                     WRITE OUT I BUFFER 
          SUNUSED                  INITIATE I FILE
          ENDIF 
          EQ     =XBASISRT+1     RESTART INPUT
* 
*         END INPUT-END 
* 
          TITLE  BASIREW
* 
*         PROCEDURE REWIND
* 
          DATA      10HBASIREW
 BASIREW  SPACE  4
*         ENTER  B5=FET ADDRESS 
* 
*         EXIT   FILE REWOUND AND SET NEUTRAL 
* 
*         USES   A1,X1,A6,X6,B6,B7,X4 
* 
*         CALLS  BASOTAB,BASOCLS,CIO= 
  
 BASIREW  PS     0
          ZR   B5,BASIREW          IGNORE IF FILE ORD WAS ZERO
          SA1    B5 
          ZR     X1,ER141    *FILE CLOSED/UNDEFINED*
  
  
          SA1    FETSTAT+B5 
          SB7    WRITFUN
          UX6    X1,B6
          MX4    59          X4=-1
          ZR     B6,BFR2
  
          SA2    FETSETV+B5 
          LX2    1           TEST SET-OCCURED FLAG
          NG     X2,REWRNDM  SKIP IF SO (ITS A RANDOM FILE) 
          LX1    9
          PL     X1,BFR2     NOT WRITE
          LX2    1
          NG     X2,APNDBUF  SKIP IF BUFFER REMAINS TO BE APPENDED
  
          LX1    1
          NG     X1,BFR1                NOT CODED 
  
          SA1    B5+FETCHAR  CHECK CURRENT LINE POSITION
          ZR     X1,BFR1      SKIP IF ALREADY COMPLETE
          RJ     BASOTAB     END LINE 
 BFR1     RJ     BASOCLS     DUMP BUFFER
 BFR2     BX6    X6-X6
          SA6    FETCHAR+B5  CLEAR WORD,CHARACTER COUNTERS
          MX0    30 
          SA1    FETLOFC+B5 
          SA3    FETSTAT+B5 
          UX3    B6,X3
          SB7    WRITBIN
          NE     B6,B7,NOTWBIN     SKIP IF NOT WRITE BINARY 
  
          SA2    FETSETV+B5 
          LX2    1                 CHECK B58 ( SET OCCURRED IE RANDOM)
          NG     X2,SETDONE        SKIP IF SET HAS OCCURRED 
  
          BX1    -X0*X1            PICK UP LOC AND
          LX1    30                MOVE IT TO LOF 
  
 NOTWBIN  BSS    0
 SETDONE  BSS    0
          BX7    X0*X1             KEEP LOF AND SET LOC ZERO
          SA7    A1                RESET IN FET 
  
          MX0    1
          LX0    60-15             BIT 44 MASK
          SA1    FETFRST+B5 
          BX7    X0*X1             KEEP B44 (ERROR PROCESSING)
          MX0    42 
          BX1    -X0*X1            SAVE -FIRST- 
          IX7    X7+X1             MERGE
          SA7    A1                RESET IN FET+1 (R AND L FIELDS ZERO) 
          MX1    59 
          LX1    30          CLEAR THE *SKIP TRAILING ZBD* BIT
          BX7    X7*X1
          SX7    B0 
          SA7    FETSETV+B5        CLEAR SET VALUE
          SA7    FETROI+B5         CLEAR WRITE BIT AND LAST RSA,IN,OUT
  
          SA1    FETSTAT+B5 
          PX7    X1,B0
          SA7    A1          SET STATUS NEUTRAL 
          LX1    59-18       INTERACTIVE BIT
          NG     X1,BASIREW  DO NOT REWIND INTERACTIVE FILE 
          REWIND B5,R 
  
  
          EQ     BASIREW     RETURN 
* 
 APNDBUF  BSS    0
  
          SA1    FETSTAT+B5 
          SB7    WRITFUN
          UX1    X1,B6
          NE     B6,B7,APNDBIN     SKIP IF NOT BCD WRITE
  
          SA1    B5+FETCHAR                                              BAS0023
          ZR   X1,APNDBIN          JUMP IF PRINT LINE COMPLETE           BAS0023
          MX4    59 
          RJ     BASOTAB     COMPLETE THE LINE
  
 APNDBIN  BSS    0
          SA1    FETOUT+B5
          LX1    18 
          SA2    FETIN+B5 
          IX1    X1+X2       ADJOIN IN AND OUT
  
          SA2    FETROI+B5
          MX0    60-36
          BX6    X0*X2       DROP OLD -IN- AND -OUT-
          IX6    X6+X1       INSERT CURRENT -IN- AND -OUT-
          SA6    A2          TO FET 
  
          SB7    1           SPECIFY EOR
  
          RJ     RNDMWR      REWRITE THE BUFFER WITH AN EOR 
  
          SA1    FETFRST+B5 
          SX7    X1 
          SA7    A1          KEEP -FIRST- BUT DROP OTHER FLAGS
          EQ     BFR2        REJOIN REWIND PROCESSING 
 REWRNDM  BSS    0
          SA1    FETROI+B5         CHECK BUFFER-HAS-BEEN-ALTERED FLAG 
          PL     X1,BFR2           IF NOT REJOIN REWIND 
  
          SB7    B0 
  
          SA1    B5 
          BX2    X1 
          LX1    59-EOIBIT
          NG     X1,METEOI   SKIP IF EOI MET
  
          LX2    59-EOFBIT
          PL     X2,NOTEOIF  CONTINUE IF NEITHER MET
  
 METEOI   BSS    0
          SB7    1           FORCE WRITE WITH EOR 
  
 NOTEOIF  BSS    0
 GE1PRU   BSS    0
  
  
          RJ     RNDMWR            REWRITE THE BUFFER 
  
          EQ     BFR2              REJOIN REWIND
  
  
*         END REWIND
* 
 BATIREW  BSS       0 
 BATEGEN  BSS       0                   ERROR-ROUTINE NEEDS ABOVE ROUT. 
 BATOSRT  BSS       0 
 BATOWRT  BSS       0 
 BATOPRT  BSS       0                   PRINT NEEDS ERROR-ROUTINE 
 BATOCON  BSS       0                   PRINT NEEDS ERROR-ROUTINE 
 BATISRT  BSS       0 
 BATIEND  BSS       0 
          END 
          IDENT     BASIINP 
*CALL COPYRITE
          TITLE  BASIINP
          IPARAMS 
          LIST   F           LIST IF-SKIPPED CODE 
          COMMENT BASIC 3 - INPUT ROUTINES. 
*CALL LIPARAM 
          ENTRY     BASIINP,BATIINP 
          ENTRY     BASIRED,BATIRED 
          ENTRY  MISDF       MESSAGE INHIBITION FOR MAT INPUT STR 
          ENTRY  BASIDEL,BATIDEL
          ENTRY     BASINOD,BATINOD 
          ENTRY  BASAPND,BATAPND
          ENTRY  BASILOC,BATILOC
          ENTRY  BASILOF,BATILOF
          ENTRY  BASIRD0,BATIRD0
          EXT    SETCHK 
          ENTRY  BASIINS,BATIINS
          EXT    RNDMWR 
          EXT    ER137,ER141,ER174
          ENTRY  BASOSET,BATOSET
          ENTRY  BASOCLO,BATOCLO
          ENTRY  BASFSET,BATFSET
         ENTRY     BASISCN
          EXT    CHKDLMT
          EXT    DLMTNO 
          EXT    DLMTSW 
          EXT    DLTKND 
          EXT    DLMTESC
          EXT    HOLDESC
          EXT    INPBUFF
          EXT    FFCHANL
          EXT    FFREAD0
          EXT    KKKKKKK,FFCLASS
          EXT    BASICON
          EXT    BASLDMT
          EXT    STRINP 
          EXT    RNBLOCK,RNLIST,DBUGON
          ENTRY     BSTRBUF 
          EXT    COMRUNS
          EXT       BASICHK 
          EXT       BASEGEN 
          EXT       BASISRT 
          EXT       BASOMOV 
          EXT       BASOCLS 
         EXT       BASOTAB
          EXT    ASCII             ASCII MODE SWITCH
          IFC    EQ,,"OS.NAME",SCOPE ,
          EXT    ASCII95           95 CHAR ASCII TRANSLATE TABLE
          ENDIF 
          EXT    BASOWR0
  
          ENTRY  BASOFET,BATOFET
          ENTRY  BASOFFT,BATOFFT
          EXT    BASCIO=
          EXT    BASSYS=
          EXT    BASGSTR
          EXT    BASRSTR
          EXT    BASTSTR
          EXT    BASESTR
 CIO=     EQU    BASCIO=
 SYS=     EQU    BASSYS=
* 
 SUNUSED  MACRO 
          SA1    B5+FETSTAT 
          SA2    B5+FETFRST 
          PX6    B0,X1
          SX7    X2 
          SA6    A1                     SET CHANNEL UNUSED
          MX6    0
          SA7    B5+FETIN 
          SA7    B5+FETOUT              RESET FET 
          SA6    B5+FETCHAR 
         SA1       B5+FETFILE           CLEAR STATUS
         MX6       17 
         LX6       18 
         BX6       -X6*X1 
         SA6       A1 
          ENDM
* 
FLUSH     MACRO                    FLUSH BUFFER IF FILE INTERACTIVE 
          LOCAL  FLUSH1 
          SA1    B5+FETSTAT 
          SB6    WRITFUN           WRITE CODED
          PX6    B6,X1
          LX1    59-18             INTERACTIVE BIT
          PL     X1,FLUSH1         BYPASS IF NOT INTERACTIVE
          SA6    B5+FETSTAT        SET WRITE CODED FUNCTION 
          SX4    -1 
          RJ     BASOTAB           NEW LINE 
          RJ     BASOCLS           FLUSH FILE 
          SX6    B0 
          SA6    NEWPFLG           CLEAR NEW PAGE FLAG
FLUSH1    BSS    0
          ENDM
* 
* 
IWRT      MACRO                    WRITE OUT I BUFFER 
          MX4    59 
          RJ     BASOTAB           NEW LINE 
          SA1    B5+FETSTAT 
          SB6    WRITFUN           WRITE CODED FUNCTION 
          PX6    B6,X1
          SA6    A1          SET WRITE CODED FUNCTION 
          RJ     BASOCLS
          ENDM
* 
* 
* 
 ENDB     EQU       100B                END OF BUFFER 
 INPLNGT  EQU       20                  LENGTH OF CHARACTER-BUFFER
 FILNMSK  EQU    42 
 NONUMBR  EQU    1
 INERROR  EQU    2
 KBLNK    EQU    55B               KRONOS BLANK CHAR
*CALL LCORE 
*CALL,ERMNUM
* 
* 
*         ERROR-MESSAGES
* 
 ERM133   DATA   C* ILLEGAL DATA, RETYPE INPUT *
 ERM134   DATA   C* NOT ENOUGH DATA, REENTER OR TYPE IN MORE *
 ERM135   DATA   C* ILLEGAL DATA ON FILE *
 ERM136   DATA   C* END OF DATA ON FILE * 
 ERM138   DATA   C* ILLEGAL FILE NUMBER * 
 ERM139   DATA   C* ILLEGAL FILE NAME * 
 ERM140   DATA   C* NO FILE SPACE. ADD ANOTHER FILE STMT *
 ERM142   DATA   C* FILE NUMBER ALREADY IN USE *
 ERM143   DATA   C* FILE ALREADY OPEN * 
 ERM147   DATA   C* TAPE FILE IS NOT ALLOWED *
 ERM168   DATA   C* STRING OVERFLOW*
 ERM171   DATA   C* ILLEGAL ACTION ON CODED FILE *
 ERM172   DATA   C* ILLEGAL SET VALUE * 
 ERM173   DATA   C* RANDOM FILE EMPTY * 
 ERM175   DATA   C* ILLEGAL ACTION ON BINARY FILE * 
 ERM195   DATA    C* INPUT WITHIN INPUT * 
  
* 
 ER135    BSS    0
          RTERROR ERMN135,ERM135,BASEGEN   *ILLEGAL DATA ON FILE *
* 
 ER136    BSS    0
          RTERROR ERMN136,ERM136,BASEGEN   *END OF DATA ON FILE * 
* 
 ER138    BSS    0
          RTERROR ERMN138,ERM138,BASEGEN   *ILLEGAL FILE NUMBER * 
* 
 ER139    BSS    0
          RTERROR ERMN139,ERM139,BASEGEN   *ILLEGAL FILE NAME * 
* 
 ER140    BSS    0
          RTERROR ERMN140,ERM140,BASEGEN   *NO FILE SPACE * 
* 
 ER142    BSS    0
          RTERROR ERMN142,ERM142,BASEGEN   *FILE NUMBER ALREADY IN USE* 
* 
 ER143    BSS    0
          RTERROR ERMN143,ERM143,BASEGEN   *FILE ALREADY OPEN * 
* 
 ER147    BSS    0
          RTERROR ERMN147,ERM147,BASEGEN   *TAPE FILE IS NOT ALLOWED* 
* 
 ER168    BSS    0
          RTERROR ERMN168,ERM168,BASEGEN   *STRING OVERFLOW * 
 ER171    BSS    0
          RTERROR ERMN171,ERM171,BASEGEN   *BAD ACTION ON CODED FILE *
* 
 ER172    BSS    0
          RTERROR ERMN172,ERM172,BASEGEN   *ILLEGAL SET VALUE * 
* 
 ER173    BSS    0
          RTERROR ERMN173,ERM173,BASEGEN   *RANDOM FILE EMPTY * 
* 
 ER175    BSS    0
          RTERROR ERMN175,ERM175,BASEGEN   *BAD ACTION ON BINARY FILE * 
* 
* 
          TITLE  INPUT PROCEDURE
* 
*         PROCEDURE INPUT 
* 
          DATA      10HBASIINP
 BASIINP  SPACE  4
*         ENTER  B5=FET ADDRESS 
* 
*         EXIT
* 
*         USES   A1,X1,A2,X2,A7,X7,B6,B7,A3,X3,A5,X5,A6,X6
* 
*         CALLS  BASICHK,BASEGEN,BASICON
  
 BASIINP  PS     0
 BIP1     SA1    B5                     FET+0 
          ZR     X1,ER141    *FILE CLOSED/UNDEFINED*
  
          SA1    FETSTAT+B5 
          SB7    READFUN
          UX1    X1,B6
          NZ     B6,BIP2     IF USED PREVIOUSLY 
          PX7    X1,B7       SET TO READ CODED
          SA7    A1 
          SB6    B7 
 BIP2     NE     B6,B7,ER137  *ILLEGAL INPUT ON FILE* 
          SX6    B0 
          RJ     BASISCN     SCAN FOR NUMBER
          NZ     B6,BIP5     IF EOR ON INPUT
          PL     X1,BASIINP  IF LEGAL NUMERIC FIELD 
  
*         ILLEGAL NUMERIC FIELD OR INSUFFICIENT DATA
  
          SA2    FETSTAT+B5 
          LX2    59-18       INTERACTIVE BIT
          PL     X2,ER135    *ILLEGAL DATA ON FILE* 
          BX7    X7-X7
          SX1    X1+NONUMBR 
          ZR     X1,BIP3     IF NOT ENOUGH DATA 
          IFC    EQ,,"OS.NAME",SCOPE ,
* 
          EXT    START01           INPUT PROMPT CHAR
          EXT    IMESFLG     INTERACTIVE INPUT ERR FLAG 
* 
          SX7    1
          SA7    IMESFLG           SET INTERACTIVE INPUT ERR FLAG 
          SUNUSED                  CLEAR FILE BUFFER
          ENDIF 
          SB7    ERM133 
          SX7    ERMN133
 ER133A   RJ     BASEGEN
          IFC    EQ,,"OS.NAME",SCOPE ,
          SX7    B0 
          SA7    IMESFLG           CLEAR INTERACTIVE INPUT ERR FLAG 
          IWRT                     WRITE OUT I BUFFER 
          SUNUSED                  INITIATE INTERACTIVE FILE
          ENDIF 
          EQ     =XBASISRT+1 RESTART THIS INPUT 
  
*         RESTART TO FILL PARTIAL INPUT 
  
 BIP3     SA7    FETCHAR+B5  CLEAR CHARACTERS PROCESSED 
          SA5    FETIN+B5 
          MX7    42 
          MX3    59 
          IFNE   FETFILE,0
          SA1    FETFILE+B5 
          ELSE
          SA1    B5          GET FET(1) 
          ENDIF 
          BX6    X5 
          BX7    X7*X1
          BX7    -X3+X7      CLEAR EOR BIT
          SA6    FETOUT+B5   SET *OUT* = *IN* 
          SA7    A1 
          IFC    EQ,,"OS.NAME",SCOPE ,
          SX7    1
          SA7    IMESFLG           SET INTERACTIVE INPUT ERR FLAG 
          SUNUSED                  CLEAR FILE BUFFER
          ENDIF 
          SA2    DLMTSW 
          ZR     X2,ER134    *NOT ENOUGH DATA, TYPE IN MORE*
          SX1    LCR               LOOK FOR CR AS DELIMITER 
          RJ     CHKDLMT
          ZR     X3,BIP1           NO MESSAGE 
 ER134    BSS    0
          SA1    BASLDMT     PICK UP LAST DELIMITER AFTER VALID ITEM. 
          SA2    DLMTSW 
          NZ     X2,ER134C   BR, IF NONSTANDARD DELIMITERS
          SX1    X1-1R,      CONTINUE THIS ITEM 
          ZR     X1,BIP1     IF IT WAS A COMMA. 
          EQ     ER134D 
 ER134C   SX2    X1-1R       BLANKS AND CR ARE
          ZR     X2,ER134D   NOT ACCEPTABLE AS
          SX2    X1-LINE     CONTINUATION DELIMITERS. 
          ZR     X2,ER134D
          RJ     CHKDLMT     CHECK LAST DELIMITER.
          NG     X3,ER134D
          ZR     X3,BIP1
 ER134D   BSS    0
          MX7    60 
          SA7    BASLDMT
          SB7    ERM134 
          SX7    ERMN134
 ER134A   RJ     BASEGEN
          IFC    EQ,,"OS.NAME",SCOPE ,
          SA5    START01
          RJ     BASOMOV           MOVE PROMPT TO BUFFER
          SX7    B0 
          SA7    IMESFLG           CLEAR INTERACTIVE INPUT ERR FLAG 
          IWRT                     WRITE OUT BUFFER 
          SUNUSED                  INITIATE INTERACTIVE FILE
          ENDIF 
          SA1    B5+FETCHAR 
          SB7    X1+INPBUFF+1 
 BIP6     RJ     SFREAD0     GET NEXT LINE OF INPUT.
          EQ     BIP6D
 BIP6A    SA1    B7          GET THE NEXT CHARACTER.
          SB7    B7+1 
 BIP6D    SX2    X1-1R       BYPASS LEADING 
          ZR     X2,BIP6A    BLANKS.
          SX2    X1-ENDB     CHECK FOR EMPTY BUFFER.
          NZ     X2,BIP6C    NO, GO CHECK FOR DELIMITER.
          RJ     SFREAD0     YES, REFILL BUFFER AND 
          EQ     BIP6D       CONTINUE SCANNING. 
 BIP6C    SB7    B7-1 
          MX7    60          CLEAR THE LAST 
          SA7    BASLDMT     DELIMITER FLAG 
          SX2    X1-LINE     IF AT EOL GO 
          ZR     X2,BIP1     TRY AGAIN. 
          SA2    DLMTSW 
          NZ     X2,BIP6B    BR, IF NONSTANDARD DELIMITERS. 
          SX2    X1-1R,      IF LEADING DELIMITER GO
          ZR     X2,BIP1     RESTART THE ITEM OTHERWISE 
          EQ     BASISRT     RESTART THE WHOLE INPUT. 
 BIP6B    RJ     CHKDLMT     CHECK IF LEADING DELIMITER.
          NG     X3,BASISRT  NO, GO RESTART INPUT.
          EQ     BIP1        CONTINUE INPUT 
  
  
 BIP5     SA1    FETSTAT+B5 
          LX1    59-18       INTERACTIVE BIT
          MX7    0
          NG     X1,BIP3     IF INTERACTIVE MODE
          EQ     ER136       *END OF DATA ON FILE*
* 
 MISDF    BSSZ   1
*         END INPUT 
* 
* 
*         INPUT STRING
* 
          DATA      10HBASIINS
* 
*         UPON ENTRY A5/X5 CONTAIN ADDRESS/VALUE
*         OF PTR WORD FOR THE TARGET VARIABLE THAT IS TO
*         RECEIVE THE INPUT ITEM. 
* 
BASIINS   DATA      0 
          SX7       1 
          SA7       STRINP
* 
*         STORE THE ADDRSS OF PTR WORD OF TARGET FOR LATER USE
          SX6    A5 
          SA6    INTGTPWA       ADDRESS OF PTR WRD OF TARGET STORED 
* 
          RJ        BASIINP 
          SX7       B0
          SA7       STRINP
          JP        BASIINS 
* 
 INTGTPWA BSSZ   1
          TITLE  BASIRD0
          DATA   10HBASIRD0 
* 
* 
***              POSITIONS A FILE TO ANY PENDING SET VALUE SPECIFIED
* 
* 
*                ENTRY (B5) = ADDRESS OF THE FILE INVOLVED
* 
*                EXIT  FILE IS POSITIONED AS SPECIFIED
* 
* 
 BASIRD0  BSS    0
          BSSZ   1
          ZR   B5,ER138            FILE ORDINAL WAS ZERO
  
  
          RJ     SETCHK            FIND THE FILE OFFSET 
          NG     X5,CHKSTAT        SKIP IF NOT APPLICABLE 
  
          SB7    READBIN
          SA1    FETSTAT+B5 
          UX1    B6,X1
          PX7    X1,B7
          SA7    A1                FORCE READ BINARY STATUS ALWAYS
  
  
          SA1    FETOUT+B5
          IX7    X1+X5             COMBINE -OUT- AND OFFSET VALUE 
          SA7    A1                RESET IN FET 
          EQ     BASIRD0           GO EXIT
  
 CHKSTAT  BSS    0
          SA1    FETSETV+B5 
          LX1    1                 CHECK IF PREVIOUS SET OCCURRED 
          PL     X1,BASIRD0        EXIT IF NOT (NOT A RANDOM FILE)
  
          SA1    FETSTAT+B5 
          UX1    B6,X1
          SB7    READBIN
          EQ     B6,B7,BASIRD0     EXIT IF ALREADY IN READ MODE 
  
  
*                A READ AFTER WRITE SITUATION OBTAINS AND THE FET MUST
*                THEREFORE BE UPDATED ACCORDINGLY.
  
          PX7    X1,B7
          SA7    A1                FORCE READ IN FETSTAT
  
          SA1    FETIN+B5 
          BX7    X1 
          SA7    A1+1              ADOPT IN AS OUT (USED BY BASIRED)
  
          MX0    42 
          SA1    FETROI+B5
          BX7    -X0*X1 
          SA7    FETIN+B5          RELOAD IN (AS AT LAST BUFFER READ) 
  
          EQ   BASIRD0
          TITLE  BASOFET
* 
* 
* 
* 
         DATA      10HBASOFET 
 BASOFET  BSS    0
* 
*                BASOFET IS CALLED VIA FILE INPUT,PRINT,READ,WRITE AND
*                ALSO VIA RESTORE AND NODATA. 
*                ON ENTRY X5 CONTAINS THE FILE ORDINAL
*                ON EXIT  B5 POINTS TO THE ASSOCIATED FET 
* 
* 
          JP     0
          RJ     CHFLNO            CHECK FILE NUMBER (IN X5)
          NZ   X5,FET1             JUMP IF ORDINAL NONZERO
          SB5    B0                SET ADDR = 0 TO FLAG ORD WAS ZERO
          EQ   BASOFET
 FET1     BSS    0
* 
          RJ     FETADDR           GET ADDRESS OF ASSOCIATED FET TO B5
          NG     X1,ER141    *FILE CLOSED/UNDEFINE(141) 
*                                  ELSE EXIT WITH ADDRESS OF FET IN B5
          EQ     BASOFET
* 
* 
          TITLE  BASOFFT
* 
* 
*** 
* 
         DATA      10HBASOFFT 
 BASOFFT  BSS    0
*                  ON ENTRY B7 POINTS TO FILE NAME
*                           X5 CONTAINS FILE ORDINAL
*                  ACTION IS TO SEARCH FET CHAIN FOR THE NAME PROVIDED
*                           AND IF IT IS FOUND PLACE THE ORDINAL IN FET 
*                           IF NAME IS NOT FOUND,SEARCH FOR A DUMMY FET 
*                           TO PLACE BOTH NAME AND ORDINAL IN. IF NO
*                           MATCH IS FOUND ON NAME,AND NO DUMMY FILE IS 
*                           FREE,ABORT WITH ERROR MESSAGE 
         JP        0
* 
         RJ        CHFLNO   CHECK FILE ORDINAL IN X5
*                           ON RETURN X5 CONTAINS TRUNCATED FILE ORDINAL
          ZR   X5,BASOFFT          IGNORE IF ORDINAL ZERO 
         RJ        CHFLNAM  CHECK FILE NAME SUPPLIED
*                                       MUST BE .LT. 7 CHARACTERS 
*                                       ON RETURN,FILE NAME IN X6 
          RJ     FETADDR                SEARCH FOR FILE ORDINAL 
          PL     X1,ER142    *FILENO ALREADY IN USE*
          RJ     FNDNAM                 FIND FILENAME 
          NG     X1,FFT1                NO FET WITH FILENAME
          SA1    B5+FETFNUM 
          MX2    42 
          BX1    -X2*X1 
          NZ     X1,ER143    *FILE ALREADY OPEN*
          IX6    X1+X5                  MERGE IN FILE ORDINAL 
          SA6    A1                     AND STORE 
          SA1    B5+FETSTAT 
          MX0    1
          LX0    CLSBIT+1               MARK THIS FILE UNCLOSEABLE
          BX6    -X0*X1 
          SA6    A1 
          RJ     FETYPE 
          EQ     BASOFFT
FFT1      BSS    0
         RJ        FNDSPAR              NEXT- ATTEMPT TO FIND A FET 
*                                       WHICH IS SPARE, 
          NG     X1,ER140    *NO FILE SPACE. ADD ANOTHER FILE STATEMENT*
*                                       ELSE NAME IS PLACED IN FET,AND
*                                       B5 POINTS TO FET
          RJ     FETYPE 
          EQ     BASOFFT
*** 
FNDNAM    BSS    0
          JP     0
          MX2    FILNMSK
          SA1    B4 
          SB5    B4+X1                  GET POINTER TO 1ST FET
FNDNAM0   SA1    B5 
          BX1    X2*X1                  MASK OUT NAME 
          BX1    X1-X6                  COMPARE 
          NZ     X1,FNDNAM2             NO MATCH
          MX1    0
          EQ     FNDNAM 
FNDNAM2   SA1    B5+FETCHAN             NEXT HEADER 
          SX1    X1 
          NG     X1,FNDNAM              END OF CHAIN
          SB5    B4+X1
          EQ     FNDNAM0
* 
* 
 CHFLNO   BSS    0
* 
* 
*                USES X1,5         B6 
*                ON ENTRY X5 HAS THE FILE NO
*                ON EXIT X5 HAS THE (TRUNCATED, IF NECESSARY) FILENUM 
* 
* 
          JP     0
          SA1    =XBASANSI     ROUND THE FILE ORDINAL 
          ZR     X1,CHFLN02  IF IN ANSI MODE. 
          BX1    X1-X1
          PX1    X1 
          RX5    X5+X1
          NX5    X5 
 CHFLN02  BSS    0
          UX1    B6,X5
          LX5    X1,B6
          NG     X5,ER138    *ILLEGAL FILE NO*
          MX1    42 
          BX1    X1*X5
          NZ     X1,ER138    *ILLEGAL FILE NO*
          EQ     CHFLNO            EXIT WITH VALUE IN X5
* 
* 
*** 
* 
 CHFLNAM  BSS    0
*                CHECKS THAT THE FILE NAME IS .LT. 7 CHARS LONG 
* 
*                USES X1,2,3,6,7   B6 
*                ON ENTRY B7 POINTS TO THE FILENAME 
*                ON EXIT THE FILENAME IS LEFT-JUSTIFIED IN X6 
* 
          JP     0
          SB6    6                 BITS PER CHAR
          MX6    42                7 CHAR SPAN
* 
          SA1    B7          X1 = STRING POINTER WORD 
          ZR     X1,CHFL.A
          SB7    X1          B7 = ADR OF VARIABLE STRING
          PL     X1,CHFL.A
          SB7    X1+B4       B7 = ADR OF CONSTANT STRING
 CHFL.A   BSS    0
  
          SA1    B7                LOAD THE FILENAME
          ZR     X1,ER139    *ILLEGAL FILE NAME*
          BX6    X6*X1             PICK L.H. 7 CHARS
          MX7    54                CHAR MASK
          LX1    6                 FIRST CHAR MUST BE LETTER
          BX2    -X7*X1 
          ZR   X2,ER139            COLON OR ILLEGAL IS BAD
          SX2    X2-1R0 
          PL   X2,ER139            NON-LETTER IS BAD
          SX3    7                 TO CHECK 7-CHAR LIMIT
* 
 TRYNXT   BSS    0
          LX1    X1,B6             SHIFT NEXT (1ST) CHAR
          BX2    -X7*X1 
          NZ   X2,FCHOKE1 
*  FOUND ZERO CHARACTER - IT IS COLON, ILLEGAL, OR EOS
*  IT MUST BE EOS OR THE FILENAME IS BAD (NO COLONS ALLOWED)
*  CHECK REST OF WORD FOR ZEROS TO END (EOS)
          SX3    X3+1              NUMBER OF CHAR LEFT IN WORD
 FCHOKE2  LX1    X1,B6             NEXT CHAR
          BX2    -X7*X1 
          NZ   X2,ER139            MUST BE ZERO TO END
          SX3    X3-1 
          NZ   X3,FCHOKE2          LOOP UNTIL WORD DONE 
          EQ   CHFLNAM             EXIT, NAME IS OK (IN X6) 
 FCHOKE1  BSS    0
          SX2    X2-ALMERIC        CHECK CHAR TO BE ALPHANUMERIC
          NG     X2,FCHOKE
          EQ     ER139       *ILLEGAL FILE NAME*
 FCHOKE   BSS    0
          SX3    X3-1 
          NZ     X3,TRYNXT         LOOP TO MEET ZERO BYTE 
          EQ     ER139       *ILLEGAL FILE NAME*
* 
* 
* 
* 
*** 
* 
 FETADDR  BSS    0
* 
* 
*                USES THE FILE ORDINAL IN X5 TO RETURN THE ADDRESS OF 
*                THE ASSOCIATED FET IN B5.
*                IF THE SEARCH FAILS X1 IS .LT. 0 ON EXIT.
*                USES X1,2,3
* 
* 
          JP     0
          SA1    B4                CHAIN HEAD 
 TSTNXT   BSS    0
          NG     X1,FETADDR        EXIT ON END OF CHAIN 
* 
*                                  LOWER 18 BITS OF X1 HAVE THE 
*                                  REL. ADDRESS OF THE NEXT (1ST) FET 
* 
          SB5    X1+B4
          SA3    B5+FETFNUM        PICK UP FILE NO FROM FET 
          MX2    -18         TRUNCATE TO JUST ORDINAL 
          BX3    -X2*X3 
          IX3    X5-X3             COMPARE TO THE TARGET FILE NUMBER
          ZR     X3,FETADDR        EXIT IF MATCH FOUND
          SA3    B5+FETCHAN        -NEXT- HEADER
          SX1    X3                PICK OUT REL ADDRESS OF NEXT FET 
          EQ     TSTNXT            GO TRY NEXT ONE
* 
* 
* 
*** 
* 
 FNDSPAR  BSS    0
* 
*                FNDSPAR FINDS A SPARE FET AND DUMPS THE FILE NAME
*                AND NUMBER IN IT.
* 
*                ON ENTRY X5 HOLDS A FILE NO
*                X6 HAS A FILE NAME 
*                B5 POINTS TO THE FIRST USEABLE FET 
* 
*                ON EXIT X1=0 MEANS A SPARE FET WAS FOUND 
*                ELSE X1 .LT. 0 MEANS FAILURE 
* 
* 
          JP     0
          MX2    54 
         SA1       B4                   GET FIRST WORD OF CONSTANTS 
         SB5       X1+B4                WHICH CONTAINS A POINTER TO 
*                                       TOP OF FET CHAIN
* 
 NXTSPAR  BSS    0
          SA1    B5                FILE NAME FROM FET 
          BX7    X1 
          LX1    6                 SHIFT FIRST CHAR ROUND 
          BX1    -X2*X1            MASK IT OUT
          ZR     X1,SPARFET        SKIP IF ITS A SPARE
          SA1    B5+FETCHAN        -NEXT- HEADER
          SX1    X1                X1 : REL ADDRESS OF NEXT FET 
          NG     X1,FNDSPAR        EXIT IF END OF CHAIN (FAILURE) 
          SB5    B4+X1             B5 : ADDRESS OF NEXT FET 
* 
          EQ     NXTSPAR
* 
 SPARFET  BSS    0
          MX2    42 
          BX7    -X2*X7 
          IX7    X7+X6             MERGE NAME INTO FET HEAD 
          SA7    B5                AND DUMP IT IN THE FET 
         MX1       0B                  CLEAR RETURN FLAG
         BX6       X5                 LOAD ORDINAL
          SA5    B5+FETFNUM 
          BX5    X2*X5
          IX6    X6+X5             MERGE FILE NO
          SA6    B5+FETFNUM        ALSO DUMP THE FILE NUMBER
          SA1    B5+FETSTAT 
          MX0    1
          LX0    CLSBIT+1               MARK THIS FILE CLOSEABLE
          BX6    X1+X0
          SA6    A1 
* 
          OPEN   B5,ALTERNR,R      OPEN FILE TO GET DEVICE TYPE 
          SA1    B5                CLEAR STATUS BITS IN FET 
          MX2    17 
          LX2    18 
          BX6    -X2*X1 
          SA6    B5 
* 
          SA1    B5+FETFRST        GET DEVICE TYPE
          MX2    DEVTYPL
          BX2    X1*X2
          LX2    DEVTYPL
          SB6    X2                6 OR 12-BIT DEVICE TYPE CODE 
          SA2    B5+FETSTAT        GET FET STATUS WORD
          LX2    30                CLEAR INTERACTIVE BIT IN CASE FILE IS
          PX6    B0,X2               NOT TERMINAL. FETSTAT IN X6. 
          SB7    DEVTYP3           TERMINAL DEVICE TYPE 
          NE     B6,B7,CKTAPE      GO CK FOR TAPE IF NOT TERMINAL 
SPAR11    BSS    0
          SB6    1
          PX6    B6,X6             TURN INTERACTIVE BIT ON
SPAR12    BSS    0
          LX6    30 
          BX1    X1-X1       (X1) = 0 = 'FOUND A SPARE FET'.
          SA6    B5+FETSTAT        STORE BACK INTO FET
          IFC    EQ,,"OS.NAME",SCOPE ,
          SA1    ASCII
          ZR     X1,FNDSPAR  NOT ASCII SO EXIT
          SA1    B5+FETSETV 
          MX6    1
          LX6    23          BIT 22 = ASCII-95 MODE 
          BX7    X1+X6
          SA7    A1 
          SA1    B5+FETFRST 
          LX6    20                BIT 42 FOR ASCII MODE
          BX7    X6+X1
          BX1    X1-X1       (X1) = 0 = 'FOUND A SPARE FET'.
          SA7    A1 
          ENDIF 
* 
          EQ     FNDSPAR           AND EXIT 
* 
 CKTAPE   BSS    0
*                CKTAPE CHECKS FILE DEVICE TYPE AND ABORTS
*                IF FILE OPENED IS A TAPE FILE. 
*                BASIC 3 FILES MUST NOT BE TAPE.
* 
          IFC    EQ,,"OS.NAME",KRONOS,
          SB7    DVTYPMT
          EQ     B6,B7,ER147       ERROR IF F/I 7-TRK TAPE
          SB7    DVTYPNT
          EQ     B6,B7,ER147       ERROR IF F/I 9-TRK TAPE
          MX2    DVTAPL            MASK FOR 6-BIT DEVICE TYPE 
          BX2    X1*X2
          LX2    DVTAPL 
          SB6    X2                PICK UP 6-BIT DEVICE TYPE
          ENDIF 
          SB7    DVTAPEM
          EQ     B6,B7,ER147       ERROR IF S/L/SI 7-TRK TAPE 
          SB7    DVTAPEN
          EQ     B6,B7,ER147       ERROR IF S/L/SI 9-TRK TAPE 
          EQ     SPAR12            CONTINUE WITH NON-INTERACTIVE
*                                    VALID FILE.
* 
          IFC    EQ,,"OS.NAME",KRONOS,
 DVTYPMT  EQU    1524B             MT DEVICE TYPE FOR F/I/TAPE
 DVTYPNT  EQU    1624B             NT DEVICE TYPE FOR F/I TAPE
 DVTAPL   EQU    6                 DT LENGTH FOR S/L/SI TAPES 
          ENDIF 
 DVTAPEM  EQU    40B               7-TRK DEVICE TYPE FOR S/L/SI TAPE
 DVTAPEN  EQU    41B               9-TRK DEVICE TYPE FOR S/L/SI TAPE
* 
* 
 FETYPE   BSS    0
*                            FETYPE CHECKS TO SEE IF FILE 
*                             IS READ ONLY TYPE FILE AND IF SO
*                              SETS WRITE LOCK OUT BIT IN FET 
* 
          BSSZ   1
          MX4    42 
          SA1    B5 
          BX7    X4*X1
          SA1    FETHED      (X1) = LFN WORD OF PREVIOUS FILINFO REQUEST
  
 .NOSBE   IFC    EQ,,"OS.NAME",SCOPE ,
          MX4    43          ONE BIT LONGER THAN AN LFN 
          LX4    1           POSITION TO CLEAR COMPLETE BIT 
 .NOSBE   ENDIF 
  
          BX1    -X4*X1      CLEAR LFN
          BX7    X7+X1       MERGE WITH NEW LFN 
          SA7    A1          STORE IN FILINFO BLOCK 
          FILINFO A7
          SA1    FETHED+1 
          LX1    59-7 
          NG     X1,FETYPE   IF WRITING IS ALLOWED
          SA1    B5+FETSTAT 
          MX7    1
          LX7    47          WRITE LOCK OUT BIT IN FET
          BX7    X7+X1
          SA7    A1 
          EQ     FETYPE 
* 
* 
 FETHED   VFD    42/0,6/5,12/1     FILINFO BLOCK
          BSSZ   4           REMAINDER OF FILINFO BLOCK 
  
* 
 ALMERIC  EQU    45B
* 
 BATOFET  BSS    0
 BATOFFT  BSS    0
 INPSCSV  BSS    1
          TITLE  BASISCN
* 
*         PROCEDURE INPUT-SCAN
* 
*         INPUT -- X6 = TYPE FLAG , TRANSFERRED TO BASICON
*         OUTPUT -- NUMBER IN X6 , RESULT-FLAG IN X1 , STATUS IN B6 
*         TYPE-FLAG .. ZERO = REAL
*                      POS  - INTEGER 
*                      NEG  = BEGIN OF NEXT NUMBER
*         RESULT-FLAG ..  0 = REAL
*                         1 = INTEGER 
*                         2 = NEW NUMBER
*                      ( -1 = NO NUMBER  )
*                        -2 = INPUT ERROR 
* 
*         THIS ROUTINE IS USED FOR INPUT OF NUMERIC ITEMS AND FOR 
*         NODATA PROCESSING. PROCESSING IS STRAIGHT FORWARD FOR INPUT 
*         OF NUMERIC ITEMS. 
* 
*         HOWEVER, NODATA PROCESSING IS A LITTLE TRICKY.
*         FIRST, BASISCN IS ENTERED WITH X6 NEGATIVE. THIS INDICATES
*         TO BASISCN AND BASICON THAT NO NUMBER IS REQUESTED. 
* 
*         THE FIRST CALL TO BASISCN WITH X1=END OF BUFFER MERELY SETS UP
*         THE UNPACK BUFFER AND POINTERS. UPON RETURN FROM THIS FIRST 
*         CALL TO BASICON, THE TYPE FLAG IS SET TO -1 (I.E. NO NUMBER). 
*         THIS TELLS BASISCN NOT TO CHECK FOR VALIDITY OF DELIMITER AND 
*         TO UPDATE THE FET BUFFER POINTERS.
* 
*         BASISCN THEN LOOPS BACK FOR ANOTHER CALL TO BASICHK AND 
*         BASICON. THIS TIME BASICON RETURNS THE FIRST CHARACTER IN THE 
*         UNPACK BUFFER, SETS THE TYPE FLAG TO 1=INTEGER, AND RETURNS -1
*         AS THE DELIMITER. THE NEGATIVE DELIMITER TELLS BASISCN NOT TO 
*         CHECK FOR VALIDITY OF THE DELIMITER AND THE POSITVE TYPE FLAG 
*         TELLS BASISCN TO RETURN TO THE ROUTINE WHICH CALLED IT. 
* 
*         IF BASICON RETURNS X1=-2 THEN ILLEGAL DATA WAS FOUND. IN THIS 
*         CASE, THE FILE IS POSITIONED TO THE NEXT NON-BLANK
*         NON-DELIMITER ITEM. 
* 
 BASISCN  BSSZ      1 
          SA6       INPSCSV             SAVE X6 
          SX6    B0 
          SA6    DLMTESC           CLEAR -ESCAPE- CODE BUFFERS
 INPSCN0  BSS       0 
          RJ        BASICHK             CHECK FOR DATA AVAILABLE
          SA2       INPSCSV 
          BX6       X2                  RESET X6
          NZ        B6,BASISCN          IF NOT THEN EXIT WITH STATUS
          SA2       B5+FETCHAR
          SX1       ENDB
          SB7       X2+INPBUFF+1
          SA2       STRINP
          NZ        X2,INPSCN4
          RJ        BASICON             GET NUMBER , START OF NO. OR EOL
* 
* CHECK THE DELIMITER FOR VALIDITY. IF THE DELIMITER IS NEGATIVE, THEN
* NO NUMBER WAS REQUESTED (I.E. NODATA CALL)
* 
          NG     X1,INPSCN3  BR, ERROR OR NO NUMBER 
          SA2    =XBASLDMT
          NG     X2,INPSCN3  BR, THIS WAS A NODATA CALL 
* 
* CHECK THE DELIMITER FOR VALIDITY
  
          SX3    X2-LINE
          ZR     X3,INPSCN3  BR, CR ALWAYS A DELIMITER
          SA3    DLMTSW 
          NZ     X3,INPSCN01 BR, USER DELIMITERS IN EFFECT
          SX3    X2-1R
          ZR     X3,INPSCN3  BR, DELIMITER WAS A BLANK
          SX3    X2-1R, 
          ZR     X3,INPSCN3  BR, DELIMITER WAS A COMMA
          SX1    -INERROR    ELSE, BAD DELIMITER--ERROR IN INPUT
          EQ     INPSCN3
* 
* CHECK FOR SPECIAL USER DEFINED DELIMITERS 
* 
 INPSCN01 BX7    X1 
          SA7    SAVTFLG     SAVE TYPE FLAG 
          SA1    =XBASLDMT
          RJ     CHKDLMT
          SA1    SAVTFLG     RESTORE TYPE FLAG
          PL     X3,INPSCN3  BR, DELIMITER IS VALID 
          SX1    -INERROR    DELIMITER IS INVALID 
* 
* 
* 
INPSCN3   BSS       0 
          SX7    X1+INERROR 
          NZ     X7,INPSCN7  BR, NO ERROR FOUND BY BASICON
* 
* AN ERROR ON INPUT WAS FOUND BY BASICON. THEREFORE, POSITION THE FILE
* TO THE NEXT NON-BLANK NON-DELIMITER ITEM. THIS IS DONE TO FACILITATE
* ON ERROR PROCESSING.
* 
          SA2    B5+FETSTAT 
          LX2    59-18             INTERACTIVE BIT
          NG   X2,INPSCN7          JUMP IF INTERACTIVE FILE 
          SX7    B4                SAVE B4
          SA7    TSAV1+1
          BX7    X1 
          SA7    TSAV1        SAVE X1 
 INPSCN   SA1    B7 
          SB7    B7+1 
 INPSCN8  BSS    0                                                       BAS0016
          SB4    X1 
          SA2    DLMTSW 
          NZ     X2,INPDLM   DELIMIT SCAN 
          SA2    STRINP 
          NZ   X2,SCNINP2          JUMP IF STRING INPUT, BLANK NOT DELIM
          SB6    1R          BLANK
          EQ     B6,B4,SCNINP9
 SCNINP2  BSS    0
          SB6    1R,         COMMA
          EQ     B6,B4,SCNINP9
 SCNINP1  BSS    0
          SB6    LINE 
          EQ     B6,B4,SCNINP9
          SB6    ENDB 
          NE     B6,B4,INPSCN 
          RJ     SFREAD0     FILL BUFFER
          EQ   INPSCN8                                                   BAS0016
* 
 INPDLM   BSS    0
          RJ     CHKDLMT
          NG     X3,SCNINP1 
          EQ     SCNINP9
* 
SCNINP9   BSS    0
          SB7    B7-1 
          SA1    TSAV1+1           RESTORE B4, X1 
          SB4    X1 
          SA1    TSAV1
 INPSCN7  BSS 0 
          SB6    INPBUFF           START OF CHAR UNPACK BUFFER
          SX7    B7-B6
          SA7       B5+FETCHAR          SAVE CHARACTER POINTER
         SX2       X1+NONUMBR 
* 
* IF X1 <> -1, THEN EXIT BASISCN. IF X1 = -1, THEN THIS IS THE 1ST
* ITERATION OF NODATA PROCESSING. THE REST OF THIS CODE UPDATES THE 
* *OUT* POINTER IN THE INPUT FET AND THEN CALLS INPSCN0 FOR A SECOND
* ITERATION. THIS 2ND ITERATION WILL RETURN WITH EITHER X1 = -2 (ERROR) 
* OR WITH X1 = 1 AND BASLDMT = -1. IN EITHER CASE, NODATA PROCESSING
* WILL TERMINATE HERE ON THE 2ND ITERATION. 
* 
          SB6       B0                  SET STATUS
          NZ        X2,BASISCN          RETURN WITH RESULT
          SA1    B5+FETFRST        UPDATE *OUT* 
          SA2    B5+FETOUT
          SX7    X2 
          SA5    B5+FETCHAR        CHAR COUNT 
          IFC    EQ,,"OS.NAME",KRONOS,
          SA3    ASCII
          ZR     X3,INPSCN9 
          SB6    INPBUFF
 SCNINP4  SA3    B6 
          SB6    B6+1 
          EQ     B6,B7,INPSCN9
          PL     X3,SCNINP4  IF ASCII CHAR
          SX5    X5+1        THEN INCREMENT CHAR COUNT
          EQ     SCNINP4
 INPSCN9  BSS    0
          ENDIF 
          SX2    10 
          IFC    EQ,,"OS.NAME",SCOPE ,
          SA3    ASCII             ASCII RUN FLAG 
          ZR   X3,INPSCN5          NON-ASCII MODE 
          SX5    X5+4              ADJUST COUNT 
          SX2    5                 CHAR/WORD
          EQ   INPSCN6
          ENDIF 
 INPSCN5  SX5    X5+10
 INPSCN6  SA3    B5+FETLIMT 
          SX3    X3 
* 
 INPSCN1  BSS    0
          SA7    A2                NEW OUT
          IX5    X5-X2             DECR COUNT BY CHAR/WORD
          NG        X5,INPSCN2          END OF LINE 
          SX7       X7+1                UP OUT
          IX6       X3-X7 
          NZ        X6,INPSCN1          NOT END OF BUFFER 
          SX7       X1                  SET OUT TO FIRST
          EQ        INPSCN1 
 INPSCN2  BSS       0 
          SX7       B0
          SA7       B5+FETCHAR          SET CHARACTER-COUNT 
* 
* CLEAR THE *TRAILING ZBD* BIT IN FETFRST. SINCE THE FET POINTERS HAVE
* NOW BEEN UPDATED CORRECTLY, IF THE NEXT WORD IS BINARY ZEROS, THEN
* IT DOES ACTUALLY REPRESENT A NULL STRING--IT IS NOT A TRAILING ZBD
* FOR THE PREVIOUS STRING INPUTED.
* 
          MX7    59 
          LX7    30 
          BX7    X7*X1
          SA7    B5+FETFRST 
          EQ        INPSCN0 
INPSCN4   RJ        BASISTR 
          EQ        INPSCN3 
* 
* 
 SAVTFLG  BSSZ   1           SAVE TYPE FLAG 
* 
* 
*         END  INPUT-SCAN 
* 
          TITLE  BASISTR
* 
* GET INPUT STRING AND STORE IN TARGET VARIABLE 
 BASISTR  DATA      0 
          SX7       B5
          SA7       FFCHANL 
          SX6       B4
          SA6       B4SAVE
          SX7       B3
         LX7       18         SHIFT B3 OVER SO
         SX6       B2              CAN
         BX7       X7+X6           SAVE  B2 
          SA7       B3SAVE
* 
*         GET SOME SPACE FOR THE TARGET VARIABLE
*         SET UP STRG MGR CALL PARAS
          SA1    INTGTPWA        X1 = ADDRESS OF PTR WORD OF TGT
          SX2    -1              X2 = LENGTH REQD PARA
          RJ     BASGSTR         GET ALL SPACE AVAIL AT END OF STRING AR
* 
          SB3    X1              B3 = FWA OF SPACE ASSIGNED 
          BX6    X1 
          SA6    SPACEFWA        HOLD ADDRESS OF SPACE, FOR LATER USE 
* 
          BX6    X2 
          SA6    SPACELEN        HOLD LEN OF SPACE FOR LATER
  
*         SET UP ENDB CHAR IN X1 THAT WAS CLOBBERED 
          SX1    ENDB             X1 = ENDB (FORCES UNPACK BUFFER FILL O
* 
  
          SX6       B0
         SB2       B0         ZERO OUT CHAR COUNT IN STRING 
          SB5       54
          SA6    OVRSW       CLEAR OVERFLOW SWITCH
 SCHECK   SB4       X1                 FIRST CHARACTER
          SB6       ENDB
          EQ        B6,B4,FILL
          SB6       LINE
          EQ        B6,B4,BLINE        NO DATA
          SA2    DLMTSW            CHECK IF NON-STD DELIMS SPECIFIED
          NZ     X2,SKPLDLM        SKIP IF SO 
          SB6    QUOT              CHECK FOR LEADING QUOTE
          EQ     B6,B4,QUOTED      IF MET, GO START STRING
          SB6       1R
          EQ        B6,B4,SGET         SKIP LEADING BLANKS
          SB6       1R, 
          EQ     B6,B4,SGET 
          JP     NQUOTE 
 SGET     SA1       B7
          SB7       B7+1
          EQ        SCHECK
 SKPLDLM  BSS    0
          RJ     CHKDLMT           CHECK FOR DELIM MATCH
          NG     X3,CHCKNUL  BR, NOT A DELIMITER--CHECK IF NULL VALUE 
          EQ     SGET              IGNORE DELIMITER 
* 
* 
 FILL     RJ        SFREAD0 
          JP        SCHECK
 BLINE    BSS    0
*         NO DATA FOR THIS ITEM SO RELEASE ALLOCATED SPACE
          SA1    INTGTPWA 
          RJ     BASRSTR         ALLOCATED SPACE RELEASED 
          SX1    -NONUMBR        SET NO DATA RETURN STATUS
          JP        SRETN 
 QUOTED   SA1       B7
          SB7       B7+1
 QUOTE1   SB4       X1
          SB6    QUOT              SCAN FOR QUOTE 
          EQ     B6,B4,SEEDKOT
 SDKOT2   BSS    0
          SB6       LINE
          EQ     B6,B4,B4SERR    NO TERMINATING QUOTE 
* 
          SB6       ENDB
          EQ        B6,B4,QFILL 
          SA1    OVRSW
          NZ     X1,QUOTED
* 
*         SET UP SPACELEN IN X1 FOR USE DURING PUTCHAR
          SA1    SPACELEN        X1 = LEN OF ALLOCATED SPACE
          RJ        PUTCHAR 
          JP        QUOTED
 SEEDKOT  BSS    0
          SA1    B7 
          SB4    X1 
          SB6    ENDB 
          NE     B4,B6,SEEDKO2
          RJ     SFREAD0
          EQ     SEEDKOT
 SEEDKO2  SB6    QUOT 
          NE     B6,B4,QENDA
          SB7    B7+1 
          JP     SDKOT2 
STROVFL  BSS       0          GO TO HERE IF STRING OVERFLOWED 
         SB6       1R 
* 
*  HERE FOR UNQUOTED STRING, OVERFLOWED.
          NE     B6,B4,B4SERR    BR, EXCESS NOT ALL BLANKS
* 
STROVFL1 BSS       0
*                             CHECK IF BLANKS ENDED BY END OF LINE
*                                  ERROR IF ISNT
         SA1       B7         NEXT CHAR 
         SB7       B7+1 
         SB4       X1 
         SB6       1R 
         EQ        B6,B4,STROVFL1  IGNORE IF BLANK
         SB6       LINE 
         EQ        B6,B4,STROVFL2   IF END OF LINE, OK
         SB6       ENDB 
         EQ        B6,B4,SOVFLFIL   END OF BUFFER, GO AND FILL
          EQ   SERR           ELSE ERROR
STROVFL2 BSS       0
*                             TRAILING BLANKS CAUSED OVERFLOW 
*                                 AS DELIMITER
         SA2       DLMTSW     DELIMITER SWITCH
         ZR        X2,LEND    IS NOT SET, OK
         SA2       DLMTNO     ELSE LOAD DELIMITER COUNT 
         BX7       X2 
          SB6    LCR               CARRIAGE RETURN
STROVFL3 BSS       0
         SA2       A2+1       LOAD NEXT DELIMITER 
         SB4       X2 
          EQ     B4,B6,B4SERR    IF CARRIAGE RETURN IS DELIMITER -- 
*                                 OVERFLOW ERROR
         SX7       X7-1 
         NZ        X7,STROVFL3   LOOP TO CHECK ALL DELIMITERS 
         EQ        LEND       IF NONE OF DELIMITERS IS CARRIAGE RETURN
*                                 OK
 B4SERR   BSS    0
          SA1    INTGTPWA 
          SX2    B2 
          RJ     BASTSTR         TRUNCATE STRING SPACE TO STRING LEN + Z
* 
          RJ     DROPTBIT        DROP TEMPORARY BIT FROM PTR WORD 
* 
* 
 SERR     SX1       -INERROR
          SB7    B7-1 
          JP        SRETN 
SOVFLFIL BSS       0          FILLING BUFFER WHEN CHECKING FOR TRAILING 
*                                  BLANKS FOR LONG STRINGS
         RJ        SFREAD0
         EQ        STROVFL1 
QFILL     RJ        SFREAD0 
          JP        QUOTE1
* 
 CHKSTDL  BSS    0
* 
          RJ     CHKDLMT           CHECK FOR DELIMITER MATCH
          NG     X3,NQUOTE2        PROCESS CHAR IF NO MATCH 
          EQ     NQUOTE3     EXIT ON DELIMITER MATCH
* 
* 
*         CHCKNUL DETERMINES IF THE CHARACTER IN THE UNPACK BUFFER IS 
*         THE NULL CHARACTER. IF IT IS NOT, THEN NORMAL PROCESSING
*         CONTINUES. IF IT IS THE NULL CHARACTER, THE UNPACK BUFFER 
*         IS SET TO THE NEXT CHARACTER IN THE UNPACK BUFFER WHICH WE
*         KNOW IS AN END OF LINE. WE THEN JUMP TO ROUTINE LEND. 
* 
*         LEND CHECKS TO SEE IF DELIMIT (CR) IS IN EFFECT. IF SO, WE
*         JUMP TO QEND WHICH STORES A ZERO BYTE IN THE VARIABLE AND 
*         EXITS. IF IT IS NOT IN EFFECT, THEN PROCESSING CONTINUES
*         NORMALLY. THE END OF LINE IS TREATED AS A REDUNDANT DELIMITER 
*         AND THE NEXT WORD IS RETRIEVED FROM THE INPUT BUFFER (FET). 
* 
 CHCKNUL  SB6    205B        CHECK IF THIS IS A NULL STRING 
          NE     B6,B4,NQUOTE  BR, THIS IS NOT A NULL STRING
          SA1    B7          THIS IS A NULL STRING--X1=EOL
          SB7    B7+1        BUMP B7 BECAUSE LEND DECREMENTS IT 
          EQ     LEND 
* 
* 
 NQUOTE   BSS    0
          RJ     PUTCHAR
          SA1    OVRSW                                                   BAS0016
          NZ   X1,STROVFL          JUMP IF STRING TOO LONG               BAS0016
 NQUOTE0  BSS    0
          SA1       B7
          SB7       B7+1
 NQUOTE1  SB4       X1
* 
          SA2    DLMTSW            LOOK AT -USER-DELIMITER(S)- SWITCH 
          NZ     X2,CHKSTDL        AND SKIP IF ITS ON 
          SB6       1R, 
          EQ     B4,B6,NQUOTE3     COMMA TERMINATES 
 NQUOTE2  BSS    0
          SB6       ENDB
          EQ        B6,B4,NFILL 
          SB6       LINE
           EQ      B4,B6,LEND     .END OF LINE
          EQ        NQUOTE
 NQUOTE3  BSS    0
          BX7    X1          SAVE THE TRAILING
          SA7    BASLDMT     DELIMITER. 
          SA2    =XBASANSI
          ZR     X2,QEND     LEAVE TRAILING BLANKS IN ANSI MODE 
          SA2    DLMTSW 
          NZ     X2,QEND     LEAVE TRAILING BLANKS
          SX1    1R 
          MX2    -6 
          SB4    60          PRESET LIMIT 
 NQUOTE4  SB5    B5+6        INCREMENT SHIFT COUNT
          EQ     B5,B4,NQUOTE5 BRANCH IF DONE WITH WORD 
          LX3    B5,X2       SHIFT MASK TO CHAR POSITION
          BX5    -X3*X6      EXTRACT CHARACTER
          LX4    B5,X1       SHIFT BLANK TO CHAR POSITION 
          BX5    X5-X4
          NZ     X5,NQUOTE6  BRANCH IF NOT A BLANK
          BX6    X3*X6       CLEAR OUT THE BLANK
          SB2    B2-1        DECREMENT THE STRING COUNT 
          EQ     NQUOTE4     TRY AGAIN
 NQUOTE5  SB3    B3-1        PREVIOUS WORD ALL ZEROS, DECREMENT 
          SA5    B3          GET PRECEDING WORD 
          BX6    X5 
          SB5    -6          PRESET SHIFT COUNT 
          EQ     NQUOTE4
 NQUOTE6  SB5    B5-6 
          PL     B5,QEND     BRANCH IF PART WORD
          SB5    54 
          SB3    B3+1 
          BX6    X6-X6       PRESET FOR ZERO WORD 
          EQ     QEND 
 NFILL    RJ        SFREAD0 
          JP        NQUOTE1 
* 
* 
 NOROOM1  BSS    0
          RJ     SPACEFUL 
          EQ     PUTRESUM 
* 
* 
 NOROOM2  BSS    0
          RJ     SPACEFUL 
          EQ     PUTCONT
* 
* 
* 
 SPACEFUL BSS    0
          DATA 0
* 
*         STRING MANAGER SAVES ALL OF CALLERS B REGS
*         ALSO X0,X3,X4,X5
* 
*         SAVE PUTCHAR X6 (INTERIM ASSEMBLY WORD) 
          SA6    PUTSVX6         X6 SAVED 
* 
*         TAKE SPACE FWA OUT OF PUTCHAR B3 PTR SO B3 = INDEX ONLY 
          SA1    SPACEFWA 
          BX1    -X1             SET X1 TO NEGATIVE SPACEFWA
          SB3    X1+B3           SET B3 TO INDEX INTO STRING SPACE
* 
*         SET UP PARAS FOR STRING MGR CALL
          SA1    INTGTPWA 
          SX2    -1 
          RJ     BASESTR         CALL TO EXTEND STRING SPACE
* 
* WE DEFER CHECKING TO SEE IF CALL TO EXTEND STRING WAS 
* SUCCESSFUL UNTIL AFTER WE HAVE RESET PUTCHAR ENVIRONMENT. 
* THIS IS DONE BECAUSE IN THE CASE OF NON-STANDARD DELIMITER
* LOGIC, EVEN IF WE WERE AT MAX STRING LENGTH ON AN -ESC- 
* CHARACTER, WE COME BACK AND HIT PUTCHAR AGAIN TO TRY TO 
* STORE THE CHARACTER THAT FOLLOWS THE -ESC-.  AFTER THIS 
* TRY WE WILL DETECT THAT THE OVERFLOW SWITCH WAS SET EARLIER 
* BECAUSE THE -ESC- WAS BEYOND MAX STRING LENGTH. 
* 
* B3 MUST BE RESET TO ADDRESS OF NEXT WORD IN SPACE 
* EVEN IF WE FAIL TO EXTEND SPACE, BECAUSE STRING MANAGER 
* MAY HAVE MOVED STRING AND WE STILL HAVE TO WRITE ZBD
* USING B3 VALUE. 
* 
* 
* 
* 
* 
*         SAVE NEW TOTAL SPACE LENGTH 
          BX6    X2 
          SA6    SPACELEN        NEW SPACE LENGTH STORED
* 
*         RECALC ADDRESS OF NEXT SPACE WORD 
*         TO BE FILLED. 
          SB3    B3+X1           INDEX + SPACE FWA
* 
*         SAVE POSSIBLY NEW SPACE FWA FOR LATER 
          BX6    X1 
          SA6    SPACEFWA        NEW SPACE FWA STORED 
* 
*         RESTORE SAVED PUTCHAR REG THAT WAS NOT
*         RESTORED BY STRING MANAGER
          SA1    PUTSVX6
          BX6    X1              PUTCHAR X6 (ASSEMBLY WORD) RESTORED
* 
*         SET UP SPACELEN IN X1 FOR PUTCHAR LOOP USE
          BX1    X2              X1 = SPACELEN
* 
* TEST IF CALL TO EXTEND STRING SPACE WAS SUCCESSFUL
          SX4      B0-B2  SET X4 TO NEGATIVE CRT STRING LEN(CHARS)
          IX4    X2+X4           (-CRT STR LEN) + EXTENDED STR SPACE LEN
          ZR     X4,ATMAXLEN     BR, NOT EXTENDED, MUST BE AT MAX STR LE
* 
*FALL THRU, WE HAVE EXTENDED SPACE
          EQ     SPACEFUL        RETURN TO CALLER OF SPACEFUL, TO RESUME
* 
 ATMAXLEN BSS    0
* 
*         STRING EXCEEDS MAX LENGTH 
*         SET OVERFLOW SWITCH 
          MX7    59 
          SA7    OVRSW           OVERFLOW SWITCH TURNED ON
* 
          EQ     PUTCHAR         RETURN TO CALLER OF PUTCHAR
 PUTCHAR  DATA      0 
* 
*         X3 MAY BE HOLDING THE NEXT CHAR 
*         TO BE PROCESSED AFTER THE CHAR IN B4 IS PROCESSED,
*         IF THE CALL TO PUTCHAR CAME FROM NON STANDARD 
*         DELIMITER CHECKING LOGIC. 
* 
* REGS IN USE DURING PUTCHAR LOOP 
*         B2 = STRING LENGTH IN CHARS 
*         B3 = ADDRESS OF NEXT WORD OF TARGET TO BE FILLED
*         B4 = CHARACTER TO BE ASSEMBLED INTO TARGET WORD 
*         B5 = SHIFT COUNT FOR TARGET WORD ASSEMBLY 
*         X6 = INTERIM ASSEMBLY WORD
* 
* 
          SX7    B0-B2           SET X7 TO NEGATIVE CRT STRG LEN (CHARS)
          SA1    SPACELEN    X1 = NUMBER OF CHARS ALLOCATED 
          IX7    X1+X7           ALLOCATED + (-CRT STR LEN) 
          ZR     X7,NOROOM1       BR, STRING FILLS SPACE ALREADY
* 
 PUTRESUM BSS    0
* 
* BRANCH IN, STRING PREVIOUSLY FILLED SPACE, WE GOT MORE
* 
         SB2       B2+1       INCREASE CHAR COUNT 
PUTTERM  BSS       0
          PL   B4,PUT1             SKIP IF 6-BIT CHAR 
          SX7    B2 
          IX7    X7-X1
          ZR     X7,NOROOM2 
* 
 PUTCONT  BSS    0
* 
* BRANCH IN, TO CONTINUE AFTER STRING FILLED ALLOCATED
* SPACE AND WE GOT SOME MORE SPACE. 
* 
          SB2    B2+1              COUNT ONE MORE FOR ASCII CHAR         BAS0009
          SB4    -B4               74XX/76XX
          SX7    B4 
          AX7    6                 74/76
          LX7    B5,X7             POSITION 
          BX6    X6+X7             INSERT 
          SB5    B5-6 
          PL   B5,PUT2             ROOM FOR LOWER HALF
          SA6    B3                STORE FULL WORD
          SB3    B3+1 
          SX6    B0                START NEW WORD 
          SB5    54 
 PUT2     BSS    0
          MX7    54 
          SX3    B4                74XX/76XX
          BX7    -X7*X3            XX 
          SB4    X7 
 PUT1     BSS    0
          SX7       B4
          LX7       B5,X7              POSITION CHARACTER 
          BX6       X6+X7              INSERT 
          SB5       B5-6
          PL        B5,PUTCHAR
          SB5       54
          SA6       B3
          SB3       B3+1
          SX6       B0
          EQ        PUTCHAR 
LEND     SA7       SAVX7
          MX7    60 
          SA7    BASLDMT
         SB7       B7-1 
         SA2       DLMTSW 
         ZR        X2,LEND0A  IF DELIMITER NOT IN EFFECT,BYPASS 
*                            ELSE CHECK IF DELIMITER IS CARRIAGE RETURN 
         SA2       DLMTNO   LOAD DELIMITER COUNT
         BX7       X2 
          SB6    LCR
LEND0B   BSS       0
         SA2       A2+1       LOAD NEXT DELIMITER 
         SB4       X2 
         EQ        B4,B6,QEND  IF DELIMITER IS CARRIAGE RETURN
*                                 DO NOT BACKSPACE OVER TRAILING BLANKS 
         SX7       X7-1 
         NZ        X7,LEND0B   LOOP TO CHECK ALL DELIMITERS 
LEND0A   BSS       0
         SB4       54             .LIMIT FOR SHIFT COUNT
         EQ        B4,B5,LEND2    .TEST IF WORD HAS BEEN FILLED AND STOR
         AX6       6
         MX2       54 
         LX2       54 
         BX6       X2*X6
         AX6       B5,X6          .SHIFT LAST CHARCTER TO RH END
         SB5       B5+6 
LEND7    SX2       77B            .SET MASK FOR RH CHARACTER
LEND4    BX7       X2*X6          .MASK 
         SX7       X7-1R          .BLANK TEST 
         NZ        X7,LEND5       .BRANCH IF NOT BLANK
          SB2    B2-1            REDUCE ITEM CHARACTER COUNT
         EQ        B4,B5,LEND2    .EXIT FROM LOOP IF WHOLE WORD USED
         SB5       B5+6           .INCREMENT
         AX6       6              .SHIFT,LOSE RH CHAR 
         EQ        LEND4          .LOOP 
LEND5    EQ        B5,B0,LEND6    .TEST IF FIRST CHARACTER
*                             ELSE ZERO OUT LOWER PART OF WORD
*                             AS STRING TERMINATOR
         MX2       1          FORM MASK TO EXTRACT CHARACTERS 
         SB5       B5-1       CONVERT TO RIGHT SHIFT COUNT FOR MASK 
         AX2       B5,X2
         BX6       -X2*X6 
         SB5       B5+1       RESET SHIFT COUNT 
         LX6       B5,X6          .SHIFT COMPLETED STRING 
         SA6       B3             .AND STORE AWAY 
          SX2    7777B             CHECK IF HAVE 2 BYTES OF ZEROS 
          BX2    X6*X2                AT END OF WORD
          NZ     X2,LEND6          IF NOT, GO PUT WORD OF ZEROS 
         EQ        LEND9          .EXIT 
LEND6    SX6       B0             .ZERO WORD
         SA6       B3+1           .STORE IN NEXT WORD 
         SB3       B3+1           .INCREMENT TO NEXT FREE 
         EQ        LEND9          .EXIT 
         SX6       B0             .IF STRING ALL BLANKS 
         SA6       B3             .ZERO OUT STRING
         EQ        LEND9          .EXIT 
LEND2    BSS       0
* 
* CHECK IF BACK DOWN STRING TO 1ST WORD 
          SA2    SPACEFWA 
          BX2    -X2             SET X2 TO NEGATIVE SPACEFWA
          SX2    X2+B3           (-SPACEFWA) + CURRENT SPACE ADDRESS
         ZR        X2,BLINE   RESULT IS ALL BLANKS  IE NULL 
         SB3       B3-1       PREVIOUS WORD 
         SA2       B3             .TO X6
         BX6       X2 
         SB5       B0             .ZERO SHIFT COUNT 
         EQ        LEND7
* 
 LEND9    BSS    0
          SA1    INTGTPWA 
          SX2    B2 
          RJ     BASTSTR         TRUNCATE STRING SPACE TO ACTUAL STRING 
* 
          RJ     DROPTBIT        REMOVE TEMPORARY BIT FROM PTR WORD 
         BX7       X2            .AND 
         SX1       B0 
         EQ        SRETN         .EXIT
 QENDB    SB7    B7+1        GET THE NEXT 
          SA1    B7          CHARACTER. 
          SX2    X1-ENDB     IF BUFFER IS 
          NZ     X2,QENDA    EMPTY THEN 
          RJ     SFREAD0     REFILL IT. 
          SB7    B7-1 
 QENDA    SX2    X1-1R       BYPASS ANY BLANKS. 
          ZR     X2,QENDB 
          SX2    X1-LINE     IF ITS A CR
          ZR     X2,QENDC    GO CLEAR THE INDICATOR.
          SA2    DLMTSW 
          NZ     X2,QENDD    NONSTANDARD DELIMITERS, BR.
          SX2    X1-1R,      IF ITS NOT A COMMA 
          NZ     X2,QENDC    GO CLEAR THE INDICATOR.
 QENDE    BX7    X1          SAVE THE 
          SA7    BASLDMT     DELIMITER. 
          EQ     QEND 
 QENDC    MX7    60          CLEAR THE LAST 
          SA7    BASLDMT     DELIMITER INDICATOR. 
          EQ     QEND 
 QENDD    RJ     CHKDLMT     CHECK FOR DELIMITER. 
          NG     X3,QENDC    NO, GO CLEAR INDICATOR.
          EQ     QENDE       YES, GO SAVE INDICATOR.
 QEND     BSS    0
          SA2    OVRSW
          NZ     X2,B4SERR       STRING OVERFLOWED
          SB4    54                STORE TERMINATOR                      BAS0009
          EQ   B4,B5,QEND1         JUMP IF CURRENT WORD EMPTY            BAS0009
          SA6    B3                STORE CURRENT WORD                    BAS0009
          NZ   B5,QEND2            EXIT IF WORD HAD TERMINATOR           BAS0009
          SB3    B3+1              STORE EXTRA ZERO WORD                 BAS0009
          SX6    B0                                                      BAS0009
 QEND1    SA6    B3                STORE ZERO                            BAS0009
 QEND2    BSS    0                                                       BAS0009
          SA1    INTGTPWA 
          SX2    B2              ITEM LEN 
          RJ     BASTSTR         TRUNCATE SPACE TO ACTUAL STRG LEN
* 
          RJ     DROPTBIT        REMOVE TEMPORARY BIT FROM PTR WORD 
* 
          SX1       B0
 SRETN    SA2       FFCHANL 
          SB5       X2
          SA2       B4SAVE
          SB4       X2
          SA2       B3SAVE
         SB2       X2         RESTORE B2
         AX2       18         SHIFT OVER TO B3
          SB3       X2
          JP        BASISTR 
SFREAD0   DATA      0 
          SX7       B5
          SA7       TSAV
          SX7       B3
          SA7       A7+1
          SA6       A7+1
* 
* PROTECT REGS FROM BASICHK CALL
          SX6    B2              B2 - STRING ITEM LENGTH (CHARS)
          SX7    B7              B7 - UNPACK BUFFER POINTER 
          SA6    SFSVB2          B2 SAVED 
          SA7    SFSVB7          B7 SAVED 
* 
*         SET UP B5 TO FET FOR BASICHK
          SA1    FFCHANL
          SB5    X1              B5 = FET 
* 
          RJ     BASICHK         ENSURE AT LEAST A UNPACK BUFFERFUL AVAI
* 
*         RESTORE REGS
          SA1    SFSVB2 
          SA2    SFSVB7 
          SB2    X1              B2 - STRING ITEM LEN(CHARS) RESTORED 
          SB7    X2              B7 - UNPACK BUFFER PTR RESTORED
* 
* 
* SUCCESSIVE EXECUTIONS OF THE
* THE ABOVE LOW LEVEL CALL TO BASICHK ENSURE
* THAT ALL DATA FOR AN ITEM IS PUMPED INTO THE CIO
* BUFFER.  AN INITIAL CALL TO BASICHK OCCURS AT A 
* HIGHER LEVEL OF LOGIC, ONCE FOR EACH INPUT ITEM.
* 
* NOTE THAT THE FET *OUT* POINTER 
* IS NOT UPDATED AFTER
* MOVING DATA FROM CIO BUFFER TO UNPACK BUFFER. 
* 
* THE FET *OUT* POINTER IS NOT UPDATED
* AFTER THE CONTENTS OF THE UNPACK BUFFER ARE 
* PROCESSED.
* 
* THE FET *OUT* POINTER IS UPDATED TO 
* REFLECT THE PREVIOUSLY UNPACKED AND 
* PROCESSED CIO WORDS IN ROUTINE FFREADO
* WHICH IS AT A LOWER LEVEL THAN HERE,
* PRIOR TO THE NEXT -UNPACK- EXECUTION. 
* 
* 
*         CHECK BASICHK STATUS
          EQ     B6,B0,ICHKOK    BR, THERE IS MORE DATA 
* 
* FALL THRU, NO MORE DATA 
          SX1    LINE            X1 SET TO -EOL- CHARACTER
          EQ     SFXT            GO TO SFREAD0 EXIT 
* 
 ICHKOK  BSS    0 
          RJ        FFREAD0 
* 
 SFXT     BSS    0
* 
* BRANCH IN, SFREAD0 CALL TO BASICHK FAILED 
* 
* 
* 
         SA2       TSAV 
          SB5       X2
          SA2       A2+1
          SB3       X2
          SA2       A2+1
          BX6       X2
          JP        SFREAD0 
* 
 DROPTBIT DATA   0
*         KNOCK OUT THE T(TEMPORARY) BIT IN PTR WORD
*         STRING MGR THINKS WE ALWAYS ASK FOR SPACE 
*         FOR A TEMPORARY, BUT THIS TGT IS A VARIABLE.
          SA1    INTGTPWA 
          SA1    X1              X1 = PTR WORD VALUE FOR THE TARGET ITEM
*         CREATE MASK TO KNOCK TBIT OUT 
          SX2    1
          LX2    58              X2 = MASK
          BX6    -X2*X1          X6 = PTR WORD WITHOUT TBIT 
          SA6    A1              PTR WORD W/O TBIT STORED BACK
          EQ     DROPTBIT        RETURN TO CALLER 
* 
          ENTRY  BAAISRT,BABISRT
          EXT    BASICNB,BASRSTR,BASIEND,BASASTR
 BAAISRT  BSSZ   1
          SX6    B2 
          SA6    SVB2IN 
          SX6    B4 
          SA6    SVB4IN 
          SA1    ININPRG
          ZR     X1,BAAISRX 
          RTERROR ERMN195,ERM195,BASEGEN
 BAAISRX  SX6    1           SET THE INPUT IN 
          SA6    A1          PROGRESS FLAG. 
          BX6    X5          SAVE THE FIRST 
          SA6    SVX5IN      WORD OF THE MASK.
          BX6    X4          SAVE THE SECOND
          SA6    A6+1        WORD OF THE MASK.
          RJ     BASISRT     INITIATE THE INPUT 
          SA1    BASICNB
          SA4    X1-1        GET THE MASK FROM
          SA5    A4-1        THE PREVIOUS INPUT 
          SB6    X4 
          SB7    B6-61
          NG     B7,BAAISR1  BRANCH IF LESS THAN 61 ITEMS.
          SA3    X1+59       PRESET A3. 
 BAAISR3  SA3    A3+1        GET NEXT ITEM FROM THE BUFFER. 
          ZR     X3,BAAISR2A BRANCH IF ALREADY ZERO.
          PL     X4,BAAISR2  BRANCH IF ITS A NUMBER.
          SX1    A3 
          RJ     BASRSTR     RELEASE THE STRING.
 BAAISR2  BX6    X6-X6       CLEAR THE
          SA6    A3          ENTRY. 
 BAAISR2A SB7    B7-1 
          LX4    1           ROTATE THE MASK. 
          PL     B7,BAAISR3 
 BAAISR1  SA3    A4          PRESET A3. 
 BAAISR5  LE     B6,B0,BAAISR4
          SA3    A3+1        GET THE NEXT ENTRY FROM THE BUFFER.
          ZR     X3,BAAISR6  BRANCH IF ALREADY ZERO.
          PL     X5,BAAISR6  BRANCH IF ITS A NUMBER.
          SX1    A3 
          RJ     BASRSTR     RELEASE THE STRING.
 BAAISR6  BX6    X6-X6       CLEAR THE
          SA6    A3          ENTRY. 
          SB6    B6-1 
          LX5    1           ROTATE THE MASK
          EQ     BAAISR5
 BAAISR4  SA1    SVX5IN      GET THE CURRENT MASK.
          SA2    A1+1 
          BX6    X2          PLACE SECOND WORD IN BASICNB-1.
          SA6    A4 
          BX6    X1          PLACE FIRST WORD IN BASICNB-2. 
          SA6    A6-1 
          SB4    B0 
          SB3    B0 
          SB1    X2 
          SB2    B1-61
          NG     B2,BAAISR7  BRANCH IF LESS THAN 61 ITEMS.
          SB1    60          LIMIT OF SIXTY WITH 1ST WORD OF MASK.
 BAAISR7  SA1    SVX5IN+B3   GET THE APPROPRIATE WORD OF THE MASK.
          LX1    B4,X1       ROTATE MASK. 
          PL     X1,BAAISR8  BRANCH IF NUMBER.
          SA5    BASICNB     GET TARGET ADDRESS 
          SA5    X5+B4       FOR STRING.
          SX6    B2          SAVE THE NEW VALUES OF B2
          SX7    B4          AND B4 
          SA6    SVB2IN2
          SA7    SVB4IN2
          SA1    SVB2IN      RESTORE OLD B2 
          SA2    SVB4IN      AND B4 
          SB2    X1 
          SB4    X2 
          RJ     BASIINS     READ IN THE STRING.
          SA1    SVB2IN2
          SA2    SVB4IN2
          SB2    X1 
          SB4    X2 
          EQ     BAAISR9
 BAAISR8  SX6    B2          SAVE NEW B2
          SX7    B4          AND B4 
          SA6    SVB2IN2
          SA7    SVB4IN2
          BX6    X6-X6
          SA6    STRINP      CLEAR STRING INDICATOR 
          SA1    SVB2IN 
          SA2    SVB4IN 
          SB2    X1 
          SB4    X2 
          RJ     BASIINP     READ THE NUMBER
          SA1    SVB2IN2
          SA2    SVB4IN2
          SB2    X1 
          SB4    X2 
          SA1    BASICNB
          SA6    X1+B4       STORE IT.
 BAAISR9  SB4    B4+1 
          LT     B4,B1,BAAISR7
          NG     B2,BAAISRA  BRANCH IF NOT TO READ 2ND WORD OF MASK.
          SB1    B2+61       CREATE NEW LIMIT.
          SB3    1           CREATE INCREMENT FOR MASK FETCH. 
          SB2    -B3         MAKE B2 NEGATIVE TO END LOOP.
          EQ     BAAISR7
 BAAISRA  RJ     BASIEND     MAKE SURE THERE ARE NO MORE ITEMS. 
          BX6    X6-X6       CLEAR THE BUFFER 
          SA6    FETROI+B5   INDEX. 
          SA1    SVB2IN 
          SB2    X1 
          SA1    SVB4IN 
          SB4    X1 
          EQ     BAAISRT
 SVX5IN   BSSZ   2           USED TO HOLD THE CURRENT MASK
 SVB2IN   BSSZ   1
 SVB4IN   BSSZ   1
 SVB2IN2  BSSZ   1
 SVB4IN2  BSSZ   1
         EXT    ININPRG 
          ENTRY  BAAIINP,BABIINP
* THIS ROUTINE FETCH A NUMERIC ITEM FROM THE NEXT POSITION IN THE INPUT 
* CONVERSION BUFFER AND LEAVES IT IN X6.
 BAAIINP  BSSZ   1
          SA1    B5+FETROI   GET INDEX INTO CONVERSION BUFFER.
          SA2    BASICNB     GET BASE OF BUFFER.
          IX2    X2+X1
          SA5    X2          GET NEXT ITEM FROM BUFFER. 
          NX6    X5          LEAVE IT IN X6 FOR RETURN
          SX7    X1+1        INCREMENT INDEX. 
          SA7    A1 
          BX7    X7-X7       CLEAR BUFFER.
          SA7    A5 
          EQ     BAAIINP
 BABIINP  BSS    0
          ENTRY  BAAIINS
 BAAIINS  BSSZ   1
          SA2    BASICNB     GET BASE OF CONVERSION BUFFER. 
          SA1    B5+FETROI   GET INDEX INTO BUFFER. 
          IX2    X1+X2
          SA2    X2          GET NEXT ITEM. 
          ZR     X2,BAAIINS2     BRANCH IF NULL STRING
          MX7    1           SET TEMPORARY BIT
          LX7    -1          OF THE SPW 
          BX7    X7+X2       AND REPLACE THE
          SA7    A2          ITEM.
 BAAIINS2 BSS    0
          SB6    A5          SET B6 TO THE TARGET ADDRESS.
          SB7    A2          SET B7 TO THE SOURCE ADDRESS.
          RJ     BASASTR     MOVE THE STRING. 
          SX7    X1+1        INCREMENT THE INDEX. 
          SA7    B5+FETROI
          EQ     BAAIINS
          ENTRY  BAAIEND,BABIEND
 BAAIEND  BSSZ   1
          BX7    X7-X7       CLEAR THE INPUT
          SA7    ININPRG     IN PROGRESS FLAG.
          SA1    BASICNB
          SA7    X1-1        CLEAR THE PREVIOUS MASK. 
          SA7    A7-1 
          EQ     BAAIEND
 BABIEND  BSS    0
          DATA   10HBSTRBUF 
 BSTRBUF  BSSZ      8 
* BSTRBUF IS NOT USED FOR INPUTTING STRING VARIABLES, 
* BUT IT IS USED TO INPUT NUMERIC VARIABLES.  IT IS ALSO
* USED BY BASIEND TO DUMP INPUT IF ANY. 
 SFSVB2   BSSZ   1
 SFSVB7   BSSZ   1
 B4SAVE   DATA       0
 B3SAVE   DATA       0
 TSAV     BSSZ      3 
SAVX7      BSSZ    1
 LINE     EQU       101B
          IFEQ   CHARSET,OLDCSET
QUOT      EQU    60B               CDC, KRONOS QUOTE
 LCR      EQU    66B
          ELSE
QUOT      EQU    64B               ASCII QUOTE
 LCR      EQU    7655B
          ENDIF 
 MAXSTRL EQU    131070          MAX STRING LEN (CHARS)
 INSTRLEN BSSZ   1               INPUT STRING LENGTH
 PUTSVX6  BSSZ   1               PUTCHAR X6 SAVE AREA 
 SPACEFWA BSSZ   1               ASSIGNED SPACE FIRST WORD ADDRESS
 SPACELEN BSSZ   1               ASSIGNED SPACE LENGTH SAVE AREA
* 
 OVRSW    BSSZ   1
 TSAV1    BSS    2
          EJECT 
 BATIINP  BSS       0 
 BABISRT  BSS    0
          TITLE  BASIDEL AND BASIINS
         DATA      10HBASIDEL 
 BASIDEL  BSS    0
*                ON ENTRY B5 POINTS TO THE TARGET FET 
*                         B6=0/1 ACCORDING AS DEFAULT DELIMITERS ARE/ARE
*                         NOT SUBSEQUENTLY REQUIRED.
*                         X5 CONTAINS (WHEN B6=1) THE 42-BIT DELIMITER
*                         DESCRIPTOR. 
* 
*                         PURPOSE: TO SAVE THE DELIMITER DESCRIPTOR IN
*                                  THE UPPER 42 BITS OF FET+FETFNUM.
* 
          JP     0
          NZ   B5,DEL1             JUMP IF FILE ORD WAS NOT ZERO
          SB5    B4+FETCHAN+2      ORD ZERO = JFILE 
 DEL1     BSS    0
          SA1    B5 
          ZR     X1,ER141    *FILE CLOSED/UNDEFINED*
          SA1    B5+FETSTAT 
          SX7    B6 
          UX0    B6,X1
          ZR     B6,DEL 
          LX1    10 
          NG     X1,ER175    *ILLEGAL ACTION ON BINARY FILE*
 DEL      SB6    X7 
          SA1    B5+FETFNUM 
          MX7    42 
          BX7    -X7*X1            CLEAR DELIMITER (TOP 42) BITS
          EQ     B6,B0,CLRDEL      GO REVERT TO DEFAULT DELIMITERS
* 
          BX7    X5+X7             MERGE DESCRIPTOR WITH FILENO 
 CLRDEL   BSS    0
          SA7    A1                AND RESET IN FET 
          EQ     BASIDEL           EXIT 
* 
* 
* 
* 
 BATIDEL  BSS    0
BATIINS   BSS       0 
 BABIINS  BSS    0
* 
*         END STRING INPUT
* 
          TITLE  BASOSET
* 
*                EACH SETDIGITS INSTANCE IN SOURCE GENERATES A CALL 
*                ON BASOSET. SETDGTS HAS A PRESET (DEFAULT) VALUE OF 6. 
*                ON ENTRY X5 HAS THE COMPUTED VALUE FROM THE
*                SET DIGITS EXPRESSION
          EXT    SETDGTS
* 
* 
          DATA   10HBASOSET 
 BASOSET  BSSZ   1
          ID     X5,SETUNDF        TEST FOR UNDEFINED 
          OR     X5,SETINF         OR INFINITE
          SA1    BASANSI
          ZR     X1,OSET2 
          BX6    X6-X6
          PX6    X6 
          RX5    X5+X6       ROUND THE ARG
 OSET2    BSS    0
          NX5    X5,B5             NORMALIZE
          UX6    B6,X5             UNPACK 
          LX6    B6,X6
          NG     X6,SETNG 
          ZR     X6,SETZR          TEST FOR ZERO
          SX5    15 
          IX5    X6-X5
          PL     X5,TOOBIG         SKIP IF .GE. 15
* 
 SETVAL   BSS    0
          SA6    SETDGTS           DUMP THE COMPUTED VALUE
          JP     BASOSET
* 
 SETUNDF  BSS    0                 FORCE
 SETINF   BSS    0                 SETDIGITS
 SETNG    BSS    0                 VALUE TO BE
 SETZR    BSS    0                 1 (FOR THESE INVALID CASES)
          SX6    1
          EQ     SETVAL            REJOIN 
* 
 TOOBIG   BSS    0
          SX6    14                FORCE 14 (MAX. PRACTICAL VALUE)
          EQ     SETVAL            REJOIN 
* 
 BATOSET  BSS    0
          TITLE  BASIRED
*         PROCEDURE READ-BINARY 
* 
 BASIRED  SPACE  4
*         ENTER- B5=FET ADDRESS 
* 
*                X4 = 0/1 FOR REAL/STRING READ RESPECTIVELY 
*                A5 = ADDRESS OF TARGET STRING
* 
* 
* 
*         EXIT X6= WORD READ (IF X4 = 0 ON ENTRY) 
*                STRING IS STORED INTO STRING AREA IF X4 = 1
* 
*         USES   A1,X1,B6,B7,A7,X7,A5,X5,X6,A2,X2,X3
* 
*         CALLS- BASICHK,BASEGEN
  
         DATA      10HBASIRED 
 BASIRED  PS     0
          SA1    FETSTAT+B5 
          SB7    READBIN
          UX0    X1,B6
          ZR     B6,BIR1
          LX1    9                      I/O BIT 
          NG     X1,ER137              MUST BE OFF(137) 
          LX1    1                      BIN/CODED BIT 
          PL     X1,ER137              MUST BE SET (137)
 BIR1     PX7    X0,B7                  SET READ BINARY 
          SA7    A1 
          NZ     X4,STRNRD         SKIP IF ITS READ-STR-FROM-BINFILE
* 
          RJ     RDONEWD           ELSE READ NEXT WORD (LEFT IN X6) 
* 
          EQ     BASIRED           AND EXIT 
* 
 STRNRD   BSS    0                 GETS HERE TO READ STRING FROM BINFILE
          SX6    A5 
          SA6    BSTRPTR     SAVE ADDRESS OF STR POINTER WORD 
          BX1    X6          X1 = ADR OF POINTER
          MX2    59          X2 = -1
          RJ     =XBASGSTR   GET ALL AVAILABLE STR SPACE
          BX6    X2          X6 = AVAIL CHARS (MULTIPLE OF 10)
          SA6    LENGTH      SAVE ORIGINAL LENGTH 
          BX7    X1          X7 = FWA OF STRING 
          SA7    FWA         SAVE ORIGINAL FWA
* 
 STRLOOP  BSS    0
          SA6    STRWNO            SAVE CURRENT COUNT 
          SA7    CURBUFW           SAVE CURRENT ADDRESS 
* 
          RJ     RDONEWD           READ NEXT WORD (INTO X6) 
* 
          SA1    CURBUFW           STRING BUFFER POINTER
          SA6    X1                STORE THE STRING WORD
          ZR     X6,RDONE    TRAILING ZERO WORD READ
          SA2    STRWNO            CURRENT WORD COUNT 
          SX2    X2-10       DECREMENT CHAR COUNT 
          ZR     X2,RDZRWD         SKIP IF ITS ZERO (BUFFER IS FULL)
          SX6    X2 
          SX7    X1+1              UPDATE CURRENT BUFF ADDRESS
          EQ     STRLOOP           GO GET NEXT WORD 
* 
 RDONE    BSS    0
          SA1    X1-1        FETCH PREVIOUS STORED WORD 
          SB7    -1 
          MX5    6
 RDONE1   SB7    B7+1        B7 = NUMBER OF TRAILING ZERO CHARS 
          LX5    6    MOVE MASK 1 CHAR
          BX6    X1*X5
          ZR     X6,RDONE1
* 
          SA2    STRWNO      X2 = CHARS LEFT IN BUFFER
          SA5    LENGTH      X5 = BUFFER LENGTH 
          IX2    X5-X2
          SX1    B7          MOVE B7 TO X1 FOR SUBTRACTION
          IX2    X2-X1       X2 = CHARS OF DATA STORED
          SA1    BSTRPTR     X1 = ADDRESS OF POINTER
          RJ     =XBASTSTR   TRUNCATE STRING TO X2 CHARS
* 
          SA1    BSTRPTR
          SA5    X1          X5 = POINTER WORD
          MX6    1
          LX6    59          MASK FOR TEMP BIT
          BX6    -X6*X5      CLEAR TEMP BIT 
          SA6    A5          RESTORE POINTER
          EQ     BASIRED     EXIT 
* 
 RDZRWD   BSS    0
          SA1    BSTRPTR     X1 = ADDRESS OF POINTER
          MX2    59          X2 = -1
          RJ     =XBASESTR   GO EXTEND STRING BY ALL AVAILABLE
          SA5    LENGTH      X5 = OLD LENGTH
          BX7    X2          X7 = NEW LENGTH (MULTIPLE OF 10) 
          SA7    A5          SAVE NEW LENGTH
          IX6    X2-X5       X6 = NEW - OLD = CHARS REMAINING 
          ZR     X6,ER168    *STRING OVERFLOW* COULDN'T EXTEND
          SA5    FWA         X5 = OLD FWA 
          BX7    X1 
          SA7    A5          SAVE NEW FWA 
          SA2    CURBUFW     X2 = LAST USED ADDRESS 
          IX5    X2-X5       X5 = WORD STORED -1
          IX7    X5+X1       X7 = NEW LAST USED ADDRESS 
          SX7    X7+1        X7 = NEXT AVAILABLE ADDRESS
          EQ     STRLOOP
* 
* 
 RDONEWD  BSS    0
          JP     0
          RJ     =XBASICHK
          NZ     B6,BIR4     IF EOR READ
 BIR2     SA1    FETOUT+B5   *OUT*
          SA5    X1          LOAD WORD
          BX6    X5          SET OUTPUT VALUE 
          SX7    X1+1        ADVANCE OUT
          SA2    FETLIMT+B5  *LIMIT*
          SX2    X2 
          IX3    X7-X2
          SA7    A1          *OUT* +1 STORED
          SA2    FETLOFC+B5 
          SX7    1
          IX7    X7+X2
          SA7    A2                UPDATE LOC (CURRENT FILE POSITION) 
          NZ     X3,RDONEWD        EXIT IF NO WRAP-AROUND 
          SA2    FETFRST+B5 
          SX7    X2 
          SA7    A1 
          EQ     RDONEWD           EXIT 
  
  
 BIR4     SA1    FETIN+B5    *IN* 
          SA2    FETOUT+B5   *OUT*
          IX1    X1-X2
          NZ     X1,BIR2     IF NOT EMPTY 
          EQ     ER136       *END OF DATA ON FILE*
 STRWNO   BSSZ   1                 CURRENT (WORD) POINTER TO BSTRBUF
 CURBUFW  BSSZ   1                 CURRENT WORD COUNT 
 BSTRPTR  BSSZ   1
 LENGTH   BSSZ   1
 FWA      BSSZ   1
 BATIRED  BSS       0 
 BATIRD0  BSS    0
* 
*         END READ-BINARY 
* 
          TITLE  BASINOD
* 
*         PROCEDURE NODATA
* 
          DATA      10HBASINOD
 BASINOD  SPACE  4
*         ENTER- B5 = FET ADDRESS 
* 
*         EXIT-  X5 = 0 (IF DATA AVAILABLE) 
*                X5 = NEG (IF NO DATA LEFT) 
* 
*         USES   A1,X1,A2,X2,A4,X4,A5,X5,A6,X6,A7,X7,B7,B6
* 
*         CALLS- BASEGEN,BASICHK,BASIREW
  
 BASINOD  PS     0
          NZ   B5,NOD1             JUMP IF FILE ORD WAS NOT ZERO
          SB5    B4+FETCHAN+2      ORD ZERO = JFILE 
 NOD1     BSS    0
          SA1    B5                     FET+0 
          ZR     X1,ER141    *FILE CLOSED/UNDEFINED*
          SA1    FETSETV+B5  CHECK IF -SET- DUE 
          NG     X1,CHKLOF   SKIP IF SO (RANDOM FILE) 
          LX1    1           CHECK IF SET PAST
          NG     X1,CHKLOF   SKIP IF SO (RANDOM FILE) 
          SA1    FETSTAT+B5 
          UX0    X1,B6
          SX5    B0 
          LX0    59-18       INTERACTIVE BIT
          NG     X0,BASINOD  ALWAYS DATA ON INTERACTIVE FILE
          LX1    9                      I/O BIT 
          PL     X1,BND1                LAST FUNCTION WAS NOT WRITE 
          MX5    1                      RETURN NO DATA
          EQ     BASINOD
  
 BND1     NZ     B6,BND2     IF NOT NEUTRAL 
          SA1    FETSTAT+B5 
          SB7    READBIN
          PX7    X1,B7
          SA7    A1          SET READ MODE
          SA4    B5+FETIN     SAVE THE IN AND OUT POINTERS BECAUSE
          SA5    B5+FETOUT    BASICHK MAY DO A READ OF THE FILE FOR 
          BX6    X4           CASES SUCH AS AN EMPTY FILE AT BOI. IN
          BX7    X5           THAT CASE THE BUFFER WOULD BE EMPTY BUT 
          SA6    SAVEIN       THE EOR BIT MIGHT NOT BE SET. 
          SA7    SAVEOUT
          RJ     =XBASICHK
          SX6    B6          SAVE THE FLAG RETURNED FROM BASICHK
          SA6    SAVEB6      BECAUSE BACKSPACE MAY WIPE IT OUT
          BKSP   B5,R        BACKSPACE--RETURN FILE TO INITIAL STATUS 
          SA4    SAVEIN      RESET THE FETIN AND FETOUT POINTERS TO 
          SA5    SAVEOUT     THEIR VALUES BEFORE BASICHK WAS CALLED.
          BX6    X4          SINCE THE STATUS IS NEUTRAL, THE BUFFER
          BX7    X5          MUST BE SET TO WHAT IT WAS BEFORE THE READ 
          SA6    B5+FETIN 
          SA7    B5+FETOUT
          SA4    SAVEB6      RESET THE BASICHK FLAG 
          SB6    X4 
          SA1    B5+FETSTAT 
          PX7    X1 
          SA7    A1 
 BINEOR   SX5    B0                FOR BINARY CASE, USE BASICHK STATUS
          ZR     B6,BASINOD        IF B6=0, RETURN EOR (X5=0) 
          MX5    1                 ELSE, NOT EOR (X5 = NEG) 
          EQ     BASINOD
  
 BND2     BSS    0
          RJ     BASISRT           SET UP DELIMITERS IF NEEDED
          SA1    FETSTAT+B5 
          LX1    10                BIN/CODED BIT
          PL     X1,BND3                IT IS CODED 
          RJ     =XBASICHK
          EQ     BINEOR 
BND3     SX6       -1 
         RJ        BASISCN
* 
* CHECK TO SEE IF ANY VALID DATA REMAINING ON FILE
* 
 BND4     MX5    1                 SET NO DATA FLAG 
          NZ     B6,BASINOD        BR, AT EOR - NO MORE DATA
          SA1    B5+FETCHAR        GET CURRENT FETCHAR OFFSET 
          SA2    B5+FETOUT         GET CURRENT OUT POINTER
          BX6    X1 
          BX7    X2 
          SA6    SAVCHAR           SAVE CURRENT FETCHAR OFFSET
          SA7    SAVOUT            SAVE CURRENT OUT POINTER 
          SX7    B0                INITIALIZE BLANK COUNT 
  
* CHECK IF DELIMIT (CR) IS IN EFFECT. IF SO, THEN A BLANK CONSTITUTES 
* VALID DATA. IF X0=0, THEN BLANK IS NOT VALID DATA. IF X0=-1, THEN 
* A BLANK IS VALID DATA.
  
          SX6    B0 
          SA6    CRFLAG      *CARRIAGE RETURN IS EXPLICIT DELIMITER* FLG
          SA1    DLMTSW 
          ZR     X1,MORE1    BR, STANDARD DELIMITERS ARE IN EFFECT
          SX1    LCR         X1 = (CR)  -- AS STORED IN CHKDLMT 
          RJ     =XCHKDLMT
          NG     X3,MORE1    BR, DELIMIT (CR) NOT IN EFFECT 
          SX6    -1          SET DELIMIT (CR) FLAG
          SA6    CRFLAG 
  
 MORE1    SX5    B0                SET DATA AVAIL FLAG
          SA1    B7                GET NEXT CHAR FROM BUFFER
          SB7    B7+1 
          SX2    ENDB              X2 = END-OF-BUFFER 
          IX2    X2-X1
          ZR     X2,GETM           BR, FILL UNPACK BUFFER 
          SX2    LINE              X2 = END-OF-LINE 
          IX2    X2-X1
          ZR     X2,ATEOL           BR, AT EOL
          SA2    CRFLAG      CHECK IF DELIMIT (CR) IN EFFECT
          NG     X2,DONE     BR, BLANKS ARE VALID DATA -- THERE IS MORE 
          SX2    1R                X2 = BLANK 
          IX2    X2-X1
          NZ     X2,DONE           BR, VALID DATA ON FILE 
          SX7    X7+1              INC BLANK COUNT
          SX2    640D              CHECK UP TO 640 BLANKS 
          IX2    X2-X7
          NZ     X2,MORE1          BR, GET NEXT CHAR
 DONE     SA1    SAVCHAR           RETRIEVE FETCHAR OFFSET
          SA2    SAVOUT            RETRIEVE OUT POINTER 
          BX6    X1 
          BX7    X2 
          SA6    B5+FETCHAR        RESTORE PROIR FETCHAR OFFSET 
          SA7    B5+FETOUT         RESTORE PRIOR OUT POINTER
          EQ     BASINOD           EXIT 
 ATEOL    SX6    B0                RESET FETCHAR
          SA6    B5+FETCHAR 
          SX6    1
          SA1    B5+FETOUT         GET CURRENT OUT POINTER
          IX6    X6+X1             UP OUT POINTER 
          SA2    B5+FETLIMT 
          SX2    X2 
          IX2    X2-X6       LIMIT-OUT
          NZ     X2,ATEOL1   IF NOT AT LIMIT YET
          SA2    B5+FETFRST 
          SX6    X2 
 ATEOL1   BSS    0
          SA6    A1 
          SB7    INPBUFF           RESET CHAR BUFFER POINTER
 GETM     RJ     SFREAD0           FILL CHAR UNPACK BUFFER
          MX5    1                 SET NO DATA FLAG 
          SX2    LINE              X2 = END-OF-LINE 
          IX2    X2-X1
          NZ     X2,MORE1           BR, GET NEXT CHAR 
          JP     DONE              EXIT 
 SAVCHAR  DATA   0
 SAVOUT   DATA   0
 CRFLAG   BSSZ   1           CARRIAGE RETURN IS AN EXPLICIT DELIMITER 
*                            I.E. DELIMIT (CR) IS IN EFFECT.
*                            0 = NOT IN EFFECT
*                            NEG = DELIMIT (CR) IS IN EFFECT
  
  
 CHKLOF   BSS    0
  
          SA1    FETLOFC+B5 
          LX1    30 
          MX0    30 
          BX0    -X0*X1      PICK UP -LOF- VALUE (IF ANY) 
          ZR     X0,USECHK         SKIP IF NOT YET FOUND
  
          MX5    0           ASSUME MORE DATA ON FILE 
  
          LX1    30 
          MX2    30 
          BX1   -X2*X1
  
          IX1    X1-X0       CHECK IF LOC .LT. LOF
          NG     X1,BASINOD  EXIT IF SO (MORE DATA TO COME) 
  
          MX5    1
          EQ     BASINOD     EXIT  (DATA EXHAUSTED) 
  
  
  
 USECHK   BSS    0
  
          SA1    FETSETV+B5 
          LX1    1           CHECK IF -SET DONE-
          NG     X1,GOCHK    SKIP IF SO TO USE BASICHK
  
          RJ      BASIRD0    ELSE POSITION THE FILE VIA THE SET VALUE 
  
 GOCHK    BSS    0
          RJ     BASICHK     CHECK IF FILE DATA IS EXHAUSTED
          EQ     BINEOR            JOIN THE SEQUENTIAL CASE (BIN) 
*         END NODATA
 SAVEIN   BSSZ   1           SAVE THE FETIN POINTER 
 SAVEOUT  BSSZ   1           SAVE THE FETOUT POINTER
 SAVEB6   BSSZ   1           SAVE THE FLAG RETURNED FROM BASICHK
* 
          TITLE  BASAPND
  
          DATA   10HBASAPND 
  
  
***       BASAPND ENABLES DATA TO BE APPENDED TO AN EXISTING NON-EMPTY
***       FILE AND SETS THE FILE STATUS TO WRITE SEQUENTIAL 
* 
* 
*         ENTRY  (B5) = ADDRESS OF THE FILE FET 
* 
*         EXIT   FETSETV (B57) IS SET ON TO INDICATE AN APPEND-TYPE FILE
* 
*         USES   X  1  2      6  7
*                B            6  7
* 
* 
* 
  
  
 BASAPND  BSS    0
          PS     0
          NZ   B5,APND1            JUMP IF FILE ORD WAS NOT ZERO
          SB5    B4+1              ORD ZERO = KFILE 
 APND1    BSS    0
          SA1    B5 
          ZR     X1,ER141    *FILE CLOSED/UNDEFINED*
          SA1    FETSETV+B5 
          LX1    1
          NG     X1,APPRNDM  SKIP IF FILE IS RANDOM 
  
          SA1    FETFRST+B5 
          SX6    X1          PRESERVE B0-17 
          SA6    A1          REPLACE IN FET 
          SA1    FETSTAT+B5 
          SB7    WRITFUN     DEFAULT TO BCD 
          UX6    X1,B6
          ZR     B6,APNEUT
          LX1    8
          PL     X1,APNEUT         NO ACTIVITY ON THIS FILE YET 
          LX1    1
          NG     X1,BASAPND             EXIT IF ALREADY WRITE 
*                                       SEQUENTIAL (BCD OR BINARY)
 APNEUT   BSS    0
  
  
 APNDSEQ  BSS    0
  
          RJ     GETLOF      GET LOF (AND POSITION FILE AT EOI) 
  
          SA1    SAVERSA     RSA AT WHICH RANDOM READ JUST TOOK PLACE 
          LX1    36 
          BX6    X1 
          SA6    FETROI+B5   MOVE IT TO THE FET (USED LATER BY BASOCHK) 
  
          SA1    FETSTAT+B5 
          SB7    WRITBIT
          PX7    X1,B7
          SA7    A1          FORCE THE -WRITE- BIT ON 
          SA1    FETLOFC+B5 
          AX1    30 
          BX6    X1 
          SA6    A1          MOVE LOF TO LOC (AND CLEAR LOF)
          MX0    IOFLAGS
          SA2    FETSETV+B5 
          BX6    -X0*X2      DROP IO SET FLAGS
          MX0    1
          LX0    57          APPEND AND EMPTY FLAG
          ZR     X1,APNDX2
          LX0    1           APPEND FLAG
 APNDX2   BSS    0
          BX6    X6+X0
          SA6    A2 
          SX6    0
          SA6    FETCHAR+B5  CLEAR LINE LENGTH
  
          EQ     BASAPND
  
  
  
  
 APPRNDM  BSS    0           APPEND APPLIED TO A RANDOM FILE
  
          MX0    30 
          SA1    FETLOFC+B5 
          BX1    X0*X1       PICK OFF THE LOF VALUE (IF ANY)
          NZ     X1,GOTLOF   SKIP IF ALREADY DETERMINED 
  
          RJ     GETLOF      GET LOF (AND POSITION THE FILE AT EOI) 
          SA1    FETLOFC+B5 
  
 GOTLOF   BSS    0
          AX1    30 
          BX7    X1 
          SA7    A1          ADOPT THE PRE-APPEND VALUE OF LOF AS THE 
*                            INITIAL VALUE OF LOC BEFORE APPENDING DATA 
  
  
          SA1    B5 
          BX2    X1 
          LX1    59-EOIBIT    CHECK IF EOI WAS MET DURING THE MOST
*                             RECENT READ 
          NG     X1,RNDMEOI  SKIP IF IT WAS 
          LX2    59-EOFBIT   ALSO CHECK IF EOF MET
          NG     X2,RNDMEOF 
          SA1    FETROI+B5
          PL     X1,BUFFRD   SKIP IF THE BUFFER WAS READ ONLY 
  
          SB7    B0          SPECIFY NO EOR 
  
          RJ     RNDMWR      REWRITE THE BUFFER 
  
          SA1    FETROI+B5
          MX7    1
          BX7    -X7*X1      DROP -BUFFER WAS ALTERED- FLAG 
          SA7    A1          REPLACE IN THE FET 
  
  
 BUFFRD   BSS    0
  
  
          EQ     APNDSEQ     JOIN STANDARD APPEND HANDLING
  
  
 RNDMEOF  BSS    0
 RNDMEOI  BSS    0
  
  
          MX7    1
          LX7    58 
          SA7    FETSETV+B5  FORCE -APPEND- FLAG
  
          SA1    FETROI+B5
          MX0    42 
          BX6    -X0*X1      -IN- AS AT LAST READ 
          AX1    18 
          BX7    -X0*X1      -OUT- AS AT LAST READ
  
          SA6    FETIN+B5    MOVE TO THE FET
          SA7    FETOUT+B5
  
  
  
          SA1    FETSTAT+B5 
          UX7    X1,B6
  
          SB7    WRITBIN
          PX7    X7,B7
          SA7    A1          FORCE BINARY WRITE STATUS
  
  
          EQ     BASAPND     EXIT 
  
  
BATINOD  BSS       0
          TITLE  BASOCLO
  
  
  
          DATA   10HBASOCLO 
 BASOCLO  BSS    0
  
* 
* 
*     BASOCLO REWINDS THE FILE AND REMOVES THE ORDINAL FROM THE FET 
  
  
* 
*         ENTRY  (X5) = SPECIFIED FILE ORDINAL
* 
* 
* 
  
  
  
          PS     0
  
  
          RJ     CHFLNO      CHECK VALIDITY OF FILE ORDINAL 
          ZR   X5,BASOCLO          IGNORE IF ORDINAL ZERO 
          RJ     FETADDR                CHECK IF FILE NO IS IN USE
          NG     X1,ER141    *FILE CLOSED/UNDEFINED*
  
          RJ     =XBASIREW   REWIND THE FILE (ALWAYS) 
  
          MX0    FILNMSK
  
          SA1    B5+FETFNUM 
          SX6    X1          B17 - 0 CONTAIN FILENO 
          BX7    X7-X7
          SA7    A1          CLEAR FILENO AND DELIMITERS IN FET 
          SA1    B5+FETSTAT 
          LX1    59-CLSBIT
          SA2    B5 
          BX7    X0*X2
          SX2    1
          BX7    X7+X2
          SA7    A2 
          PL     X1,CLX1                FILE NOT CLOSEABLE
  
          LX6    60-FILNMSK  FORM A DUMMY FILENAME (USING FILENO) 
          BX6    X6+X2
          SA6    A2          REPLACE IN FET 
          SA1    A2+FETSTAT        FETCH FET STATUS WORD
          MX0    1                 SET WRITE LOCKOUT MASK 
          LX0    -13               POSITION WRITE LOCKOUT MASK BIT
          BX6    -X0*X1            CLEAR WRITE LOCKOUT BIT
          SA6    A1                REPLACE FET STATUS WORD
  
 CLX1     BSS    0
          SA1    B5+FETSTAT 
          UX1    B6,X1
          PX7    B0,X1       SET FET BASIC STATUS NEUTRAL 
          SA7    A1 
  
          SA1    B5+FETFRST 
          SX7    X1 
          SA7    A1+1        MOVE -FIRST- TO -IN- AND 
          SA7    A1+2        -OUT-
  
  
          MX6    0
          MX7    0
          SA6    B5+FETSETV  CLEAR -SET- VALUE (IF ANY) 
          SA7    B5+FETLOFC  CLEAR -LOC- AND -LOF- (IF ANY) 
          SA1    DEFMARG     RESTORE THE DEFAULT MARGIN 
          BX7    X1 
          SA7    B5+FETLINL 
  
          EQ     BASOCLO     EXIT 
  
 DEFMARG  VFD    30/7,30/5    DEFAULT MARGINS 
 BATOCLO  BSS    0
          TITLE  BASFSET
          DATA   10HBASFSET 
* 
* 
****             BASFSET UPDATES A WORD POINTER TO A SPECIFIED BINARY 
**               BASIC FILE 
* 
*                ENTRY (X5) = SPECIFIED SET VALUE 
*                      (B4) POINTS TO THE ASSOCIATED FET
* 
* 
*                EXIT THE SET VALUE IS TRUNCATED AND UNFLOATED AND
*                     STORED IN THE ASSOCIATED FET AT FETSVAL; THE
*                     RANDOM BIT IN THE FET IS ALSO TURNED ON 
* 
*                USES X  0  1  2  5  6  7 
*                     B  6  7 
* 
* 
* 
 BASFSET  BSS    0
          BSSZ   1
          ID     X5,ER172    *ILLEGAL SET VALUE*
          OR     X5,ER172 
          SA1    BASANSI
          ZR     X1,FSET2 
          BX7    X7-X7
          PX7    X7 
          RX5    X5+X7       ROUND THE ARG
          NX5    X5 
 FSET2    BSS    0
          NG     X5,ER172 
          ZR     X5,ER172 
          ZR   B5,ER138            JUMP IF FILE ORDINAL WAS ZERO
          SA1    B5                     FET+0 
          ZR     X1,ER141    *FILE CLOSED/UNDEFINED*
          SA1    FETSTAT+B5 
          UX0    B6,X1
          EQ     B6,B0,FTYPOK      OK IF REWOUND
          LX1    10                     BIN/CODE BIT
          PL     X1,ER171    *ILLEGAL ACTION ON CODED FILE* 
          SA2    FETSETV+B5 
          LX2    2                      CHECK APPEND FLAG 
          NG     X2,APPNDF              SKIP IF FILE IS BEING APPENDED T
          SA2    FETFRST+B5 
          LX2    59-47                  CHECK RANDOM FLAG 
          NG     X2,FTYPOK              SKIP IF ALREADY RANDOM
  
          LX1    59                     I/O BIT 
          PL     X1,FTYPOK              READBIN 
          LX1    59 
          PL     X1,ER171    *ILLEGAL ACTION ON CODED FILE* 
  
*                FLUSH THE BUFFER (BINARY SEQUENTIAL WRITE FILE)
  
          BX7    X5 
          SA7    SAVX5             SAVE THE SET VALUE 
  
          RJ     BASOCLS           WRITE THE FINAL BUFFER (WITH AN EOR) 
  
          SA5    SAVX5             RELOAD THE SET VALUE 
  
 FSET1    BSS    0
          MX0    30 
          SA1    FETLOFC+B5 
          BX7    -X0*X1      PICK OUT LOC AND 
          LX7    30          ADOPT IT AS LOF
          SA7    A1                     REPLACE IN THE FET
  
 FTYPOK   BSS    0
          SA1    FETSTAT+B5 
          MX0    1
          LX0    50 
          BX7    X0+X1                  SET BINARY MODE 
          SA7    A1 
          NX5    X5,B6
          UX6    B6,X5             UNPACK 
          LX6    B6,X6
  
          SX5    1                 FOR BASE 1 
          IX6    X6-X5             X6 = NEW LOC VALUE 
          SA6    NEWLOC            SAVE NEW VALUE OF LOC
  
          SA1    FETLOFC+B5 
          BX7    X1 
          SA7    OLDLOFC           SAVE OLD VALUE OF FETLOFC
  
          MX0    30 
          BX1    X0*X1             X1 = LOF IN UPPER 30 BITS
          AX1    30                X1 = LOF IN LOWER 30 BITS
          NZ        X1,CHKLIM      BR, LOF NOT EQUAL ZERO 
  
* CHECK IF THIS IS AN EMPTY RANDOM FILE 
  
          SA6    A1                RESET NEW LOC VALUE IN FET FOR GETLOF
          RJ     GETLOF 
          SA1    FETLOFC+B5  X1 = NEW VALUE OF FETLOFC
  
          SA2    OLDLOFC     RESET OLD VALUE OF LOF AND LOC IN FETLOFC
          BX7    X2          THIS IS DONE INCASE OF ER173 OR ER174 AND
          SA7    A1          ON ERROR IS IN EFFECT. 
  
          MX0    30          MASK OF LOC VALUE
          BX1    X0*X1       X1=NEW LOF IN UPPER 30 BITS
          AX1    30          X1=NEW LOF IN LOWER 30 BITS
  
          ZR     X1,ER173    *RANDOM FILE EMPTY*
  
          SA2    NEWLOC 
          BX6    X2          COPY NEW LOC TO X6 
  
* CHECK IF NEW LOC VALUE IS BEYOND EOF
  
 CHKLIM   BSS    0
          IX5    X1-X6       X1 = CORRECT VALUE OF LOF, X6 = NEW LOC
          NG     X5,ER174    *RANDOM ACTION BEYOND EOF* 
          ZR     X5,ER174 
  
* SET FETLOFC TO THE CORRECT(POSSIBLY NEW) VALUE OF LOF AND THE NEW 
* VAULE OF LOC
  
          LX1    30          SHIFT X1(LOF)TO UPPER 30 BITS
          BX7    X1+X6       MERGE CORRECT LOF AND NEW LOC
          SA7    A1          RESET IN FETLOFC 
  
          MX5    1
*         WE LEAVE SET DONE BIT ON IF IT IS ALREADY ON, ON THE
*         ASSUMPTION IT IS ONLY USED BY OTHER ROUTINES TO 
*         INDICATE THAT A RANDOM READ OR WRITE WAS
*         PERFORMED ON THE FILE.
* 
          SA1    FETSETV+B5 
          LX1    1           ISOLATE SET DONE FLAG
          PL     X1,NOSETDON BRANCH IF SET DONE NOT PREVIOUSLY SET
          MX5    2           PRESET SET PENDING AND SET DONE FLAGS ON 
 NOSETDON BX6    X6+X5       TURN ON SET PENDING (AND SET DONE IF ON BEF
          SA6    FETSETV+B5        RECORD THE SET FILE VALUE
          SA1    FETFRST+B5 
          MX7    1
          LX7    48                RANDOM BIT 
          SX6    FETLEN 
          LX6    18                (FET LENGTH - 5) TO B23-18 
          BX6    X6+X7
          BX6    X1+X6
  
          MX0    1
          LX0    45                ERROR PROCESSING BIT B44 
          BX6    X0+X6             MERGE
  
          SA6    A1                REPLACE IN FET+1 
  
          EQ     BASFSET           EXIT 
  
  
 APPNDF   BSS    0
  
          BX7    X5 
          SA7    SAVX5       SAVE THE SET VALUE 
  
          SA1    FETOUT+B5
          LX1    18 
          SA2    FETIN+B5 
          IX1    X1+X2       ADJOIN -IN- AND -OUT-
  
          SA2    FETROI+B5
          MX0    60-36
          BX6    X0*X2       DROP OLD -IN- AND -OUT-
          IX6    X6+X1       INSERT CURRENT -IN- AND -OUT-
          SA6    A2          IN THE FET 
  
  
          SB7    1           SPECIFY WRITE WITH EOR 
          RJ     RNDMWR      OUTPUT THE SPLICED (OLD AND NEW DATA) BUFFR
  
  
          SA5    SAVX5       RELOAD THE SET VALUE 
  
          EQ     FSET1       REJOIN SET VALUE PROCESSING
  
* 
  
 SAVX5    BSSZ   1
 NEWLOC   BSSZ   1           NEW SET VALUE (LOC VALUE)
 OLDLOFC  BSSZ   1           VALUE OF LOF AND LOC ON ENTRY TO BASFSET 
          TITLE  BASILOC
          DATA   10HBASILOC 
* 
* 
**               RETURNS THE CURRENT (WORD) POSITION FOR THE BINARY 
**               FILE SPECIFIED BY LOC
* 
* 
*                ENTRY (X5) = FILE ORDINAL
* 
*                EXIT (X5) = CURRENT FILE POSITION AS A RELATIVE
*                            WORD ADDRESS 
* 
* 
  
 BASILOC  BSS    0
          BSSZ   1
          ZR     X5,ER138    *ILLEGAL FILE NO*
  
  
          SX7    B5 
          SA7    B5SAVE            PRESERVE B5 (FET POINTER)
  
          RJ     CHFLNO            CHECK AND UNFLOAT THE FILE NUMBER
  
          RJ     FETADDR           FIND THE FET ADDRESS 
          NG     X1,ER141    *FILE CLOSED/UNDEFINED* (141)
          SA1    B5 
          ZR     X1,ER141    *FILE CLOSED/UNDEFINED*
          SA1    FETSTAT+B5 
          UX0    X1,B6
          ZR     B6,FISNEUT             NEUTRAL 
          LX1    8                      ACTION BIT
          PL     X1,FISACT
          LX1    2                      BIN/CODED BIT 
          PL     X1,ER171    *ILLEGAL ACTION ON CODED FILE* 
          EQ     FISBIN 
 FISACT   BSS    0
          LX1    60-8                   RESTORE X1
 FISNEUT  MX0    1
          LX0    60-10
          BX7    X1+X0                  SET BIN/CODED BIT 
          SA7    A1 
 FISBIN   BSS    0
          SA1    FETLOFC+B5        LOC VALUE IS IN B29-0
          MX5    30 
          BX5    -X5*X1            EXTRACT LOC
          SX1    1                 FOR BASE 1 
          IX5    X5+X1
          PX5    B0,X5             PACK 
          NX5    B6,X5
  
          SA1    B5SAVE 
          SB5    X1                RELOAD B5
  
          EQ     BASILOC           EXIT WITH (X5) = LOC 
  
  
  
  
 B5SAVE   BSSZ   1
  
  
 BATILOC BSS    0 
          TITLE  BASILOF
          DATA   10HBASILOF 
  
* 
* 
**               RETURNS THE LENGTH (IN WORDS) OF THE BINARY FILE 
**               SPECIFIED BY THE LOF FUNCTION PARAMETER
* 
*                ENTRY (X5) = FILE ORDINAL
* 
*                EXIT (X5) = FILE LENGTH
* 
* 
* 
 BASILOF  BSS    0
          BSSZ   1
          ZR     X5,ER138    *ILLEGAL FILE NO*
  
  
          SX7    B5 
          SA7    B5SAVE 
  
          RJ     CHFLNO            CHECK AND UNFLOAT THE FILE NUMBER
  
          RJ     FETADDR           FIND THE FET ADDRESS 
          NG     X1,ER141    *FILE CLOSED/UNDEFINED* (141)
  
          SA1    B5 
          ZR     X1,ER141    *FILE CLOSED/UNDEFINED*
          SA1    FETSETV+B5 
          LX1    2                      CHECK APPEND FLAG 
          NG     X1,FILAPND             SKIP IF FILE IS BEING APPENDED T
          SA1    FETSTAT+B5 
          UX0    X1,B6
          ZR     B6,FILNEUT             NEUTRAL 
          LX1    8                      ACTION BIT
          PL     X1,FILACT
          LX1    2                      BIN/CODED BIT 
          PL     X1,ER171    *ILLEGAL ACTION ON CODED FILE* 
          LX1    60-1 
          PL     X1,FILBIN              READBIN 
  
          SA1    FETSETV+B5 
          NG     X1,FILBIN         BR IF SET PENDING (FILE IS RANDOM) 
          LX1    1
          NG     X1,FILBIN         SKIP IF SET OCCURRED (FILE IS RANDOM)
  
*                WHEN THE FILE IS A SEQUENTIAL WRITE FILE , LOF BECOMES 
*                EQUAL TO THE CURRENT LOC.
  
 FILAPND  BSS    0
          SA1    FETLOFC+B5 
          MX0    30 
          BX1    -X0*X1            SAVE LOC VALUE 
          BX7    X1 
          LX7    30                MOVE IT INTO LOF FIELD 
          BX7    X1+X7             MERGE LOC AND LOF
          SA7    A1                RESET IN THE FET 
  
          PX5    X1,B0             FLOAT
          NX5    B6,X5             NORMALIZE
          EQ     LOFEXIT
  
 FILACT   BSS    0
 FILNEUT  BSS    0
 FILBIN   BSS    0
          SA1    FETLOFC+B5        BITS 59-30 CONTAIN LOF 
          MX5    30 
          AX1    30 
          BX5    -X5*X1 
          ZR     X5,FINDLOF        SKIP IF FILE LENGTH NOT YET FOUND
          PX5    B0,X5             FLOAT LOF VALUE
          NX5    B6,X5             NORMALIZE
          EQ     LOFEXIT           GO RELOAD B5 
  
 FINDLOF  BSS    0
          SA1    FETSTAT+B5 
          BX7    X1 
          SA7    SAVSTAT           SAVE THE CURRENT STATUS
  
          SA1    FETLOFC+B5 
          BX7    X1 
          SA7    SAVLOFC           SAVE CURRENT LOC 
  
          RJ     GETLOF      GET THE VALUE OF LOF 
          EQ     LODSTAT
  
  
  
***       GETLOF DETERMINES THE VALUE OF LOF (VIA A READ AT EOI) AND
*         MOVES IT TO FETLOFC+B5
* 
* 
*         ENTRY  (B5) = FET ADDRESS 
* 
*         EXIT   (X7) = LOF 
* 
* 
* 
  
 GETLOF   BSS    0
          PS     0
  
          SA1    FETSTAT+B5 
          UX1    X1,B6
          LX1    59-18       INTERACTIVE BIT
          NG     X1,GETLOF   EXIT IF INTERACTIVE
          EQ     B0,B6,FILREWD     SKIP IF NEUTRAL E.G. REWOUND 
  
  
          SA1    FETSETV+B5 
          LX1    1
          PL     X1,FNOTSET        SKIP IF SET DID NOT OCCUR
  
          SA1    FETROI+B5
          PL     X1,BRDONLY        SKIP IF BUFFER IS UNCHANGED
  
          SB7    B0 
  
          RJ     RNDMWR            REWRITE THE BUFFER 
  
          SA1    FETROI+B5
          MX7    1
          BX7    -X7*X1            DROP BUFFER-WAS-ALTERED FLAG 
          SA7    A1                REPLACE IN FET 
  
 FILREWD  BSS    0
 FNOTSET  BSS    0
 BRDONLY  BSS    0
  
          SX7    B0 
          SA7    FETINDX+B5        CLEAR CRI , W AND RR FIELDS
  
          SA1    FETFRST+B5 
          SX2    X1                KEEP -FIRST- 
          LX1    59-47             CHECK RANDOM BIT 
          NG     X1,RNDMNOW        SKIP IF THE FILE IS ALREADY RANDOM 
  
          MX7    1
          LX7    48                RANDOM BIT B47 
          SX6    FETLEN 
          LX6    18                FET LENGTH - 5 IN B23-18 
          BX6    X6+X7             MERGE
          BX6    X2+X6             INSERT -FIRST- 
          MX0    1
          LX0    45                ERROR PROCESSING B44 
          BX6    X0+X6
          SA6    A1                RESET IN FET 
  
 RNDMNOW  BSS    0
  
  
  
          MX4    42 
          SA1    B5 
          BX7    X4*X1
          SA1    STATHED     (X1) = LFN WORD OF PREVIOUS FILINFO REQUEST
  
 .NOSBE   IFC    EQ,,"OS.NAME",SCOPE ,
          MX4    43          ONE BIT LONGER THAN AN LFN 
          LX4    1           POSITION TO CLEAR COMPLETE BIT 
 .NOSBE   ENDIF 
  
          BX1    -X4*X1      CLEAR LFN
          BX7    X7+X1       MERGE WITH NEW LFN 
          SA7    A1          STORE IN FILINFO BLOCK 
          FILINFO A7
          MX7    42 
          SA1    B5 
          BX7    X7*X1
          SX1    READBIN+1
          BX7    X7+X1
          SA7    A1 
          SA1    FETFRST+B5 
          BX6    X1 
          SA6    TEMPOUT
          SA1    STATHED+3   (X1) = FILE LENGTH WORD OF FILINFO BLOCK 
          LX1    24          (X1) = 6/0,24/CRI,6/0,24/LENGTH
          MX7    -24
          BX7    -X7*X1      (X7) = LENGTH IN PRUS
          SA7    SAVERSA
          NZ     X7,RDLOOP
          SX7    1
          SA7    SAVERSA
          EQ     LOADB             EMPTY FILE 
 RDLOOP   BSS    0
          SA7    SAVRSA 
          SA1    FETFRST+B5 
          SX6    X1 
          SA6    A1+1 
          SA6    A1+2 
          IFC    EQ,,"OS.NAME",KRONOS,
          MX1    1
          LX1    30 
          BX7    X7+X1             TURN ON W BIT
          ENDIF 
          SA7    B5+FETINDX 
          READ   B5,R 
          SA1    B5 
          LX1    59-EOIBIT
          NG     X1,LPP          SKIP IF EOI RETURNED 
          LX1    6
          PL     X1,LOADB          SKIP IF NOT EOF
 LPP      BSS    0
          SA1    SAVRSA 
          SA2    B5+FETIN 
          SA3    TEMPOUT
          IX3    X2-X3
          BX6    X2 
          SA6    TEMPOUT
          SX3    X3-65
          SX7    X1-1 
          NG,X3  LPP2 
          SX7    X1-1 
 LPP2     BSS 
          ZR     X7,LOADB 
          EQ     RDLOOP            READ AGAIN 
  
 LOADB    BSS    0
  
          SA5    SAVERSA
          SX5    X5-1              DROP EXTRA PRU COUNT 
  
          SA1    B5+FETIN          -IN- 
          SA2    B5+FETOUT         LOAD -OUT- 
  
          IX1    X1-X2             IN-OUT GIVES NO OF WORDS READ
          SX2    X1-65
          NG,X2  LOADB2 
          SX5    X5-1 
 LOADB2   LX5    6
          IX5    X5+X1             FORM COMBINED TOTAL
          PX7    B0,X5
          NX7    B0,X7
          SA1    FETLOFC+B5 
          MX0    30 
          BX6    -X0*X1            KEEP LOC VALUE 
          LX5    30                SHIFT LOF VALUE TO UPPER 
          IX6    X5+X6             MERGE
          SA6    A1                REPLACE IN FET 
          SA7    SAVFLO            SAVE (FLOATING) VALUE OF LOF 
  
  
          EQ     GETLOF      EXIT 
  
  
  
  
  
  
  
 LODSTAT  BSS    0
  
          SA1    SAVSTAT
          BX7    X1 
          SA7    FETSTAT+B5        RESET FORMER STATUS
          UX1    B6,X1
          SB6    B6-2 
          LE     B6,FREWD          SKIP TO REWIND IF FILE WAS NEUTRAL 
  
          SA1    SAVLOFC
          MX0    30 
          BX1    -X0*X1            PICK-UP PREVIOUS LOC 
          MX7    1
          BX7    X1+X7             FORCE SET-PENDING FLAG 
          SA7    FETSETV+B5        DUMP IN FET
  
          SA1    B5SAVE 
          SB6    X1 
          EQ     B5,B6,SETNOW      SKIP IF CURRENT FET IS THE SAME AS 
*                                  THE FET ASSOCIATED WITH THE LOF
          SA5    SAVFLO            LOAD (FLOATING) LOF VALUE
          EQ     LOFEXIT
  
 FREWD    BSS    0
  
  
          REWIND B5,R              REWIND THE FILE (AS IT WAS BEFORE LOF
*                                  WAS USED)
  
  
          SA5    SAVFLO            RELOAD THE (FLOATING) VALUE FOR LOF
          EQ     LOFEXIT           GO EXIT
  
  
 SETNOW   BSS    0
          SA1    SAVSTAT
          UX1    B6,X1
          SB7    WRITBIN
          EQ     B6,B7,WRNOW       SKIP IF LAST FILE STATUS WAS WRITE 
  
          RJ     BASIRD0           MAKE THE FILE READY TO READ ON 
  
          SA5    SAVFLO            RELOAD THE (FLOATING) SET VALUE
          EQ     LOFEXIT
  
  
 WRNOW    BSS    0
          RJ     BASOWR0           GET THE FILE READY TO WRITE ON 
  
          SA5    SAVFLO            RELOAD (FLOATING) VALUE OF LOF 
  
 LOFEXIT  BSS    0
          SA1    FETSTAT+B5 
          MX0    1
          LX0    60-10
          BX7    X0+X1                  SET BIN/CODED BIT 
          SA7    A1 
          SA1    B5SAVE 
          SB5    X1                RESTORE B5 
  
          EQ     BASILOF           EXIT 
  
  
  
 SAVSTAT  BSSZ   1
 SAVLOFC  BSSZ   1
 SAVFLO   BSSZ   1
 STATHED  VFD    42/0,6/5,12/1     FILINFO BLOCK
          BSSZ   4           REMAINDER OF FILINFO BLOCK 
  
 SAVERSA  BSSZ   1           HOLDS RANDOM SECTOR (PRU) ADDRESS
 BATILOF  BSS    0
 BATAPND  BSS    0
 BATFSET  BSS    0
  
 SAVRSA   BSS    1
 TEMPOUT  BSS    1
          END 
