|
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: 14554 (0x38da)
Notes: pts_type(SC)
Names: »WUPRF.SC«
└─⟦f45ea3bc3⟧ Bits:30009713 Philips computer tape "WSM"
└─⟦this⟧ »WSM:UTIL/WUPRF.SC«
IDENT WUPRF REL=2.3,841001,870155940230 ************************************** * WORK STATION MANAGEMENT * * UTILITY PROGRAMS * * 6 PRINT FILE * * * ************************************** ** HISTORY: ** 83-06-30/MAER UFERR INTRODUCED AS ERROR-ROUTINE AFTER P&F-HANDLER CALLS. ** FILES NOW CLOSED AS MANY TIMES AS OPENED. ** OPEN: 1. OPENF 2. 1ST PREAD ** CLOSE: 1. CLOSEF 2. PCLOSE ** 83-06-22/MAER "RETURN" ALLOWED WHEN NEW PAGE. ** 83-05-11/MAER CHANGED DECORATIONS. ** 82-11-29/MAER PAGING ON VD82 SOLVED. ** 82-11-04/MAER INCREASED ITEM FOR SECTION SIZE. DDUM WUDIV PDIV ENTRY WUPRF * EXPROC DECLRA CRE= SCREEN ROUTINE EXPROC DECLRN EXPROC DERR CRE= ERROR ROUTINE EXPROC DISERR EXPROC UFERR EXPROC DSKERR,PBIN EXPROC DERROR,PKTAB EXPROC CHVNAM,PSTRG,PBIN CRE= CHANGE VOLUMENAME PARAM: NEW NAME, F.C. EXPROC HALT * EXT RDSECT ASS= READ A SECTOR EXT PRINTF ASS= PRINT FILE EXT BINBCD ASS= TWO BINARY ITEMS TO BCD EXT BCDBIN ASS= BCD TO TWO BINARY ITEMS EXT OPENF ASS= OPEN FILE EXT CLOSEF ASS= CLOSE FILE EXT READDK ASS= READ A RECORD EXT CHANFC ASS= CHANGE FILECODE EXT PREAD ASS= WSM-READ EXT PCLOSE ASS= WSM-CLOSE EXT GETIND ASS= GET DIMENSION EXT EMPTYT ASS= CHECK IF EMPTY ITEM EXT RCGET ASS= GET RETURN-CODE INCLUDE WULIT,LIST EJECT WUPRF PROC ****************** * 6 PRINT FILE * ****************** TBT BOOL1,PRF050 B PFCONT PRF050 ATTFMT FUPRINT SET DEPROMPT PRF100 PERF DECLRA PRF150 IB DEBINW2, C PRF100, CANC, C RETUR, RETUR, C PRF200 ENTER PERF DSKERR,W0 'BELL' B PRF150 PRF200 MOVE BIN5,W0 NO. OF EXTENTS MOVE BCDI21(W3),=D'00' USED FOR START RECNO PRF210 MOVE BCDI21(W2),=D'00' USED FOR NO. OF RECS MOVE BIN1,W0 SECTOR NO. CALL RDSECT,DISK,BIN1,SYSBUF,RETCOD READ VOLUME-LABEL BNOK PRF550 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 PRF220 CALL RDSECT,DISK,BIN1,SYSBUF,RETCOD READ ONESECTOR BNOK PRF550 MOVE BIN4,W0 DISP TO FILENAME PRF240 MOVE BIN3,W0 MATCH FILNAM,BIN3,W8,SYSBUF,BIN4,W8 BOK PRF300 FILENAME FOUND PRF260 ADD BIN4,DKBIN3 GET NEXT VTOC ENTRY CBL BIN4,=W'240',PRF240 ALL ENTRIES HANDLED SUB DKBIN2,W1 MORE VTOC RECORDS BNZ PRF280 YES PERF DSKERR,W12 B PRF150 PRF280 ADD BIN1,W1 READ NEXT VTOC RECORD B PRF220 PRF300 MOVE BIN2,BIN4 BIN4 -> FILENAME ADD BIN2,W10 BIN2 -> FEN XCOPY BIN3,W0,W2,SYSBUF,BIN2 BIN2 := FEN CBNE BIN3,BIN5,PRF260 BIN5 = WANTED EXTENT ADD BIN2,W2 BIN2 -> FEL XCOPY BIN10,W0,W2,SYSBUF,BIN2 BIN10 := FEL ADD BIN2,W2 BIN2 -> FEL XCOPY BIN11,W0,W2,SYSBUF,BIN2 BIN11 := FEL CALL BINBCD,BIN10,BIN11,BCDI21(W4) ADD BCDI21(W4),BCDI21(W3) CBNG NOREC,BCDI21(W4),PRF340 ADD BIN5,W1 MOVE BCDI21(W3),BCDI21(W4) B PRF210 PRF340 XCOPY PBLOCK,W6,W1,FCOD2,W1 FC3= FILECODE PRINTER XCOPY PBLOCK,W7,W1,FCOD,W1 FC4= FILECODE DISKIN ADD BIN2,W2 DISP TO START SECTOR XCOPY BIN10,W0,W2,SYSBUF,BIN2 ADD BIN2,W2 XCOPY BIN11,W0,W2,SYSBUF,BIN2 CALL BINBCD,BIN10,BIN11,BCDI21(W1) SUB BCDI21(W1),BCDI21(W3) SUB NOREC,=D'+1' ADD BCDI21(W1),NOREC GET FROM SECTOR.NO. CALL BCDBIN,BCDI21(W1),BIN10,BIN11 XCOPY PBLOCK,W10,W2,BIN10,W0 FROM SECTORNUMBER XCOPY PBLOCK,W12,W2,BIN11,W0 XCOPY PBLOCK,W14,W2,BIN10,W0 TO SECTORNUMBER XCOPY PBLOCK,W16,W2,BIN11,W0 CALL PRINTF,PBLOCK,BPOOL(W5),BPOOL(W10),RETCOD CBE RETCOD,W0,PRF600 PRF550 PERF DISERR B PRF150 PRF600 CBNE FCOD2,SCRNFC,PRF620 PRINTER PERF HALT PRF620 ADD NOREC,=D'+1' CBE RECNUM,NOREC,PRF700 ADD NOREC,=D'+1' B PRF300 PRF700 SET DEPROMPT THOME PERF DECLRN B PRF150 EJECT * * PRINT FILE TABLE OF CONTENTS * PFCONT ATTFMT FUPRINT SET DEPROMPT SET BOOL2 PFC100 PERF DECLRA IB DEBINW2,PFC100,RETUR * * START OF FIRST CHAIN * - BIN14 = STARTLINE OF PAGE (1 OR 6) * - BIN15 = PAGE-SIZE (24 OR 44) * ATTFMT FHEX THOME PERF CHVNAM,VOLEX1,FCOD CHANGE NAME TO TEMP. BNOK PFC132 CALL OPENF,DISK,FILECODE(W1),SYSBUF,FILNAM,VOLEX1,RETCOD CALL CHANFC,DEDSPRT,FCOD2 ---CHANGE OUTPUT DEVICE MOVE BCD13A,W1 PAGE NO:=1 MOVE BIN9,W64 LINE-COUNTER:=HIGH-VALUE MOVE BIN5,W10 START OF FIRST CHAIN MOVE BIN12,W0 NUMB OF OCC SECTORS:=0 EJECT * * NEXT CHAIN * PFC120 MOVE RECNUM,BIN5 READ A CHAINRECORD PFC130 CALL CHANFC,DISK,FCOD1 CALL READDK,DISK,FILECODE(W1),RBUF,SECLEN,RECNUM,RETCOD BOK PFC140 PFC132 MOVE STR6A,HEX00 CALL RCGET,RETCOD,STR6A MOVE DEBINW4,W22 PERF DERROR,DEKTAB4 IB DEBINW2,PFC135,PFC210,PFC210 PFC135 CBNE FCOD2,SCRNFC,PFC130 PERF CURSET ***SET CURSER AFTER ERROR B PFC130 * * INITIATE FOR FIRST ENTRY * PFC140 MOVE BIN10,W14 DISP TO FIRST ENTRY MOVE BIN11,W24 NO. OF ENTRIES EJECT * * NEXT ENTRY * PFC150 MOVE BIN4,BIN10 XCOPY DTEST,W0,W1,RBUF,BIN4 LOAD TYPE ADD BIN4,W1 DISP TO NAME XCOPY STR6B,W0,W6,RBUF,BIN4 CALL EMPTYT,STR6B ---CHECK IF EMPTY ITEM BNOK PFC190 JMP IF EMPTY ADD BIN4,W7 XCOPY BIN16,W0,W2,RBUF,BIN4 LOAD SECTOR NUMBER MOVE BCD5A,BIN16 CONVERT SECTOR TO BCD PFC155 XCOPY PBLOCK,W5,W7,RBUF,BIN10 TYPE AND NAME CALL GETIND,BPOOL(W1),BIN7,BIN6 XCOPY PBLOCK,W14,W2,BIN6,W0 MOVE BIN6,W26 XCOPY PBLOCK,BIN6,W8,FILNAM,W0 ADD BIN6,W8 XCOPY PBLOCK,BIN6,W6,VOLEX1,W0 CALL PREAD,PBLOCK,BPOOL(W1) WSM-READ. NOTE: OPEN-FILE 1ST TIME! BOK PFC170 XCOPY RETCOD,W0,W2,PBLOCK,W20 PERF UFERR IB DEBINW2,PFC160,PFC170,PFC210 PFC160 CBNE FCOD2,SCRNFC,PFC155 PERF CURSET ***SET CURSER AFTER ERROR B PFC155 EJECT * * PRINT OUT EDITING * PFC170 MOVE BIN16,W0 WORKITEM:=0 XCOPY BIN16,W1,W1,BPOOL(W1),W18 LOAD SIZE BINARY ADD BIN12,BIN16 ADD NUMB OF OCC SECTORS MOVE BCD4A,BIN16 CONVERT SIZE BCD MOVE BIN16,W0 WORKITEM:=0 CBE DTEST,=C'D',PFC175 JMP IF DEFINITION XCOPY BIN16,W1,W1,BPOOL(W1),W22 LOAD VERSION BINARY PFC175 MOVE BCD3A,BIN16 CONVERT VERSION BCD PFC180 PERF PRINT,FPCHEAD,FPCDET, ***PRINT ONE LINE C BIN9,BIN15,BIN14,W2 IB DEBINW2,PFC185,PFC210,PFC210, CLR,CAN,RET,CFW C PFC185 B PFC190 PFC185 CBNE FCOD2,SCRNFC,PFC180 PERF CURSET ***SET CURSOR AFTER ERROR B PFC180 EJECT * * NEXT ENTRY OR NEXT CHAIN * PFC190 SUB BIN11,W1 NO. OF ENTRIES BZ PFC200 ALL HANDLED ADD BIN10,W10 TAKE NEXT B PFC150 * * CHANGE FOR NEXT CHAIN RECORD * PFC200 XCOPY BIN1,W0,W2,RBUF,W2 LINK NEXT XCOPY BIN2,W0,W2,RBUF,W4 CALL BINBCD,BIN1,BIN2,RECNUM CBNE BIN2,W0,PFC130 LINK FWD CBNE BIN1,W0,PFC130 ADD BIN5,W1 MOVE BIN6,W26 CBE BIN5,BIN6,PFC205 B PFC120 PFC205 MOVE BCD5A,BIN12 LOAD NUMB OF OCC SECTORS BCD ADD BIN9,W1 INCREMENT LINE NUMBER PERF PRINT,FPCHEAD,FPCTOT, ***PRINT ONE LINE C BIN9,BIN15,BIN14,W2 CBNE FCOD2,SCRNFC,PFC210 JMP IF NOT VDU PERF HALT ***HALT WHEN VDU EJECT * * END OF FREE SPACE CHAIN * PFC210 MOVE NOREC,=D'00' MOVE FCOD2,=X'0036' DEFAULT OUTPUT DEVICE CALL CHANFC,DEDSPRT,FCOD2 ---CHANGE OUTPUT DEVICE CALL CHANFC,DISK,FCOD1 PFC220 CALL CLOSEF,DISK,FILECODE(W1),RBUF,NOREC,RETCOD * BOK PFC220 DELETED 83-06-30 CALL PCLOSE,PBLOCK,BPOOL(W1) PERF CHVNAM,VOLNAM,FCOD CHANGE NAME TO ORIGIN B PFCONT RETUR RET PEND EJECT * * SET CURSOR AFTER ERROR-MESSAGE * CURSET PROC MOVE BIN16,BIN9 LOAD CURRENT LINE NO SUB BIN16,W1 ADJUST XCOPY BIN16,W0,W1,BIN16,W1 LINE:=ADJUSTED LINENO XCOPY BIN16,W1,W1,W1,W1 COLUMN:=1 DSC1 DEDSPRT,6,BIN16 SET CURSOR RET PEND EJECT * * THIS ROUTINE PRINT ONE LINE ON THE LINE PRINTER. * THE FORMAT OF THE LINE IS DECIDED OF THE * PARAMETER 'LINE'. IF PAGE OVERFLOW OCCURS, * THE HEADER FORMAT WILL BE PRINTED OUT. HEADER * FORMAT IS DECIDED OF THE PARAMETER * 'HEADER'. * * INPUT PARAMETERS: HEADER = HEADER FORMAT * LINE = LINE FORMAT * LINENO = ACTUAL LINE NUMBER * LINMAX = MAXIMUM NUMBER OF LINES IN ONE P * LINEST = LINE START VALUE * HLINES = NUMBER OF LINES IN HEADER * OUTPUT VARIABLE : DEBINW2 = 0 OK * (= 1 CLEAR-KEY, TRY AGAIN) * = 2 CANCEL-KEY * = 3 RET-KEY * ************************************************************************ PRINT PROC HEADER,LINE,LINENO,LINMAX,LINEST,HLINES PFRMT HEADER PFRMT LINE PBIN LINENO PBIN LINMAX PBIN LINEST PBIN HLINES MOVE DEBINW2,W0 CLEAR ERROR-SIGNAL EJECT CBNG LINENO,LINMAX,PRI300 JUMP IF LINMAX NOT REACHED CBNE FCOD2,SCRNFC,PRI100 JMP IF NOT VDU PERF HALT ***HALT IF VDU SUB BIN2,W1 BIN2 HOLDES KEY INDEX: BZ PRI100 1 = ENTER => PROCEED MOVE DEBINW2,W3 2 = RETURN B PRI999 PRI100 EDWRT DEDSPRT,FORMF FORM-FEED=NEW PAGE EDWRT DEDSPRT,HEADER PRINT HEADER BNOK PRI350 JUMP IF NOT OK PRI200 ADD BCD13A,=D'+1' INCREMENT PAGENR MOVE LINENO,LINEST REINSTATE LINENUMBER ADD LINENO,HLINES ADJUST FOR HEADLINES PRI300 EDWRT DEDSPRT,LINE PRINT DETAIL-LINE BOK PRI400 JUMP IF OK PRI350 MOVE DEBINW4,W3 PRINTER NOT OPERABLE PERF DERROR,DEKTAB4 ***(ERROR-)MESSAGE ROUTINE B PRI999 JUMP ON CLR, CANC OR RET-KEY PRI400 ADD LINENO,W1 INCREMENT LINE-NUMBER MOVE DEBINW2,W0 OK PRI999 RET PEND EJECT * FUPRINT FRMT FSL FATTR .HIGH FATTR .INV FCOPY =C'PRINT FILE TABLE OF CONTENTS' FNL FATTR .HIGH FCOPY =C'UNIT:' FKI 6,MINL=3,MAXL=3,ME,ALPHA,NEOI,APPL=5 FCOPY INUNIT FATTR .HIGH FTAB 12 FCOPY =C'VOLUME-NAME:' FINP 25 FCOPY VOLNAM FNL FATTR .HIGH FCOPY =C'FILENAME:' FKI 10,MINL=1,MAXL=8,ME,REWRT,APPL=16,ALPHA,NEOI FCOPY FILNAM FBF BOOL1,FUP100 FNL FNL FATTR .HIGH FCOPY =C'FROM RECORD NO.:' FKI 17,MINL=1,MAXL=5,ME,NEOI,REWRT,APPL=4 FROM RECORD FMEL 'TTTTX',NOREC FNL FATTR .HIGH FCOPY =C'TO RECORD NO.:' FKI 17,MINL=1,MAXL=5,ME,NEOI,REWRT,APPL=4 TO RECORD FMEL 'TTTTX',RECNUM FNL FUP100 FNL FATTR .HIGH FTEXT 'PRINT OUTPUT DEVICE:' FKI 21,MINL=2,MAXL=2,ME,ALPHA,REWRT,NEOI,APPL=11 FCOPY STR2A FMEND FHEX FRMT FSL FKI 1 FCOPY HEX00 FMEND EJECT * * HEADER LINE * FPCHEAD FRMT FTEXT ' +' PRINT WITHOUT ADVANCING FCOPY =C'PRINT FILE TABLE OF CONTENTS' FILLR ' ',1 FCOPY ='FILE:' FCOPY FILNAM FTEXT ' ON VOLUME:' FCOPY VOLNAM FTEXT ' PAGE:' FMEL 'ZZ9',BCD13A PAGE NO FEOR FLINK FPCRUB FMEND EJECT * * RUBRIK LINE * FPCRUB FRMT FILLR ' ',2 FTEXT 'NAME TYPE SIZE VERSION SECTOR' FMEND * * DETAIL LINE * FPCDET FRMT FILLR ' ',2 FCOPY STR6B FTAB 13 FCOPY DTEST TYPE FTAB 16 FMEL 'ZZ9',BCD4A SIZE FTAB 24 FMEL 'ZZZ',BCD3A VERSION NUMBER FTAB 31 FMEL 'ZZ9',BCD5A SECTOR NUMBER FMEND EJECT * * TOTAL LINE * FPCTOT FRMT FILLR ' ',2 FEOR FILLR ' ',2 FTEXT 'OCCUPIED SECTORS:' FTAB 27 FMEL 'ZZZVZZ9',BCD5A NUMB OF OCC SECTORS FMEND * * FORM FEED * FORMF FRMT FTEXT ' 1' FMEND END