*DECK BASRTS
          IDENT  BASRTS 
          TITLE  BASRTS - COMMON PROCEDURES 
*CALL COPYRITE
          SYSCOM             DEFINE INTERFACE SYMBOLS.
          IPARAMS 
 INPLNGT  EQU    20 
 UNPKLEN  EQU    20                CHAR LEN OF UNPACK  BUFFER 
 ICHKMIN  EQU    UNPKLEN*2/10+1    MIN NO. WRDS IN CIO BUFFER 
*CALL LCORE 
*CALL LIPARAM 
*CALL ERMNUM
          EXT    ASCII
          EXT    COMRUNS
          EXT    SETDGTS
          EXT    PRTFLG            INTERRUPT PROCESSOR PRINT FLAG 
          EXT    ER174
          EXT    RNBLOCK,RNLIST,DBUGON
          EXT    BASCOMP
          EXT    BASEGEN
          ENTRY  OBUFLCL
          ENTRY  NUMFLG 
          ENTRY  MOVERTN,MOVESTT   PROCEDURE - STORAGE MOVE 
          ENTRY  BASOTAB           PROCEDURE - TAB CONTROL
          ENTRY  BASOCLS           PROCEDURE - CLOSE FILES
          ENTRY  BASOMOV           PROCEDURE - CHARCATER MOVE 
          IFC    EQ,,"OS.NAME",SCOPE ,
          ENTRY  ASCII95           95 CHAR ASCII TRANSLATE TABLE
          ENDIF 
          ENTRY  BASICON           PROCEDURE - INPUT CONVERT
          ENTRY  BASIUNP,SKIPEOL   PROCEDURE - UNPACK TO CHAR BUFFER
          ENTRY  INPBUFF           CHAR UNPACK BUFFER 
          ENTRY  BASICHK           PROCEDURE - INPUT CHECK
          ENTRY  BASOCON           PROCEDURE - OUTPUT CONVERT 
          ENTRY  BASXCHR,BATXCHR   PROCEDURE - CHR$ FUNCTION
          ENTRY  ASCORD            PROCEDURE - FIND ASCII ORDINAL 
          ENTRY  CC                BASOPTS PRINT LINE FLAG
          ENTRY  CVSCALL           BASACVS STRING FLAG
          ENTRY  BASWNB=
          ENTRY  BASCIO=
          ENTRY  BASMSG=
          ENTRY  BASSYS=
          ENTRY  BASRCL=
          ENTRY  OBUFLCL
          ENTRY  NUMFLG 
          ENTRY  LBLKFLG
          ENTRY  FFCLASS,KKKKKKK   USED BY SUBSTR SCANNING
          ENTRY  CNVDGTS,ROUNDIT
          ENTRY  FINDEXP
          ENTRY  SETCHK 
          ENTRY  TABFLG 
          ENTRY  NUMCHAR
          ENTRY  FFREAD0,FFCHANL
          ENTRY  BASXGST,BASCGST
          ENTRY  BASCDT1,BASCDT2
          ENTRY  BASCDT3
          ENTRY  DLMTNO,DLMTSW,DLTKND 
          ENTRY  TABCNVX
          ENTRY  DLMTESC
          ENTRY  RNDMRD,RNDMWR
          ENTRY  BASOCHK           PROCEDURE - OUTPUT CHECK 
          ENTRY  PRVBLCL     PREVIOUS STRING HAD A BLANK-APPENDED-TO-COLON
          ENTRY  COLNBLK     BLANK-APPENDED-TO-TRAILING-COLON FLAG
* 
          TITLE  XTEXT MACRO COMCSYS
 SUBR     SPACE  4,8
***       SUBR - SUBROUTINE ENTRY/EXIT DEFINITION.
* 
* 
* TAG     SUBR               DEFINE *EXIT.* AND *TAG_X*.
* TAG     SUBR   0           SAME.
* TAG     SUBR   =           SAME, AND DECLARE *TAG* AS ENTRY POINT.
* TAG     SUBR   -           DEFINE *EXIT.* BUT NOT *TAG_X*.
* TAG     SUBR   LETTER      DEFINE *TAG_LETTER* BUT NOT *EXIT.*. 
* 
*         ENTRY  *TAG* = SUBROUTINE ENTRY NAME. 
* 
*         EXIT   CODE GENERATED --
*                TAG    EQ    *+1S17    ALWAYS. 
*                       ENTRY TAG       IF = SPECIFIED. 
*                EXIT.  SET   *         IF BLANK, 0, =, OR - SPECIFIED. 
*                       NOREF EXIT.     IF BLANK, 0, =, OR - SPECIFIED. 
*                TAG_X  EQU   *         IF BLANK, 0, OR = SPECIFIED.
*                       NOREF TAG_X     IF BLANK, 0, OR = SPECIFIED.
*                TAG_LETTER  EQU  *     IF LETTER SPECIFIED.
* 
*         USES   NONE.
* 
*         CALLS  NONE.
  
  
          PURGMAC SUBR
  
          MACRO  SUBR,T,A 
T  EQ *+1S17D 
'?CPU#EN MICRO 1,,=T= 
  IFC NE, A  ,3 
  IFC LT, A 0 ,2
"'?CPU#EN"A EQU * 
  SKIP 7
  IFC NE, A - ,4
  IFC EQ, A = ,1
  ENTRY T 
"'?CPU#EN"X EQU * 
  NOREF "'?CPU#EN"X 
EXIT. SET * 
  NOREF EXIT. 
  ENDM
**        SYSTEM I/O PROCESSING SUBROUTINES 
          XTEXT  COMCSYS
          TITLE  XTEXT MACRO COMCCIO
          XTEXT  COMCCIO
 BASCIO=  EQU    CIO= 
 BASMSG=  EQU    MSG= 
 BASSYS=  EQU    SYS= 
 BASWNB=  EQU    WNB= 
 BASRCL=  EQU    RCL= 
          FILINFO LIBSL      THIS CALL FORCES LOAD OF CPU.LFM 
* 
* 
*         PROCEDURE STORAGE-MOVE  -  MOVERTN
* 
*         MOVERTN WAS ORIGINALLY IN ROUTINE TRANSFER IN BASCOMP 
*         UNDER THE STATEMENT LABEL MOVSTRT.  THE PURPOSE OF
*         MOVING MOVERTN TO ITS PRESENT LOCATION IS TO RELIEVE
*         ROUTINE TRANSFER IN BASCOMP FROM DOING STORAGE
*         RELOCATION FOR MOVERTN TO RA+51B. 
*         SEE THE DESCRIPTION OF TRANSFR IN BASCOMP FOR REGISTERS 
*         PASSED TO MOVERTN . 
* 
* 
*         -MOVERTN- IS USED ONLY IN COMPILE-TO-CORE MODE. 
* 
 MOVESTT  BSSZ   1                 STATUS WORD - UPPER 30 
*                                  BITS CONTAINS NEW FL 
*                                  IF MEM REQUEST DESIRED.
* 
* 
* 
*         BASIC OBJECT TIME ROUTINES - OVERLAY(BASIC,2,0) 
*         OR OVERLAY(BASIC,3,0) OR OVERLAY(BASIC,4,0).
*         (X4) = OVERLAY NUMBER REQUIRED. 
* 
 NUCLEUS  DATA  0LNUCLEUS 
 SYSOVL   DATA  0LSYSOVL
 LIBSL    VFD   42/0,18/0                           42/NAME,18/STATUS 
          VFD   6/0,6/0,2/1,4/0,1/1,4/0,1/0,36/0
          VFD    42/0LBASLIB,18/0 
 FOLSAVE  BSSZ   2                 SAVE B REGISTERS 
 SVFWA    BSSZ   1                 SAVE ADDR OF BASCOMP=FWA OF OVERLAY
 OMFLG    DATA   0                 DBUG.OM OLDCOPY FLAG 
          ENTRY  BASANSI,BASCOLL,BASICNB
 BASANSI  DATA   0
 BASCOLL  DATA   0
 BASICNB  DATA   0
          DATA   10HMOVERTN 
 MOVERTN BSS     0
* 
*     LOAD RUN TIME LIBRARY OVER BASCOMP
* 
*  SAVE B REGISTERS 
          SX6    B1                REG B1 
          LX6    18 
          SX2    B2                REG B2 
          IX6    X6+X2
          LX6    18 
          SX2    B3                REG B3 
          IX6    X6+X2
          SA6    FOLSAVE
          SX6    B5                REG B5 
          LX6    18 
          SX2    B6                REG B6 
          IX6    X6+X2
          LX6    18 
          SX2    B7                REG B7 
          IX6    X6+X2
          SA6    A6+1 
* 
          SA1      64B              (X1)= RA+64B
          SA2      65B              (X2)= RA+65B
          MX5      1
          LX5      19 
          BX2      X2*X5            (X2)= LIBRARY FILE FLAG 
          MX5      42 
          BX1      X1*X5            (X1)= NAME/LIBRARY NAME 
          ZR       X2,OVL01         BR, LOAD OPTION U=0 
          SA5      NUCLEUS
          IX5      X1-X5            CHECK FOR NUCLEUS 
          NZ       X5,OVL01         BR, NAME NOT NUCLEUS
          SA1      SYSOVL           (X1)= 6LSYSOVL
 OVL01    SA3      LIBSL
          SA5      A3+1 
          IX6      X1+X3            PUT NAME IN LDV REQUEST 
          LX2      24 
          IX7      X2+X5            SET U IN LDV REQUEST
          LX4      54 
          IX7      X7+X4            SET OVL NUMBER IN LDV REQUEST 
          SA6    A3                LIBSL
          SX1    B2                INSTRUCTION BASE = LWA+1 
          SA2    SVFWA             FWA OF OVERLAY=BASCOMP ADDR
          LX1    18 
          BX1    X1+X2             COMBINE LWA AND FWA
          IX7    X7+X1             SET LWA AND FWA IN LDV REQUEST 
          SA7    A5                LIBSL+1
          LX4    6           CHECK OVERLAY NO 
          SX6    X4-2 
          ZR     X6,OVL02 
          SX6    X4+33B      IF NOT 2 STICK IN NAME 
          LX6    18 
          SA5    A5+1 
          BX6    X6+X5
          SA6    A5                LIBSL+2
 OVL02    SYSTEM LDV,R,LIBSL
          SB4    =YDBUG.OM         WEAK EXTERNAL REF TO DEBUG 
          NG     B4,OVL03          BR IF NOT IN DEBUG MODE
          SA5    LIBSL+1           GET ENTRY POINT ADDRESS. 
          SB6    X5 
          SA1    OMFLG             FETCH DEBUG OLDCOPY FLAG 
          RJ     =YDBUG.OM         LET CID KNOW OVERLAY LOADED
 OVL03    BSS    0
          SA1    FOLSAVE           RESTORE B REGISTERS
          SB3    X1 
          AX1    18 
          SB2    X1 
          AX1    18 
          SB1    X1 
          SA1    A1+1 
          SB7    X1 
          AX1    18 
          SB6    X1 
          AX1    18 
          SB5    X1 
          SX0    1                 RESET INCREMENT
* 
 TRANS01 SA1     B2+B7             B7 = 0  LOOP TO MOVE CODE
          BX6    X1                B2 = INSTRUCTION BASE
          SA6    B3+B7             B3 = GENERATED CODE BASE 
          SB7    B7+X0             X0 = 1 
          LT     B7,B1,TRANS01     B1 = NO. OF WORDS TO MOVE
* 
 TRANS02 SA6     B3+B7             LOOP TO PRESET VARIABLES 
          SB7    B7+X0
          LT     B7,B5,TRANS02     B5 = B1 + NO. OF VARIABLES 
* 
*         UPDATE LWA+1 IN LOADER WORD2 (RA+65) TO INDICATE
*         LAST WORD +1 USED BY RUNNING PROGRAM
* 
          SX6    A6+1        X6 = LWA + 1 
          SA1    65B         X1 = RA+65B
          MX0    42 
          BX1    X0*X1       CLEAR OLD LWA+1
          BX6    X1+X6       OR IN NEW ONE
          SA6    A1          RESTORE RA+65
* 
*  LOAD MOVESTT, AND SEE IF MEM REQUEST DESIRED 
* 
          SA2    MOVESTT
          ZR     X2,TRANS03 
* 
          MEMORY CM,MOVESTT,R,
* 
 TRANS03 SB7     B0 
          JP     B6                ENTRY ADDRESS
* 
*         END OF PROCEDURE MOVERTN
* 
          TITLE  BASOCLS - CLOSE OUTPUT FILES PROCEDURE 
* 
*         PROCEDURE OUTPUT-CLOSE
* 
          DATA   10HBASOCLS 
 BASOCLS  SPACE  4
*         ENTER- B5 = FET ADDRESS 
* 
*         EXIT-  B6 = 0 (NO ERROR)
* 
*         USES-  A1,X1,A6,X6,B7,B6,A2,X2,X4 
* 
*         CALLS- CIO= 
  
 BASOCLS  PS     0
          SA1    FETSTAT+B5 
          SB6    B0 
          UX6    X1,B7
          SX1    B7 
          LX1    59-2 
          PL     X1,BASOCLS  IF NOT PREVIOUSLY USED FOR WRITE 
          MX4    42 
          IFNE   FETFILE,0
          SA1    FETFILE+B5 
          ELSE
          SA1    B5 
          ENDIF 
          SX6    B7+1 
          BX1    X1*X4
          BX6    X1+X6
          SA6    A1          SET FILE CODE FIELD
          SA1    FETIN+B5    *IN* 
          SA2    FETOUT+B5   *OUT*
          IX2    X1-X2
          NZ,X2  LBL         IF BUFFER NOT EMPTY
* 
* CHECK IF IN=OUT=LIMIT-1.  IF SO ( AND LAST OPERATION WAS A WRITE) 
* AN EXACT BUFFER LOAD WAS WRITTEN OUT WITHOUT AN EOR.
          SA1    FETLIMT+B5 
          SX1    X1-1 
          SA2    FETIN+B5 
          IX0    X1-X2
          NZ     X0,BASOCLS  IN=OUT=(LIMIT-1) 
 LBL      BSS    0
  
  
          WRITER   B5,R 
  
          SB6    B0          SET NO ERROR RETURN
          EQ     BASOCLS     RETURN 
* 
*         END OUTPUT-CLOSE
* 
          TITLE  BASOTAB - TAB CONTROL PROCEDURE
* 
*         PROCEDURE TAB-CONTROL 
* 
 BASOTAB  BSSZ      1 
*         ON ENTRY, X4 CONTAINS TAB CODE 0, 1 OR -1 
* 
*         TEST IF TAB CODE IS ZERO (NO TABBING REQD)
          ZR     X4,TABLL90        BR, DO NOTHING, RETURN 
* 
*         TEST IF TAB CODE IS 1 (PAD OUT TO NEXT ZONE WITH BLANKS)
          PL     X4,TAB1         BR,TAB CODE MUST BE 1
* 
* FALL THRU, TAB CODE MUST BE -1 (CLOSE CURRENT LINE, SET UP FOR NEW LIN
* SINCE THIS IS THE END OF A LINE WE CAN RESET THE POINTER FLAGS FOR
* BLANK-APPENDED-TO-ENDING-COLON. 
* 
* 
          MX6    0
          SA6    PRVBLCL
          SA6    COLNBLK
* 
* 
* 
* THIS ROUTINE CLOSES OFF THE CURRENT PRINT LINE. 
* CONTROL MAY REACH HERE BY FALLING THRU OR BY BRANCHING IN.
* 
* BRANCH IN: MEANS THAT THE CURRENT PRINT ITEM IS TO BE PRINTED AT OR 
* BEYOND THE LAST PRINT ZONE OF MARGIN. THEREFORE, WE MUST ADD A ZERO 
* BYTE DELIMITER TO THE CURRENT LINE AND PUT THE CURRENT PRINT ITEM ON
* THE NEXT LINE.
* 
* FALL THRU: MEANS THAT THE CURRENT PRINT ITEM IS IN THE BUFFER AND WE
* MUST ADD A ZERO BYTE DELIMITER TO CLOSE OUT THE CURRENT LINE. 
* 
* NOTE ===> THE CODE WHICH WAS ORIGINALLY HERE APPENDED A BLANK IF THERE
* WERE AN ODD NUMBER OF CHARACTERS IN THE LAST WORD IN THE BUFFER. THIS 
* WAS NOT NEEDED (BUT MAY HAVE MADE PROCESSING SOMEWHAT SIMPLER). 
*     THEREFORE, WE ALWAYS STORE A ZBD IN TABLANK+1 AND JUMP TO SUPW2.
* THERE IS A SPECIAL CASE FOR EXACTLY 9 CHARACTERS IN THE LAST WORD.
* THIS SPECIAL CASE IS HANDLED IN BASOMOV.
* 
 SU01     BSS    0
          SX4    -1          NEEDED FOR BRANCH-IN CASE
          SX6    B0          NEEDED FOR BRANCH IN CASE
          SA6    TABLANK+1   STORE END OF LINE INDICATOR
          EQ     SUPW2
* 
* 
* 
 TAB1     BSS    0
* SINCE WE WANT TO KEEP THE BLANK ON THE PREVIOUS STRING WE RESET THE 
* BLANK-APPENDED-TO-ENDING-COLON FLAGS. 
* 
* 
          MX6    0
          SA6    PRVBLCL
          SA6    COLNBLK
* 
* TAB CODE MUST BE 1 (PAD OUT TO NEXT ZONE WITH BLANKS) 
* 
* COMPUTE NO OF 15 CHAR ZONES AND NO OF RESIDUAL PART ZONE CHARS OF ACTU
*         FIRST, CALC NO OF CHARS IN ACTUAL LINE
          SA1    B5+FETCHAR      X1 - ACTUAL WORDS + CHARS
          NZ     X1,SIGACT       BR, THERE IS AN ACTUAL COUNT 
* 
*         FALL THRU, SET ZONE AND PART ZONE CTS TO ZERO 
          MX6    0               X6 = ACTUAL ZONE COUNT = 0 
          MX7    0               X7 = ACTUAL PART ZONE CHAR CT = 0
          EQ     MRGZTST         BR TO TEST IF MARGINE = 0
* 
 SIGACT   BSS    0
*         COUNT THE CHARS IN ACTUAL 
*                X1 CONTAINS FETCHAR
          SX2    X1              X2 = CHAR PORTION OF FETCHAR 
          AX1    30              X1 = WORDS PORTION OF FETCHAR
          LX1    1               X1 = FETCHAR WORDS * 2 
          IX2    X1+X2           X2 = FETCHAR WORDS * 2 ) + (FETCHAR CHA
          LX1    2               X1 = FETCHAR WRDS * 8
          IX1    X1+X2           X1 = FETCHAR WDS * 10) + (FETCHAR CHARS
* 
* NOW COUNT ACTUAL ZONES AND ACTUAL PART ZONE CHARS 
          SB6    0               B6 = ZONE COUNT
* 
 AGN      SX1    X1-15           X1 = ACTUAL LINE CHARS REDUCED BY 15 SU
          NG     X1,OVRDRWN      BR, REDUCED TOO MUCH 
          SB6    B6+1            B6 = INCREMENT ZONE COUNT (1 ZONE = 15 
          EQ     AGN             BR TO REDUCE SOME MORE 
* 
 OVRDRWN  BSS    0
*         B6 = COUNT OF ZONES 
          SX6    B6              X6 = COUNT OF ACTUAL ZONES 
          SX7    X1+15           X7 = COUNT OF ACTUAL PART ZONE CHARS 
* 
 MRGZTST  BSS    0
* 
* TEST IF MARGIN IS ZERO, IF SO BRANCH
          SA1    B5+FETLINL      FETCH MARGIN WORDS + CHAR
          ZR     X1,AEQZTST      BR, MARGIN IS ZERO 
* 
* FALL THRU, MARGIN IS NON-ZERO 
* CALC NO OF CHARS IN MARGIN
          SX2    X1              X2 = CHARS OF FETLINL
          AX1    30              X1 = WORDS OF FETLINL
          LX1    1               X1 = FETLINL WDS * 2 
          IX2    X1+X2           X2 = FETLINL WDS * 2)+(FETLINL CHARS 
          LX1    2               X1 = FETLINL WDS * 8 
          IX1    X1+X2           X1 = TOTAL MARGIN CHARS
* 
* TRANSLATE MARGIN CHARS INTO MARGIN ZONE COUNT 
          SB6    0               B6 = ZONE COUNT
 AGN2     SX1    X1-15           X1 = MARGIN CHARS REDUCED BY 15 PROGRES
          NG     X1,OVRDRWN2     BR, REDUCED TOO MUCH 
          ZR     X1,OVRDRWN2     B6 = LAST MARGIN ZONE NO. 0,1,2....
          SB6    B6+1            B6 = INCREMENTED ZONE COUNT
          EQ     AGN2            GO REDUCE SOME MORE
* 
 OVRDRWN2 BSS    0
*         B6 = NO OF MARGIN ZONES 
*         X6 = NO OF ACTUAL ZONES 
*         X7 = NO OF ACTUAL PART ZONE CHARS 
* 
* NOW TEST IF ACTUAL IS AT OR BEYOND LAST MARGIN ZONE START 
          SB6    -B6             SET UP MARGIN ZONE COUNT AS A NEGATIVE 
          SB6    X6+B6           B6 = ACTUAL ZONE COUNT - MARGIN ZONE CO
          NE     B6,B0,AEQZTST      BR, ACTUAL IS NOT AT OR BEYOND LAST 
* 
* FALL THRU, ACTUAL IS AT OR BEYOND LAST ZONE START 
*         TEST TO SEE IF ANY ACTUAL PART ZONE CHARS 
          NZ     X7,SU01         BR, ACTUAL IS BEYOND LAST ZONE START 
* 
* FALL THRU, MARGIN NON-ZERO, ACTUAL IS AT LAST ZONE START
* 
* 
* 
 AEQZTST  BSS    0
* 
* 
* BRANCH IN, MARGIN IS ZERO 
* BRANCH IN, MARGIN NON-ZERO, ACTUAL LESS THAN LAST ZONE START
* 
          SA3    BASANSI           CHECK FOR ANSI MODE ON 
          NZ     X3,AEQZTST1       SKIP CK FOR ZONE START IF ANSI MODE
* TEST IF ACTUAL IS AT A ZONE START 
          ZR     X7,SUZBD        BR, ACTUAL IS AT A ZONE START (NO PART 
* 
 AEQZTST1 BSS    0
* WE MUST CREATE A STRING OF BLANKS TO PAD OUT THE CURRENT LINE TO
* THE POSITION BEFORE THE NEXT ZONE START.
* 
* THE PAD OUT STRING WILL CONSIST OF ONE OF THE FOLLOWING 
*         ONE WORD OF BLANKS FOLLOWED BY A ZERO BYTE DELIM WORD 
*         OR ONE WORD OF BLANKS FOLLOWED BY A WORD OF SOME BLANKS THAT
*         ENDS WITH A ZBD,
*         OR ONE WORD THAT CONTAINS SOME BLANKS AND A ZBD,
*         OR A ONE WORD ZBD ONLY. 
* 
*         ALL THE ABOVE COMBINATIONS ARE BUILT AT LOCATIONS TABLANK AND/
*         TABLANK+1.
* 
*         X7 CONTAINS ACTUAL PART ZONE CHAR COUNT 
* 
*         CALC NO OF SPACES REQUIRED TO PAD OUT TO NEXT ZONE
          BX7    -X7             SET PART ZONE CHAR CT NEGATIVE 
          SX7    X7+15           X7 = COUNT OF SPACES REQD TO PAD OUT ZO
* 
*         NOW DETERMINE IF PAD OUT STRING MUST INCLUDE 1 WHOLE WD OF BLA
          SX2    X7-10
          NG     X2,CTZBITS     BR, WHOLE WD OF BLANKS NOT REQD 
          SX7    X2              X7 = CT OF BLANKS IN PART WORD OF BLANK
* 
 CTZBITS  BSS    0
* 
* X7 NOW CONTAINS CT OF BLANKS REQD IN A PART WORD OF BLANKS AND
* X2 IS A FLAG INDICATING WHETHER A WHOLE WD IS/IS NOT REQD  POS/NEG
* 
* DEVELOP COUNT OF ZERO BITS REQUIRED TO FILL OUT PART WORD OF BLNKS
*         I.E. SET UP MASK COUNT
* 
          SB6    60              PRESET ZERO BITS COUNT 
* 
 SUMSKCT  ZR     X7,SUPADSTR       BR, COUNT OF PART WORD BLNKS IS ZERO,
* 
          SB6    B6-6            REDUCE COUNT OF ZERO BITS REQD FOR EACH
          SX7    X7-1            X7 = REDUCED COUNT OF BLANKS REQD
          EQ     SUMSKCT         GO ADJUST ZERO BIT COUNT SOME MORE 
* 
 SUZBD    BSS    0
* 
* ACTUAL IS AT A ZONE, WE SET UP TO WRITE A ZBD ONLY
          MX2    1               SET X2 FLAG TO NEG, I.E. ONLY 1 WORD ZB
          SB6    60              B6 ZERO BIT COUNT SET
          EQ     SUPADSTR        GO TO CREATE ZBD 
* 
* CREATE PAD OUT STRING 
* 
 SUPADSTR BSS    0
* 
*         B6 = ZERO BITS COUNT, X2 FLAG RE WHOLE WORD REQD/NOT REQD 
* 
 TABLL32  SA5       TABLANK 
          MX1       1 
          AX1       B6,X1 
          LX1       1 
          LX1       B6,X1 
          AX1       1                   GENERATE MASK 
          BX6      -X1*X5 X6 = REQD WORD OF SOME BLNKS AND/OR ZBD 
          SA6    TABLANK+1       NOW STORED IN ASSEMBLY AREA
* 
* TEST IF A WHOLE WORD OF BLANKS IS ALSO REQUIRED TO BE 
*         PART OF THE STRING
* 
          PL     X2,PAD2WDS     BR, WHOLE REQD, STRING CONSISTS OF 2 WOR
* 
* FALL THRU, 1 WORD STRING REQD 
* SET UP POINTER WORD FOR LOCATION TABLANK+1
* 
 SUPW2    SA5    TABLANK+1
          EQ     MVBLNKS
* 
 PAD2WDS BSS    0 
* TWO WD STRING REQD. 
* 
* SET UP POINTER WORD FOR LOCATION TABLANK
* 
          SA5    TABLANK
* 
 MVBLNKS  BSS    0
 TABLL40  RJ        BASOMOV             MOVE BLANKS 
          SX6    B0 
          SA6    TABLANK+1         RESET TO ZERO
          PL        X4,TABLL90          NO LINE 
          SA1       B5+FETCHAR
          ZR        X1,TABLL90          POSITIONED AT BEGIN ALLREADY
 TABLL45  BSS    0
          SA1       B5+FETIN
          SA2       B5+FETLIMT          UPDATE IN 
          SX6       X1+1
          SX7       X2
          IX7       X6-X7 
          NZ        X7,TABLL50
          SA2       B5+FETFRST
          SX6       X2
 TABLL50  SA2    B5+FETOUT
          IX2    X6-X2       X2 = NEW  IN - OUT 
          NZ     X2,TABLL55  SKIP IF NEW IN NOT EQUAL TO OUT
          RJ     BASOCHK     OTHERWISE GO FLUSH BUFFER BEFORE UPDATING I
          EQ     TABLL45     GO BACK AND RECALCULATE NEW IN 
 TABLL55  SA6    A1          STORE UPDATED IN 
          SX7       0 
          SA7       B5+FETCHAR          CLEAR COUNT 
 TABLL90  BSS       0 
          EQ        BASOTAB 
* 
* 
* 
* 
 TABLANK  DATA      10H 
          DATA      0 
          DATA   0
          TITLE  BASOMOV - CHARACTER MOVE PROCEDURE 
 LBLKFLG  BSSZ   1     FLAG TO INDICATE THAT 1ST BLANK CHAR OUTPUTTED 
* 
*         PROCEDURE CHARACTER-MOVE
* W A R N I N G   FOLLOWING SAVES OF REGISTER CONTENTS
* DO NOT PROTECT CALLERS OF BASOMOV FROM DESTRUCTION
* OF ANY OTHER REGISTERS THAT MIGHT BE USED IF BASOMOV
* CALLS BASOCHK.
* 
 BASOMOV  BSSZ      1 
* SAVE REGS 
          SX7    B2 
          SA7    MOVERB2         B2 SAVED 
          SX6       B3
          SX7       B4
          SA6       MOVERB3 
          SA7       MOVERB4             SAVE B3, B4 
         SX6       B1 
         SX7       B7 
         SA6       MOVERB1
         SA7       MOVERB7
         BX7       X4 
         SA7       MOVERX4          .STORE X4 
          SA1    B5+FETOUT
          SB2    X1              B2 NOW CONTAINS *OUT* ADDRESS
          SA1       B5+FETLIMT
          SA2       B5+FETIN
          SB3       X1                  B3 = LIMIT
          SB4       X2                  B4 = POINTER
         SA4       B5+FETCHAR     . TEST  FOR END OF LINE 
         NZ        X4,FET0         . ZERO INDICATES LINE TERMINATED 
         SA4       LBLKFLG
         NZ        X4,FET0    JUMP IF LEADING BLANK IS OUTPUTTED
         SB6       B0 
         SB1      60              . PRE SET SHIFT COUNT 
          SA4    B5+FETSTAT  CHECK IF THIS IS AN INTERACTIVE FILE 
          LX4    59-18
          NG     X4,FET2     BR, THIS IS AN INTERACTIVE FILE
          SA4    KOPTION     GET NAME OF K FILE 
          SX4    X4             GET ADDRESS OF KFILE FET
          SX2    B5          ADDRESS OF THIS OUTPUT FET 
          IX2    X2-X4       IF THIS IS THE FILE *OUTPUT*, THEN THE STRING
*                            WE ARE ABOUT TO PRINT IS A LEADING BLANK.
          NZ     X2,FET2     BR, NOT THE FILE *OUTPUT*--NOT A LEADING BLANK 
          EQ     FET2A       HERE FOR FILE OUTPUT--PRINTING A LEADING 
*                            BLANK. SKIP TRAILING COLON PROCESSING
*                            BECAUSE IT WOULD MESS UP OUR FLAGS.
*     PICK UP LAST WORD STORED
*     AND DETERMINE HOW MANY SPACES ARE UNUSED
 FET0     BSS    0
          SX7    B0 
          SA7    LBLKFLG
          IFC    EQ,,"OS.NAME",SCOPE ,
          SA4    ASCII
          ZR   X4,FET3             NON-ASCII
* 
* 
*  ASCII MODE - CHECK 12-BIT CHARACTERS 
          SA4    X2                LAST WORD STORED IN BUFFER 
          SX2    7777B             CHAR MASK
          SB7    60                LIMIT
          SB6    5
          SB1    B0                COUNT
 FET4     AX4    12                GET CHARACTER
          BX1    X2*X4
          SB1    B1+12             COUNT BITS OF ZEROES 
          SB6    B6-1 
          EQ   B1,B7,FET2          EXIT IF WHOLE WORD SHIFTED 
          ZR   X1,FET4             LOOP IF CHARACTER ZERO 
          EQ   FET2 
          ENDIF 
* 
* 
 FET3     BSS    0                 CHECK FOR 6-BIT CHARACTERS 
          SA4    X2                LAST WORD STORED IN BUFFER 
         SX2       77B            .MASK FOR LAST CHARACTER
         SB7       60             .LIMIT FOR LOOP 
         SB6       10 
         SB1       0              .INDEX
FET1     AX4       6              .SHIFT CHARACTER
         BX1       X2*X4          MASK LAST CHARACTER 
         SB1       B1+6           .COUNT BITS OF ZEROES 
          SB6      B6-1 
         EQ        B7,B1,FET2     .EXIT IF WHOLE WORD SHIFTED 
         ZR        X1,FET1        .LOOP IF CHARACTER 0
* 
* 
 FET2     RJ     PRCOLON     PROCESS POSSIBLE TRAILING COLON
 FET2A    SX6    B6 
         SA6       OPH
       SB6         B1 
*     B6 NOW HOLDS SHIFT COUNT FOR PLACING WORDS IN BUFFER
          MX1       1 
          AX1       B6,X1 
          LX1       1 
          LX1       B6,X1 
          AX1       1                   X1 = MASK 
         SX4    B0           .ZERO WORD COUNT 
* 
          SA3       B4                  FETCH ( OLD ) 
* 
* 
* THIS CODE DOES SPECIAL PROCESSING WHEN: 
*  A) LAST WORD IN BUFFER HAS EXACTLY 9 CHARACTERS IN IT; 
*  B) NEXT ITEM TO BE MOVED TO THE BUFFER IS END OF LINE(I.E. ALL ZEROS)
* 
 MOVE1A   SX0    A5          CHECK IF THIS IS AN END OF LINE TERMINATOR 
          SX2    TABLANK+1
          IX2    X2-X0
          NZ     X2,MOVE1E   BR, THIS IS NOT AN END OF LINE, IT IS A
*                                 NULL PRINT ITEM 
          SX2    77B         CHECK FOR EXACTLY 6 BITS OF ZERO REMAINING 
          BX2    X3*X2
          NZ     X7,MOVE1E   BR, NOT 6 BITS OF ZERO IN LAST WORD
          SX2    7777B       CHECK FOR MORE THAN 6 BITS OF ZERO 
          BX2    X2*X3
          ZR     X2,MOVE1E   BR, MORE THAN 6 BITS OF ZERO IN LAST WORD
          NZ     X5,MOVE1E   BR, NOT STORING A NULL WORD
          SB4    B4+1        LEAVE 6 BITS OF ZERO IN PREVIOUS WORD AND
*                            ADD A WORD OF ZEROS TO SIGNAL END OF LINE. 
 MOVE1B   LT     B4,B3,MOVE1C BR, *IN* LESS THAN *LIMIT*
          SA2    B5+FETFRST     ELSE, SET IN TO *FIRST* 
          SB4    X2 
          SX2    7777B       RESET MASK IN X2 IN CASE WE GO TO MOVEL01
 MOVE1C   EQ     B4,B2,MOVE1D BR, *IN* = *OUT* FULL BUFFER
          MX6    0           ELSE, STORE ZERO AND CONTINUE
          SA6    B4 
          EQ     MOVEL02
 MOVE1D   RJ     CHKSAVE     SAVE REGISTERS USED BY BASOMOV 
          RJ     BASOCHK     OUTPUT THE BUFFER
          RJ     CHKRSTOR    RESTORE THE REGISTERS(UPDATED FET POINTERS)
          EQ     MOVE1C 
MOVE1E    SA2    ASCII
          ZR   X2,MOVE1            JUMP IF NOT ASCII MODE 
          IFC    EQ,,"OS.NAME",KRONOS,
*   CHECK FOR NUMERIC OUTPUT
         SA2       NUMFLG 
         ZR        X2,CHMOV       .IF NON-NUMERIC DO CHARACTER MOV
          ELSE
* 
* 
*  ASCII MODE - CONVERT 6/12 DISPLAY CODE TO 95-CHAR ASCII CODE 
* 
          SX2    77B
          SB1    -B6               POSITION ANY PARTIAL WORD
          SB1    B1+60             60-ZEROBITS
          NZ   B1,SMOV1            PARTIAL EXISTS 
          SX6    B0                START NEW WORD 
          SB1    5
          EQ   SMOV2
 SMOV1    LX6    B1,X3             POSITION EXISTING CHARS RIGHT
          SA1    OPH               CHARS IN WORD
          BX1    -X1
          SB1    X1+5              CHAR SPACES LEFT 
* 
 SMOV2    BSS    0
          SX3    B0                ZERO ESCAPE FLAG 
          SB6    10                CHARS LEFT IN INPUT WORD 
* 
 SMOV3    LX5    6                 NEXT CHAR FROM STRING
          BX1    X2*X5
          NZ   X3,SMOV10           JUMP IF ESCAPE PENDING 
          ZR   X1,SMOV5            ASSUME ZERO IS EOS 
          EQ   SMOV8               REGULAR BYTE 
 SMOV10   BSS    0
          IX3    X3+X1             FETCH ASCII CODE FROM 74 OR 76 TABLE 
          SA1    X3 
          SX1    X1                ASCII CODE FROM LOWER HALF 
          EQ   SMOV9               GO ADD CHAR TO OUTPUT WORD 
 SMOV8    SA3    ASCII95+X1        FETCH ASCII CODE FROM TABLE
          SX1    X3                ASCII CODE FROM LOWER HALF 
          LX3    30 
          PL   X3,SMOV9            SKIP IF NOT ESCAPE CODE, ADD TO WORD 
          LX3    30                ESCAPE CODE, SAVE TABLE ADDR IN FLAG 
          SX3    X3 
          EQ   SMOV6               GO GET NEXT 6-BITS (LOWER HALF)
 SMOV9    BSS    0
          SX3    B0                ZERO ESCAPE FLAG 
          LX6    12                ADD TO OUTPUT WORD 
          BX6    X6+X1
          SB1    B1-1 
          NZ   B1,SMOV6            ROOM FOR MORE
          SA6    B4                STORE FULL WORD
          SX4    X4+1              COUNT WORDS
          SX6    B0                START NEW WORD 
          SB1    5
          SB4    B4+1              INCR BUFFER POINTER
          NE     B4,B3,TRYOUT3   BR, NEW IN NOT AT *LIMIT*
          SA2    B5+FETFRST        WRAP AROUND
          SB4    X2 
          SX2    77B
* 
*         THIS PATH USED BY SCOPE ASCII 
* 
 TRYOUT3  BSS    0
          NE     B4,B2,SMOV6   BR, NEW IN NOT AT *OUT*
* 
*FALL THRU, NEW IN AT *OUT*, MUST FLUSH CIO BUFFER
          RJ     CHKSAVE       SAVE REGS IN USE BY BASOMOV
          RJ     BASOCHK       GO FLUSH CIO BUFFER
          RJ     CHKRSTOR      RESTORE REGS AND SET UP CIO BUFF ADDRS 
* 
          SX6    B0          START NEW WORD 
*FALL THRU
* 
* 
 SMOV6    BSS    0                 GET NEXT CHAR FROM INPUT STRING
          SB6    B6-1 
          NZ   B6,SMOV3            LOOP IN WORD 
          SA5    A5+1              NEXT WORD
          SB6    10 
          EQ   SMOV3
* 
* 
 SMOV5    BSS    0                 END OF STRING
          SB6    B6-1 
          ZR     B6,SMOV5A         END OF WORD CHECK NEXT 
          SB7    B6+B6             B6*6 
          SB7    B7+B6
          SB7    B7+B7
          SB7    B7-1 
          MX3    1
          AX3    B7 
          BX3    X3*X5             CHECK FOR END OF STRING
          ZR     X3,SMOV5B         END OF DTRING
          SB6    B6+1              COLON
          EQ     SMOV8
 SMOV5A   SA3    A5+1 
          ZR     X3,SMOV5B         END OF STRING
          SB6    B6+1 
          EQ     SMOV8             COLON
 SMOV5B   SB6    B6+1 
          ZR   B1,SMOV7            POSITION LAST WORD 
          LX6    12 
          SB1    B1-1 
          EQ     SMOV5B            LOOP 
 SMOV7    SA6    B4                STORE LAST WORD
          EQ   MOVEL02
          ENDIF 
* 
* 
*  NON-ASCII MODE MOVE
* 
*  MOVE ONE WORD AT A TIME
*  SCANNING FOR 00 AT END OF WORD 
 MOVE1    BSS    0
          MX7    0                 RAISE FALSE CONDITION FLAG 
         SA7       NUMFLG         .TURN OFF FLAG
         SB7       0               .ZERO ASCII COUNT
          SX2    7777B             RESET MASK 
 MOVEL01  BX6       -X1*X3              X6 = UPPER
          LX3       X5,B6               X3 = OLD
          BX7       X1*X3               X7 = LOWER
          BX6       X6+X7               X6 = NEW
          BX7       X2*X6 
          SA6       B4                  STORE ( NEW ) 
          ZR        X7,MOVEL02          END OF MOVE 
          BX5       X2*X5 
 +        ZR        X5,*+1
          SA5       A5+1                FETCH ( NEXT )
          SB4       B4+1
          SX4       X4+1                UP WORD-COUNT 
          LT     B4,B3,TRYOUT  BR, NEW IN ADDR NOT AT *LIMIT* 
          SA2       B5+FETFRST
          SB4       X2
          SX2    7777B             POINT = FIRST
* 
*         THIS PATH USED BY KRONOS NON-ASCII
*         THIS PATH USED BY KRONOS ASCII, NUMERIC ITEM
*         THIS PATH USED BY SCOPE NON-ASCII 
* 
 TRYOUT   BSS    0
          NE     B4,B2,MOVEL01 BR, NEW IN ADDR NOT AT *OUT* 
* 
* NEW IN ADDRESS IS AT *OUT*
          RJ     CHKSAVE       SAVE REGS REQUIRED BY BASOMOV
          RJ     BASOCHK       GO FLUSH CIO BUFFER OUT
          RJ     CHKRSTOR      RESTORE SAVED REGS, SU CIO ADDRS 
          EQ     MOVEL01
          IFC    EQ,,"OS.NAME",KRONOS,
*   FOLLOWING DOES CHARACTER MOVE,SCANNING FOR 74 AND 76
*   CHARACTERS,INDICATING ASCII  12 BIT CHARACTERS
CHMOV    SB7       0                .ZERO ASCII COUNT 
CMASK    SB1       10             .CHARACTER COUNT
         SA2       AFLG           .TEST ASCII FLAG
         ZR        X2,CHLST       .TO DETERMINE IF 1ST CH IS EXEMPT 
         SX6       FALSE          .ZERO ASCI FLAG 
         SA6       AFLG 
         SB1       B1-1           .EXEMPT 1ST CH BY INDEXING
         LX5       6              .AND SHIFTING 
CHLST    SX2       77B            .RESET MASK 
CHLOOP   LX5       6              .LOOP - SHIFT TO START
         BX0       X5*X2                - MASK LEFT CHARACTER 
         SX0       X0-CMASK2            - 76 TEST FIRST 
         ZR        X0,ASCI
         SX0       X0+2      . 74 TEST SECOND 
         ZR        X0,ASCI
         SB1       B1-1                 - INDEX 
LPTEST   NE        B1,B0,CHLOOP         - TEST IF THROUGH 
WLOOP    BX6       -X1*X3          .MASK OUT UNUSED BITS
         LX3       X5,B6          .SHIFT NEW WORD 
         BX7       X1*X3          .MASK OUT LOWER BITS
         BX6       X6+X7          .FORM WORD TO BE PLACED IN BUFFER 
         SA6       B4             .STORE IN BUFFER
          SX2    7777B             MASK FOR STRING TERMINATOR 
         BX7       X2*X6          .MASK FOR 00
         ZR        X7,MOVEL02     .END MOVE 
         BX5       X2*X5
         ZR        X5,MOVEL09     .AVOID SCANNING LAST WORD TWICE 
         SA5       A5+1           .NEXT WORD TO BE MOVED
         SX4       X4+1           .UP WORD COUNT (10 CHARACTERS)
         SB4       B4+1           .NEXT FREE WORD IN BUFFER 
          LT     B4,B3,TRYOUT1 BR, NEW IN NOT AT *LIMIT*
         SA2      B5+FETFRST
         SB4       X2             .GET ADDRESS TOP OF BUFFER
         SX2        77B 
* 
*         THIS PATH USED BY KRONOS ASCII, WORD JUST MOVED HAD ZBD 
* 
 TRYOUT1  BSS    0
          NE     B4,B2,CMASK   BR, NEW IN NOT AT *OUT*
* 
*FALL  THRU NEW IN AT *OUT*, MUST FLUSH CIO BUFFER
          RJ     CHKSAVE       SAVE REGS THAT ARE IN USE BY BASOMOV 
          RJ     BASOCHK       GO TO FLUSH BUFFER 
          RJ     CHKRSTOR      RESTORE REGS AND SET UP CIO ADDRS
          EQ     CMASK
MOVEL09  SX4       X4+1           . 
         SB4       B4+1 
* 
*         THIS PATH USED BY KRONOS ASCII, WORD JUST STORED
*         DID NOT HAVE ZBD, BUT BALANCE OF INPUT WORD CONTAINS ZBD
          LT     B4,B3,TRYOUT2   BR, NEW IN NOT AT *LIMIT*
         SA2       B5+FETFRST 
         SB4       X2 
         SX2        77B 
 TRYOUT2  BSS    0
          NE     B4,B2,WLOOP   BR, NEW IN NOT AT *OUT*
* 
*FALL THRU, NEW IN AT *OUT*, MUST FLUSH CIO BUFFER
          RJ     CHKSAVE       SAVE REGS IN USE BY BASOMOV
          RJ     BASOCHK       GO FLUSH CIO BUFFER
          RJ     CHKRSTOR      RESTORE REGS AND SET UP CIO ADDRS
          EQ     WLOOP
ASCI      SB7      B7+1              .ASCII COUNTER 
         SB1       B1-1           .INDEX
         NE        B1,B0,ASCI2    .TEST IF LAST CHARACTER 
         SX6       TRUE           .IF LAST,TURN ON ASCII FLAG TO
         SA6       AFLG           .EXEMPT,1ST OF NEXT WORD
         EQ        LPTEST         .RETURN 
ASCI2    LX5       6              .EXEMPT NEXT CHARACTER
         SB1       B1-1 
         EQ        LPTEST         .RETURN 
          ENDIF 
* 
* 
* 
 MOVEL02  SX7       B4
          NZ     X6,MOVE40         OK IF NON ZERO WORD
* 
* LAST WORD STORED WAS ZERO 
*         IF X4 WHICH CONTAINS OUTPUT ITEM WORD COUNT IS ZERO,
*         THEN WE MUST HAVE STORED A NULL IN 1ST WORD OF OUTPUT.
          ZR     X4,MOVE40       BR, STORED NULL AT 1ST OUTPUT WD OF STR
* 
* STORED ZERO AT OTHER THAN 1ST OUTPUT WORD.
*         WE CHECK TO SEE IF PREVIOUS WORD FILLED WITH DATA 
          SA2    B5+FETFRST        CHECK IF ZERO WORD IS
          SA2    X2                   FIRST WORD OF BUFFER
          SX2    A2-B4
          NZ     X2,MOVE41         IF SO, GET PREVIOUS WORD 
          SA2    B5+FETLIMT           FROM END OF BUFFER
          SA2    X2-1 
          EQ     MOVE43 
MOVE41    BSS    0
          SA2    B4-1              GET PREVIOUS WORD
MOVE43    BSS    0
          SX5    77B               CHECK IF PREVIOUS WORD 
          BX5    X5*X2                IS COMPLETED
          NZ     X5,MOVE40         JUMP IF SO 
          BX6    X2                ELSE WORD IS INCOMPLETE
          SX4    X4-1              DECREASE WORD COUNT--ZERO WORD 
          SX7    A2                SET FETFRST TO PREV WORD 
MOVE40    BSS    0
          SA7    B5+FETIN          UPDATE *IN*
* 
* 
*         COUNT CHARACTERS IN LAST WORD 
          IFC    EQ,,"OS.NAME",SCOPE ,
          SA2    ASCII
          ZR   X2,MOVEL04          NON-ASCII MODE 
          SX2    7777B             COUNT 12-BIT CHARS 
          SX7    5
 MOVEL05  AX6    12 
          BX5    X2*X6
          SX7    X7-1              COUNT CHAR 
          ZR   X7,MOVEL06          ALL WORD DONE
          ZR   X5,MOVEL05          LOOP 
 MOVEL06  SA5    OPH               CHARS IN LAST WORD BEFORE MOVE 
          IX2    X7-X5             NET CHARS ADDED TO LAST WORD 
          PL   X2,MOVEL07 
          SX4    X4-1              ADJUST 
          SX2    X2+5 
 MOVEL07  BSS    0
          BX7    X2          X7=PHYSICALLY ADDED CHAR, X4=WORDS 
          SX2    1           ADJUST FOR 5 CHAR WORDS
          BX2    X2*X4
          AX4    1           HALVE THE WORD COUNT 
          ZR     X2,MOVEL09 
          SX7    X7+5 
 MOVEL09  BSS    0
          SA2    B5+FETCHAR        OLD WORD/CHAR COUNT
          SX5    X2                CHARS
          AX2    30                WORDS
          IX2    X2+X4             NEW WORDS
          IX5    X5+X7             NEW CHARS
          SX4    X5-10
          ZR   X4,MOVEL08          SKIP IF LE 5 CHAR
          NG   X4,MOVEL08 
          SX5    X5-10       ADJUST 
          SX2    X2+1 
 MOVEL08  LX2    30                ASSEMBLE WORDS AND CHARS 
          BX7    X2+X5
          EQ   CHMOD1              GO STORE NEW FETCHAR 
          ENDIF 
* 
* 
* 
* 
 MOVEL04  SX2    77B               CHECK 6-BIT CHARS
          SX7       10
 MOVEL03  AX6       6 
          BX5       X2*X6 
          SX7       X7-1                COUNT CHARACTERS
 +        ZR        X7,*+1              ALL THE WORD SHIFTED
          ZR        X5,MOVEL03
* 
         SA5       OPH
MOD9       IX2     X7-X5          .CALCULATE WORDS
           ZR      X2,MOD8        .AND CHARACTERS PHYSICALLY
           PL      X2,MOD8        .ADDED TO BUFFER
           SX4     X4-1           .BORROW 10
           SX7     X7+10
           EQ      MOD9 
MOD8       BX7     X2             .X7-PHYSICALLY ADDED CHARS
*                                 .X4-PHYSICALLY ADDED WORDS
         SX5       B7             .ASCII COUNT TO X5
CHMOD0   IX3       X7-X5          . GET TRUE COUNT BY 
         NG        X3,CHMOD2      . SUBTRACTING ASCII COUNT 
         SA2    B5+FETCHAR   .GET OLD WORD/CH COUNT 
         SX5    X2           .CH COUNT
         AX2    30           .W  COUNT
         IX2    X2+X4        .TOTAL W COUNT 
         IX5    X5+X3        .TOTAL CH COUNT (CORRECTED FOR ASCII)
         SX3    10           .CH PER W
         IX4    X5-X3        . TEST IF GT 10 CH 
         ZR     X4,CHMOD3    .BRANCH IF 10 CH 
         NG     X4,CHMOD3    .BRANCH IF LT 10CH 
         SX2    X2+1         .CASE WHERE GT 10 CH 
         SX5    X5-10        .DECREASE CH INCREASE W
CHMOD3   LX2    30           .W COUNT TOP 30 BITS 
         BX7    X2+X5        .ASSEMBLE NEW FETCHAR
         EQ     CHMOD1
CHMOD2    SX4      X4-1 
         SX7       X7+10
         EQ         CHMOD0
* 
* 
CHMOD1   BSS       0
          SA7       B5+FETCHAR          RESET COUNT 
          NZ   X7,MOVEND           SKIP IF SOME CHARACTERS
*  WE HAVE JUST MOVED A NULL ITEM INTO A NEW LINE 
*  IF FOLLOWED BY EOL FORCE A CHAR COUNT OF ONE 
*  IN ORDER TO PRINT A NULL LINE (ZERO WORD)
          SA1    MOVERX4           TAB CODE 
          PL   X1,MOVEND           SKIP IF NOT EOL
          SX7    1                 FORCE CHARCOUNT ONE
          SA7    A7 
 MOVEND   BSS    0
         SA4       MOVERX4          .RESTORE X4 
          SA1       MOVERB3 
          SA2       MOVERB4 
          SB3       X1
          SB4       X2
         SA1       MOVERB1
         SA2       MOVERB7
         SB1       X1 
         SB7       X2 
          SA1    MOVERB2
          SB2    X1              B2 NOW RESTORED
          EQ        BASOMOV 
* 
 CHKSAVE  PS 0
*         ROUTINE TO SAVE REGS IN USE BY BASOMOV PRIOR TO RJ TO BASOCHK 
          BX6    X1 
          BX7    X2 
          SA6    BMVSVX1       X1 -SHIFT MASK- SAVED
          SA7    BMVSVX2        X2 -CHARACTER EXTRACT MASK- SAVED 
          BX6    X3 
          BX7    X4 
          SA6    BMVSVX3        X3 -RESIDUE OF INPUT WORD- SAVED
          SA7    BMVSVX4        X4 -OUTPUT ITEM WORD COUNT- SAVED 
          BX6    X5 
          SA6    BMVSVX5     X5 - NEXT WORD TO BE PROCESSED 
          SX6    A5 
          SA6    BMVSVA5       A5 -ADDRESS OF CURRENT INPUT WORD- SAVED 
          SX6    B6 
          SX7    B7 
          SA6    BMVSVB6       B6 -LOOP VARIABLE- SAVED 
          SA7    BMVSVB7       B7 -ASCII ESC COUNT- SAVED 
          SA2    B5+FETFRST 
          SB2    X2          B2 = FIRST 
          NE     B2,B4,CHKSAV1         SKIP IF IN NOT EQU FIRST 
          SB4    B3          B4 = LIMIT 
 CHKSAV1  SX6    B4-1        X6 = IN -1 
          SA6    B5+FETIN    UPDATE IN POINTER
          EQ     CHKSAVE
* 
 CHKRSTOR PS     0
*         ROUTINE TO RESTORE REGS SAVED PRIOR TO CALL TO BASOCHK
*         AND TO SET UP *IN* *OUT* *LIMIT* ADDRS IN BREGS 
          SA1    B5+FETIN 
          SA2    B5+FETOUT
          SA3    B5+FETLIMT 
          SB4    X1            B4 CONTAINS *IN* ADDR
          SB2    X2            B2 CONTAINS *OUT* ADDR 
          SB3    X3            B3 CONTAINS *LIMIT* ADDR 
          SB4    B4+1        RE ADJUST  IN
          NE     B4,B3,CHKRST1         SKIP IF IN NOT EQU LIMIT 
          SA2    B5+FETFRST 
          SB4    X2          B4 = FIRST = IN
 CHKRST1  SA1    BMVSVB6
          SA2    BMVSVB7
          SB6    X1              B6 RESTORED
          SB7    X2              B7 RESTORED
          SA2    BMVSVA5
          SA5    X2          A5 RESTORED
          SA1    BMVSVX5
          BX5    X1          X5 RESTORED
          SA4    BMVSVX4       X4 RESTORED
          SA3    BMVSVX3       X3 RESTORED
          SA2    BMVSVX2       X2 RESTORED
          SA1    BMVSVX1       X1 RESTORED
          EQ     CHKRSTOR 
* 
* 
* 
* THIS ROUTINE CHECKS THE PREVIOUS WORD MOVED TO THE BUFFER TO
* DETERMINE IF IT ENDED IN A COLON-BLANK SEQUENCE(ONLY IF BLANK ADDED 
* INTERNALLY BY THE COMPILER). IF A COLON-BLANK IS FOUND THEN VARIOUS 
* POINTERS ARE RESET TO MOVE THE NEW DATA INTO THE BUFFER BEGINING AT 
* THE CHARACTER POSITION FORMORLY HELD BY THE APPENDED BLANK. 
* 
* 
 PRCOLON  DATA   7LPRCOLON
          SA2    ASCII       IF THIS IS AN ASCII STRING,
          NZ     X2,PRCOLON    --EXIT-- 
          SX2    A5          CHECK IF NULL POINTER WORD 
          ZR     X2,PRCOLON  BR, THIS IS A NULL POINTER WORD
          SA2    A5          CHECK IF THIS IS A NULL STRING 
          ZR     X2,PRCOLON  BR, THIS IS A NULL STRING
          SA2    PRVBLCL     GET PREVIOUS BLANK-APPENDED-TO-ENDING-COLON-FLAG 
          ZR     X2,CLBL1    BR, PREVIOUS STRING MOVED TO BUFFER DIDNT
*                              INCLUDE A BLANK APPENDED TO ENDING COLON 
          SA2    B5+FETCHAR  CHECK IF THIS IS A NEW LINE
          ZR     X2,CLBL1    BR, THIS IS EITHER A NEW LINE OR A 
*                              LEADING BLANK FOR A NEW LINE 
          SB7    60          THIS IS USED TO CHECK VALUE OF B1
          EQ     B1,B7,CLBL3 IF B1=60 THEN WE MUST PROCESS THE PREVIOUS WORD
          SB1    B1+6        BITS-OF-ZERO-COUNTER + 6 (I.E. COUNT BLANK AS ZERO 
          SB6    B6-1        SUBTRACT 1 FROM CHARACTER COUNT(BACK OVER BLANK) 
 CLBL1    SA2    COLNBLK     GET CURRENT BLANK-APPENDED-TO-ENDING-COLON FLAG
          BX7    X2            AND STORE IT IN THE PREVIOUS STRING'S
          SA7    PRVBLCL       BLANK-APPENDED-TO-ENDING-COLON FLAG
          EQ     PRCOLON     RETURN 
* 
* THIS BLOCK OF CODE PROCESSES THE CASE WHERE A COLON-BLANK SEQUENCE HAS ENDED
* THE PREVIOUS WORD. IN THIS CASE THE FET POINTERS MUST BE RESET SO THAT THE
* NEW STRING WILL BE MOVED TO THE BUFFER BEGINING AT THE CHARATER POSITION THAT 
* THE BLANK OCCUPIES. 
* 
* 
 CLBL3    SA2    B5+FETFRST 
          SB7    X2          B7 = POINTER TO FETFRST
          NE     B7,B4,CLBL5 BR, *IN* NOT EQUAL *FIRST* 
          SB4    B3          SET *IN* = *LIMIT* 
 CLBL5    SB4    B4-1        *IN* = *IN* - 1 (OR POSSIBLY LIMIT - 1)
          SX6    B4          COPY THE NEW *IN* POINTER FOR STORAGE
          SA6    B5+FETIN    STORE THE NEW IN POINTER IN THE FET
          SB1    6           RESET BITS OF ZERO COUNTER TO LAST 6 BITS
          SB6    9           RESET CHARACTER COUNTER TO 9 CHARACTERS
          EQ     CLBL1       RETURN 
* N O T E  -  NO PROVISION MADE TO HANDLE THE STATUS
* RETURN IN B6 FROM BASOCHK 
* 
* 
 BMVSVX1   BSSZ   1 
 BMVSVX2  BSSZ   1
 BMVSVX3  BSSZ   1
 BMVSVX4  BSSZ   1
 BMVSVX5  BSSZ   1
 BMVSVB6  BSSZ   1
 BMVSVB7  BSSZ   1
 BMVSVA5  BSSZ   1
* 
* 
 MOVERB2  BSSZ   1
 MOVERB3  BSSZ      1 
 MOVERB4  BSSZ      1 
MOVERB1  BSSZ      1
MOVERB7  BSSZ      1
MOVERX4  BSSZ      1
OPH      BSSZ      1         . TEMP FOR OLD PHYSICAL C COUNT
 PRVBLCL  BSSZ   1           FLAG INDICATES IF PREVIOUS STRING MOVED HAD
 COLNBLK  BSSZ   1           BLANK APPENDED TO ENDING COLON IN CONSTANT STRING F
*                            BLANK-APPENDED-TO-ENDING-COLON CONDITION 
* 
AFLG     DATA      0              .ASCII FLAG 
CMASK1   EQU        74B 
CMASK2   EQU        76B 
*         END CHARACTER-MOVE
* 
* 
 IFOS     IFC    EQ,,"OS.NAME",SCOPE ,
 ASCII95  BSS    0
* 
*  95 CHARACTER ASCII TRANSLATE TABLE 
* 
*  UPPER 30 BITS OF EACH WORD CONVERTS ASCII TO 6/12 DISPLAY CODE 
*  LOWER 30 BITS CONVERTS 6/12 DISPLAY CODE TO ASCII
* 
 ASC      MACRO  OCT,DEC
          VFD    30/OCT_B,30/DEC
          ENDM
* 
          ASC    -7640,58          NUL  COLON 
          ASC    -7641,65          SOH  A 
          ASC    -7642,66          STX  B 
          ASC    -7643,67          ETX  C 
          ASC    -7644,68          EOT  D 
          ASC    -7645,69          ENQ  E 
          ASC    -7646,70          ACK  F 
          ASC    -7647,71          BEL  G 
          ASC    -7650,72          BS   H 
          ASC    -7651,73          HT   I 
          ASC    -7652,74          LF   J 
          ASC    -7653,75          VT   K 
          ASC    -7654,76          FF   L 
          ASC    -7655,77          CR   M 
          ASC    -7656,78          SO   N 
          ASC    -7657,79          SI   O 
          ASC    -7660,80          DLE  P 
          ASC    -7661,81          DC1  Q 
          ASC    -7662,82          DC2  R 
          ASC    -7663,83          DC3  S 
          ASC    -7664,84          DC4  T 
          ASC    -7665,85          NAK  U 
          ASC    -7666,86          SYN  V 
          ASC    -7667,87          ETB  W 
          ASC    -7670,88          CAN  X 
          ASC    -7671,89          EM   Y 
          ASC    -7672,90          SUB  Z 
          ASC    -7673,48          ESC  0 
          ASC    -7674,49          FS   1 
          ASC    -7675,50          GS   2 
          ASC    -7676,51          RS   3 
          ASC    -7677,52          US   4 
          ASC    55,53             SPACE  5 
          ASC    66,54             EXCLAMATION  6 
          ASC    64,55             QUOTE  7 
          ASC    60,56             POUND  8 
          ASC    53,57             $  9 
 IFCSET   IFEQ   IP.CSET,IP.C63 
          ASC    -7404,43          PERCENT   +
 IFCSET   ELSE
          ASC    63,43             PERCENT   +
 IFCSET   ENDIF 
          ASC    67,45             AMPERSAND  - 
          ASC    70,42             APOSTROPHE  *
          ASC    51,47             OPEN PAREN  /
          ASC    52,40             CLOSE PAREN  OPEN PAREN
          ASC    47,41             *  CLOSE PAREN 
          ASC    45,36             +  $ 
          ASC    56,61             ,  = 
          ASC    46,32             -  SPACE 
          ASC    57,44             .  , 
          ASC    50,46             /  . 
          ASC    33,35             0  POUND 
          ASC    34,91             1  OPEN BRKT 
          ASC    35,93             2  CLOSE BRKT
 IFCSET   IFEQ   IP.CSET,IP.C63 
          ASC    36,58             3   COLON
 IFCSET   ELSE
          ASC    36,37             3   PERCENT
 IFCSET   ENDIF 
          ASC    37,34             4  QUOTE 
          ASC    40,95             5  UNDERLINE 
          ASC    41,33             6  EXCLAMATION 
          ASC    42,38             7  AMPERSAND 
          ASC    43,39             8  APOSTROPHE
          ASC    44,63             9  QUESTION
 IFCSET   IFEQ   IP.CSET,IP.C63 
          ASC    63,60             COLON   LESS 
 IFCSET   ELSE
          ASC    0,60              COLON  LESS
 IFCSET   ENDIF 
          ASC    77,62             ;  GREATER 
          VFD    30/72B,1/1,29/ASCII954    LESS   74B 
          ASC    54,92             =  BACKSLASH 
          VFD    30/73B,1/1,29/ASCII956    GREATER   76B
          ASC    71,59             QUESTION   ; 
 ASCII954 BSS    0                 74XX CONVERSION STARTS HERE
          ASC    -7401,0           AT   UNUSED
          ASC    1,64              UPPERCASE A     AT 
          ASC    2,94              B   CIRCUMFLEX 
          ASC    3,0               C   UNUSED 
 IFCSET   IFEQ   IP.CSET,IP.C63 
          ASC    4,37              D   PERCENT
 IFCSET   ELSE
          ASC    4,58              D   COLON
 IFCSET   ENDIF 
          ASC    5,17        E (67)         ALTERNATE DC1 (7405)
          ASC    6,19        F              ALTERNATE DC3 
          ASC    7,96        G              GRAVE (7407)
 ASCII956 BSS    0           76XX CONVERSION STARTS HERE
          ASC    10,96       H              OLD GRAVE (7600)
          ASC    11,97       I              LCA (LOWER CASE A)
          ASC    12,98       J              LCB 
          ASC    13,99       K (75)         LCC 
          ASC    14,100      L              LCD (7604)
          ASC    15,101      M              LCE 
          ASC    16,102      N              LCF 
          ASC    17,103      O              LCG 
          ASC    20,104      P (80)         LCH (7610)
          ASC    21,105      Q              LCI 
          ASC    22,106      R              LCJ 
          ASC    23,107      S              LCK 
          ASC    24,108      T              LCL (7614)
          ASC    25,109      U (85)         LCM 
          ASC    26,110      V              LCN 
          ASC    27,111      W              LCO 
          ASC    30,112      X              LCP (7620)
          ASC    31,113      Y              LCQ 
          ASC    32,114      Z (90)         LCR 
          ASC    61,115      OPEN BRACKET   LCS 
          ASC    75,116      BACK SLASH     LCT (7624)
          ASC    62,117      CLOSE BRACKET  LCU 
          ASC    -7402,118   CIRCUMFLEX     LCV 
          ASC    65,119      UNDERLINE (95) LCW 
          ASC    -7407,120   GRAVE          LCX (7630)
          ASC    -7601,121   LCA            LCY 
          ASC    -7602,122   LCB            LCZ 
          ASC    -7603,123   LCC            OPEN BRACE
          ASC    -7604,124   LCD (100)      VERTICAL BAR (7634) 
          ASC    -7605,125   LCE            CLOSE BRACE 
          ASC    -7606,126   LCF            TILDE 
          ASC    -7607,127   LCG            DEL 
          ASC    -7610,0     LCH            NUL (7640)
          ASC    -7611,1     LCI            SOH 
          ASC    -7612,2     LCJ            STX 
          ASC    -7613,3     LCK            ETX 
          ASC    -7614,4     LCL            EOT (7644)
          ASC    -7615,5     LCM            ENQ 
          ASC    -7616,6     LCN (110)      ACK 
          ASC    -7617,7     LCO            BEL 
          ASC    -7620,8     LCP            BS (7650) 
          ASC    -7621,9     LCQ            HT
          ASC    -7622,10    LCR            LF
          ASC    -7623,11    LCS (115)      VT
          ASC    -7624,12    LCT            FF (7654) 
          ASC    -7625,13    LCU            CR
          ASC    -7626,14    LCV            SO
          ASC    -7627,15    LCW            SI
          ASC    -7630,16    LCX (120)      DLE (7660)
          ASC    -7631,17    LCY            DC1 
          ASC    -7632,18    LCZ            DC2 
          ASC    -7633,19    OPEN BRACE     DC3 
          ASC    -7634,20    VERTICAL BAR   DC4 (7664)
          ASC    -7635,21    CLOSE BRACE    NAK 
          ASC    -7636,22    TILDE          SYN 
          ASC    -7637,23    DEL (127)      ETB 
          ASC    0,24        UNUSED (128)   CAN (7670)
          ASC    0,25        UNUSED         EM
          ASC    0,26        UNUSED         SUB 
          ASC    0,27        UNUSED         ESC 
          ASC    0,28        UNUSED         FS (7674) 
          ASC    0,29        UNUSED         GS
          ASC    0,30        UNUSED         RS
          ASC    0,31        UNUSED         US (7677) 
* 
 IFOS     ENDIF 
* 
* 
          TITLE  BASICON - INPUT CONVERT PROCEDURE
* 
* 
          TITLE  BASICON
* 
*         INPUT - CONVERT 
* 
*         INPUT -- FIRST CHARACTER IN X1 B7 CHARACTER-POINTER 
*         OUTPUT -- DELIMITER IN X1  NUMBER IN X6 
* 
* 
 NONUMBR  EQU         1 
 INERROR  EQU         2 
 NEWNUMB  EQU         2 
 DISPLUS  EQU         45B              . DISPLAY CODE PLUS SIGN 
 DISZERO  EQU         33B              . DISPLAY CODE ZERO
 NMBLNGH  EQU         14               . MAX NO OF SIG DIGITS IN NUMBER 
 LOWERE   EQU         293              . MINIMUM NEGATIVE EXPONENT
* 
* 
          DATA        10HBASICON
 BASICON  BSSZ        1 
          SX7         B5
          SA6         FFINTFL           SAVE INTEGER-FLAG 
          SA7       FFCHANL             SAVE CHANNEL
          SX0         B0               . TYPE = REAL
          SA2       B5+FETSTAT
          SX7       X2
          SA7       KWDXXXX             SET KBLANK-LOCAL
          SX6    B0+B0
          SX7    B0+B0
          SA6         B0+MVALLCL       . CLEAR MANTISSA VALUE 
          SA7         B0+MSIGLCL       . CLEAR MANTISSA SIGNIFICANT LNTH
          SA6         B0+MSINLCL       . CLEAR MANTISSA SIGN(POSITIVE)
          SA7         B0+MLENLCL       . CLEAR MANTISSA TOTAL LENGTH
          SA6         B0+MPNTLCL       . CLEAR MANTISSA POINT POSITION
          SA7         B0+DVALLCL       . CLEAR EXPONENT VALUE 
          SA6         B0+DSINLCL       . CLEAR EXPONENT SIGN(POSITIVE)
          SA7         B0+FFSTLCL       . FREE-FORM STATE..= 0(NEUTRAL)
          EQ          FFANAL
* 
* 
* DETERMINE IF THE VALUE RETURNED FROM BASIUNP IS THE PSUEDO NULL VALUE.
* BASICON WILL TREAT THE PSUEDO NULL VALUE AS A BLANK LINE. THEREFORE,
* IF THE NULL VALUE IS RETURNED THIS ROUTINE WILL PUT A BLANK IN X1 FOR 
* BASICON TO PROCESS. 
* 
 CHKNULL  SX2    X1-205B
          NZ     X2,FFANAL   BR, THIS IS NOT A NULL STRING
          SX1    55B         ELSE, FOR NODATA AND NUMERIC INPUTS TREAT
*                            AS A BLANK LINE (CONSISTING OF 1 BLANK AND 
*                            AN EOL). 
          EQ     FFANAL 
* 
* 
* 
*  CONTROL REACHES HERE TO GET THE NEXT CHARACTER FROM THE CHANNEL
 FFLOOP   SA1         B7               . NEXT CHARACTER 
          SB7         B7+1             . BUMP CHARACTER COUNTER 
* 
*  CONTROL REACHES HERE WITH A CHARACTER IN X1 TO ANALYSE 
FFANAL   BSS       0
         SA2       DLMTSW     CHECK IF DELIMITER SWITCH ON
         ZR        X2,FFANAL1 
 BASCDT1 NO                   CHECK IF DELIMITER
*                             BASCOMP BUILDS RJ =XCHKDLMT HERE
          BSS    0
          ZR     X3,FFDLMET  DELIMITER MET
FFANAL1  BSS       0
          PL   X1,FFANAL2          SKIP IF NOT ESCAPE CODE
          MX7    -6 
          BX1    -X1
          BX1    -X7*X1 
 FFANAL2  BSS    0
         SA2       X1+FFCLASS   ELSE CLASSIFICATION TABLE ENTRY 
          SA3         B0+FFSTLCL       . CURRENT STATE
          UX4         B6,X2            . B6..= CLASS OF CHARACTER(0-6)
          SB6         X3+B6            . B6..= RELATIVE TABLE ENTRY ADDR
          SA5         B6+FFSTACT       . X5..= CORRESPONDING TABLE ENTRY
          SB5         X5               . B5..= ACTION ADDRESS 
          LX5         21               . NEW STATE*8 TO LOW ORDER 
          SX4         770B             . MASK 
          BX7         X4*X5            . ISOLATE NEW STATE*8
          SA7         B0+FFSTLCL       . SAVE AS NEW STATE
          JP          B5               . JUMP TO WHERE THE ACTION IS
* 
DLCLASS  EQU       5          CLASS FOR DELIMITERS
FFDLMET  BSS       0
         SA3       FFSTLCL    CURRENT STATE 
         SB6       X3+DLCLASS   ACTION TABLE OFFSET FOR DELIMITER 
         SA5       B6+FFSTACT   GET ACTION ADDRESS
         SB5       X5         AND PUT IT IN B5
         SX7       0           SET NEW STATE AS NEUTRAL 
         SA7       FFSTLCL     STORE NEW STATE
         JP        B5         GO PERFORM ACTION 
* 
* 
*         CONTROL REACHES HERE WITH EMPTY UNPACK-BUFFER 
 FFREAD   RJ       FFREAD0
          EQ     CHKNULL
 FFREAD0  DATA      0 
          SA2       FFCHANL 
          SB5       X2
          SA1    B5+FETFRST 
          SA2    B5+FETOUT
          SX5    B7-INPBUFF-1      NUMBER OF CHAR ABOVE OUT 
          IFC    EQ,,"OS.NAME",KRONOS,
          SA3    ASCII
          ZR,X3  FFREAD5A 
          ZR,X5  FFREAD5A 
          MI,X5  FFREAD5A 
          SA4    B5+FETLIMT 
          SX4    X4          X4 = LIMIT 
          SX6    B4 
          SA6    =SSAVEB4    SAVE B4
          SX6    B3 
          SA6    =SSAVEB3    SAVE B3
          SB3    X5          B3 = CHARACTERS IN THE STRING. 
          SB4    0           CHARACTERS READ FROM THE STRING
          MX0    54D         7..700 
 GETWORD  SA3    X2          GET WORD 
          SB6    10          CHARS LEFT IN WORD 
 GETCHAR  LX3    6
          BX7    -X0*X3      GET NEXT CHARACTER 
          SB6    B6-1        DECREMENT CHARS REMAINING IN WORD
          SX6    ESC2        X6 = 76B 
          IX6    X7-X6       IF ASCII (76XX)
          ZR     X6,CHARCNT  BR, THIS IS AN ASCII CHARACTER 
          SX6    ESC1        X6 = 74B 
          IX6    X7-X6       IF ASCII (74XX)
          ZR     X6,CHARCNT  BR, THIS IS AN ASCII CHARACTER 
          SB4    B4+1 
          EQ     REMCHAR
 CHARCNT  SX5    X5+1        ...INCREMENT CHARACTER COUNT 
 REMCHAR  EQ     B4,B3,FFREAD5  IF ALL CHARACTERS SCANNED 
          NZ,B6  GETCHAR        IF MORE CHARACTERS TO READ
          SX2    X2+1           END OF WORD, GET NEXT WORD
          IX6    X4-X2       X6 = LIMIT - OUT 
          NZ     X6,GETWORD  BR, NEW OUT NOT AT LIMIT 
          SX2    X1          ELSE, SET OUT TO FIRST 
          EQ     GETWORD
 FFREAD5  SA2    SAVEB3 
          SB3    X2 
          SA2    SAVEB4 
          SB4    X2 
          SA2    B5+FETOUT
 FFREAD5A BSS    0
          ENDIF 
          SX7    X2 
          SX2    10 
          IFC    EQ,,"OS.NAME",SCOPE ,
          SA3    ASCII             ASCII RUN FLAG 
          ZR     X3,FFREAD4  NON-ASCII MODE 
          SX2    5                 CHAR/WORD
          ENDIF 
 FFREAD4  SA3    B5+FETLIMT 
          SX3    X3 
* 
 FFREAD2  SA7    A2 
          IX5    X5-X2             DECR COUNT BY CHAR/WORD
          NG        X5,FFREAD1          END OF LOOP 
          SX7       X7+1
          IX6       X3-X7 
          NZ        X6,FFREAD2          NOT LIMIT 
          SX7       X1
          EQ        FFREAD2 
 FFREAD1  IX6    X5+X2
          IFC    EQ,,"OS.NAME",KRONOS,
          SA3    ASCII
          ZR     X3,FFREAD6 
          SA3    X7          GET NEXT WORD
          SB6    X6 
          MX2    54 
 FFREAD9  ZR     B6,FFREAD6  GET THE LOGICAL CHARACTERS IN FETCHAR
          MI,B6  FFREAD6
          SB6    B6-1 
          LX3    6
          BX5    -X2*X3 
          SX7    X5-ESC1
          ZR     X7,FFREAD7 
          SX7    X5-ESC2
          ZR     X7,FFREAD7 
          EQ     FFREAD9
 FFREAD7  SX6    X6-1        DECREMENT ONE CHAR IF ASCII CODE 
          EQ     FFREAD9
 FFREAD6  BSS    0
          ENDIF 
          SA6         B5+FETCHAR        RESET CHARACTER-COUNT 
          SB6         INPBUFF 
          SB7         INPLNGT 
          RJ          BASIUNP           UNPACK INPLNGT CHARACTERS 
          SA2       B5+FETCHAR
          SB7         X2+INPBUFF        RESET CHARACTER-POINTER 
          SA1         B7
          SB7         B7+1              UP POINTER
          SX0         B0               . TYPE = REAL
          EQ        FFREAD0 
* 
* 
*CONTROL REACHES HERE FOR NON-NUMERIC IN NEUTRAL STATE
FFALPN   BSS       0          CHECK IF DELIMITER FIRST
*                             IGNORE DELIMITERS AT END OF LINE
          SA2    DLMTSW            CHECK NON-STANDARD DELIMITER SWITCH
          NZ     X2,FFDLMT         SKIP IF SPECIAL DELIMITER(S) IN USE
          SX2       X1-1R,
          ZR        X2,FFLOOP          COMMA OK, OTHER ERROR
         SA2       FFINTFL    GET TYPE
         NG        X2,FFEXIT3   RETURN WITH NO NUMBER,  ELSE
* 
* 
*  CONTROL REACHES HERE ON ALL SYNTACTIC ERRORS 
 FFERROR  SX1         -INERROR         . NUMBER INPUT ERROR 
          SX5         0                 SET RESULT TO ZERO
          EQ          FFEXIT2 
 FFDLMT2  BSS    0
          SA1    B7 
          SB7    B7+1 
FFDLMT    BSS    0
 BASCDT2  NO                       CALL DELIMITER MATCH 
*                             BASCOMP BUILDS RJ =XCHKDLMT HERE
          BSS    0
          NG     X3,FFDLMT1  NOT MET
 FFDLMT0  BSS    0
          BX7    X7-X7
          SA7    ASW
          EQ     FFLOOP 
* 
 FFDLMT1  BSS    0
         SA2       FFINTFL    ELSE GET TYPE 
         NG        X2,FFEXIT3  IF NO NUMBERWANTED, EXIT 
         EQ        FFERROR    ELSE ERROR IN INPUT 
* 
* 
 FFBLNK0  BSS    0                 BLANK IN NEUTRAL STATE 
          SA2    DLMTSW 
          ZR   X2,FFLOOP           IGNORE IF BLANK IS DELIMITER 
          SA2    FFINTFL           CHECK IF NODATA SCAN 
          NG   X2,FFEXIT3          RETURN NEW-NUMBER IF SO
          EQ   FFLOOP              ELSE IGNORE
* 
* 
*      *********          ACTIONS FOLLOW          **********************
* 
*  CONTROL REACHES HERE ONLY WHEN THE NUMBER HAS NOT YET BEGUN
 FFLINE   SX1         -NONUMBR         . NO NUMBER
          SX5         0                 SET RESULT TO ZERO
          EQ          FFEXIT2 
* 
*  CONTROL REACHES HERE WITH A SIGN AS THE FIRST CHARACTER OF A NUMBER
 SYN01    BSS         0                .
          SA2         FFINTFL          . GET TYPE 
          NG          X2,FFEXIT3       . RETURN NO NUMBER 
          SX7         X1-DISPLUS       . MAP PLUS SIGN=0, MINUS SIGN=1
          SA7         B0+MSINLCL       . SAVE SIGN OF NUMBER
          JP          FFLOOP           . NEXT CHARACTER 
* 
*  CONTROL REACHES HERE WITH THE FIRST DIGIT OF A NUMBER (NO SIGN)
 INT02    BSS         0                .
          SA2         FFINTFL          . GET TYPE 
          NG        X2,FFEXIT3         . RETURN NO NUMBER 
*  CONTROL REACHES HERE WITH AN INTERIOR DIGIT OF AN INTEGER
 INT22    SX5         X1-DISZERO       . MAP DIGITS TO 0-9 INTO X5
          SA2         B0+MSIGLCL       . MANTISSA SIGNIFICANT LENGTH
          SA3         B0+MVALLCL       . MANTISSA VALUE 
          SA4         B0+MLENLCL       . MANTISSA TOTAL LENGTH
          BX1         X3               . VALUE NOW IN X1 AND X3 
          SX6         X4+1             . BUMP TOTAL LENGTH COUNTER
          LX3         2                . X3 = 4*VALUE 
          SA6         A4               . SAVE NEW TOTAL LENGTH
          IX4         X3+X1            . X4 = 4*VALUE+1*VALUE = 5*VALUE 
          SX6         X2+1             . BUMP NO OF SIG MANTISSA DIGITS 
          LX4         1                . X4 = 2*5*VALUE = 10*VALUE
          IX7         X4+X5            . X7 = 10*VALUE + NEW DIGIT
          SX1         X2-NMBLNGH       . SET FOR TEST OF NO SIG DIGITS
          ZR          X7,FFLOOP        . IF X7=0,OLD VALUE,NEW DIGIT=0
          SA6         A2               . IF NOT 0, STORE NEW MANT. COUNT
          PL          X1,FFLOOP        . JUMP IF ALREADY 14 SIG. DIGITS 
          SA7         A3               . IF NOT, STORE NEW VALUE
          JP          FFLOOP           . NEXT CHARACTER 
*  CONTROL REACHES HERE WITH THE FIRST DIGIT OF A NUMBER(AFTER A SIGN)
 INT12    EQU         INT22 
*  CONTROL REACHES HERE WITH THE FIRST DIGIT AFTER A POINT
 DEC34    EQU         INT22 
*  CONTROL REACHES HERE WITH EACH DIGIT AFTER THE FIRST AFTER A POINT 
 DEC44    EQU         INT22 
* 
*  CONTROL REACHES HERE WITH AN INITIAL POINT IN A NUMBER (NO SIGN) 
 DEC03    BSS         0                .
          SA2         FFINTFL          . GET TYPE 
          NG          X2,FFEXIT3       . RETURN NO NUMBER 
*  CONTROL REACHES HERE WITH A POINT AFTER AT LEAST ONE DIGIT OR DEC03
 INT23    BSS         0                .
          SA1         FFINTFL 
          NZ          X1,INT20         . IF INTEGER-FLAG THEN COMPL. NO.
          SA1         B0+MLENLCL       . NO OF DIGITS PASSED
          BX6         X1
          SA6         B0+MPNTLCL       . SET AS POINT POSITION
          JP          FFLOOP           . NEXT CHARACTER 
*  CONTROL REACHES HERE WITH AN INITIAL POINT IN A NUMBER(AFTER A SIGN) 
 DEC13    EQU         INT23 
*  CONTROL REACHES HERE WITH A SUB-TEN AFTER AT LEAST ONE DIGIT,NO POINT
 INT25    EQU         INT23 
* 
*  CONTROL REACHES HERE WITH AN INITIAL SUB-TEN IN A NUMBER (NO SIGN) 
 EXP05    SX7         1                . SINCE   XXX = U  XXX 
          SA7         B0+MVALLCL       .MANTISSA VALUE..=1
          SA7         B0+MLENLCL       . MANTISSA LENGTH..=1
          SA7         B0+MSIGLCL       . MANTISSA SIGNIFICANT LENGTH..=1
          SA7         B0+MPNTLCL       . MANTISSA POINT POSITION..=1
          JP          FFLOOP           . NEXT CHARACTER 
*  CONTROL REACHES HERE WITH AN INITIAL SUB-TEN IN A NUMBER (AFTER SIGN)
 EXP15    EQU         EXP05 
* 
*  CONTROL REACHES HERE WITH A SUB-TEN AFTER A DIGIT AFTER A POINT
 DEC45    EQU         FFLOOP           . NEXT CHARACTER 
*  CONTROL REACHES HERE WITH A SUB-TEN AFTER A PERIOD 
 DEC35    EQU         DEC45 
*  CONTROL REACHES HERE WITH A SIGN IMMEDIATELY AFTER A SUB-TEN 
 EXP56    SX7         X1-DISPLUS       . MAP PLUS SIGN=0,MINUS SIGN=1 
          SA7         B0+DSINLCL       . SAVE AS EXPONENT SIGN
          JP          FFLOOP           . NEXT CHARACTER 
* 
*  CONTROL REACHES HERE WITH THE FIRST DIGIT AFTER A SUB-TEN
 EXP57    SA2         B0+DVALLCL       . CURRENT EXPONENT VALUE 
          SX5         X1-DISZERO       . MAP DIGITS TO 0-9 INTO X5
          SX3         X2-1000          . FOR TESTING SIZE OF EXPONENT 
          PL          X3,FFLOOP        . JUMP IF ALREADY GREATER 1000 
          BX4         X2               . SAVE VALUE IN X4 
          LX2         2                . X2 = 4*VALUE 
          IX3         X2+X4            . X3 = 4*VALUE + 1*VALUE =5*VALUE
          LX3         1                . X3 = 2*5*VALUE=10*VALUE
          IX7         X3+X5            . X7 = 10*VALUE +NEW DIGIT 
          SA7         A2               . STORE NEW VALUE
          JP          FFLOOP           . NEXT CHARACTER 
*  CONTROL REACHES HERE WITH THE FIRST DIGIT AFTER A SIGN AFTER SUB-TEN 
 EXP67    EQU         EXP57 
*  CONTROL REACHES HERE WITH A DIGIT,OTHER THAN THE FIRST, AFTER SUB-TEN
 EXP77    EQU         EXP57 
* 
*  CONTROL REACHES HERE WITH A BLANK IN ANY STATE (EXCEPT 0)
FFBLNK   BSS       0
         SA2       DLMTSW     IF DELIMITED IGNORE BLANK 
         NZ        X2,FFLOOP
*                             NOTE BLANK AS DELIMITER IS CHECKED BY 
*                                      SYNTAX TABLE 
         SX1       KKKKKKK-FFCLASS     CHAR  = SPECIAL K BLANKS CHAR
          SA2         B0+KWDXXXX       . X2..= K DELIMITER WORD 
          SX4         X2-1
         ZR        X4,FFANAL1   IF 1 BLANK DELIMITS, JUMP 
          SX6         1 
          SA6         B0+BCNTLCL       . BLANK COUNTER..=1
          SA7         B0+SVSTLCL       . SAVE CURRENT STATE 
          SX7         8*8              . NEW STATE..= 8  NEW STATE IS 
          SA7         B0+FFSTLCL       . MULTIPLIED BY 8 FOR ADDRESSING 
          JP          FFLOOP           . NEXT CHARACTER 
* 
*  CONTROL REACHES HERE WITH A BLANK IN THE BLANK SCANNING STATE (8)
 BLNK88   SA4         B0+BCNTLCL       . X4..= BLANK COUNTER
          SA2         B0+KWDXXXX       . X2..= K DELIMITER WORD 
          SX6         X4+1             . UP THE BLANK COUNT 
          IX5         X2-X6            . X5..= K - NO OF BLANKS 
          SA6         A4               . SAVE UPDATED BLANK COUNTER 
          NZ          X5,FFLOOP        . GET NEXT CHAR IF NOT KTH BLANK 
          SX1         KKKKKKK-FFCLASS    CHAR..= SPECIAL K BLANKS CHAR
*  CONTROL REACHES HERE WITH A NON-BLANK IN THE BLANK SCANNING STATE
 BLNK80   SA2         B0+SVSTLCL       . STATE BEFORE BLANK SCANNING ST 
          BX7         X2               . RESTORE TO X7 AND
          SA7         B0+FFSTLCL       . AS CURRENT STATE 
          JP          FFANAL           . ANALYSE NEW CHAR IN RESET STATE
* 
*  CONTROL REACHES HERE WITH THE BYTE WHICH TERMINATES AN INTEGER 
 INT20    SA2         B0+MLENLCL       . MANTISSA TOTAL LENGTH
          BX6         X2               . STORE AS 
          SA6         B0+MPNTLCL       . MANTISSA POINT POSITION
          SX0         1                . TYPE = INTEGER 
*  CONTROL REACHES HERE WITH THE BYTE WHICH TERMINATES THE EXPONENT PART
 EXP70    SA2         B0+DSINLCL       . EXPONENT SIGN
          SA4         B0+DVALLCL       . EXPONENT VALUE 
          ZR          X2,DEC40         . IF SIGN IS POSITIVE-OK 
          BX7         -X4              . IF NEGATIVE, COMPLEMENT VALUE
          SA7         A4               . SAVE NEW VALUE 
*  CONTROL REACHES HERE WITH THE BYTE WHICH TERMINATES THE FRACTION PART
 DEC40    SA2         B0+MSIGLCL       . MANTISSA SIGNIFICANT LENGTH
          SA4         B0+DVALLCL       . EXPONENT VALUE (IF ANY)
          SX3         X2-NMBLNGH-1     . TO TEST LENGTH 
          NG          X3,NORMTRM       . JUMP IF NOT MORE THAN 14 SIGS. 
          SX5         X2-NMBLNGH       . EXCESS OVER 14 
          IX7         X4+X5            . ADD TO EXPONENT (TREAT LIKE
          SA7         A4               . POWERS OF 10) AND SAVE 
*  CONTROL REACHES HERE TO CONVERT ALL NUMBERS TO FLOATING-POINT FORM 
 NORMTRM  SA1         B0+MVALLCL       . MANTISSA VALUE 
          ZR          X1,FFEXIT1       .JUMP TO GET ZERO RESULT 
          SA2         B0+MPNTLCL       . MANTISSA POINT POSITION
          SA3         B0+MLENLCL       . MANTISSA TOTAL LENGTH
          PX4         B0,X1            . X4 = FLOATING POINT OF MANTISSA
          IX7         X2-X3            . LENGTH OF FRACTION PART
          NX5         B0,X4               . NORMAL FLOATING-POINT FORM
          SA2         B0+DVALLCL       . EXPONENT VALUE 
          IX1         X2+X7            . ADJUST EXPONENT BY FRACTIONAL
          SB5         -2               . INITALIZE POINT OF EXP TABLE 
          PL          X1,LOOPEND       . JUMP IF EXPONENT IS POSITIVE 
          SB5         -1               . IF SO, MODIFY POINTER AND
          BX1         -X1              . COMPLEMENT EXPONENT-NOW NORMAL 
 LOOPEND  SB5         B5+2             . COUNTS 0,2,4 OR 1,3,5
          SA3         B5+AA            . 100,10,OR 1 FOR BOTH POS. NEG
          SA4         B5+CC1           . FLOAT OF LOWER RANGE (+ OR -)
 EXPLOOP  ZR          X1,NUMSIGN       . JUMP IF CURRENT EXPONENT ZERO
          IX6         X1-X3            . EXPONENT - LOWER RANGE 
          NG          X6,LOOPEND       . TEST IF LOWER RANGE TOO BIG
*  CHECK EXPONENTS TO SEE IF RESULTING NUMBER WILL BE VALID.
          SX2    B2                SAVE B2
          SX1    B3                SAVE B3
          UX7    X4,B2             B2 = EXPONENT OF MULTIPLIER
          UX7    X5,B3             B3 = EXPONENT OF NORMAL FLOATING PT. NO. 
          SB2    B2+B3             B2 = EXPONENT OF RESULT
          SB3    1770B             B3 = TEST VALUE
          GT     B2,B3,EXPERR      ERROR BR IF MULTIPLY RESULT WOULD BE BAD 
*  CALCULATE FLOATING POINT NUMBER
          SB2    X2                RESTORE B2 
          SB3    X1                RESTORE B3 
          RX5         X5*X4            . ROUND FLOAT PROD 
          IR   X5,EXPOK            JUMP IF STILL IN RANGE 
 EXPERR   BSS    0                 EXPONENT ERROR 
          SB2    X2                RESTORE B2 
          SB3    X1                RESTORE B3 
          SB7    B7-1              EXP TOO BIG, BACK UP OVER DELIM
          EQ   FFERROR             EXIT WITH ERROR
 EXPOK    BSS    0
          BX1         X6               . SAVE NEW EXPONENT
          JP          EXPLOOP          . ONWARD AND DOWNWARD
*  CONTROL REACHES HERE WITH THE F-P NUMBER IN X5 (UNSIGNED AS YET) 
 NUMSIGN  SA2         B0+MSINLCL       . MANTISSA SIGN
          ZR          X2,FFEXIT        . JUMP IF NUMBER POSITIVE
          BX5         -X5              . IF NEGATIVE, COMPLEMENT IT 
* 
*  CONTROL REACHES HERE WITH THE SIGNED F-P NUMBER IN X5(UV)
 FFEXIT   BSS         0 
* 
*            EXIT ROUTINE 
* THIS ROUTINE DOES THE FOLLOWING:  
*         1)SETS THE UNPACK BUFFER POINTER TO THE POSITION OF THE LAST
*           CHARACTER CHECKED;
*         2)SKIPS ALL TRAILING BLANKS;
*         3)SAVES THE DELIMITER;
*         4)SETS X6 TO THE RESULT NUMBER (IF ANY);
*         5)SETS X1 TO THE APPROPRIATE TYPE FLAG; 
*         6)RESETS B5 TO THE FET ADDRESS OF THE INPUT FILE; 
*         7)RESETS ASW TO ZERO. 
* 
          SB5    B0          B5 = FLAG FOR NUMBER OF BLANKS SKIPPED 
          SB7    B7-1        B7 = POINTER CURRENT ITEM IN UNPACK BUFFER 
          SA2    ASW
          ZR     X2,SKPBLK1  BR, LAST ITEM DIDNT INCLUDE ASCII ESC CODE 
          SB7    B7-1        ELSE, SKIP OVER ASCII ESC CODE 
* 
* SKIP OVER TRAILING BLANKS 
* 
 SKPBLK1  SB5    B5+1        B5 = FLAG FOR TRAILING BLANKS SKIPPED
          SA1    B7          PICK UP CURRENT ITEM FROM THE UNPACK BUFFER
          SB7    B7+1        SET POINTER TO NEXT ITEM IN UNPACK BUFFER
 SKPBLK2  SX2    X1-1R
          ZR     X2,SKPBLK1  BR, LAST ITEM WAS A BLANK--CHECK FOR MORE
* 
          SB5    B5-1        LAST ITEM WAS NOT A BLANK
* 
* LAST ITEM CHECKED WAS NOT A BLANK. SEE IF IT IS END OF BUFFER.
* IF IT IS, REFILL THE BUFFER AND CHECK FOR MORE BLANKS.
* 
          SX2    IREND
          NZ     X2,SAVDLMT  BR, LAST ITEM WAS NOT END OF BUFFER
* 
* REFILL BUFFER AND CHECK FOR MORE BLANKS 
* 
          BX6    X5          SAVE RESULT
          SA6    SAVETOT
          SX6    B5          SAVE BLANKS SKIPPED FLAG 
          SA6    SAVBLFL
          RJ     FFREAD0     REFILL THE UNPACK BUFFER 
          SA5    SAVBLFL     RESET BLANKS SKIPPED FLAG
          SB5    X5 
          SA5    SAVETOT     RESET RESULT 
          EQ     SKPBLK2     LOOK FOR MORE TRAILING BLANKS
* 
* SAVE THE DELIMITER FOR BASISCN
* 
 SAVDLMT  SB7    B7-1        SET B7 TO CURRENT ITEM IN UNPACK BUFFER
          ZR     B5,DELSAV   BR, NO TRAILING BLANKS READ OR SKIPPED 
* 
          SA2    DLMTSW      ELSE, SPECIAL PROCESSING IF USER DELIMITERS
          NG     X2,SPCDLMT  BR, USER DELIMITERS ARE IN EFFECT
* 
          SX1    1R          ELSE, RETURN BLANK AS DELIMITER
* 
 DELSAV   SX6    X1 
          SA6    BASLDMT     SAVE THE DELIMITER 
* 
* RETURN TYPE FLAG IN X1 AND RESULT IN X6 
* 
          SX1    X0          X1 = TYPE FLAG 
* 
 FFEXIT2  BX6    X5          X6 = RESULT
          SA2    FFCHANL
          SB5    X2          B5 = FET ADDRESS OF INPUT FILE 
          SX7    B0 
          SA7    ASW         ZERO OUT ASCII ESC CODE FLAG 
          EQ     BASICON     RETURN 
* 
* THIS EXIT IS USED WHEN NO NUMBER IS REQUESTED (E.G. NODATA) ON ENTRY
* TO BASICON AND THE CURRENT ITEM IN THE UNPACK BUFFER IS NOT END OF
* BUFFER AND NOT END OF LINE. 
* 
*  NOTE ===> THE RESULT FLAG IS SET TO NONUMBER (1=INTEGER) WHICH 
*            INDICATES TO BASISCN THAT NO ERROR HAS OCURRED.
*            THE DELIMITER IS SET TO -NONUMBER (-1) TO INDICATE THAT
*            NO FURTHER DELIMITER CHECKING IS NEEDED. 
*            SEE BASISCN FOR MORE INFORMATION ON NO NUMBER PROCESSING 
* 
 FFEXIT3  SB7    B7-1        B7=POINTER TO CURRENT ITEM IN UNPACK BUFFER
          SX0    NONUMBR     X0 = TYPE FLAG 1 = INTEGER 
          SX1    -NONUMBR    DELIMITER = -1 
          SX5    B0          CLEAR RESULT -- NO NUMBER RETURNED 
          EQ     DELSAV      SAVE THE -1 AS DELIMITER.
 FFEXIT1  SX5         0                .ZERO RESULT 
          JP          FFEXIT           .JOIN NORMAL EXIT
* 
* THIS ROUTINE CHECKS TO SEE IF A BLANK IS SPECIFIED AS A DELIMITER.
* IF SO, THEN A BLANK IS RETURNED AS THE DELIMITER SINCE TRAILING BALNKS
* HAVE BEEN READ AND SKIPPED. 
* IF NOT, THEN THE CURRENT ITEM IS RETURNED AS THE DELIMITER. 
* 
 SPCDLMT  SX1    1R          X1 = BLANK 
 BASCDT3  NO                 BASERRS BUILDS RJ =XCHKDLMT HERE 
          SX1    1R          ENSURE X1 = BLANK IN CASE IT WAS CHANGED 
          ZR     X3,DELSAV   BR, SAVE BLANK AS THE DELIMITER
          SA1    B7          ELSE, PICK UP CURRENT ITEM IN UNPACK BUFFER
          EQ     DELSAV      AND SAVE AS THE DELIMITER. 
* 
* 
* 
 SAVBLFL  BSSZ   1           SAVE SKIPPED TRAILING BLANKS COUNTER-FLAG
* 
* 
* 
*  CONTROL REACHES HERE WHEN THE SIGN IS NOT FOLLOWED BY A DIGIT, ., OR 
 SYN10    EQU         FFERROR 
*  CONTROL REACHES HERE WHEN A POINT IS NOT FOLLOWED BY A DIGIT 
 DEC30    EQU         DEC40 
*   CONTROL REACHES HERE WHEN SUB-TEN IS FOLLOWED BY EOL
 EXP50    EQU         FFERROR 
*  CONTROL REACHES HERE WHEN EXPONENT SIGN IS NOT FOLLOWED BY A DIGIT 
 EXP60    EQU         FFERROR 
          TITLE  FFCLASS-FFSTACT TABLE
* 
*  THE FOLLOWING TABLE IS A COMBINATION OF TWO TABLES WHICH ARE USED
*  IN CONJUNCTION WITH EACH OTHER, BUT ARE OTHERWISE LOGICALLY SEPARATE 
*  THE TWO TABLES ARE.. 
*                        CHARACTER CLASSIFICATION TABLE (UPPER 12-BITS) 
*                        STATE/ACTION TABLE (LOWER 48 BITS) 
* 
*   CONTROL REACHES HERE WHEN SUB-TEN IS FOLLOWED BY A LETTER 
 EXP55    SX1    X1-14B      CHECK LAST CHAR FOR *L*
          NZ     X1,FFERROR  IF NOT ITS AN ILLEGAL NO 
          SB7    B7-1        ELSE ASSUME *ELSE* AND RESET 
          EQ     DEC40
 FFSTACT  EQU       *+1-$/59
 FFCLASS  EQU       *+1-$/59
*                                                       CLASS DELIMITER 
*         STATE 0 - NEUTRAL 
 +        VFD         12/2005B,6/02,24/0,18/INT02   OTHER DIGIT 
          VFD         12/2005B,6/03,24/0,18/DEC03    OTHER POINT
 +        VFD       12/2005B,6/00,24/0,18/FFALPN  OTHER SUB-TEN 
          VFD         12/2005B,6/01,24/0,18/SYN01    OTHER PLUS/MINUS 
          VFD         12/2005B,6/00,24/0,18/FFBLNK0  OTHER BLANK
          VFD         12/2002B,6/00,24/0,18/FFALPN   OTHER OTHER
 +        VFD         12/2005B,6/00,24/0,18/FFLINE  OTHER LINE
          VFD         12/2005B,6/00,24/0,18/FFREAD   OTHER ENDBUF 
*         STATE 1 - FIRST AFTER LEADING PLUS OR MINUS SIGN
 +        VFD         12/2005B,6/02,24/0,18/INT12   OTHER DIGIT 
 +        VFD         12/2005B,6/03,24/0,18/DEC13   OTHER POINT 
 +        VFD         12/2005B,6/05,24/0,18/EXP15   OTHER SUB-TEN 
 +        VFD         12/2005B,6/00,24/0,18/SYN10   OTHER PLUS-MINUS
          VFD         12/2005B,6/01,24/0,18/FFBLNK   OTHER BLANK
          VFD         12/2005B,6/00,24/0,18/SYN10    OTHER OTHER
          VFD         12/2005B,6/00,24/0,18/SYN10    OTHER LINE 
 +        VFD         12/2005B,6/01,24/0,18/FFREAD  OTHER ENDBUF
*         STATE 2 - GATHERING INTEGER DIGITS
          VFD         12/2005B,6/02,24/0,18/INT22    OTHER DIGIT
 +        VFD         12/2005B,6/03,24/0,18/INT23   OTHER POINT 
          VFD    12/2005B,6/09,24/0,18/INT25    OTHER SUB-TEN 
          VFD         12/2005B,6/00,24/0,18/INT20    OTHER PLUS/MINUS 
 +        VFD         12/2005B,6/02,24/0,18/FFBLNK  OTHER BLANK 
          VFD         12/2005B,6/00,24/0,18/INT20    OTHER OTHER
 +        VFD         12/2005B,6/00,24/0,18/INT20   OTHER LINE
          VFD         12/2005B,6/02,24/0,18/FFREAD   OTHER ENDBUF 
*         STATE 3 - FIRST AFTER DECIMAL POINT 
 +        VFD         12/2005B,6/04,24/0,18/DEC34   OTHER DIGIT 
 +        VFD         12/2005B,6/00,24/0,18/DEC30   OTHER POINT 
 +        VFD         12/2005B,6/05,24/0,18/DEC35   OTHER SUB-TEN 
 +        VFD         12/2000B,6/00,24/0,18/DEC30   DIGIT PLUS/MINUS
 +        VFD         12/2000B,6/03,24/0,18/FFBLNK  DIGIT BLANK 
 +        VFD         12/2000B,6/00,24/0,18/DEC30   DIGIT OTHER 
 +        VFD         12/2000B,6/00,24/0,18/DEC30   DIGIT LINE
 +        VFD         12/2000B,6/03,24/0,18/FFREAD  DIGIT ENDBUF
*         STATE 4 - GATHERING FRACTIONAL DIGITS 
 +        VFD         12/2000B,6/04,24/0,18/DEC44   DIGIT DIGIT 
 +        VFD         12/2000B,6/00,24/0,18/DEC40   DIGIT POINT 
 +        VFD         12/2000B,6/05,24/0,18/DEC45   DIGIT SUB-TEN 
 +        VFD         12/2000B,6/00,24/0,18/DEC40   DIGIT PLUS/MINUS
 +        VFD         12/2000B,6/04,24/0,18/FFBLNK  DIGIT BLANK 
 +        VFD         12/2003B,6/00,24/0,18/DEC40   PLUS  OTHER 
 +        VFD         12/2003B,6/00,24/0,18/DEC40   MINUS LINE
 +        VFD         12/2005B,6/04,24/0,18/FFREAD  OTHER ENDBUF
*         STATE 5 - FIRST AFTER EXPONENT INDICATOR(SUB-TEN= APOSTROPHE) 
          VFD         12/2005B,6/07,24/0,18/EXP57    OTHER DIGIT
          VFD         12/2005B,6/00,24/0,18/EXP50    OTHER POINT
          VFD         12/2005B,6/00,24/0,18/EXP50    OTHER SUB-TEN
 +        VFD         12/2005B,6/06,24/0,18/EXP56   OTHER PLUS/MINUS
          VFD         12/2005B,6/05,24/0,18/FFBLNK   OTHER BLANK
          VFD    12/2004B,6/00,24/0,18/EXP55    BLANK OTHER 
          VFD         12/2005B,6/05,24/0,18/EXP50    OTHER LINE 
          VFD         12/2001B,6/05,24/0,18/FFREAD   OTHER ENDBUF 
*         STATE 6 - FIRST AFTER EXPONENT PLUS OR MINUS SIGN 
 +        VFD         12/2005B,6/07,24/0,18/EXP67   OTHER DIGIT 
 +        VFD         12/2005B,6/00,24/0,18/EXP60   OTHER  POINT
 +        VFD         12/2005B,6/00,24/0,18/EXP60   OTHER SUB-TEN 
 +        VFD         12/2005B,6/00,24/0,18/EXP60   OTHER PLUS/MINUS
 +        VFD         12/2005B,6/06,24/0,18/FFBLNK  OTHER BLANK 
 +        VFD         12/2005B,6/00,24/0,18/EXP60   OTHER OTHER 
 +        VFD         12/2005B,6/00,24/0,18/EXP60   OTHER LINE
 +        VFD         12/2005B,6/06,24/0,18/FFREAD  OTHER ENDBUF
*         STATE 7 - GATHERING EXPONENT DIGITS 
 +        VFD         12/2005B,6/07,24/0,18/EXP77   OTHER DIGIT 
 +        VFD         12/2005B,6/00,24/0,18/EXP70   OTHER  POINT
 +        VFD         12/2005B,6/00,24/0,18/EXP70   OTHER SUB-TEN 
 +        VFD         12/2005B,6/00,24/0,18/EXP70   OTHER PLUS/MINUS
*                NOTE THAT BITS 18-20 IN THE NEXT ENTRY HOLD TYPE 
*                OF CHAR FOR USE BY THE SUBSTR CONVERSION.
 +         VFD   12/2005B,6/07,24/1,18/FFBLNK    OTHER  BLNK
 +        VFD         12/2005B,6/00,24/0,18/EXP70   OTHER OTHER 
 +         VFD   12/2005B,6/00,24/1,18/EXP70     OTHER  LINE
 +        VFD         12/2005B,6/07,24/0,18/FFREAD  OTHER ENDBUF
*         STATE 8 - PASSING INTERIOR BLANK CHARACTERS 
          VFD         12/2007B,6/00,24/0,18/BLNK80
          VFD         12/2006B,6/00,24/2,18/BLNK80
 KKKKKKK  VFD         12/2005B,6/00,24/0,18/BLNK80  KBLNK SUB-TEN 
 +        VFD         12/2005B,6/00,24/0,18/BLNK80  NUSED PLUS/MINUS
 +        VFD         12/2005B,6/08,24/0,18/BLNK88  NUSED BLANK 
 +        VFD         12/2005B,6/00,24/0,18/BLNK80  NUSED OTHER 
 +        VFD         12/2005B,6/00,24/0,18/BLNK80  NUSED LINE
 +        VFD         12/2005B,6/08,24/0,18/FFREAD  NUSED ENDBUF
*         STATE 9 - FIRST AFTER SUB-TEN AFTER INTEGER 
          VFD    12/2005B,6/07,24/0,18/EXP57    NUSED DIGIT 
          VFD    12/2005B,6/00,24/0,18/EXP50    NUSED POINT 
          VFD    12/2005B,6/00,24/0,18/EXP50    NUSED SUB-TEN 
          VFD    12/2005B,6/06,24/0,18/EXP56    NUSED PLUS/MINUS
          VFD    12/2005B,6/05,24/0,18/FFBLNK   NUSED BLANK 
          VFD    12/2005B,6/00,24/0,18/EXP50    NUSED OTHER 
          VFD    12/2005B,6/00,24/0,18/EXP50    NUSED LINE
          VFD    12/2005B,6/00,24/0,18/FFREAD   NUSED ENDBUF
* 
*         END    INPUT - CONVERT
* 
* 
*  TABLE OF EXPONENT RANGES FOR CREATION OF FLOATING POINT NUMBER 
 AA       DATA        100 
          DATA        100 
          DATA        10
          DATA        10
          DATA        1 
          DATA        1 
*  TABLE OF FLOATING-POINT EQUIVALENTS FOR ABOVE RANGES 
 CC1      DATA        1.0E+100
          DATA        1.0E-100
          DATA        1.0E+10 
          DATA        1.0E-10 
          DATA        1.0E+1
          DATA        1.0E-1
* 
* 
 MVALLCL  BSSZ        1 
 MSIGLCL  BSSZ        1 
 MSINLCL  BSSZ        1 
 MLENLCL  BSSZ        1 
 MPNTLCL  BSSZ        1 
 DVALLCL  BSSZ        1 
 DSINLCL  BSSZ        1 
 FFSTLCL  BSSZ        1 
 SVSTLCL  BSSZ        1 
 BCNTLCL  BSSZ        1 
 FFINTFL  BSSZ        1 
 FFCHANL  BSSZ      1 
 KWDXXXX  BSSZ      1 
 INPBUFF  BSS       INPLNGT+1 
 INPSCSV  BSS       1 
 ESC1     EQU    74B               KRONOS -ESCAPE- CODE 1 
 ESC2     EQU    76B               KRONOS -ESCAPE- CODE   2 
 KBLNK    EQU    55B               KRONOS BLANK 
 DLMTESC  BSSZ   1                 HOLDS -ESCAPE- CODE BYTE (IF USED) 
 DLMTSW   BSSZ   1                 0/1 FOR STANDARD/NONSTANDARD DELIMS
 DLMTNO   BSSZ   1                 NO OF DELIMITERS (AT MOST 3) 
 DLMT1    EQU    DLMTNO+1 
          BSSZ   3                 BUFFER FOR THE (POSSIBLE) 3 DELIMS 
 DLTKND   BSSZ   1                 NON-ZERO IF AT LEAST 1 DELIM IS AN 
*                                  -ESCAPE- COMBO 
 BASLDMT  BSSZ   1           CONTAINS THE LAST INPUT DELIMITER. 
 SAVETOT  BSSZ   1
          ENTRY  BASLDMT
 ASW      BSSZ   1
* 
          TITLE  BASIUNP - UNPACK TO CHARACTER BUFFER PROCEDURE 
* 
*         PROCEDURE UNPACK
* 
*         ENTRY CONDITIONS: 
*                (B5) = *FET* ADDRESS.
*                (B6) = FWA OF UNPACK BUFFER. 
*                (B7) = NUMBER OF ELEMENTS. 
*         EXIT CONDITIONS:  
*                (B6) = ACTUAL NUMBER OF ELEMENTS.
*                (B7) = ADDRESS OF LAST WORD UNPACKED.
*                (B5) = *FET* ADDRESS.
*                A0,B1,B2,B3,B4 ARE SAVED.
*                DATA HAS BEEN MOVED FROM THE *CIO* BUFFER
*                TO THE UNPACK BUFFER.
* 
 IREND    EQU         100B
 IRLINE   EQU         101B
 IREOP    EQU    103B              END OF PGM 
 UPACKBT  EQU         10
 UPACKLG  EQU         60/UPACKBT
* 
 BASIUNP  DATA        0                 ENTRY 
          MX7    42 
          SX6    A0 
          BX6    -X7*X6      A0 
          LX6    18 
          SX1    B1 
          BX1    -X7*X1 
          BX6    X6+X1       B1 
          LX6    18 
          SX1    B2 
          BX1    -X7*X1 
          BX6    X6+X1       B2 
          SX1    B3 
          SA6    USAVE       A0,B1,B2 
          BX6    -X7*X1      B3 
          SX1    B4 
          LX6    18 
          BX1    -X7*X1 
          BX6    X6+X1       B4 
          SA6    USAVE+1     B3,B4
          SX6    B0                RESET ESCAPE-PENDING FLAG
          SA6    ESCBUF 
          SA1    COMRUNS
          ZR     X1,UNPAK30   SKIP IF RUN TIME
          SA1    SKIPEOL
          ZR   X1,UNPAK30          BYPASS IF SKIP-TO-EOL NOT NEEDED 
          SA6    A1                RESET FLAG 
          RJ   SKIP                SKIP TO EOL
 UNPAK30  BSS    0
          SA5    B5+FETIN    *IN* POINTER.
          SA1         B5+FETOUT         A 
          SA2         B5+FETLIMT        LIMIT 
          BX7    -X5         (X7) = -(*IN* POINTER).
          SA5         B5+FETFRST        FIRST 
          SB1         X1                B1 = WORD-ADDRESS 
          SB2         X2                B2 = LIMIT
          SB4         B0                B4 = COUNT
          MX2         60-UPACKLG
          SA0         -1
          SA4         1 
          SX4         7777B 
          IFC    EQ,,"OS.NAME",KRONOS,
          SA1    ASCII
          ZR   X1,UNPAK08          IF NOT ASCII MODE USE FAST LOOP
          EQ   UNPAK08A            GO START SLOW LOOP 
* 
*  SLOWER LOOP FOR ESCAPE CODE CHECKING AT COMPILE TIME 
* 
 UNPAK07A LX1    UPACKLG
          BX6    -X2*X1            NEXT 6 BIT BYTE
          RJ   CHKESC              CHECK IF ESCAPE CODE 
          GE     B4,B7,UNPAK10A 
          SB3    B3+A0             DECR BYTES LEFT IN WORD
          SA6    B6+B4             STORE UNPACKED BYTE
          SB4    B4+A4             INCR BUFFER PTR
          LT   B0,B3,UNPAK07A      LOOP IF MORE IN WORD 
          SB1    B1+A4             INCR WORD ADDR 
          NE   B1,B2,UNPAK05A      IF OUT .NE. LIMIT
          SB1    X5          SET OUT = FIRST
 UNPAK05A SX3    B1+X7
          NZ   X3,UNPAK08A   IF OUT .NE. IN 
          RJ   UNPAK80       READ MORE DATA 
 UNPAK08A SA1    B1                GET NEW WORD 
          SB3    UPACKBT           RESET BYTE COUNT 
          BX6    X1*X4
          NZ   X6,UNPAK07A         LOOP IF NOT END OF LINE
          SB3    8                 SKIP ZEROS PRECEDING EOL 
          AX1    UPACKLG
 UNPAK01A AX1    UPACKLG
          BX6    -X2*X1            EXTRACT CHAR 
          NZ   X6,UNPAK02A         EXIT IF NONZERO
          SB3    B3+A0             DECR BYTE COUNT
          NZ   B3,UNPAK01A         LOOP TO SKIP ZEROS 
* 
* SEE COMMENTS IN FAST LOOP FOR NULL LINE PROCESSING
* 
* 
          SA3    COMRUNS
          ZR     B4,NULLINE  BR, THIS IS FIRST WORD OF INPUT--POSSIBLY A
*                            NULL LINE. 
          NZ     X3,NOSET    BR, THIS IS COMPILE TIME 
          MX7    1
          LX7    31          SET BIT 30 IN FETFRST TO SIGNIFY LAST ITEM 
          SA3    B5+FETFRST  INPUT FROM THIS FILE ENDED ON WROD BOUNDRY.
          BX7    X7+X3
          SA7    A3          STORE BACK INTO FETFRST
* 
 NOSET    BSS    0           NORMAL PROCESSING
          SA1    A6                ZERO WORD, CHECK LAST CHAR OF PREV WD
          NZ   X1,UNPAK06          EXIT IF NOT ZERO 
          SB4    B4-1              BACKSPACE OVER IT, 11-CHAR EOL 
          EQ   UNPAK06             AND EXIT 
 UNPAK02A SA1    A1                UNPACK NONZERO CHARS IN LAST WORD
 UNPAK03A ZR     B3,UNPAK06    NO MORE LEFT 
          LX1    UPACKLG
          BX6    -X2*X1            EXTRACT CHAR 
          RJ   CHKESC              CHECK IF ESCAPE CODE 
          GE     B4,B7,UNPAK10
          SA6    B6+B4             STORE IT 
          SB3    B3+A0             DECR BYTES LEFT
          SB4    B4+A4             INCR BUFFER PTR
          EQ     UNPAK03A 
* 
*  FASTER LOOP WITH NO ESCAPE CODE CHECKING 
* 
          ELSE
          SA1    ASCII             ASCII FLAG 
          ZR   X1,UNPAK08          NON-ASCII MODE - UNPACK 6-BIT CHARS
* 
*  ASCII MODE - UNPACK 12-BIT CHARACTERS
* 
 PAK4     SA1    B1                FETCH NEXT WORD
          BX6    X1*X4
          ZR   X6,PAK1             SKIP IF EOL WORD 
          SB3    5                 UNPACK 5 12-BIT BYTES
 PAK3     GE     B4,B7,UNPAK10     BUFFER FULL, END 
          LX1    12                NEXT BYTE
          BX6    X4*X1
          SX3    X6-128            CHECK RANGE
          NG   X3,PAK5             0-127 OK 
          SX6    B0                FOLD OTHERS INTO 0 
 PAK5     SA3    ASCII95+X6        GET ESCAPE CODE REPRESENTATION 
          AX3    30                FROM UPPER HALF WORD 
          BX6    X3 
          SA6    B6+B4             STORE IN UNPACK BUFFER 
          SB4    B4+A4             INCR BUFFER PTR
          SB3    B3+A0             DECR BYTES LEFT
          LT   B0,B3,PAK3          LOOP IN WORD 
          SB1    B1+A4             NEXT WORD ADDR 
          EQ     B1,B2,PAK55 IF *LIMIT*, RESET TO *FIRST*.
          SX3    B1+X7
          NZ     X3,PAK4     IF *OUT* NE *IN*.
          RJ     UNPAK80     READ MORE DATA.
          EQ     PAK4 
 PAK55    BSS    0
          SB1    X5                WRAP AROUND TO FIRST 
          EQ   PAK4 
* 
 PAK1     BSS    0                 UNPACK LAST WORD, UP TO 4 BYTES
          SB3    4
          ZR     X1,UNPAK06        SEE IF WHOLE WORD EOL
 PAK6     GE     B4,B7,UNPAK10     BUFFER FULL, END 
          LX1    12 
          BX6    X4*X1
          ZR   X6,UNPAK06          EXIT ON FIRST ZERO 
          SX3    X6-128            CHECK RANGE
          NG   X3,PAK8
          SX6    B0 
 PAK8     SA3    ASCII95+X6        ESCAPE CODE REPRESENTATION 
          AX3    30 
          BX6    X3 
          SA6    B6+B4             STORE
          SB4    B4+A4
          SB3    B3+A0             DECR COUNT 
          LT   B0,B3,PAK6          LOOP IN WORD 
          EQ   UNPAK06             END OF LINE
* 
* 
*  NON-ASCII MODE - UNPACK 6-BIT CHARACTERS 
* 
          ENDIF 
 UNPAK07  GE          B4,B7,UNPAK10    END OF LOOP
          LX1         UPACKLG 
          BX6         -X2*X1           NEXT BYTE
          SB3         B3+A0 
          SA6         B6+B4            MOVE THE BYTE
          SB4         B4+A4 
          LT          B0,B3,UNPAK07    IF NOT NEW WORD THEN LOOP
          SB1         B1+A4 
          NE          B1,B2,UNPAK05    IF OUT .NE. LIMIT
          SB1    X5          SET OUT = FIRST
 UNPAK05  SX3         B1+X7 
          NZ          X3,UNPAK08       IF OUT .NE. IN 
          RJ          UNPAK80          READ MORE DATA 
 UNPAK08  SA1         B1               GET NEW WORD 
          SB3         UPACKBT          RESET COUNT
          BX6         X1*X4 
          NZ          X6,UNPAK07       NOT END OF LINE
*                                  END OF LINE ENCOUNTERED
*                                  GET UPPER PART OF WORD AND 
          SB3    8                    SKIP OVER ZEROS IMMEDIATELY 
          AX1    UPACKLG              PRECEDING END OF LINE 
UNPAK01   AX1    UPACKLG
          BX6    -X2*X1 
          NZ     X6,UNPAK02 
          SB3    B3+A0             DECREASE BYTE COUNT
          NZ     B3,UNPAK01        LOOP TO SKIP OVER ZEROS
* 
* 
* WHEN BASIC SEES A WORD OF BINARY ZEROS ON INPUT, IT CHECKS THE
* FOLLOWING:  
*                1) IS THIS THE FIRST WORD OF THE CURRENT INPUT ITEM; 
*                2) IF THIS IS COMPILE TIME OR RUN TIME;
*                3) IF SPECIAL DELIMITERS ARE IN EFFECT;
* 
*         IF ALL THE ABOVE CONDITIONS ARE MET, A PSUEDO NULL CHARACTER
*         (205B) IS RETURNED ALONG WITH AN END OF LINE PSUEDO CHARACTER 
*         (101B).  IF ANY OF THESE CONDITIONS ARE NOT MET, ONLY THE END 
*         OF LINE CHARACTER IS RETURNED.
* 
* 
          SA3    COMRUNS
          ZR     B4,NULLINE  BR, THIS IS THE FIRST WORD OF AN INPUT ITEM
          NZ     X3,SKIPSET  BR, THIS IS COMPILE TIME 
          MX7    1
          LX7    31          SET BIT 30 IN FETFRST TO SIGNIFY LAST ITEM 
          SA3    B5+FETFRST  INPUT FROM THIS FILE ENDED ON WROD BOUNDRY.
          BX7    X7+X3
          SA7    A3          STORE BACK INTO FETFRST
* 
 SKIPSET  BSS    0           NORMAL PROCESSING
          SA1    A6          LOAD LAST BYTE UNPACKED
          NZ   X1,UNPAK06          EXIT IF NOT ZERO 
          SB4    B4-1        ELSE BACKSPACE OVER THE ZERO BYTE
          EQ   UNPAK06             AND EXIT 
* 
* 
* THIS ROUTINE DETERMINES WHETHER TO RETURN ONLY EOL OR A NULL VALUE
* PLUS EOL WHEN THE FIRST WORD ENCOUNTERED IS A FULL WORD OF ZEROS. 
* ONLY EOL IS RETURNED IF:  
*         1) THIS IS COMPILE TIME;
*         2) SPECIAL DELIMITERS ARE NOT IN EFFECT.
* 
* 
 NULLINE  NZ     X3,UNPAK06  BR, THIS IS COMPILE TIME 
          SA3    DLMTSW 
          ZR     X3,UNPAK06  BR, SPECIAL DELIMITERS ARE NOT IN EFFECT 
* 
* THIS ROUTINE CHECKS IF THIS IS A ZBD FOR THE PREVIOUS STRING INPUTED. 
* IT DOES THIS BY CHECKING BIT 50 OF FETFRST. IF BIT 50 IS NOT SET THEN 
* THIS IS A LEGITIMATE NULL LINE AND A *PSUEDO NULL* CHARACTER IS 
* RETURNED IN THE UNPACK BUFFER.
* 
* IF BIT 50 IS SET, THEN THIS IS A ZBD FOR THE PREVIOUS STRING. THIS ZBD
* HAS NOT BEEN PROCESSED DUE TO THE WAY THE FET POINTERS ARE UPDATED. 
* THEREFORE, WE RETURN ONLY AN EOL. 
* 
          SA3    B5+FETFRST 
          LX3    59-30       TEST BIT 50 TO DETERMINE IF LAST ITEM INPUT
*                            FROM FILE ENDED ON A WORD BOUNDRY
          NG     X3,CLEARBT  BR, THIS IS A ZBD FOR PREVIOUS ITEM INPUT
  
          SX6    205B 
          SA6    B6+B4       STORE PSUEDO NULL CHARACTER IN UNPBUF
          SB4    B4+A4       BUMP THE UNPBUF POINTER
          EQ     UNPAK06
* 
 CLEARBT  MX7    1
          BX7    -X7*X3      CLEAR BIT 30 
          LX7    31          REPOSITION THE WORD
          SA7    B5+FETFRST  STORE THE WORD BACK INTO THE FET 
          EQ     UNPAK06     GO STORE AN EOL. 
* 
* 
UNPAK02   SA1    A1 
UNPAK03   GE     B4,B7,UNPAK10
          ZR     B3,UNPAK06        JUMP IF FINISHED SCAN
          LX1    UPACKLG
          BX6    -X2*X1            EXTRACT CHAR 
          SA6    B6+B4             STORE CHAR 
          SB3    B3+A0             DECREASE BYTE COUNT
          SB4    B4+A4             INCREASE BUFFER PTR
          EQ     UNPAK03           LOOP FOR THE WORD
* 
* 
* 
 UNPAK10A BSS    0
          NZ     X6,UNPAK10     BUFFER FULL, END
          SA1    B1+A4          CHECK NEXT WORD 
          NZ     X1,UNPAK10     NOT EOL,BUFFER FULL 
          EQ     UNPAK06     EXIT 
 UNPAK10  SX6         IREND 
          SA6    SKIPEOL           SET FLAG TO SKIP NEXT TIME 
          SA4    B0                TRICK TO BACK UP OVER WORD THAT CAUSE
                                   LATER SB7 B1+A4 WILL BE NO ADDITION
          EQ   UNPAK77
UNPAK06   BSS    0
          SX6         IRLINE
 UNPAK77  BSS         0 
          SA6         B6+B4            SET LINE-MARK, NO CHANGE OF NUMBR
          SB6         B4                B6 = ACTAUL COUNT 
          SB7       B1+A4 
          LT        B7,B2,UNPAK78 
          SB7       X5
 UNPAK78  BSS       0 
          SA2    USAVE+1
          SA1    USAVE
          SB4    X2 
          AX2    18 
          SB3    X2 
          SB2    X1 
          AX1    18 
          SB1    X1 
          AX1    18 
          SA0    X1          RESTORE A0,B1,B2,B3,B4 
          EQ          BASIUNP 
* 
*         READ MORE DATA INTO THE *CIO* BUFFER. 
* 
 UNPAK80  DATA   0
          SX6    A6 
          SA6    UNPA6       SAVE (A6)
          SX6    B6 
          SA7    OUTSAVE
          SA6    UNPB6
          SX7    B7 
          SA7    UNPB7
          RJ     BASICHK     FORCE READ THRU MIN XFER CHECK.
          NZ     B6,UNPAK10  IF NO MORE DATA. 
          SA4    UNPA6
          SA4    X4 
          BX6    X4 
          SA6    A4          RESTORE (A6) 
          SA4    1
          SA3    UNPB6
          SA2    UNPB7
          SA1    OUTSAVE
          SB6    X3 
          SX4    7777B
          SB7    X2 
          SX7    X1 
          MX2    60-UPACKLG 
          EQ     UNPAK80
* 
* 
* 
 SKIP     DATA   0                 SKIP TO EOL
* 
 SKIP4    SX5    7777B
          SA1    B5+FETOUT
          SX6    X1                X6 = OUT 
          SA2    B5+FETLIMT 
          SX7    X2                X7 = LIMIT 
          SA2    B5+FETFRST 
          SX2    X2                X2 = FIRST 
          SA3    B5+FETIN 
          SX3    X3                X3 = IN
 SKIP3    SA1    X6                FETCH WORD 
          BX4    X5*X1
          ZR   X4,SKIP1            EOL FOUND
          SX6    X6+1              TRY NEXT WORD IN BUFFER
          BX4    X6-X7             COMPARE TO LIMIT 
          NZ   X4,SKIP2 
          SX6    X2                WRAP AROUND
 SKIP2    SA6    B5+FETOUT         UPDATE OUT 
          BX4    X6-X3             COMPARE TO IN
          NZ   X4,SKIP3            LOOP IF MORE IN BUFFER 
          SX6    B6                SAVE B6,B7 
          SX7    B7 
          SA6    UNPB6
          SA7    UNPB7
          RJ   BASICHK             READ MORE
          SX1    B6                SAVE EOR FLAG
          SA2    UNPB6             RESTORE B6,B7
          SB6    X2 
          SA2    UNPB7
          SB7    X2 
          ZR   X1,SKIP4            GO SEARCH THIS BUFFERFULL
          SA1    B5+FETIN          EOR ON READ
          SA2    B5+FETOUT         CHECK IF ANY DATA
          BX1    X1-X2
          NZ   X1,SKIP4            GO PROCESS DATA
          SX6    IREOP             NO MORE DATA 
          SA6    B6                STORE END-OF-PGM 
          SB6    1
          SA1    B5+FETOUT
          SB7    X1                INDICATE NO DATA 
          EQ   BASIUNP             ESCAPE THIS WHOLE MESS 
 SKIP1    SX6    X6+1              FOUND EOL, POINT TO NEXT WORD
          BX1    X6-X7             CHECK FOR LIMIT
          NZ   X1,SKIP5 
          SX6    X2 
 SKIP5    SA6    B5+FETOUT
*         THE FOLLOWING IS ALMOST A DUPLICATE OF ABOVE CODE 
          BX1    X6-X3
          NZ     X1,SKIP
          SX6    B6 
          SX7    B7 
          SA6    UNPB6
          SA7    UNPB7
          RJ     BASICHK
          SX1    B6 
          SA2    UNPB6
          SA3    UNPB7
          SB6    X2 
          SB7    X3 
          ZR     X1,SKIP
          SA1    B5+FETIN 
          SA2    B5+FETOUT
          BX1    X1-X2
          NZ     X1,SKIP
          SX6    IREOP
          SA6    B6 
          SB6    1
          SB7    X2 
          EQ     BASIUNP
* 
* 
 CHKESC   DATA   0                 CHECK FOR ESCAPE CODE
          SA3    ESCBUF 
          NZ   X3,UNPAK21          SKIP IF ESCAPE CODE WAITING
          SX3    X6-ESC1           CHECK FOR ESCAPE CODE
          ZR   X3,UNPAK22 
          SX3    X6-ESC2
          NZ   X3,CHKESC           EXIT IF NOT ESCAPE CODE
 UNPAK22  SA6    ESCBUF            SAVE ESCAPE CODE 
          EQ   CHKESC              BE BACK LATER FOR LOWER HALF 
 UNPAK21  BSS    0                 PREV CHAR WAS ESCAPE CODE
          LX3    UPACKLG
          BX3    X6+X3             ADD LOWER 6 BITS TO GET FULL CHAR
          SX6    B0                RESET ESCAPE-WAITING FLAG
          SA6    A3 
          BX6    -X3     COMPLEMENT 12-BIT CHAR FOR COMPILER RTNS 
          SB4    B4+A0             BACK UP TO STORE OVER PREV WORD
          EQ   CHKESC 
* 
* 
 ESCBUF   DATA   0                 NONZERO IF ESCAPE WAITING
 SKIPEOL  DATA   0                 NONZERO IF SKIP TO EOL BEFORE READ NE
 UNPA6    BSS    1           SAVE (A6)
 UNPB6    BSS    1                 SAVE B6,B7 
 UNPB7    BSS    1
 OUTSAVE  BSS    1
 USAVE    BSSZ   2
* 
*         END UNPACK
* 
          TITLE  BASICHK - INPUT CHECK PROCEDURE
* 
*         PROCEDURE INPUT-CHECK 
* 
*         ENTER  B5=FET ADDRESS 
* 
*         EXIT   B6=0 (NO ERROR AND NOT EOR)
*                B6=2 (NO ERROR AND EOR) AND FILE EMPTY 
* 
*         USES   A1,X1,A2,X2,A3,X3,A4,X4,A6,X6,X7,B6,B7.
* 
*         CALLS CIO=
 BASICHK  SPACE  4
          DATA   10HBASICHK 
  
 BASICHK  PS     0
 BIK1     BSS    0
          IFNE   FETFILE,0
          SA4    FETFILE+B5  GET FET(1) 
          ELSE
          SA4    B5          GET FET(1) 
          ENDIF 
          LX4    59-4        EOR BIT
          SB6    2           SET EOR
          SA1    FETIN+B5    *IN* 
          SA2    FETOUT+B5   *OUT*
          IX3    X1-X2       *IN - *OUT*
          NZ     X3,BIK1A    IF FILE NOT EMPTY
          NG     X4,BASICHK  IF EMPTY AND EOR 
 BIK1A    SB6    B0 
          PL     X3,BIK2     IF *OUT* @ *IN* (X3)=WORDS REMAINING 
          SA3    FETFRST+B5  *FIRST*
          SA4    FETLIMT+B5  *LIMIT*
          SX4    X4          CLEAR UPPER
          SX3    X3          CLEAR UPPER
          IX2    X4-X2       *LIMIT* - *OUT*
          IX1    X1-X3       *IN* - *FIRST* 
          IX3    X1+X2       SUM OF REMAINING SPACE 
* 
 BIK2     BSS    0
*         X3 CONTAINS COUNT OF NUMBER OF WORDS OF DATA LEFT 
*         IN CIO BUFFER; MAY BE ZERO OR GREATER.
* 
*         AT COMPILE TIME, BASICHK ENSURES THAT FETLINL WORDS+2 
*         ARE ALWAYS AVAILABLE IN THE CIO BUFFER. 
* 
*         AT RUN TIME, BASICHK ENSURES AT LEAST ICHKMIN WORDS IN BUFFER.
* 
          SX1    ICHKMIN     X1 = MIN WORDS REQUIRED IN BUFFER
          SA2    COMRUNS
          ZR     X2,SPACETST SKIP IF THIS IS RUNTIME
          SA1    FETLINL+B5   FETCH MARGIN  WORDS/CHARS 
          AX1    30 
          SX1    X1+2 
 SPACETST IX3    X3-X1       REMAINING SPACE - REQUIRED SPACE 
          PL     X3,BASICHK  IF ONE LINE OR MORE REMAINS
          SA2    FETSETV+B5 
          LX2    1           CHECK SET-OCCURRED FLAG (B58)
          NG     X2,RNDMF          SKIP IF SET OCCURRED (RANDOM FILE) 
          IFNE   FETFILE,0
          SA1    FETFILE+B5 
          ELSE
          SA1    B5 
          ENDIF 
          MX4    42 
          SA2    FETSTAT+B5 
          UX2    X2,B7       B7=TYPE OF READ
          SX2    B7+1 
          BX6    X4*X1
          LX1    59-4 
          NG     X1,BASICHK  DO NOT ATTEMPT READ IF EOR 
          BX6    X6+X2
          SA6    A1          STORE READ CODE IN FET(1)
          SX2    A1          FET ADDRESS FOR I/O PROCESSOR
  
          READ   B5,R 
          IFC    EQ,,"OS.NAME",SCOPE ,
** IN SCOPE FORCE EOR AFTER THE READ
** WHEN INPUT COMES FROM THE TERMINAL 
          SA1    B5+FETSTAT        GET THE STATUS WORD FROM FET 
          LX1    59-18       INTERACTIVE BIT
          PL     X1,BIK1     SKIP IF NOT INTERACTIVE
          SA1    B5+FETFILE 
          SX2    EORBIT            BIT 4 IS SET FOR EOR 
          BX6    X1+X2             MERGE EOR BIT WITH READ STATUS 
          SA6    A1          PLACE IN FET 
          ENDIF 
          EQ     BIK1        RE-CHECK BUFFER STATUS BEFORE RETURN 
* 
*         END INPUT-CHECK 
* 
          EJECT 
 RNDMF    BSS    0
          IX3    X3+X1             RECOMPUTE REMAINING SPACE
          SX3    X3-1              1 WORD IS OK FOR RANDOM BINARY FILES 
          PL     X3,BASICHK        EXIT   - STILL OK
  
          SA1    FETROI+B5         CHECK BUFFER-HAS-BEEN-ALTERED FLAG 
          PL     X1,BUFREAD        SKIP IF BUFFER IS UNCHANGED
  
          MX0    1
          BX7    -X0*X1 
          SA7    A1                DROP BUFFER-ALTERED FLAG 
  
          SB7    B0                EOR NOT REQUIRED 
  
  
          RJ     RNDMWR            REWRITE BUFFER 
  
 BUFREAD  BSS    0
          SA1    FETLOFC+B5 
          MX0    30 
          BX1    -X0*X1            KEEP LOC 
          AX1    6                 CHANGE TO SECTOR COUNT 
          SX2    1
          IX1    X1+X2             ADJUST FOR 1-ORIGIN CONVENTION 
  
          RJ     RNDMRD            READ BUFFER
  
          SA1    FETLOFC+B5 
          MX0    54 
          BX1    -X0*X1      OFFSET 
          SA2    FETOUT+B5
          IX7    X1+X2             OUT + OFFSET 
          SA7    A2          REPLACE IN OUT 
          EQ     BIK1              REJOIN BASICHK 
          TITLE  BASXCHR - RETURN CHARACTER STRING PROCEDURE
          DATA   10HBASXCHR 
 BASXCHR  DATA   0
* 
*  PURPOSE: RETURN ONE-CHARACTER STRING CORRESPONDING TO ASCII
*           ORDINAL N WHERE N IS THE ARGUMENT OF CHR, RETURN NULL 
*           STRING FOR N.LT.0 OR N.GT.127 
*  ENTRY:   X5 CONTAINS NUMERIC ARGUMENT
*  EXIT:    B7 POINTS TO CHRADDR WHICH CONTAINS REL ADDR (REL TO B2)
*                            OF THE STRING POINTER WORD OF THE
*                            RESULT STRING
* 
*         SPECIAL CONDITION - IF FLAG CSVCALL IS NON ZERO,
*                            BASXCHR WAS CALLED BY BASACVS
*                            (CHANGE ARRAY TO STRING) AND 
*                            THE RESULT STRING IS RETURNED
*                            IN X6
* 
* 
 IF1      IFEQ   CHARSET,NEWCSET
 ASCAT    EQU    64                ASCII ORDINAL OF AT
 DISAT    EQU    74B               NON-ASCII AT 
 ASCCIRC  EQU    94                ASCII ORDINAL OF CIRCUMFLEX
 DISCIRC  EQU    76B               NON-ASCII CIRCUMFLEX 
 IF2      IFNE   IP.CSET,IP.C63 
 ASCCOLN  EQU    58                ASCII ORDINAL OF COLON 
 DISCOLN  EQU    00B               NON-ASCII COLON
 IF2      ENDIF 
 IF1      ENDIF 
          SA1    COMRUNS     IF IN COMPILE
          NZ     X1,CHRASC8  OR IF NOT
          SA1    BASANSI     IN ANSI MODE 
          ZR     X1,CHRASC8  GO TRUNCATE. 
          BX1    X1-X1       ROUND THE
          PX1    X1          ARG. 
          RX5    X5+X1
          UX5    X5 
          SA1    BASCOLL     IF IN ASCII COLLATING
          NZ     X1,CHRASC9  GO TREAT AS ASCII. 
          MX1    -6          CHECK FOR < 64.
          BX1    X5*X1
          NZ     X1,CHRNULL 
          LX5    -6 
          BX6    X5 
          EQ     CHRSTOR
 CHRASC8  BSS    0
          NG   X5,CHRNULL          ARG OUT OF RANGE 
          UX5    B6,X5             CONVERT ARG TO INTEGER 
          LX5    B6,X5
 CHRASC9  BSS    0
          MX1    53                CHECK IF GT 127 (7 BITS) 
          BX1    X1*X5
          NZ   X1,CHRNULL          ARG OUT OF RANGE 
 IF1      IFEQ   CHARSET,NEWCSET
          SA1    ASCII
          NZ   X1,CHRASC1          SKIP IF ASCII MODE 
          SX1    X5-ASCAT          CHECK IF COMMERCIAL AT 
          NZ   X1,CHRASC2 
          SX6    DISAT             RETURN NON-ASCII VALUE 
          EQ   CHRASC4
 CHRASC2  SX1    X5-ASCCIRC        CHECK IF CIRCUMFLEX
          NZ   X1,CHRASC3 
          SX6    DISCIRC           RETURN NON-ASCII VALUE 
          EQ   CHRASC4
 CHRASC3  BSS    0
 IF2      IFNE   IP.CSET,IP.C63 
          SX1    X5-ASCCOLN        CHECK IF COLON 
          NZ   X1,CHRASC1 
          SX6    DISCOLN           RETURN NON-ASCII VALUE 
 IF2      ELSE
          EQ   CHRASC1
 IF2      ENDIF 
 CHRASC4  LX6    54                LEFT JUSTIFY CHAR
          EQ   CHRSTOR
 CHRASC1  BSS    0
 IF1      ENDIF 
          MX1    58 
          BX1    -X1*X5            X1 = LOWER 2 BITS, INDEX VALUE 0-3 
          AX5    2                 X5 = NUMBER/4
          SA5    CHRTAB+X5         FETCH WD CONTAINING 4 12-BIT ENTRIES 
          LX1    2                 4*INDEX
          SB6    X1 
          LX1    1                 8*INDEX
          SB6    B6+X1             12*INDEX 
          LX5    B6,X5             POSITION 12-BIT FIELD LEFT 
          MX1    12 
          BX6    X1*X5             CLEAR REST OF WORD 
          EQ   CHRSTOR
 CHRNULL  SX6    B0     RETURN NULL STRING FOR ARG OUT OF RANGE 
          SB7    CHRRSLT     B7 - ADDR OF NULL RESULT 
          SX1    B7          X1 - ADDR OF RSLT PTR
          SA2    COMRUNS
          NZ     X2,CHRASC7 
          SA2    BASANSI
          ZR     X2,CHRASC7 
          RTERROR ERMN196,ERM196,BASEGEN
 CHRSTOR  SA1    CVSCALL     EXIT WITH STRING IN X6 IF CALLED 
          NZ     X1,BASXCHR  BY BASACVS 
          SA2    COMRUNS     FETCH COMPILE VS RUNTIME SWITCH
          SB7    CHRRSLT     B7=ADR OF RESULT OF COMPILE TIME CALL
          SX1    B7 
          NZ     X2,CHRASC7  JUMP IF COMPILE TIME CALL
          BX7    X2 
          BX4    X6          MOVE RESULT STR TO PROTECTED REG 
          LX6    6
          MX2    6           LOOK AT 2ND 6 BITS OF POSSIBLE 
          BX6    X2*X6       12 BIT CHARACTER 
          SX2    1           X2 = CHAR COUNT = 1
          ZR     X6,CHRASC5  SKIP IF JUST 1 6 BIT CHAR
          LX2    1           CHAR COUNT = 2 
 CHRASC5  SX1    CHRPTR      X1 = ADDRESS OF CHRPTR 
 BASXGST  NO                 GO GET SPACE FOR STRING
*                            BASCOMP BUILDS RJ =XBASGSTR HERE 
          BSS    0
          BX6    X4          MOVE RESULT TO X6
 CHRASC6  SB7    CHRPTR 
 CHRASC7  SA6    X1          STORE RESULT STRING
          SX7    B7-B2       X7 = RELATIVE ADR OF RESULT POINTER
          SA7    CHRADDR
          SB7    CHRADDR           RETURN PTR TO REL ADDR 
          EQ   BASXCHR
* 
* 
* 
 CHRPTR   BSSZ   1           STRING POINTER FOR RESULT
 CHRRSLT  BSSZ   1           RESULT OF COMPILE TIME CALL
 CVSCALL  BSSZ   1           FLAG SET BY BASACVS
 CHRADDR  BSS    1                 STORE REL ADDR OF RESULT HERE
 ERM196   DATA   C* ILLEGAL CHR$ ARG *
* 
 CHRTAB   BSS    0     TABLE OF ASCII CHARACTERS, 4 PER WORD
*                   0   1   2   3 
 IF1      IFEQ   CHARSET,OLDCSET
          DATA   76557646766076360000B     0 NUL SOH STX ETX
          DATA   76537407766476340000B     4 EOT ENQ ACK BEL
          DATA   76517652670076450000B     8 BS HT LF VT
          DATA   76566600765776500000B     12 FF CR SO SI 
          DATA   76337405763574060000B     16 DLE DC1 DC2 DC3 
          DATA   76377640764176420000B     20 DC4 NAK SYN ETB 
          DATA   76437644766376770000B     24 CAN EM SUB ESC
          DATA   76727654767376750000B     28 FS GS RS US 
          DATA   55007647600071000000B     32 SP EXCLAM QUO POUND 
          DATA   53007402650064000000B     36 $ PERCENT AMPERSAND APOST 
          DATA   51005200470045000000B     40  (  )  *  + 
          DATA   56004600570050000000B     44  ,  -  .  / 
          DATA   33003400350036000000B     48  0  1  2  3 
          DATA   37004000410042000000B     52  4  5  6  7 
          DATA   43004400630077000000B     56  8  9  :  ; 
          DATA   72005400730075000000B     60 LESS  =  GREATER QUESTION 
          DATA   74010100020003000000B     64 AT  A  B  C 
          DATA   04000500060007000000B     68  D  E  F  G 
          DATA   10001100120013000000B     72  H  I  J  K 
          DATA   14001500160017000000B     76  L  M  N  O 
          DATA   20002100220023000000B     80  P  Q  R  S 
          DATA   24002500260027000000B     84  T  U  V  W 
          DATA   30003100320061000000B     88  X  Y  Z  OPENBRKT
          DATA   76666200700074040000B     92 BACKSLASH CLOSEBRKT 
*                                             CRCFLEX UNDLINE 
          DATA   74037601760276030000B     96 GRAVE  A  B  C
          DATA   76047605760676070000B     100  D  E  F  G
          DATA   76107611761276130000B     104  H  I  J  K
          DATA   76147615761676170000B     108  L  M  N  O
          DATA   76207621762276230000B     112  P  Q  R  S
          DATA   76247625762676270000B     116  T  U  V  W
          DATA   76307631763276610000B     120  X  Y  Z  OPENBRACE
          DATA   76677662767076740000B     124 VLINE CLSBRACE TILDE DEL 
 IF1      ELSE
          DATA   76407641764276430000B     0 NUL SOH STX ETX
          DATA   76447645764676470000B     4 EOT ENQ ACK BEL
          DATA   76507651765276530000B     8 BS HT LF VT
          DATA   76547655765676570000B     12 FF CR SO SI 
          DATA   76607661766276630000B     16 DLE DC1 DC2 DC3 
          DATA   76647665766676670000B     20 DC4 NAK SYN ETB 
          DATA   76707671767276730000B     24 CAN EM SUB ESC
          DATA   76747675767676770000B     28 FS GS RS US 
          DATA   55006600640060000000B     32 SP EXCLAM QUO POUND 
 IF2      IFEQ   IP.CSET,IP.C63 
          DATA   53007404670070000000B     36 $ PERCNT AMPRSND APOST
 IF2      ELSE
          DATA   53006300670070000000B     36 $ PERCNT AMPRSND APOST
 IF2      ENDIF 
          DATA   51005200470045000000B     40  (  )  *  + 
          DATA   56004600570050000000B     44  ,  -  .  / 
          DATA   33003400350036000000B     48  0  1  2  3 
          DATA   37004000410042000000B     52  4  5  6  7 
 IF2      IFEQ   IP.CSET,IP.C63 
          DATA   43004400630077000000B     56  8  9  :  ; 
 IF2      ELSE
          DATA   43004400740477000000B     56  8  9  :  ; 
 IF2      ENDIF 
          DATA   72005400730071000000B     60 LESS  =  GREATER QUESTNMK 
          DATA   74010100020003000000B     64 AT  A  B  C 
          DATA   04000500060007000000B     68  D  E  F  G 
          DATA   10001100120013000000B     72  H  I  J  K 
          DATA   14001500160017000000B     76  L  M  N  O 
          DATA   20002100220023000000B     80  P  Q  R  S 
          DATA   24002500260027000000B     84  T  U  V  W 
          DATA   30003100320061000000B     88  X  Y  Z  OPENBRKT
          DATA   75006200740265000000B     92 BACKSLASH CLOSEBRKT 
*                                             CRCFLEX UNDLINE 
          DATA   74077601760276030000B   96   GRAVE  A  B  C
          DATA   76047605760676070000B     100  D  E  F  G
          DATA   76107611761276130000B     104  H  I  J  K
          DATA   76147615761676170000B     108  L  M  N  O
          DATA   76207621762276230000B     112  P  Q  R  S
          DATA   76247625762676270000B     116  T  U  V  W
          DATA   76307631763276330000B     120  X  Y  Z  OPENBRACE
          DATA   76347635763676370000B     124 VLINE CLSBRACE TILDE DEL 
 IF1      ENDIF 
* 
 BATXCHR  BSS    0
          TITLE  BASOCON
* 
*         OUTPUT - CONVERT
* 
*         INPUT  NUMBER IN X.R
*         OUTPUT  A.R POINTS AT FIRST WORD OF RESULT
* 
*         BASOCON 
*         INITIALLY EACH WORD OF A 30 WORD
*         BUFFER OBUFLCL IS ALLOCATED TO CONTAIN
*         ONE DISPLAY CHARACTER IN LOW ORDER POSITION.
*         THE SEQUENCE OF DISPLAY CHARACTERS REPRESENTS THE 
*         FLOATING POINT NUMBER INPUTTED TO BASOCON, PARTIALLY
*         CONVERTED TO THE FORMAT PRODUCED BY BASOCON. AT 
*         THE CONCLUSION OF BASOCON, THE OUTPUT SEQUENCE
*         OF DISPLAY CHARACTERS IS PACKED 
*         INTO THE BEGINNING WORDS OF OBUFLCL.
* 
*         THE APPROXIMATE SEQUENCE OF BASOCON PROCESSING
*         IS AS FOLLOWS - 
* 
* 
*         BASOCON TESTS THE INPUT FLOATING POINT NUMBER TO
*         DETERMINE IF IT IS ZERO, INDEFINITE OR INFINITE.  IF SO,
*         CERTAIN CONSTANTS ARE SET INTO X5 AND 
*         BASOCON RETURNS TO THE CALLER. THE BUFFER IS
*         UNCHANGED IN THIS CASE, AND CONTAINS
*         BINARY ZEROES.  THE CONSTANTS ARE FOR 
*         VALUE ZERO -  SPACE0SPACE; VALUE INDEFINITE - 
*         SPACEUNDEFINEDSPACE; VALUE INFINITY - 
*         SPACEINFINITYSPACE. 
* 
*         THE SIGN WHICH
*         CORRESPONDS TO THE SIGN OF THE MANTISSA 
*         OF THE INPUT NUMBER IS STORED AS A
*         DISPLAY BLANK OR MINUS CHARACTER AT THE 
*         BEGINNING OF THE OUTPUT BUFFER OBUFLCL. 
* 
*         BASOCON TESTS THE FLOATING POINT NUMBER TO
*         DETERMINE IF IT REPRESENTS AN INTEGER VALUE.
*         IF SO, A FURTHER TEST IS MADE TO DETERMINE
*         IF THE FULL MAGNITUDE OF THE INTEGER CAN BE 
*         OUTPUTTED , HAVING REGARD 
*         FOR THE SETDIGITS IN EFFECT DURING BASOCON
*         PROCESSING. IF THE SETDIGITS IN EFFECT
*         IS THE VALUE SET BY THE COMPILER AS THE DEFAULT 
*         CASE (6) THEN MAGNITUDES NOT GREATER THAN 
*         9 DIGITS WILL BE FLAGGED AS INTEGER. IF THE 
*         SETDIGITS IN EFFECT DURING BASOCON PROCESSING 
*         THE COMPILER DEFAULT, THEN
*         THE INTEGER IS FLAGGED AS INTEGER ONLY IF 
*         THE NUMBER OF DIGITS IN IT DOES NOT EXCEED THE
*         CURRENT VALUE OF SETDIGITS. 
* 
*         IF THE FULL MAGNITUDE CAN BE
*         OUTPUTTED, THE INTEGER/REAL FLAG IS SET TO INTEGER, 
*         OTHERWISE THE FLAG IS SET REAL. 
* 
*         BASOCON CONVERTS THE FLOATING POINT 
*         NUMBER INTO TWO COMPONENTS= 
*         - A POSITIVE BINARY NUMBER WHICH HAS A MAGNITUDE
*         OF NOT MORE THAN 14 DECIMAL DIGITS
*         - A POSITIVE OR NEGATIVE BINARY NUMBER WHICH
*         IS THE POWER OF 10 TO WHICH THE FIRST COMPONENT 
*         IS RAISED TO OBTAIN A VALUE APPROXIMATING THE 
*         INPUT FLOATING POINT NUMBER. WE SHALL HEREAFTER 
*         REFER TO COMPONENT 1 AS THE BASE COMPONENT
*         AND COMPONENT 2 AS THE EXP10 COMPONENT. 
*         THIS CONVERSION IS ACCOMPLISHED BY A TECHNIQUE
*         BY WHICH THE BASE COMPONENT IS PROGRESSIVELY
*         ADJUSTED TO BRING IT TO A MAGNITUDE IN THE
*         RANGE OF 14 DIGITS AND THE EXPONENT VALUE IS
*         AJUSTED TO COMPENSATE FOR THE CHANGE TO BASE
*         VALUE. IN THE CASE OF NUMBERS FLAGGED AS INTEGER
*         EXP10 HAS A VALUE OFF ZERO. 
* 
* 
*         AT THIS POINT, IF NUMBER FLAGGED REAL, BASOCON UTILIZES THE 
*         SETDIGITS VALUE THAT IS EFFECTIVE AT THE
*         TIME OF CALL TO BASOCON TO SELECT THE ROUNDING
*         FACTOR AND TO APPLY IT
*         TO THE BASE WHICH IS STILL A BINARY 
*         NUMBER. 
* 
*         THEN BASOCON CONVERTS THE BINARY BASE 
*         TO AN INTERIM FORMAT IN OBUFLCL.
*         EACH CHARACTER IN THE INTERIM FORMAT IS DEVELOPED 
*         IN SUCCESSION FROM LEFT TO RIGHT. 
* 
* 
*         THE INTERIM FORMAT IS ONE DISPLAY CHARACTER 
*         PER WORD OF OBUFLCL, SUCH AS -
*         WD 1 SPACE OR - (SIGN OF BASE)
*         WD  2  ONE OF DISPLAY DIGIT 0-9, CALLED 
*         THE INTEGER DIGIT AS IN N.NN..NE+1
*         WD  3 CONTAINS THE 2ND HIGHEST
*         DIGIT OF THE NUMBER IF FLAGGED INTEGER, OR
*         A DISPLAY DECIMAL POINT CHARACTER IF THE NUMBER 
*         IS FLAGGED REAL.
*         WD  4---
*         FOLLOWING WORDS EACH CONTAIN SUCCESSIVE DIGITS
*         OF THE BASE.
* 
*         THE ACTUAL NUMBER OF DIGITS STORED IN SUCCESSIVE
*         WORDS OF OBUFLCL DOES NOT EXCEED THE VALUE
*         OF SETDIGITS IN EFFECT, EXCEPT FOR THE
*         CASE DESCRIBED ABOVE (COMPILER DEFAULT AND
*         INTEGER OF NOT MORE THAN 9 DIGITS - UP TO 
*         9 DIGITS MAY BE STORED IN OBUFLCL). 
* 
*         IN SUMMARY, AT THIS POINT THE DIGITS IN OBUFLCL 
*         REPRESENT THE BASE COMPONENT AS AN
*         INTEGER NNNN...N OR AS AN INTEGER + FRACTION I.E. 
*         N.NNNN...N.  THE EXPONENT IF ANY, 
*         CONTINUES TO BE HELD IN STORAGE AS A SIGNED 
*         BINARY NUMBER.
* 
*         IF NUMBER FLAGGED INTEGER, BASOCON SKIPS DOWN TO
*         PACK THE DIGITS IN THE OBUFLCL INTO CONSECUTIVE 
*         POSITIONS OF OBUFCL WORDS AND EXITS; OTHERWISE
*         PROCESSING CONTINUES AS SET OUT FOLLOWING.
* 
*         IN ORDER TO OUTPUT THE NUMBER CORRECTLY 
*         IT IS NECESSARY TO ADD THE EXPONENTIAL
*         NOTATION TO THE DIGIT SEQUENCE PRESENTLY
*         RESIDING IN OBUFLCL, I.E. ESN, OR 
*         ESNN, OR ESNN (E=E,S=+OR-,N=EXP DIGIT). 
* 
*         IF THE SIGN OF THE EXP10 COMPONENT
*         IS POSITIVE, IT IS CHECKED AGAINST THE
*         VALUE OF SETDIGITS IN EFFECT TO SEE IF A
*         RIGHT SHIFT OF THE DECIMAL POINT CAN
*         BE EMPLOYED IN ORDER TO ELIMINATE THE NEED
*         FOR EXPONENTIAL NOTATION IN THE OUTPUT. 
*         IF THIS IS THE CASE, THE INTERIM FORMAT 
*         IN OBUFLCL OF SPACEN.NN....N FOR
*         EXAMPLE, IS CHANGED TO SPACENNN.N..N. 
*         IF A RIGHT SHIFT OF DECIMAL POINT CANNOT
*         ELIMINATE THE NEED FOR E NOTATION, THEN 
*         EXP10 COMPONENT IS CONVERTED TO DISPLAY 
*         AND APPENDED TO THE SEQUENCE IN THE BUFFER. 
*         FOR EXAMPLE, A SEQUENCE IN BUFFER OF
*         SPACE2.000 FOR A SETDIGITS OF 4, WITH 
*         AN EXP10 COMPONENT = +4 BECOMES 
*         THE SEQUCENCE SPACE2.000E+4 IN THE BUFFER.
* 
*         IF THE SIGN OF THE POWER OF 10 EXPONENT IS MINUS
*         A TEST IS MADE TO SEE IF IT IS POSSIBLE TO
*         ELIMINATE THE NEED FOR THE EXPONENT BY SHIFTING 
*         DECIMAL POINT TO THE LEFT AND INSERTING THE 
*         REQUIRED ZERO DIGITS IMMMEDIATELY FOLLOWING THE 
*         DECIMAL POINT.  THIS ACTION CAN ONLY BE CARRIED 
*         OUT IF THERE ARE SUFFICIENT TRAILING ZERO DIGITS
*         IN THE BASE SO THAT LEADING ZERO DIGITS CAN 
*         BE INSERTED WITHOUT LOSING ANY OF THE REQUIRED
*         SIGNIFICANT DIGITS.  FOR EXAMPLE, IF SETDIGITS = 4
*         A NUMBER OF VALUE 2.000E-3 CAN BE OUTPUTTED AS
*         .002 AND 2.100E-3 CAN BE OUTPUTTED AS .0021 BUT 
*         2.010E-3 MUST BE OUTPUTTED AS 2.010E-3. 
* 
* 
* 
*         THE CONCLUDING ROUTINE IN BASOCON PACKS 
*         THE SEQUENCE OF DIGITS IN THE OBUFLCL INTO
*         THE FIRST ONE OR TWO WORDS OF OBUFLCL AS
*         REQUIRED BY THE LENGTH OF THE NUMBER. 
* 
*         A SPACE CHARACTER FOLLOWS THE LAST USED 
*         POSITION OF THE PACKED NUMBER AND BINARY
*         ZEROES FOLLOW.
* 
*         THE FIRST PACKED WORD OF OBUFLCL IS SET INTO
*         X5 AND BASOCON EXITS. 
* 
*         IF SET DIGITS =    AND VALUE IS        BASOCON PRODUCES 
* 
*         1                  .1                  S.1BZ
* 
*         2                  .1                  S.1BZ
* 
*         4                  10000               S1.000E+4BZ
* 
*         6(DEFAULT)         -1234567            -1234567BZ 
* 
*         6(USER SET)        -1234567            -1.23457E+6BZ
* 
*         5                  .001                S.001BZ
* 
*         3                  .0016               S1.60E-3BZ 
* 
*         4                  .0016               S.0016BZ 
* 
*         4                  .0016436            S1.644E-3BZ
* 
*         (WHERE S=SPACE FOR PLUS SIGN,B=BLANK,Z=BINARY ZEROES) 
* 
* 
* 
 TRUE     EQU         1 
 FALSE    EQU         0 
 DISZERO  EQU         33B 
 DISBLNK  EQU         55B 
 DISMINS  EQU         46B 
 DISPNT   EQU         57B 
 DISEXP   EQU         05B 
          IFEQ   CHARSET,NEWCSET
 ESCCIRC  EQU    7402B             ASCII CIRCUMFLEX 
 CIRCFLEX EQU    76B               NON-ASCII CIRCUMFLEX 
          ENDIF 
 DISPLUS  EQU       45B 
 MANTDIG  EQU         6 
 MAXINTG  EQU         9 
 BUFFLGT  EQU    30 
* 
* 
          DATA        10HBASOCON
 BASOCON  BSSZ        1 
          SA4       TABFLG
          SX7       B0
          SA7       A4
          SA7    BKSP1             ZERO UNLESS SET 1 AND EXP -1 
          NZ       X4,TABCON
          SX6         B5               . SAVE CHANNEL-POINTER 
          SA6         OCHANNL          .
         SX7       TRUE           .TURN ON NUMERIC
         SA7       NUMFLG         .OUTPUT FLAG
          ID          X5,NUMUNDF       . OUTPUT UNDEFINED 
          OR          X5,NUMINFT       . OUTPUT INFINITY
          NX5       B5,X5              . NUMBER MUST BE NORMALIZED
          UX4         B5,X5 
          ZR          X4,NUMZERO       . JUMP IF NUMBER IS ZERO 
          SX7    B5+1777B 
          ZR     X7,NUMZERO  TREAT AS ZERO IF PARTIAL UNDERFLOW.
          SX7          DISBLNK
          PL          X5,STND01        . JUMP IF NUMBER NOT NEGATIVE
          SX7         DISMINS          . SET FOR MINUS SIGN 
          BX5         -X5              . COMPLEMENT. NO ALWAYS POS NOW
 STND01   SA7         B0+OBUFLCL       . SIGN OF NUMBER TO OUTPUT AREA
          RJ     FINDTYP           SETS X0 TO 0/1 FOR INTEGER/REAL
          RJ     FINDEXP           LEAVE EXPONENT IN X6 
          RJ     ROUFCTR           ESTABLISH ROUNDING FACTOR
          RJ     ROUNDIT           ROUNDOFF (AND ADJUST EXPONENT IF OVER
*                                  FLOW OCCURS) 
          RJ     CNVDGTS           REDUCE MANTISSA TO THE FORM N.NNN ETC
*                                  AND DUMP IT IN OBUFLCL 
          NZ     X0,STND410        SKIP IF REAL 
* 
          RJ     ZONINT            ELSE FIX INTEGER ZONES AND LEAVE 
*                                  LIMIT FOR BLANK FILL IN B5 ON EXIT.
          RJ     SPZRFIL           PAD FORMAT WITH SPACES AND APPEND
*                                  TRAILING ZEROS.
          SB6    B0+OBUFLCL        START OF OUTPUT BUFFER 
          RJ     PACKBUF           COMPACT OUTPUT STRING TO WORDS 
          JP     ALLEXIT           PREPARE TO LEAVE 
* 
*                                  SET X0 TO 0/1 FOR INTEGER/REAL 
 FINDTYP  BSS    0
          JP     0
          SX0    1
          UX6         B5,X5            .
          LX6         X6,B5            .
          PX7         B0,X6            .
          NX6         B7,X7            .
          IX7         X6-X5            .
          NZ          X7,STND011       . NOT INTEGER
          SA1    ROUNDTB+MAXINTG
          SA2    SETDGTS
          NG     X2,NOTSET         IF SET NOT USED CONTINUE BELOW 
          SB6    X2                SET DIGITS VALUE 
          SA1    ROUNDTB+B6        USE IT TO TEST FOR INTEGER FORMAT
 NOTSET   BSS    0
          PX2         B0,X1            .
          NX3         B7,X2            .
          FX6         X5-X3            .
          PL          X6,STND011       . EXPONENT TOO BIG 
          SX0         B0               . SET INTEGER
 STND011  BSS         0                .
          JP     FINDTYP           EXIT WITH TYPE IN X0 
* 
*                                  LEAVE EXPONENT IN B6 
* 
 FINDEXP  BSS    0
          JP     0
          SX6    B0+B0
          SB6         1 
          SB5         PEXPTAB-3        . INITIALIZE TABLE POINTER 
          SB7         ENDPEXP          . END OF TABLE TEST ADDRESS
 STNDLP1  EQ          B5,B7,STND02     . JUMP IF POSITIVE TABLE USED UP 
          SB5         B5+3             . BUMP TABLE POINTER TO NEXT SET 
          SA1         B5               . X1..= MAGNITUDE TEST VALUE 
          SA2         B5+B6            . X2..= MULTIPLIER FACTOR
          SA3         B5-B6            . X3..= EXPONENT INCREMENT 
 STNDLP2  IX7         X5-X1            . SET UP X7 FOR MAGNITUDE TEST 
          NG          X7,STNDLP1       . LOOP IF VALUE BELOW RANGE
          RX5         X5*X2            . VALUE..= VALUE*MULTIPLIER FACTR
          IX6         X6+X3            . EXP..= EXP+ EXP INCREMENT
          EQ          B0,B0,STNDLP2    . LOOP 
 STND02   SB7         ENDNEXP          . END OF NEG TABLE TEST ADDRESS
 STNDLP3  EQ          B5,B7,STND03     . JUMP IF NEG TABLE USED UP
          SB5         B5+3             . BUMP TABLE POINTER TO NEXT SET 
          SA1         B5               . X1..= MAGNITUDE TEST VALUE 
          SA2         B5+B6            . X2..= MULTIPLIER FACTOR
          SA3         B5-B6            . X3..= EXPONENT INCREMENT 
 STNDLP4  IX7         X5-X1            . SET UP X7 FOR MAGNITUDE TEST 
          PL          X7,STNDLP3       . LOOP IF VALUE ABOVE RANGE
          RX5         X5*X2            . VALUE..= VALUE*MULTIPLIER FACTR
          IX6         X6+X3            . EXP..= EXP+ EXP INCREMENT
          EQ          B0,B0,STNDLP4    . LOOP 
 STND03   UX1         B5,X5            . X1..= MANTISSA + OR - LOW BITS 
          LX5         B5,X1            . X5..= MANTISSA WITH L-O BITS 
          SB7         FALSE            . OVERFLOW ON ROUNDING FLAG
          SX6         X6+14            . ADJUST EXPONENT TO ALIGN POINTS
          JP     FINDEXP           EXIT WITH EXPONENT IN B6 
* 
* 
 ROUFCTR  BSS    0                 LEAVES B5 POINTING AT THE APPROPRIATE
*                                  ENTRY IN ROUNDTB 
          JP     0
          SB5    B0 
          SA1    SETDGTS
          NG     X1,NTSET          SKIP IF SETDIGITS NOT IN USE 
          SX2    14                SET UP THE 
          IX2    X2-X1             NEW ROUNDOFF CONST 
          SB5    X2 
 NTSET    BSS    0
          ZR          X0,STND031       . NOT REAL 
          SB5         14-MANTDIG       . SET ROUNDING FOR REAL
          NG     X1,STND031        SKIP IF SETDIGITS NOT USED 
          SX3    14                ELSE USE THE 
          IX1    X3-X1             COMPUTED VALUE 
          SB5    X1 
 STND031  BSS    0
          JP     ROUFCTR           EXIT 
* 
* 
* 
*                ROUNDOFF REAL OR INTEGER VALUE AND ADJUST EXPONENT ON
*                OVERFLOW 
* 
 ROUNDIT  BSS    0
          JP     0
          SA3    ROUNDTB+B5        GET POWER OF 10
          BX1         X3               . AND
          LX1         2                . MULTIPLY BY 5
          IX2         X1+X3            . ROUNDING CONSTANT
          IX5         X5+X2            . ROUND X5 
          SA1         ROUNDTB+15       . UPPER LIMIT
          IX3         X5-X1            . SET X3 FOR OVERFLOW TEST 
          NG          X3,STND04        . JUMP IF NO OVERFLOW
          SB7         TRUE             . OVERFLOW ON ROUNDING..= TRUE 
          SX6         X6+1             . EXP..= EXP+1 
 STND04   BSS         0                .
          JP     ROUNDIT           EXIT 
* 
*                CONVERT MANTISSA TO DIGITS AND DUMP IN OBUFLCL IN THE
*                FORM : N.NNNN ETC. 
* 
 CNVDGTS  BSS    0
          JP     0
          SX7         DISZERO-1        . DIHIT..= -1 (DISPLAY)
          SA1         B7+ROUNDTB+14    . X1..= FIRST POWER OF TEN NEEDED
 STNDLP5  SX7         X7+1             . DIGIT..= DIGIT+1 
          IX5         X5-X1            . SET X5 FOR TEST
          PL          X5,STNDLP5       . LOOP IF STILL OF WRT TEN POWER 
          IX5         X5+X1            . RESET X5- GONE TOO FAR 
          SA7         B0+OBUFLCL+1     . INTEGER DIGIT TO OUTPUT AREA 
          SB5         B0+OBUFLCL+15    . B5 = LIMIT FOR INTEGER 
          SA2    SETDGTS
          NG     X2,NONSET
          SB5    X2+OBUFLCL+1      SET BUFFER BOUND USING SET VALUE 
 NONSET   BSS    0
          SB6         B0+OBUFLCL+2     . B6 = START FOR INTEGER 
          SX7    1
          IX7    X2-X7             TEST FOR SET 1 
          ZR     X7,SETUP          GO ADVANCE BOUND IF SO 
 SET0     BSS    0
          ZR          X0,STND041       . NOT REAL 
          ZR     X7,SET409
 SET1NEG1 BSS    0
          SX7         DISPNT           . SET FOR POINT
          SA7         B6               . MOVE POINT 
          SB6         B6+1             . UP COUNTER 
          MX7     56
          BX2    -X7*X2            LOWER 4 BITS HAVE IMPLICIT/COMPUTED
*                                  SET VALUE FOR FIELD WIDTH
          SB5    X2+OBUFLCL+2      SET BUFFER BOUND ACCORDINGLY 
 STND041  BSS         0                .
 STNDLP6  SX7         DISZERO-1        . DIGIT..= -1 (DISPLAY)
          SA1         A1-1             . X1..= NEXT POWER OF TEN
 STNDLP7  SX7         X7+1             . DIGIT..= DIGIT+1 
          IX5         X5-X1            . SET X5 FOR TEST
          PL          X5,STNDLP7       . LOOP IF STILL OK WRT TEN POWER 
          IX5         X5+X1            . RESET X5 - GONE TOO FAR
          SA7         B6               . CURRENT DIGIT TO OUTPUT AREA 
          SB6         B6+1             . UP COUNTER ADDRESS 
          NE          B6,B5,STNDLP6    . LOOP IF NOT 13 DIGITS STORED 
          JP     CNVDGTS           EXIT 
* 
 SETUP    BSS    0
          SB5    B5+1              ADVANCE BUFFER BOUND 
          EQ     SET0              REJOIN 
*                                  CHECK FOR SPECIAL
 SET409   BSS    0
          PL     X6,SET410         SKIP IF EXPONENT IS POSITIVE 
          SX7    1
          IX7    X6+X7
          NZ     X7,CNVDGTS        EXIT IF EXP IS NOT -1
          SX7    1
          SA7    BKSP1             EXP IS -1 AND SET DIGITS VALUE IS 1
          IX2    X2+X7             USED LATER TO ADVANCE B5 
          EQ     SET1NEG1 
* 
 SET410   BSS    0
*         NO LONGER USED BY PRINT USING 
          EQ     CNVDGTS           AND EXIT 
* 
*                                  NZ  X0,STND410 NOW MOVED TO CONTROL
*                FIXES INTEGER ZONE WIDTH. ON EXIT B5 HOLDS LIMIT FOR 
*                LATER SPACE FILL.
* 
 ZONINT   BSS    0
          JP     0
          SB6         B0+OBUFLCL+2     . PREPARE BLANK-FILL 
          SB6         X6+B6            . SET NEXT FREE
       SB5        B6+1       LIMIT FOR BLANK FILL 
          EQ     ZONINT 
* 
* 
 STND410  BSS         0                . REAL NUMBER
*  CONTROL REACHES HERE FOR COMPLETION OF A REAL NUMBER 
          NG          X6,STND412       . NEGATIVE EXPONENT
          SA1    SETDGTS           LOAD PRESET/COMPUTED FIELD WIDTH 
          MX7    1                 DROP A 
          BX1    -X7*X1            (POSSIBLE) BIT 59
          IX7    X6-X1             SET CURRENT VALUE
          PL          X7,STND430       . EXPONENT TO BIG FOR SPECIAL
          RJ     SHFTPRD           MOVE PERIOD RIGHT AND REDUCE 
*                                  EXPONENT TO ZERO 
          JP     STND420           REJOIN -SPECIAL- CONTROL 
* 
*                SHFTPRD MOVES THE DECIMAL POINT RIGHT AND REDUCES THE
*                EXPONENT TO ZERO AT THE SAME TIME. 
* 
 SHFTPRD  BSS    0
          JP     0
          SA1    B0+OBUFLCL+1 
          SX5         X6               . PREPARE COUNT
 STND411  BSS    0
          ZR     X5,SHFTPRD        EXIT WHEN EXPONENT IS ZERO 
* 
          SA1         A1+1             . SHIFT RIGHT PERIOD 
          SA2         A1+1             .
          BX6         X1               .
          BX7         X2               .
          SA6         A1+1             .
          SA7         A1               .
          SX5         X5-1             . REDUCE EXPONENT
          EQ          STND411          . LOOP 
* 
* 
 STND412  SX5         X6               . NEG EXPONENT 
          SA1         B5               . PRESET A1 AS POINTER 
          SX1         DISZERO          . PRESET DIGIT 
 STND413  SX2         X1-DISZERO       .
          NZ          X2,STND430       . DIGIT NONZERO - NO SPECIAL 
          SX5         X5+1             . COUNT ZEROS FROM RIGHT 
          SA1         A1-1             . GET NEXT CHARACTER 
          NG          X5,STND413       . ZEROS FROM RIGHT - LOOP
          RJ     DECFRAC           ARRANGE DECIMAL FRACTION 
          JP     STND420           REJOIN -SPECIAL- CONTROL 
* 
*                DECFRAC MOVES THE DECIMAL POINT TO THE LEFT HAND END 
*                AND INSERTS LEADING ZEROS (AS APPROPRIATE) 
* 
 DECFRAC  BSS    0
          JP     0
          SX5    X6                USE EXPONENT AS COUNT
          SA1         B0+OBUFLCL+1     . SET UP SHIFT MANTISSA RIGHT
          SA2         A1+1             . FIRST SHIFT PERIOD LEFT
          BX6         X1               .
          BX7         X2               .
          SA6         A1+1             .
          SA7         A1               .
          SX5         X5+1             . INCREASE EXPONENT
          ZR     X5,DECFRAC 
          SB7         B0+OBUFLCL+1     . SET LIMIT
          SB5         B5-1             . LAST DIGIT 
          SB5         X5+B5            . SET START
          BX5         -X5              . SET INCREMENT
 STND414  SA1         B5               . NEXT DIGIT 
          BX7         X1               . SHIFT RIGHT MANTISSA 
          SA7         X5+B5            .
          SB5         B5-1             . DOWN POINTER 
          LT          B7,B5,STND414    . LOOP 
          SB5         X5+B5            . RESET POINTER
          SX7         DISZERO          .
 STND415  SA7         B5               . MOVE IN ZEROS
          SB5         B5-1             . DOWN POINTER 
          LT          B7,B5,STND415    . LOOP 
          JP     DECFRAC
* 
* 
 STND420  BSS         0                . ZERO EXPONENT
          SA5    BKSP1
          ZR     X5,NOTSET1        EXIT IN NORMAL CASE
          SB6    B6-1              BKSP FOR SET = 1 AND EXP -1
 NOTSET1  BSS    0
          SB6         B6+1             . PRESET POINTER 
 STND421  SB6         B6-1             . DOWN POINTER 
          SA1         B6-1             .
          SX2         X1-DISZERO       . CHECK FOR ZERO 
          ZR          X2,STND421       . ZERO - LOOP
          SB5         B0+OBUFLCL+MANTDIG+3  . MANTISSA-LENGTH 
          RJ     SPZRFIL           PAD WITH SPACES AND ZEROS. 
          SB6    B0+OBUFLCL        START OF OUTPUT BUFFER 
          RJ     PACKBUF           GATHER OUTPUT FIELD INTO WORDS.
          JP     ALLEXIT           GO TO LEAVE
* 
* 
 STND430  BSS         0                . NO SPECIAL - REAL
          SX2    B0                TO FORCE LEADING-ZERO SUPPRESSION
          RJ     EXPCNV            CONVERT EXPONENT (FOR E-FORMAT)
          SB5    OBUFLCL+14        LIMIT FOR SPACE FILL 
          RJ     SPZRFIL           PAD SPACES  AND ZEROS ON THE RIGHT 
          SB6    B0+OBUFLCL        START OF OUTPUT BUFFER 
          RJ     PACKBUF           GATHER OUTPUT STRING TO WORDS
          JP     ALLEXIT           GO LEAVE 
* 
*                CONVERT EXPONENT AND APPEND IT TO OBUFLCL
*                ON ENTRY X2 IS 0/1 IF LEADING-ZERO-SUPPRESSION IS/ISNT 
*                REQUIRED.
* 
 EXPCNV   BSS    0
          JP     0
          SX7    DISEXP            LITERAL -E- FOR EXPONENT SIGN
          SA7         B6               . MOVE EXPONENT MARK 
          SB6         B6+1             . UP COUNTER 
          SX7         DISPLUS          . SET FOR POSITIVE EXPONENT
          PL          X6,STND05        . NO NEG EXPONENT
          SX7         DISMINS          . SET FOR NEGATIVE EXPONENT
          BX6         -X6              . COMPLEMENT VALUE 
 STND05   SA7         B6               . MOVE EXPONENT-SIGN 
          SB6         B6+1             . UP COUNTER 
          SB5         B6+3             . SET EXPONENT-LIMIT 
          SB7         B6               . SET COUNT
          SA1         ROUNDTB+2        . 1ST POWER OF TEN NEEDED =100 
          SX4         DISZERO           . 
 STNDLP8  SX7         DISZERO-1        . DIGIT..= -1(DISPLAY) 
 STNDLP9  SX7         X7+1             . DIGIT..= DIGIT+1 
          IX6         X6-X1            . SET X6 FOR TEST
          PL          X6,STNDLP9       . LOOP IF STILL OK WRT TEN POWER 
          IX6         X6+X1            . RESET X6- GONE TOO FAR 
          IX5         X7-X4             . 
          ZR     X5,STND0515       SKIP IF ZERO 
 KEEPZRO  BSS    0
          SA7         B6               . CURRENT DIGIT TO OUTPUT AREA 
          SB6         B6+1             . UP POINTER 
          SX4         B0                . 
 STND051  BSS         0                .
          SA1         A1-1             . X1 .= NEXT ENTRY 
          SB7         B7+1             . UP COUNT 
          NE          B7,B5,STNDLP8    . LOOP IF NOT 3 EXP DIGITS 
          JP     EXPCNV 
 STND0515 BSS    0
          ZR     X2,STND051        SKIP IF LEAD-ZEROS ARE SUPPRESSED
          EQ     KEEPZRO           ELSE RETAIN THEM 
* 
* 
* 
* 
*                ON ENTRY B5 HOLDS THE LIMIT FOR ZONE SPACE FILL AND
*                B6 POINTS TO THE FIRST POSITION TO BE FILLED. ZEROS
*                ARE APPENDED TO FILL THE BUFFER BEFORE EXIT. 
* 
 SPZRFIL  BSS    0
          JP     0
          SX7         DISBLNK          . PREPARE BLANK-MOVE 
          SA7    B6 
          SB6         B6+1             . UP POINTER 
          SB5    OBUFLCL+BUFFLGT       .SET END OF BUFFER 
          SX7         B0               .
 STND071  SA7         B6               . FULL REST OF BUFFER WITH 00
          SB6         B6+1             . UP POINTER 
          LT          B6,B5,STND071    . ZERO - LOOP
* 
          JP     SPZRFIL
* 
* 
*                PACKBUF GATHERS THE OUTPUT STRING CHARACTERS AND PACKS 
*                THEM 10 PER WORD IN OBUFLCL
* 
 PACKBUF  BSS    0
          JP     0
          SX5         77B              . MASK 
          SA1         B0+OBUFLCL-1     .
          BX6         X1               .
          SA6         A1               . PRESET A6
 STND081  SX6         B0               .
          SB7         9                . CHARACTER-COUNT
 STND082  SA1         B6               .
          SB6         B6+1             .
          BX2         X5*X1            .
          LX6         6                .
          BX6         X6+X2            . PACK ONE WORD
          SB7         B7-1             .
          PL          B7,STND082       . LOOP IN WORD 
          SA6         A6+1             .
          LT          B6,B5,STND081    . NEXT WORD
          JP     PACKBUF
* 
* 
* 
 ALLEXIT  BSS    0
          SA5    OBUFPW          FETCH PTR WORD FOR OBUFLCL 
 STND99   BSS         0                . COMMON EXIT
          SA1         OCHANNL          .
          SB5         X1               . RESET CHANNEL-POINTER
          EQ          BASOCON          . EXIT 
 OBUFPW   VFD    42/0,18/OBUFLCL
 ZEROPW   VFD    42/0,18/ZEROPIC
 INFPW    VFD    42/0,18/INFTPIC
 UNDFPW   VFD    42/0,18/UNDFPIC
 SBLANKPW VFD    42/0,18/SBLANK 
 TABTEMPW BSSZ   1
* 
TABCON    BSS       0 
          RJ     TABCNV 
          JP     BASOCON           EXIT 
* 
* 
* 
 TABCNV   BSS    0
          JP     0
          SA3    BASANSI           FETCH ANSI MODE FLAG 
          ZR     X3,TABCNV4        BR IF NOT ANSI MODE
*  ARGUMENT PROCESSING FOR ANSI MODE
* 
          BX3    X3-X3
          PX3    X3 
          RX5    X5-X3       ROUND AND SUBTRACT ONE 
          PL     X5,TABCNV1        BR IF ONE OR GREATER 
 TABERR   BSS    0
          BX6    X0 
          SA6    SAVEX0 
*  NONFATAL ERROR. * BAD TAB ARG *
          SB7    ERM197 
          SX7    ERMN197
          RJ     BASEGEN
          SA1    SAVEX0 
          BX0    X1 
          SX5    0                 BAD TAB ARG SO USE ONE INSTEAD 
* 
 TABCNV1  BSS    0
          SA1    B5+FETLINL        GET MARGIN VALUE 
          ZR     X1,TABCNV2        BR IF MARGIN IS ZERO 
          SX7    X1                CHAR 
          AX1    29                WORDS*2
          BX2    X1 
          LX2    2
          IX1    X1+X2             WORDS*10 
          IX1    X1+X7             TOTAL MARGIN LENGTH IN CHARS 
*  COMPUTE ARG=MOD(ARG-1,MARGIN LENGTH)+1 
          NX5    X5 
          PX1    X1 
          NX1    X1 
          FX3    X5/X1
          UX3    B7,X3
          LX3    B7,X3
          PX3    X3 
          NX3    X3 
          FX3    X1*X3
          FX5    X5-X3
          FX3    X5-X1
          PL     X3,TABERR
*  FIND CURRENT POSITION
 TABCNV2  BSS    0
          UX5    B7,X5
          LX5    B7,X5
          SA1    B5+FETCHAR 
          SX2    X1                UNITS
          AX1    29                2*TENS 
          BX3    X1 
          LX3    2                 8*TENS 
          IX1    X1+X3             10*TENS
          IX1    X1+X2             CURRENT POSITION=10*TENS+UNITS 
          IX4    X1-X5             COMPARE CURRENT POSITION WITH TAB ARG
          ZR     X4,TEXIT          BR TO IGNORE TAB 
          NG     X4,TABCNV3        TAB ARG IS LESS THAN CURRENT POS.
* 
          BX7    X5 
          SA7    SAVARG            SAVE THE TAB ARGUMENT
          SA5    ZERO              SET UP ZERO PTR WORD FOR NULL STRING 
          MX4    73B                SET -1 TO FORCE END OF CURRENT LINE 
 TABCNVX  NO                       RJ =XBASOPRT STORED HERE BY BASESRT
          BSS    0
* 
          SA5    SAVARG            RESTORE TAB ARG
          BX4    -X5               SET UP TO POSITION TO TAB ARG
*                                  POSITION ON THE NEXT LINE. 
 TABCNV3  BSS    0
          BX2    -X4               X2=POSITIVE NO. OF BLANKS REQUIRED.
          BX5    -X2               X5=NEGATIVE COUNT OF BLANKS
          EQ     TABCNV5
*  ARGUMENT PROCESSING FOR BASIC 3.4 MODE 
* 
 TABCNV4  BSS    0
          NG        X5,TEXIT
          UX5       B7,X5 
          LX5       B7,X5              CONVERT TO INTEGER 
          SA1    B5+FETLINL        GET MARGIN VALUE 
* 
* TEST IF MARGIN = 0
* 
          ZR     X1,BUMP         BR, MARGIN IS ZERO 
* 
          SX7    X1                CHAR 
          AX1    29                WORDS*2
          BX2    X1 
          LX2    2
          IX1    X1+X2             WORDS*10 
          IX1    X1+X7             TOTAL CHAR 
 LESSNUM  BSS    0
          IX5    X5-X1
          ZR     X5,TEXIT 
          PL     X5,LESSNUM 
          IX5    X5+X1
* 
 BUMP     BSS    0
* 
* BRANCH IN, MARGIN IS ZERO 
* 
          SX5    X5+1 
          SA1       B5+FETCHAR
          SX2       X1                 UNITS
          AX1       29                 2*TENS 
          BX3       X1
          LX3       2                  8*TENS 
          IX1       X1+X3              10*TENS
          IX1       X1+X2              10*TENS+UNITS
          SX7    1                 USED LATER TO ENSURE ONLY N-1
          IX1    X1+X7             SPACES ARE SKIPPED FOR TAB(N)
          IX5       X1-X5 
          PL        X5,TEXIT           X-CURRENT PRINT POSITION 
          BX2    -X5             X2 = POSITIVE NO OF BLANKS REQUIRED
* 
 TABCNV5  BSS    0
* TEST IF SBLANK AREA LARGE ENUFF TO HOLD REQD STRING OF BLNKS
          SX3    X5+150          NEGATIVE COUNT OF BLANKS + 150 
          PL     X3,BIGENUFF     BR, SBLANK IS BIG ENUFF
* 
* FALL THRU, ASK STRING MANAGER FOR A TEMPORARY STRING AREA 
          SX1    TABTEMPW        X1 = ADDRESS OF PTR WORD FOR TEMPORARY 
*         (X2 CONTAINS COUNT OF BLANKS REQUIRED = REQD STRING AREA LENGT
          MX6    0
          SA6    TABTEMPW        CLEAR TEMPORARY PTR WORD 
 BASCGST  NO                     GET A TEMPORARY SPACE
*                                BASCOMP BUILDS RJ =XBASGSTR HERE 
          BSS    0
* 
*         (BASGSTR RETURNS X2 SAME AS X2 VALUE ON CALL) 
*         (X1 = ADDRESS OF TEMPORARY AREA)
          SB7    X1              X7 = ADDRESS OF TEMPORARY
          SA5    TABTEMPW        A5/X5 SET UP FOR FUTURE STRG MOVE
          EQ     FILLAREA        GO TO SET UP BLANKS IN AREA
* 
 BIGENUFF BSS    0
* 
          SB7    SBLANK          B7 = ADDRESS OF STORE AREA 
          SA5    SBLANKPW        A5/X5 SET UP AS REQD FOR STRG MOVE 
* 
* FALL THRU, FILL SBLANK AREA 
 FILLAREA BSS    0
* BRANCH IN, FILL TEMPORARY AREA
* 
          SX7       55B 
          LX7       54
TLOOPW    SB6       10
          SX6       B0
 TLOOPC   ZR     X2,TDONE 
          BX6       X6+X7 
          LX7       54
          SX2    X2-1 
          SB6       B6-1
          NE        B6,B0,TLOOPC
          SA6       B7
          SB7       B7+1
          EQ        TLOOPW
TDONE     SA6       B7
          MX6    0                     MAKE NEXT WORD ZERO IN CASE
          SA6    B7+1                  PREVIOUS WORD FILLS TO 9 CHARACTE
          JP     TABCNV            EXIT 
TEXIT     SA5       ZERO
*                A PTR WORD OF ZERO = A NULL STRING 
          JP     TABCNV            EXIT 
ZERO      DATA       0
 SBLANK   BSSZ   16                BUFFER FOR TAB-GENERATED SPACES
 NUMCHAR  BSSZ   1                 CHARS PER LINE + 1 (THE ADDED 1
*                                  MAKES COMPARISON EASIER) 
 SAVARG   BSSZ   1
 SAVEX0   BSSZ   1
 ERM197   DATA   C* BAD TAB ARG - 1 USED *
* 
*  CONTROL REACHES HERE WITH SPECIAL NUMBERS
 NUMZERO  SA5    ZEROPW          FETCH PTR WORD 
          EQ          STND99           . EXIT 
* 
 NUMUNDF  SA5    UNDFPW          FETCH PTR WD UNDEFINED MSG 
          EQ          STND99           . EXIT 
* 
 NUMINFT  SA5    INFPW           FETCH PTR WORD 
          EQ          STND99           . EXIT 
*         STOP IS THE LOOP INDUCING CODE STRING FOR USE IN DEBUGGING
* 
          EJECT 
*  EXPONENT TABLE BEGINS HERE 
*  POSITIVE HALF FIRST
          DATA        100 
 PEXPTAB  DATA        1.0E114 
          DATA        1.0E-100
          DATA        10
          DATA        1.0E24
          DATA        1.0E-10 
          DATA        1 
          DATA        1.0E15
          DATA        1.0E-1
*  NEGATIVE PART NEXT 
          DATA        -100
 NEXPTAB  DATA        1.0E-85 
          DATA        1.0E100 
          DATA        -10 
          DATA        1.0E5 
          DATA        1.0E10
          DATA        -1
          DATA        1.0E14
          DATA        1.0E1 
 ENDPEXP  EQU         PEXPTAB+6 
 ENDNEXP  EQU         NEXPTAB+6 
* 
*  THE FOLLOWING TABLE IS USED TO CONVERT BINARY NUMBERS TO DECIMAL 
 ROUNDTB  DATA        1 
          DATA        10
          DATA        100 
          DATA        1000
          DATA        10000 
          DATA        100000
          DATA        1000000 
          DATA        10000000
          DATA        100000000 
          DATA        1000000000
          DATA        10000000000 
          DATA        100000000000
          DATA        1000000000000 
          DATA        10000000000000
          DATA        100000000000000 
          DATA        1000000000000000
* 
* 
ZEROPIC   DATA     3L 0 
UNDFPIC   DATA     11L UNDEFINED
INFTPIC   DATA    10L INFINITY
          DATA   0
 TABFLG   DATA      0 
NUMFLG   DATA           0         .FLAG FOR NUMERIC OUTPUT
 BKSP1    BSSZ   1
 OCHANNL  BSSZ        1 
* 
 OBUFLCL  BSS    0
*  COPYRIGHT NOTICE IS OVERWRITTEN WHEN BUFFER IS USED  * 
          DATA   H* COPYRIGHT CONTROL DATA CORPORATION *
          DATA   C* 1975,1976,1977,1978 * 
          BSS    OBUFLCL+BUFFLGT-*
* 
*         END   OUTPUT - CONVERT
          TITLE  BASOCHK - PROCEDURE OUTPUT CHECK 
* 
*         PROCEDURE OUTPUT-CHECK
* 
 BASOCHK  SPACE  4
*         ENTER- B5 = FET ADDRESS 
* 
*         EXIT-  B6 = 0 (NO ERROR)
* 
*         USES-  A1,X1,A2,X2,A3,X3,A4,X4,A5,X5
* 
*         CALLS- CIO= 
  
         DATA      10HBASOCHK 
 BASOCHK  PS     0
* 
          SB6    0
* 
* TEST IF COMPILE OR RUN TIME.
* COMPILE TIME REQUIRES AND EXPECTS OUTPUT BUFFER TO HAVE 
* AT LEAST ONE LINE OF SPACE FREE.
* RUN TIME EXPECTS BASOCHK TO ENSURE THAT 2 WORDS ARE FREE. 
* 
          SA1    COMRUNS         FETCH COMPILE/RUNTIME FLAG 
          NZ     X1,CTIM         BR, IT IS COMPILE TIME 
* 
* FALL THRU, IT IS RUN TIME 
          SX3    2               SET UP NO OF FREE WORDS COUNT
          EQ     CALCSP          GO CHECK OUT HOW MUCH SPACE AVAIL IN CI
* 
 CTIM     SA3    B5+FETLINL      X3 = MAX LINE WORDS / CHARS
          AX3    30              X3 = MAX LINE WORDS
          SX3    X3+2            X3 = MAX LINE WORDS + 2
* 
* IF IT IS COMPILE TIME AND ASCII MODE, WE
* DOUBLE THE NO OF FREE WORDS REQUIRED IN CIO BUFF
          SA5    ASCII           X5 = ASCII FLAG
          ZR     X5,CALCSP       BR, NOT ASCII, GO TO CHECK OUT BUFFER S
* 
* FALL THRU, IT IS ASCII
          LX3    1               X3 = DOUBLED NO OF MAX LINE WORDS
* 
 CALCSP   BSS    0
* 
* HERE FOR COMPILE TIME AND RUN TIME
          SA1    B5+FETIN        FETCH ADDRESS OF NEXT WORD TO BE USED
          SA2    B5+FETOUT        *OUT* 
          IX4    X2-X1           *OUT* - *IN* 
* 
          ZR     X4,BASOCHK  IF EMPTY BUFFER
          PL     X4,BOK1     IF *IN* .LE. *OUT* (X4) = REMAINING SPACE
          SA4    FETLIMT+B5  *LIMIT*
          SA5    FETFRST+B5  *FIRST*
          IX4    X4-X1       *LIMIT* - *IN* 
          IX5    X2-X5       *OUT* - *FIRST*
          IX4    X4+X5       TOTAL AVAILABLE SPACE
          SX4    X4 
 BOK1     IX3    X4-X3       SPACE AVAILABLE - LINE LENGTH
          PL     X3,BASOCHK  IF ONE OR MORE LINES REMAIN TO BE FILLED 
  
          SA1    FETSETV+B5 
          LX1    1                 CHECK B58 (SET-OCCURRED FLAG)
          NG     X1,RNDMF1         SKIP IF RANDOM FILE
  
  
          LX1    1
          NG     X1,APPFCHK  SKIP IF APPEND FILE INVOLVED 
  
*         WRITE OUTPUT
  
          MX4    42 
          IFNE   FETFILE,0
          SA1    FETFILE+B5 
          BX3    X2                SAVE FETSTAT FOR LATER 
          ELSE
          SA1    B5 
          ENDIF 
          SA2    FETSTAT+B5 
          UX2    X2,B6       TYPE OF WRITE
          SB6    B6-WRITFUN        CHECK FOR CODED WRITE
          NZ     B6,BOK2           BR, BINARY WRITE 
          LX3    59-18             CHK FOR CONNECTED OUTPUT FILE
          PL     X3,BOK2           BR, NOT CONNECTED OUTPUT FILE
          MX6    59                SET CONNECTED PRINT FLAG FOR USE 
          SA6    PRTFLG            BY INTERRUPT PROCESSOR 
* 
 BOK2     BSS    0
          BX1    X1*X4
          SX2    B6+1 
          BX6    X1+X2
          SA6    A1          STORE CODE FIELD 
*         WRITE BUFFER    (NON  BUFFERED) 
          WRITE  B5,R 
  
          SB6    B0          SET NO ERROR 
          EQ     BASOCHK     RETURN 
* 
* 
 APPFCHK  BSS    0
          SA1    FETSETV+B5 
          MX0    2
          LX0    58 
          BX7    -X0*X1      DROP -APPEND- FLAGS
          SA7    A1          REPLACE IN FET 
  
  
*                ARRANGE TO RE-WRITE THE 1ST (SPLICED) BUFFER BACK
*                INTO PLACE IF AN APPEND OCCURRED MOST RECENTLY FOR THIS
  
  
          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    B0 
  
          RJ     RNDMWR      REWRITE THE SPLICED (OLD DATA + APPENDED 
*                            DATA) BUFFER 
  
          SA1    FETFRST+B5 
          SX7    X1 
          SA7    A1          DROP RANDOM , ERROR CONTROL AND FET LENGTH 
*                            FIELDS 
  
          SB6    B0          SPECIFY NO EOR 
  
          EQ     BASOCHK     EXIT 
 RNDMF1   BSS    0
          SA1    FETROI+B5         CHECK BUFFER-HAS-BEEN-ALTERED FLAG 
          PL     X1,BUFNOTW        SKIP IF IT WAS READ ONLY 
  
          SB7    B0                EOR NOT SPECIFIED
          RJ     RNDMWR            REWRITE THE BUFFER 
  
 BUFNOTW  BSS    0
          SA1    FETLOFC+B5 
          MX0    30 
          BX1    -X0*X1            PICK-UP LOC VALUE
          AX1    6                 SHIFT TO GET REL SECTOR ADDRESS
          SX2    1
          IX1    X1+X2             ALLOW FOR 1-ORIGIN CONVENTION
  
          RJ     RNDMRD 
  
          SA1    FETLOFC+B5 
          MX0    54 
          BX1    -X0*X1            OFFSET FROM BUFFER START 
          SA2    FETOUT+B5
          IX6    X1+X2
          SA6    FETIN+B5          FORCE IN TO OUT + OFFSET 
          EQ     BASOCHK           EXIT 
          EJECT 
 SETCHK   BSS    0
* 
* 
***              SETCHK REPOSITIONS THE FILE IF NECESSARY TO THE
***              NEAREST SECTOR IMPLIED BY THE SET VALUE. THE CURRENT 
***              BUFFER IS REWRITTEN IF IT HAS CHANGED SINCE BEING READ.
* 
* 
*                ENTRY (B5) = ADDRESS OF THE FET
* 
*                EXIT  (X5) = DIFFERENCE BETWEEN THE CURRENT AND THE
*                      SPECIFIED SET VALUE. (X5) IS .LT. 0 IF SET IS
*                      NOT APPLICABLE.
* 
* 
* 
          BSSZ   1
          MX5    1
          SA1    FETSETV+B5        B59 ON IMPLIES SET PENDING 
          PL     X1,SETCHK         EXIT WITH (X5) .LT. 0
  
          MX0    2
          BX1    -X0*X1            KEEP SET VALUE (DROP B59-58) 
          MX0    1
          LX0    59 
          BX6    X0+X1             FORCE B58 ON (SET OCCURRED FLAG) 
          SA6    A1                REPLACE IN FET 
  
  
*                NOW TEST IF THE FILE LOCATION IMPLIED BY THE LATEST SET
*                VALUE IS ALREADY AVAILABLE IN THE BUFFER LAST READ.
  
  
          MX0    23 
          LX0    59 
          SA1    FETROI+B5
          BX2    X0*X1             RSA AT WHICH LAST READ WAS DONE
          AX2    36                MOVE IT DOWN 
          ZR     X2,NEWREAD        SKIP IF NO PREVIOUS SETTING
          SX2    X2-1              ALLOW FOR 1 ORIGIN CONVENTION
          LX2    6                 CONVERT SECTOR COUNT TO WORD COUNT 
  
          SX3    X1                PICK UP IN AS AT LAST READ 
          BX7    X3                HOLD PRO TEM 
  
          AX1    18 
          SX4    X1                OUT AS AT LAST READ
          IX3    X3-X4             IN - OUT 
          IX3    X3+X2             UPPER BOUND OF BUFFER
          MX0    IOFLAGS
          SA5    FETSETV+B5 
          BX5    -X0*X5            LATEST SET VALUE 
          IX6    X5-X3             (SET VALUE) - UPPER BOUND
          PL     X6,NEWREAD        SKIP (SET IS ABOVE CURRENT BUFFER) 
  
          IX6    X5-X2             (SET VALUE) - LOWER BOUND OF BUFFER
          NG     X6,NEWREAD        SKIP IF SET IS BELOW CURRENT BUFFER
  
          SA7    FETIN+B5          RESET IN AS AT LAST READ 
  
          SX7    X1 
          SA7    A7+1              RESET OUT AS AT LAST READ
  
          BX5    X6                ACTUAL OFFSET FROM START OF BUFFER 
          EQ     SETCHK            EXIT 
  
  
 NEWREAD  BSS    0
          SA2    FETSTAT+B5 
          UX2    B6,X2
          EQ     B6,B0,FILREW      SKIP IF FILE IS REWOUND
  
  
          PX7    B0,X2
          SA7    A2                FORCE STATUS NEUTRAL 
  
  
          SA2    FETROI+B5         CHECK THE WRITE BIT (B59)
          PL     X2,RDONLY         SKIP IF THE BUFFER WAS NOT CHANGED 
  
          SA2    FETROI+B5
          AX2    36 
          MX0    37 
          BX2    -X0*X2 
          ZR     X2,FRSTSET        SKIP IF THIS IS THE FIRST SET
  
  
          SB7    B0                EOR NOT NEEDED 
          SA2    B5                CHECK IF EOR ON LAST READ
          LX2    59-4 
          PL   X2,WRITREC          JUMP IF NOT EOR
          SB7    1           ELSE FORCE WRITE-WITH-EOR
  
 WRITREC  BSS    0
          RJ     RNDMWR            REWRITE THE BUFFER 
  
 RDONLY   BSS    0
 FRSTSET  BSS    0
 FILREW   BSS    0
          MX0    IOFLAGS
          SA1    FETSETV+B5        SET VALUE
          BX1    -X0*X1 
          AX1    6                 (SET VALUE)/64 
          SX2    1
          IX1    X1+X2             RSA COUNT ORIGINS AT 1 
  
          RJ     RNDMRD            READ AT THE APPROPRIATE RSA
  
  
          SA1    FETSETV+B5        SET VALUE
          MX0    54 
          BX5    -X0*X1            LOWER 6 BITS OF SET VALUE IE OFFSET
  
  
          EQ     SETCHK 
  
  
* 
 RNDMRD   BSS    0
* 
* 
***              READS THE FILE AT THE SPECIFIED RELATIVE SECTOR ADDRESS
***              THE IN AND OUT RETURNED BY READ ARE SAVED IN FETROI
* 
*                ENTRY (X1) = RELATIVE SECTOR ADDRESS 
* 
  
          BSSZ   1
          MX7    0
          IFC      EQ,,"OS.NAME",KRONOS,
          MX7    1
          LX7    30                SET BIT 29 
          ENDIF 
          BX7    X7+X1             MERGE RELATIVE SECTOR ADDRESS
          SA7    FETINDX+B5        DUMP IN FET
  
          LX1    36                SHIFT BEFORE MERGE WITH FETROI 
          SA2    FETROI+B5
          MX0    23 
          LX0    60-1              MASK FOR B58-36 (KEEP B59) 
          BX2    -X0*X2            DROP CURRENT RSA VALUE 
          BX7    X1+X2             MERGE RSA,IN,OUT 
          SA7    A2                RESET IN FET 
  
          SA1    FETFRST+B5 
          SX7    X1 
          SA7    A1+1              MOVE -FIRST- TO -IN- AND 
          SA7    A1+2              -OUT-
  
          IFC    EQ,,"OS.NAME",SCOPE ,
          MX6    1
          LX6    48 
          BX6    X6+X1             SET BIT 47 
          SA6    A1 
          ENDIF 
  
          MX0    42 
          SA1    B5 
          BX1    X0*X1             FILE NAME
          SX7    READBIN+1         READ BINARY
          BX7    X1+X7             MERGE
          SA7    A1                RESET IN FET 
  
  
          READ   B5,R              READ SECTOR AS IMPLIED BY SET VALUE
  
  
  
          SA1    B5                FILE NAME ,ERROR STATUS ETC
          AX1    10 
          MX0    56 
          BX1    -X0*X1            ISOLATE ABNORMAL TERMINATION 
          NZ     X1,ER174    *RANDOM ACTION BEYOND EOF* 
          SA1    FETOUT+B5         OUT
          LX1    18 
          SA2    FETIN+B5          IN 
          BX1    X1+X2             MERGE
          MX0    24 
          SA2    FETROI+B5
          BX2    X0*X2             DROP FORMER IN AND OUT 
          BX7    X1+X2             MERGE NEW IN AND OUT 
          SA7    A2                REPLACE IN FET 
  
          EQ     RNDMRD 
  
  
  
  
 RNDMWR   BSS    0
* 
* 
***              REWRITES THE BUFFER AT THE RSA IT WAS READ FROM
*                WITH AN EOR IF SPECIFIED.
* 
* 
*                ENTRY (B5) ^ ADDRESS OF THE FET
*                      (B7) = 1 IF WRITER REQUIRED ELSE = 0 
* 
* 
          BSSZ   1
          SA2    FETROI+B5
          MX0    42 
          BX7    -X0*X2            PICK-UP IN (AS SET BY CIO AFTER THE
                                   MOST RECENT READ ON THIS FILE) 
          SA7    FETIN+B5          RESET IN FET 
          AX2    18 
          BX7    -X0*X2            PICK-UP OUT
          SA7    A7+1              RESET IN FET 
  
          MX0    37 
          AX2    18 
          BX2    -X0*X2            RSA AT WHICH LAST READ TOOK PLACE
  
          MX7    0
          IFC      EQ,,"OS.NAME",KRONOS,
          MX7    1
          LX7    30                SET BIT 29 (W-BIT FOR RANDOM WRITE)
          ENDIF 
          BX7    X7+X2             MERGE WITH RSA AT WHICH TO WRITE 
          SA7    FETINDX+B5        DUMP AT FET+6
  
          MX0    42 
          SA2    B5 
          BX2    X0*X2             FILE NAME
          SX7    WRITBIN+1         BINARY WRITE 
          BX7    X2+X7             MERGE
          SA7    A2                REPLACE IN FET 
  
          SA1    B5+FETFRST 
          MX7    1
          LX7    48                SET BIT 47 
          BX7    X7+X1
          IFC    EQ,,"OS.NAME",KRONOS,
*                              CHANGE THE LENGTH FIELD
          MX6    1             TO INCLUDE THE RANDOM INDEX
          LX6    20 
          BX7    X6+X7
          ENDIF 
          SA7    A1 
  
  
          NE     B7,B0,WREOR       SKIP IF EOR REQUIRED 
  
          REWRITE  B5,R 
  
  
          EQ     RNDMWR 
  
 WREOR    BSS    0
  
          REWRITER B5,R 
  
          SA1    FETROI+B5
          AX1    18 
          MX6    42 
          BX7    -X6*X1 
          SA1    FETIN+B5 
          SX1    X1 
          IFC    EQ,,"OS.NAME",SCOPE ,
          IX7    X1-X7
          SX6    77B
          BX7    X6*X7
          ZR     X7,RWRITER 
          ENDIF 
          SA2    FETOUT+B5
          IX1    X1-X2
          ZR     X1,RNDMWR
 RWRITER   BSS    0 
          WRITER B5,R 
  
          EQ     RNDMWR            REJOIN 
 CC       DATA   1L1               BASOPTS FLAG 
          TITLE  FIND ASCII ORDINAL ROUTINE (ASCORD)
 ASCORD   DATA   0
* 
 ESC100   EQU    7400B             ASCII ESCAPE CODES 
 ESC200   EQU    7600B
* 
*  FIND ASCII ORDINAL OF DISPLAY CODE CHARACTER IN X1 
*  RETURN ORDINAL IN X1,  RETURN NEGATIVE IF NON-ASCII CHARACTER
*  SUCH AS 7400 OR 7477 
*  CALLED BY ASC COMPILE-TIME FUNCTION AND CHANGE STMT IN ASCII MODE
*  AND STRING COMPARE IN ASCII MODE 
* 
          SX2    77B               CONVERT CHAR IN X1 TO AN INDEX 
          BX3    -X2*X1            X3 = UPPER BITS
          BX4    X2*X1             X4 = LOWER BITS
          NZ   X3,ASCORD1          NOT 0-77B
 IF1      IFEQ   CHARSET,OLDCSET
          ZR   X4,ASCORD3          00 ILLEGAL 
          SX5    X4-ESC1
          ZR   X5,ASCORD3          74 ILLEGAL 
          SX5    X4-ESC2
          ZR   X5,ASCORD3          76 ILLEGAL 
 IF1      ELSE
 IF2      IFEQ   IP.CSET,IP.C63 
          ZR   X4,ASCORD3          00 ILLEGAL 
 IF2      ENDIF 
          SA5    ASCII
          ZR   X5,ASCORD4          ANYTHING OK IN NON-ASCII MODE
 IF3      IFNE   IP.CSET,IP.C63 
          ZR   X4,ASCORD3          00 ILLEGAL 
 IF3      ENDIF 
          SX5    X4-ESC1
          ZR   X5,ASCORD3          74 ILLEGAL 
          SX5    X4-ESC2
          ZR   X5,ASCORD3          76 ILLEGAL 
 IF1      ENDIF 
          EQ   ASCORD4
 ASCORD1  SX5    X3-ESC100
          NZ   X5,ASCORD2          NOT 74XX 
          ZR   X4,ASCORD3          7400 ILLEGAL 
 IF1      IFEQ   CHARSET,OLDCSET
          SX5    X4-10B 
          PL   X5,ASCORD3          7410-7477 ILLEGAL
 IF1      ELSE
          SX5    X4-10B 
          PL     X5,ASCORD3  7410-7477 ARE ILLEGAL
          SX5    X4-3 
          ZR   X5,ASCORD3          7403 ILLEGAL 
 IF1      ENDIF 
          SX1    ASCTBL74+X4       SET INDEX FOR 74XX 
          EQ   ASCORD4
 ASCORD2  SX5    X3-ESC200
          NZ   X5,ASCORD3          NOT 76XX 
 IF1      IFEQ   CHARSET,OLDCSET
          ZR   X4,ASCORD3          7600 ILLEGAL 
 IF1      ENDIF 
          SX1    ASCTBL76+X4       SET INDEX FOR 76XX 
          EQ   ASCORD4
 ASCORD3  SX1    -1                ILLEGAL CHARACTER
          EQ   ASCORD              EXIT 
* 
 ASCORD4  BSS    0                 X1 = INDEX INTO TABLE
          MX2    57 
          BX2    -X2*X1            X2 = LOWER 3 BITS
          AX1    3                 X1 = INDEX/8 
          SA1    ASCTBL+X1         FETCH WORD CONTAINING 8 7-BIT ENTRIES
          SB6    X2                POSITION 7-BIT ENTRY TO THE LEFT 
          SX3    X2                LOWER BITS 
          LX3    2                 *4 
          LX2    1                 *2 
          IX2    X2+X3             *6 
          SB6    B6+X2             7*LOWER BITS 
          LX1    B6,X1             POSITION LEFT
          LX1    7                 MOVE AROUND TO THE RIGHT 
          MX2    53                ISOLATE THE ENTRY
          BX1    -X2*X1 
          EQ   ASCORD              RETURN, X1 = THE ORDINAL 
* 
* 
 ASCTBL   BSS    0
*  TABLE OF ASCII ORDINALS IN DISPLAY CODE ORDER
*  EACH WORD CONTAINS 8 7-BIT ENTRIES AND 4 UNUSED BITS 
*                  ORDINAL         DISPLAY CODE 
 IF1      IFEQ   CHARSET,OLDCSET
          VFD    7/0               00  UNUSED 
          VFD    7/65              01  A
          VFD    7/66              02  B
          VFD    7/67              03  C
          VFD    7/68              04  D
          VFD    7/69              05  E
          VFD    7/70              06  F
          VFD    7/71              07  G
          VFD 4/0 
          VFD    7/72              10  H
          VFD    7/73              11  I
          VFD    7/74              12  J
          VFD    7/75              13  K
          VFD    7/76              14  L
          VFD    7/77              15  M
          VFD    7/78              16  N
          VFD    7/79              17  O
          VFD 4/0 
          VFD    7/80              20  P
          VFD    7/81              21  Q
          VFD    7/82              22  R
          VFD    7/83              23  S
          VFD    7/84              24  T
          VFD    7/85              25  U
          VFD    7/86              26  V
          VFD    7/87              27  W
          VFD 4/0 
          VFD    7/88              30  X
          VFD    7/89              31  Y
          VFD    7/90              32  Z
          VFD    7/48              33  0
          VFD    7/49              34  1
          VFD    7/50              35  2
          VFD    7/51              36  3
          VFD    7/52              37  4
          VFD 4/0 
          VFD    7/53              40  5
          VFD    7/54              41  6
          VFD    7/55              42  7
          VFD    7/56              43  8
          VFD    7/57              44  9
          VFD    7/43              45  +
          VFD    7/45              46  -
          VFD    7/42              47  *
          VFD 4/0 
          VFD    7/47              50  /
          VFD    7/40              51  (
          VFD    7/41              52  )
          VFD    7/36              53  $
          VFD    7/61              54  =
          VFD    7/32              55  SPACE
          VFD    7/44              56  ,
          VFD    7/46              57  .
          VFD 4/0 
          VFD    7/34              60  QUOTE
          VFD    7/91              61  OPEN BRKT
          VFD    7/93              62  CLOSE BRKT 
          VFD    7/58              63  COLON
          VFD    7/39              64  APOSTROPHE 
          VFD    7/38              65  AMPERSAND
          VFD    7/13              66  CR 
          VFD    7/10              67  LF 
          VFD 4/0 
          VFD    7/94              70  UPARROW (CIRCUMFLEX) 
          VFD    7/35              71  POUND
          VFD    7/60              72  LESS 
          VFD    7/62              73  GREATER
          VFD    7/0               74  UNUSED 
          VFD    7/63              75  QUESTION MK
          VFD    7/0               76  UNUSED 
          VFD    7/59              77  SEMICOLON
          VFD 4/0 
 ASCTBL74 EQU    100B              74XX STARTS HERE 
          VFD    7/0               7400  UNUSED 
          VFD    7/64              01  COMMERCIAL AT
          VFD    7/37              02  PERCENT
          VFD    7/96              03  GRAVE
          VFD    7/95              04  UNDERLINE
          VFD    7/17              05  DC1
          VFD    7/19              06  DC3
          VFD    7/5               07  ENQ
          VFD 4/0 
 ASCTBL76 EQU    110B              76XX STARTS HERE 
          VFD    7/0               7600  UNUSED 
          VFD    7/97              01  A
          VFD    7/98              02  B
          VFD    7/99              03  C
          VFD    7/100             04  D
          VFD    7/101             05  E
          VFD    7/102             06  F
          VFD    7/103             07  G
          VFD 4/0 
          VFD    7/104             10  H
          VFD    7/105             11  I
          VFD    7/106             12  J
          VFD    7/107             13  K
          VFD    7/108             14  L
          VFD    7/109             15  M
          VFD    7/110             16  N
          VFD    7/111             17  O
          VFD 4/0 
          VFD    7/112             20  P
          VFD    7/113             21  Q
          VFD    7/114             22  R
          VFD    7/115             23  S
          VFD    7/116             24  T
          VFD    7/117             25  U
          VFD    7/118             26  V
          VFD    7/119             27  W
          VFD 4/0 
          VFD    7/120             30  X
          VFD    7/121             31  Y
          VFD    7/122             32  Z
          VFD    7/16              33  DLE
          VFD    7/7               34  BEL
          VFD    7/18              35  DC2
          VFD    7/3               36  ETX
          VFD    7/20              37  DC4
          VFD 4/0 
          VFD    7/21              40  NAK
          VFD    7/22              41  SYN
          VFD    7/23              42  ETB
          VFD    7/24              43  CAN
          VFD    7/25              44  EM 
          VFD    7/11              45  VT 
          VFD    7/1               46  SOH
          VFD    7/33              47  EXCLAMATION
          VFD 4/0 
          VFD    7/15              50  SI 
          VFD    7/8               51  BS 
          VFD    7/9               52  HT 
          VFD    7/4               53  EOT
          VFD    7/29              54  GS 
          VFD    7/0               55  NUL
          VFD    7/12              56  FF 
          VFD    7/14              57  SO 
          VFD 4/0 
          VFD    7/2               60  STX
          VFD    7/123             61  OPEN BRACE 
          VFD    7/125             62  CLOSE BRACE
          VFD    7/26              63  SUB
          VFD    7/6               64  ACK
          VFD    7/38              65  AMPERSAND
          VFD    7/92              66  BACKSLASH
          VFD    7/124             67  VERTICAL LINE
          VFD 4/0 
          VFD    7/126             70  TILDE
          VFD    7/35              71  POUND
          VFD    7/28              72  FS 
          VFD    7/30              73  RS 
          VFD    7/127             74  DEL
          VFD    7/31              75  US 
          VFD    7/0               76  UNUSED 
          VFD    7/27              77  ESC
          VFD 4/0 
 IF1      ELSE
 IF2      IFEQ   IP.CSET,IP.C63 
          VFD    7/0               00  UNUSED 
 IF2      ELSE
          VFD    7/58              00  NON-ASCII COLON
 IF2      ENDIF 
          VFD    7/65              01  A
          VFD    7/66              02  B
          VFD    7/67              03  C
          VFD    7/68              04  D
          VFD    7/69              05  E
          VFD    7/70              06  F
          VFD    7/71              07  G
          VFD 4/0 
          VFD    7/72              10  H
          VFD    7/73              11  I
          VFD    7/74              12  J
          VFD    7/75              13  K
          VFD    7/76              14  L
          VFD    7/77              15  M
          VFD    7/78              16  N
          VFD    7/79              17  O
          VFD 4/0 
          VFD    7/80              20  P
          VFD    7/81              21  Q
          VFD    7/82              22  R
          VFD    7/83              23  S
          VFD    7/84              24  T
          VFD    7/85              25  U
          VFD    7/86              26  V
          VFD    7/87              27  W
          VFD 4/0 
          VFD    7/88              30  X
          VFD    7/89              31  Y
          VFD    7/90              32  Z
          VFD    7/48              33  0
          VFD    7/49              34  1
          VFD    7/50              35  2
          VFD    7/51              36  3
          VFD    7/52              37  4
          VFD 4/0 
          VFD    7/53              40  5
          VFD    7/54              41  6
          VFD    7/55              42  7
          VFD    7/56              43  8
          VFD    7/57              44  9
          VFD    7/43              45  +
          VFD    7/45              46  -
          VFD    7/42              47  *
          VFD 4/0 
          VFD    7/47              50  /
          VFD    7/40              51  (
          VFD    7/41              52  )
          VFD    7/36              53  $
          VFD    7/61              54  =
          VFD    7/32              55  SPACE
          VFD    7/44              56  ,
          VFD    7/46              57  .
          VFD 4/0 
          VFD    7/35              60  POUND
          VFD    7/91              61  OPEN BRKT
          VFD    7/93              62  CLOSE BRKT 
 IF2      IFEQ   IP.CSET,IP.C63 
          VFD    7/58              63  COLON
 IF2      ELSE
          VFD    7/37              63  PERCENT
 IF2      ENDIF 
          VFD    7/34              64  QUOTE
          VFD    7/95              65  UNDERLINE
          VFD    7/33              66  EXCLAMATION
          VFD    7/38              67  AMPERSAND
          VFD 4/0 
          VFD    7/39              70  APOSTROPHE 
          VFD    7/63              71  QUESTION MK
          VFD    7/60              72  LESS 
          VFD    7/62              73  GREATER
          VFD    7/64              74  NON-ASCII AT 
          VFD    7/92              75  BACKSLASH
          VFD    7/94              76  NON-ASCII CIRCUMFLEX 
          VFD    7/59              77  SEMICOLON
          VFD 4/0 
 ASCTBL74 EQU    100B              74XX STARTS HERE 
          VFD    7/0               7400  UNUSED 
          VFD    7/64              01  ASCII AT 
          VFD    7/94              02  ASCII CIRCUMFLEX 
          VFD    7/0               03  UNUSED 
 IF2      IFEQ   IP.CSET,IP.C63 
          VFD    7/37              04  PERCENT
 IF2      ELSE
          VFD    7/58              04  ASCII COLON
 IF2      ENDIF 
          VFD    7/17        05  ALTERNATE DC1
          VFD    7/18        06  ALTERNATE DC3
          VFD    7/96        07  GRAVE
          VFD 4/0 
 ASCTBL76 EQU    110B        76XX STARTS HERE 
          VFD    7/96        7600  OLD GRAVE
          VFD    7/97              01  A
          VFD    7/98              02  B
          VFD    7/99              03  C
          VFD    7/100             04  D
          VFD    7/101             05  E
          VFD    7/102             06  F
          VFD    7/103             07  G
          VFD 4/0 
          VFD    7/104             10  H
          VFD    7/105             11  I
          VFD    7/106             12  J
          VFD    7/107             13  K
          VFD    7/108             14  L
          VFD    7/109             15  M
          VFD    7/110             16  N
          VFD    7/111             17  O
          VFD 4/0 
          VFD    7/112             20  P
          VFD    7/113             21  Q
          VFD    7/114             22  R
          VFD    7/115             23  S
          VFD    7/116             24  T
          VFD    7/117             25  U
          VFD    7/118             26  V
          VFD    7/119             27  W
          VFD 4/0 
          VFD    7/120             30  X
          VFD    7/121             31  Y
          VFD    7/122             32  Z
          VFD    7/123             33  OPEN BRACE 
          VFD    7/124             34  VERTICAL LINE
          VFD    7/125             35  CLOSE BRACE
          VFD    7/126             36  TILDE
          VFD    7/127             37  DEL
          VFD 4/0 
          VFD    7/0               40  NUL
          VFD    7/1               41  SOH
          VFD    7/2               42  STX
          VFD    7/3               43  ETX
          VFD    7/4               44  EOT
          VFD    7/5               45  ENQ
          VFD    7/6               46  ACK
          VFD    7/7               47  BEL
          VFD    4/0
          VFD    7/8               50  BS 
          VFD    7/9               51  HT 
          VFD    7/10              52  LF 
          VFD    7/11              53  VT 
          VFD    7/12              54  FF 
          VFD    7/13              55  CR 
          VFD    7/14              56  SO 
          VFD    7/15              57  SI 
          VFD 4/0 
          VFD    7/16              60  DLE
          VFD    7/17              61  DC1
          VFD    7/18              62  DC2
          VFD    7/19              63  DC3
          VFD    7/20              64  DC4
          VFD    7/21              65  NAK
          VFD    7/22              66  SYN
          VFD    7/23              67  ETB
          VFD 4/0 
          VFD    7/24              70  CAN
          VFD    7/25              71  EM 
          VFD    7/26              72  SUB
          VFD    7/27              73  ESC
          VFD    7/28              74  FS 
          VFD    7/29              75  GS 
          VFD    7/30              76  RS 
          VFD    7/31              77  US 
          VFD 4/0 
 IF1      ENDIF 
* 
* 
          END 
