|
DataMuseum.dkPresents historical artifacts from the history of: Philips Data Systems |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about Philips Data Systems Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - metrics - download
Length: 23748 (0x5cc4)
Notes: pts_type(SC)
Names: »WUCOP.SC«
└─⟦f45ea3bc3⟧ Bits:30009713 Philips computer tape "WSM"
└─⟦this⟧ »WSM:UTIL/WUCOP.SC«
IDENT WUCOP REL=2.3,841203,870155940230 ************************************** * WORK STATION MANAGEMENT * * * * 4 COPY VOLUME/FILE (REORGANIZE) * * * ************************************** ** HISTORY: ** 84-12-03 /CJ MUL&DIV NOW FROM ASS.ROUTINE ** 84-10-23 /CJ TOSSUT REL13 NEW DIALOUGE IMPLEMENTED ** 84-07-12 /MAER CALCULATION OF "PROGRAM LENGTH" FOR L-FILES ** (LOAD MODULES) CORRECTED (ROUNDING, NOT TRUNC.). ** "FILE NAME UNKNOWN" DISPLAYED INSTEAD OF ** "I/O ERROR 0000" IF INPUT FILE NOT PRESENT. ** DISPLAY OF COPIED ELEMENT TYPES AND NAMES WHEN ** ANSWERING "Y" TO THE QUESTION "WHOLE FILE ?". ** COPY F TO F, FILE SIZE CALCULATION CORRECTED ** (SECTOR LENGTH 255 FOR S,D,I-FILES, OTHERS 256). ** MAX SECTION SIZE DISPLAYED (FORMAT FCOPY). ** 83-06-30 /MAER DUPLICATION OF DESTINATION UNIT NOW ALLOWED. ** 83-06-20 /MAER COPY FORMS OF TFP ADDED. ** 83-06-17 /MAER COPY SPECIFIC SECTION / DEFINITION INTRODUCED. ** 83-05-11 /MAER SOP-PANEL F.C. := ZERO (EARLIER 20 => BAD ** READ-REQUEST ON VD82 FOR COPY DISC TO DISC). ** CHANGED DECORATIONS. ** 82-10-20 /MAER VOLUME-NAME CHANGE COMPLETED. ** 82-07-26 /DALI VOLUME-NAME IS CHANGED BEFORE COPY ** 81-11-04 /DALI CREATION DDUM WUDIV PDIV ENTRY WUCOP * EXPROC DECLRA CRE= SCREEN ROUTINE EXPROC DECLRN CRE= SCREEN ROUTINE EXPROC DISERR CRE= ERROR ROUTINE EXPROC UFERR CRE= ERROR ROUTINE EXPROC DSKERR,PBIN CRE= ERROR ROUTINE EXPROC CHVNAM,PSTRG,PBIN CRE= CHANGE VOLUMENAME EXPROC HALT * EXT COPYDD ASS= COPY DISC TO DISC EXT OPENF ASS= OPEN FILE EXT CLOSEF ASS= CLOSE FILE EXT RDSECT ASS= READ ONE SECTOR EXT BINBCD ASS= TWO BINARY ITEMS TO BCD EXT BCDBIN ASS= BCD TO TWO BINARY ITEMS EXT CREFIL ASS= CREATE FILE EXT DELFIL ASS= DELETE FILE EXT READDK ASS= READ A RECORD EXT WRITDK ASS= WRITE A RECORD EXT CHANFC ASS= CHANGE FILECODE EXT PREAD ASS= WSM-READ EXT PWRITE ASS= WSM-WRITE EXT PCLOSE ASS= WSM-CLOSE EXT WXMUL ASS= MULTIPLICATION EXT WXDIV ASS= DIVISION EXT GETIND ASS= GET DIMENSION EJECT WUCOP PROC ************************************* * 4 COPY VOLUME/FILE (REORGANIZE) * ************************************* COP000 CLEAR BOOL2 USED IN FORMAT FIO ATTFMT FCOPY SET DEPROMPT COP100 PERF DECLRA COP150 IB DEBINW2,COP100,RETUR,COP200 PERF DSKERR,W0 'BELL' B COP150 RETUR RET COP200 IB DTYP,COP500,COP700 COPY FILE,COPY WSM EJECT ********************* * COPY DISC TO DISC * ********************* * COP250 ATTFMT FCOPV SET DEPROMPT COP300 PERF DECLRA COP350 IB DEBINW2,COP300,COP000,COP400 PERF DSKERR,W0 'BELL' B COP350 COP400 XCOPY PBLOCK,W6,W1,FCOD1,W1 FC3 = SOURCE DISC XCOPY PBLOCK,W7,W1,FCOD2,W1 FC4 = DEST. DISC XCOPY PBLOCK,W14,W6,COPNAM,W0 VOL.NAME DEST DISC XCOPY PBLOCK,W22,W1,W3,W1 OPTION=3 NEW DIALOUGE XCOPY PBLOCK,W23,W1,W0,W0 SOP-PANEL F.C. NOT USED (:=0) CALL COPYDD,PBLOCK,BPOOL(W1),BPOOL(W18),RETCOD BPOOL(W1) = BUF1 = 2048 WORDS BPOOL(W18)= BUF2 = 200 WORDS CBE RETCOD,W0,COP450 CBE RETCOD,W9,COP000 OPERATOR ABORTED COP420 PERF DISERR B COP350 COP450 PERF HALT B COP000 EJECT ********************* * COPY FILE TO FILE * ********************* COP500 ATTFMT FCOPF SET DEPROMPT SET BOOL2 COP510 PERF DECLRA COP520 IB DEBINW2,COP510,COP000,COP540 PERF DSKERR,W0 'BELL' B COP520 COP540 CLEAR BOOL5 FILE PRESENCE INDICATOR MOVE NOREC,=D'00' PERF CHVNAM,VOLEX1,FCOD1 CHANGE NAME BNOK COP546 PERF CHVNAM,VOLEX2,FCOD2 CHANGE NAME BNOK COP544 SET BOOL5 "FILE NAME UNKNOWN" CBE FCOD1,FCOD2,COP541 CALL OPENF,DISK,FILECODE(W1),SYSBUF,FILNAM,VOLEX1,RETCOD B COP542 COP541 CALL OPENF,DISK,FILECODE(W1),SYSBUF,FILNAM,VOLEX2,RETCOD COP542 BNOK COP543 CLEAR BOOL5 "FILE NAME KNOWN..." CALL CLOSEF,DISK,FILECODE(W1),RBUF,NOREC,RETCOD BOK COP548 COP543 PERF CHVNAM,COPNAM,FCOD2 CHANGE NAME BNOK COP546 CBE FCOD1,FCOD2,COP546 COP544 PERF CHVNAM,VOLNAM,FCOD1 CHANGE NAME COP546 TBT BOOL5,COP547 FILE NOT PRESENT PERF DISERR B COP520 COP547 PERF DSKERR,W12 "FILE NAME UNKNOWN" B COP520 COP548 CALL OPENF,DISK,FILECODE(W3),SYSBUF,COPFIL,VOLEX2,RETCOD BNOK COP550 CALL CLOSEF,DISK,FILECODE(W3),RBUF,NOREC,RETCOD BNOK COP543 COP550 MOVE BCDI21(W2),=D'00' USED FOR NO. OF RECS MOVE BIN5,W0 NO. OF EXTENTS MOVE BIN1,W0 SECTOR NO. CALL CHANFC,DISK,FCOD1 CALL RDSECT,DISK,BIN1,SYSBUF,RETCOD READ VOLUME-LABEL BNOK COP543 XCOPY BIN1,W0,W2,SYSBUF,W10 FSAT BASE MOVE DKBIN2,=W'46' FSAT-LENGTH DISPLACEMENT XCOPY DKBIN1,W0,W2,SYSBUF,DKBIN2 FSAT-LENGTH XCOPY DKBIN2,W0,W2,SYSBUF,W6 ADM-LENGTH XCOPY DKBIN3,W0,W2,SYSBUF,W12 VTOC-REC-LEGTH ADD DKBIN3,W1 OCCUPYED BYTE SUB DKBIN2,DKBIN1 GET NO. OF VTOC RECS ADD BIN1,DKBIN1 START OF VTOC COP590 CALL RDSECT,DISK,BIN1,SYSBUF,RETCOD READ ONESECTOR BNOK COP543 MOVE BIN4,W0 DISP TO FILENAME COP600 MOVE BIN3,W0 MATCH FILNAM,BIN3,W8,SYSBUF,BIN4,W8 BOK COP640 FILENAME FOUND COP610 ADD BIN4,DKBIN3 GET NEXT VTOC ENTRY CBL BIN4,=W'240',COP600 ALL ENTRIES HANDLED SUB DKBIN2,W1 MORE VTOC RECORDS BNZ COP620 YES CBNE BCDI21(W2),=D'00',COP680 FILE HANDLED PERF DSKERR,W12 B COP543 COP620 ADD BIN1,W1 READ NEXT VTOC RECORD B COP590 COP640 CBNE BIN5,W0,COP660 NO. OF EXTENTS MOVE BIN12,=W'40' NO. OF EXTENTS ADD BIN12,BIN4 DISP IN VTOC-RECORD XCOPY BIN5,W1,W1,SYSBUF,BIN12 XCOPY BPOOL(W20),W0,DKBIN3,SYSBUF,BIN4 SAVE ENTRY CBNE BIN5,W0,COP660 AT LEAST ONE ENTRY MOVE BIN5,=X'7FFF' COP660 MOVE BIN2,=W'27' F.ORG DISPL. XCOPY STR1A,W0,W1,BPOOL(W20),BIN2 MOVE BIN2,W12 FILE EXT 1 ADD BIN2,BIN4 DISP IN VTOC-RECORD CBNE STR1A,=C'L',COP670 BRANCH IF NOT L-FILE ADD BIN2,W8 USE LAST RECORD NO WHEN L-FILES. COP670 XCOPY BIN10,W0,W2,SYSBUF,BIN2 FILE EXTENT 1 ADD BIN2,W2 XCOPY BIN11,W0,W2,SYSBUF,BIN2 FILE EXTENT 2 CALL BINBCD,BIN10,BIN11,BCDI21(W1) ADD BCDI21(W2),BCDI21(W1) SUB BIN5,W1 MORE EXTENTS BP COP610 YES COP680 ERASE 0,W1,W6 XCOPY PBLOCK,W7,W1,STR1A,W0 F.ORG XCOPY PBLOCK,W8,W8,COPFIL,W0 FILE-NAME XCOPY PBLOCK,W16,W6,VOLEX2,W0 VOL-NAME 1 COP682 CALL CLOSEF,DISK,FILECODE(W3),RBUF,NOREC,RETCOD BOK COP682 CALL DELFIL,PBLOCK,BPOOL(W5),BPOOL(W10),RETCOD XCOPY PBLOCK,W7,W1,STR1A,W0 F.ORG XCOPY PBLOCK,W8,W8,COPFIL,W0 FILE-NAME COPY PBLOCK,W16,W6,VOLEX2,W0 VOL-NAME 1 MOVE BIN1,=W'40' MOVE BIN2,=W'28' CRD + RP XCOPY PBLOCK,BIN1,W9,BPOOL(W20),BIN2 REL + RET.PERIOD MOVE BIN1,=W'49' MOVE BIN2,=W'26' BF XCOPY PBLOCK,BIN1,W1,BPOOL(W20),BIN2 BF MOVE BIN4,W0 XCOPY BIN4,W1,W1,BPOOL(W20),BIN2 BF MOVE BIN1,=W'50' MOVE BIN2,W24 XCOPY PBLOCK,BIN1,W2,BPOOL(W20),BIN2 RECORD LENGTH XCOPY BIN3,W0,W2,BPOOL(W20),BIN2 RECORD LENGTH MOVE NOREC,BCDI21(W2) SAVE NO. OF RECS MOVE BIN1,=W'52' CBNE STR1A,=C'L',COP684 JUMP IF NOT L-FILE XCOPY PBLOCK,BIN1,W2,BPOOL(W20),W8 MON + SOP MOVE BIN7,BCDI21(W2) NO. OF SECTORS CALL WXDIV,BIN7,W16,BIN7 PROGRAM USES 240 BYTES MOVE BCDI21(W1),BIN7 PER SECTOR SUB BCDI21(W2),BCDI21(W1) MOVE BCDI21(W3),BCDI21(W2) SAVE NO OF RECORDS MOVE BIN1,BCDI21(W2) CALL WXDIV,BIN1,W4,BIN1 GET PROGRAM LENGTH MOVE BCDI21(W2),BIN1 MOVE BIN1,=W'54' MOVE BCDI21(W1),BCDI21(W2) IF REMAINDER EXISTS => MUL BCDI21(W1),=D'+4' => YET ANOTHER CBE BCDI21(W1),BCDI21(W3),COP683 SECTOR IS NEEDED. ADD BCDI21(W2),=D'+1' COP683 CALL BCDBIN,BCDI21(W2),BIN10,BIN11 XCOPY PBLOCK,BIN1,W2,BIN11,W0 PROGRAM LENGTH B COP687 COP684 CALL WXMUL,BIN4,BIN3,BIN4 MOVE BIN6,BIN4 MOVE BIN5,W0 COP685 MOVE BIN7,BUFLEN ASSUME BUFFER LENGTH 255 CBE STR1A,=C'S',COP686 WHICH IS TRUE FOR 'S'-... CBE STR1A,=C'D',COP686 ...'D'-...AND... CBE STR1A,=C'I',COP686 ...'I'-FILES (DATA MANAGM.). MOVE BIN7,SECLEN OTHERS USE SECTOR LENGTH 256 BYTES. COP686 ADD BIN5,W1 SUB BIN6,BIN7 BP COP686 MOVE BIN1,BCDI21(W2) CALL WXDIV,BIN1,BIN5,BIN1 CALL WXDIV,BIN4,BIN3,BIN4 MOVE BCD5A,BIN4 CALL WXMUL,BIN1,BIN4,BIN1 MOVE BCDI21(W2),BIN1 CALL BCDBIN,BCDI21(W2),BIN10,BIN11 MOVE BIN1,=W'52' XCOPY PBLOCK,BIN1,W2,BIN10,W0 NO. OF RECORDS MOVE BIN1,=W'54' XCOPY PBLOCK,BIN1,W2,BIN11,W0 NO. OF RECORDS MOVE BIN1,=W'56' XCOPY PBLOCK,BIN1,W2,W0,W0 KA MOVE BIN1,=W'58' XCOPY PBLOCK,BIN1,W2,W0,W0 NIF COP687 CALL CREFIL,PBLOCK,BPOOL(W12),BPOOL(W1),RETCOD CMP RETCOD,W0 'I/O-ERROR' BNZ COP543 CBE FCOD1,FCOD2,COP688 CALL OPENF,DISK,FILECODE(W1),SYSBUF,FILNAM,VOLEX1,RETCOD B COP689 COP688 CALL OPENF,DISK,FILECODE(W1),SYSBUF,FILNAM,VOLEX2,RETCOD COP689 BNOK COP543 CALL OPENF,DISK,FILECODE(W3),SYSBUF,COPFIL,VOLEX2,RETCOD BNOK COP698 COP690 MOVE RECNUM,=D'+1' XCOPY BIN10,W0,W2,BPOOL(W20),W20 SAVE LRN XCOPY BIN11,W0,W2,BPOOL(W20),W22 COP692 CALL CHANFC,DISK,FCOD1 CALL READDK,DISK,FILECODE(W1),BPOOL(W1),SECLEN,RECNUM,RETCOD BNOK COP696 CALL CHANFC,DISK,FCOD2 CALL WRITDK,DISK,FILECODE(W3),BPOOL(W1),SECLEN,RECNUM,RETCOD BNOK COP696 CBE RECNUM,NOREC,COP693 ADD RECNUM,=D'+1' B COP692 COP693 CALL BINBCD,BIN10,BIN11,NOREC GET LRN INTO NOREC CALL CHANFC,DISK,FCOD1 CALL CLOSEF,DISK,FILECODE(W1),RBUF,NOREC,RETCOD BOK COP694 MOVE NOREC,=D'00' CALL CHANFC,DISK,FCOD1 CALL CLOSEF,DISK,FILECODE(W1),RBUF,NOREC,DEBINW4 B COP543 COP694 CALL CHANFC,DISK,FCOD2 CALL CLOSEF,DISK,FILECODE(W3),RBUF,NOREC,RETCOD BNOK COP543 PERF CHVNAM,COPNAM,FCOD2 CHANGE NAME BNOK COP546 CBE FCOD1,FCOD2,COP695 PERF CHVNAM,VOLNAM,FCOD1 CHANGE NAME BNOK COP546 COP695 B COP000 COP696 MOVE NOREC,=D'00' CALL CHANFC,DISK,FCOD2 CALL CLOSEF,DISK,FILECODE(W3),RBUF,NOREC,DEBINW4 COP698 MOVE NOREC,=D'00' CALL CHANFC,DISK,FCOD1 CALL CLOSEF,DISK,FILECODE(W1),RBUF,NOREC,DEBINW4 B COP543 EJECT COP700 ************************ * COPY WSM SYSTEM-FILE * ************************ ATTFMT FCOPW SET DEPROMPT SET BOOL2 COP710 PERF DECLRA COP720 IB DEBINW2,COP710,COP000,COP730 PERF DSKERR,W0 'BELL' B COP720 COP730 MOVE NOREC,=D'00' PERF CHVNAM,VOLEX1,FCOD1 CHANGE NAME BNOK COP737 PERF CHVNAM,VOLEX2,FCOD2 CHANGE NAME BNOK COP734 CBE FCOD1,FCOD2,COP731 CALL OPENF,DISK,FILECODE(W1),SYSBUF,FILNAM,VOLEX1,RETCOD B COP732 COP731 CALL OPENF,DISK,FILECODE(W1),SYSBUF,FILNAM,VOLEX2,RETCOD COP732 BOK COP738 COP733 PERF CHVNAM,COPNAM,FCOD2 CHANGE NAME BNOK COP737 COP734 PERF CHVNAM,VOLNAM,FCOD1 CHANGE NAME COP737 PERF DSKERR,W12 'FILE NAME UNKNOWN' B COP720 COP738 CALL OPENF,DISK,FILECODE(W3),SYSBUF,COPFIL,VOLEX2,RETCOD BNOK COP733 WSM FILE NOT CREATED CALL CLOSEF,DISK,FILECODE(W3),RBUF,NOREC,RETCOD BNOK COP733 EJECT ******************************************************* ** ATTACH FORMAT - PERFORM INPUT (WHOLE FILE (Y/N/S) ** ******************************************************* ATTFMT FCOPA COP739 SET DEPROMPT COP740 PERF DECLRA COP741 IB DEBINW2,COP740,COP810,COP742 PERF DSKERR,W0 'BELL' B COP741 COP742 CBNE COPY,='S',COP746 BRANCH IF NOT "SPECIFIC" **************************************************** ** COPY SPECIFIC SECTION/DEFINITION/TFP-FORMAT ** **************************************************** ATTFMT FCOPC ATTACH FORMAT 'TYPE & NAME' SET DEPROMPT COP743 ERASE 2,W1,W2 ERASE INPUT FIELDS PERF DECLRN COP744 IB DEBINW2,COP743,COP810,COP745 PERF DSKERR,W0 'BELL' B COP744 COP745 XCOPY RBUF,W0,W1,ANSW,W0 COPY TYPE TO RBUF XCOPY RBUF,W1,W6,STR6B,W0 COPY NAME TO RBUF MOVE BIN1,W0 B COP792 COP746 EJECT **************************************************** ** COPY ELEMENT BY ELEMENT ** **************************************************** MOVE BIN12,=X'0101' SET LINE/COL ERASE 0,W1,W1 ERASE LINE 01 MOVE DTEST,=C'D' 1. 'D' WSM DEFINITIONS 2. 'F' TFP FORMS 3. 'S' WSM SECTIONS COP747 MOVE BIN5,W10 START OF FIRST CHAIN COP748 MOVE RECNUM,BIN5 READ A CHAINRECORD COP749 CALL CHANFC,DISK,FCOD1 CALL READDK,DISK,FILECODE(W1),RBUF,SECLEN,RECNUM,RETCOD BOK COP751 PERF DISERR COP750 IB DEBINW2,COP740,COP810,COP749 PERF DSKERR,W0 'BELL' B COP750 COP751 MOVE BIN1,W14 DISP TO FIRST ENTRY MOVE BIN2,W24 NO. OF ENTRIES COP752 MOVE BIN3,W0 MATCH DTEST,BIN3,W1,RBUF,BIN1,W1 LOOK IF SAME TYPE BNOK COP795 NO * CBE COPY,=C'N',COP754 * ATTFMT FHEX 83-06-22 / MAER * B COP792 COP754 MOVE BIN4,BIN1 ADD BIN4,W1 DISP TO NAME XCOPY STR6B,W0,W6,RBUF,BIN4 CBE COPY,=C'N',COP756 BRANCH IF ONE BY ONE PERF DISPYE DISPLAY WHEN ANSWER 'YES' B COP792 COP756 CBE DTEST,=C'S',COP758 CBE DTEST,=C'F',COP757 TFP FORMS ATTFMT FCOPD B COP760 COP757 ATTFMT FCOPFO B COP760 COP758 ATTFMT FCOPS COP760 SET DEPROMPT COP780 ERASE 2,W2,W2 ERASE ANSWER PERF DECLRN COP785 IB DEBINW2,COP780,COP810,COP790 PERF DSKERR,W0 'BELL' B COP785 COP790 CBNE ANSW,=C'Y',COP795 NOT THIS ONE COP792 XCOPY PBLOCK,W5,W7,RBUF,BIN1 TYPE AND NAME CALL GETIND,BPOOL(W1),BIN7,BIN6 XCOPY PBLOCK,W14,W2,BIN6,W0 MOVE BIN6,=W'26' XCOPY PBLOCK,BIN6,W8,FILNAM,W0 ADD BIN6,W8 XCOPY PBLOCK,BIN6,W6,VOLEX1,W0 SEND DEFAULT VOL = VOLEX1 CBNE FCOD1,FCOD2,COP793 DIFF. UNITS => BRANCH XCOPY PBLOCK,BIN6,W6,VOLEX2,W0 ELSE USE UNIT 2 TEMP NAME COP793 CALL PREAD,PBLOCK,BPOOL(W1) WSM-READ BNOK COP794 XCOPY PBLOCK,W5,W7,RBUF,BIN1 TYPE AND NAME XCOPY PBLOCK,W12,W1,W2,W1 FILECODE MOVE BIN6,=W'26' XCOPY PBLOCK,BIN6,W8,COPFIL,W0 ADD BIN6,W8 XCOPY PBLOCK,BIN6,W6,VOLEX2,W0 DEST. VOLUME IS ALWAYS VOLEX2 CALL PWRITE,PBLOCK,BPOOL(W1) WSM-WRITE BOK COP795 COP794 XCOPY RETCOD,W0,W2,PBLOCK,W20 PERF UFERR CBNE COPY,='S',COP785 BRANCH IF NOT "SPECIFIC" B COP744 COP795 CBNE COPY,='S',COP796 COPY "SPECIFIC" ? B COP743 -YES COP796 SUB BIN2,W1 NO, DECREASE NO. OF ENTRIES BZ COP800 ALL HANDLED ADD BIN1,W10 TAKE NEXT B COP752 COP800 XCOPY BIN10,W0,W2,RBUF,W2 LINK NEXT XCOPY BIN11,W0,W2,RBUF,W4 CALL BINBCD,BIN10,BIN11,RECNUM CBNE BIN11,W0,COP801 LINK FWD CBE BIN10,W0,COP802 COP801 B COP749 COP802 ADD BIN5,W1 MOVE BIN6,=W'26' CBE BIN5,BIN6,COP805 B COP748 COP805 CBE DTEST,=C'S',COP810 CBE DTEST,=C'F',COP807 MOVE DTEST,=C'F' B COP808 COP807 MOVE DTEST,=C'S' COP808 B COP747 COP810 MOVE NOREC,=D'00' CALL CHANFC,DISK,FCOD1 CALL CLOSEF,DISK,FILECODE(W1),RBUF,NOREC,RETCOD BNOK COP816 CALL CHANFC,DISK,FCOD2 CALL CLOSEF,DISK,FILECODE(W3),RBUF,NOREC,RETCOD * BNOK COP818 83-06-20 CALL PCLOSE,PBLOCK,BPOOL(W1) PERF CHVNAM,VOLNAM,FCOD1 CHANGE NAME BNOK COP737 PERF CHVNAM,COPNAM,FCOD2 CHANGE NAME BNOK COP737 COP815 B COP000 COP816 MOVE NOREC,=D'00' CALL CHANFC,DISK,FCOD2 CALL CLOSEF,DISK,FILECODE(W3),RBUF,NOREC,DEBINW4 COP818 B COP733 PEND EJECT DISPYE PROC DSC1 DEDSSCRN,6,BIN12 SET CURSOR EDWRT DEDSSCRN,FINFO WRITE LINE ADD BIN12,SECLEN LINE := LINE + 1 CBL BIN12,=X'1901',DISP50 BRANCH IF LINE < 25 XCOPY BIN12,W0,W1,W1,W1 LINE := 01 ADD BIN12,W11 COL := COL + 11 CBL BIN12,=X'014A',DISP50 BRANCH IF COL < 74 PAGE IS FULL: MOVE BIN12,=X'0101' LINE/COL := 0101 DISP50 RET PEND EJECT **************** * FINFO FRMT FSL FATTR .HIGH FCOPY DTEST FTAB 3 FCOPY STR6B FMEND FCOPY FRMT FSL FATTR .HIGH FATTR .INV FCOPY =C'COPY ' FCOPY =C'VOLUME/FILE' FNL FATTR .HIGH FTEXT 'TYPE OF COPY:' FKI 14,MINL=1,MAXL=1,ME,NEOI,ALPHA,APPL=8 FCOPY STR1A FNL FATTR .HIGH FTEXT 'V = VOLUME' FNL FATTR .HIGH FTEXT 'F = FILE' FNL FATTR .HIGH FTEXT 'W = WSM SYSTEM-FILE' FTAB 21 FTEXT '(MAX SIZE OF ONE SECTION: ' FMEL 'ZZ9',NOOFPO FTAB 51 FTEXT 'SECTORS)' FMEND * FCOPV FRMT FSL FATTR .HIGH FATTR .INV FCOPY =C'COPY VOLUME TO VOLUME' FLINK FIO FMEND * FCOPF FRMT FSL FATTR .HIGH FATTR .INV FTEXT 'COPY FILE TO FILE' FLINK FIO FMEND * FCOPW FRMT FSL FATTR .HIGH FATTR .INV FTEXT 'COPY AND REORGANIZE WSM SYSTEM FILE' FLINK FIO FMEND * FCOPA FRMT FSL FATTR .HIGH FCOPY =C'WHOLE FILE ? Y/N/S:' FKI 21,MINL=1,MAXL=1,ME,NEOI,ALPHA,APPL=1 FCOPY COPY FLINK FHEX FMEND * FCOPD FRMT FSL FATTR .HIGH FCOPY =C'COPY DEFINITION:' FATTR .INV FINP 17 FCOPY STR6B FLINK FANSW FMEND * FCOPS FRMT FSL FATTR .HIGH FCOPY =C'COPY SECTION:' FATTR .INV FINP 14 FCOPY STR6B FLINK FANSW FMEND * FCOPFO FRMT FSL FATTR .HIGH FCOPY =C'COPY FORMAT:' FATTR .INV FINP 13 FCOPY STR6B FLINK FANSW FMEND FCOPT FRMT FSL FATTR .HIGH FTEXT 'COPY TABLE T' FATTR .INV FINP 14 FMEL '999',BCD3A FLINK FANSW FMEND * FCOPC FRMT FSL FATTR .HIGH FATTR .INV FCOPY =C'COPY SPECIFIC:' FNL FATTR .HIGH FCOPY =C'TYPE:' FKI 6,MINL=1,MAXL=1,ME,NEOI,ALPHA FCOPY ANSW FATTR .HIGH FTAB 8 FATTR .HIGH FCOPY =C'NAME:' FKI 13,MINL=1,MAXL=6,ME,NEOI,ALPHA,APPL=18 FCOPY STR6B FLINK FHEX FMEND FANSW FRMT FNL FATTR .HIGH FCOPY =C'Y/N' FKI 5,MINL=1,MAXL=1,ME,NEOI,ALPHA,APPL=1 FCOPY ANSW FMEND * FIO FRMT FNL FATTR .HIGH FCOPY =C'INPUT' FATTR .HIGH FTAB 7 FCOPY =C'UNIT:' FKI 12,MINL=3,MAXL=3,ME,ALPHA,NEOI,APPL=9 FCOPY INUNIT FATTR .HIGH FTAB 20 FCOPY =C'VOLUME-NAME:' FINP 33 FCOPY VOLNAM FBF BOOL2,FIODD FATTR .HIGH FTAB 42 FCOPY =C'FILENAME:' FKI 51,MINL=1,MAXL=8,ME,NEOI,REWRT,ALPHA,APPL=6 FCOPY FILNAM FIODD FNL FATTR .HIGH FCOPY =C'OUTPUT' FATTR .HIGH FTAB 8 FCOPY =C'UNIT:' FKI 13,MINL=3,MAXL=3,ME,ALPHA,NEOI,REWRT,APPL=10,DUPL=INUNIT FCOPY UTUNIT FATTR .HIGH FTAB 20 FCOPY =C'VOLUME-NAME:' FINP 33 FCOPY COPNAM FBF BOOL2,FIOD2 FATTR .HIGH FTAB 42 FCOPY =C'FILENAME:' FKI 51,MINL=1,MAXL=8,ME,NEOI,REWRT,ALPHA,APPL=6,DUPL=FILNAM FCOPY COPFIL FIOD2 FLINK FHEX FMEND * FHEX FRMT FNL FKI 1,MINL=0,MAXL=0 FCOPY HEX00 FMEND * END