|
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: 16556 (0x40ac)
Notes: pts_type(SC)
Names: »ADM6.SC«
└─⟦f445cacdf⟧ Bits:30009666 Philips computer tape "600111"
└─⟦this⟧ »NJ-AMT/ADM6.SC«
IDENT ADM6 821105 NJ 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 BCKUP EXT RAREAD EXT GETBIT EXT WRITJT * INCLUDE EQUATE EJECT ADM600 MOVE GSWBIN1,=X'00' DETACH DEVICE DSC1 DCOMM,TRPAR,GSWBIN1 SET CCONVFLG CLEAR SPKEYFLG TBT GTKASSE,ADM0605 TBF GTMASTFL,ADM0605 CBNE CTASKNR,CBIN0,ADM0605 SET SPPROMPT MOVE SPKEY,CBIN2 ATTFMT SNDFRM6 PERF SPCLRS IB SPBINW2,ADM0605,ADM0605,ADM0610 B ADM600 ADM0605 B ADM06RET * WRITE SLUTD ADM0610 MOVE GSWBIN1,=X'41' DEVICE ADDRESS DSC1 DCOMM,TRPAR,GSWBIN1 TRANSFER PARAM ADM0611 SET SPPROMPT ATTFMT SNDFRM PERF SPCLRS IB SPBINW2,ADM0612,ADM0612,ADM0615 B ADM0611 ADM0612 B ADM600 ADM0615 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 EJECT ************************************************** * 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 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,=X'00' DETACH DEVICE 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 FILES ON VOL 2 MOVE CRECNR,CBIN1 MOVE CRECBCD,=D'1' PERF LAMPON,=W'1024' LAMP 1 PERF LAMPON,=W'64' LAMP 5 PERF LAMPON,=W'32' LAMP 6 PERF LAMPON,=W'16' LAMP 7 CHNG010 PERF SOPRD CLEAR TTLOKFLG IB GSWBIN2, C CHSOP10,CHSOP09,CHSOP08,CHSOP07,CHSOP06, C CHSOP05,CHSOP04,CHSOP03,CHSOP02,CHSOP01 B CHNG010 CATCH INV. VALUES CHSOP01 SET TTLOKFLG EDWRT KJTAPE,LOKFMT B CHSOP05 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 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,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 ? TBF TTLOKFLG,SND012 PIN 1 PRESSED? MOVE GSWSTR20,='G01' REPLEASE G01 MOVE GSWBIN5,CBIN3 BYE R31 MATCH CPCKBUF,GSWBIN5,CBIN3,GSWSTR20,CBIN0,CBIN3 BNOK SND012 NO MATCH MOVE GSWSTR20,='R01' REPLACE XCOPY CPCKBUF,GSWBIN5,CBIN3,GSWSTR20,CBIN0 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 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,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 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 EXCHTEST MOVE GSWBIN2,CBIN20 MOVE CTRANBUF,=X'35' DELAY GSWBIN2 CMP CBIN0,CBIN0 RET PEND EJECT ********************************************* * * TRNOK - CHECK IF MESSAGE CORRECT RECIEVED * ********************************************* TRNOK PROC MOVE GSWBIN3,CBIN0 MOVE GSWSTR9,=X'35' MATCH CTRANBUF,GSWBIN3,GSWBIN2,GSWSTR9,CBIN0,CBIN1 BNE TRNERR MOVE GSWBIN2,CBIN0 MOVE CTRANBUF,=C' ' CMP CBIN0,CBIN0 RET TRNERR 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 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 WJDC010 B WJDC200 WJDCRET RET * * * 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 RET PEND EJECT 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 FILLR X'07',1 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 ' FILLR X'07',1 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 =C'DATATRANSMISSION ' FILLR '?',1 FILLR X'07',1 FNL FKI 1 FMEL 'B',TSWBCD2 FMEND * WJDCFRM FRMT FILLR ' ',2 FCOPY CPCKBUF FMEND * LOKFMT FRMT FILLR ' ',2 FTEXT 'FLG. DISKETTE SENDES TIL LOKALSYSTEM' FEOR FILLR ' ',2 FMEND END