(' erstellt wird PN=',10A2) B0028000 * B0028100 * SPECIAL CHARACTER BYTE DEFINITIONS - EBCDIC B0028200 * B0028300 TITLE EBCDIC TO ASCII TRANSLATION TABLE B0040800 * B0040900 * EBCDIC TO ASCII TRANSLATION TABLE B0041000 * A 256 BYTE TABLE B0041100 * B0041200 BSCTAB EQU * DB X'00' 00 NUL 00 B0041400 DB X'01' SOH B0041500 DB X'02' STX B0041600 DB X'03' ETX B0041700 DB X'80' 04 BF 80 (NO ASCII EQUIV) B0041800 DB X'09' 05 HT 09 B0041900 DB X'81' 06 OC 81 (NO ASCII EQUIV) B0042000 DB X'7F' 07 DEL 7F B0042100 DB X'82' 08 82 B0042200 DB X'83' 09 RLF 83 (NO ASCII EQUIV) B0042300 DB X'84' 0A SMM 84 (NO ASCII EQUIV) B0042400 DB X'0B' 0B VT 0B B0042500 DB X'0C' 0C FF 0C B0042600 DB X'0D' 0D CR 0D B0042700 DB X'0E' 0E GO 0E B0042800 DB X'0F' 0F SI 0F B0042900 DB X'10' 10 DLE 10 B0043000 DB X'11' 11 DC1 11 B0043100 DB X'12' 12 DC2 12 B0043200 DB X'13' 13 DC3 13 B0043300 DB X'85' 14 RES 85 (NO ASCII EQUIV) B0043400 DB X'86' 15 NL 85 (NO ASCII EQUIV) B0043500 DB X'08' 16 BS 08 B0043600 DB X'87' 17 IL 87 (NO ASCII EQUIV) B0043700 DB X'18' 18 CAN 18 B0043800 DB X'19' 19 EM 19 B0043900 DB X'88' 1A CC 88 (NO ASCII EQUIV) B0044000 DB X'89' 1B 89 B0044100 DB X'1C' 1C IFS 1C (FS) B0044200 DB X'1D' 1D IGS 1D (GS) B0044300 DB X'1E' 1E IRS 1EW (RS) B0044400 DB X'1F' 1F IVS 1F (US) B0044500 DB X'90' 20 DS 90 (NO ASCII EQUIV) B0044600 DB X'91' 21 SOS 91 (NO ASCII EQUIV) B0044700 DB X'92' 22 BS 92 (ASCII FS=EBCDIC IFS) B0044800 DB X'93' 23 93 B0044900 DB X'94' 24 BYP 94 (NO ASCII EQUIV) B0045000 DB X'0A' 25 LF 0A B0045100 DB X'17' 26 ETB 17 B0045200 DB X'1B' 27 BSC 1B /PRE B0045300 DB X'95' 28 95 B0045400 DB X'96' 29 96 B0045500 DB X'97' 2A SM 97 B0045600 DB X'98' 2B 98 B0045700 DB X'99' 2C 99 B0045800 DB X'05' 2D ENQ 05 B0045900 DB X'06' 2E ACK 06 B0046000 DB X'07' 2F BEL 07 B0046100 DB X'A0' 30 A0 B0046200 DB X'A1' 31 A1 B0046300 DB X'16' 32 SYN 16 B0046400 DB X'A2' 33 A2 B0046500 DB X'A3' 34 BM A3 (NO ASCII EQUIV) B0046600 DB X'A4' 35 RS A4 (ASCII RS=EBCDIC IRS) B0046700 DB X'A5' 36 DC A5 (NO ASCII EQUIV) B0046800 DB X'04' 37 EOT 04 B0046900 DB X'A6' 38 A6 B0047000 DB X'A7' 39 A7 B0047100 DB X'A8' 3A A8 B0047200 DB X'A9' 3B A9 B0047300 DB X'14' 3C DC4 14 B0047400 DB X'15' 30 NAK 15 B0047500 DB X'F9' 3E F9 B0047600 DB X'1A' 3F SUB 1A B0047700 DB X'20' 40 SP 20 B0047800 DB X'C1' 41 C1 B0047900 DB X'C2' 42 C2 B0048000 DB X'C3' 43 C3 B0048100 DB X'C4' 44 C4 B0048200 DB X'C5' 45 C5 B0048300 DB X'C6' 46 C6 B0048400 DB X'C7' 47 C7 B0048500 DB X'C8' 48 C8 B0048600 DB X'C9' '9 C9 B0048700 DB X'5B' 4A 5B F CENT = A ( B0048800 DB X'2E' 4B . 2E B0048900 DB X'3C' 4C < 3C B0049000 DB X'28' 4D ( 28 B0049100 DB X'2B' 4E + 2B B0049200 DB X'5D' 4F ) 5D F VBAR = A ) B0049300 DB X'26' 50 & 26 B0049400 DB X'D1' 51 D1 B0049500 DB X'D2' 52 D2 B0049600 DB X'D3' 53 D3 B0049700 DB X'D4' 54 D4 B0049800 DB X'D5' 55 D5 B0049900 DB X'D6' 56 D6 B0050000 DB X'D7' 57 D7 B0050100 DB X'D8' 58 D8 B0050200 DB X'D9' 59 D9 B0050300 DB X'21' 5A ! 21 B0050400 DB X'24' 5B 24 B0050500 DB X'2A' 5C + 2A B0050600 DB X'29' 5D ) 29 B0050700 DB X'3B' 5E : 3B B0050800 DB X'5E' 5F 5E B0050900 DB X'2D' 60 - 2D B0051000 DB X'2F' 61 / 2F B0051100 DB X'E2' 62 E2 B0051200 DB X'E3' 63 E3 B0051300 DB X'E4' 6' E4 B0051400 DB X'E5' 65 E5 B0051500 DB X'E6' 66 E6 B0051600 DB X'E7' 67 E7 B0051700 DB X'E8' 68 E8 B0051800 DB X'E9' 69 E9 B0051900 DB X'7C' 6A DVC C DOUBLE VERT BAR B0052000 DB X'2C' 6B ' 2C B0052100 DB X'25' 6C % 25 B0052200 DB X'5F' 6D < 5F UNDERLINE B0052300 DB X'3E' 6E > 3E B0052400 DB X'3F' 6F ? 3F B0052500 DB X'F0' 70 F0 B0052600 DB X'F1' 71 F1 B0052700 DB X'F2' 72 F2 B0052800 DB X'F3' 73 F3 B0052900 DB X'F4' 74 F4 B0053000 DB X'F5' 55 F5 B0053100 DB X'F6' 76 F6 B0053200 DB X'F7' 77 F7 B0053300 DB X'F8' 78 F8 B0053400 DB X'60' 79 BKA 60 BACK APOSTROPHE B0053500 DB X'3A' 7A : 3A B0053600 DB X'23' 7B # 23 B0053700 DB X'40' 7C @ 40 B0053800 DB X'27' 7D ' 27 B0053900 DB X'3D' 7E V 3D B0054000 DB X'22' 7F " 22 B0054100 DB X'C0' 80 C0 B0054200 DB X'61' 81 A 61 (LOWER CASE) B0054300 DB X'62' 82 B 62 (LOWER CASE) B0054400 DB X'63' 83 C 63 (LOWER CASE) B0054500 DB X'64' 84 D 64 (LOWER CASE) B0054600 DB X'65' 85 E 65 (LOWER CASE) B0054700 DB X'66' 86 F 66 (LOWER CASE) B0054800 DB X'67' 87 G 67 (LOWER CASE) B0054900 DB X'68' 88 H 68 (LOWER CASE) B0055000 DB X'69' 89 I 69 (LOWER CASE) B0055100 DB X'8A' 8A 8A B0055200 DB X'8B' 8B 8B B0055300 DB X'8C' 8C 8C B0055400 DB X'8D' 8D 8D B0055500 DB X'8E' 8E 8E B0055600 DB X'8F' 8F 8F B0055700 DB X'D0' 90 D0 B0055800 DB X'6A' 91 J 6A (LOWER CASE) B0055900 DB X'6B' 92 K 6B (LOWER CASE) B0056000 DB X'6C' 93 L 6C (LOWER CASE) B0056100 DB X'6D' 94 M 6D (LOWER CASE) B0056200 DB X'6E' 95 N 6E (LOWER CASE) B0056300 DB X'6F' 96 O 6F (LOWER CASE) B0056400 DB X'70' 97 P 70 (LOWER CASE) B0056500 DB X'71' 98 Q 71 (LOWER CASE) B0056600 DB X'72' 99 R 72 (LOWER CASE) B0056700 DB X'9A' 9A 9A B0056800 DB X'9B' 9B 9B B0056900 DB X'9C' 9C 9C B0057000 DB X'9D' 9D 9D B0057100 DB X'9E' 9E 9E B0057200 DB X'9F' 9F 9F B0057300 DB X'E0' A0 E0 B0057400 DB X'7E' A1 NOT 7E (SIMILAR) B0057500 DB X'73' A2 S 73 (LOWER CASE) B0057600 DB X'74' A3 T 74 (LOWER CASE) B0057700 DB X'75' A4 U 75 (LOWER CASE) B0057800 DB X'76' A5 V 76 (LOWER CASE) B0057900 DB X'77' A6 W 77 (LOWER CASE) B0058000 DB X'78' A7 X 78 (LOWER CASE) B0058100 DB X'79' A8 Y 79 (LOWER CASE) B0058200 DB X'7A' A9 Z 7A (LOWER CASE) B0058300 DB X'AA' AA AA B0058400 DB X'AB' AB AB B0058500 DB X'AC' AC AC B0058600 DB X'AD' AD AD B0058700 DB X'AE' AE AE B0058800 DB X'AF' AF AF B0058900 DB X'B0' B0 B0 B0059000 DB X'B1' B1 B1 B0059100 DB X'B2' B2 B2 B0059200 DB X'B3' B3 B3 B0059300 DB X'B4' B4 B4 B0059400 DB X'B5' B5 B5 B0059500 DB X'B6' B6 B6 B0059600 DB X'B7' B7 B7 B0059700 DB X'B8' B8 B8 B0059800 DB X'B9' B9 B9 B0059900 DB X'BA' BA BA B0060000 DB X'BB' BB BB B0060100 DB X'BC' BC BC B0060200 DB X'BD' BD BD B0060300 DB X'BE' BE BE B0060400 DB X'BF' BF BF B0060500 DB X'7B' C0 LHB 7B LEFT BRACKET B0060600 DB X'41' C1 A 41 B0060700 DB X'42' C2 B 42 B0060800 DB X'43' C3 C 43 B0060900 DB X'44' C4 D 44 B0061000 DB X'45' C5 E 45 B0061100 DB X'46' CL F 46 B0061200 DB X'47' C7 G 47 B0061300 DB X'48' C8 H 48 B0061400 DB X'49' C9 I 49 B0061500 DB X'CA' CA CA B0061600 DB X'CB' CB CB B0061700 DB X'CC' CC CC B0061800 DB X'CD' CD CD B0061900 DB X'CE' CE CE B0062000 DB X'CF' CF CF B0062100 DB X'7D' DO RHB 7D RIGHT BRACKET B0062200 DB X'4A' D1 J 4A B0062300 DB X'4B' D2 K 4B B0062400 DB X'4C' D3 L 4C B0062500 DB X'4D' D4 M 4D B0062600 DB X'4E' D5 N 4E B0062700 DB X'4F' D6 O 4F B0062800 DB X'50' D7 P 50 B0062900 DB X'51' D8 Q 51 B0063000 DB X'52' D9 R 52 B0063100 DB X'DA' DA DA B0063200 DB X'DB' DB DB B0063300 DB X'DC' DC DC B0063400 DB X'DD' DD DD B0063500 DB X'DE' DE DE B0063600 DB X'DF' DF DF B0063700 DB X'5C' E0 DB X'E1' E1 E1 B0063900 DB X'53' E2 53 B0064000 DB X'54' E3 T 54 B0064100 DB X'55' E4 U 55 B0064200 DB X'56' E5 V 56 B0064300 DB X'57' E6 W 57 B0064400 DB X'58' E7 X 58 B0064500 DB X'59' E8 Y 59 B0064600 DB X'5A' E9 Z 5A B0064700 DB X'EA' EA EA B0064800 DB X'EB' EB EB B0064900 DB X'EC' EC EC B0065000 DB X'ED' ED ED B0065100 DB X'EE' EE EE B0065200 DB X'EF' EF EF B0065300 DB X'30' F0 0 30 B0065400 DB X'31' F1 1 31 B0065500 DB X'32' F2 2 32 B0065600 DB X'33' F3 3 30 B0065700 DB X'34' F4 4 34 B0065800 DB X'35' F5 5 35 B0065900 DB X'36' F6 6 36 B0066000 DB X'37' F7 7 37 B0066100 DB X'38' F8 8 38 B0066200 DB X'39' F9 9 39 B0066300 DB X'FA' FA FA B0066400 DB X'FB' FB FB B0066500 DB X'FC' FC FC B0066600 DB X'FD' FD FD B0066700 DB X'FE' FE FE B0066800 DB X'FF' FF FF B0066900 ALIGN 2 B0067000 PDATE FBA B0133300 * B0133400 * INITIALIZE BUFFER PARAMETERS B0133500 * STH 0,DAISCHS LOGOFF SVC 1,GET3 LH 0,GET3+2 BNZ LOGOFFE SVC 1,CRAUS LOGOFF1 BAL 15,SEND LH 0,SND+2 BZ LOGOFF CHI 0,X'840B' BE LOGOFF2 CHI 0,X'8405' BNE LOGOFF1 LOGOFF2 BAL 14,RESPONST B LOGOFF1 SPACE 3 *--------------------------------------- * AUF DAS LOGOFF WARTEN * LOGOFFE SVC 1,CWFM SVC 1,WFM B WASDO SPACE 3 WF BAL 14,RESPONST EOJE SVC 1,EOTASK EOJX SVC 3,0 SPACE 3 *--------------------------------------- * KOMMANDOS UEBERTRAGEN * KD XHR 0,0 STH 0,ERWARTG SVC 1,KDO SVC 1,KDI LHI 1,BUFFER AH 1,KDI+12 LIS 2,1 LHI 3,BUFFER+79 SIS 1,1 LHI 0,C' ' KDL STB 0,0(1) KOMMANDO TRAILING BLANKS BXLE 1,KDL KDB1 BAL 15,SEND LH 0,SND+2 BZ KDBE CHI 0,X'840B' BE KDB2 CHI 0,X'8405' BNE KDB1 KDB2 BAL 14,RESPONST B KDB1 SPACE 3 *----------------------------------------- * AUF DIE DURCHFUEHRUNGSLISTE WARTEN * KDBE SVC 1,CWFM SVC 1,WFM B WASDO TITLE BSC EMPFANG MIT TIMEOUT RESPONST BAL 15,RECVT LH 0,RCV+2 BNZR 14 B RTSP0 RTSPONS BAL 15,RECV BNZR 14 RTSP0 LH 0,RCV+12 SVC 2,UNPAK3 LHI 1,DRUBUF+6 LHI 4,INBUF LIS 5,1 LH 6,RCV+12 CHI 6,132 BNP RTSP1 LHI 6,132 RTSP1 AHI 6,-1(4) RTSP2 LB 0,0(4) CHI 0,X'20' BM RTSP3 CHI 0,X'5F' BNP RTSP4 RTSP3 LHI 0,C' ' RTSP4 AIS 1,1 STB 0,0(1) BXLE 4,RTSP2 STH 1,PRINT+6 SVC 1,PRINT B RTSPONS * RECVT LHI 0,X'4100' STH 0,RCV LCS 0,1 STH 0,RCV+2 SVC 1,RCV LH 0,RCV+2 CHI 0,-1 BNER 15 XHR 1,1 RECVT1 SVC 2,WAIT LH 0,RCV+2 CHI 0,-1 BNER 15 AIS 1,1 CH 1,TIMO BNP RECVT1 SVC 1,CKILL SVC 7,CLOSE LB 0,CLOSE+2 SVC 2,UNPAK4 SVC 1,LOG4 SVC 7,OPEN LB 0,OPEN+2 SVC 2,UNPAK5 SVC 1,LOG5 LHR 0,0 BNZ RECVTX LHI 0,X'A100' STH 0,RCV+2 BR 15 RECVTX SVC 3,1 TITLE BSC EMPFANG UND SENDEN RESPONS BAL 15,RECV BNZR 14 LH 0,RCV+12 SVC 2,UNPAK3 LHI 1,DRUBUF+6 LHI 4,INBUF LIS 5,1 LH 6,RCV+12 CHI 6,132 BNP RESP1 LHI 6,132 RESP1 AHI 6,-1(4) RESP2 LB 0,0(4) CHI 0,X'20' BM RESP3 CHI 0,X'5F' BNP RESP4 RESP3 LHI 0,C' ' RESP4 AIS 1,1 STB 0,0(1) BXLE 4,RESP2 STH 1,PRINT+6 SVC 1,PRINT LH 1,ERWARTG BZ RESPONS * SLLS 1,1 LH 1,TABV(1) * LIS 6,1 LIS 7,1 LH 8,0(1) VERGL0 LHR 9,6 SLLS 9,1 AHR 9,1 LH 9,0(9) LHI 2,DRUBUF+7 LIS 3,1 AH 2,0(9) LHR 4,2 AH 4,2(9) SIS 4,1 LHI 5,4(9) VERGL LB 0,0(5) CLB 0,0(2) BNE VERGLX AHR 5,3 BXLE 2,VERGL LIS 0,1 STH 0,DAISCHS XHR 0,0 STH 0,ERWARTG VERGLX BXLE 6,VERGL0 B RESPONS * SEND SVC 1,SND LH 0,SND+2 SVC 2,UNPAK1 SVC 1,LOG1 BR 15 * RECV LHI 0,X'4900' STH 0,RCV SVC 1,RCV LH 0,RCV+2 SVC 2,UNPAK2 SVC 1,LOG2 LH 0,RCV+2 BR 15 TITLE DECLARATIONEN HAUPTPROGRAMM TABV DC 0,TABV1D,TABV2D,TABV3D TABV1D DC 3,TABV1,TABV4,TABV5 TABV2D DC 1,TABV2 TABV3D DC 1,TABV3 TABV1 DC 1,11 DB C'IEF403I RR ' ALIGN 2 TABV2 DC 0,23 DB C'PROCESSING ENDED AT EOD' H×IU IIIIII IIII I!I" I#I$I%I&I'I(I) I*I+I,I-I.I/I0I1 I2I3I4I5I6I7I8I9 I:I;I<I=I>I?I@ IAIBICIDIEIFIGIH IIIJIKILIMINIOIP IQIRISIT ALIGN 2 TABV3 DC 1,25 DB C'IEF161I RD1 READER CLOSED' ALIGN 2 TABV4 DC 1,32 DB C'IE F039I RD1 RDR WAITING FOR WORK' ALIGN 2 TABV5 DC 6,16 DB C'**** KLEINDIENST' ALIGN 2 ERWARTG DC 0 DAISCHS DC 0 RW1 DC X'C009',0,0,0,0,0,0,0,0,0 GET1 DC X'4809',0,BUFFER,BUFFER+79,0,0,0,0,0,0 CRAUSA DC C' --->:' BUFFER DS 80 CRAUSE EQU *-1 WFM DC X'8800',0,0,0,0,0,0,0,0,0 SND DC X'2900',0,BUFFER,BUFFER+79,0,0,0 DC X'2000',X'8000' RCV DC X'4900',0,INBUF,INBUF+511,0,0,0 DC X'2000',X'0000' INBUF DS 512 PRINT DC X'2806',0,DRUBUF,DRUBUF+131,0,0,0,0,0,0 GET2 DC X'4802',0,BUFFER,BUFFER+79,0,0,0,0,0,0 GET3 DC X'4803',0,BUFFER,BUFFER+79,0,0,0,0,0,0 UNPAK1 DC 6,CODE1 UNPAK2 DC 6,CODE2 UNPAK3 DB X'C0',6 DC CODE3 LOG1 DC X'2807',0,LOG1A,LOG1E,0,0,0,0,0,0 LOG1A DB C' Send Code :' CODE1 DB C' ' LOG1E EQU *-1 ALIGN 2 LOG2 DC X'2807',0,LOG2A,LOG2E,0,0,0,0,0,0 LOG2A DB C' Receive Code :' CODE2 DB C' ' LOG2E EQU *-1 ALIGN 2 DRUBUF DB C' ' CODE3 DB C' :' DS 144 ALIGN 2 CLOGON DC X'2808',0,CLOGONA,CLOGONE,0,0,0,0,0,0 CLOGONA DC C' ********** LOGON ************' CLOGONE EQU *-1 ALIGN 2 CJOB DC X'2808',0,CJOBA,CJOBE,0,0,0,0,0,0 CJOBA DC C' ********* JOB ************' CJOBE EQU *-1 ALIGN 2 CLIST DC X'2808',0,CLISTA,CLISTE,0,0,0,0,0,0 CLISTA DC C' ************* LISTE EMPFANG ************' CLISTE EQU *-1 ALIGN 2 CLOGOFF DC X'2808',0,CLOGOFFA,CLOGOFFE,0,0,0,0,0,0 CLOGOFFA DC C' *********** LOGOFF *************' CLOGOFFE EQU *-1 ALIGN 2 CEOJ DC X'2808',0,CEOJA,CEOJE,0,0,0,0,0,0 CEOJA DC C' *********** EOJ EMPFANG ************' CEOJE EQU *-1 ALIGN 2 CWFM DC X'2808',0,CWFMA,CWFME,0,0,0,0,0,0 CWFMA DC C' ********* WFM ***********' CWFME EQU *-1 ALIGN 2 CRAUS DC X'2808',0,CRAUSA,CRAUSE,0,0,0,0,0,0 CLOGONR DC X'2808',0,CLOGONRA,CLOGONRE,0,0,0,0,0,0 CLOGONRA DC C' ******* LOGON RESPONSE **********' CLOGONRE EQU *-1 ALIGN 2 ANFANG DC X'2805',0,ANFANGA,ANFANGE,0,0,0,0,0,0 ANFANGA DC C' Logon fertig ?' ANFANGE EQU *-1 ALIGN 2 ANSWER DC X'4805',0,ANSWERA,ANSWERE,0,0,0,0,0,0 ANSWERA DS 80 ANSWERE EQU *-1 ALIGN 2 ENDE DC X'2805',0,ENDEA,ENDEE,0,0,0,0,0,0 ENDEA DC C' Logoff fertig ?' ENDEE EQU *-1 ALIGN 2 NOWEND DC X'2805',0,NOWENDA,NOWENDE,0,0,0,0,0,0 NOWENDA DC C' Kann LOGOFF gemacht werden ?' NOWENDE EQU *-1 ALIGN 2 WAIT DB X'80',23 DC 0 DC X'1000',1000 CKILL DC X'2808',0,CKILLA,CKILLE,0,0,0,0,0,0 CKILLA DC C' *** CLOSE READ WEGEN TIMEOUT ***' CKILLE EQU *-1 ALIGN 2 CLOSE DC X'0400' DC 0,0,0 DC C'RJE ' DC C' ' DB C' ',0 DC 0,0 UNPAK4 DC 6,CODE4 LOG4 DC X'2807',0,LOG4A,LOG4E,0,0,0,0,0,0 LOG4A DB C' CLOSE STATUS=' CODE4 DB C' ' LOG4E EQU *-1 ALIGN 2 OPEN DC X'40E0' DC 0,0,0 DC C'RJE ' DC C' ' DB C' ',0 DC 0,0 UNPAK5 DC 6,CODE5 LOG5 DC X'2807',0,LOG5A,LOG5E,0,0,0,0,0,0 LOG5A DB C' OPEN STATUS=' CODE5 DB C' ' LOG5E EQU *-1 ALIGN 2 EOD DC X'2805',0,EODA,EODE,0,0,0,0,0,0 EODA DC C' Job fertig uebertragen. Warten auf RUN' EODE EQU *-1 ALIGN 2 EOTASK DC X'2805',0,EOTASKA,EOTASKE,0,0,0,0,0,0 EOTASKA DC C' Alles in Ordnung: Daten gespeichert' EOTASKE EQU *-1 ALIGN 2 TIMOUTX DC X'2805',0,TIMOUTXA,TIMOUTXE,0,0,0,0,0,0 TIMOUTXA DC C' time out ' TIMOUTXE EQU *-1 ALIGN 2 WASDOX DC X'2805',0,WASDOXA,WASDOXE,0,0,0,0,0,0 WASDOXA DC C' ? ' WASDOXE EQU *-1 ALIGN 2 HANO DC X'2805',0,HANOA,HANOE,0,0,0,0,0,0 HANOA DC C' was willsch ? (XX,LO,WO,JO,WJ,LF,WF,KD) ' HANOE EQU *-1 ALIGN 2 KDO DC X'2805',0,KDOA,KDOE,0,0,0,0,0,0 KDOA DC C' ?? ' KDOE EQU *-1 ALIGN 2 KDI DC X'4805',0,BUFFER,BUFFER+79,0,0,0,0,0,0 TITLE PN BEARBEITUNG XFER STM 0,SAVXFER SPACE 3 *------------------------------------------ * PN INHALTSFILE ANHAENGEN * L19 SVC 1,FF SPACE 3 *------------------------------------------ * SCHLEIFE UEBER ALLE PN * L20 LIS 0,1 AHM 0,ZPN LH 0,ZPN CH 0,ZPNTAB BP L40 ALLES ABGEARBEITET SPACE 3 *------------------------------------------- * EINE PN UEBERTRAGEN * LH 3,ZPN SIS 3,1 MH 2,K18 LHI 1,PNTAB(3) STH 1,L31 BAL 15,PNOP OPEN DFU FILE DC 6 L31 DC *-* NAME DC STATUS LH 0,STATUS BNZ L20 DER FILE LAESST SICH NET ANSPRECHEN SPACE 1 L32 SVC 1,GETDFU EINEN SATZ LESEN (DATEN) LH 0,GETDFU+2 BNZ L39 SPACE 1 BAL 15,SENDEN UND AUSGEBEN AUF DIE LEITUNG DC 6 DC DATEN DC K50 B L32 SPACE 1 L39 BAL 15,PNCL CLOSE DFU FILE DC 2 SPACE 3 *----------------------------------------- * PN IN INHALTSFILE EINTRAGEN * LH 0,L31 NAME STH 0,L38 BAL 15,CTL DC 4 L38 DC *-* NAME B L20 SPACE 3 L40 LM 0,SAVXFER BR 15 TITLE DECLARATIONEN PN BEARBEITUNG SAVXFER DS 32 MPNTAB DC 200 ANZAHL MAX. PN FILES AUF EINEN SCHWUNG ZPNTAB DC 0 ANZAHL VORHANDENER PN FILES PNTAB DS 18*200 PN TABELLE LOGNIX DC 7,LOGNIXE-LOGNIXA LOGNIXA DB C' keine Daten fuer BSC Uebertragung da' LOGNIXE EQU * ALIGN 2 FF DC X'840A',0,0,0,0,0,0,0,0,0 ZPN DC 0 LAUFENDER PN-INDEX IN PNTAB K18 DC 18 STATUS DC 0 GETDFU DC X'4804',0,DATEN,DATEN+49,0,0,0,0,0,0 DATEN DS 50 K50 DC 50 TITLE SUBROUTINES *----------------------------------------- * SENDEN : SENDEN MIT BSC * CALL SENDEN(DATEN,LAENGE) * SENDEN STM 0,SAVAR LH 1,2(15) SOURCE LIS 2,1 LH 3,4(15) LH 3,0(3) AHI 3,-1(1) LHI 4,BUFFER SPACE 1 SND1 LB 5,0(1) DATEN IN PUFFER REIN LB 0,BSCTAB(5) ABER SCHOEN KONVERTIERT ZUM KONVERT STB 0,0(4) AHR 4,2 BXLE 1,SND1 SPACE 1 LHI 0,C' ' REST PUFFER LOESCHEN LIS 5,1 LHI 6,BUFFER+79 SND2 STB 0,0(4) BXLE 4,SND2 SPACE 1 SND3 BAL 15,SEND RAUS DAMIT LH 0,SND+2 WIE GINGS >? BZ SENDEX GUAT SPACE 1 CHI 0,X'840B' SOLL EINE LISTE DAZWISCHEN REIN? BE SND4 CHI 0,X'8405' BNE SND3 DAS WAR KOMISCH, RETRY SPACE 1 SND4 BAL 14,RESPONST HER MIT DER LISTE B SND3 ABER JETZT KOMM I SPACE 1 SENDEX LM 0,SAVAR AH 15,0(15) BR 15 TITLE SUBROUTINES *------------------------------------------ * PNOP : PN FILECHEN EROEFFNEN * CALL PNOP(NAME,STATUS) * PNOP STM 0,SAVAR LH 1,2(15) NAME LIS 2,1 LHI 3,7(1) LHI 4,FDNAM PNOP1 LB 0,0(1) STB 0,0(4) AHR 4,2 BXLE 1,PNOP1 SPACE 1 LHI 0,X'4000' OPEN VERSUCH STH 0,OPCLS SVC 7,OPCLS LB 0,OPCLS+2 LH 1,4(15) STATUS STH 0,0(1) SPACE 1 SVC 2,UNPAK6 LM 12,FDNAM PN ANZEIGEN STM 12,PNDISPL SVC 2,LOG6 SPACE 1 LM 0,SAVAR AH 15,0(15) BR 15 TITLE SUBROUTINES *------------------------------------------ * CTL : PN NAME IN INHALTSFILE REIN * CALL CTL(NAME) * CTL STM 0,SAVAR SPACE 1 SVC 2,TIM TIME OF DAY SVC 2,DAT DAY OF DAY LH 1,2(15) LIS 2,1 LHI 3,7(1) LHI 4,CTLAR NAME OF PN CTL1 LB 0,0(1) STB 0,0(4) AHR 4,2 BXLE 1,CTL1 SPACE 1 SVC 1,PUTCLT REIN IN DEN INHALTSFILE SPACE 1 LM 0,SAVAR AH 15,0(15) BR 15 TITLE SUBROUTINES *------------------------------------------ * PNCL : CLOSE PN FILECHEN * CALL PNCL * PNCL STM 0,SAVAR SPACE 1 LHI 0,X'0400' CLOSE IT STH 0,OPCLS SVC 7,OPCLS SPACE 1 LHI 0,X'0200' DELETE IT STH 0,OPCLS SVC 7,OPCLS SPACE 1 LM 0,SAVAR AH 15,0(15) BR 15 TITLE EBCDIC TO ASCII TRANSLATION TABLE B0040800 * B0040900 * EBCDIC TO ASCII TRANSLATION TABLE B0041000 * A 256 BYTE TABLE B0041100 * B0041200 BSCTAB EQU * DB X'00' 00 NUL 00 B0041400 DB X'01' SOH B0041500 DB X'02' STX B0041600 DB X'03' ETX B0041700 DB X'80' 04 BF 80 (NO ASCII EQUIV) B0041800 DB X'09' 05 HT 09 B0041900 DB X'81' 06 OC 81 (NO ASCII EQUIV) B0042000 DB X'7F' 07 DEL 7F B0042100 DB X'82' 08 82 B0042200 DB X'83' 09 RLF 83 (NO ASCII EQUIV) B0042300 DB X'84' 0A SMM 84 (NO ASCII EQUIV) B0042400 DB X'0B' 0B VT 0B B0042500 DB X'0C' 0C FF 0C B0042600 DB X'0D' 0D CR 0D B0042700 DB X'0E' 0E GO 0E B0042800 DB X'0F' 0F SI 0F B0042900 DB X'10' 10 DLE 10 B0043000 DB X'11' 11 DC1 11 B0043100 DB X'12' 12 DC2 12 B0043200 DB X'13' 13 DC3 13 B0043300 DB X'85' 14 RES 85 (NO ASCII EQUIV) B0043400 DB X'86' 15 NL 85 (NO ASCII EQUIV) B0043500 DB X'08' 16 BS 08 B0043600 DB X'87' 17 IL 87 (NO ASCII EQUIV) B0043700 DB X'18' 18 CAN 18 B0043800 DB X'19' 19 EM 19 B0043900 DB X'88' 1A CC 88 (NO ASCII EQUIV) B0044000 DB X'89' 1B 89 B0044100 DB X'1C' 1C IFS 1C (FS) B0044200 DB X'1D' 1D IGS 1D (GS) B0044300 DB X'1E' 1E IRS 1EW (RS) B0044400 DB X'1F' 1F IVS 1F (US) B0044500 DB X'90' 20 DS 90 (NO ASCII EQUIV) B0044600 DB X'91' 21 SOS 91 (NO ASCII EQUIV) B0044700 DB X'92' 22 BS 92 (ASCII FS=EBCDIC IFS) B0044800 DB X'93' 23 93 B0044900 DB X'94' 24 BYP 94 (NO ASCII EQUIV) B0045000 DB X'0A' 25 LF 0A B0045100 DB X'17' 26 ETB 17 B0045200 DB X'1B' 27 BSC 1B /PRE B0045300 DB X'95' 28 95 B0045400 DB X'96' 29 96 B0045500 DB X'97' 2A SM 97 B0045600 DB X'98' 2B 98 B0045700 DB X'99' 2C 99 B0045800 DB X'05' 2D ENQ 05 B0045900 DB X'06' 2E ACK 06 B0046000 DB X'07' 2F BEL 07 B0046100 DB X'A0' 30 A0 B0046200 DB X'A1' 31 A1 B0046300 DB X'16' 32 SYN 16 B0046400 DB X'A2' 33 A2 B0046500 DB X'A3' 34 BM A3 (NO ASCII EQUIV) B0046600 DB X'A4' 35 RS A4 (ASCII RS=EBCDIC IRS) B0046700 DB X'A5' 36 DC A5 (NO ASCII EQUIV) B0046800 DB X'04' 37 EOT 04 B0046900 DB X'A6' 38 A6 B0047000 DB X'A7' 39 A7 B0047100 DB X'A8' 3A A8 B0047200 DB X'A9' 3B A9 B0047300 DB X'14' 3C DC4 14 B0047400 DB X'15' 30 NAK 15 B0047500 DB X'F9' 3E F9 B0047600 DB X'1A' 3F SUB 1A B0047700 DB X'20' 40 SP 20 B0047800 DB X'C1' 41 C1 B0047900 DB X'C2' 42 C2 B0048000 DB X'C3' 43 C3 B0048100 DB X'C4' 44 C4 B0048200 DB X'C5' 45 C5 B0048300 DB X'C6' 46 C6 B0048400 DB X'C7' 47 C7 B0048500 DB X'C8' 48 C8 B0048600 DB X'C9' '9 C9 B0048700 DB X'5B' 4A 5B F CENT = A ( B0048800 DB X'2E' 4B . 2E B0048900 DB X'3C' 4C < 3C B0049000 DB X'28' 4D ( 28 B0049100 DB X'2B' 4E + 2B B0049200 DB X'5D' 4F ) 5D F VBAR = A ) B0049300 DB X'26' 50 & 26 B0049400 DB X'D1' 51 D1 B0049500 DB X'D2' 52 D2 B0049600 DB X'D3' 53 D3 B0049700 DB X'D4' 54 D4 B0049800 DB X'D5' 55 D5 B0049900 DB X'D6' 56 D6 B0050000 DB X'D7' 57 D7 B0050100 DB X'D8' 58 D8 B0050200 DB X'D9' 59 D9 B0050300 DB X'21' 5A ! 21 B0050400 DB X'24' 5B 24 B0050500 DB X'2A' 5C + 2A B0050600 DB X'29' 5D ) 29 B0050700 DB X'3B' 5E : 3B B0050800 DB X'5E' 5F 5E B0050900 DB X'2D' 60 - 2D B0051000 DB X'2F' 61 / 2F B0051100 DB X'E2' 62 E2 B0051200 DB X'E3' 63 E3 B0051300 DB X'E4' 6' E4 B0051400 DB X'E5' 65 E5 B0051500 DB X'E6' 66 E6 B0051600 DB X'E7' 67 E7 B0051700 DB X'E8' 68 E8 B0051800 DB X'E9' 69 E9 B0051900 DB X'7C' 6A DVC C DOUBLE VERT BAR B0052000 DB X'2C' 6B ' 2C B0052100 DB X'25' 6C % 25 B0052200 DB X'5F' 6D < 5F UNDERLINE B0052300 DB X'3E' 6E > 3E B0052400 DB X'3F' 6F ? 3F B0052500 DB X'F0' 70 F0 B0052600 DB X'F1' 71 F1 B0052700 DB X'F2' 72 F2 B0052800 DB X'F3' 73 F3 B0052900 DB X'F4' 74 F4 B0053000 DB X'F5' 55 F5 B0053100 DB X'F6' 76 F6 B0053200 DB X'F7' 77 F7 B0053300 DB X'F8' 78 F8 B0053400 DB X'60' 79 BKA 60 BACK APOSTROPHE B0053500 DB X'3A' 7A : 3A B0053600 DB X'23' 7B # 23 B0053700 DB X'40' 7C @ 40 B0053800 DB X'27' 7D ' 27 B0053900 DB X'3D' 7E V 3D B0054000 DB X'22' 7F " 22 B0054100 DB X'C0' 80 C0 B0054200 DB X'61' 81 A 61 (LOWER CASE) B0054300 DB X'62' 82 B 62 (LOWER CASE) B0054400 DB X'63' 83 C 63 (LOWER CASE) B0054500 DB X'64' 84 D 64 (LOWER CASE) B0054600 DB X'65' 85 E 65 (LOWER CASE) B0054700 DB X'66' 86 F 66 (LOWER CASE) B0054800 DB X'67' 87 G 67 (LOWER CASE) B0054900 DB X'68' 88 H 68 (LOWER CASE) B0055000 DB X'69' 89 I 69 (LOWER CASE) B0055100 DB X'8A' 8A 8A B0055200 DB X'8B' 8B 8B B0055300 DB X'8C' 8C 8C B0055400 DB X'8D' 8D 8D B0055500 DB X'8E' 8E 8E B0055600 DB X'8F' 8F 8F B0055700 DB X'D0' 90 D0 B0055800 DB X'6A' 91 J 6A (LOWER CASE) B0055900 DB X'6B' 92 K 6B (LOWER CASE) B0056000 DB X'6C' 93 L 6C (LOWER CASE) B0056100 DB X'6D' 94 M 6D (LOWER CASE) B0056200 DB X'6E' 95 N 6E (LOWER CASE) B0056300 DB X'6F' 96 O 6F (LOWER CASE) B0056400 DB X'70' 97 P 70 (LOWER CASE) B0056500 DB X'71' 98 Q 71 (LOWER CASE) B0056600 DB X'72' 99 R 72 (LOWER CASE) B0056700 DB X'9A' 9A 9A B0056800 DB X'9B' 9B 9B B0056900 DB X'9C' 9C 9C B0057000 DB X'9D' 9D 9D B0057100 DB X'9E' 9E 9E B0057200 DB X'9F' 9F 9F B0057300 DB X'E0' A0 E0 B0057400 DB X'7E' A1 NOT 7E (SIMILAR) B0057500 DB X'73' A2 S 73 (LOWER CASE) B0057600 DB X'74' A3 T 74 (LOWER CASE) B0057700 DB X'75' A4 U 75 (LOWER CASE) B0057800 DB X'76' A5 V 76 (LOWER CASE) B0057900 DB X'77' A6 W 77 (LOWER CASE) B0058000 DB X'78' A7 X 78 (LOWER CASE) B0058100 DB X'79' A8 Y 79 (LOWER CASE) B0058200 DB X'7A' A9 Z 7A (LOWER CASE) B0058300 DB X'AA' AA AA B0058400 DB X'AB' AB AB B0058500 DB X'AC' AC AC B0058600 DB X'AD' AD AD B0058700 DB X'AE' AE AE B0058800 DB X'AF' AF AF B0058900 DB X'B0' B0 B0 B0059000 DB X'B1' B1 B1 B0059100 DB X'B2' B2 B2 B0059200 DB X'B3' B3 B3 B0059300 DB X'B4' B4 B4 B0059400 DB X'B5' B5 B5 B0059500 DB X'B6' B6 B6 B0059600 DB X'B7' B7 B7 B0059700 DB X'B8' B8 B8 B0059800 DB X'B9' B9 B9 B0059900 DB X'BA' BA BA B0060000 DB X'BB' BB BB B0060100 DB X'BC' BC BC B0060200 DB X'BD' BD BD B0060300 DB X'BE' BE BE B0060400 DB X'BF' BF BF B0060500 DB X'7B' C0 LHB 7B LEFT BRACKET B0060600 DB X'41' C1 A 41 B0060700 DB X'42' C2 B 42 B0060800 DB X'43' C3 C 43 B0060900 DB X'44' C4 D 44 B0061000 DB X'45' C5 E 45 B0061100 DB X'46' CL F 46 B0061200 DB X'47' C7 G 47 B0061300 DB X'48' C8 H 48 B0061400 DB X'49' C9 I 49 B0061500 DB X'CA' CA CA B0061600 DB X'CB' CB CB B0061700 DB X'CC' CC CC B0061800 DB X'CD' CD CD B0061900 DB X'CE' CE CE B0062000 DB X'CF' CF CF B0062100 DB X'7D' DO RHB 7D RIGHT BRACKET B0062200 DB X'4A' D1 J 4A B0062300 DB X'4B' D2 K 4B B0062400 DB X'4C' D3 L 4C B0062500 DB X'4D' D4 M 4D B0062600 DB X'4E' D5 N 4E B0062700 DB X'4F' D6 O 4F B0062800 DB X'50' D7 P 50 B0062900 DB X'51' D8 Q 51 B0063000 DB X'52' D9 R 52 B0063100 DB X'DA' DA DA B0063200 DB X'DB' DB DB B0063300 DB X'DC' DC DC B0063400 DB X'DD' DD DD B0063500 DB X'DE' DE DE B0063600 DB X'DF' DF DF B0063700 DB X'5C' E0 DB X'E1' E1 E1 B0063900 DB X'53' E2 53 B0064000 DB X'54' E3 T 54 B0064100 DB X'55' E4 U 55 B0064200 DB X'56' E5 V 56 B0064300 DB X'57' E6 W 57 B0064400 DB X'58' E7 X 58 B0064500 DB X'59' E8 Y 59 B0064600 DB X'5A' E9 Z 5A B0064700 DB X'EA' EA EA B0064800 DB X'EB' EB EB B0064900 DB X'EC' EC EC B0065000 DB X'ED' ED ED B0065100 DB X'EE' EE EE B0065200 DB X'EF' EF EF B0065300 DB X'30' F0 0 30 B0065400 DB X'31' F1 1 31 B0065500 DB X'32' F2 2 32 B0065600 DB X'33' F3 3 30 B0065700 DB X'34' F4 4 34 B0065800 DB X'35' F5 5 35 B0065900 DB X'36' F6 6 36 B0066000 DB X'37' F7 7 37 B0066100 DB X'38' F8 8 38 B0066200 DB X'39' F9 9 39 B0066300 DB X'FA' FA FA B0066400 DB X'FB' FB FB B0066500 DB X'FC' FC FC B0066600 DB X'FD' FD FD B0066700 DB X'FE' FE FE B0066800 DB X'FF' FF FF B0066900 ALIGN 2 B0067000 TITLE DECLARATIONEN SUBROUTINES SAVAR DS 32 OPCLS DC 0 OPEN/CLOSE PN FILECHEN B0050700 DB X'3B' 5E : 3B B0050800 DB X'5E' 5F 5E B0050900 DB X'2D' 60 - 2D B0051000 DB X'2F' 61 / 2F B0051100 DB X'E2' 62 E2 B0051200 DB X'E3' 63 E3 B0051300 DB X'E4' 6' E4 B0051400 DB X'E5' 65 E5 B0051500 DB X'E6' 66 E6 B0051600 DB X'E7' 67 E7 B0051700 DB X'E8' 68 E8 B0051800 DB X'E9' 69 E9 B0051900 DB X'7C' 6A DVC C DOUBLE VERT BAR B0052000 DB X'2C' 6B ' 2C B0052100 DB X'25' 6C % 25 B0052200 DB X'5F' 6D < 5F UNDERLINE B0052300 DB X'3E' 6E > 3E B0052400 DB X'3F' 6F ? 3F B0052500 DB X'F0' 70 F0 B0052600 DB X'F1' 71 F1 B0052700 DB X'F2' 72 F2 B0052800 DB X'F3' 73 F3 B0052900 DB X'F4' 74 F4 B0053000 DB X'F5' 55 F5 B0053100 DB X'F6' 76 F6 B0053200 DB X'F7' 77 F7 B0053300 DB X'F8' 78 F8 B0053400 DB X'60' 79 BKA 60 BACK APOSTROPHE B0053500 DB X'3A' 7A : 3A B0053600 DB X'23' 7B # 23 B0053700 DB X'40' 7C @ 40 B0053800 DB X'27' 7D ' 27 B0053900 DB X'3D' 7E V 3D B0054000 DB X'22' 7F " 22 B0054100 DB X'C0' 80 C0 B0054200 DB X'61' 81 A 61 (LOWER CASE) B0054300 DB X'62' 82 B 62 (LOWER CASE) B0054400 DB X'63' 83 C 63 (LOWER CASE) B0054500 DB X'64' 84 D 64 (LOWER CASE) B0054600 DB X'65' 85 E 65 (LOWER CASE) B0054700 DB X'66' 86 F 66 (LOWER CASE) B0054800 DB X'67' 87 G 67 (LOWER CASE) B0054900 DB X'68' 88 H 68 (LOWER CASE) B0055000 DB X'69' 89 I 69 (LOWER CASE) B0055100 DB X'8A' 8A 8A B0055200 DB X'8B' 8B 8B B0055300 DB X'8C' 8C 8C B0055400 DB X'8D' 8D 8D B0055500 DB X'8E' 8E 8E B0055600 DB X'8F' 8F 8F B0055700 DB X'D0' 90 D0 B0055800 DB X'6A' 91 J 6A (LOWER CASE) B0055900 DB X'6B' 92 K 6B (LOWER CASE) B0056000 DB X'6C' 93 L 6C (LOWER CASE) B0056100 DB X'6D' 94 M 6D (LOWER CASE) B0056200 DB X'6E' 95 N 6E (LOWER CASE) B0056300 DB X'6F' 96 O 6F (LOWER CASE) B0056400 DB X'70' 97 P 70 (LOWER CASE) B0056500 DB X'71' 98 Q 71 (LOWER CASE) B0056600 DB X'72' 99 R 72 (LOWER CASE) B0056700 DB X'9A' 9A 9A B0056800 DB X'9B' 9B 9B B0056900 DB X'9C' 9C 9C B0057000 DB X'9D' 9D 9D B0057100 DB X'9E' 9E 9E B0057200 DB X'9F' 9F 9F B0057300 DB X'E0' A0 E0 B0057400 DB X'7E' A1 NOT 7E (SIMILAR) B0057500 DB X'73' A2 S 73 (LOWER CASE) B0057600 DB X'74' A3 T 74 (LOWER CASE) B0057700 DB X'75' A4 U 75 (LOWER CASE) B0057800 DB X'76' A5 V 76 (LOWER CASE) B0057900 DB X'77' A6 W 77 (LOWER CASE) B0058000 DB X'78' A7 X 78 (LOWER CASE) B0058100 DB X'79' A8 Y 79 (LOWER CASE) B0058200 DB X'7A' A9 Z 7A (LOWER CASE) B0058300 DB X'AA' AA AA B0058400 DB X'AB' AB AB B0058500 DB X'AC' AC AC B0058600 DB X'AD' AD AD B0058700 DB X'AE' AE AE B0058800 DB X'AF' AF AF B0058900 DB X'B0' B0 B0 B0059000 DB X'B1' B1 B1 B0059100 DB X'B2' B2 B2 B0059200 DB X'B3' B3 B3 B0059300 DB X'B4' B4 B4 B0059400 DB X'B5' B5 B5 B0059500 DB X'B6' B6 B6 B0059600 DB X'B7' B7 B7 B0059700 DB X'B8' B8 B8 B0059800 DB X'B9' B9 B9 B0059900 DB X'BA' BA BA B0060000 DB X'BB' BB BB B0060100 DB X'BC' BC BC B0060200 DB X'BD' BD BD B0060300 DB X'BE' BE BE B0060400 DB X'BF' BF BF B0060500 DB X'7B' C0 LHB 7B LEFT BRACKET B0060600 DB X'41' C1 A 41 B0060700 DB X'42' C2 B 42 B0060800 DB X'43' C3 C 43 B0060900 DB X'44' C4 D 44 B0061000 DB X'45' C5 E 45 B0061100 DB X'46' CL F 46 B0061200 DB X'47' C7 G 47 B0061300 DB X'48' C8 H 48 B0061400 DB X'49' C9 I 49 B0061500 DB X'CA' CA CA B0061600 DB X'CB' CB CB B0061700 DB X'CC' CC CC B0061800 DB X'CD' CD CD B0061900 DB X'CE' CE CE B0062000 DB X'CF' CF CF B0062100 DB X'7D' DO RHB 7D RIGHT BRACKET B0062200 DB X'4A' D1 J 4A B0062300 DB X'4B' D2 K 4B B0062400 DB X'4C' D3 L 4C B0062500 DB X'4D' D4 M 4D B0062600 DB X'4E' D5 N 4E B0062700 DB X'4F' D6 O 4F B0062800 DB X'50' D7 P 50 B0062900 DB X'51' D8 Q 51 B0063000 DB X'52' D9 R 52 B0063100 DB X'DA' DA DA B0063200 DB X'DB' DB DB B0063300 DB X'DC' DC DC B0063400 DB X'DD' DD DD B0063500 DB X'DE' DE DE B0063600 DB X'DF' DF DF B0063700 DB X'5C' E0 DB X'E1' E1 E1 B0063900 DB X'53' E2 53 B0064000 DB X'54' E3 T 54 B0064100 DB X'55' E4 U 55 B0064200 DB X'56' E5 V 56 B0064300 DB X'57' E6 W 57 B0064400 DB X'58' E7 X 58 B0064500 DB X'59' E8 Y 59 B0064600 DB X'5A' E9 Z 5A B0064700 DB X'EA' EA EA B0064800 DB X'EB' EB EB B0064900 DB X'EC' EC EC B0065000 DB X'ED' ED ED B0065100 DB X'EE' EE EE B0065200 DB X'EF' EF EF B0065300 DB X'30' F0 0 30 B0065400 DB X'31' F1 1 31 B0065500 DB X'32' F2 2 32 B0065600 DB X'33' F3 3 30 B0065700 DB X'34' F4 4 34 B0065800 DB X'35' F5 5 35 B0065900 DB X'36' F6 6 36 B0066000 DB X'37' F7 7 37 B0066100 DB X'38' F8 8 38 B0066200 DB X'39' F9 9 39 B0066300 DB X'FA' FA FA B0066400 DB X'FB' FB FB B0066500 DB X'FC' FC FC B0066600 DB X'FD' FD FD B0066700 DB X'FE' FE FE B0066800 DB X'FF' FF FF B0066900 ALIGN 2 B0067000 TITLE DECLARATIONEN SUBROUTINES SAVAR DS 32 OPCLS DC 0 OPEN/CLOSE PN FILECHEN DC 4 DC 0,0 DC C'DATA' FDNAM DS 8 DB C'DFU' DB 0 DC 0,0 UNPAK6 DC 6,CODE6 LOG6 DC 7,LOG6E-LOG6A LOG6A DB C' PN ' PNDISPL DS 8 DB C' Status ' CODE6 DB C' ' LOG6E EQU * ALIGN 2 TIM DC 8,TIME DAT DC 9,DAY CTLAR DS 8 PN NAME DAY DS 8 TAGESDATUM DC C' ' TIME DS 8 UHRZEIT PUTCLT DC X'280A',0,CTLAR,CTLAR+25,0,0,0,0,0,0 TITLE PNSRT - PRIMANOTA TABELLE ERSTELLEN *------------------------------------------------ * * CALL PNSRT(MAXENTRY,TABENTRY,PNTABLE); * * MAXENTRY: MAX. ANZAHL EINTRAGE * TABENTRY: AKTUELLE ANZAHL EINTRAEGE * PNTABLE: PN-TABELLE * * PN EINTRAG PNHEAD STRUC PN.NAME DS 8 NAME DER PN PN.LRECL DS 2 SATZLAENGE PN.NRECS DS 2 ANZAHL SAETZE PN.DATE DS 4 DATUM DER ERSTELLUNG (YMD) PN.TIME DS 2 UHRZEIT DER ERSTELLUNG (HM) ENDS * *------------------------------------------------ * * LOGICAL UNITS INLUN EQU 1 OUTLUN EQU 2 * * * OFFSET EINTRAG EINES DIRECTORY BLOCKS(=SEKTOR) DBFINA EQU 0 ; FILENAME (8 BYTE) DBFLBA EQU 12 ; FLBA (4 BYTES) DBLLBA EQU 16 ; LLBA (4 BYTES) DBKEYS EQU 20 ; WRITE/READ KEYS - JE 1 BYTE DBLREC EQU 22 ; LOGICAL RECORD LENG (INDEXED) DBCRE EQU 24 ; CREATE DATUM DBWRI EQU 28 ; WRITTEN DATUM DBSTAT EQU 36 ; FILE STATUS(1 BYTE): * BIT 1 - FILE TYP * 1= INDEXED * 0= CONTIGUOUS * BIT 3 - ENTRY STATUS * 1=BESETZT * 0=GELOESCHT DBNLR EQU 42 DBLENG EQU 48 ;LAENGE EINES EINTRAGES * *--------------------------------- * REGISTER R0 EQU 0 R1 EQU 1 R2 EQU 2 R3 EQU 3 R4 EQU 4 R5 EQU 5 R6 EQU 6 R7 EQU 7 R8 EQU 8 R9 EQU 9 R10 EQU 10 R11 EQU 11 R12 EQU 12 R13 EQU 13 R14 EQU 14 R15 EQU 15 *********************************** TITLE PNSRT - MAIN * *************************************************************** * * * PNS ERSTELLT EINE TABELLE DER PRIMANOTA, * * NACH DATUM UND UHRZEIT AUFSTEIGEND SORTIERT. * * * * SORTIERT WIRD IM 'INSERT' VERFAHREN; D.H., * EIN EINTRAG WIRD IMMER SOFORT AN DER RICHTIGEN * STELLE IN DIE TABELLE EINGETRAGEN. FALLS DER PUFFER * NICHT AUSREICHT, FALLEN MANCHE EINTRAEGE AUS DEM * PUFFER. * **************************************************************** SPACE 248 SPACE 2 SPACE 2 PNSRT EQU * *-------------------------------------------------- * AUS PARAMETERN: * ETAB: ADR. PN-TABLE * ETE: ADR. ENDE PN-TABLE * MENTRY: MAX. ANZAHL EINTRAEGE IN TABELLE STM R0,SAVEREGS LM R13,2(R15) LH R1,0(R13) MAX. ANZAHL EINTRAEGE STH R1,MENTRY XHR R0,R0 STH R0,0(R14) TABENTRY <- 0; STH R15,ETAB ADR. PN-TABLE LHI R0,PNHEAD LAENGE EINES EINTRAGES MHR R0,R0 LAENGE DER PN-TABLE AHR R15,R1 ENDE DER PN-TABLE SIS R15,1 STH R15,ETE ADDR. MERKEN LM R0,SAVEREGS REGISTER RESTOREN *-------------------------------------- LHI R5,REGSAVE *SET DIRECTORY SVC ADR LHI 14,DIRBLK LHI 15,255(14) STM 14,RDDIR+4 SPACE 2 * INIT FELDER LIS R8,1 R8=TRUE SPACE 1 LH R1,ETAB LIS R2,2 ENTRIES LH R3,ETE LHI R0,X'7FFF' INIT MIT MAX. WERT EINIT STH R0,0(R1) BXLE R1,EINIT SPACE 1 XHR R9,R9 STH R9,EOF LCS R0,1 STH R0,DIRPTR * P200 EQU * LHI R1,MASKE BAL R15,PNSNE GET NXT DIR. ENTRY LH R0,EOF BNZ P300 ENDE DER DIRECTORY XHR R8,R8 R8=FALSE SPACE 1 LHI R1,ENTRY BAL R15,PNSSE SET UP ENTRY SPACE 1 LHR R9,R9 1. ENTRY? BP P220 SPACE 1 * 1. EINTRAG LHI R1,ENTRY LH R2,ETAB SVC 2,MOVENTRY ENTRY ---> ETAB(1,1) LIS R9,1 R9=1 B P200 SPACE 2 *******************SORTLOOP**************** P220 EQU * LIS R12,1 LIS R13,1 LH R14,MENTRY LOOP OVER MAX. ENTRIES SORTLOOP EQU * LHI R1,ENTRY ENTRY PTR FOR VERGLEICH LHI R3,-1(R12) LHI R2,PNHEAD MHR R2,R2 LHR R2,R3 AH R2,ETAB BAL R15,PNSCE VGL: ENTRY <-> ETAB(1,I) LH R0,RECODE RECODE ? BNZ P290 ENTRY IST GROESSER * ENTRY EINSCHIEBEN AIS R9,1 INCRE ANZ. ENTRIES CH R9,MENTRY MAX. ERRIECHT? BNP P230 SPACE 1 LH R9,MENTRY OVERFLOW! P230 LHR R4,R9 J=R9 * PLATZ MACHEN FUER NEUEN ENTRY P240 CAR R4,R12 I <-> J BE P260 LHI R3,-1(R4) OFFSET ETAB(1,J) BERECHNEN LHI R2,PNHEAD MHR R2,R2 LH R2,ETAB AHR R2,R3 LHI R1,-PNHEAD(R2) OFFSET ETAB(1,L) BERECHNEN SVC 2,MOVENTRY ETAB(1,L) ---> ETAB(1,J) SIS R4,1 J=J-1 B P240 SPACE 1 P260 EQU * ENTRY ---> ETAB(1,I) LHI R3,-1(R12) OFFSET ETAB(1,I) BERECHNEN LHI R2,PNHEAD MHR R2,R2 LH R2,ETAB AHR R2,R3 LHI R1,ENTRY SVC 2,MOVENTRY INSERT ENTRY B P295 P290 BXLE R12,SORTLOOP P295 B P200 * * DIRECTORY FERTIG * P300 EQU * * P900 EQU * STH R9,TABENTRY ANZAHL EINTRAEGE LH R15,SAVEREGS+30 LM R13,2(R15) LH R0,TABENTRY STH R0,0(R14) AKT. ANZAHL EINTRAEGE * LM R0,SAVEREGS AH R15,0(R15) BR R15 TITLE PNSSE - BUILD ENTRY AUS DIRECTORY EINTRAG * REG 1 BEKOMMT ADDRESS ENTRY PNSSE EQU * AHI R5,2*16 STM R8,-2*16(R5) SPACE 2 LHR R8,R1 SPACE 2 LH R1,INDXDB SIS R1,1 LHI R0,DBLENG MHR R0,R0 AIS R1,4 OFFSET BERECHNEN LHR R9,R1 AHI R9,DIRBLK DIRBLK(OFFSET) * SET FILENAME LM R12,DBFINA(R9) STM R12,0(R8) * CSEC/NLR LH R0,DBNLR(R9) STH R0,PN.NRECS(R8) * LRECL LH R0,DBLREC(R9) STH R0,PN.LRECL(R8) * UHRZEIT/DATUM LH R1,DBCRE(R9) ZEIT IN MIN. LHI R2,60 XHR R0,R0 DHR R0,R2 STB R1,PN.TIME(R8) STUNDE STB R0,PN.TIME+1(R8) MINUTE SPACE 1 LH R0,DBCRE+2(R9) LHR R1,R0 NHI R1,X'007F' STB R1,PN.DATE(R8) JAHR LHR R1,R0 SRLS R1,12 STB R1,PN.DATE+1(R8) MONAT NHI R0,X'0FFF' SRLS R0,7 STB R0,PN.DATE+2(R8) TAG XHR 0,0 STB 0,PN.DATE+3(R8) FILLER BYTE SPACE 2 LM R8,-2*16(R5) SHI R5,2*16 BR R15 SPACE 2 *************** TITLE PNSNE - HOLEN NEXT DIRECTORY EINTRAG * REG 1 ENTHAELT ADR MASKE(DIRMSK) SPACE 2 SPACE 2 PNSNE EQU * AHI R5,2*16 STM R8,-2*16(R5) SPACE 2 LHR R8,R1 MASKE ADR SPACE 2 LH R0,DIRPTR BNM NE100 NOT. 1. AUFRUF SPACE 1 XHR R0,R0 STH R0,DIRPTR SVC 1,RDDIR LH R0,RDDIR+2 BNZ IOERROR LH R0,DIRBLK+10 PTR TO 1. DIRBLK STH R0,DIRPTR LIS R0,5 STH R0,INDXDB INIT ENTRY INDX SPACE 2 * FILENAME SUCHEN ANHAND MASKE; 5 ENTRIES PRO DIRBLK NE100 EQU * LIS R0,1 AHM R0,INDXDB INCRE INDX PTR LH R0,INDXDB CHI R0,5 LETZTER ENTRY SCHON ? BNP NE110 NEIN SPACE 1 * NXT DIRBLK HOLEN; DIRPTR=0 --> ENDE XHR R0,R0 STH R0,INDXDB INIT LH R0,DIRPTR SCHON LETZTER GEWESEN? BZ NE999 JA SVC 1,RDDIR LH R0,RDDIR+2 BNZ IOERROR * LH R0,DIRBLK+2 STH R0,DIRPTR DIRPTR=DIRBLK(2) LIS R0,1 STH R0,INDXDB SPACE 1 NE110 EQU * LH R1,INDXDB SIS R1,1 LHI R0,DBLENG MHR R0,R0 AIS R1,4 LHR R9,R1 AHI R9,DIRBLK DIRBLK(OFFSET) LH R0,DBSTAT(R9) FSTAT THI R0,X'1000' ENTRY BESETZT ? BZ NE100 ENTRY GELOESCHT * FILE LEER ? LH 0,DBNLR(9) BZ NE100 * CHECK ENTRY <---> MASKE (* --> DON'T CARE) LHI R1,DBFINA(R9) LIS R2,1 LHI R3,10(R1) LOOP OVER FILENAME/EXT LHR R4,R8 MSKCHK LB R0,0(R4) CHI R0,C'*' DONT CARE ? BE NE150 CLB R0,0(R1) BNE NE100 NO MATCH NE150 AIS R4,1 INCRE MASKEN PTR BXLE R1,MSKCHK B NE990 * * HURRAH - MATCH * NE999 EQU * LCS R0,1 STH R0,EOF NE990 EQU * LM R8,-2*16(R5) SHI R5,2*16 BR R15 SPACE 1 *********************************** TITLE PNSCE - ENTRY VERGLEICH *********************************************** * EINGANGS PARM: * ADR ENTRY1 IN REG 1 * ADR ENTRY2 IN REG 2 * * AUSGANGSPARM: * RECODE (WIE UNTEN) ************************************************** SPACE 2 * SUBROUTINE PNSCE(ENTRY1,ENTRY2) *C *C************************************************************** *C * *C PNSCE VERGLEICHT ZWEI ENTRIES * *C * *C EINGANGSPARM: * *C ENTRY1 - 1. ENTRY *C ENTRY2 - 2. ENTRY *C *C AUSGANGSPARM: *C RECODE - RESULT DES VERGLEICHES: *C ENTRY1 <-> ENTRY2 ---> RECODE *C ----------------------------- *C 1<2 ---> 0 *C 1=2 ---> 1 *C 1>2 ---> 2 *C *C*************************************************************** SPACE 2 PNSCE EQU * AHI R5,2*16 STM R8,-2*16(R5) SPACE 2 * VERGLEICH DATUM/UHRZEIT LHI R8,PN.DATE(R1) LIS R9,2 LHI R10,PN.TIME+1(R1) CE10 LH R0,0(R8) CH R0,PN.DATE(R2) BM CE90 BP CE95 AIS R2,2 BXLE R8,CE10 SPACE 1 LIS R0,1 RECODE=1 BS CE99 CE90 XHR R0,R0 RECODE=0 BS CE99 CE95 LIS R0,2 RECODE=2 CE99 STH R0,RECODE SAVE RECODE SPACE 1 LM R8,-2*16(R5) SHI R5,2*16 BR R15 TITLE IOERROR IOERROR EQU * SVC 2,UNPACKER SVC 1,ERRORMSG SVC 3,1 * UNPACKER DB 0,6 DC IOCODE * ERRORMSG DC X'2805',0,ERRMSGA,ERRMSGE,0,0,0,0 ERRMSGA DC C'*** I/O ERROR ' IOCODE DC C' ' ERRMSGE EQU *-1 TITLE FELDER REGSAVE DS 96 REGISTER SAVEAREA SAVEREGS DS 32 INDXDB DAC *-* RECODE DAC *-* DIRBLK DS 256 MASKE DC C'P*******DFU*' MASKE FUER ENTRY SEARCH * MENTRY DC 0 MAX. ANZAHL EINTRAEGE TABENTRY DC 0 TATSAECHLICHE ANZAHL ETAB DC 0 ANFANGSADR. PN-TABLE ETE DC 0 ENDEADR. PN-TABLE ENTRY DS PNHEAD EOF DC 0 ****************************** * SVCS ALIGN 2 PAUSE DB 0,1 * ALIGN 2 RDDIR DB X'4C',INLUN DC X'0' DAC *-*,*-* DC Y'0' DIRPTR EQU *-2 DC 0,0,0,0 * ALIGN 2 MOVENTRY DB X'0'+PNHEAD,18 DB 1,2 DAC *-* * **************************** * REGS END START BSCTST PROG BSC - SESSION TEST : JES, 3780 * *------------------------------------------------ * ASSIS * 0: RJE * 1 : disc "DATA" * 2: JOB.DAT * 3: LOGOFF.DAT * 4: dfu primanota files * 5: Console * 6: prints * 7: leitungsstatus * 8: ablauftrace * 9: LOGON.DAT * 10: inhaltsfile * *---------------------------------------------- * TIMO DC 15 TIME OUTWERT BEIM LISTENEMPFANG LOGVERS DC 7,VERSONE-VERSON VERSON DB C'06108116' VERSONE EQU * ALIGN 2 TITLE HAUPTPROGRAMM START EQU * SVC 2,LOGVERS SPACE 3 *----------------------------------------- * VORRAT AN PN ERFASSEN * XHR 0,0 STH 0,ZPN BAL 15,PNSRT DC 8 DC MPNTAB DC ZPNTAB DC PNTAB LH 0,ZPNTAB GIBTS WAS? B WASDO SVC 2,LOGNIX NOI! SVC 3,1 SPACE 3 *---------------------------------- * WAS TUN ? * .04 TIMOUT SVC 1,TIMOUTX * .06 WASDO SVC 1,WASDOX SVC 1,ANSWER LH 0,ANSWERA CHI 0,C'XX' BE EOJX END TASK CHI 0,C'LO' BE LO LOGON MACHEN CHI 0,C'WO' BE WO AUF QUITTUNG LOGON WARTEN CHI 0,C'JO' BE JO JOB AUSGEBEN CHI 0,C'WJ' BE WJ WARTEN AUF LISTE CHI 0,C'LF' BE LF LOGOFF MACHEN CHI 0,C'WF' AUF QUITTUNG LOGOFF WARTEN BE WF CHI 0,C'KD' BE KD KOMMANDO SVC 1,HANO B WASDO SPACE 3 *---------------------------------------------- * MIT LOGON SESSION EROEFFNEN * LO LIS 0,1 STH 0,ERWARTG XHR 0,0 STH 0,DAISCHS LOGON0 SVC 1,CLOGON SVC 1,RW1 LOGON SVC 1,GET1 LH 0,GET1+2 BNZ LOGONE SVC 1,CRAUS LOGON1 BAL 15,SEND LH 0,SND+2 BZ LOGON CHI 0,X'840B' BE LOGON2 CHI 0,X'8405' BNE LOGON1 LOGON2 BAL 14,RESPONST B LOGON1 SPACE 3 *-------------------------------------- * AUF DIE SESSION EROEFFNUNG WARTEN * LOGONE SVC 1,CWFM SVC 1,WFM B WASDO SPACE 3 WO SVC 1,CLOGONR LOGONR BAL 14,RESPONST LH 0,RCV+2 CHI 0,X'A100' BE TIMOUT LH 0,DAISCHS BZ LOGONR B WASDO SPACE 3 *--------------------------------------- * JOBCONTROL UEBERTRAGEN * JO XHR 0,0 STH 0,ERWARTG JOB0 SVC 1,CJOB VORNE DRAN JOB SVC 1,GET2 LH 0,GET2+2 BNZ JOBE LB 0,BUFFER CHI 0,C'@' HIER DATEN REIN BE JOB3 SVC 1,CRAUS JOB1 BAL 15,SEND LH 0,SND+2 BZ JOB CHI 0,X'840B' BE JOB2 CHI 0,X'8405' BNE JOB1 JOB2 BAL 14,RESPONST B JOB1 SPACE 3 *------------------------------------------- * DATEN EINMISCHEN * JOB3 BAL 15,XFER SPACE 1 B JOB JCL HINTEN ANHAENGEN SPACE 3 *----------------------------------------- * AUF DIE DURCHFUEHRUNGSLISTE WARTEN * JOBE SVC 1,CWFM SVC 1,EOD SVC 1,WFM B WASDO SPACE 3 WJ LIS 0,2 STH 0,ERWARTG XHR 0,0 STH 0,DAISCHS LIST0 SVC 1,CLIST LIST BAL 14,RESPONST LH 0,RCV+2 CHI 0,X'A100' BE TIMOUT LH 0,DAISCHS BZ LIST SVC 1,CEOJ DER JOB IST AUF IBM GELOFFEN B WASDO SPACE 3 *------------------------------------------------ * LOGOFF MACHEN * LF SVC 1,CLOGOFF LIS 0,3 STH 0,ERWARTG XHR 0,0