|
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: 11122 (0x2b72)
Notes: pts_type(SC)
Names: »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 TXTUNP ENTRY TXTPAK ENTRY TXTOPR ENTRY REPL00 ENTRY SETKEY EXT FRMTXT EXT FMTREM EXT SPCLRN EXT ABORT EXT RAWRIT EXT RAREAD EXT SPCLRA EXT SPLIN8 EJECT TXTPRT PROC ************************************ * * THE PROCEDURE LISTS TEXTREGISTER, * EITHER COMPLETELY OR SELECTED PORTIONS * ON THE SPECIFIED DATASET * ************************************ TXTL010 TBT CTEXTFLG,TXTL015 B TXTLRET TXTL015 MOVE GTLINE,CPGSIZE 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 GENWRT,CBIN3,TXTHDR B TXTL060 TXTL050 SUB GTLINE,CBIN4 PERF GENWRT,GTHCDEV,TXTHDR B TXTL060 * READ NEXT TEXTRECORD TXTL060 TXTL070 TBF CTXTFLG,TXTL080 CONTINUE IF BUFFER AVAILABLE DELAY CBIN1 ELSE WAIT 0.1 SEC B TXTL070 TXTL080 SET CTXTFLG INDICATE BUFFER OCCUPIED MOVE GSWBIN7,GSWBCD3 MOVE GSWBIN1,=W'24' MOVE CTXBUF,=C' ' PERF RAREAD,DK06,=D'6',CTXBUF,GSWBIN1,GSWBIN7 BNOK TXTL200 CBE GTWBCD1,=D'4',TXTL130 DELETED ? CBNE GTWBCD1,=D'10',TXTL090 CLEAR CTXTFLG B TXTL195 TXTL090 * WRITE TEXTRECORD PERF TXTUNP CBE GTTXTTKO,=D'0',TXTL135 DELETED ? MOVE GSWBIN1,GSWBCD5 MOVE GTWBCD1,GSWBCD3 IB GSWBIN1,TXTL100,TXTL110 TXTL100 CLEAR GTSWFLAG PERF GENWRT,GTHCDEV,TXTPR SUB GTLINE,CBIN2 CBG GTLINE,CBIN0,TXTL135 IB GTHCDEV,TXTL101,TXTL109 TXTL101 PERF GENWRT,GTHCDEV,TXTFF0 B TXTL109 TXTL102 PERF GENWRT,GTHCDEV,TXTFF2 B TXTL109 TXTL109 MOVE GTLINE,CPGSIZE SUB GTLINE,CBIN4 CLEAR GTSWFLAG ADD GSWBCD3,=D'1' PERF GENWRT,GTHCDEV,TXTHDR SUB GSWBCD3,=D'1' B TXTL135 TXTL110 SET GTSWFLAG INDICATE TALLY PERF GENWRT,CBIN3,TXTPR TXTL130 CLEAR CTXTFLG 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 CLEAR CTXTFLG PERF SKIP CMP CBIN1,CBIN0 NOT OK RET PEND * * SKIP PROC CLEAR GTSWFLAG MOVE GSWBIN1,GSWBCD5 IB GSWBIN1,SKIP20,SKIP10 B SKIP90 SKIP10 PERF GENWRT,CBIN3,TXTFF1 TALLY B SKIP90 SKIP20 IB GTHCDEV,SKIP21,SKIP22 B SKIP90 SKIP21 PERF GENWRT,GTHCDEV,TXTFF1 GTP B SKIP90 SKIP22 PERF GENWRT,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 TXTO010 TBF CTXTFLG,TXTO020 BUFFER AVAILABLE ? DELAY CBIN1 ELSE WAIT 0.1 SEC B TXTO010 TXTO020 SET CTXTFLG MOVE GSWBIN8,GSWBCD1 MOVE GSWBIN1,=W'24' MOVE CTXBUF,CBLANKS PERF RAREAD,DK06,=D'6',CTXBUF,GSWBIN1,GSWBIN8 BNOK TXTO910 CBE GTWBCD1,=D'10',TXTO910 END MEDIUM PERF TXTUNP CLEAR GTSWFLAG PERF SPCLRN CBNE SPBINW2,CBIN3,TXTO000 TXTO030 TBF CTXTFLG,TXTO040 DELAY CBIN1 B TXTO030 TXTO040 SET CTXTFLG PERF TXTPAK PERF RAWRIT,DK06,=D'6',CTXBUF,GSWBIN8 BNOK TXTO910 NOK TXTO920 CLEAR CTXTFLG B TXTO000 TXTO980 CLEAR GTSWFLAG TXTO990 PERF SETKEY CMP CBIN0,CBIN0 OK RET TXTO910 CLEAR CTXTFLG 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 CLEAR CTXTFLG RET PEND * TXTPAK PROC XCOPY CTXBUF,CBIN0,CBIN2,GTTXTTKO,CBIN0 MOVE GSWBIN1,CBIN22 PERF REPL00,GTLEVTXT,GSWBIN1 XCOPY CTXBUF,CBIN2,CBIN22,GTLEVTXT,CBIN0 CBNE GTTXTTKO,=D'0',TXTPRET MOVE GTLEVTXT,CBLANKS XCOPY CTXBUF,CBIN2,CBIN22,GTLEVTXT,CBIN0 TXTPRET RET PEND * GENWRT 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 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 AF TEKSTFIL' FILLR ' ',3 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 FNL FNL FNL FNL FNL FNL FNL FNL FNL FMEND * * * TXTFF2 FRMT FILLR '1',2 FMEND * * * * END