|
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: 17356 (0x43cc)
Notes: pts_type(SC)
Names: »ADM6.SC«
└─⟦22f4dea89⟧ Bits:30009702 Philips computer tape "DOS_PTS_4.2_M_FL"
└─⟦this⟧ »NJ-AMT/ADM6.SC«
└─⟦dab19bdd7⟧ Bits:30009677 Philips computer tape "600218"
└─⟦this⟧ »NJ-AMT/ADM6.SC«
IDENT ADM6 831101 EV EBCDIC DDUM KMD08 PDIV ENTRY ADM600 * EXT SPCLRS EXT SPCLRA 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 EXT WRITLO * 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'40' 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 CLEAR TTLOKFLG ATTFMT SNDFRM7 PERF SPCLRA EDWRT SCREEN,SNDFRM8 CBE SPBINW2,CBIN3,ADM0640 ADM0620 PERF LAMPOF,=W'2047' ADM0630 PERF CHNGDK CHANGE DISC BNOK ADM6SOFF ADM0640 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' PERF WRITLO,CBIN17 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 CLEAR TTLOKFLG 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 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 GTRECNR,CBIN0 NUMBER OF DATA RECORDS 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 ' SND012 MOVE GSWSTR20,=C'SLUTD' MOVE GSWBIN5,CBIN0 MATCH GSWSTR20,GSWBIN5,CBIN5,CPCKBUF,CBIN0,CBIN5 BE SNDSLUT TBF TTLOKFLG,SND014 PIN 1 PRESSED? MOVE GSWSTR20,='379G01' REPLACE 379G01 MOVE GSWBIN5,CBIN0 BYE R01 MATCH CPCKBUF,GSWBIN5,CBIN6,GSWSTR20,CBIN0,CBIN6 BNOK SND010 NO MATCH MOVE GSWSTR20,='379R01' REPLACE XCOPY CPCKBUF,GSWBIN5,CBIN6,GSWSTR20,CBIN0 SND014 ADD GTRECNR,CBIN1 ONE MORE RECORD TO SEND 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 SUB GTRECNR,CBIN1 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 GSWBCD3,GTRECNR NO. OF DATA RECORDS PERF SLUTID,GSWBCD3 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' PERF WRITLO,CBIN17 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 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 =C'DATATRANSMISSION ' FILLR '?',1 FNL FKI 1 FMEL 'B',TSWBCD2 FMEND * SNDFRM7 FRMT FSL FTEXT 'SKAL DENNE DISKETTE SENDES?' FNL FKI 1 FMEL 'B',TSWBCD2 FMEND * SNDFRM8 FRMT FILLR '1',2 FMEND * WJDCFRM FRMT FILLR ' ',2 FCOPY CPCKBUF FMEND * LOKFMT FRMT FILLR ' ',2 FTEXT 'FLG. DISKETTE SENDES TIL LOKALSYSTEM' FEOR FILLR ' ',2 FMEND END