; 00021
.INCLUDE "LB:[MACROS]MACROS.MAC"
 
MODULE CommonUCS, MNAME=CUCS, VER=03, LIBR=YES, COMM=<Common User Code Set>
 
  .REM %
  ------------------------------------------------------------
  |         Copyrigth (c) 1994 by WAS, Saratov, Russia.      |
  |                  All rights reserved.                    |
  ------------------------------------------------------------
 
    : X.X. Xxxxxxx, . , 9  1994 .
 
    :  ASCII   
               .
 
    :      OPEN, GET, PUT
                CLOSE     
                 "".
                ,     
                    (. ).
 
    :      6  1988 . -            V01.01
                  28  1988 . -            V01.02
                                    multi-buffering FCS-11
               20  1988 . -    VX0103
                                    big-buffering FCS-11
                 9  1994 . - common :           WAS.02
                15  1994 . -      WAS.03
                                       
                                      file1=file2
  %
 
  ; Variants
 
  ;
  ; MBF  = 1  -    
  ; MBF >= 2  - n   
  ;             (  FCS-11   multi-buffering)
  ;
  MBF=2.
 
  ;
  ; OBS  = 1 - 512.-  
  ; OBS >= 2 - n*512.-  
  ;            (  FCS-11   big-buffering)
  ;
  OBS=20.
 
  ;
  ; E$GCML = 0 -   GCML
  ; E$GCML = 1 -   GCML
  ;
  E$GCML=0
 
  ;;;;
 
  .IIF NDF MBF    MBF=1
  .IIF LE  MBF-1  MBF=1
  .IIF NDF OBS    OBS=1
  .IIF LE  OBS-1  OBS=1
  .IIF NDF E$GCML E$GCML=0
 
  ;;;;
 
  FROM SYSMAC IMPORT DIR$,   ALUN$,  QIOW$
  FROM SYSMAC IMPORT GREG$S, EXTK$S, SDRC$S, STSE$S, WSIG$S
  FROM SYSMAC IMPORT FCSMC$, FCSBT$, FDOF$L, FSROF$
  .IIF EQ E$GCML FROM SYSMAC IMPORT  GCMLD$, GCMLB$, GCML$
  .IIF NE E$GCML FROM SYSMAC IMPORT  EGCMI$
  FROM SYSMAC IMPORT CSI$,   CSI$1,  CSI$2
 
  FROM SYSLIB.QIOSYM IMPORT IE.UPN, IE.EOF, TF.CCO
  FROM SYSLIB.VCTDF  IMPORT $DSW,   .FSRPT
 
  FROM SYSLIB.FCSTYP IMPORT .FCTYP
  FROM SYSLIB.RQLCB  IMPORT $RLCB
 
  FROM MAIN          IMPORT $CTAB
 
  ;;;;
 
  EXPORT QUALIFIED CUCS
 
  ;;;;
 
  MAXD   = 1    ; .  
  CLUN   = 1    ; lun  
  ILUN   = 2    ; lun  
  OLUN   = 3    ; lun  
  MXRLEN = 256. ; .    
 
  FCSMC$
  FCSBT$
  FDOF$L
  FSROF$ DEF$L
 
  .IIF NE E$GCML EGCMI$
  GCMLD$
 
  CSI$
 
  ;
  ; Constants
  ;
  NBF1=3                   ; simple version
  NBF2=<OBS>*2+1           ; big only
  NBF3=<MBF>*2+1           ; multi only
  NBF4=<MBF*OBS>*2+1       ; big & multi-buffering FCS-11
  SPSZ1=NBF1*<512.+S.BFHD>
  SPSZ2=NBF2*<512.+S.BFHD>
  SPSZ3=NBF3*<512.+S.BFHD>
  SPSZ4=NBF4*<512.+S.BFHD>
 
  FSRSZ$ 0
 
  $PRINT
 
  $IDATA
    GREG:
    INP:
    BUF:  .LIMIT
          .=INP
          .BLKB   MXRLEN
          .EVEN
 
  PROCEDURE INIT
    $PDATA
      CALUN: ALUN$ CLUN, TI, 0
      IALUN: ALUN$ ILUN, SY, 0
      OALUN: ALUN$ OLUN, SY, 0
 
      .IIF NE FT.BBF-2 .ERROR
      .IIF NE FT.MBF-4 .ERROR
 
      FCSTYP: .WORD SPSZ1 ; simple
              .WORD SPSZ2 ; FT.BBF
              .WORD SPSZ3 ; FT.MBF
              .WORD SPSZ4 ; FT.BBF & FT.MBF
    $IDATA
      QINIT: .WORD 0
  BEGIN
    IF QINIT EQ #0 THEN
      DIR$ #CALUN
      DIR$ #IALUN
      DIR$ #OALUN
      MOV @#.FSRPT, R1
      IF RESULT IS EQ THEN
        BPT
      END
      IF A.DFUI(R1) EQ #0 THEN
        FINIT$                  ;  FCS-11
      END
      CALL .FCTYP               ;   FCS-11
      BIC  #^C<FT.BBF!FT.MBF>, R1
        .IIF NE FT.BBF-2 .ERROR
        .IIF NE FT.MBF-4 .ERROR
      MOV  FCSTYP(R1), R1       ;   
      MOV  INP+2, R2            ;    
      MOV  #GREG, R3            ;     
      GREG$S , R3               ;  Executive'
      MOV  G.RGRS(R3), R3
      ASH  #6, R3               ;  
      SUB  R2, R3               ;  
      SUB  R3, R1               ; -
      ADD  #77, R1              ; 
      ASH  #-6, R1              ;  - 100(8)  
      EXTK$S R1                 ; 
      MOV  #GREG, R1            ;    
      GREG$S , R1               ;  Executive'
      MOV  G.RGRS(R1), R1       ;  R1
      ASH  #6, R1               ;  
      SUB  R2, R1               ;   
      MOV  @#.FSRPT, R0         ; free memory listhead
      CALL $RLCB                ; 
      INC QINIT                 ;  
    END
    RETURN
  END INIT
 
  PROCEDURE CALLMO
    $PDATA
      MO: .RAD50  /MO..../
  BEGIN
    SUB  #11.*2, SP     ; 11  
    MOV  #3*400+1, R1   ; 3 -  , 1 -  
    IF R0 PL #0 THEN    ;  R0 , 
      NEGB R0           ;     
      INC  R1           ;     -  /
    ELSE                ; 
      NEG  R0           ;     
    END                 ; 
    PUSH R0             ;   -  
    PUSH R1             ;   -  
    MOV  SP, R1         ;    
    LOOP                ; 
      SDRC$S  #MO, R1, #1       ;   MO....
      IF RESULT IS CC LEAVE LOOP ;     -  
      MOV  @#$DSW, R0           ;   -  R0
      IF R0 NE #IE.UPN THEN     ;    "  ", 
        BPT                     ;     (  )
      END                       ; 
      WSIG$S                    ;   
    END                 ;  
    STSE$S #1           ;   
    ADD  #13.*2, SP     ;  
    SEC                 ;     CALLMO
    RETURN              ; 
  END CALLMO
 
  PROCEDURE FIERR
  BEGIN
    MOV  IFDB+F.ERR, R0
    BR   CALLMO
  END FIERR
 
  PROCEDURE OIERR
  BEGIN
    PRINT <CommonUCS --   :>
    BR   FIERR
  END OIERR
 
  PROCEDURE GIERR
  BEGIN
    PRINT <CommonUCS --    :>
    BR   FIERR
  END GIERR
 
  PROCEDURE FOERR
  BEGIN
    MOV  OFDB+F.ERR, R0
    BR   CALLMO
  END FOERR
 
  PROCEDURE OOERR
  BEGIN
    PRINT <CommonUCS --   :>
    BR   FOERR
  END OOERR
 
  PROCEDURE POERR
  BEGIN
    PRINT <CommonUCS --    :>
    BR   FOERR
  END POERR
 
  $IDATA
    CSIBLK: .BLKB   C.SIZE
            .EVEN
 
    IFDB: FDBDF$
          FDRC$A FD.PLC!FD.INS, BUF, MXRLEN
          FDOP$A ILUN, CSIBLK+C.DSDS, DFNB
          FDBF$A , OBS*512., MBF
    DFNB: NMBLK$ TXT, TXT, 0, SY, 0
 
    OFDB: FDBDF$
          FDRC$A FD.INS
          FDOP$A OLUN, CSIBLK+C.DSDS, DFNB
          FDBF$A , OBS*512., MBF
 
  PROCEDURE CSI1
  BEGIN
    CSI$2 #CSIBLK, OUTPUT           ;  
    IF RESULT IS CC THEN
      FDBF$R #IFDB, , , ,#FD.RAH    ; Multi-buffering  
      OPNS$R                        ;   
      IF RESULT IS CC THEN          ;   , 
        MOV  #IFDB+F.FNB, R0        ;  FDB FNB  
        MOV  #OFDB+F.FNB, R1        ;  FDB FNB  
        THRU R2 := #S.FNBW          ;  FNB  
          MOV  (R0)+, (R1)+         ; 
        END
        FDBF$R #OFDB, , , ,#FD.WBH  ; Multi-buffering  
        OPNS$M                      ;   FID'
        IF RESULT IS CS THEN        ;   , 
          CLOSE$ #IFDB              ;   FDB
          CALLR  OOERR              ;  MO....
        END                         ;       
      ELSE
        CALLR OIERR                 ;  MO....
      END                           ;       
    ELSE
      PRINT <CommonUCS --  CSI-2   >
      SEC
    END
    RETURN
  END CSI1
 
  PROCEDURE CSI2
  BEGIN
    CSI$2 #CSIBLK, INPUT                ;  
    IF RESULT IS CC THEN
      FDBF$R #IFDB, , , ,#FD.RAH        ; Multi-buffering  
      OPNS$R                            ;   
      IF RESULT IS CC THEN              ;   , 
        CSI$2 #CSIBLK, OUTPUT           ;  
        IF RESULT IS CC THEN
          FDBF$R #OFDB, , , ,#FD.WBH    ; Multi-buffering  
          FDAT$R , IFDB+F.RTYP, IFDB+F.RATT, IFDB+F.RSIZ
          OPNS$W                        ;   
          IF RESULT IS CS THEN          ;   , 
            CLOSE$ #IFDB                ;   FDB
            CALLR  OOERR                ;  MO....
          END                           ;       
        ELSE
          PRINT <CommonUCS --  CSI-2   >
          SEC
        END
      ELSE
        CALLR OIERR                     ;  MO....
      END                               ;       
    ELSE
      PRINT <CommonUCS --  CSI-2   >
      SEC
    END
    RETURN
  END CSI2
 
  PROCEDURE CSI
    $ASCII
      PRMPT: .ASCII <15><12>/CommonUCS>/
      PRMP.L=.-PRMPT
    $IDATA
      GCML:
        .IIF EQ E$GCML GCMLB$ MAXD, UCS, INP, CLUN, , MXRLEN
        .IIF NE E$GCML GCML: ECMLB$ , CLUN, MAXD, UCS, INP, MXRLEN
  BEGIN
    CSI$1 #CSIBLK, GCML+G.CMLD+2, GCML+G.CMLD   ;  
    IF RESULT IS CC THEN
      IFB #CS.EQU OFF.IN CSIBLK+C.STAT THEN
        CALL CSI1
      ELSE
        CALL CSI2
      END
    ELSE
      PRINT <CommonUCS --    >
      SEC
    END
    RETURN
  END CSI
 
  PROCEDURE CUCS
  BEGIN
    CALL INIT
 
;   MOVB #GE.COM!GE.IND!GE.SIZ, GCML+G.MODE ; 
 
    LOOP
      GCML$ #GCML, #PRMPT, #PRMP.L     ;   
      IF RESULT IS CS THEN             ;  
        IFB GCML+G.ERR NE #IE.EOF THEN ;   -  ^Z
          PRINT <CommonUCS --    >
        END
        RETURN
      END
 
      IF GCML+G.CMLD NE #0 THEN ;   
        CALL CSI
        IF RESULT IS CC THEN
          REPEAT
            GET$ #IFDB                       ;  
            IF RESULT IS CS THEN             ;  
              IFB IFDB+F.ERR NE #IE.EOF THEN ;   eof
                CALL GIERR                   ;  MO....
              END
              SEC
            ELSE
              MOV  IFDB+F.NRBD+2, R0         ;  
              MOV  IFDB+F.NRBD, R1           ;  
              MOV  R0, R2                    ; 
              MOV  R1, R3                    ;  R2  R3
              IF RESULT IS NE THEN           ;   -   
                THRU R1                      ; 
                  CLR  R5
                  BISB (R0), R5
                  MOVB $CTAB(R5), (R0)+
                END
              END
              PUT$ #OFDB, R2, R3             ;   
              IF RESULT IS CS THEN           ;  
                CALL POERR
              END
            END
          UNTIL RESULT IS CS
          CLOSE$ #IFDB
          CLOSE$ #OFDB
        END
      END
    END
  END CUCS
 
END CommonUCS
 
.END
