Retro1.org codex

PRGM SCREX;
# TITLE SCREX - SCREEN/LINE EXECUTIVE PROGRAM. #
 
BEGIN  # SCREX #
 
#
***  SCREX - SCREEN/LINE EXECUTIVE PROGRAM.
*
*    *SCREX* MANAGES THE SCREEN AND LINE COMMANDS
*    AND ALLOWS THE USER TO SPECIFY THE MODE OF
*    OPERATION, AND OPTIONALLY THE TERMINAL MODEL
*    BEING USED.  *SCREX* INVOKES A CALL TO THE
*    LOADER TO LOCATE A TERMINAL-DEFINITION CAPSULE,
*    WHICH IT COPIES ONTO THE FILE *ZZZZTRM*.  IT
*    THEN WRITES OUT THE TERMINAL INITIALIZATION
*    SEQUENCE FOUND IN THE LOADED CAPSULE.
*
*    PRGM SCREX
*
*    ENTRY     *SCREX* HAS TWO ENTRY POINTS, *SCREEN* AND *LINE*.
*
*    EXIT      OBJECT ROUTINE EXECUTED.
*
*    NOTES     *SCREX* USES BOTH *SYMPL* AND *COMPASS* ROUTINES.
*
*    COPYRIGHT CONTROL DATA SYSTEMS INC.  1992.
#
 
  XREF
    BEGIN
    PROC PF;                         # GET *TERMLIB* FILE #
    PROC SCRCCK;                     # CHECK CAPSULE, GET LENGTH #
    PROC SCRCIS;                     # CHECK INTERACTIVE STATUS #
    PROC SCRCZF;                     # CREATE *ZZZZTRM* FILE #
    PROC SCRFST;                     # FILE STATUS CHECK #
    PROC SCRGIS;                     # GET INIT. SEQUENCE #
    PROC SCRISR;                     # ISSUE SYSTEM REQUEST #
    PROC SCRLCP;                     # LOAD TERMINAL CAPSULE #
    PROC SCRPKP;                     # PROCESS PARAMETERS #
    PROC SCRRET;                     # RETURN *TERMLIB* FILE #
    PROC SCRRTA;                     # RESIDENT TERMCAP ADDRESS #
    PROC SCRRZF;                     # READ *ZZZZTRM* FILE #
    PROC SCRUGD;                     # UNLOAD GROUP DIRECTORY #
    PROC VDTABT$;                    # TERMINATE ABNORMALLY #
    PROC VDTCLO;                     # CLOSE THE OUTPUT FET #
    PROC VDTGSL;                     # GET SCREEN/LINE MODE #
    PROC VDTGTA;                     # GET TERMCAP ADDRESS #
    PROC VDTGTN;                     # GET TERMINAL MNEMONIC #
    PROC VDTGTO;                     # GET TERMINAL ORDINAL #
    PROC VDTMSG$;                    # ISSUE ERROR MESSAGE #
    PROC VDTOPN;                     # OPEN THE OUTPUT FET #
    PROC VDTSSL;                     # SET SCREEN/LINE MODE #
    PROC VDTWTC;                     # WRITE THE INIT. SEQ. #
    END
 
  XDEF
    BEGIN
    LABEL LINE;                       # LINE DIRECTIVE #
    LABEL SCREEN;                     # SCREEN DIRECTIVE #
    END
 
  ITEM ERR1       C(32) =  "TERMINAL MODEL NOT YET SPECIFIED";
                                     # ERROR MESSAGE #
  ITEM ERR1T      I = 0;             # END OF ERROR MESSAGE #
  ITEM ERR2       C(29) =  "TERMINAL DEFINITION NOT FOUND";
                                     # ERROR MESSGE #
  ITEM ERR2T      I = 0;             # END OF ERROR MESSAGE #
  ITEM ERR3       C(25) =  "DEFINITION FILE NOT FOUND";
                                     # ERROR MESSGE #
  ITEM ERR3T      I = 0;             # END OF ERROR MESSAGE #
  ITEM I          I;                 # INTEGER VARIABLE #
  ITEM MODE       I;                 # DIRECTIVE MODE VARIABLE #
  ITEM SCRIST     B;                 # INTERACTIVE STATUS FLAG #
  ITEM SCRLCA     I;                 # LOADED CAPSULE ADDRESS #
  ITEM SCRMDL     I;                 # MODEL ORDINAL(0 IF UNREC.)#
  ITEM SCRMOD     I;                 # MODE(LINE = 0,SCREEN = 1)#
  ITEM SCRPFF     I;                 # PERMANENT FILE FOUND #
  ITEM SCRPFN     C(7) = "TERMLIB";  # *PFM* PARAMETER #
  ITEM SCRRCA     I;                 # RESIDENT CAPSULE ADDRESS #
  ITEM SCRSTS     B;                 # *TERMLIB* STATUS FLAG #
  ITEM SCRTCF     B;                 # TERMCAP FOUND #
  ITEM SCRTFL     B;                 # *TERMLIB* FILE LOCAL #
  ITEM SCRTRM     C(7) = "Z Z Z Z";  # USER-SUPPLIED MNEMONIC #
  ITEM SCRTRP     B;                 # *TERMLIB* RETRIEVED BY *PF* #
  ITEM SCRUSN     C(7) = "LIBRARY";  # ALTERNATE USER NUMBER #
  ITEM SCRZBA     I;                 # *ZZZZTRM* BUFFER ADDRESS #
  ITEM SCRZFE     B;                 # *ZZZZTRM* FILE EXISTS FLAG #
  ITEM SCRZTM     C(7);              # Z-PREFIXED TERM-MNEMONIC #
  ITEM UNLOAD     B;                 # UNLOAD GROUP DIRECTORY #
  ARRAY NONESTR[0:0] S(1);
    BEGIN
    ITEM NONEKEY  C(00,00,04) = ["NONE"];  # NONE OPTION STRING #
    ITEM ZEROES   I(00,24,18) = [ 0 ];  # ZERO-FILL #
    ITEM NONE     C(00,00,07);       # ZERO-FILLED STRING #
    END
 
  PROC SCRGTC(SCRZTM,SCRTCF,SCRSTS,SCRTRP);
  # TITLE SCRGTC - GET TERMINAL CAPSULE. #
 
  BEGIN  # SCRGTC #
 
  #
  ***  SCRGTC - GET TERMINAL CAPSULE.
  *
  *    *SCRGTC* CALLS *SCRLCP* TO LOAD A CAPSULE GIVEN THE
  *    CAPSULE NAME, WHICH RETURNS THE ADDRESS OF THE CAPSULE
  *    IF SUCCESSFULLY LOADED.  IF SO, THE ROUTINE *SCRCZF*
  *    CREATES A FILE NAMED *ZZZZTRM* AND COPIES THIS CAPSULE
  *    RECORD INTO IT.  *SCRCZF* THEN MARKS THE *ZZZZTRM* FILE
  *    NON-RETURNABLE BY GLOBAL CLEAR.
  *
  *    PROC SCRGTC(SCRZTM,SCRTCF,SCRSTS,SCRTRP)
  *
  *                SCRZTM = Z-PREFIXED TERMINAL MNEMONIC.
  *                SCRTCF = TERMCAP FOUND FLAG RETURNED.
  *                SCRSTS = *TERMLIB* STATUS FLAG.
  *                SCRTRP = *TERMLIB* RETRIEVED BY *PF*.
  *
  *    ENTRY     OBJECT ROUTINE CALLED WITH TERMINAL MNEMONIC,
  *              *TERMLIB* STATUS FLAG, AND FLAG TO RETURN *TERMLIB*.
  *
  *    EXIT      COMPLETION FLAG RETURNED TO CALLING ROUTINE.
  *
  *    NOTES     THE *SCRGTC* ROUTINES ARE COMPASS MACROS.
  *
  *    COPYRIGHT CONTROL DATA SYSTEMS INC.  1992.
  #
 
 
  ITEM SCRCLS     I;                 # CAPSULE LOADED SUCCESSFULLY #
  ITEM SCRLCA     I;                 # LOADED CAPSULE ADDRESS #
  ITEM SCRSTS     B;                 # *TERMLIB* STATUS FLAG #
  ITEM SCRTCF     B;                 # TERMCAP FOUND #
  ITEM SCRTCL     I;                 # TERMINAL CAPSULE LENGTH #
  ITEM SCRTCV     B;                 # TERMINAL CAPSULE VALID #
  ITEM SCRTRP     B;                 # *TERMLIB* RETRIEVED BY *PF* #
  ITEM SCRZTM     C(7);              # TERMINAL MNEMONIC #
 
 
  SCRTCF = FALSE;                    # INITIALIZE FOUND FLAG #
  SCRLCP(SCRZTM,SCRLCA,SCRCLS);      # LOAD TERMINAL CAPSULE #
  IF SCRCLS EQ 0 THEN                # CAPSULE LOADED SUCCESSFULLY #
    BEGIN
    SCRTCV = FALSE;                  # INITIALIZE AS INVALID #
    SCRCCK(SCRLCA,SCRZTM,SCRTCV,SCRTCL,SCRSTS);  # VALIDATE TERMCAP #
    IF SCRTCV THEN                   # IF VALID *TDU* TERMCAP #
      BEGIN
      SCRRET("ZZZZTRM");             # RETURN *ZZZZTRM* FILE #
      SCRCZF(SCRLCA,SCRTCL);         # CREATE *ZZZZTRM* FILE #
      SCRMDL = 1;                    # USER DEFINED MODEL #
      SCRMOD = MODE;                 # DIRECTIVE SPECIFIED MODE #
      VDTSSL(SCRMDL,SCRMOD);         # SET MODEL, MODE #
      SCRISR(SCRMOD);                # ISSUE SYSTEM REQUEST #
      SCROUT(SCRLCA,SCRMOD);         # PRINT INIT. SEQUENCE #
      SCRTCF = TRUE;                 # TERMINAL CAPSULE FOUND #
      SCRRET("ZZZZZOU");             # RETURN *ZZZZZOU* FILE #
      END
    END
  IF SCRTRP THEN
    BEGIN                            # IF *PF* RETRIEVED *TERMLIB* #
    SCRRET(SCRPFN);                  # RETURN LOCAL FILE #
    END
 
  END  # SCRGTC #
 
  PROC SCROUT(SCRLCA,SCRMOD);
  # TITLE SCROUT - OUTPUT TERMINAL INITIALIZATION SEQUENCE #
 
  BEGIN  # SCROUT #
 
  #
  ***  SCROUT - OUTPUT TERMINAL INIT. SEQUENCE *
  *
  *    *SCROUT* CALLS *VDTOPN* TO OPEN AND INITIALIZE THE
  *    OUTPUT FET.  *SCRGIS* IS THEN CALLED TO GET THE
  *    TERMINAL INITIALIZATION SEQUENCE FROM THE LOADED
  *    CAPSULE, CONVERTING THE SEQUENCE FROM 7-BIT BYTES
  *    TO 12-BIT TRANSPARENT BYTES.  THE SEQUENCE IS LEFT
  *    IN THE *SCRISB* BUFFER, WHICH IS WRITTEN BY *VDTWTC*
  *    TO THE OUTPUT FET, AND *VDTCLO* CLOSES THIS FET.
  *
  *    PROC SCROUT(ADDRESS,MODE)
  *
  *                ADDRESS = LOADED CAPSULE OR FILE BUFFER ADDRESS.
  *                MODE = MODE SPECIFIED BY USER.
  *
  *    ENTRY     ADDRESS = LOADED CAPSULE OR FILE BUFFER ADD RESS.
  *              MODE = 0, IF LINE MODE,
  *                   = 1, IF SCREEN MODE.
  *
  *    EXIT      OBJECT ROUTINE EXECUTED.
  *
  *    NOTES     THE *SCROUT* ROUTINES ARE COMPASS ROUTINES.
  *
  *    COPYRIGHT CONTROL DATA SYSTEMS INC.  1992.
  #
 
  BASED ARRAY PARM [0:0] P(1);;
 
  ITEM SCRISB     I;                 # SEQUENCE BUFFER #
  ITEM SCRLCA     I;                 # LOADED CAPSULE ADDRESS #
  ITEM SCRMOD     I;                 # TERMINAL MODE #
  ITEM SCRREC     I;                 # RECALL PARAMETER #
 
  SCRREC = 1;                        # SET AUTO RECALL #
  SCRGIS(SCRLCA,SCRMOD,SCRISB);      # GET SEQUENCE #
  IF SCRISB NQ 0 THEN
    BEGIN                            # IF NOT EMPTY SEQUENCE #
    VDTOPN;                          # OPEN THE OUTPUT FET #
    P<PARM> = SCRISB;
    VDTWTC(PARM);                    # WRITE SEQUENCE #
    VDTCLO(SCRREC);                  # CLOSE THE OUTPUT FET #
    END
 
  END  # SCROUT #
 
 
SCREEN:                              # SCREEN ENTRY POINT #
 
  MODE = 1;                          # INITIALIZE MODE TO SCREEN #
  GOTO SCRMAIN;                      # JUMP TO MAIN BODY OF *SCREX* #
 
LINE:                                # LINE ENTRY POINT #
 
  MODE = 0;                          # INITIALIZE MODE TO LINE #
  GOTO SCRMAIN;                      # JUMP TO MAIN BODY OF *SCREX* #
 
 
SCRMAIN:
 
  SCRCIS(SCRIST);                    # CHECK INTERACTIVE STATUS #
  IF NOT(SCRIST) THEN                # IF NOT INTERACTIVE  #
    STOP;                            # HALT PROGRAM EXECUTION #
  SCRPKP(SCRTRM);                    # PROCESS PARAMETERS #
  IF (SCRTRM EQ NONE[0]) THEN        # NONE OPTION SPECIFIED #
    BEGIN                            # NONE OPTION #
    SCRMDL = 0;                      # SET CURRENT MODEL TO NONE #
    SCRMOD = 0;                      # SET CURRENT MODE TO LINE #
    VDTSSL(SCRMDL,SCRMOD);           # SET MODE, MODEL #
    SCRISR(SCRMOD);                  # ISSUE SYSTEM REQUEST #
    RETURN;
    END
  IF SCRTRM EQ "Z Z Z Z" THEN        # IF MODEL NOT SPECIFIED #
    BEGIN
    VDTGSL(SCRMDL,SCRMOD);           # GET CURRENT MODEL, MODE #
    IF SCRMDL NQ 0 THEN              # IF PREVIOUS MODEL SPECIFIED #
      BEGIN
      IF SCRMDL NQ 1 THEN            # IF RESIDENT MODEL SPECIFIED #
        BEGIN
        SCRMOD = MODE;               # SET CURRENT MODE #
        VDTGTA(SCRMDL,SCRRCA);       # GIVEN MODEL, RETURN ADDRESS #
        SCROUT(SCRRCA,SCRMOD);       # SEND INITIALIZATION SEQUENCE #
        VDTSSL(SCRMDL,SCRMOD);       # SET MODE, MODEL #
        SCRISR(SCRMOD);              # ISSUE SYSTEM REQUEST #
        END
      ELSE                           # NON-RESIDENT MODEL SPECIFIED #
        BEGIN
        SCRZFE = FALSE;
        SCRPFN = "ZZZZTRM";
        SCRFST(SCRPFN,SCRZFE);       # CHECK FOR LOCAL *ZZZZTRM* #
        IF SCRZFE THEN               # IF LOCAL *ZZZZTRM* EXISTS #
          BEGIN
          SCRMOD = MODE;             # USER SPECIFIED MODE #
          SCRRZF(SCRPFN,SCRZBA);     # READ INTO BUFFER #
          SCROUT(SCRZBA,SCRMOD);     # SEND INITIALIZATION SEQUENCE #
          VDTSSL(SCRMDL,SCRMOD);     # SET MODE, MODEL #
          SCRISR(SCRMOD);            # ISSUE SYSTEM REQUEST #
          END
        ELSE                         # NO LOCAL *ZZZZTRM* #
          BEGIN
          VDTMSG$(ERR3,0,1);         # ERROR MESSAGE #
          VDTABT$;                   # TERMINATE ABNORMALLY #
          END
        END
      END
    ELSE                             # NO PREVIOUS MODEL SPECIFIED #
      BEGIN
      IF MODE EQ 0 THEN              # LINE MODE SPECIFIED #
        BEGIN                        # LINE DIRECTIVE #
        SCRMDL = 0;                  # SET CURRENT MODEL TO NONE #
        SCRMOD = 0;                  # SET CURRENT MODE TO LINE #
        VDTSSL(SCRMDL,SCRMOD);       # SET MODE, MODEL #
        SCRISR(SCRMOD);              # ISSUE SYSTEM REQUEST #
        END
      ELSE
        BEGIN                        # SCREEN DIRECTIVE #
        VDTMSG$(ERR1,0,1);           # ERROR MESSAGE #
        VDTABT$;                     # TERMINATE ABNORMALLY #
        END
      END
    END                              # MODEL NOT SPECIFIED #
  ELSE                               # MODEL WAS SPECIFIED #
    BEGIN
    C<0>SCRZTM = "Z";                # PREFIX MNEMONIC WITH "Z" #
    FOR I = 1 STEP 1 UNTIL 6 DO
      C<I>SCRZTM = C<I-1>SCRTRM;     # CONCAT *SCRTRM* TO *SCTZTM* #
    VDTGTO(SCRMDL,SCRTRM);           # GET TERMINAL ORDINAL #
    IF SCRMDL NQ 0 THEN              # IF TERMINAL TABLE RESIDENT #
      BEGIN
      SCRMOD = MODE;                 # SET DIRECTIVE MODE #
      SCRRTA(SCRTRM,SCRLCA);         # GET TERMCAP ADDRESS #
      SCROUT(SCRLCA,SCRMOD);         # PRINT INIT. SEQUENCE #
      VDTSSL(SCRMDL,SCRMOD);         # SET MODE, MODEL #
      SCRISR(MODE);                  # ISSUE SYSTEM REQUEST #
      END
    ELSE                             # TERMINAL TABLE NOT RESIDENT #
      BEGIN
      UNLOAD = FALSE;                # GROUP DIRECTORY UNLOAD FLAG #
      SCRTRP = FALSE;
      SCRSTS = FALSE;                # INITIALIZE *TERMLIB* STATUS #
      SCRTFL = FALSE;
      SCRTCF = FALSE;
      SCRFST(SCRPFN,SCRTFL);         # CHECK IF *TERMLIB* IS LOCAL #
      IF SCRTFL THEN
        BEGIN                        # IF LOCAL *TERMLIB* FOUND #
        SCRSTS = TRUE;
        SCRGTC(SCRZTM,SCRTCF,SCRSTS,SCRTRP);  # GET LOCAL CAPSULE #
        UNLOAD = TRUE;
        END
      IF NOT SCRTCF THEN             # IF TERMINAL CAPSULE NOT FOUND #
        BEGIN
        PF("GET",SCRPFN,SCRPFN,"RC",SCRPFF,0);  # GET *SCRPFN* FILE #
        IF SCRPFF NQ 0 THEN
          BEGIN                      # IF GET FAILS, ATTACH #
          PF("ATTACH",SCRPFN,SCRPFN,"RC",SCRPFF,"NA",0,0);
          END
        IF SCRPFF EQ 0 THEN          # IF FILE WAS FOUND #
          BEGIN
          SCRSTS = TRUE;
          SCRTRP = TRUE;             # *TERMLIB* RETRIEVED BY *PF* #
          IF UNLOAD THEN             # IF LOADER CALLED BEFORE #
            BEGIN
            SCRUGD;                  # UNLOAD GROUP DIRECTORY #
            UNLOAD = FALSE;          # GROUP DIRECTORY UNLOADED #
            END
          SCRGTC(SCRZTM,SCRTCF,SCRSTS,SCRTRP);  # GET CAPSULE #
          UNLOAD = TRUE;
          END
        IF NOT SCRTCF THEN           # IF TERMCAP NOT FOUND #
          BEGIN
          PF("GET",SCRPFN,SCRPFN,"RC",SCRPFF,"UN",SCRUSN,"PN","0",0);
                                     # GET *TERMLIB* FROM UN=LIBRARY #
          IF SCRPFF NQ 0 THEN
            BEGIN                    # IF GET FAILS, ATTACH #
            PF("ATTACH",SCRPFN,SCRPFN,"RC",SCRPFF,
               "UN",SCRUSN,"PN","0","NA",0,0);
            END
          IF SCRPFF EQ 0 THEN        # IF FILE WAS FOUND #
            BEGIN
            SCRSTS = FALSE;          # SET STATUS TO SYSTEM #
            SCRTRP = TRUE;           # *TERMLIB* RETRIEVED BY *PF* #
            IF UNLOAD THEN           # IF LOADER CALLED BEFORE #
              BEGIN
              SCRUGD;                # UNLOAD GROUP DIRECTORY #
              END
            SCRGTC(SCRZTM,SCRTCF,SCRSTS,SCRTRP);  # GET CAPSULE #
            END
          IF NOT SCRTCF THEN         # IF TERMCAP NOT FOUND #
            BEGIN
            SCRMOD = 0;              # LINE MODE #
            SCRMDL = 0;              # UNDEFINED ORDINAL #
            VDTSSL(SCRMDL,SCRMOD);   # SET MODE, MODEL #
            SCRISR(SCRMOD);          # ISSUE SYSTEM REQUEST #
            VDTMSG$(ERR2,0,1);       # SEND MESSAGE TO USER #
            VDTABT$;                 # TERMINATE ABNORMALLY #
            END
          END                        # TERMCAP NOT FOUND #
        END                          # TERMCAP NOT FOUND #
      END                            # TERMINAL TABLE NOT RESIDENT #
    END                              # MODEL WAS SPECIFIED #
 
END  # SCREX #                       # END OF *SCREX* PROGRAM #
 
TERM