SHARE
TWEET

REXX

a guest Jan 15th, 2012 66 Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
  1. /****************************** REXX ***********************************/
  2. /*                                                                     */
  3. /* Name: NETSOL.REX                                                    */
  4. /*                                                                     */
  5. /* Type: REXX Command Procedure                                        */
  6. /*                                                                     */
  7. /* Desc: Screen Definition Facility                                    */
  8. /*                                                                     */
  9. /***********************************************************************/
  10. SIGNAL ON NOVALUE
  11. CALL Initialize
  12. ARG File
  13. IF ARG()=0 THEN Filename='turnkey'
  14.            ELSE Filename=STRIP(ARG(1))
  15. In_file=Filename  || '.map'
  16. Out_file=Filename || '.asm'
  17. LBL=TRANSLATE(STRIP(Filename))
  18. LBLA=SUBSTR(LBL||COPIES(' ',8),1,8)
  19. LBLB=SUBSTR(LBL||'L'||COPIES(' ',8),1,8)
  20. Process_status = '.NONE'
  21. /*CALL SysFileDelete Out_file*/
  22. DO WHILE LINES(In_file)
  23.    My_rec=LINEIN(In_file)
  24.    SELECT
  25.       WHEN My_rec = ".ATTR" THEN DO
  26.          Process_status = ".ATTR"
  27.          A = 0
  28.          attrlist=''
  29.          ITERATE
  30.          END
  31.       WHEN My_rec = ".SCREEN" THEN DO
  32.          Process_status = ".SCREEN"
  33.          L = 0
  34.          L = L + 1; LINE.L = '$ESC'
  35.                     LINE.L.VARIABLE = TRUE
  36.          L = L + 1; LINE.L = '$IO   ERASE/WRITE'
  37.                     LINE.L.VARIABLE = TRUE
  38.          L = L + 1; LINE.L = '$WCC  (RESETKBD,MDT)'
  39.                     LINE.L.VARIABLE = TRUE
  40.          LINE.0 = L
  41.          B = 0
  42.          B = B + 1; BEMERK.B = '* >>>>>>>>>>>>>>>>>>>>>> Sample Screen Layout <<<<<<<<<<<<<<<<<<<<<<<<'
  43.          B = B + 1; BEMERK.B = '* '
  44.          B = B + 1; BEMERK.B = '* ----+----1----5----2----+----3----+----4----+----5----+----6----+---'
  45.          DATA = ''
  46.          Row = 0
  47.          Col = 0
  48.          NO_Attrib = TRUE
  49.          ITERATE
  50.          END
  51.       WHEN My_rec = ".VARS" THEN DO
  52.          Process_status = ".VARS"
  53.          V = 0
  54.          V = V + 1; VAR.V = LBL||'E'
  55.          V = V + 1; VAR.V = LBL||'I'
  56.          V = V + 1; VAR.V = LBL||'W'
  57.          VAR.0 = V
  58.          ITERATE
  59.          END
  60.       WHEN My_rec = ".MARKS" THEN DO
  61.          Process_status = ".MARKS"
  62.          MarksList=''
  63.          M = 0
  64.          ITERATE
  65.          END
  66.       OTHERWISE DO
  67.          CALL Process_Myrec
  68.          END
  69.    END
  70. END
  71. IF DATA \= "" THEN               /* If we still have data      */
  72.    DO
  73.       CALL Write_DC              /* Write data for last field  */
  74.    END
  75. /* ENDIF */
  76. Outlist=COPIES(' ',LENGTH(ATTRLIST)+LENGTH(MarksList))
  77. DO B = 1 TO BEMERK.0
  78.    X = TRANSLATE(BEMERK.B,Outlist,Attrlist||MarksList)
  79.    CALL LINEOUT Out_file,X
  80. END
  81. V=0
  82. CALL LINEOUT Out_file,'         PUSH  PRINT'
  83. CALL LINEOUT Out_file,'         PRINT OFF'
  84. CALL LINEOUT Out_file,LBLA||' DS    0D'
  85. DO L = 1 TO LINE.0
  86.    IF LINE.L.VARIABLE THEN
  87.       DO
  88.          V = V + 1
  89.          ASMLINE = SUBSTR(VAR.V||'         ',1,9)
  90.       END
  91.    ELSE
  92.       DO
  93.          ASMLINE = COPIES(' ',9)
  94.       END
  95.    /* ENDIF */
  96.    ASMLINE = ASMLINE || LINE.L
  97.    IF LENGTH(ASMLINE) < 72 THEN
  98.       DO
  99.          CALL LINEOUT Out_file,ASMLINE
  100.       END
  101.    ELSE
  102.       DO
  103.          CALL LINEOUT Out_file,SUBSTR(ASMLINE,1,71)||'C'
  104.          CALL LINEOUT Out_file,COPIES(' ',15) || SUBSTR(ASMLINE,72,LENGTH(ASMLINE)-71)
  105.       END
  106. END
  107. CALL LINEOUT Out_file,LBLB||' EQU   *-' || LBL
  108. CALL LINEOUT Out_file,'         POP   PRINT'
  109. CALL STREAM In_file,"CMD","CLOSE"
  110. CALL STREAM Out_file,"CMD","CLOSE"
  111. RETURN
  112. Process_Myrec:
  113.    SELECT
  114.       WHEN Process_status = ".ATTR"    THEN CALL Process_attribute
  115.       WHEN Process_status = ".SCREEN"  THEN CALL Process_screen
  116.       WHEN Process_status = ".VARS"    THEN CALL Process_vars
  117.       WHEN Process_status = ".MARKS"   THEN CALL Process_marks
  118.    END
  119.    RETURN
  120.  
  121. Process_marks:
  122.    Parse VAR My_rec Mark Type
  123.    Mark=STRIP(Mark)
  124.    Type=STRIP(Type)
  125.    M = M + 1; MARKS.LIST.M = Type
  126.               MARKS.Type = Mark
  127.               MARKS.LIST.0 = M
  128.               MarksList=MarksList || Mark
  129.    RETURN
  130.  
  131. Process_attribute:
  132.    Parse VAR My_rec Attrib Text
  133.    temp = ''
  134.    IC = FALSE
  135.    DO K = 1 TO WORDS(Text)
  136.       IF TRANSLATE(WORD(Text,K)) = 'CUR' THEN
  137.          DO
  138.             IC=TRUE
  139.          END
  140.       ELSE
  141.          DO
  142.             temp=temp||','||TRANSLATE(WORD(Text,K))
  143.          END
  144.      /* ENDIF */
  145.    END
  146.    temp = SUBSTR(TEMP,2,LENGTH(Temp)-1)
  147.    A = A + 1; ATTR.A = '('||Temp||')'
  148.               ATTR.A.CURSOR = IC
  149.    ATTR.0 = A
  150.    attrlist=Attrlist||Attrib
  151.    RETURN
  152.  
  153. Process_screen:
  154.    ROW = ROW + 1                                /* count row we are working on */
  155.    X = SUBSTR(My_REC||COPIES(' ',80),1,80)      /* make full 80 byte record    */
  156.    B = B + 1; BEMERK.B = '* ' || SUBSTR(X,1,69)
  157.    BEMERK.0 = B
  158.    DO C = 1 TO 80                               /* Process one by one          */
  159.       K = SUBSTR(X,C,1)                         /* get next byte               */
  160.       DO A = 1 TO ATTR.0                        /* test if attribute           */
  161.          IF SUBSTR(Attrlist,A,1)=K THEN         /* If we find an attribute     */
  162.             DO
  163.                No_Attrib = FALSE
  164.                IF DATA \= "" THEN               /* And we already have data    */
  165.                   DO
  166.                     CALL Write_DC               /* Write data for prev. field  */
  167.                   END
  168.                /* ENDIF */                      /* Write orders for this field */
  169.                L = L + 1; LINE.L ='$SBA  (' || ROW || ',' || C || ')'
  170.                                    LINE.L.VARIABLE = FALSE
  171.                L = L + 1; LINE.L ='$SF   '  || ATTR.A
  172.                                    LINE.L.VARIABLE = FALSE
  173.                IF ATTR.A.CURSOR THEN
  174.                   DO
  175.                      L = L + 1; LINE.L = '$IC'
  176.                                 LINE.L.VARIABLE = FALSE
  177.                   END
  178.                /*ENDIF*/
  179.                LINE.0 = L
  180.                LEAVE A
  181.             END
  182.          /* ENDIF */
  183.       END
  184.       IF No_attrib THEN
  185.          DO
  186.             NOP
  187.          END
  188.       ELSE
  189.          DO
  190.             DATA = DATA || SUBSTR(X,C,1)
  191.             IF SUBSTR(X,C,1)= "'" THEN DATA = DATA || "'"
  192.          END
  193.       /* ENDIF */
  194.    END
  195.    RETURN
  196.  
  197. Write_DC:
  198.    Constant = STRIP(SUBSTR(DATA,2,LENGTH(DATA)-1),'T',' ')
  199.    SELECT
  200.      WHEN LENGTH(CONSTANT) = 0 THEN
  201.           NOP
  202.      WHEN Constant = COPIES(Marks.var,LENGTH(CONSTANT)) THEN
  203.         DO
  204.            L = L + 1; LINE.L = 'DC    CL' || LENGTH(constant) || ''' '''
  205.                       LINE.L.VARIABLE = TRUE
  206.         END
  207.      WHEN Constant = COPIES(' ',LENGTH(CONSTANT)) THEN
  208.         DO
  209.            NOP
  210.         END
  211.      OTHERWISE
  212.         DO
  213.            L = L + 1; Line.L = 'DC    C''' || Constant ||''''
  214.                       LINE.L.VARIABLE = FALSE
  215.         END
  216.    END
  217.    LINE.0 = L
  218.    DATA=''
  219.    RETURN
  220.  
  221. Process_vars:
  222.    DO I = 1 TO Words(My_rec)
  223.       V = V + 1; VAR.V = TRANSLATE(WORD(My_rec,I))
  224.    END
  225.    VAR.0 = V
  226.    RETURN
  227.  
  228. INITIALIZE:
  229.    TRUE = (1=1)
  230.    FALSE = \TRUE
  231.    Marks.var = '_'
  232.    RETURN
  233.  
  234. Novalue:
  235.    MsgText = ''
  236.    MsgText = 'An unitialized variable has been used' CRLF
  237.    MsgText = MsgText || 'Linenumber was' SIGL CRLF
  238.    MsgText = MsgText || 'Sourceline was' SOURCELINE(SIGL) CRLF
  239.    RC = RxMessageBox(Msgtext,'Novalue Condition','OK','STOP')
  240.    EXIT
  241.    ADDRESS 'CMD' 'PAUSE'
  242.    ADDRESS 'CMD' 'EXIT'
RAW Paste Data
Top