|
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: 17256 (0x4368)
Notes: pts_type(SC)
Names: »ADM6.SC«
└─⟦26dca8ec8⟧ Bits:30009711 Philips computer tape "RÅKON-DIVFMT"
└─⟦this⟧ »REMIT2/ADM6.SC«
IDENT ADM6 821105 NJ DDUM KMD08 PDIV ENTRY ADM600 EXT SPCLRA EXT SPCLRS EXT SPLIN8 EXT SLUTID EXT RAWRIT EXT WRITID EXT LAMPOF EXT ADMRET EXT SPERR EXT CLSVOL EXT LAMPON EXT SOPRD EXT ASGVOL EXT BCKUP EXT RAREAD EXT GETBIT EXT WRITJT * INCLUDE EQUATE EJECT ADM600 TBT C569FLG,ADM601 MOVE GSWBIN1,CBIN0 DSC1 DCOMM,TRPAR,GSWBIN1 ADM601 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 CBNE SPBINW2,CBIN3,ADM06RET ADM0610 TBT C569FLG,ADM0611 MOVE GSWBIN1,=X'40' DSC1 DCOMM,TRPAR,GSWBIN1 ADM0611 SET SPPROMPT ATTFMT SNDFRM BRUGERNAVN/KENDEORD PERF SPCLRS CBNE SPBINW2,CBIN3,ADM600 ADM0615 TBT C569FLG,ADM0613 HOLSTED? TBT CCONVERT,ADM0613 HOLSTED+CONVERT VERSION SUB CRECBCD,=D'1' PERF SLUTID,CRECBCD ADD CRECBCD,=D'1' PERF RAWRIT,DK02,=D'2',CPCKBUF,CRECNR BNOK ADM600 PERF WRITID,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 TBF CDCSOP,ADM0620 ATTFMT SNDFRM7 PERF SPCLRA CBE SPBINW2,CBIN3,ADM0640 ADM0620 * SEND NEXT OR SIGNOFF PERF LAMPOF,=W'2047' ADM0630 PERF CHNGDK CHANGE DISC BNOK ADM6SOFF ADM0640 PERF STRTRC SEND STARTIDENT BNOK ADM0650 IF NOT OK, TRY NEXT PERF SENDRC SEND BATCH BOK ADM0620 IF NOT OK PERF TERMIN SEND TERMINATE ADM0650 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 TBT C569FLG,ADM06RET 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,=' ' EDIT CTRANBUF,SIGONF * FIND LENGTH MATCH CTRANBUF,GSWBIN1,GSWBIN2,CBLANKS,CBIN0,CBIN2 MOVE GSWBIN2,GSWBIN1 PERF EXCHAN EXCHANGE DC BNOK SIGON100 PERF WJDC MOVE GSWSTR20,=C'DFH3504' MOVE GSWBIN1,CBIN0 MATCH CTRANBUF,GSWBIN1,GSWBIN2,GSWSTR20,CBIN0,CBIN7 BNE SIGON100 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 FILES ON VOL 2 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 SPCLRA CBNE SPBINW2,CBIN3,CHNG000 PERF SIGNON BNOK CHNG000 PERF LAMPOF,=W'2047' B CHNG000 CHSOP05 PERF LAMPOF,=W'2047' LAMPS OFF PERF ASGVOL,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,CBIN5,CBIN1 MOVE GSWBIN6,CBIN0 MOVE GSWBIN1,=W'40' MOVE GSWSTR20,=' ' COPY CPCKBUF,GSWBIN1,CBIN20,GSWSTR20,GSWBIN6 MOVE CTRANBUF,=' ' 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' BNE SND012 MOVE CPCKBUF,=C'SLUTD00000 ' MOVE GSWBIN3,CRECLGD SND012 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 GTWBCD2,CRECNR PERF SPLIN8,CBIN10,CBIN3 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,=' ' EDSUB CTRANBUF,GSWBIN3,SNDFRM5 MOVE GSWBIN2,CBIN18 PERF EXCHAN BNOK SNDERR PERF WRITID,CBIN5,CBIN2 PERF WJDC PRINT ANSWER 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,=' ' 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,=' ' MOVE CPCKBUF,=C'CSSF ' EDSUB CTRANBUF,GSWBIN3,SNDFRM2 MOVE GSWBIN2,CBIN9 PERF EXCHAN BNOK SIGOFRET PERF WJDC PRINT ANSWER SIGOFRET RET PEND EJECT ********************************************* * EXCHAN - EXCHANGE DC * IN CASE OF ERROR ERRORMESSAGE * IS SHOWN ON SCREEN AND JOURNAL ********************************************* EXCHAN PROC EXCH10 MOVE GSWBIN5,CBIN1 MOVE GSWBIN1,=W'504' DCREAD DCOMM,CDUM0,GSWBIN1,GSWBIN5 * IN ORDER TO AVOID SHIT FROM VTAM, EVERYTHING WHICH * WE HAVE NOT ASKED FOR, IS THROWN AWAY. IF THERE IS * NO MORE SHIT, "DCREAD" WILL RETURN NOT-OK BOK EXCH10 MORE SHIT MOVE GSWBIN5,=W'600' TIMEOUT VALUE DCWRITE DCOMM,CTRANBUF,GSWBIN2,GSWBIN5 BNOK EXCHNOK MOVE GSWBIN2,=W'504' MOVE GSWBIN5,=W'600' 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 EXCHRET CMP CBIN0,CBIN0 RET PEND EJECT ********************************************* * * TRNOK - CHECK IF MESSAGE CORRECT RECIEVED * ********************************************* TRNOK PROC MOVE GSWBIN3,CBIN0 MOVE GSWSTR9,=X'1B3543' MATCH CTRANBUF,GSWBIN3,GSWBIN2,GSWSTR9,CBIN0,CBIN3 BNE TRNERR MOVE GSWBIN2,CBIN0 MOVE CTRANBUF,=' ' 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 WJDC200 SUB GSWBIN4,GSWBIN1 GSWBIN4 = LENGTH COPY CPCKBUF,CBIN0,GSWBIN4,CTRANBUF,GSWBIN1 EDWRT KJTAPE,WJDCFRM ADD GSWBIN4,CBIN3 SUB GSWBIN2,GSWBIN4 ADD GSWBIN4,GSWBIN1 MOVE GSWBIN1,GSWBIN4 CBG GSWBIN2,CBIN3,WJDC005 B WJDCRET * * * WJDC100 SUB GSWBIN2,GSWBIN1 CBL GSWBIN2,=W'52',WJDC200 MOVE GSWBIN4,=W'30' FIND BLANK MATCH CTRANBUF,GSWBIN4,GSWBIN2,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 WJDCRET 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 FMELI 'TTT9',TTARKSAV FILLR X'07',1 FMEND * SIGONF FRMT FILLR ' ',2 FTEXT X'272020' FTEXT 'CSSN PS=' FMELI '9999',TTARKSAV FTEXT ',NAME=' FMEL 'AAAAAAAAAAAAAAAAAAA9',TTCYKTOT FMEND * SNDFRM2 FRMT FILLR ' ',2 FTEXT X'272020' FCOPY CPCKBUF FMEND * SNDFRM3 FRMT FILLR '1',2 FCOPY =C'DATATRANSMISSION ' FMEND * SNDFRM5 FRMT FBNZ GSWBIN3,SNDLAB10 FILLR ' ',2 FTEXT X'272020' SNDLAB10 FTEXT X'112020' FCOPY CPCKBUF FMEND * SNDFRM6 FRMT FSL FCOPY ='DATATRANSMISSION' FILLR '?',1 FNL FKI 1 FMEL 'B',TSWBCD2 FMEND * SNDFRM7 FRMT FSL FTEXT 'SEND DENNE DISKETTE?' FNL FKI 1 FMEL 'B',TSWBCD2 FMEND * WJDCFRM FRMT FILLR ' ',2 FCOPY CPCKBUF FMEND * END