|
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: 23666 (0x5c72)
Notes: pts_type(SC)
Names: »DCBSC.SC«
└─⟦928b1fd3e⟧ Bits:30009671 Philips computer tape "600131"
└─⟦this⟧ »PT3272/DCBSC.SC«
IDENT DCBSC REL 11.0 82-04-23 870150541100 =2 TWO DC-LINES =1, CHARAC. ADDR. 81-01-26 **************************************************************** * * * MODULE DCBSC * * MODULE HANDLING THE COMMUNICATION * * BETWEEN THE SLU AND CLUSTER CONTROLLER * * (EMULATION 3270 BSC) * * * **************************************************************** EJECT *********************************************************** * * * ROUTINES * * * * DCINP DC-INPUT MAIN ROUTINE * * READW READ WITH WAIT * * DCWRIT WRITE DC BUFFER * * TSTMES TEST MESSAGE * * SETSTA SET STATUS * * TSTSTA TEST STATUS * * DCABOR ABORT DC REQUEST * * CHKSTA CHACK DC STATUS * * DCOFLN INDICATE OFFLINE TO CLUSTER * * TRPA TRANSMIT SHORT READ * * TRPF TRANSMIT READ MODIFIED * * * *********************************************************** EJECT **************************************************************** * * * ENTRY POINTS * * * **************************************************************** ENTRY DCINP DC-INPUT MAIN ROUTINE ENTRY TSTSTA TEST STATUS ENTRY SETSTA SET STATUS ENTRY OPEN OPEN ENTRY CONCT CONNECT PASSIVE ENTRY DISCON DISCONNECT =2 ENTRY SETTYM SET REQUEST TIMER ENTRY TSTMES TEST MESSAGE. ENTRY DCABOR ABORT DC REQUEST ENTRY TRPA TRANSMIT SHORT READ ENTRY TRPF TRANSMIT READ MODIFIED ENTRY DCOFLN INDICATE OFFLINE TO CLUSTER ENTRY CHKSTA CHECK DC STATUS ENTRY DCWRIT WRITE DC BUFFER ENTRY READW READ DC WITH WAIT ENTRY RDSTAT READ STATISTICS ************************************************************* * * * EXTERNAL REFERENCES * * * ************************************************************* EXTRN GETBUF GET BUFFER (PAD) EXTRN RELBUF RELEASE BUFFER (PAD) EXTRN PAID STORE AID-CODE IN DC BUFFER (PAD) EXTRN SCRINF GET SCREEN INFORMATION (VDU) EXTRN BUFADR STORE BUFFER ADDRESS IN DC BUFFER (PAD) EXTRN PACK PACK MODIFIED FIELDS (PAD) EXTRN LMP3OF INHIBIT LAMP OFF (KEYB) EXTRN DISMOD DISPLAY MODIFIED FIELDS (VDU) EXTRN UNPACK UNPACK DC BUFFER (PAD) EXTRN ERROR INDICATE ERROR (KEYB) EXTRN RESKB RESET KEYBOARD BUFFER (KEYB) EXTRN LMP1ON SYSTEM AVAILABLE DK EXTRN LMP3ON ON EXTRN LMP1OF SYSTEM AVAILABLE DK EJECT ********************************************************* * * * CONDITIONAL ASSEMBLY PARAMETERS * * * ********************************************************* X:C EQU 0 OFFLINE HANDLING IF :=1 OFLIN EQU 0 X:D EQU 1 NUMBER OF LINES (1-2) NBRLIN EQU 2 X:E EQU 300 REQUEST TIMEOUT IN 100 MS REQTIM EQU 00300 X:L EQU 1000 MAX BUFFER SIZE IN WORDS BUFFL EQU 1150 X:O EQU 0 TEST INCLUDED IF:=1 TEST EQU 0 EJECT *************************************************************** * * * DECLARATIONS OF DATA AND EQUATES * * *************************************************************** * * EQUATES FOR ECB HANDLING * ECBBA EQU 2 BUFFER ADDRESS ECBRL EQU 4 REQUESTED LENGTH ECBEL EQU 6 EFFECTIVE LENGTH ECBRC EQU 8 RETURN CODE ECBCW1 EQU 10 CONTROL WORD 1 ECBCW2 EQU 12 CONTROL WORD 2 * * RELATIVE POS. IN ECBBLK * DC EQU 4 EJECT * * RELATIVE ADDRESSES IN * TERMINAL WORKBLOCK * WCC EQU 1952 WCC CHAR. KBINH EQU WCC+2 KB INHIBIT INDICATOR DCLENG EQU KBINH+4 DC READ EFFECTIVE LENGTH MAIN EQU DCLENG+12 MAIN FRAME FLAG ECBBLK EQU MAIN+6 ECB:S FOR MULTIPLE WAIT BUFPNT EQU ECBBLK+14 BUFFER TO RELEASE REGI EQU BUFPNT+2 SAVE AREA ECBDC1 EQU REGI+46 ECB DC LINE 1 ECBDC2 EQU ECBDC1+2 ECB DC LINE 2 * * RELATIVE ADDRESSES IN * COMMON WORKBLOCK * MF1CU EQU 0 SYMBOLIC ADDRESS MF2CU EQU MF1CU+2 SYMBOLIC ADDRESS EJECT ************************************************************ * * * DCINP DC INPUT MAIN ROUTINE * * * ************************************************************ * REGISTERS * * A11= CREDIT WORK AREA * A13= RESERVED * ******************************************** DCINP EQU * CF A14,GETBUF GET BUFFER LDR A3,A8 CF A14,READW READ ONE BUFFER ANK A1,8 OK? RF(Z) DCIN10 YES LDR A8,A12 CF A14,RELBUF RELEASE BUFFER RF DCIN15 DCIN10 EQU * LD A1,ECBEL,A8 ST A1,DCLENG,A11 SAVE LENGTH ST A12,BUFPNT,A11 CF A14,UNPACK UNPACK THE BUFFER CF A14,DISMOD DISPLAY THE NEWS DCIN15 EQU * LD A1,KBINH,A11 LDR A2,A1 ANK A1,1 KEYBOARD TOTALLY INHIBIT? RF(Z) DCIN20 NO ANK A2,/E KEYBOARD NOT TOTALLY INHIBIT LD A1,WCC,A11 ANK A1,2 RESTORE KEYBOARD? RF(Z) DCIN30 NO DCIN20 EQU * CF A14,LMP3OF TUR OFF INHIBIT LAMP ANK A2,4 RESTORE KEYBOARD DCIN30 EQU * ST A2,KBINH,A11 LDK A1,0 CF A14,SETSTA SET DEVICE END RTN A14 EJECT ************************************************************** * * * OPEN OPEN * * ************************************************************** * REGISTERS * * A8= DC ECB * A11= CREDIT WORK AREA * A13= RESERVED * ************************************************************** OPEN EQU * LD A8,ECBDC1,A11 GET ECB ADDRESS LDK A4,0 RESET INDICATOR LD A3,6,A13 GET BASE LD A2,MF1CU,A3 ADDRESS =1 OPEN10 EQU * ST A2,ECBCW2,A8 . =1 LDK A7,/A1 OPEN LKM DATA 1 LD A1,ECBRC,A8 RF(N) OPEN20 IFT NBRLIN=2 LDR A4,A4 ANOTHER LINE TO OPEN RF(NZ) OPEN20 NO LD A8,ECBDC2,A11 GET LINE 2 LD A2,MF2CU,A3 GET SECOND SYMB. ADD DK LDK A4,1 RB OPEN10 XIF OPEN20 EQU * RTN A14 EJECT ********************************************************* * * * CONCT CONNECT PASSIVE * * ********************************************************* * REGISTERS * * A8= DC ECB * A11= CREDIT WORK AREA * A13= RESERVED * ************************************************** CONCT EQU * CF A14,GETBUF GET BUFFER LD A8,ECBDC1,A11 GET LINE 1 LD A3,6,A13 GET BASE =2 . =2 IFT NBRLIN=2 . =2 LD A1,MAIN,A11 SECOND LINE? =2 RF(Z) CONC10 NO! =2 LD A8,ECBDC2,A11 YES! =2 ADK A3,2 SECOND CU =2 XIF . =2 CONC10 EQU * ST A12,ECBBA,A8 LDR* A1,A11 GET TASKID ANK A1,/FF SC A1,+1,A12 SAVE ADDRESS IN BUFFER LDK A1,2 LENGTH ST A1,ECBRL,A8 . =2 LD A1,MF1CU,A3 ST A1,ECBCW2,A8 . =1 LDK A7,/A7 CONNECT PASSIVE LKM DATA 1 LD A1,REGI,A11 GET TABLE TO SAVE PHYS. ADDRESS LD A2,ECBCW2,A8 GET ADDRESS SC A2,+2,A1 SAVE IT FOR COPY COMMAND . =2 LDR A8,A12 CF A14,RELBUF RELEASE BUFFER RTN A14 EJECT . =2 ************************************************************** * * DISCON - DISCONNECT * ************************************************************** * * INPUT: A11 = CREDIT WORK AREA * * USED* A1,A7,A8 * *************************************************************** * DISCON EQU * . =2 CF A14,DCABOR ABORT TEST MESSAGE =2 LDK A7,/AF DISCONNECT =2 LKM . =2 DATA 1 . =2 RTN A14 . =2 EJECT ***************************************************************** * * SETTYM SET REQUEST TIMEOUT * ***************************************************************** * REGISTERS * * ***************************************************************** SETTYM EQU * LD A8,ECBDC1,A11 GET ECB LDK A4,0 RESET INDICATOR LDKL A1,REQTIM GET TIMEOUT VALUE SETT10 EQU * ST A1,ECBCW1,A8 LDK A7,/B9 SET TIMEOUT LKM DATA 1 IFT NBRLIN=2 LDR A4,A4 MORE TO TIME? RF(NZ) SETT20 NO LD A8,ECBDC2,A11 GET LINE 2 LDK A4,1 NO MORE RB SETT10 SETT20 EQU * XIF RTN A14 EJECT ********************************************************* * * * READW RECEIVE * * ********************************************************* * REGISTERS * * A3= BUFFER ADDRESS * A8= DC ECB * A11= CREDIT WORK AREA * A13= RESERVED * ********************************************************* READW EQU * LD A8,ECBDC1,A11 LINE 1 IFT NBRLIN=2 LD A1,MAIN,A11 MORE LINES RF(Z) REDW10 NO LD A8,ECBDC2,A11 LINE 2 REDW10 EQU * XIF LDKL A1,BUFFL+BUFFL GET LENGTH ST A1,ECBRL,A8 ST A3,ECBBA,A8 LDK A7,/82 RECEIVE LKM DATA 1 LD A1,ECBRC,A8 ANK A1,/5B OK? RF(Z) REDW20 YES CF A14,CHKSTA CHECK STATUS LDK A1,8 INDICATE ERROR RF REDW30 REDW20 EQU * LDK A1,2 REDW30 EQU * RTN A14 EJECT ********************************************************* * * * DCWRIT SEND * * ********************************************************* * REGISTERS * * A1= AT ENTRY CHAIN INDICATOR, RETURN CODE * A8= DC ECB * A9= DC BUFFER LENGTH * A11= CREDIT WORK AREA * A13= RESERVED * ***************************************************** DCWRIT EQU * LD A8,ECBDC1,A11 LINE IFT NBRLIN=2 LD A1,MAIN,A11 LINE 2? RF(Z) DCWR10 NO LD A8,ECBDC2,A11 LINE 2 DCWR10 EQU * XIF LDK A2,2 KEYBOARD INHIBIT BUT RESETABLE ORS A2,KBINH,A11 LDK A7,/86 WRITE ORDER ST A12,ECBBA,A8 BUFFER ADDRESS ST A9,ECBRL,A8 LKM DATA 1 LD A1,ECBRC,A8 ANY ERROR? ANK A1,/5B RF(Z) DCWR90 NO CF A14,ERROR CF A14,CHKSTA CHECK DC STATUS LD A1,KBINH,A11 ANK A1,/D RESET KEYBOARD PARTLY ST A1,KBINH,A11 CF A14,LMP3OF INHIBIT LAMP OFF CF A14,RESKB RESET KB BUFFER LDK A1,1 RETURN CODE DCWR90 EQU * RTN A14 EJECT ********************************************************* * * * TSTMES TEST IF ANY MESSAGE, NO WAIT * * * ********************************************************* * REGISTERS * * A1= RETURN CODE * A11= ADDRESS TO CREDIT WORK AREA * A13= ADDRESS TO ECB AREA * ********************************************************* TSTMES EQU * LD A8,ECBDC1,A11 LINE 1 IFT NBRLIN=2 LD A1,MAIN,A11 LINE 2 RF(Z) TSTM10 NO LD A8,ECBDC2,A11 LINE 2 TSTM10 EQU * XIF LDK A2,1 ST A2,ECBCW1,A8 INDICATE TEST MESSAGE LDK A7,0 TEST MESS., NO WAIT LKM DATA 1 RTN A14 EJECT ************************************************************* * * * SETSTA SET STATUS * * * ************************************************************* * REGISTERS * * A1= AT ENTRY STATUS * A8= DC ECB * A11= RESERVED * A13= ADDRESS TO ECB AREA * ************************************************************ SETSTA EQU * LD A8,ECBDC1,A11 IFT NBRLIN=2 LD A2,MAIN,A11 RF(Z) SETS10 LD A8,ECBDC2,A11 SETS10 EQU * XIF LDK A7,/B8 ST A1,ECBCW1,A8 LKM DATA 1 RTN A14 EJECT ****************************************************** * * * TSTSTA TEST STATUS * * * ****************************************************** * REGISTERS * * A1= RETURN CODE * A8= DC ECB * A11= RESERVED * A13= ADDRESS TO ECB AREA * ***************************************************** TSTSTA EQU * LD A8,ECBDC1,A11 LINE 1 IFT NBRLIN=2 LD A1,MAIN,A11 LINE 2? RF(Z) TSTS10 NO LD A8,ECBDC2,A11 LINE 2 TSTS10 EQU * XIF CM ECBCW1,A8 INDICATE TEST STATUS LDK A7,/80 LKM DATA 1 LD A1,ECBCW1,A8 RTN A14 EJECT ********************************************************************* * * RDSTAT READ STATISTICS * ********************************************************************** * REGISTERS * * ********************************************************************* RDSTAT EQU * IFT TEST=1 LD A8,ECBDC1,A11 IFT NBRLIN=2 LD A1,MAIN,A11 THE OTHER LINE RF(Z) RDST10 NO LD A8,ECBDC2,A11 RDST10 EQU * XIF IFT TEST=1 ST A12,ECBBA,A8 LDKL A1,BUFFL+BUFFL ST A1,ECBRL,A8 CM ECBCW1,A8 NO RESET AFTERWARDS LDK A7,/AD LKM DATA 1 RTN A14 XIF EJECT ********************************************************** * * * DCABOR ABORT TEST MESSAGE REQUEST * * * ********************************************************** * REGISTERS * * A8= DC ECB * A11= ADDRESS TO CREDIT WORK AREA * A13= ADDRESS TO ECB AREA * ********************************************************* DCABOR EQU * LD A8,ECBDC1,A11 LINE 1 IFT NBRLIN=2 LD A1,MAIN,A11 LINE 2? RF(Z) DCAB10 NO LD A8,ECBDC2,A11 LINE 2 DCAB10 EQU * . =2 XIF LDK A7,0 LKM DATA 10 LDR A7,A7 OK? RF(NZ) DCAB20 NO, ALREADY COMPLETED =2 CM ECBBLK+DC,A11 DCAB20 EQU * . =2 RTN A14 EJECT * * * * DC RETURN CODE * * * * BIT 0 REQUEST ERROR * 1 RESERVED * 2 RESERVED * * 9 REQUEST TIMEOUT * 11 SEQUENCE ERROR * 12 INCORRECT LENGTH * 13 RESERVED * 14 TRANSMISSION ERROR * 15 NO CONNECTION * * * EJECT ****************************************************** * * * CHKSTA CHECK DC STATUS * * * ****************************************************** * REGISTERS * * A1= AT ENTRY DC RETURN CODE, RETURN CODE * A11= CREDIT WORK AREA * A13= RESERVED * ******************************************************* CHKSTA EQU * CF A14,TSTSTA TEST STATUS ANKL A1,/2211 LINE OK? XRKL A1,/2211 RF(NZ) CHKS10 NO CF A14,LMP1ON SYSTEM AVAIL. RF CHKS20 CHKS10 EQU * * LAMP ONE OFF DELETED P & T * CHKS20 EQU * RTN A14 EJECT ********************************************************* * * * DCOFLN INDICATE OFFLINE TO CLUSTER * * * ********************************************************* * REGISTERS * * A11= CREDIT WORK AREA * A13= RESERVED * ************************************************** DCOFLN EQU * IFT OFLIN=1 CF A14,DCABOR XIF RTN A14 EJECT ***************************************************** * * * TRPA TRANSMIT SHORT READ AT PA-KEY * * * ***************************************************** * REGISTERS * * A2= AID CODE * A11= CREDIT WORK AREA * A13= RESERVED * ***************************************************** TRPA EQU * CF A14,GETBUF GET TRANSMIT BUFFER CF A14,PAID STORE AID IN BUFFER CF A14,DCWRIT TRANSMIT LDR A8,A12 BUFFER TO RELEASE CF A14,RELBUF RELEASE BUFFER RTN A14 EJECT ****************************************************** * * * TRPF TRANSMIT MODIFIED READ AT PF-KEY * * * ****************************************************** * REGISTERS * * A2= AID CODE * A4= REL CURSOR POS. * A5= RESERVED * A6= RESERVED * A11= CREDIT WORK AREA * A13= RESERVED * ****************************************************** TRPF EQU * CF A14,GETBUF GET TRANSMIT BUFFER CF A14,PAID SAVE AID-CODE CF A14,SCRINF GET SCREEN INFORMATION LDR A1,A4 CURSOR ADDRESS CF A14,BUFADR STORE CURSOR ADDRESS IN BUFFER CF A14,PACK PACK BUFFER WITH MODIFIED FIELDS AND TRANSMIT RTN A14 END