|
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: 11054 (0x2b2e)
Notes: pts_type(SC)
Names: »REMTXT.SC«
└─⟦75255755f⟧ Bits:30009693 Philips computer tape "600410"
└─⟦this⟧ »NJREMIT/REMTXT.SC«
└─⟦b6546aa17⟧ Bits:30009689 Philips computer tape "600325"
└─⟦this⟧ »REMIT2/REMTXT.SC«
IDENT REMTXT 03.01.XXX.1 DDUM KMD08 PDIV ENTRY TXTPRT ENTRY TXTOPR ENTRY TXTRD ENTRY REPL00 ENTRY SETKEY ENTRY GENWRF ENTRY GENWRS ENTRY SKIP EXT FMTREM EXT SPCLRN EXT ABORT EXT RAWRIT EXT RAREAD EXT SPCLRA EXT SPLIN8 EXT WAITF EJECT TXTPRT PROC ************************************ * THE PROCEDURE LISTS TEXTREGISTER, * EITHER COMPLETELY OR SELECTED PORTIONS * ON THE SPECIFIED DATASET ************************************ TBT CTEXTFLG,TXTL015 B TXTLRET TXTREG DOES NOT EXIST TXTL015 MOVE GTLINE,=W'48' SIZE OF PRINT PAGE PERF FMTREM,CBIN1 TXTPDU CLEAR GTSWFLAG MOVE GSWBCD3,=D'1' FROM TXTNR MOVE GSWBCD4,=D'999' TO TXTNR MOVE GSWBCD5,=D'2' DEFAULT HARDCOPY DEVICE PERF SPCLRN IB SPBINW2,TXTLRET,TXTLRET,TXTL020 B TXTL015 * PRINT HEADER ON HARDCOPY DEVICE TXTL020 CBE GSWBCD5,=D'1',TXTL050 HCDEV ? SET GTSWFLAG PERF GENWRF,CBIN3,TXTHDR B TXTL060 TXTL050 SUB GTLINE,CBIN4 PERF GENWRF,GTHCDEV,TXTHDR B TXTL060 * READ NEXT TEXTRECORD TXTL060 TXTL070 MOVE GSWBIN7,GSWBCD3 PERF TXTRD,GSWBIN7 BNOK TXTL200 CBE GTWBCD1,=D'4',TXTL130 DELETED ? CBNE GTWBCD1,=D'10',TXTL090 B TXTL195 TXTL090 * WRITE TEXTRECORD CBL GTTXTTKO,=D'1',TXTL135 DELETED? MOVE GSWBIN1,GSWBCD5 MOVE GTWBCD1,GSWBCD3 IB GSWBIN1,TXTL100,TXTL110 TXTL100 CLEAR GTSWFLAG PERF GENWRF,GTHCDEV,TXTPR SUB GTLINE,CBIN2 CBG GTLINE,CBIN0,TXTL135 IB GTHCDEV,TXTL101,TXTL109 TXTL101 PERF GENWRF,GTHCDEV,TXTFF0 B TXTL109 TXTL102 PERF GENWRF,GTHCDEV,TXTFF2 B TXTL109 TXTL109 MOVE GTLINE,=W'48' SIZE OF PRINT PAGE SUB GTLINE,CBIN4 CLEAR GTSWFLAG ADD GSWBCD3,=D'1' PERF GENWRF,GTHCDEV,TXTHDR SUB GSWBCD3,=D'1' B TXTL135 TXTL110 SET GTSWFLAG INDICATE TALLY PERF GENWRF,CBIN3,TXTPR TXTL130 TXTL135 PERF SPLIN8,CBIN0,CBIN0 TESTIO KEYB BOK TXTL150 CALL ABORT,KEYB TXTL140 ADD GSWBCD3,=D'1' NEXT RECORD CBG GSWBCD3,GSWBCD4,TXTL195 B TXTL070 TXTL150 TEST FOR MAK-KEY WAIT KEYB CBNE SPBINW2,CBIN6,TXTL140 TXTL195 PERF SKIP TXTLRET CMP CBIN0,CBIN0 OK, RETURN RET TXTL200 PERF SKIP CMP CBIN1,CBIN0 NOT OK RET PEND EJECT SKIP PROC CLEAR GTSWFLAG MOVE GSWBIN1,GSWBCD5 IB GSWBIN1,SKIP20,SKIP10 B SKIP90 SKIP10 PERF GENWRF,CBIN3,TXTFF1 TALLY B SKIP90 SKIP20 IB GTHCDEV,SKIP21,SKIP22 B SKIP90 SKIP21 PERF GENWRF,GTHCDEV,TXTFF1 GTP B SKIP90 SKIP22 PERF GENWRF,GTHCDEV,TXTFF2 LP B SKIP90 SKIP90 RET PEND EJECT * TXTOPR PROC ********************************* * * THE PROCEDURE MAINTAINS TEXTREGISTER. * ********************************** TXTO000 TBF CTEXTFLG,TXTO990 MOVE SPKEY,CBIN2 SET GTSWFLAG SET SPPROMPT PERF FMTREM,CBIN2 TXTVEDL PERF SPCLRA CBNE SPBINW2,CBIN3,TXTO980 MOVE GSWBIN8,GSWBCD1 PERF TXTRD,GSWBIN8 BNOK TXTO910 CBE GTWBCD1,=D'10',TXTO910 END MEDIUM CLEAR GTSWFLAG PERF SPCLRN CBNE SPBINW2,CBIN3,TXTO000 TXTO030 PERF TXTWR,GSWBIN8 BNOK TXTO910 NOK B TXTO000 TXTO980 CLEAR GTSWFLAG TXTO990 PERF SETKEY CMP CBIN0,CBIN0 OK RET TXTO910 CLEAR GTSWFLAG PERF SETKEY CMP CBIN4,CBIN0 RET PEND EJECT REPL00 PROC STRG,LEN ************************************ * * THE PROCEDURE REPLACES HEX-ZEROES * BY SPACES, IN ANY STRINGFIELD. * THIS IS ACCOMPLISHED BY FINDING * THE FIRST 00-BYTE, COMPUTING * THE LENGTH OF THE REST OF THE * FIELD, AND DELETING THIS REST. * ************************************ MOVE GSWBIN7,LEN MOVE GSWBIN1,CBIN0 MOVE GSWSTR1,=X'00' MATCH STRG,GSWBIN1,GSWBIN7,GSWSTR1,CBIN0,CBIN1 BNE REPL10 NO MATCH FOUND SUB GSWBIN7,GSWBIN1 DLETE STRG,GSWBIN1,GSWBIN7 CMP CBIN0,CBIN0 RET REPL10 CMP CBIN4,CBIN0 RET PEND * TXTUNP PROC XCOPY GTTXTTKO,CBIN0,CBIN2,CTXBUF,CBIN0 XCOPY GTLEVTXT,CBIN0,CBIN22,CTXBUF,CBIN2 MOVE GSWSTR2,CTXBUF CBNE GSWSTR2,=C' ',TXTU10 MOVE GTTXTTKO,=D'0' TXTU10 RET PEND * TXTPAK PROC XCOPY CTXBUF,CBIN0,CBIN2,GTTXTTKO,CBIN0 MOVE GSWBIN1,CBIN22 PERF REPL00,GTLEVTXT,GSWBIN1 XCOPY CTXBUF,CBIN2,CBIN22,GTLEVTXT,CBIN0 CBNL GTTXTTKO,=D'1',TXTPRET MOVE GTLEVTXT,CBLANKS XCOPY CTXBUF,CBIN2,CBIN22,GTLEVTXT,CBIN0 TXTPRET RET PEND EJECT GENWRF PROC DSET,$FRMT PFRMT $FRMT IB DSET,WRT10,WRT20,WRT30 WRT10 TBF GTGTPFLG,WRT90 EDWRT DSHCGP,$FRMT B WRT90 WRT20 TBF GTLPFLG,WRT90 EDWRT DSHCLP,$FRMT B WRT90 WRT30 TBF GTTTPFLG,WRT90 EDWRT KTALLY,$FRMT B WRT90 WRT90 RET PEND GENWRS PROC DSET,STRG IB DSET,WRS10,WRS20,WRS30 WRS10 TBF GTGTPFLG,WRS90 EDWRT DSHCGP,STRG B WRS90 WRS20 TBF GTLPFLG,WRS90 EDWRT DSHCLP,STRG B WRS90 WRS30 TBF GTTTPFLG,WRS90 EDWRT KTALLY,STRG B WRS90 WRS90 RET PEND EJECT TXTRD PROC BIN * * THE PROCEDURE READS THE TEXT, SPECIFIED * IN THE PARAMETER * PERF WAITF,CTXTFLG MOVE GSWBIN1,=W'24' LENGTH MOVE CTXBUF,CBLANKS PERF RAREAD,DK06,=D'6',CTXBUF,GSWBIN1,BIN BNOK TXT098 CBE GTWBCD1,=D'10',TXT098 END OF FILE PERF TXTUNP MOVE GSWBIN1,CBIN0 CLEAR CTXTFLG CMP CBIN0,CBIN0 B TXT099 TXT098 CLEAR CTXTFLG CMP CBIN0,CBIN1 TXT099 RET PEND EJECT TXTWR PROC BIN PERF WAITF,CTXTFLG PERF TXTPAK PERF RAWRIT,DK06,=D'6',CTXBUF,BIN BNOK TXTW095 CLEAR CTXTFLG CMP CBIN0,CBIN0 B TXTW099 TXTW095 CLEAR CTXTFLG CMP CBIN0,CBIN1 TXTW099 RET PEND SETKEY PROC ***************************************** * * SETS SPKEY TO 1 IF KASSE OPEN, * ELSE SETS SPKEY TO 2 * ***************************************** MOVE SPKEY,CBIN1 CBG CMASK(TTASKNR),=D'0',SETKRET MOVE SPKEY,CBIN2 CLOSED SETKRET RET PEND EJECT TXTHDR FRMT FILLR '1',2 FCOPY =C'UDSKRIFT ' FCOPY =C'AF ' FCOPY =C'TEKST ' FCOPY =C'FIL' FILLR ' ',2 FBF GTSWFLAG,TXTH10 FNL TXTH10 FILLR ' ',8 FMEL '99E-99E-99',CMASKDAT FNL FCOPY =C'FRA/TIL NR ' FILLR ' ',4 FMEL 'ZZ9',GSWBCD3 FILLR '-',1 FMEL 'ZZ9',GSWBCD4 FILLR ' ',2 FNL FMEND * * * TXTPR FRMT FNL FNL FMEL '999',GTWBCD1 FILLR ' ',1 FMEL 'ZZZ',GTTXTTKO FBF GTSWFLAG,TXTPRT05 -, REGNERULLE ? FILLR ' ',16 FNL FB TXTPRT10 TXTPRT05 FILLR ' ',5 TXTPRT10 FCOPY GTLEVTXT FILLR ' ',1 FMEND * * * TXTFF0 FRMT FNL FNL FNL FNL FMEND * * * TXTFF1 FRMT FLINK TXTFF0 FLINK TXTFF0 FNL FMEND * * * TXTFF2 FRMT FILLR '1',2 FMEND * * * * END