*DECK,OUTPUT
          IDENT     BASOGEN 
          TITLE  BASOGEN
* 
*CALL COPYRITE
* 
          IPARAMS 
          COMMENT BASIC 3 - OUTPUT ROUTINES.
*CALL LIPARAM 
          ENTRY     BASOPRT 
          EXT    LBLKFLG     OUTPUT BLANK CHAR FLAG 
          EXT    BASSYS=
 SYS=     EQU    BASSYS=
          EXT    BASOTAB           PROCEDURE - TAB CONTROL
          EXT    BASOMOV           PROCEDURE - CHARACTER MOVE 
          EXT    CC                BASOPTS FLAG 
          EXT    NUMCHAR
          EXT    TABFLG 
          ENTRY  BASATAB,BATATAB
          ENTRY     BASOSRT 
          EXT    RNBLOCK,RNLIST,DBUGON
          EXT    FINDEXP
          EXT    CNVDGTS,ROUNDIT
          ENTRY  BASOWR0,BATOWR0
          EXT    SETCHK 
          ENTRY     BASOWRT 
          ENTRY  BASOMGN,BATOMGN
          ENTRY  BASCALL,BASPARM
          EXT       BASEGEN 
          EXT    BASGSTR
          EXT    BASRSTR
                EXT COMRUNS 
          EXT    ASCII             ASCII MODE SWITCH
          EXT    RECOVER           RPV RECOVERY AREA                     BAS0015
          IFC    EQ,,"OS.NAME",SCOPE ,
          EXT    ASCII95           ASCII 95 CHAR TRANSLATE TABLE
          ENDIF 
          EXT    ER141,ER174
          EXT    BASRCL=
 RCL=     EQU    BASRCL=
          ENTRY  BASAV12,BASAV34
          IFC    EQ,,"OS.NAME",KRONOS,
          SST    FSET 
          ELSE
 LWPR     EQU    65B
          ENDIF 
          SYSCOM             DEFINE INTERFACE SYMBOLS.
*CALL,LCORE 
*CALL,ERMNUM
* 
* 
 MAXMARG  EQU    131070      MAXIMUM MARGIN 
 MARGBND  EQU    MAXMARG+1
 DFLTLWD  VFD    30/DFLTWDS,30/DFLTCHS
 CALLMAX  EQU    20                MAX NUMBER OF CALL ARGUMENTS 
* 
 CMASK1   EQU    74B               ASCII ESCAPE CODE 74 
 CMASK2   EQU    76B               ASCII ESCAPE CODE 76 
* 
 R        EQU       5                   FIRST PARAMETER 
* 
*         ERROR-MESSAGES
* 
 ERM130   DATA   C* ILLEGAL OUTPUT ON FILE *
 ERM131   DATA   C* ILLEGAL MARGIN *
 ERM138   DATA   C* ILLEGAL FILE NUMBER * 
* 
* 
 ER130    BSS    0
          RTERROR ERMN130,ERM130,BASEGEN   *ILLEGAL OUTPUT ON FILE *
* 
 ER131    BSS    0
          RTERROR ERMN131,ERM131,BASEGEN   *ILLEGAL MARGIN *
* 
 ER138    BSS    0
          RTERROR ERMN138,ERM138,BASEGEN   *ILLEGAL FILE NUMBER * 
* 
          TITLE  START PRINT AND MOVE-ROUTINE 
* 
*         PROCEDURE START-PRINT 
* 
          DATA      10HBASOSRT
 BASOSRT  BSSZ      1 
* 
          SX7    B0 
         SA7       LBLKFLG    CLEAR LEADING BLANK FLAG
          NZ   B5,BASOSRT          EXIT IF FILE ORD WAS NOT ZERO
          SB5    B4+1              ORD ZERO = KFILE 
          EQ        BASOSRT 
* 
*         END START-PRINT 
          EJECT 
          SPACE  4
          TITLE  BASOPRT
*         PROCEDURE PRINT 
* 
* 
* 
PRNT50    MACRO  ENDLAB,RETLAB
*                CHECK FOR STRING TERMINATOR WHEN ZERO BYTE MET 
*                ENDLAB--RETURN ADDRESS WHEN STRING TERMINATOR
*                ENCOUNTERED.  RETLAB--RETURN ADDRESS FOR NOT 
*                ENCOUNTERED. 
* 
          LOCAL  PRNT51 
          SX7    B6-1              NUMBER OF BYTES LEFT IN WORD 
          ZR     X7,PRNT51         JUMP IF LAST BYTE
          LX7    1                 BYTES * 2
          SX2    X7 
          LX7    1                 BYTES * 4
          IX2    X2+X7             BIT COUNT
          SX7    B6                SAVE B6 IN REG 
          SB6    X2-1              SHIFT COUNT FOR MASK 
          MX2    1
          AX2    B6,X2             FORM MASK TO CHECK REST OF WORD
          SB6    X7                RESET B6 
          BX2    X2*X1             EXTRACT REST OF WORD 
          ZR     X2,ENDLAB         STRING ENDED IF REST IS ZERO 
          SX2    77B               ELSE RESET REG 
          EQ     RETLAB               AND ZERO IS VALID CHAR
PRNT51    BSS    0
          SA2    A1+1              NEXT WORD
          ZR     X2,ENDLAB            IS ZERO IF STRING ENDED 
          SX2    77B               ELSE RESET REG 
          EQ     RETLAB               AND ZERO IS VALID CHAR
          ENDM
* 
* 
          DATA      10HBASOPRT
*         ENTRY  B5=FET ADDRESS 
*                X4=TAB 
*         A5 - ADDRESS OF THE ITEM POINTER WORD 
*         X5 - CONTENT OF ITEM POINTER WORD 
*         EXIT   B6=0 (NO ERROR)
*         USES   A1,X1,B6,B7
*         CALLS  BASOMOV,BASOTAB,BASOCHK,BASEGEN
 BASOPRT  BSSZ      1 
* 
          SX7    A5 
          SA7    PRTPWA      SAVE ORIGINAL POINTER WORD ADDRESS 
* 
* 
*         IF THE ITEM POINTER WORD IS ZERO, THE POINTER WORD
*         CAN BE ITSELF BE REGARDED AS THE NULL STRING OF THE 
*         ITEM.  THIS IS THE CASE FOR STRING CONSTANTS. 
*         IN THIS CASE, THE ADDRESS IN A5, NORMALLY CONSIDERED
*         THE ADDRESS OF THE POINTER WORD, CAN BE REGARDED AS 
*         THE ADDRESS OF THE (NULL) STRING. 
* 
*         IF THE CONTENTS OF THE POINTER WORD IS NON-ZERO,
*         WE USED THE STRING ADDRESS IN THE POINTER WORD
*         TO FETCH THE 1ST WORD OF THE STRING.  IF THE 1ST
*         WORD IS FOUND TO BE ZERO, WE HAVE A SECOND CASE OF
*         NULL STRING.
* 
*SET UP IN A5 THE ADDRESS OF THE STRING, AND IN X5 THE 1ST WORD 
          BX7    X5          COPY X7 TO X5 FOR XHIFTING 
          LX7    3           CHECK FOR BLANK APPENDED TO ENDING COLON FLAG
          PL     X7,RESETFL  BR, COLNFL FLAG NOT ON--RESET COLNBLK FLAG 
          SX7    1           ELSE, SET BLANK APPENDED TO ENDING COLON FLAG
          SA7    =XCOLNBLK
          EQ     CKNULL      BR, CHECK FOR NULL STRING
 RESETFL  MX7    0           RESET THE COLNBLK FLAG 
          SA7    =XCOLNBLK
 CKNULL   ZR     X5,SUDONE   A5/X5 = ADR/ 1ST WORD OF NULL STRING 
          PL     X5,NOTCONS  X5 = POINTER FOR NON CONSTANT
          SX5    X5+B4       ADD CONSTANT OFFSET FOR CONSTANT PTR 
 NOTCONS  SA5    X5          A5/X5 = STR ADDRESS/ 1ST WORD
* 
 SUDONE   BSS    0
         BX7       X4 
         SA7       SAVX4      SAVE PRINT SPACING CODE 
          SA1    B5 
          ZR     X1,ER141    *FILE CLOSED/UNDEFINED*
          SA1       B5+FETSTAT          GET STATUS-WORD 
          SB7    WRITFUN     CODED WRITE
          UX2       B6,X1 
          ZR     B6,PRNT002             NEUTRAL 
          LX1    9
          PL     X1,ER130              I/O BIT MUST BE ON 
          LX1    1
          NG     X1,ER130              BIN/CODED BIT MUST BE OFF
 PRNT002  PX7    B7,X2
          LX2    59-46       WRITE LOCK OUT BIT 
          PL     X2,PRNT021 
          SB7    B0          TRYING TO WRITE ON READ ONLY FILE
          LX2    47 
          PX7    X2,B7       SET STAT TO NEUTRAL
          SA7    A1 
          EQ     ER130       ILLEGAL OUTPUT ON FILE 
 PRNT021  BSS    0
          SA7    A1                     SET WRITE CODED FUNC
          SX3    B0 
          ZR   X5,PRNT005          SKIP IF NULL ITEM
          SX4    B0          INITIALIZE COUNT OF ASCII CHARS TO 0 
          SA1    A5 
          SB6    10 
          SA2    ASCII
          SB7    X2                B7 = ASCII MODE SWITCH 
          SX2    77B
 PRNT001  LX1    6
          BX6    X2*X1
          ZR     X6,PRNT42         CHECK FOR STR TERM IF ZERO 
PRNT43    BSS    0
          ZR   B7,PRNT12           SKIP IF NOT ASCII MODE 
*                             IGNORE ASCII ESCAPE CODE
         SX7       CMASK2     ASCII ESCAPE  76
         IX7       X7-X6
         ZR        X7,PRNT10  IF ASCII ESCAPE CODE, BYPASS
         SX7       CMASK1     ASCII ESCAPE   74 
         IX7       X7-X6
         ZR        X7,PRNT10  IF ASCII ESCAPE CODE, BYPASS
*                             ELSE NORMAL CHAR
PRNT12   BSS       0
          SX3    X3+1 
          SB6    B6-1 
          NZ     B6,PRNT001 
          SA1    A1+1 
          SB6    10 
          EQ     PRNT001
PRNT42    BSS    0                 ZERO BYTE ENCOUNTERED
          PRNT50 PRNT004,PRNT43    CHECK FOR STRING TERMINATOR
PRNT10   BSS       0
         SB6       B6-1       DECREASE BYTE COUNT 
          SX4    X4+1        X4 = COUNT OF ASCII CHARS
         ZR        B6,PRNT11  IF ASCII ESCAPE CODE AT END OF WORD 
         LX1       6          ELSE NEXT BYTE IS PART OF ASCII CHAR
         EQ        PRNT12     RESUME SCAN 
PRNT11   BSS       0
         SA1       A1+1       GET NEXT WORD OF STRING 
         SB6       10         INITIALIZE BYTE COUNT 
         LX1       6          BYTE IS PART OF ASCII CHAR
         EQ        PRNT12     RESUME SCAN 
 PRNT004  BSS    0
          SA1    B5+FETLINL        PLACE MARGIN+1 IN NUMCHAR
          IX6    X3+X4       X6 = COUNT OF 6-BIT CHARS
          SA6    PRNTLEN     SAVE CHARACTER COUNT 
          SA4    SAVX4       RESTORE DELIMITER CODE 
          NZ     X1,MRGNZ        BR, MARGIN IS NON ZERO 
* 
* FALL THRU, MARGIN IS ZERO 
*         IF WE ARE NOT AT A NEW LINE, CALL BASOMOV 
*         IMMEDIATELY TO MOVE ITEM TO CIO BUFFER. 
*         IF AT A NEW LINE, WE CHECK TO SEE IF A LEADING BLANK
*         HAS BEEN OUTPUTTED, OR OUTPUT IT IF IT IS REQUIRED. 
*         THEN GO TO BASOMOV. 
* 
          SA1    B5+FETCHAR 
          ZR     X1,PRNT007      BR, MARGIN 0, AT NEW LINE
* 
* FALL THRU, MARGIN ZERO, NOT A NEW LINE
          EQ     PRNT003
* 
* 
 MRGNZ    BSS    0
          SX7    X1                CHAR 
          AX1    29                WORDS*2
          BX2    X1 
          LX2    2
          IX1    X1+X2             WORDS*10 
          IX7    X7+X1             TOTAL CHAR 
          SX7    X7+1 
          SA7    NUMCHAR
          SA1    B5+FETCHAR 
         ZR        X1,PRNT006   BYPASS IF NEW LINE
          SA2    NUMCHAR
          IX7    X1-X2
          SX7    X7-1 
          AX1    29 
          IX7    X7+X3
          BX2    X1 
          IX1    X1+X7
          LX2    2
          IX1    X1+X2
          NG     X1,PRNT005 
          BX7    X3 
          SA7    SAVX3
          MX4    59                   NEW LINE
          SX7    A5 
          SA7    PRNTSAV
          RJ     BASOTAB
         SA5       PRNTSAV
         SA5       X5         RESTORE POINTER TO STRING 
          SA3    SAVX3
          SA4    SAVX4
          EQ     PRNT006
 PRNT005  BSS    0
         SA1       B5+FETCHAR           CHECK IF NEW LINE 
         NZ        X1,PRNT003 
*                             NEW LINE
PRNT006  BSS       0
          ZR   X5,PRNT007          NULL ITEM
         SA1       NUMCHAR    GET MAX WIDTH FOR STRING PRINT OUT + 1
         IX7       X3-X1      IF STRING EXCEEDS MAX WIDTH ALLOWED 
         PL        X7,PRNT301     WITHIN MARGIN 
         ZR        X7,PRNT301     DIVIDE INTO SEVERAL LINES 
* 
 PRNT007  BSS    0
         RJ        PRNT21     MOVE LEADING BLANK FOR CARRIAGE CONTROL 
*                                  IF NECESSARY 
 PRNT003  BSS    0
          NZ     X3,PRNT274  NON-NULL STRING
          SB7    X4 
          LE     B7,B0,PRNT274     NOT COMMA
          SX3    1
          SA5    PRNTBLK     FORCE
 PRNT274  BSS    0
          RJ     BASOMOV
          RJ        BASOTAB 
          RJ        BASOCHK 
 PRNTEXT  SA1    PRTPWA      X1 = ADDRESS OF ORIGINAL POINTER WORD
          SA5    X1          A5/X5 = ORIGINAL PTR ADR AND CONTENTS
          LX5    59-58       POSITION TEMPORARY FLAG
          PL     X5,NOTTEMP  SKIP IF NOT A TEMPORARY
          RJ     =XBASRSTR   GO RETURN TEMPORARY STRING 
 NOTTEMP  EQ     BASOPRT     EXIT 
* 
* 
PRNT21   BSS       1
*                             CHECK IF LEADING BLANK IS NECESSARY 
          IFC    EQ,,"OS.NAME",KRONOS,
          SA1    B5+FETSTAT 
          LX1    59-18       INTERACTIVE BIT
          NG     X1,PRNT21   NO CC REQUIRED ON INTERACTIVE FILE 
          ENDIF 
          SA2    KOPTION     GET NAME OF KFILE
          SX2    X2                GET ADDR OF K FILE FET 
          SX1    B5 
*                             OUTPUT LEADING BLANK ONLY IF FILE 
*                                 IS *OUTPUT*  (PRINTER)
         IX1       X1-X2
         NZ        X1,PRNT21  LEADING BLANK NOT NEEDED
*                                GO OUTPUT NEXT PART OF STRING
         SX7       A5         ELSE SAVE ADDR OF STRING
         SA7       PRNTSAV
         SA5       PRNTBLK
          BX6    X5 
          SA5    CC 
          SA6    A5          CHANGE CC TO BLANK CARRIAGE CONTROL CHARACT
         BX7       X3 
         SA7       SAVX3      SAVE CHAR COUNT (X3)
         RJ        BASOMOV    AND OUTPUT LEADING BLANK
         SX7       B0 
*                             DO NOT CONSIDER LEADING BLANK AS PART 
         SA7       B5+FETCHAR     OF PRINT OUT WIDTN
         SX7       1
         SA7       LBLKFLG    SET LEADING BLANK OUTTED FLAG 
         SA3       SAVX3      RESET CHAR COUNT
         SA5       PRNTSAV
         SA5       X5         RESET ADDR OF STRING
         EQ        PRNT21     RETURN
* 
PRNT301  BSS       0
*                             STRING TOO LONG FOR LINE WIDTH
*                             DIVIDE INTO SEVERAL LINES 
* 
*                             COPY STRING TO TEMPORARY BUFFER 
          SX1    TEMPPTR     X1 = ADDRESS OF POINTER FOR TEMP STR 
          SA2    PRNTLEN     X2 = NUMBER OF 6-BIT CHARS IN STRING 
          RJ     =XBASGSTR   GO GET TEMPORARY STRING SPACE
* 
          SA2    PRTPWA 
          SA2    X2          X2 = ORIGINAL STR PTR WORD 
          PL     X2,PRNT302  JUMP IF STR IS NOT A CONSTANT
          SX2    X2+B4       ADD IN CONSTANT OFFSET IF IT IS
 PRNT302  SA5    X2          A5/X5 = FWA/1ST WORD OF ORIGINAL STR 
*                            NOTE - FWA CANNOT BE DETERMINED UNTIL
*                                   AFTER THE CALL TO BASGSTR SINCE 
*                                   STRING MANAGER MAY MOVE THE STRING
*                                   WHEN ACQUIRING SPACE
          MX2    48 
          SB7    X1          B7 = FWA OF TEMP STRING
 PRNT24   BX7    X5 
          SA7    B7 
          SB7    B7+1 
          BX6    -X2*X5      PICK OFF LAST 2 BYTES IN WORD
          SA5    A5+1        FETCH NEXT WORD
          NZ     X6,PRNT24   LOOP IF NOT END OF STRING
          SA5    X1          A5/X5 = FWA / AND 1ST WORD OF COPIED STRING
* 
* 
*                             SCAN STRING TO MAX PRINT WIDTH
PRNT19   BSS       0
         SX3       B0         CLEAR CHAR COUNT
         SA5       A5         LOAD WORD INTO REG FOR MOVE 
         SA1       A5         LOAD FIRST WORD OF STRING 
         SB6       10         BYTE COUNT PER WORD 
          SA2    ASCII
          SB7    X2                B7 = ASCII MODE SWITCH 
         SX2       77B        BYTE MASK 
         SA4       NUMCHAR    GET MAX STRING PRINT WIDTH + 1
         SX4       X4-1           MAX STRING PRINT WIDTH
* 
PRNT13   BSS       0
         LX1       6          NEXT CHAR 
         BX6       X2*X1
          ZR     X6,PRNT45         CHECK FOR STR TERM IF ZERO 
PRNT46    BSS    0
* 
          ZR   B7,PRNT17           SKIP IF NOT ASCII MODE 
*                             IGNORE ASCII ESCAPE CODE
         SX7       CMASK2     ASCII ESCAPE  76
         IX7       X7-X6
         ZR        X7,PRNT15  BYPASS IF ASCII ESCAPE CODE 
         SX7       CMASK1     ASCII ESCAPE  74
         IX7       X7-X6
         ZR        X7,PRNT15  BYPASS IF ASCII ESCAPE CODE 
*                             ELSE  CHAR
PRNT17   BSS       0
         SX3       X3+1       INCREASE CHAR COUNT 
         IX7       X4-X3      CHECK FOR MARGIN WIDTH
         SB6       B6-1       DECREASE BYTE COUNT 
         ZR        X7,PRNT18  IF MARGIN WIDTH EXCEEDED
*                                GO OUTPUT PART OF STRING 
         NZ        B6,PRNT13  LOOP IF WORD NOT EXHAUSTED
         SA1       A1+1       ELSE GET NEXT WORD
         SB6       10         RESET BYTE COUNT
         EQ        PRNT13        AND LOOP 
* 
PRNT15   BSS       0
         SB6       B6-1       DECREASE BYTE COUNT 
         ZR        B6,PRNT16  IF ASCII AT END OF WORD 
         LX1       6          ELSE NEXT BYTE IS PART OF ASCII CHAR
         EQ        PRNT17     RESUME SCAN 
PRNT16   BSS       0
         SA1       A1+1       GET NEXT WORD OF STRING 
         SB6       10         RESET BYTE COUNT
         LX1       6          BYTE IS PART OF ASCII CHAR
         EQ        PRNT17     RESUME SCAN 
* 
PRNT45    BSS    0                 ZERO BYTE ENCOUNTERED
          PRNT50 PRNT14,PRNT46     CHECK FOR STRING TERMINATOR
PRNT14   BSS       0          STRING IS ENDED 
*                             GO PRINT LAST PORTION AND SPACE PROPERLY
         MX2       6          IF STRING IS COMPLETELY OUTPUTTED 
         BX1       X5*X2
         ZR        X1,PRNT14A     RETURN
* 
         SA1       A1         GET LAST WORD 
         RJ        PRNT25     ZERO OUT LAST PART OF WORD
*                             CHECK IF LEADING BLANK NECESSARY
         RJ        PRNT21 
         SA4       SAVX4      RESET SKIP CODE 
          SA5    A5                LOAD FIRST WORD OF STRING
         RJ        BASOMOV    MOVE STRING TO BUFFER 
         RJ        BASOTAB    DO PRINT SPACING
         RJ        BASOCHK    CHECK FOR BUFFER SPACE
PRNT14A  BSS       0
          SX1    TEMPPTR     X1 = ADR OF POINTER FOR TEMPORARY STR
          RJ     =XBASRSTR   GO RETURN TEMP STRING SPACE
          EQ     PRNTEXT     EXIT 
* 
* 
PRNT25   BSSZ      1          ZERO OUT LAST PART OF CURRENT WORD
*                                  FOR MOVE ROUTINE 
         MX4       1          FORM MASK AND ZERO OUT LAST PART OF WORD
         SX7       B0-B6
         SX7       X7+10
         LX7       1          NUMBER OF CHAR * 2
         SB6       X7 
         LX7       1          NUMBER OF CHAR * 4
         SX7       B6+X7      NUMBER OF CHAR * 6 -- BIT COUNT 
         SB6       X7-1 
         SA7       SAVBIT     SAVE BIT COUNT FOR SHIFTING 
         AX4       B6,X4      FORM MASK 
         BX7       X1*X4      EXTRACT TOP CHARS 
         SA7       A1         PUT INTO ORIGINAL STRING
         EQ        PRNT25     RETURN
* 
*                             BREAK UP STRING AND PRINT 
PRNT18   BSS       0
         SX7       B6 
         SA7       SAVB6      SAVE NUMBER OF CHAR REMAINING 
         SX7       A1 
         SA7       SAVA1      SAVE ADDR OF CURRENT WORD BEING SCANNED 
         SA1       A1 
         BX7       X1         SAVE CURRENT WORD AND NEXT WORD AS
         SA3       A1+1          REPLACED BY ZEROS FOR LINE 
         SA7       SAVSTR        TERMINATION. 
         BX7       X3 
         SA7       SAVSTR+1 
* 
         RJ        PRNT25     ZERO OUT LAST PART OF WORD
         SX7       B0 
         SA7       A1+1       STORE ZEROS -- LINE TERMINATOR
* 
*                             CHECK IF LEADING BLANK NECESSARY
         RJ        PRNT21 
         MX4       59         SET NEW LINE CODE  -1 
          SA5    A5          GET FIRST WORD TO MOVE 
         RJ        BASOMOV    MOVE STRING TO BUFFER 
         RJ        BASOTAB    SKIP LINE 
         RJ        BASOCHK    CHECK IF BUFFER FULL
* 
         SA1       SAVSTR+1   GET 2ND SAVED WORD OF STRING
         BX7       X1 
         SA1       SAVA1      GET CURRENT WORD ADDR 
         SA7       X1+1       RESTORE 2ND WORD SAVED TO STRING
* 
*                             SHIFT REMAINING STRING LEFT 
* 
         SA4       SAVB6      GET COUNT OF REMAINING BYTES
         SB6       X4 
         EQ        B6,B0,PRNT20  IF CURRENT WORD COMPLETELY USED UP 
*                                ELSE SHIFT TO WORD BOUNDARY
         SA5       X1         RESET START ADDR OF STRING
         SA1       SAVSTR     GET CURRENT WORD THAT WAS SAVED 
         BX7       X1 
         SA7       A5         RESTORE ORIGINAL WORD OF STRING 
         SA1       A5         LOAD IT FOR SHIFTING
         SA3       SAVBIT     GET SAVED BIT COUNT FOR SHIFTING
         SB6       X3-1 
         MX4       1
         AX4       B6,X4      FORM MASK 
* 
*                             SHIFT STRING LEFT UNTIL END 
PRNT23   BSS       0
          SX0    7777B             FORM MASK TO CHECK 
          BX0    X0*X1                IF LAST WORD OF STRING
          ZR     X0,PRNT49         JUMP IF SO 
         SB6       X3         BIT COUNT FOR SHIFTING
         BX7       -X4*X1     BOTTOM OF FIRST WORD
         LX7       B6,X7      SHIFT IT LEFT 
         SA2       A1+1       NEXT WORD 
         BX6       X4*X2      TOP OF SECOND WORD
         LX6       B6,X6      SHIFT IT AROUND TO RIGHT
         BX7       X7+X6      PUT WORD TOGETHER 
         SA7       A1         STORE CONSTRUCTED WORD BACK 
* 
         SA1       A1+1       NEXT WORD OF STRING TO BE PUT TOGETHER
         EQ        PRNT23        AND LOOP 
* 
PRNT20   BSS       0
         SA5       X1+1       RESET START OF STRING 
         EQ        PRNT19     GO OUTPUT NEXT PART OF STRING 
* 
PRNT49    BSS    0
          SB6    X3                BIT COUNT FOR SHIFTING 
          BX7    -X4*X1            BOTTOM OF LAST WORD
          LX7    B6,X7             SHIFT IT LEFT
          SA7    A1                STORE IT BACK
          EQ     PRNT19            FINISHED SHIFTING STRING 
*                                  GO PRINT NEXT PART OF STRING 
* 
* 
 PRNTLEN  BSS    1           COUNT OF 6-BIT CHARS IN STRING 
 TEMPPTR  BSSZ   1           POINTER FOR TEMP STRING. INITIALLY 0 
 PRTPWA   BSS    1           ADDRESS OF STRING BEING PRINTED SAVED HERE 
PRNTSAV  DATA      0
PRNTBLK  DATA      1L 
SAVB6    BSSZ      1
SAVA1    BSSZ      1
SAVSTR   BSSZ      2          TO HOLD 2 WORDS OF STRING 
SAVBIT   BSSZ      1          BIT COUNT 
SAVA5    BSSZ      1
 SAVX3    BSSZ   1
 SAVX4    DATA   0
* 
*         END PRINT 
* 
          TITLE  BASOWR0
* 
* 
* 
          DATA   10HBASOWR0 
* 
* 
***              POSITIONS A FILE IF NECESSARY IE WHEN A SET VALUE
***              IS PENDING.
* 
* 
*                ENTRY (B5) = ADDRESS OF FET FOR FILE 
*                EXIT  FETIN+B5 ADJUSTED AS REQUIRED
* 
* 
  
 BASOWR0  BSS    0
          BSSZ   1
          ZR   B5,ER138            FILE ORD WAS ZERO
  
          BX7    X5                SAVE VALUE TO BE WRITTEN 
          SA7    WRVAL
  
          RJ     SETCHK            FIND THE FILE OFFSET (IF ANY)
          PL     X5,SETPEND        SKIP IF SET STMT PENDING 
  
          SA1    FETSETV+B5 
          LX1    1
          PL     X1,BASWRX         SKIP IF FILE IS NOT RANDOM 
          SA1    FETLOFC+B5 
          MX0    30 
          BX7    -X0*X1      LOC
          BX6    X0*X1
          LX6    30          LOF
          IX7    X7-X6       LOC-LOF
          PL     X7,ER174    *RANDOM ACTION BEYOND EOF* 
  
          SA1    FETSTAT+B5 
          UX1    B6,X1
          SB7    WRITBIN
          EQ     B6,B7,BASWRX      SKIP IF MODE IS ALREADY WRITE BIN
  
  
*                A WRITE AFTER READ SITUATION OBTAINS AND THE FET MUST
*                THEREFORE BE SET ACCORDINGLY.
  
          PX7    X1,B7
          SA7    A1                FORCE WRITE BINARY STATUS
  
          SA1    FETOUT+B5
          BX7    X1 
          SA7    FETIN+B5          ADOPT OUT AS IN (USED BY BASOWRT)
  
          MX0    42 
          SA1    FETROI+B5
          AX1    18 
          BX7    -X0*X1 
          SA7    A7+1              RESET OUT (AS AT LAST BUFFER READ) 
  
          EQ     SETPEN1
  
 SETPEND  BSS    0
  
          SB7    WRITBIN
          SA1    FETSTAT+B5 
          UX1    B6,X1
          PX7    X1,B7
          SA7    A1                FORCE WRITE BINARY STATUS ALWAYS 
  
          SA1    FETOUT+B5
          IX6    X1+X5
          SA6    FETIN+B5          FORCE (IN) TO (OUT)+(OFFSET VALUE) 
 SETPEN1  BSS    0
          MX0    1
          SA1    FETROI+B5
          BX7    X0+X1
          SA7    A1                SET THE WRITE BIT IN THE FET 
  
 BASWRX   BSS    0
          SA5    WRVAL             RESTORE VALUE TO BE WRITTEN
          EQ     BASOWR0
  
 BATOWR0  BSS    0
          TITLE  BASOWRT
*         PROCEDURE WRITE-BINARY
* 
          DATA      10HBASOWRT
 BASOWRT  SPACE  4
*         ENTER  B5=FET ADDRESS 
*                X5=NUMBER TO STORE IN BUFFER 
*                X4 = 0/1 FOR REAL/STRING WRITE RESPECTIVELY
* 
*         EXIT   B6=0 (NO ERROR)
* 
*         CALLS  BASOCHK,BASEGEN
* 
*         USES   A1,X1,B7,B6,A7,X7,A6,A7,A2,X2,X3 
  
 BASOWRT  PS     0
          SA1    B5 
          ZR     X1,ER141    *FILE CLOSED/UNDEFINED*
          SA1    FETSTAT+B5  INTERNAL STATUS
          SB7    WRITBIN     WRITE BINARY COMMAND 
          UX0    X1,B6
          ZR     B6,BBT1A               NEUTRAL 
          LX1    8
          PL     X1,BBT1
          NE     B6,B7,ER130 *ILLEGAL OUTPUT ON FILE* 
          EQ     BBT1B
 BBT1     LX1    1                      I/O BIT 
          NG     X1,BBT1A 
          LX1    1                      BIN/CODED BIT 
          PL     X1,ER130    *ILLEGAL OUTPUT ON FILE* 
 BBT1A    BSS    0
          PX7    X0,B7
          SA7    A1 
 BBT1B    BSS    0
          LX0    59-46       WRITE LOCK OUT BIT 
          PL     X0,BBT1C 
          SB7    B0          TRYING TO WRITE ON READ ONLY FILE
          LX0    47 
          PX7    X0,B7       SET STAT TO NEUTRAL
          SA7    A1 
          EQ     ER130       ILLEGAL OUTPUT ON FILE 
 BBT1C    BSS    0
* 
          NZ     X4,WBINSTR        SKIP IF ITS STR-WRITE-TO-BIN-FILE
          RJ     WRWDOUT           ELSE OUTPUT THE REAL VALUE 
          EQ     BASOWRT           AND EXIT 
* 
* 
 WBINSTR  BSS    0
* 
* 
*                A.R POINTS TO THE STRING TO BE WRITTEN 
*                A FINAL ZERO WORD IS ALWAYS RECORDED ( AS AN -EOS- FLG)
* 
* 
          SB7    A.R               LOAD SOURCE ADDRESS
          ZR     X.R,NXTSTRW JUMP IF NULL STRING
          PL     X.R,WBIN.A        SKIP IF VARIABLE STRING
          SX.R   X.R+B4      ADD CONSTANT OFFSET
 WBIN.A   SB7    X.R         B7 = FWA OF STRING 
 NXTSTRW  BSS    0
          SA5    B7                LOAD NEXT SOURCE WORD
          ZR     X5,WREOS          SKIP IF ZERO (TO WRITE -EOS- FLAG) 
          MX0    48 
         BX3       -X0*X5    MASK R.H. CHARACTER
         ZR        X3,LASTWD BRANCH IF END OF STRING
          SB7    B7+1              UPDATE SOURCE POINTER
          SX7    B7 
          SA7    STRADDR           AND SAVE IT
* 
          RJ     WRWDOUT           GO RECORD THE CURRENT WORD 
* 
          SA1    STRADDR           RECORD SOURCE ADDRESS
          SB7    X1 
          EQ     NXTSTRW           GO LOAD NEXT SOURCE (STRING) WORD
* 
LASTWD   BSS       0
         RJ        WRWDOUT   OUTPUT LAST WORD 
 WREOS    BSS    0
          SX5    B0                FORCE ZERO AS -EOS- FLAG 
          RJ     WRWDOUT           AND RECORD IT
          EQ     BASOWRT           EXIT 
  
* 
 WRWDOUT  BSS    0                 WRITES ONE WORD TO BINARY FILE 
          JP     0
*         WORD ENTRY ASSUMES AT LEAST ONE WORD REMAINS IN BUFFER
  
          SA1    FETIN+B5    GET *IN* 
          SA2    FETLIMT+B5  GET *LIMIT*
          IFNE   R,6,1
          BX6    X.R
          SA6    X1          STORE WORD 
          SA4    FETLOFC+B5 
          SX6    1
          IX6    X6+X4
          SA6    A4                UPDATE LOC (FILE POSITION) 
          SX7    X1+1        ADVANCE *IN* 
          SX2    X2 
          IX3    X2-X7       *LIMIT* - *IN* 
          NZ     X3,BBT2     IF NOT END OF BUFFER 
          SA2    FETFRST+B5 
          SX7    X2 
 BBT2     SA7    A1          RESTORE NEW *IN* 
          RJ     =XBASOCHK
          EQ     WRWDOUT           EXIT 
* 
* 
 STRADDR  BSSZ   1                 CURRENT SOURCE STRING (WORD) ADDRESS 
* 
 WRVAL    BSSZ   1                 TEMP FOR VALUE TO BE WRITTEN 
*         END WRITE-BINARY
          TITLE  BASOCLS
          TITLE  CHARACTER MOVE ROUTINE 
          TITLE  TAB-CONTROL  AND  BASATAB
* 
*         END TAB-CONTROL 
* 
* 
*         TAB (X) 
* 
          DATA      10HBASATAB
BASATAB   DATA      0 
          SX7       1 
          SA7       TABFLG
          JP        BASATAB 
BATATAB   BSS       0 
* 
*         END       TAB(X)
* 
          TITLE  BASOMGN
* 
* 
         DATA      10HBASOMGN 
 BASOMGN  BSS    0
* 
* 
*                ENTRY: B5 POINTS TO THE FET
*                       X5 CONTAINS THE -MARGIN- VALUE
* 
*                CALLED BY : GENERATED CODE FROM -MARGIN- SOURCE STMTS
* 
* 
*                PURPOSE: TO CONVERT THE -MARGIN- VALUE TO THE
*                FORMAT - 30/WDS,30/CHS (WHERE WDS AND CHS REPRESENT
*                WORDS AND CHARACTERS RESPECTIVELY) 
*                        AND TO SAVE THE RESULT IN THE ASSOCIATED FET.
* 
*                EXIT: FET+FETLINL HAS THE REQUIRED FORMAT
* 
          JP     0
          NZ   B5,MGN2             JUMP IF FILE ORD WAS NOT ZERO
          SB5    B4+1              ORD ZERO = KFILE 
 MGN2     BSS    0
          SA1    B5 
          ZR     X1,ER141    *FILE CLOSED/UNDEFINED*
          SA1    B5+FETSTAT 
          UX0    X1,B6
          ZR     B6,MGN1
 MGN1     BSS    0
* 
          RJ     CHKMRGN           CHECK THE SPECIFIED -MARGIN- VALUE 
* 
          NG     X0,ER131    *ILLEGAL MARGIN* 
* 
*                                  X1 HAS A VALID (INTEGER) MARGIN
* 
* 
* 
          RJ     LNLWDCH           CONVERT TO THE PROPER FORMAT 
* 
          SA7    B5+FETLINL        SAVE IN THE FET
          EQ     BASOMGN           EXIT 
* 
* 
* 
* 
* 
 CHKMRGN  BSS    0
* 
* 
*                ENTRY:X5 HAS THE MARGIN VALUE
* 
*                PURPOSE: TO CHECK THAT THE -MARGIN- VALUE IS LEGAL 
* 
*                EXIT: X0 IS .LT. 0 IF THE VALUE IS ILLEGAL 
*                      X1 CONTAINS THE -MARGIN- AS AN INTEGER (TRUNCATED
*                      IF NECESSARY)
* 
*                USES: X0  1       B  6 
* 
          JP     0
          SA1    =XBASANSI
          ZR     X1,CHK2
          SX1    171740B     ADD .5 
          LX1    42 
          FX5    X5+X1
 CHK2     BSS    0
          NG     X5,ILLMARG        ERROR: NEGATIVE MARGIN 
          UX1    B6,X5
          LX1    X1,B6             TRUNCATE 
          NG     X1,ILLMARG  ERROR: NEGATIVE MARGIN 
          SX2    MARGBND           MARGIN BOUND 
          IX0    X1-X2
          PL     X0,ILLMARG        ERROR: MARGIN .GT. LEGAL MAXIMUM 
* 
          SX0    B0                SET MARGIN-VALUE-IS-OK FLAG
          EQ     CHKMRGN           EXIT 
* 
* 
* 
 ILLMARG  BSS    0
          MX0    59                SET MARGIN-VALUE-IS-ILLEGAL FLAG 
          EQ     CHKMRGN           EXIT 
* 
* 
 LNLWDCH  BSS    0
* 
*                ENTRY: X1 CONTAINS A VALID -MARGIN- VALUE
* 
*                PURPOSE: TO CONVERT THE POSITIVE INTEGER IN X1 TO THE
*                FORMAT: 30/WDS,30/CHS WHERE (WDS*10)+CHS= THE VALUE
*                INVOLVED.
* 
*                EXIT: X7 CONTAINS 30/WDS,30/CHS
* 
*                USES: X1  2  7 
* 
          JP     0
          SX2    10 
          SX7    B0 
* 
 INXT     BSS    0
          IX1    X1-X2
          NG   X1,BACKUP1          SKIP IF GONE TOO FAR 
          SX7    X7+1              INCREMENT WORD COUNT 
          EQ     INXT              LOOP 
* 
 BACKUP1  BSS    0
          IX1    X1+X2             RESTORE LAST VALUE TESTED
          LX7    30                MOVE WORD COUNT TO UPPER HALF
          IX7    X7+X1             APPEND CHARACTER COUNT 
          EQ     LNLWDCH           EXIT 
* 
 BATOMGN  BSS    0
* 
* 
          DATA   10HBASCALL 
 BASCALL  DATA   0                 CALL EXTERNAL ROUTINE
* 
*  SAVE B REGS, CALL EXTERNAL ROUTINE, RESTORE B REGS 
*  A5 = EXT RTN ADDR
* 
          SX6    B1                SAVE B1 - B4 
          SX1    B2 
          LX6    18 
          BX6    X6+X1
          SA6    CALLSAV1 
          SX6    B3 
          SX1    B4 
          LX6    18 
          BX6    X6+X1
          SA6    CALLSAV2 
* 
          SA1    BASPARM           POINT A1 TO PARAM ADDR LIST
          SA2    RJINST            PLACE EXT ADDR IN RJ INSTRUCTION 
          MX3    18 
          LX3    48 
          BX6    -X3*X2            DROP ADDR FIELD
          SX2    A5                EXTERNAL ADDR
          LX2    30 
          BX6    X6+X2
          SA6    RJINST            *** MODIFY INSTRUCTION **
          SA2    RJINST            WAIT FOR STORE COMPLETE
*                ADJUST STRING PARAMETERS 
* 
          SA1    BASPARM-1
          MX0    0           (X0)= STR PARAMETER FLAG 
 CALL.A   SA1    A1+1        X1 = PARAMETER LIST WORD 
          ZR     X1,CALL.B   BR, ALL PARAMS PROCESSED 
          PL     X1,CALL.A   NOT A STRING PARAMETER 
          BX1    -X1
          SA2    X1          X2 = STRING POINTER WORD 
          MX0    1           SET STRING PARAM FLAG
          MX4    0                 CLEAR EQU STR PTR WORD 
          ZR     X2,CALL.A   BR, NULL STRING
          SX3    B4+X2       (X3)= FWA OF STRING CONSTANT 
          NG     X2,CALL.A1  BR, STRING CONSTANT
* 
*         CHECK FOR EQUATED STRING VARIABLES
* 
          BX4    X2                (X4) = EQU STR PTR WORD
          AX4    18          POSITION EQU PTR 
          SX4    X4          (X4)= EQU POINTER
          ZR     X4,CALL.A   BR, VALID STRING PARAM 
          SX3    X2          (X3)= FWA OF EQUATED STR VARIABLE
* 
 CALL.A1  SX6    A1          SAVE ADDR OF PARAMETER WORD
          SA6    SAVA1
          LX2    59-53+18 
          SX2    X2          (X2)= CHARACTER LENGTH OF STRING 
          RJ     =XBASGSTR   GET NEW STR SPACE
* 
          SX2    X2+2        ADD ZERO BYTE DELIMITER TO CHARACTER COUNT 
          ZR     X4,MORE           BR, NOT AN EQUATED STRING
          SA4    X4                GET EQUATED STR PTR WORD 
          SX3    X4                (X3) = ADDR OF OLD STRING
 MORE     SA4    X3          (X4)= STRING PARAMETER 
          BX6    X4 
          SA6    X1          (X1)= ADDR OF NEW STR AREA 
* 
          SX1    X1+1        INCR FWA OF NEW STR AREA 
          SX3    X3+1        INCR FWA OF OLD STR AREA 
          SX2    X2-10       DECR CHARACTER COUNT OF STR
          SB6    X2 
          GT     B6,MORE     BR, MORE CHARS TO MOVE 
          SA1    SAVA1       RESTORE BASPARM PTR
          SA1    X1 
          JP     CALL.A      BR, GET NEXT STR PARAM 
* 
*         FORMAT APLIST ENTRIES FOR STRING PARAMETERS 
* 
 CALL.B   BSS    0
          ZR     X0,CALL.C   BR, NO STR PARAMS
          SA1    BASPARM-1
          MX6    2           (X6)= TEMP STR MASK
          SX4    CTYPE       (X4)= CHAR TYPE
          LX4    48 
 CALL.B1  SA1    A1+1 
          ZR     X1,CALL.C   BR, CALL SUBROUTINE
          PL     X1,CALL.B1  BR, NOT STRING PARAM 
          BX1    -X1         (X1)= ADDR OF STR POINTER WORD 
          SA2    X1          (X2)= STR POINTER WORD 
          SX3    X2          (X3)= FWA OF STRING
          BX7    -X6*X2      CLEAR TEMP STR BITS
          SA7    A2          RESTORE STR POINTER WORD 
* 
          LX2    59-53+18 
          SX2    X2          (X2)= CHAR LENGTH OF STRING
          LX2    30 
          BX7    X2+X3
          BX7    X4+X7
          SA7    A1          SAVE APLIST ENTRY
          JP     CALL.B1     BR, CHECK FOR NEXT STR PARAM 
* 
 CTYPE    EQU    5           CODE FOR STRING TYPE 
 BASAV12  BSS 
 CALLSAV1 BSS    1
 BASAV34  BSS 
 CALLSAV2 BSS    1
* 
* 
          DATA   10HBASPARM 
 BASPARM  BSS    CALLMAX+1         BUILD PARAM ADDR LIST HERE 
* 
 CALL.C   SA1    BASPARM     POINT A1 TO PRAM LIST
 RJINST   BSS    0           CALL EXTERNAL ROUTINE
          RJ     0           ***** MODIFIED ***** 
          SA1    CALLSAV1    RESTORE B1-B4
          SB2    X1 
          AX1    18 
          SB1    X1 
          SA1    CALLSAV2 
          SB4    X1 
          AX1    18 
          SB3    X1 
          EQ     BASCALL
* 
          END 
