* 4/22/72 -- 14:00 (7F)
* MODULE NAME: TEXTDEF
* NUMBER: 91
* PURPOSE: (1) CONTAINS ALL STANDARD REGISTER DEFINITIONS
*          (2) CALLS IN SYSTEM SIG7
*          (3) REFERENCES THE RETURN ADDRESS STACK (RTNSTACK)
*          (4) PROVIDES CHARACTER VALUES
*          (5) DEFINES SAVRTN,RETURN PROCS
*          (6) DEFINES MESSAGE,DBMSG PROCS
*          (7) DEFINES MOVE,COMP,INSCHAR PROCS
*          (8) DEFINES LC (LOWER-CASE) PROC
*          (9) DEFINES BREAK CONTROL PROC (BRKCTRL)
*
* CALLED BY ALL UTS/TEXT ROUTINES
*
*
* CALLED BY 'SYSTEM TEXTDEF'
*
*
         DISP     X'042272'
*
*
         SYSTEM   SIG7
*
TEXT     EQU      1                 TEXT VALUE FOR #SYS
TEXTR    EQU      2                 TEXTR VALUE FOR #SYS
#SYS     EQU      TEXT              SYSTEM = TEXT
*
#ULOC    CSECT    1                 NORMAL PROCEDURE CONTROL SECTION
#PLOC    CSECT    1                 CONTROL SECTION FOR LITERALS
         USECT    #ULOC
*
#KDBMSG  SET      0                 DEBUG REFERENCE FLAG
#KSAVRTN SET      0                 RETURN STACK REF FLAG
*
*
*
* STANDARD REGISTER DEFINITIONS
*
BUF1     EQU      1                 I/O BUFFER ADDR REGISTERS
BUF2     EQU      2
BUF3     EQU      3
*
X1       EQU      4                 INDEX REGISTERS
X2       EQU      5
X3       EQU      6
X4       EQU      7
*
D1,SR1   EQU      8                 STANDARD DATADEF,MONITOR REGISTERS
DX1,SR2  EQU      9
D2,SR3   EQU      10
DX2,SR4  EQU      11
*
AC1      EQU      12                ACCUMULATORS,ARGUMENT REGISTERS
AC2      EQU      13
AC3      EQU      14
*
SRTN     EQU      15                SUBROUTINE CALL/RETURN REGISTER
*
*
* SPECIAL CHARACTER VALUES
*
#ATTN    EQU      X'04'
#TAB     EQU      X'05'
#BKSP    EQU      X'08'
#CR      EQU      X'0D'
#LF      EQU      X'15'
#STOP    EQU      X'2D'
#BLANK   EQU      X'40'
#BLANKS  EQU      X'40404040'
#UL      EQU      X'6D'
#QM      EQU      X'6F'
#BSUL    EQU      X'086D'           BACKSPACE-UNDERLINE
#ULBS    EQU      X'6D08'           UNDERLINE-BACKSPACE
#SHFTMASK EQU     X'000FFFFF'       MASK TO STORE SHIFT SIZE
*
* FILE OPEN/CLOSE PARAMETERS
*
#REL     EQU      1                 CLOSE WITH RELEASE
#SAVE    EQU      2                 CLOSE WITH SAVE
*
*                                   OPEN PARAMETERS:
#IN      EQU      1                    IN
#OUT     EQU      2                    OUT
#INOUT   EQU      4                    INOUT (UPDATE)
#OUTIN   EQU      8                    OUTIN (SCRATCH)
*
*
*
* TERMINAL AND BUFFER PARAMETERS
*
#LSTCOL  EQU      140               MAX COLUMN NUMBER
#STDBUFSZ EQU     256               STANDARD READ/WRITE SIZE
#MSGBUFSZ EQU     20                MESSAGE BUFFER
#RDLNSZ  EQU      140               MAX READ SIZE
#MXLNSZ  EQU      254               MAXIMUM LINE SIZE
*
*
* REF FLAG FOR TEXTSTA
*
TXT:REFS SET      1                 INITIALIZE TO DO REF'S
RESREFLG CNAME
         PROC
TXT:REFS SET      0                 RESET REF FLAG
         PEND
*
*
*
* PROCS FOR RETURN ADDRESS STACK
*
STACKSZ  EQU      20                SET STACK AT 20 FOR NOW
SAVRTN   CNAME                      PUSH RETURN ADDR ON STACK
         PROC
         DO       #KSAVRTN=0
#KSAVRTN SET      1
         REF      RTNSTACK
         FIN
LF(1)    PSW,SRTN RTNSTACK
         PEND
*
RETURN   CNAME                      PULL RETURN ADDR AND BRANCH
         PROC
LF(1)    PLW,SRTN RTNSTACK
         B        *SRTN
         PEND
*
*
* LOWER CASE FUNCTION (LC)
*
LC       FNAME                      CONVERT CHAR TO LOWER-CASE
         PROC
         PEND     AF(1)&X'BF'
*
*
*
*
* MESSAGE GENERATION PROCS
*
MESSAGE  CNAME                      GENERATE MESSAGE
         PROC
         LOCAL    J,CS,CBASE,M,BYTES,OUT,K,CHARS,NOW
*
#MSGBA   SET      BA(%)+1
#NMSG    SET      0
LF(1)    RES,1    1
*
J        DO       NUM(AF)
         DO       NUM(AF(J))>1
AF(J,1)  EQU      BA(%)
#NMSG    SET      #NMSG+AF(J,2)
         RES,1    AF(J,2)
*
         ELSE
CS       SET      S:UT(AF(J))
CBASE    SET      0
M        SET      NUM(CS)
BYTES    SET      16
*
         WHILE    M>0
         DO1      M<16
BYTES    SET      M
M        SET      M-16
OUT      SET
*
K        DO       BYTES
OUT(K)   SET      CS(CBASE+K)
         FIN
CBASE    SET      CBASE+16
*
CHARS    SET      S:PT(OUT)
         GEN,BYTES*8  CHARS
#NMSG    SET      #NMSG+BYTES
         FIN
*
         FIN
         FIN
*
NOW      SET      BA(%)
         ORG      #MSGBA-1
         DO       SCOR(CF(2),NOCR)=0
         GEN,8    #NMSG+1
         ELSE
         GEN,8    #NMSG
         FIN
         ORG      NOW
         DO       SCOR(CF(2),NOCR)=0
         GEN,8    X'0D'
#NMSG    SET      #NMSG+1
         FIN
         BOUND    4
*
         PEND
*
*
*
DBMSG    CNAME                      GENERATE AND PRINT MESSAGE
         PROC
         DO       #KDBMSG=0
#KDBMSG  SET      1
         REF      S27PRINT
         FIN
         USECT    #PLOC
         MESSAGE  AF
         USECT    #ULOC
         LI,BUF1  #MSGBA
         LI,AC1   #NMSG
         BAL,SRTN S27PRINT
         PEND
*
*
* MOVE, INSERT, COMPARE PROCS FOR CHARACTER STRING MANIPULATION
*
MOVE     CNAME    0,X'61'           MOVE CHARACTER STRING
COMP     CNAME    0,X'60'           COMPARE CHARACTER STRING
INSCHAR  CNAME    1                 INSERT CHAR IN BUFFER
         PROC
         LOCAL    LLAB,LWAF1,LWAF2,LWAF3,GETAF3
         LOCAL    STCNT,INSTZRO,CLAB
*
         DO1      NAME(1)=1
CF(2)    SET      0
*
         DO       AFA(2)=0&AFA(3)=0
         USECT    #PLOC
LLAB     SET      %
         GEN,8,24 AF(3),AF(2)
         USECT    #ULOC
         LW,CF(2)+1  LLAB
*
         ELSE
         GOTO,AFA(2)  LWAF2
         LI,CF(2)+1  AF(2)
         GOTO     GETAF3
LWAF2    GEN,8,4,3,17  X'32',CF(2)+1,0,AF(2)
GETAF3   GOTO,AFA(3)  LWAF3
         LI,CF(2) AF(3)
         GOTO     STCNT
LWAF3    GEN,8,4,3,17  X'32',CF(2),0,AF(3)
STCNT    STB,CF(2)  CF(2)+1
         FIN
*
         DO       NAME(1)=0
         GOTO,AFA(1)  LWAF1
         LI,CF(2) AF(1)
         GOTO     INSTZRO
LWAF1    GEN,8,4,3,17  X'32',CF(2),0,AF(1)
INSTZRO  GEN,8,4,20  NAME(2),CF(2),0
*
         ELSE
         USECT    #PLOC
CLAB     SET      %
         GEN,8,24 AF(1),0
         USECT    #ULOC
         MBS,CF(2)  BA(CLAB)
         FIN
*
         PEND
*
*
* BRKCTRL -- BREAK CONTROL PROC
*
#BRKFLAG SET      0                 INITIALIZE FIRST-TIME FLAG
BRKCTRL  CNAME
         PROC
*
         DO       #BRKFLAG=0        DO REF'S FIRST TIME ONLY
#BRKFLAG SET      1                 SET FIRST-TIME FLAG
         REF      BRKADDR,BRKFLAG,BRKSAVE
         FIN
*
         LI,SRTN  WA(AF(1))         GET ADDR FOR BREAK RETURN
         STW,SRTN BRKADDR           SET BREAK RETURN ADDR
         LI,SRTN  0                 INITIALIZE  BREAK FLAG
         STW,SRTN BRKFLAG
*
         PEND
*
*
         END
