*DECK BASCASE 
          IDENT  BASCASE
          ENTRY  BASTUPR,BASXUPR
          ENTRY  BASTLWR,BASXLWR
          EXT    REG= 
          TITLE  BASCASE - BASIC 3 UPRC$/LWRC$ PROCESSORS.
          COMMENT BASIC 3 - UPRC$/LWRC$ PROCESSORS. 
 MAIN     SPACE  4,4
          CON    10HBASTLWR 
 BASTLWR  PS
          SB7    B1          SET LWRC$ CALL TO PRS
          RJ     PRS
          SA1    =XASCII
          ZR     X1,LWR9     IF NOT IN ASCII MODE 
          SA0    B0          OUTPUT STRING LENGTH 
          SX3    5           74/76 MASK (101) 
          MX7    0
          SB4    10 
          MX0    6
          ZR     B7,LWR7     IF NULL INPUT STRING 
 LWR2     SA1    B2          LOAD INPUT WORD
          SB5    10 
          SB2    B2+B1
 LWR3     ZR     B7,LWR5     IF END OF INPUT STRING 
          ZR     B5,LWR2     IF END OF INPUT WORD 
          BX6    X0*X1
          SB7    B7-B1       CHARACTERS/INPUT STRING
          LX6    6
          SB5    B5-B1       CHARACTERS/INPUT WORD
          SB6    X6-3        BIAS FOR MASK TEST 
          LX1    6
          NZ     X6,LWR3A 
*         COLON FOUND - CONVERT IT TO ASCII DISPLAY CODE
* 
          SX6    04B         74/04 FOR COLON
          SA6    LWRA        SAVE 
          SX6    74B         SET PREFIX FOR COLON 
          RJ     ADC         ADD THE CHARACTER TO OUTPUT STRING 
          SA4    LWRA 
          SX6    X4+
          RJ     ADC
*         CHECK IF THIS IS A TRAILING COLON 
* 
          MX4    77B
          BX4    X4*X1       CHARACTER NEXT TO COLON
          LX4    6
          SX5    X4-1R       CHECK IF IT IS AN APPENDED BLANK 
          NZ     X5,LWR3B    BR, IF NOT A TRAILING COLON
          SB5    B5-B1       SKIP THE APPENDED BLANK
          SB7    B7-B1
          LX1    6
LWR3B     EQ     LWR3        BACK TO THE LOOP 
* 
LWR3A     LX4    X3,B6       TEST FOR ASCII PREFIX
          SX5    X6-1R0 
          NG     X4,LWR6     IF 74XX OR 76XX
          PL     X5,LWR4     IF NOT A LETTER
  
*         DO LOWER CASE CONVERSION. 
  
          SA6    LWRA        SAVE X6
          SX6    76B         PREFIX 
          RJ     ADC         ADD CHARACTER
          SA4    LWRA 
          SX6    X4+         RESET X6 CHARACTER 
 LWR4     RJ     ADC         ADD CHARACTER
          EQ     LWR3        CONTINUE 
  
*         HANDLE 12-BIT CHARACTERS. 
  
 LWR6     RJ     ADC         ADD PREFIX CHARACTER 
          NZ     B5,LWR8     IF INPUT AVAILABLE 
          ZR     B7,LWR5     IF END OF INPUT STRING 
          SA1    B2 
          SB5    10 
          SB2    B2+B1
 LWR8     BX6    X0*X1
          SB7    B7-B1       CHARACTERS/INPUT STRING
          LX6    6
          SB5    B5-1        CHARACTERS/INPUT WORD
          LX1    6
          EQ     LWR4        ADD TO OUTPUT STRING 
  
 LWR5     SB5    B4 
          RJ     RET         FINAL PROCESSING 
          JP     BASTLWR     RETURN 
  
 LWR7     SA0    B0          NULL LENGTH
          BX7    X7-X7
          SB5    10 
          SA7    B3 
          EQ     LWR5        COMPLETE 
  
 LWR9     SA1    B3-B1
          BX7    X1 
          SA7    A1          PRESET A7
 LWR10    SA1    B2          COPY OLD TO NEW
          BX7    X1 
          SB2    B2+B1
          SA7    A7+B1
          LE     B2,B4,LWR10
          SA0    B7+         SET LENGTH 
          SB4    10 
          EQ     LWR5        COMPLETE 
  
 LWRA     BSS    1           TEMPORARY HOLDING WORD FOR X6
          SPACE  4,4
**        ADC - ADD CHARACTER TO OUTPUT STRING. 
* 
*         ENTRY  (X6) = CHARACTER TO ADD. 
*                (X7) = ASSEMBLY WORD.
*                (A0) = CURRENT CHARACTER COUNT.
*                (B4) = SPACE AVAILABLE IN X7.
*                (B3) = FWA TO WRITE NEW STRING.
* 
*         EXIT   INPUT REGISTERS UPDATED. 
*                IF OUTPUT STRING OVERFLOW, EXIT TO =XER168.
  
  
 ADC      PS                 ENTRY/EXIT 
          LX7    6
          SB4    B4-B1       CHARACTERS/OUTPUT WORD 
          BX7    X7+X6       ADD CHARACTER
          SA0    A0+B1       OUTPUT STRING LENGTH 
          GT     B4,B0,ADC   IF X7 NOT YET FULL 
          SA7    B3          STASH AWAY WORD
          SB3    B3+B1
          SA2    PRSE 
          SB6    X2 
          BX7    X7-X7       CLEAR ASSEMBLY 
          SB4    10 
          LE     B3,B6,ADC   STILL ROOM AVAILABLE 
          RJ     =XBASRBR=   RESTORE REGISTERS
          JP     =XER168     * STRING OVERFLOW *
          SPACE  4
          CON    10HBASTUPR 
 BASTUPR  PS                 UPRC$ ENTRY/EXIT 
          EQ     UPR         JUMP TO ACTUAL ROUTINE 
 PRS      SPACE  4,4
**        PRS - PRESET ROUTINE. 
* 
*         EXIT   (X6) = STRING LENGTH DIV 10. 
*                (X7) = STRING LENGTH MOD 10. 
*                (B1) = 1.
*                (B2) = FWA READ (INPUT STRING).
*                (B3) = FWA WRITE (NEW STRING). 
*                (B4) = LWA READ (INPUT STRING).
*                (B7) = STRING LENGTH (INPUT STRING). 
* 
*         CALLS  BASSBR=, BASSMGS, BAS.MOD. 
  
  
 PRS      PS                 ENTRY/EXIT 
          RJ     =XBASSBR=   SAVE REGISTERS 
          SX6    A5 
          SA6    PRSA        SAVE INPUT STRING POINTER
          AX5    18+18
          SA1    A6+B1       FTN/SYMPL CALL BLOCK 
          SX7    PRSC 
          SX6    X5 
          ZR     B7,PRS2     IF UPRC$ CALL
          LX6    1           LENGTH*2 
 PRS2     SA6    PRSD        SET LENGTH 
          SA7    PRSF 
          RJ     =XBASSMGS   GET NEW STRING SPACE 
          SA2    PRSD 
          RJ     =XBAS.MOD
          SA1    PRSF 
          NO
          IX6    X1+X6       LWA+1
          SA2    PRSA 
          SA2    X2 
          SA6    PRSE        SET LWA+1
          SB4    B0 
          SA3    REG=+4      OLD B4 
          SB3    X1          NEW FWA
          PL     X2,PRS1     FWA IS ABSOLUTE
          SB4    X3+         FWA IS RELATIVE TO B4
 PRS1     SB2    X2+B4       OLD FWA
          AX2    18+18
          SB4    X2 
          SX2    X2          LENGTH 
          SB1    1
          RJ     =XBAS.MOD   LENGTH QUOTIENTS 
          SB7    B4          SAVE LENGTH
          SB4    X6+B2       FIND LWA 
          NZ     X7,PRS      IF LWA SET 
          SB4    B4-B1       OVERRAN LWA
          EQ     PRS         RETURN 
          SPACE  4
 PRSA     BSS    1           INPUT STRING POINTER 
 PRSB     CON    PRSF        ADDRESS OF ADDRESS OF STRING POINTER 
          CON    PRSD        ADDRESS OF LENGTH
 PRSC     BSS    1           OUTPUT STRING POINTER
 PRSD     BSS    1           OUTPUT STRING LENGTH 
 PRSE     BSS    1           LWA+1 OF STRING
 PRSF     CON    PRSC        ADDRESS OF STRING POINTER
          SPACE  4
**        RET - RETURN FROM CASE PROCESSOR. 
* 
*         ENTRY  (B5) = X7 CHARACTER COUNT. 
*                (X7) = LAST CHARACTERS.
*                (B3) = FWA TO WRITE. 
*                (A0) = LENGTH OF OUTPUT STRING.
* 
*         EXIT   END OF LINE AND TRUNCATION OF STRING AREA COMPLETE.
* 
*         CALLS  BASRBR=, BASSMTS.
  
  
 RET      PS                 ENTRY/EXIT 
          SB4    B5-10       FINAL PROCESSING 
          ZR     B4,RET1     IF X7 IS EMPTY 
          SX1    B5+B5
          LX2    X1,B1
          IX1    X1+X2       B5*6 
          SB4    X1 
          LX7    X7,B4       LEFT JUSTIFY 
          SA7    B3+         STASH LAST WORD
 RET1     MX0    -12
          SA1    A7          LAST WORD STORED 
          BX1    -X0*X1 
          MX6    0
          ZR     X1,RET2     IF PROPER EOL
          SA6    A7+1        66-BIT EOL 
 RET2     SX7    A0          NEW LENGTH 
          SA1    PRSB        FTN/SYMPL CALL BLOCK 
          SA7    PRSD        SET NEW LENGTH 
          MX6    1
          LX7    18+18
          SA2    X1          FWA
          LX6    -1 
          IX7    X7+X2       LENGTH+FWA 
          BX6    X6+X7       TYPETEMP+LENGTH+FWA=STRING POINTER 
          SX7    PRSC 
          SA6    A2 
          SA7    X1 
          RJ     =XBASSMTS   TRUNCATE TO PROPER LENGTH
          RJ     =XBASRBR=   RESTORE REGISTERS
          SB7    PRSC 
          SX7    B7-B2
          SB7    PRSD 
          SA7    B7          POINTER TO POINTER 
          EQ     RET         RETURN 
          SPACE  4
 BASXLWR  BSS    0           LWA+1 OF LWRC$ PROCESSOR.
          SPACE  4,4
 UPR      BSS    0           UPRC$ PROCESSOR
          SB7    B0          SET UPRC$ CALL TO PRS
          RJ     PRS         PRESET ROUTINE 
          SA1    =XASCII
          ZR     X1,UPR10    IF NOT IN ASCII MODE 
          MX0    6           CHARACTER MASK 
          SB5    10          CHARACTERS/WORD
          BX7    X7-X7
          SA0    B0          OUTPUT STRING CHARACTER COUNT
          SA7    B3          ZERO FIRST WORD OF NEW STRING
          ZR     B7,UPR12    IF NULL INPUT
 UPR2     GT     B2,B4,UPR7  IF END OF INPUT STRING 
          SA1    B2          GET STRING WORD
          SB2    B2+B1
          SB6    10          CHARACTERS/WORD
          SX3    76B         LOWER CASE PREFIX
 UPR3     ZR     B6,UPR2     IF END OF INPUT WORD 
          ZR     B7,UPR7     END OF INPUT STRING
          BX6    X0*X1
          SB6    B6-B1       CHARACTERS/WORD
          LX6    6
          SB7    B7-B1       CHARACTERS/STRING
          IX4    X6-X3       TEST CHARACTER 
          LX1    6
          ZR     X4,UPR5     IF POSSIBLE LOWER CASE CHARACTER 
 UPR4     LX7    6           ADD ROOM 
          SB5    B5-B1       CHARACTERS/OUTPUT WORD 
          BX7    X7+X6       ADD IN NEW CHARACTER 
          SA0    A0+B1       INCREMENT LENGTH 
          GT     B5,B0,UPR3  IF ROOM AVAILABLE
          SA7    B3          SOCK IT AWAY 
          SB3    B3+B1
          SB5    10          RESET COUNTERS 
          SX7    0
          EQ     UPR3        NEXT CHARACTER 
  
 UPR5     ZR     B6,UPR6     IF INPUT EMPTY 
          BX2    X0*X1       CHECK XX OF 76XXB
          LX2    6
          SX4    X2-1R0 
          ZR     X2,UPR4     IF NOT A LETTER
          PL     X4,UPR4     IF NOT A LETTER
          SB7    B7-B1       CHARACTERS/STRING
          SB6    B6-B1       CHARACTERS/INPUT WORD
          LX1    6           SKIP NEXT CHARACTER
          SX6    X2 
          EQ     UPR4        ADD CHARACTER TO OUTPUT STRING 
  
 UPR6     GT     B2,B4,UPR4  IF 76B IS THE LAST CHARACTER 
          SA1    B2          GET NEXT WORD
          SB2    B2+B1
          SB6    10 
          EQ     UPR5        CHECK XX OF 76XXB
  
 UPR7     RJ     RET         FINAL PROCESSING 
          JP     BASTUPR     RETURN 
  
 UPR10    SA1    B3-B1
          BX7    X1 
          SA7    A1          PRESET A7
 UPR11    SA1    B2          COPY OLD TO NEW
          BX7    X1 
          SB2    B2+B1
          SA7    A7+B1
          LE     B2,B4,UPR11
          SA0    B7+         SET LENGTH 
          SB5    10 
          EQ     UPR7        COMPLETE 
  
 UPR12    SA0    B0          NULL INPUT 
          BX7    X7-X7
          SB5    10 
          SA7    B3 
          EQ     UPR7        COMPLETE 
  
 BASXUPR  BSS    0           LWA+1 OF PROCESSOR 
          SPACE  4
          END 
