|
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: 7870 (0x1ebe)
Notes: pts_type(SC)
Names: »DCCONV.SC«
└─⟦5c22ed822⟧ Bits:30009675 Philips computer tape "600209"
└─⟦this⟧ »DEN10/DCCONV.SC«
IDENT DCCONV NJ-AMT 830224/EV BATCH TRANSMISSION DDUM DEDDIV PDIV ENTRY DCSGON ENTRY DCSGOF ENTRY DCSEND * EJECT * * KEYTABLE * CLR EQU X'8F' CLEAR CAN EQU X'91' CANCEL RET EQU X'98' RETURN ENT EQU X'8C' ENTER * KEYTAB KTAB CLR,CAN,RET,ENT * * STIMO EQU X'0B' ATTACH EQU X'0E' DETACH EQU X'0F' TRPAR EQU X'00' EJECT * * THIS MODULE CONTAINS SUBROUTINES TO BE USED * IN THE BATCH TRANSMISSION * CALLED FROM MODULE DECONV EJECT * * DCSGON SEND SIGNON * * BRUGERNAVN BCDI21(6?) * KENDEORD BCDI21(7)? * DCSGON PROC EDSUB DCBUF,REQDC,SIGONF INSERT SIGN ON PERF EXCHAN DCEXCHANGE RET RET 2 PEND EJECT * * DCSGOF SEND SIGN OFF * * DCSGOF PROC EDSUB DCBUF,REQDC,SIGOFF PERF EXCHAN RET RET 2 PEND EJECT DCSEND PROC FC,TYPE,RETCON * * SEND DCDATA IB BTYPE,DCSNDON,DCSNDST,DCSNDDA,DCSNDSL,DCSNDOF * DCSNDDA SEND DATA MOVE DCWRK,REQDC PREV DATA ADD DCWRK,BIN4 NEW DATA CBNG DCWRK,REQLEN,DCSNDDA2 PERF EXCHAN B DCSNDDA2 OK, SEND, NO ROOM PERF TERMIN NOK B DCSNDNOK DCSNDDA2 ROOM FOR MORE EDSUB DCBUF,REQDC,SNDFRM5 XCOPY DCBUF,REQDC,BIN4,BPOOL(BIN10),W0 COPY DATA ADD REQDC,BIN4 SET NEW LENGTH B DCSNDOK * DCSNDON DCSNDST DCSNDSL DCSNDOF CBL REQDC,W6,DCSND4 MOVE BTYPE,W3 PERF EXCHAN ALREADY DATA IN BUFFER B DCSND4 SEND THEM SEND PREV AS DATA PERF TERMIN FILL AGAIN B DCSNDNOK SEND AS NEW TYPE???? DCSND4 MOVE BTYPE,TYPE RESET BTYPE EDSUB DCBUF,REQDC,SNDFRM5 XCOPY DCBUF,REQDC,BIN4,BPOOL(BIN10),W0 COPY ADD REQDC,BIN4 SET LENGTH PERF EXCHAN B DCSNDOK PERF TERMIN B DCSNDNOK * DCSNDOK RET DCSNDNOK RET 2 PEND EJECT * * EXCHAN * DCEXCHANGE AND CHECK RESPONSE DEPENDING ON TYPE * OF DATA, HEAD, DATA, BALANCE * EXCHAN PROC MOVE DCWRK,W1 DSC1 DSDCFD,STIMO,DCWRK MOVE BIN7,W1 READ DSDCFD,STR8A,BIN7 DUMMY READ MOVE DCWRK,=W'600' TIME OUT DSC1 DSDCFD,STIMO,DCWRK TIME OUT WRITE DSDCFD,DCBUF,REQDC BNOK EXCHNOK MOVE REQDC,REQLEN SET MAX LENGTH MOVE DCWRK,=W'600' TIME OUT DSC1 DSDCFD,STIMO,DCWRK TIME OUT READ DSDCFD,DCBUF,REQDC BNOK EXCHNOK * * CHECK RESPONSE * IB BTYPE, C EXCHANON, C EXCHANST, C EXCHANDA, C EXCHANSL, C EXCHANOF * EXCHANON AFTER SIGN ON PERF WRDC PRINT ANSWER MOVE STR8A,=C'DFH3504' LOOK FOR MOVE BIN7,W0 CORRECT RESPONSE MATCH DCBUF,BIN7,REQDC,STR8A,W0,W7 BNE EXCHNOK B EXCHOK * EXCHANST AFTER START RECORD EXCHANDA AFTER DATA RECORD MOVE STR8A,=X'1B3543' ERASE/WRITE MOVE BIN7,W0 MATCH DCBUF,BIN7,REQDC,STR8A,W0,W3 BNE EXCHNOK B EXCHOK * EXCHANSL AFTER SLUTD PERF WRDC PRINT ANSWER MOVE STR8A,=C'0002' MOVE BIN7,W0 MATCH DCBUF,BIN7,REQDC,STR8A,W0,W4 BNE EXCHNOK B EXCHOK * EXCHANOF AFTER SIGN OFF PERF WRDC PRINT ANSWER B EXCHOK * * EXCHOK MOVE DCBUF,=C' ' INITIALISE DCBUFFER MOVE REQDC,W0 TO X'2020272020 ' EDSUB DCBUF,REQDC,SNDFRM2 RET * EXCHNOK RET 2 PEND EJECT *SEND TERMINATE TERMIN PROC IB BTYPE, C TERMON, C TERMST, C TERMDA, C TERMSL, C TERMOF * TERMDA AFTER DATA TERMSL AFTER SLUTD MOVE BTYPE,W5 AS SIGN OFF MOVE BPOOL(BIN13),=C'TERMINATE ' MOVE BIN4,W10 MOVE DCBUF,=C' ' MOVE REQDC,W0 EDSUB DCBUF,REQDC,SNDFRM5 XCOPY DCBUF,REQDC,BIN4,BPOOL(BIN10),W0 ADD REQDC,BIN4 NEW LENGTH PERF EXCHAN B TERMRET * TERMON TERMST TERMOF B TERMRET TERMRET RET PEND EJECT WRDC PROC PRINT RECEIVED DC BUFFER CBL REQDC,W1,WRDCRET NO MESSAGE CBG REQDC,REQLEN,WRDCRET TOO LONG * CHECK IF APPLICATION OR CICS MESSAGE MOVE BIN13,WORK(W13) GET FIRST BUFFER ADD BIN13,W2 MOVE STR8A,=C'DFH' MOVE BIN7,W0 MATCH DCBUF,BIN7,REQDC,STR8A,W0,W3 BE WRDC100 CICS MESSAGE * * APPLICATION MESSAGE4 * * LOOK FOR 'SBA' 'ADR' 'ADR' MOVE STR8A,=X'11' 'SBA' MOVE BIN7,W0 MATCH DCBUF,BIN7,REQDC,STR8A,W0,W1 BNE WRDCRET NO SBA * ADD BIN7,W3 BYPASS SBA SEQUENSE MOVE DCWRK,BIN7 SUB REQDC,DCWRK ADJUST LENGTH CBL REQDC,W1,WRDCRET NO DATA LEFT WRDC05 MOVE BPOOL(BIN13),=X'00' CLEAR BUFFER MATCH DCBUF,DCWRK,REQDC,STR8A,W0,W1 LOOK FOR NEXT SBA BNE WRDC10 SUB DCWRK,BIN7 DCWRK=LENGTH COPY BPOOL(BIN13),W0,DCWRK,DCBUF,BIN7 EDWRT DEDSPRT,WRDCFRM ADD DCWRK,W3 BYPASS SBA SEQUENCE SUB REQDC,DCWRK ADJUST LENGTH ADD DCWRK,BIN7 RESET POINTER MOVE BIN7,DCWRK CBG REQDC,W3,WRDC05 NEXT LINE B WRDCRET END * WRDC10 LAST LINE B WRDC200 * * CICS MESSAGE * WRDC100 SUB REQDC,BIN7 ADJUST LENGTH (FROM 'DFH') CBL REQDC,=W'112',WRDC200 LAST LINE MOVE DCWRK,=W'80' MOVE STR8A,=C' ' MATCH DCBUF,DCWRK,W32,STR8A,W0,W1 FIND SPACE IN LAST 32 CHARS BNE WRDC200 MOVE BPOOL(BIN13),=X'00' CLEAR PRINT BUFFER SUB DCWRK,BIN7 DCWRK=LENGTH COPY BPOOL(BIN13),W0,DCWRK,DCBUF,BIN7 EDWRT DEDSPRT,WRDCFRM PRINT LINE SUB REQDC,DCWRK ADJUST LENGTH ADD BIN7,DCWRK * WRDC200 LAST LINE MOVE BPOOL(BIN13),=X'00' CLEAR PRINT BUFFER CBL REQDC,=W'112',WRDC210 MOVE REQDC,=W'112' MAX LENGTH WRDC210 COPY BPOOL(BIN13),W0,REQDC,DCBUF,BIN7 EDWRT DEDSPRT,WRDCFRM * WRDCRET RET PEND EJECT * * FORMATS * * SIGONF FRMT FTEXT 'CSSN PS=' FMEL '9999',BCDI21(W6) FTEXT ',NAME=' FMEL 'AAAAAAAAAAAAAAAAAAA9',BCDI21(W7) FMEND * SIGOFF FRMT FTEXT C'CSSF ' FMEND * SNDFRM2 FRMT FILLR ' ',2 FCOPY =X'272020' FMEND * SNDFRM5 FRMT FCOPY =X'112020' FMEND * WRDCFRM FRMT FILLR ' ',2 FCOPY BPOOL(BIN13) FMEND * END