|
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: 15590 (0x3ce6)
Notes: pts_type(SC)
Names: »ADM6.SC«
└─⟦38a30a456⟧ Bits:30009662 Philips computer tape "600104"
└─⟦this⟧ »OD-KOM/ADM6.SC«
└─⟦d2cdd233a⟧ Bits:30009674 Philips computer tape "600204"
└─⟦this⟧ »OD-KOM/ADM6.SC«
IDENT ADM6 831005 EV DDUM KMD08 PDIV ENTRY ADM600 ENTRY SIGNON ENTRY CHNGDK ENTRY STRTRC ENTRY SENDRC ENTRY TERMIN ENTRY SIGNOF ENTRY EXCHAN ENTRY TRNOK ENTRY WJDC * EXT SPCLRS EXT SLUTID EXT RAWRIT EXT WRITID EXT LAMPOF EXT ADMRET EXT SPERR EXT CLSVOL EXT LAMPON EXT SOPRD EXT ASGVOL EXT ASGFIL EXT BCKUP EXT RAREAD EXT GETBIT EXT WRITJT * INCLUDE EQUATE EJECT ADM600 MOVE GSWBIN1,CBIN0 DSC1 DCOMM,TRPAR,GSWBIN1 SET CCONVFLG CLEAR SPKEYFLG TEST GTKASSE BNZ ADM06RET CMP TTASKNR,CBIN1 MASTER ? BNE ADM06RET NO CMP CTASKNR,CBIN0 ALL CLOSED BNE ADM06RET SET SPPROMPT MOVE SPKEY,CBIN2 ATTFMT SNDFRM6 PERF SPCLRS IB SPBINW2,ADM06RET,ADM06RET,ADM0610 B ADM600 ADM0610 MOVE GSWBIN1,=X'40' DSC1 DCOMM,TRPAR,GSWBIN1 ADM0611 SET SPPROMPT ATTFMT SNDFRM PERF SPCLRS IB SPBINW2,ADM0612,ADM0612,ADM0615 B ADM0611 ADM0612 B ADM600 ADM0615 TBT CCONVERT,ADM0613 SUB CRECBCD,=D'1' PERF SLUTID,CPCKBUF,CRECBCD ADD CRECBCD,=D'1' PERF RAWRIT,DK02,=D'2',CPCKBUF,CRECNR BNOK ADM600 PERF WRITID,CPCKBUF,CBIN5,CBIN2 SLUTID ON JOURNAL ADM0613 ************************************************** * BATCH TRANSMISSION * 1) SIGNON * 2) CHANGE DISK * 3) SEND STARTIDENT * 4) SEND TRANSACTIONS AND SLUTID * 5) IN CASE OF ERROR SEND TERMINATE * 6) WHEN ALL TRANSMITTED SEND SIGNOFF ************************************************* PERF SIGNON BNOK ADM06OUT ADM0620 PERF LAMPOF,=W'2047' ADM0630 PERF CHNGDK CHANGE DISC BNOK ADM6SOFF PERF STRTRC SEND STARTIDENT BNOK ADM0630 IF NOT OK, TRY NEXT PERF SENDRC SEND BATCH BOK ADM0620 IF NOT OK PERF TERMIN SEND TERMINATE PERF LAMPOF,=W'2047' PERF LAMPON,=W'2' LAMP 10, ERROR B ADM0630 ADM6SOFF PERF SIGNOF SEND SIGNOFF ADM06OUT MOVE CTRANBUF,=X'00' CLEAR TR 12 COUNTERS MOVE GSWBIN1,CBIN0 DSC1 DCOMM,TRPAR,GSWBIN1 ADM06RET CLEAR CCONVFLG SET SPKEYFLG PERF LAMPOF,=W'2047' B ADMRET EJECT ************************************************ * * SIGNON * IF NOT OK CR NOT = 0 * ************************************************ SIGNON PROC MOVE GSWBIN1,CBIN5 MOVE GSWBIN2,=W'50' MOVE CTRANBUF,=C' ' EDIT CTRANBUF,SIGONF * FIND LENGTH MATCH CTRANBUF,GSWBIN1,GSWBIN2,CBLANKS,CBIN0,CBIN2 MOVE GSWBIN2,GSWBIN1 TBT CTESTFLG,SIGON10 PERF EXCHAN EXCHANGE DC BNOK SIGON100 PERF WJDC MOVE GSWSTR20,=C'DFH3504' MOVE GSWBIN1,CBIN0 MATCH CTRANBUF,GSWBIN1,GSWBIN2,GSWSTR20,CBIN0,CBIN7 BNE SIGON100 SIGON10 EDWRT SCREEN,SNDFRM3 CMP CBIN0,CBIN0 RET SIGON100 MOVE SPBINW4,CBIN21 MOVE GTWBCD2,=D'60' MOVE GSWSTR9,=C'TRANSMIT ' MOVE GTWBCD1,=D'16' PERF SPERR PERF WRITJT,=W'14' CMP CBIN0,CBIN1 RET PEND EJECT ********************************************* * * CHNGDK - CHANGE DISK * STOP SEND PIN 6 * CONTINIUE PIN 5 * ********************************************* CHNGDK PROC CHNG000 PERF CLSVOL,CBIN2 CLOSE REGSET MOVE CRECNR,CBIN1 MOVE CRECBCD,=D'1' PERF LAMPON,=W'64' LAMP 5 PERF LAMPON,=W'32' LAMP 6 PERF LAMPON,=W'16' LAMP 7 CHNG010 PERF SOPRD IB GSWBIN2, C CHSOP10,CHSOP09,CHSOP08,CHSOP07,CHSOP06, C CHSOP05,CHSOP04,CHSOP03,CHSOP02,CHSOP01 CHSOP01 CHSOP02 CHSOP03 CHSOP04 CHSOP08 CHSOP09 B CHNG010 CHSOP10 * ERROR, SIGN ON AGAIN PERF LAMPOF,=W'2047' LAMPS OFF PERF LAMPON,=W'2' LAMP 10 SET SPPROMPT ATTFMT SNDFRM SIGNON FORMAT PERF SPCLRS IB SPBINW2,CH1010,CH1010,CH1020 CH1010 B CHNG000 CH1020 PERF SIGNON BNOK CHNG000 PERF LAMPOF,=W'2047' B CHNG000 CHSOP05 PERF LAMPOF,=W'2047' LAMPS OFF PERF ASGFIL,CBIN2 ASSIGN DISK 2 BOK CHNG050 PERF LAMPON,=W'2' B CHNG000 CHNG050 PERF LAMPON,=W'64' LAMP 5 CMP CBIN0,CBIN0 SET CR RET CHSOP06 SOP 6 PERF LAMPOF,=W'2047' LAMPS OFF PERF BCKUP,=W'1' WITHOUT BACKUP BNOK CHNG000 B CHNG130 CHSOP07 PERF LAMPOF,=W'2047' LAMPS OFF PERF BCKUP,=W'2' WITH BACKUP BNOK CHNG000 B CHNG130 CHNG130 PERF LAMPOF,=W'2047' CMP CBIN0,CBIN1 INDICATE ERROR OR END OF TRANS RET PEND EJECT ****************************************** * * STRTRC - SEND OF STARTIDENT * AND CHECK REPLY * ******************************************* STRTRC PROC PERF LAMPOF,=W'2047' PERF LAMPON,=W'64' MOVE GSWBIN6,CBIN1 MOVE GSWBIN1,=W'128' PERF RAREAD,DK02,=D'2',CPCKBUF,GSWBIN1,GSWBIN6 BNOK STRTRET CBE GTWBCD1,=D'4',STRTRET RECORD DELETED? PERF WRITID,CPCKBUF,CBIN5,CBIN1 MOVE GSWBIN6,CBIN0 MOVE GSWBIN1,=W'40' MOVE GSWSTR20,CBLANKS COPY CPCKBUF,GSWBIN1,CBIN20,GSWSTR20,GSWBIN6 MOVE CTRANBUF,=C' ' EDIT CTRANBUF,SNDFRM2 MOVE GSWBIN2,=W'31' LENGTH PERF EXCHAN EXCHANGE DC BNOK STRTRET PERF TRNOK CHECK IF OK BNOK STRTRET CMP CBIN0,CBIN0 SET CR RET STRTRET CMP CBIN0,CBIN1 RET PEND EJECT ********************************************** * * SENDRC - SEND BATCH UNTIL SLUTID * ********************************************** SENDRC PROC MOVE CRECNR,CBIN1 SND005 MOVE GSWBIN3,CBIN0 PACKPOINTER SND010 ADD CRECNR,CBIN1 MOVE GSWBIN1,=W'128' PERF RAREAD,DK02,=D'2',CPCKBUF,GSWBIN1,CRECNR BNOK SNDERR CMP GTWBCD1,=D'4' BE SNDERR RECORD DELETED ? MOVE GSWSTR20,=C'SLUTD' MOVE GSWBIN5,CBIN0 MATCH GSWSTR20,GSWBIN5,CBIN5,CPCKBUF,CBIN0,CBIN5 BE SNDSLUT MOVE GSWSTR9,=X'7F' FIND LENGTH SND015 MOVE GSWBIN4,CBIN0 MOVE GSWBIN5,=W'128' MATCH CPCKBUF,GSWBIN4,GSWBIN5,GSWSTR9,CBIN0,CBIN1 BE SND020 MOVE GSWSTR9,=X'21' B SND015 SND020 ADD GSWBIN4,GSWBIN3 SEE IF MORE SPACE CBNG GSWBIN4,=W'504',SND030 SUB CRECNR,CBIN1 NO MORE SPACE B SND040 SEND BUFFER SND030 SUB GSWBIN4,GSWBIN3 RESTORE ADD GSWBIN4,CBIN1 FILL WITH X'00' CBE GSWBIN4,=W'128',SND037 MOVE GSWSTR20,=X'00' MOVE GSWBIN5,=W'128' SND035 INSRT CPCKBUF,GSWBIN4,CBIN20,GSWSTR20,CBIN0 SUB GSWBIN5,CBIN20 CBG GSWBIN5,GSWBIN4,SND035 ALL TRAILING FILLED SND037 EDSUB CTRANBUF,GSWBIN3,SNDFRM5 INSERT RECORD B SND010 READ NEXT SND040 MOVE GSWBIN2,GSWBIN3 MOVE SPBINW1,=X'0301' MOVE TTARKSAV,CRECNR DSC1 SCREEN,POS,SPBINW1 EDWRT .NW,SCREEN,SNDFRM4 DISPLAY RECNR PERF EXCHAN BNOK SNDERR PERF TRNOK BNOK SNDERR B SND005 SNDSLUT CBE GSWBIN3,CBIN0,SND090 REQ.LGTH.=0 ? MOVE GSWBIN2,GSWBIN3 PERF EXCHAN EXCHANGE DC BNOK SNDERR PERF TRNOK BNOK SNDERR SND090 MOVE GSWBIN3,CBIN0 MOVE CTRANBUF,=C' ' EDSUB CTRANBUF,GSWBIN3,SNDFRM5 MOVE GSWBIN2,CBIN18 PERF EXCHAN BNOK SNDERR PERF WRITID,CPCKBUF,CBIN5,CBIN2 PERF WJDC PRINT ANSWER TBT CTESTFLG,SNDSL10 MOVE GSWSTR9,=C'0002' MOVE GSWBIN1,CBIN0 MOVE GSWBIN2,=W'52' MATCH CTRANBUF,GSWBIN1,GSWBIN2,GSWSTR9,CBIN0,CBIN4 BNE SNDERR SNDSL10 CMP CBIN0,CBIN0 RET SNDERR CMP CBIN1,CBIN0 RET PEND EJECT ******************************************** * * TERMIN - TERMINATE TRANSMISSION IN CASE OF ERROR * ******************************************** TERMIN PROC MOVE GSWBIN3,CBIN0 MOVE CTRANBUF,=C' ' MOVE CPCKBUF,=C'TERMINATE ' MOVE GSWBIN3,CBIN0 EDSUB CTRANBUF,GSWBIN3,SNDFRM2 MOVE GSWBIN2,CBIN14 PERF EXCHAN EXCHANGE DC BNOK TERMRET PERF WJDC TERMRET RET PEND EJECT ********************************************* * * SIGNOFF * ********************************************* SIGNOF PROC MOVE GSWBIN3,CBIN0 MOVE CTRANBUF,=C' ' MOVE CPCKBUF,=C'CSSF ' EDSUB CTRANBUF,GSWBIN3,SNDFRM2 MOVE GSWBIN2,CBIN9 PERF EXCHAN BNOK SIGOFRET TBT CTESTFLG,SIGOFRT1 PERF WJDC PRINT ANSWER SIGOFRET RET SIGOFRT1 CMP CBIN0,CBIN0 RET PEND EJECT ********************************************* * EXCHAN - EXCHANGE DC * IN CASE OF ERROR ERRORMESSAGE * IS SHOWN ON SCREEN AND JOURNAL ********************************************* EXCHAN PROC TBT CTESTFLG,EXCHTEST EXCH10 MOVE GSWBIN5,CBIN1 MOVE GSWBIN1,=W'504' DCREAD DCOMM,CDUMBUF,GSWBIN1,GSWBIN5 BOK EXCH10 IF ANYTIBNG RCVD, THROW AWAY MOVE GSWBIN5,=W'900' TIMEOUT DCWRITE DCOMM,CTRANBUF,GSWBIN2,GSWBIN5 BNOK EXCHNOK MOVE GSWBIN2,=W'504' MOVE GSWBIN5,=W'900' TIMEOUT DCREAD DCOMM,CTRANBUF,GSWBIN2,GSWBIN5 BOK EXCHRET EXCHNOK PERF GETBIT,DCOMM FETCH ERRORCODE MOVE SPBINW4,CBIN21 MOVE GTWBCD2,=D'60' MOVE GSWSTR9,=C'TRANSMIT ' PERF SPERR PERF WRITJT,=W'14' CMP CBIN0,CBIN1 RET EXCHTEST MOVE CTRANBUF,=X'1B3543' DELAY CBIN20 EXCHRET CMP CBIN0,CBIN0 RET PEND EJECT ********************************************* * * TRNOK - CHECK IF MESSAGE CORRECT RECIEVED * ********************************************* TRNOK PROC MOVE GSWBIN3,CBIN0 MOVE GSWSTR9,=X'1B3543' =EBCDIC 27F5C3 MATCH CTRANBUF,GSWBIN3,GSWBIN2,GSWSTR9,CBIN0,CBIN3 BNE TRNERR MOVE GSWBIN2,CBIN0 MOVE CTRANBUF,=C' ' CMP CBIN0,CBIN0 RET TRNERR MOVE GTWBCD2,=D'60' MOVE GSWSTR9,=C'TRANSMIT ' MOVE GTWBCD1,=D'50' PERF SPERR PERF WRITJT,=W'14' CMP CBIN0,CBIN1 RET PEND EJECT ************************************************* * * WJDC - PRINT RECEIVED MESSAGE ON JOURNAL * ************************************************* WJDC PROC WAIT KTALLY CBL GSWBIN2,CBIN1,WJDCRET CBG GSWBIN2,=W'504',WJDCRET MOVE GSWSTR9,=C'DFH' MOVE GSWBIN1,CBIN0 MATCH CTRANBUF,GSWBIN1,GSWBIN2,GSWSTR9,CBIN0,CBIN3 BE WJDC100 CICS MESSAGE * * APLICATION MESSAGE * MOVE GSWSTR9,=X'11' MOVE GSWBIN1,CBIN0 MATCH CTRANBUF,GSWBIN1,GSWBIN2,GSWSTR9,CBIN0,CBIN1 BNE WJDCRET * GSWBIN1=START ADD GSWBIN1,CBIN3 BYPASS SBA SEQUENSE MOVE GSWBIN4,GSWBIN1 SUB GSWBIN2,GSWBIN4 ADJUST LENGTH CBL GSWBIN2,CBIN1,WJDCRET WJDC005 MOVE CPCKBUF,=X'00' MATCH CTRANBUF,GSWBIN4,GSWBIN2,GSWSTR9,CBIN0,CBIN1 BNE WJDC010 SUB GSWBIN4,GSWBIN1 GSWBIN4 = LENGTH CBNG GSWBIN4,=W'52',WJDC007 MOVE GSWBIN4,=W'52' MAX 52 CHARS COPY CPCKBUF,CBIN0,GSWBIN4,CTRANBUF,GSWBIN1 EDWRT KJTAPE,WJDCFRM B WJDC008 WJDC007 COPY CPCKBUF,CBIN0,GSWBIN4,CTRANBUF,GSWBIN1 EDWRT KJTAPE,WJDCFRM ADD GSWBIN4,CBIN3 WJDC008 SUB GSWBIN2,GSWBIN4 ADD GSWBIN4,GSWBIN1 MOVE GSWBIN1,GSWBIN4 CBG GSWBIN2,CBIN3,WJDC005 B WJDCRET WJDC010 B WJDC200 WJDCRET RET * WJDC100 SUB GSWBIN2,GSWBIN1 CBL GSWBIN2,=W'52',WJDC200 MOVE GSWBIN4,=W'30' FIND BLANK ADD GSWBIN4,GSWBIN1 MATCH CTRANBUF,GSWBIN4,CBIN22,CBLANKS,CBIN0,CBIN1 BNE WJDC200 MOVE CPCKBUF,=X'00' SUB GSWBIN4,GSWBIN1 COPY CPCKBUF,CBIN0,GSWBIN4,CTRANBUF,GSWBIN1 EDWRT KJTAPE,WJDCFRM SUB GSWBIN2,GSWBIN4 ADD GSWBIN1,GSWBIN4 WJDC200 MOVE CPCKBUF,=X'00' CBL GSWBIN2,=W'52',WJDC210 MOVE GSWBIN2,=W'52' WJDC210 COPY CPCKBUF,CBIN0,GSWBIN2,CTRANBUF,GSWBIN1 EDWRT KJTAPE,WJDCFRM RET PEND EJECT ************************************************ * * FORMATS USED * ************************************************ * SNDFRM FRMT FSL FCOPY =C'DATATRANSMISSION ' FNL FTEXT 'BRUGERNAVN' FKI 12,MINL=1,MAXL=13,ME FMEL 'AAAAAAAAAAAAAAAAAAA9',TTCYKTOT FNL FTEXT 'KENDEORD' FKI 12,MINL=1,MAXL=4,ME FMEL 'TTT9',TTARKSAV FMEND * SIGONF FRMT FILLR ' ',2 FCOPY =X'272020' FTEXT 'CSSN PS=' FMEL '9999',TTARKSAV FTEXT ',NAME=' FMEL 'AAAAAAAAAAAAAAAAAAA9',TTCYKTOT FMEND * SNDFRM2 FRMT FILLR ' ',2 FCOPY =X'272020' FCOPY CPCKBUF FMEND * SNDFRM3 FRMT FILLR '1',2 FCOPY =C'DATATRANSMISSION ' FMEND * SNDFRM4 FRMT FILLR ' ',2 FTEXT 'ANTAL RECORDS:' FMEL 'ZZZZZ9',TTARKSAV FMEND * SNDFRM5 FRMT FBNZ GSWBIN3,SNDLAB10 FILLR ' ',2 FCOPY =X'272020' SNDLAB10 FCOPY =X'112020' FCOPY CPCKBUF FMEND * SNDFRM6 FRMT FSL FCOPY ='DATATRANSMISSION ' FILLR '?',1 FNL FKI 1 FMEL 'B',TSWBCD2 FMEND * WJDCFRM FRMT FILLR ' ',2 FCOPY CPCKBUF FMEND * END