Advertisement
Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- /****************************** REXX ***********************************/
- /* */
- /* Name: NETSOL.REX */
- /* */
- /* Type: REXX Command Procedure */
- /* */
- /* Desc: Screen Definition Facility */
- /* */
- /***********************************************************************/
- SIGNAL ON NOVALUE
- CALL Initialize
- ARG File
- IF ARG()=0 THEN Filename='turnkey'
- ELSE Filename=STRIP(ARG(1))
- In_file=Filename || '.map'
- Out_file=Filename || '.asm'
- LBL=TRANSLATE(STRIP(Filename))
- LBLA=SUBSTR(LBL||COPIES(' ',8),1,8)
- LBLB=SUBSTR(LBL||'L'||COPIES(' ',8),1,8)
- Process_status = '.NONE'
- /*CALL SysFileDelete Out_file*/
- DO WHILE LINES(In_file)
- My_rec=LINEIN(In_file)
- SELECT
- WHEN My_rec = ".ATTR" THEN DO
- Process_status = ".ATTR"
- A = 0
- attrlist=''
- ITERATE
- END
- WHEN My_rec = ".SCREEN" THEN DO
- Process_status = ".SCREEN"
- L = 0
- L = L + 1; LINE.L = '$ESC'
- LINE.L.VARIABLE = TRUE
- L = L + 1; LINE.L = '$IO ERASE/WRITE'
- LINE.L.VARIABLE = TRUE
- L = L + 1; LINE.L = '$WCC (RESETKBD,MDT)'
- LINE.L.VARIABLE = TRUE
- LINE.0 = L
- B = 0
- B = B + 1; BEMERK.B = '* >>>>>>>>>>>>>>>>>>>>>> Sample Screen Layout <<<<<<<<<<<<<<<<<<<<<<<<'
- B = B + 1; BEMERK.B = '* '
- B = B + 1; BEMERK.B = '* ----+----1----5----2----+----3----+----4----+----5----+----6----+---'
- DATA = ''
- Row = 0
- Col = 0
- NO_Attrib = TRUE
- ITERATE
- END
- WHEN My_rec = ".VARS" THEN DO
- Process_status = ".VARS"
- V = 0
- V = V + 1; VAR.V = LBL||'E'
- V = V + 1; VAR.V = LBL||'I'
- V = V + 1; VAR.V = LBL||'W'
- VAR.0 = V
- ITERATE
- END
- WHEN My_rec = ".MARKS" THEN DO
- Process_status = ".MARKS"
- MarksList=''
- M = 0
- ITERATE
- END
- OTHERWISE DO
- CALL Process_Myrec
- END
- END
- END
- IF DATA \= "" THEN /* If we still have data */
- DO
- CALL Write_DC /* Write data for last field */
- END
- /* ENDIF */
- Outlist=COPIES(' ',LENGTH(ATTRLIST)+LENGTH(MarksList))
- DO B = 1 TO BEMERK.0
- X = TRANSLATE(BEMERK.B,Outlist,Attrlist||MarksList)
- CALL LINEOUT Out_file,X
- END
- V=0
- CALL LINEOUT Out_file,' PUSH PRINT'
- CALL LINEOUT Out_file,' PRINT OFF'
- CALL LINEOUT Out_file,LBLA||' DS 0D'
- DO L = 1 TO LINE.0
- IF LINE.L.VARIABLE THEN
- DO
- V = V + 1
- ASMLINE = SUBSTR(VAR.V||' ',1,9)
- END
- ELSE
- DO
- ASMLINE = COPIES(' ',9)
- END
- /* ENDIF */
- ASMLINE = ASMLINE || LINE.L
- IF LENGTH(ASMLINE) < 72 THEN
- DO
- CALL LINEOUT Out_file,ASMLINE
- END
- ELSE
- DO
- CALL LINEOUT Out_file,SUBSTR(ASMLINE,1,71)||'C'
- CALL LINEOUT Out_file,COPIES(' ',15) || SUBSTR(ASMLINE,72,LENGTH(ASMLINE)-71)
- END
- END
- CALL LINEOUT Out_file,LBLB||' EQU *-' || LBL
- CALL LINEOUT Out_file,' POP PRINT'
- CALL STREAM In_file,"CMD","CLOSE"
- CALL STREAM Out_file,"CMD","CLOSE"
- RETURN
- Process_Myrec:
- SELECT
- WHEN Process_status = ".ATTR" THEN CALL Process_attribute
- WHEN Process_status = ".SCREEN" THEN CALL Process_screen
- WHEN Process_status = ".VARS" THEN CALL Process_vars
- WHEN Process_status = ".MARKS" THEN CALL Process_marks
- END
- RETURN
- Process_marks:
- Parse VAR My_rec Mark Type
- Mark=STRIP(Mark)
- Type=STRIP(Type)
- M = M + 1; MARKS.LIST.M = Type
- MARKS.Type = Mark
- MARKS.LIST.0 = M
- MarksList=MarksList || Mark
- RETURN
- Process_attribute:
- Parse VAR My_rec Attrib Text
- temp = ''
- IC = FALSE
- DO K = 1 TO WORDS(Text)
- IF TRANSLATE(WORD(Text,K)) = 'CUR' THEN
- DO
- IC=TRUE
- END
- ELSE
- DO
- temp=temp||','||TRANSLATE(WORD(Text,K))
- END
- /* ENDIF */
- END
- temp = SUBSTR(TEMP,2,LENGTH(Temp)-1)
- A = A + 1; ATTR.A = '('||Temp||')'
- ATTR.A.CURSOR = IC
- ATTR.0 = A
- attrlist=Attrlist||Attrib
- RETURN
- Process_screen:
- ROW = ROW + 1 /* count row we are working on */
- X = SUBSTR(My_REC||COPIES(' ',80),1,80) /* make full 80 byte record */
- B = B + 1; BEMERK.B = '* ' || SUBSTR(X,1,69)
- BEMERK.0 = B
- DO C = 1 TO 80 /* Process one by one */
- K = SUBSTR(X,C,1) /* get next byte */
- DO A = 1 TO ATTR.0 /* test if attribute */
- IF SUBSTR(Attrlist,A,1)=K THEN /* If we find an attribute */
- DO
- No_Attrib = FALSE
- IF DATA \= "" THEN /* And we already have data */
- DO
- CALL Write_DC /* Write data for prev. field */
- END
- /* ENDIF */ /* Write orders for this field */
- L = L + 1; LINE.L ='$SBA (' || ROW || ',' || C || ')'
- LINE.L.VARIABLE = FALSE
- L = L + 1; LINE.L ='$SF ' || ATTR.A
- LINE.L.VARIABLE = FALSE
- IF ATTR.A.CURSOR THEN
- DO
- L = L + 1; LINE.L = '$IC'
- LINE.L.VARIABLE = FALSE
- END
- /*ENDIF*/
- LINE.0 = L
- LEAVE A
- END
- /* ENDIF */
- END
- IF No_attrib THEN
- DO
- NOP
- END
- ELSE
- DO
- DATA = DATA || SUBSTR(X,C,1)
- IF SUBSTR(X,C,1)= "'" THEN DATA = DATA || "'"
- END
- /* ENDIF */
- END
- RETURN
- Write_DC:
- Constant = STRIP(SUBSTR(DATA,2,LENGTH(DATA)-1),'T',' ')
- SELECT
- WHEN LENGTH(CONSTANT) = 0 THEN
- NOP
- WHEN Constant = COPIES(Marks.var,LENGTH(CONSTANT)) THEN
- DO
- L = L + 1; LINE.L = 'DC CL' || LENGTH(constant) || ''' '''
- LINE.L.VARIABLE = TRUE
- END
- WHEN Constant = COPIES(' ',LENGTH(CONSTANT)) THEN
- DO
- NOP
- END
- OTHERWISE
- DO
- L = L + 1; Line.L = 'DC C''' || Constant ||''''
- LINE.L.VARIABLE = FALSE
- END
- END
- LINE.0 = L
- DATA=''
- RETURN
- Process_vars:
- DO I = 1 TO Words(My_rec)
- V = V + 1; VAR.V = TRANSLATE(WORD(My_rec,I))
- END
- VAR.0 = V
- RETURN
- INITIALIZE:
- TRUE = (1=1)
- FALSE = \TRUE
- Marks.var = '_'
- RETURN
- Novalue:
- MsgText = ''
- MsgText = 'An unitialized variable has been used' CRLF
- MsgText = MsgText || 'Linenumber was' SIGL CRLF
- MsgText = MsgText || 'Sourceline was' SOURCELINE(SIGL) CRLF
- RC = RxMessageBox(Msgtext,'Novalue Condition','OK','STOP')
- EXIT
- ADDRESS 'CMD' 'PAUSE'
- ADDRESS 'CMD' 'EXIT'
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement