RMAC TITLE 'Program to Transfer a Macintosh File to CMS' 00000001 RMAC CSECT 00000002 EXTRN CRCTAB,SCRIO 00000003 PRINT NOGEN 00000004 REGEQU 00000005 USING *,R15 00000006 STM R0,R15,RDSAVE SAVE ALL REGISTERS 00000007 LR R10,R15 00000008 LA R11,2048(R10) 00000009 LA R11,2048(R11) 00000010 LA R12,2048(R11) 00000011 LA R12,2048(R12) 00000012 DROP R15 00000013 USING RMAC,R10,R11,R12 R10 - R12 = RMAC BASE REGISTERS 00000014 USING NUCON,0 ALSO ADDRESS NUCON 00000015 SR R15,R15 00000016 ST R15,RTNCODE RETURN CODE INITIALIZED TO ZERO 00000017 ST R15,BUFSIZE OUTPUT BUFFER EMPTY 00000018 ST R15,RETRYCNT TOTAL RETRY COUNT = 0 00000019 ST R15,TOTCHRS INITIALIZE TIMING DATA 00000020 ST R15,TOTSECS 00000021 ST R15,TOTSECS+4 00000022 MVI FLAGS,NOMENU INITIALIZE FLAGS 00000023 MVI FLAGS2,0 00000024 MVI TRMFLAGS,0 ALSO TERMINAL FLAGS 00000025 BAL R14,GETID DEFINE LOCAL NODEID 00000026 CLC NODEID(8),BROWNID CHECK FOR BROWN 00000027 BNE NOTBROWN IF BROWN, SET FLAG BIT 00000028 OI FLAGS3,ALTTR FOR ALT. XLATE TABLES 00000029 NOTBROWN BAL R14,ZEROLAST ZERO RECVLAST BUFFER 00000030 MVC RECVATTR(18),=18C'0' INITIALIZE FILE ATTRIBUTES 00000031 MVC VERSDATA(5),=C' 0000' INITIALIZE VERSION DATA 00000032 MVC XFSPEED(4),=C'0000' INITIALIZE TRANSFER RATE 00000033 LA R9,OUTFILE R9 -> OUTPUT FILE FSCB 00000034 USING FSCBD,R9 00000035 EJECT 00000036 * INTERPRET FILE ID ARGUMENTS: 00000037 MVC FSCBFM(2),=CL2'A1' DEFAULT FM IS "A1" 00000038 MVC DSKMODE(1),=CL2'A1' 00000039 CLI 8(R1),X'FF' ERROR IF FN OR FT IS 00000040 BE BADID MISSING OR "*" 00000041 CLI 8(R1),C'*' 00000042 BE BADID 00000043 CLI 16(R1),X'FF' 00000044 BE BADID 00000045 CLI 16(R1),C'*' 00000046 BE BADID 00000047 MVC FSCBFN(16),8(R1) SAVE VALID FN AND FT 00000048 CLI FSCBFT,C'.' FT BEGINS WITH A PERIOD? 00000049 BNE KEEPFT NO, KEEP FT AS IS 00000050 MVC FSCBFT(7),FSCBFT+1 SHIFT CHARACTERS OVER 00000051 MVI FSCBFT+7,C' ' PUT BLANK AT END 00000052 MVI DELIM,C'.' USE "." FOR MAC DELIMITER 00000053 KEEPFT EQU * 00000054 CLI 24(R1),C'*' SAVE FM IF GIVEN AND NOT "*" 00000055 BE BADID 00000056 CLC 24(8,R1),=C'(' OPTIONS MAY START HERE ALSO 00000057 BE HAVEID 00000058 CLI 24(R1),X'FF' 00000059 BE DOSTATE 00000060 MVC FSCBFM(2),24(R1) SAVE CALLER'S FM 00000061 MVC DSKMODE(1),24(R1) 00000062 B HAVEID 00000063 SPACE 00000064 * SAVE AREA LOCATED HERE FOR ADDRESSABILITY 00000065 RDSAVE DS 8D REGISTER SAVE AREA 00000066 RTNCODE EQU RDSAVE+60 RETURN CODE AT LOCATION FOR R15 00000067 SPACE 00000068 BADID EQU * FILE ID ERROR 00000069 LINEDIT TEXT='DMSRMC001E Fileid incomplete or contains "*"', X00000070 DISP=ERRMSG 00000071 MVI RTNCODE+3,24 00000072 B CMSRTN 00000073 EJECT 00000074 * INTERPRET OPTIONS: 00000075 HAVEID EQU * FSCB FILEID COMPLETE 00000076 LA R2,32(R1) R2 = OPTION POINTER 00000077 OPTLOOP EQU * PROCESS OPTIONS 00000078 CLC 0(8,R2),=8X'FF' END AT X'FF' 00000079 BE DOSTATE 00000080 CLC 0(8,R2),=CL8')' ALSO ")" 00000081 BE DOSTATE 00000082 CLC 0(8,R2),=CL8'(' SKIP "(" 00000083 BE NEXTOPT 00000084 LA R5,8 GET LENGTH IN R5 00000085 LA R4,7(R2) R4 -> LAST BYTE 00000086 LENLOOP EQU * LOOP TO GET LENGTH 00000087 CLI 0(R4),C' ' AT NON-BLANK? 00000088 BNE HAVELEN YES, LENGTH IN R5 00000089 BCTR R4,0 R4 -> PREVIOUS BYTE 00000090 BCT R5,LENLOOP DECREMENT & REPEAT 00000091 B OPTERR ALL BLANK IS ERROR 00000092 SPACE 00000093 HAVELEN BCTR R5,0 DECREMENT LENGTH FOR EX 00000094 LA R4,OPTTAB R4 -> OPTION TABLE 00000095 TABCHECK EQU * LOOK FOR MATCH IN TABLE 00000096 CLI 0(R4),X'FF' AT TABLE END? 00000097 BE OPTERR YES, BAD OPTION 00000098 EX R5,TABCLC FOUND A MATCH? 00000099 BE USEOPT YES, HANDLE OPTION 00000100 LA R4,12(R4) R4 -> NEXT OPTION 00000101 B TABCHECK TRY AGAIN 00000102 SPACE 00000103 USEOPT L R3,8(R4) GET ADDRESS OF ROUTINE 00000104 BR R3 EXECUTE CODE FOR OPTION 00000105 SPACE 00000106 NEXTOPT EQU * OPTION CODE RETURN HERE 00000107 LA R2,8(R2) CHECK OUT NEXT TOKEN 00000108 B OPTLOOP 00000109 SPACE 00000110 TABCLC CLC 0(*-*,R4),0(R2) COMPARE TABLE ENTRY TO OPTION 00000111 SPACE 00000112 MENUOPT NI FLAGS,255-NOMENU RESET FLAG 00000113 B NEXTOPT 00000114 SPACE 00000115 NOMENOPT OI FLAGS,NOMENU SET FLAG 00000116 B NEXTOPT 00000117 SPACE 00000118 BINOPT OI FLAGS2,BINXF SET FLAG 00000119 B NEXTOPT 00000120 SPACE 00000121 NOBINOPT NI FLAGS2,255-BINXF RESET FLAG 00000122 B NEXTOPT 00000123 SPACE 00000124 STDXOPT NI FLAGS3,255-ALTTR RESET ALT. XLATE FLAG 00000125 B NEXTOPT 00000126 SPACE 00000127 OPTERR LINEDIT TEXT='DMSRMC003E Invalid option ''........''', X00000128 SUB=(CHARA,(R2)),DISP=ERRMSG 00000129 MVI RTNCODE+3,24 00000130 B CMSRTN 00000131 EJECT 00000132 DOSTATE EQU * 00000133 LA R1,OUTFILE CALL STATEW FOR INPUT FILE 00000134 MVC 0(8,R1),=CL8'STATEW' 00000135 SVC 202 00000136 DC AL4(*+4) 00000137 C R15,=F'28' ERROR IF "FILE NOT FOUND" 00000138 BE TRMINIT NOT RETURNED 00000139 ST R15,RTNCODE SAVE RETURN CODE 00000140 C R15,=F'36' ERROR 36 IS DISK NOT ACCESSED 00000141 BE NODISK 00000142 C R15,=F'0' ELSE IF NON-ZERO, ASSUME STATEW 00000143 BNE CMSRTN TYPED MESSAGE 00000144 LINEDIT TEXT='DMSRMC002E Output file already exists', X00000145 DISP=ERRMSG 00000146 MVI RTNCODE+3,28 00000147 B CMSRTN 00000148 SPACE 00000149 NODISK LINEDIT TEXT='DMSRMC069E Disk ''..'' not accessed', X00000150 SUB=(CHARA,DSKMODE),DISP=ERRMSG 00000151 B CMSRTN 00000152 SPACE 00000153 * 00000154 * PERFORM ONE-TIME INITIALIZATION 00000155 * 00000156 TRMINIT BAL R14,TERMTYPE DETERMINE TERMINAL TYPE 00000157 OI FLAGS2,TERMINIT REMEMBER TERM INIT. DONE 00000158 TM TRMFLAGS,MAC3270 MAC3270? 00000159 BZ BINCHECK NO, CHECK FOR BINARY XFER 00000160 CLC M3270VER+1(4),=C'0110' NEW ENOUGH? 00000161 BNL INITCONT YES, CONTINUE 00000162 MVC M3270VER(2),M3270VER+1 FORMAT VERSION NUMBER 00000163 MVI M3270VER+2,C'.' 00000164 BAL R14,ENDFS EXIT FULL-SCREEN MODE 00000165 LINEDIT TEXT='DMSRMC013E This version of Mac3270 (.....) does X00000166 not support file transfer', X00000167 SUB=(CHARA,M3270VER),DISP=ERRMSG 00000168 LA R15,36 STORE RETURN CODE & RETURN 00000169 ST R15,RTNCODE 00000170 B CMSRTN 00000171 SPACE 00000172 BINCHECK TM FLAGS2,BINXF BINARY SPECIFIED WHEN NOT MAC3270? 00000173 BZ INITCONT NO, CONTINUE 00000174 BAL R14,ENDFS EXIT FULL-SCREEN MODE 00000175 LINEDIT TEXT='DMSRMC014E Mac3270 must be used for binary file X00000176 transfers',DISP=ERRMSG 00000177 LA R15,36 STORE RETURN CODE & RETURN 00000178 ST R15,RTNCODE 00000179 B CMSRTN 00000180 EJECT 00000181 INITCONT TM TRMFLAGS,GRAFTRM 3270 TERMINAL? 00000182 BO CPOK2 YES, SKIP ASCII INIT. 00000183 * DO ASCII INITIALIZATION 00000184 MVC INTAB(4),AINTRTBL SAVE "SET INPUT" TABLE 00000185 MVC OUTTAB(4),AOUTRTBL SAVE "SET OUTPUT" TABLE 00000186 DMSEXS XC,AINTRTBL(4),AINTRTBL RESET INPUT TRANSLATION 00000187 DMSEXS XC,AOUTRTBL(4),AOUTRTBL RESET OUTPUT TRANSLATION 00000188 LINEDIT TEXT='SET LINEDIT OFF',DOT=NO,DISP=CPCOMM 00000189 LTR R15,R15 CHECK FOR ERROR FROM CP 00000190 BZ CPOK1 00000191 ST R15,RTNCODE SAVE RETURN CODE 00000192 LINEDIT TEXT='DMSRMC010E Error from CP "SET" command', X00000193 DISP=ERRMSG 00000194 B CMSRTN 00000195 SPACE 00000196 CPOK1 EQU * SET PROMPT TO >, DC2 00000197 CLC NODEID(8),BROWNID SKIP PROMPT COMMAND IF NOT BROWN 00000198 BNE CPLSIZE 00000199 LINEDIT TEXTA=PRMTCMD,DOT=NO,DISP=CPCOMM 00000200 LTR R15,R15 CHECK FOR ERROR FROM CP 00000201 BNZ CPERR 00000202 CPLSIZE LINEDIT TEXT='TERM LINESIZE OFF',DOT=NO,DISP=CPCOMM 00000203 LTR R15,R15 CHECK FOR ERROR FROM CP 00000204 BZ CPOK2 00000205 CPERR ST R15,RTNCODE SAVE RETURN CODE 00000206 LINEDIT TEXT='DMSRMC010E Error from CP "TERM" command', X00000207 DISP=ERRMSG 00000208 B CMSRTN 00000209 SPACE 00000210 CPOK2 EQU * HAVE MAC ENTER XFER MODE 00000211 LA R1,CTLFS R1 -> STRING 00000212 LA R2,2 R2 = LENGTH 00000213 BAL R14,WRITE OUTPUT STRING 00000214 EJECT 00000215 * 00000216 * ATTEMPT TO GET VERSION INFORMATION. END FILE TRANSFER IF 00000217 * NOT A MACINTOSH SYSTEM. 00000218 * 00000219 MVI VERSDATA,C'M' SET MACINTOSH DEFAULT 00000220 MVC SENDDATA(2),=C'VR' "VR" FOR VERSION REQUEST 00000221 LA R1,2 COMMAND LENGTH IS 2 00000222 STH R1,SENDLEN 00000223 BAL R14,CPMCMMD EXECUTE COMMAND 00000224 CLC RECVDATA(2),=C'VI' DID WE GET VERSION INFO.? 00000225 BNE CHKSYS NO, KEEP DEFAULT 00000226 MVC VERSDATA(5),RECVDATA+2 COPY VERSION DATA 00000227 CHKSYS CLI VERSDATA,C'M' IS IT A MACINTOSH SYSTEM? 00000228 BE SYSOK YES, CAN CONTINUE 00000229 CLI VERSDATA,C'C' IS IT A CP/M SYSTEM? 00000230 BE SYSOK YES, CAN CONTINUE 00000231 LA R1,2 COMMAND LENGTH IS 2 00000232 STH R1,SENDLEN 00000233 MVC SENDDATA(2),=C'EX' "EXIT" COMMAND 00000234 BAL R14,CPMCMMD EXECUTE COMMAND, IGNORE RESULTS 00000235 BAL R14,ENDFS 00000236 LINEDIT TEXT='DMSRMC012E Remote system type is unknown', X00000237 DISP=ERRMSG 00000238 LA R15,36 STORE RETURN CODE & RETURN 00000239 ST R15,RTNCODE 00000240 B CMSRTN 00000241 SPACE 00000242 SYSOK EQU * FILL-IN FSCB (NEED VERSION INFO): 00000243 MVI FSCBFV,C'V' RECFM = V 00000244 MVC FSCBITNO(2),=H'0' ITEM NO. = 0 00000245 LA R1,OUTBUF 00000246 ST R1,FSCBBUFF STORE BUFFER ADDRESS 00000247 MVC FSCBNOIT(2),=H'1' NO. OF ITEMS TO WRITE = 1 00000248 MVC MACID(8),FSCBFN INITIALIZE ID WITH FILENAME 00000249 MVC MACID+8(9),=CL9' ' 00000250 LA R1,MACID R1 -> FIRST BLANK IN ID 00000251 IDLOOP CLI 0(R1),C' ' LOOP UNTIL BLANK REACHED 00000252 BE MOVEFT 00000253 LA R1,1(R1) 00000254 B IDLOOP 00000255 SPACE 00000256 MOVEFT CLI VERSDATA,C'C' CP/M? 00000257 BE CPMMFT YES, DIFFERENT ID FORMAT 00000258 MVC 0(1,R1),DELIM APPEND DELIMITER 00000259 MVC 1(8,R1),FSCBFT AND FILETYPE 00000260 L R2,=A(TOLOWER) TRANSLATE TO LOWER CASE 00000261 TR MACID(17),0(R2) TRANSLATE TO LOWER CASE 00000262 B USEFT 00000263 SPACE 00000264 CPMMFT MVI 0(R1),C'.' APPEND PERIOD AND 00000265 MVC 1(3,R1),FSCBFT START OF FILETYPE 00000266 USEFT EQU * 00000267 EJECT 00000268 * 00000269 * OPEN MAC FILE FOR INPUT 00000270 * 00000271 ***** FSERASE 'RMAC DEBUG A' ***** 00000272 MVC SENDDATA(2),=C'OI' "OI" TO OPEN FOR INPUT 00000273 TM FLAGS2,BINXF BINARY SPECIFIED? 00000274 BZ KEEPOI NO, KEEP OI COMMAND 00000275 MVC SENDDATA(2),=C'BI' "BI" FOR BINARY INPUT 00000276 NI FLAGS2,255-BINXF RESET FLAG 00000277 KEEPOI MVC SENDDATA+2(17),MACID FOLLOWED BY MAC FILE ID 00000278 LA R1,19 R1 = MAXIMUM LENGTH 00000279 LA R2,SENDDATA+18 R2 -> LAST BYTE 00000280 CLI VERSDATA,C'C' CP/M SYSTEM? 00000281 BNE TRUNLP NO, CAN KEEP LENGTHS 00000282 LA R1,14 R1 = MAXIMUM LENGTH 00000283 LA R2,SENDDATA+13 R2 -> LAST BYTE 00000284 TRUNLP CLI 0(R2),C' ' LOOP: ADJUST LENGTH TO REMOVE 00000285 BNE USELEN TRAILING BLANKS 00000286 BCTR R1,0 DECREMENT LENGTH 00000287 BCTR R2,0 DECREMENT ADDRESS 00000288 B TRUNLP 00000289 SPACE 00000290 USELEN STH R1,SENDLEN STORE COMPUTED LENGTH 00000291 TM FLAGS,NOMENU MENU SUPPRESSED? 00000292 BZ EXOPEN NO, CONTINUE 00000293 CLI VERSDATA,C'C' LIKEWISE IF CP/M 00000294 BE EXOPEN 00000295 LA R2,SENDDATA(R1) APPEND "*" AT END 00000296 MVI 0(R2),C'*' 00000297 LA R1,1(R1) INCREMENT LENGTH 00000298 STH R1,SENDLEN STORE UPDATED VALUE 00000299 EXOPEN EQU * 00000300 BAL R14,CPMCMMD EXECUTE COMMAND 00000301 CLC RECVDATA(2),=C'AT' DID WE GET ATTRIBUTES? 00000302 BE SAVEATR YES, SAVE THEM 00000303 CLC RECVDATA(2),=C'BT' LIKEWISE BINARY ATTR. 00000304 BE BINATR 00000305 BAL R14,READRC GET RETURN CODE IN R1 00000306 * END XFER MODE 00000307 LR R2,R1 COPY RC FOR LINEDIT 00000308 LA R1,2 COMMAND LENGTH IS 2 00000309 STH R1,SENDLEN 00000310 MVC SENDDATA(2),=C'EX' "EXIT" COMMAND 00000311 BAL R14,CPMCMMD EXECUTE COMMAND, IGNORE RESULTS 00000312 BAL R14,ENDFS END FULL-SCREEN MODE 00000313 C R2,=F'1' ERROR 1 IS CP/M FILE NOT FOUND 00000314 BE NOFILE 00000315 * ELSE TYPE ERROR NUMBER 00000316 LINEDIT TEXT='DMSRMC004E Mac error .... opening ''.................'X00000317 '',SUB=(DEC,(R2),CHARA,MACID),DISP=ERRMSG,RENT=NO 00000318 LA R15,100(R2) STORE RETURN CODE & RETURN 00000319 ST R15,RTNCODE 00000320 B CMSRTN 00000321 SPACE 00000322 NOFILE EQU * 00000323 LINEDIT TEXT='DMSRMC005E Mac file ''.................'' not founX00000324 d',SUB=(CHARA,MACID),DISP=ERRMSG 00000325 LA R15,100(R2) 00000326 ST R15,RTNCODE 00000327 B CMSRTN 00000328 SPACE 00000329 BINATR OI FLAGS2,BINXF BT LIKE AT, BUT BINARY XFER 00000330 MVI FSCBFV,C'F' CHANGE RECFM TO F 00000331 SAVEATR MVC RECVATTR(18),RECVDATA+2 SAVE ATTRIBUTES TO USE LATER 00000332 EJECT 00000333 * 00000334 * READ AND PROCESS CP/M DATA BLOCKS 00000335 * 00000336 RDBGN SR R4,R4 R4 = CP/M BLOCK NO. OFFSET 00000337 B RDCVT SKIP INITIAL INCREMENT 00000338 RDLOOP EQU * LOOP TO PROCESS BLOCKS 00000339 LA R4,1(R4) R4 = NEXT BLOCK NUMBER 00000340 RDCVT MVC SENDDATA(6),=X'402120202020' CONVERT BLOCK NUMBER 00000341 CVD R4,DECBUF 00000342 ED SENDDATA(6),DECBUF+5 00000343 MVC SENDDATA(2),=C'RB' STORE READ BLOCK COMMAND 00000344 LA R1,6 00000345 CLC VERSDATA+1(4),=C'0000' IS XFSPEED SUPPORTED? 00000346 BE NOSPEED NO, KEEP JUST BLOCK NO. 00000347 MVC SENDDATA+6(4),XFSPEED APPEND XFSPEED 00000348 LA R1,10 CHANGE LENGTH TO 10 00000349 NOSPEED EQU * 00000350 STH R1,SENDLEN STORE COMMAND LENGTH 00000351 TM TRMFLAGS,VTAM VTAM CONNECTION? 00000352 BZ RBCMMD NO, READY FOR COMMAND 00000353 OI FLAGS2,VTAMRB INDICATE VTAM PREP. NEEDED 00000354 RBCMMD BAL R14,CPMCMMD EXECUTE COMMAND 00000355 NI FLAGS2,255-VTAMRB RESET VTAM PREP. FLAG 00000356 CLC RECVDATA(2),=C'DB' DID WE GET THE DATA BLOCK? 00000357 BNE RDEND IF NOT, PROCESS RC 00000358 TM FLAGS2,BINXF BINARY TRANSFER? 00000359 BO RDBIN YES, PROCESS SEPARATELY 00000360 BAL R14,PROCBLK PROCESS DATA BLOCK 00000361 B RDLOOP TRY FOR NEXT BLOCK 00000362 SPACE 00000363 RDBIN BAL R14,PROCBIN PROCESS BINARY DATA 00000364 B RDLOOP 00000365 SPACE 00000366 RDEND BAL R14,READRC GET RETURN CODE IN R1 00000367 * END XFER MODE 00000368 C R1,=F'1' TYPE MESSAGE IF NOT NORMAL EOF 00000369 BE RDCLOSE 00000370 LR R3,R1 COPY RETURN CODE FOR LINEDIT 00000371 LA R1,SUBCODE R1 -> STRING 00000372 LA R2,1 R2 = LENGTH 00000373 BAL R14,WRITE TELL VMXFER TO CALL "SUBSET" 00000374 BAL R14,ENDFS EXIT FULL-SCREEN MODE 00000375 C R3,=F'11' CHECK FOR USER ABORT 00000376 BE USRABORT 00000377 LINEDIT TEXT='DMSRMC006E Error ...... from Mac read', X00000378 SUB=(DEC,(R3)),DISP=ERRMSG 00000379 LA R15,100(R3) STORE RETURN CODE 00000380 ST R15,RTNCODE 00000381 BAL R14,BEGINFS RESTORE FULL-SCREEN MODE 00000382 LA R1,SUBCODE R1 -> STRING 00000383 LA R2,1 R2 = LENGTH 00000384 BAL R14,WRITE TELL VMXFER TO EXIT "SUBSET" 00000385 B RDCLOSE 00000386 SPACE 00000387 USRABORT LINEDIT TEXT='DMSRMC011E Transfer aborted by user', X00000388 DISP=ERRMSG 00000389 LA R15,100(R3) STORE RETURN CODE 00000390 ST R15,RTNCODE 00000391 BAL R14,BEGINFS RESTORE FULL-SCREEN MODE 00000392 LA R1,SUBCODE R1 -> STRING 00000393 LA R2,1 R2 = LENGTH 00000394 BAL R14,WRITE TELL VMXFER TO EXIT "SUBSET" 00000395 RDCLOSE LA R1,2 COMMAND LENGTH IS 2 00000396 STH R1,SENDLEN 00000397 MVC SENDDATA(2),=C'CI' CLOSE INPUT FILE 00000398 BAL R14,CPMCMMD EXECUTE COMMAND 00000399 BAL R14,READRC GET RETURN CODE IN R1 00000400 LTR R1,R1 TYPE MESSAGE IF NOT ZERO 00000401 BZ RDEXIT 00000402 LR R3,R1 COPY RETURN CODE FOR LINEDIT 00000403 LA R1,SUBCODE R1 -> STRING 00000404 LA R2,1 R2 = LENGTH 00000405 BAL R14,WRITE TELL VMXFER TO CALL "SUBSET" 00000406 BAL R14,ENDFS EXIT FULL-SCREEN MODE 00000407 LINEDIT TEXT='DMSRMC009E Error ...... from Mac close', X00000408 SUB=(DEC,(R3)),DISP=ERRMSG 00000409 LA R15,100(R3) STORE RETURN CODE 00000410 ST R15,RTNCODE 00000411 BAL R14,BEGINFS RESTORE FULL-SCREEN MODE 00000412 LA R1,SUBCODE R1 -> STRING 00000413 LA R2,1 R2 = LENGTH 00000414 BAL R14,WRITE TELL VMXFER TO EXIT "SUBSET" 00000415 RDEXIT LA R1,2 COMMAND LENGTH IS 2 00000416 STH R1,SENDLEN 00000417 MVC SENDDATA(2),=C'EX' "EXIT" COMMAND 00000418 BAL R14,CPMCMMD EXECUTE COMMAND, IGNORE RESULTS 00000419 B CMSRTN RETURN 00000420 EJECT 00000421 * 00000422 * LOOP TO PROCESS A BLOCK OF CP/M DATA A BYTE AT A TIME 00000423 * 00000424 PROCBLK EQU * 00000425 STM R0,R15,BLKSAVE SAVE REGISTERS 00000426 LH R6,RECVLEN R6 = NUMBER OF BYTES 00000427 S R6,=F'2' 00000428 BNP PROCRET RETURN IF NOT > 0 00000429 LA R2,RECVDATA+2 R2 -> FIRST DATA BYTE 00000430 LA R6,0(R2,R6) R6 -> PAST LAST DATA BYTE 00000431 BYTELOOP EQU * 00000432 TM FLAGS,EOF IGNORE DATA LINE IF 00000433 BO PROCRET EOF SIGNALLED 00000434 CLI 0(R2),X'3F' > X'3F' IS GOOD DATA 00000435 BH ADDBYTE 00000436 BE SETEOF X'3F' IS CP/M EOF CODE 00000437 CLI 0(R2),X'0B' X'0B' IS TRANSLATED CR 00000438 BE NEWLINE 00000439 CLI 0(R2),X'25' X'25' (LF) IS IGNORED 00000440 BE NXTBYTE 00000441 * KEEP ANY OTHER CONTROL CHARACTERS 00000442 * (THERE SHOULDN'T BE ANY) 00000443 ADDBYTE L R3,BUFSIZE IS OUTPUT BUFFER FULL ? 00000444 C R3,=F'256' 00000445 BL ADDCONT 00000446 BAL R8,WRITEBUF YES - ADD IT TO DISK FILE 00000447 L R3,BUFSIZE R3 = BYTES NOW (SHOULD BE 0) 00000448 IC R4,CENTSGN BEGIN CONTINUATION LINE 00000449 STC R4,OUTBUF(R3) WITH A CENT SIGN 00000450 LA R3,1(R3) (A NON-ASCII CHARACTER) 00000451 ADDCONT IC R4,0(R2) ADD CHAR. FROM CP/M TO 00000452 STC R4,OUTBUF(R3) OUTPUT BUFFER 00000453 LA R3,1(R3) 00000454 ST R3,BUFSIZE UPDATE BUFFER SIZE 00000455 B NXTBYTE READY FOR A NEW CHARACTER 00000456 SPACE 00000457 SETEOF OI FLAGS,EOF SET EOF WHEN CTL-Z RECEIVED 00000458 B PROCRET IGNORE REST OF DATA LINE 00000459 SPACE 00000460 NEWLINE BAL R8,WRITEBUF ADD BUFFER TO FILE 00000461 * WHEN CR RECEIVED 00000462 NXTBYTE EQU * READY FOR NEXT CP/M BYTE 00000463 LA R2,1(R2) 00000464 CR R2,R6 00000465 BL BYTELOOP PROCESS NEXT BYTE 00000466 PROCRET LM R0,R15,BLKSAVE RESTORE REGISTERS 00000467 BR R14 RETURN AFTER PROCESSING ENTIRE BLOCK 00000468 SPACE 00000469 BLKSAVE DS 8D LOCAL REGISTER SAVE AREA 00000470 EJECT 00000471 * 00000472 * PROCESS BLOCKS OF BINARY DATA WHICH HAVE BEEN READ 00000473 * 00000474 PROCBIN EQU * 00000475 STM R0,R15,BINSAVE SAVE REGISTERS 00000476 LH R5,RECVLEN R5 = NUMBER OF BYTES 00000477 S R5,=F'2' 00000478 BNP BINRET RETURN IF NOT > 0 00000479 LA R2,RECVDATA+2 R2 -> FIRST DATA BYTE 00000480 LA R6,127(R5) GET NUMBER OF 128 BYTE BLOCKS 00000481 SRL R6,7 00000482 LR R4,R6 R4 = NUMBER OF BYTES TO WRITE 00000483 SLL R4,7 00000484 SR R4,R5 MORE THAN WE READ? 00000485 BNP BINLOOP NO, CONTINUE 00000486 BCTR R4,0 DECREMENT FOR EX 00000487 LA R3,0(R2,R5) R3 -> PAST LAST BYTE 00000488 EX R4,BINXC FILL END WITH ZEROS 00000489 BINLOOP EQU * LOOP TO WRITE BLOCKS 00000490 MVC BUFSIZE(4),=F'128' SET BUFSIZE TO 128 00000491 MVC OUTBUF(128),0(R2) COPY DATA TO BUFFER 00000492 BAL R8,WRITEBUF WRITE DATA TO DISK 00000493 LA R2,128(R2) R2 -> NEXT DATA BLOCK 00000494 BCT R6,BINLOOP REPEAT FOR ALL BLOCKS 00000495 BINRET LM R0,R15,BINSAVE RESTORE REGISTERS 00000496 BR R14 RETURN AFTER PROCESSING ENTIRE BLOCK 00000497 SPACE 00000498 BINSAVE DS 8D LOCAL REGISTER SAVE AREA 00000499 BINXC XC 0(*-*,R3),0(R3) GENERATE ZEROS FOR SHORT BLOCK 00000500 EJECT 00000501 * 00000502 * SUBROUTINE TO WRITE OUTPUT BUFFER TO DISK 00000503 * 00000504 WRITEBUF L R5,BUFSIZE IF BUFFER IS EMPTY, 00000505 LTR R5,R5 USE ONE BLANK FOR LINE 00000506 BP NOTNULL 00000507 MVI OUTBUF,C' ' 00000508 LA R5,1 00000509 NOTNULL ST R5,FSCBSIZE TELL WRBUF BUFFER LENGTH 00000510 OI FLAGS,FINIS SET FLAG TO CLOSE FILE 00000511 FSWRITE FSCB=OUTFILE CALL WRBUF 00000512 LTR R15,R15 CHECK FOR ERRORS 00000513 BNZ WRERR 00000514 ST R15,BUFSIZE RESET BUFFER SIZE 00000515 BR R8 RETURN TO CALLER 00000516 SPACE 00000517 WRERR C R15,=F'12' IS DISK R/O? 00000518 BNE ISRW NO 00000519 OI FLAGS,ROERR ELSE REMEMBER NO UPDATING 00000520 ISRW LR R3,R15 COPY RC FOR LINEDIT 00000521 XC BUFSIZE(4),BUFSIZE ENSURE CMSRTN WON'T CALL US AGAIN 00000522 LA R1,SUBCODE R1 -> STRING 00000523 LA R2,1 R2 = LENGTH 00000524 BAL R14,WRITE TELL VMXFER TO CALL "SUBSET" 00000525 BAL R14,ENDFS EXIT FULL-SCREEN MODE 00000526 LINEDIT TEXT='DMSRMC105S Error ''.....'' writing file ''......X00000527 ..............'' on disk', X00000528 SUB=(DEC,(R3),CHAR8A,FSCBFN),DISP=ERRMSG,RENT=NO 00000529 LA R15,100 STORE RETURN CODE 00000530 ST R15,RTNCODE 00000531 BAL R14,BEGINFS RESTORE FULL-SCREEN MODE 00000532 LA R1,SUBCODE R1 -> STRING 00000533 LA R2,1 R2 = LENGTH 00000534 BAL R14,WRITE TELL VMXFER TO EXIT "SUBSET" 00000535 B RDCLOSE 00000536 EJECT 00000537 * 00000538 * RETURN TO CMS 00000539 * 00000540 CMSRTN L R3,BUFSIZE ANY DATA LEFT IN BUFFER ? 00000541 LTR R3,R3 IF SO, WRITE IT TO DISK 00000542 BZ FILDONE 00000543 BAL R8,WRITEBUF 00000544 FILDONE TM FLAGS2,TERMINIT TERMINAL TYPE KNOWN? 00000545 BZ RTNCLOSE NO, SKIP CLEANUP 00000546 TM TRMFLAGS,GRAFTRM 3270 TERMINAL? 00000547 BO RTN3270 YES, END FULL-SCREEN MODE 00000548 * CLEANUP FOR ASCII: 00000549 LINEDIT TEXT='SET LINEDIT ON',DOT=NO,DISP=CPCOMM 00000550 LINEDIT TEXT='TERM LINESIZE 80',DOT=NO,DISP=CPCOMM 00000551 CLC NODEID(8),BROWNID SKIP PROMPT COMMAND IF NOT BROWN 00000552 BNE PRSKIP1 00000553 LINEDIT TEXT='TERM PROMPT ON',DOT=NO,DISP=CPCOMM 00000554 PRSKIP1 EQU * 00000555 DMSEXS MVC,AINTRTBL(4),INTAB RESTORE XLATE TABLES 00000556 DMSEXS MVC,AOUTRTBL(4),OUTTAB 00000557 B RTNCLOSE 00000558 SPACE 00000559 RTN3270 BAL R14,ENDFS EXIT FULL-SCREEN MODE 00000560 RTNCLOSE TM FLAGS,FINIS 00000561 BZ NOTOPEN 00000562 FSCLOSE '* * *' FORCE FILE TO BE CLOSED 00000563 TM FLAGS,ROERR R/O ERROR FROM FSWRITE? 00000564 BO NOTOPEN YES, DON'T ATTEMPT TO WRITE 00000565 CLI VERSDATA,C'C' CP/M SYSTEM? 00000566 BE CPMDATE YES, GO HANDLE 00000567 CLC RECVATTR+4(14),=18C'0' CHECK IF DATE/TIME 00000568 BE NOTOPEN IF NOT, SKIP UPDATE 00000569 BAL R14,SETDATE SET DATE AND TIME FOR FILE 00000570 B NOTOPEN 00000571 SPACE 00000572 CPMDATE CLC RECVATTR+4(8),=12C'0' CHECK IF DATE/TIME 00000573 BE NOTOPEN IF NOT, SKIP UPDATE 00000574 BAL R14,SETDATEC SET DATE AND TIME FOR FILE 00000575 NOTOPEN L R2,RETRYCNT TYPE NON-ZERO RETRY COUNT 00000576 LTR R2,R2 00000577 BZ NORETRY 00000578 LINEDIT TEXT='DMSRMC008I ...... block retransmission(s)', X00000579 SUB=(DEC,(R2)),DISP=ERRMSG 00000580 NORETRY LM R0,R15,RDSAVE RESTORE REGISTERS AND RETURN 00000581 BR R14 00000582 EJECT 00000583 * SEND COMMAND TO CP/M SYSTEM AND 00000584 * READ RESPONSE 00000585 CPMCMMD EQU * 00000586 STM R0,R15,CMMDSAVE SAVE REGISTERS 00000587 SR R4,R4 RETRY COUNT = 0 00000588 LH R0,SENDLEN CALCULATE CHECKSUM (4 BYTES) 00000589 LA R1,SENDDATA 00000590 BAL R14,CHKCALC RESULT BYTES ARE IN R2 00000591 * APPEND CHECKSUM TO SENDDATA 00000592 AR R1,R0 R1 -> AFTER LAST BYTE OF DATA 00000593 MVI 0(R1),X'01' STORE CHECKSUM DELIMITER 00000594 LA R1,1(R1) STORE CHECKSUM BYTES 00000595 STCM R2,B'1111',0(R1) 00000596 LH R2,SENDLEN ADD 5 TO LENGTH 00000597 LA R2,5(R2) (DELIMITER, 4-BYTE CHECKSUM) 00000598 STH R2,SENDLEN 00000599 CMDLOOP BAL R14,ZERODATA ZERO RESPONSE BUFFER 00000600 LH R2,SENDLEN GET LENGTH FOR WRITE 00000601 TM TRMFLAGS,MAC3270 APPLETALK CONNECTION? 00000602 BZ CMDSCODE NO, NEED START CODES 00000603 LA R1,SENDDATA ELSE JUST RESTORE R1 -> DATA 00000604 B CMDSOK 00000605 SPACE 00000606 CMDSCODE LA R2,2(R2) ADJUST FOR START BYTE CODES 00000607 LA R1,SENDSTRT R1 -> FIRST BYTE 00000608 CMDSOK EQU * START CODE ADDED, IF NEEDED 00000609 STCK STRTTIME SAVE TOD CLOCK FOR RATE CALC. 00000610 ST R2,WRCNT SAVE BYTE COUNT 00000611 TM FLAGS2,VTAMRB VTAM PREP. NEEDED? 00000612 BZ CMDWRITE NO, READY FOR COMMAND 00000613 LR R5,R1 SAVE R1, R2 FOR WRITERD 00000614 LR R6,R2 00000615 LA R1,VTAMCCW R1 -> VTAM INIT. CCW 00000616 LH R2,CONADDR R2 = CONSOLE ADDRESS 00000617 ICM R2,B'1000',=X'01' INDICATE CMS CONSOLE 00000618 LA R13,R13SAVE R13 -> SAVE AREA 00000619 L R15,=V(SCRIO) R15 -> ENTRY POINT 00000620 BALR R14,R15 SEND PREP. SCREEN 00000621 LA R1,RCCW R1 -> READ MOD. CCW 00000622 LH R2,CONADDR R2 = CONSOLE ADDRESS 00000623 ICM R2,B'1000',=X'01' INDICATE CMS CONSOLE 00000624 LA R13,R13SAVE R13 -> SAVE AREA 00000625 L R15,=V(SCRIO) R15 -> ENTRY POINT 00000626 BALR R14,R15 ISSUE READ MOD. FOR VTAM 00000627 ***** L R2,=F'4096' ***** 00000628 ***** SR R2,R0 ***** 00000629 ***** L R3,=A(GRAFDATA) ***** 00000630 ***** FSWRITE 'RMAC DEBUG A',BUFFER=(R3),BSIZE=(R2),RECFM=V 00000631 LR R1,R5 RESTORE R1, R2 00000632 LR R2,R6 00000633 CMDWRITE BAL R14,WRITERD WRITE DATA TO TERMINAL 00000634 * ALSO READ RESPONSE IF 3270 00000635 TM TRMFLAGS,GRAFTRM 3270 TERMINAL? 00000636 BO SKIPREAD RDTERM NOT NEEDED 00000637 RDTERM RECVDATA,EDIT=PHYS,LENGTH=1032 READ RESPONSE 00000638 STH R0,RECVLEN 00000639 SKIPREAD LH R0,RECVLEN READ LENGTH IN R0 00000640 ST R0,RDCNT SAVE BYTE COUNT 00000641 STCK ENDTIME SAVE TOD CLOCK FOR RATE CALC. 00000642 C R0,=F'6' ERROR IF < 6 BYTES 00000643 BL RETRY 00000644 LA R1,RECVDATA CHECK FOR CHECKSUM DELIMITER 00000645 AR R1,R0 00000646 S R1,=F'5' R1 -> WHERE DELIMITER SHOULD BE 00000647 CLI 0(R1),X'01' RETRY IF NOT THERE 00000648 BNE RETRY 00000649 SR R3,R3 GET CHECKSUM BYTES IN R3 00000650 ICM R3,B'1111',1(R1) 00000651 S R0,=F'5' R0 = DATA LENGTH 00000652 STH R0,RECVLEN SAVE LENGTH 00000653 LA R1,RECVDATA R1 -> DATA 00000654 BAL R14,CHKCALC GET CHECKSUM BYTES IN R2 00000655 CR R2,R3 IF MATCH, USE DATA 00000656 BE CMDRTN 00000657 RETRY C R4,=F'5' RETRY LIMIT REACHED? 00000658 BNL ABORT IF SO, ABORT XFER 00000659 LA R4,1(R4) INCREMENT COUNT 00000660 L R1,RETRYCNT INCREMENT GLOBAL COUNT 00000661 LA R1,1(R1) 00000662 ST R1,RETRYCNT 00000663 LA R1,SUBCODE R1 -> STRING 00000664 LA R2,1 R2 = LENGTH 00000665 BAL R14,WRITE TELL VMXFER TO CALL "SUBSET" 00000666 BAL R14,ENDFS EXIT FULL-SCREEN MODE 00000667 WRTERM RETRYMSG,RMSGL,EDIT=NO TYPE MESSAGE TO USER 00000668 BAL R14,BEGINFS RESUME FULL-SCREEN MODE 00000669 LA R1,SUBCODE R1 -> STRING 00000670 LA R2,1 R2 = LENGTH 00000671 BAL R14,WRITE TELL VMXFER TO EXIT "SUBSET" 00000672 B CMDLOOP SEND COMMAND AGAIN 00000673 SPACE 00000674 CMDRTN EQU * VALID DATA HAS BEEN READ 00000675 CLC RECVDATA(2),=C'DB' WAS IT A DATA BLOCK? 00000676 BNE CMDSUB NO, SKIP THIS CHECK 00000677 TM TRMFLAGS,GRAFTRM ALWAYS SKIP FOR 3270S 00000678 BO CMDSUB 00000679 BAL R14,COMPDATA SAME AS LAST READ? 00000680 BNE NOTSAME NO, THAT'S TYPICAL 00000681 * ELSE VERY SUSPICIOUS, SO TRY AGAIN 00000682 BAL R14,ZEROLAST DON'T REPEAT THIS 00000683 LA R1,SYN R1 -> STRING 00000684 LA R2,3 R2 = LENGTH 00000685 BAL R14,WRITE WRITE BAD COMMAND 00000686 SYNLOOP RDTERM RECVDATA,EDIT=PHYS,LENGTH=1032 WAIT FOR BAD RESPONSE 00000687 LTR R0,R0 00000688 BNZ SYNLOOP 00000689 B CMDLOOP ASK FOR THIS DATA ONCE MORE 00000690 SPACE 00000691 NOTSAME BAL R14,COPYDATA SAVE DATA WE READ 00000692 CMDSUB BAL R14,TIMEUPD UPDATE XFER RATE 00000693 BAL R14,SUBCHK CHECK FOR SUBSET MODE 00000694 BNZ CMDLOOP IF SUBSET, REPEAT COMMAND 00000695 LM R0,R15,CMMDSAVE RESTORE REGISTERS 00000696 BR R14 RETURN TO CALLER 00000697 SPACE 00000698 ABORT LA R1,ABORTSTR R1 -> STRING 00000699 CLI VERSDATA,C'C' CP/M SYSTEM? 00000700 BNE ASTROK NO, KEEP ABORTSTR 00000701 LA R1,ABRTSTRC USE DIFFERENT STRING 00000702 ASTROK LA R2,3 R2 = LENGTH 00000703 BAL R14,WRITE SEND ABORT COMMAND 00000704 BAL R14,ENDFS EXIT FULL-SCREEN MODE 00000705 LINEDIT TEXT='DMSRMC007E Retry count exceeded', X00000706 DISP=ERRMSG 00000707 LA R15,256 STORE RETURN CODE 00000708 ST R15,RTNCODE 00000709 B CMSRTN RETURN TO CMS 00000710 SPACE 00000711 CMMDSAVE DS 8D LOCAL SAVE AREA 00000712 EJECT 00000713 * RETURN RC IN RECVDATA BUFFER 00000714 * OR 999 IF NO VALID RC 00000715 READRC EQU * 00000716 STM R2,R15,RCSAVE SAVE REGISTERS 00000717 LA R1,999 SET DEFAULT RETURN CODE 00000718 LH R2,RECVLEN MUST HAVE AT LEAST 6 BYTES 00000719 C R2,=F'6' 00000720 BL RCRTN 00000721 CLC RECVDATA(2),=C'RC' MUST START WITH "RC" 00000722 BNE RCRTN 00000723 LA R3,4 R3 = DIGIT COUNT 00000724 LA R4,RECVDATA+2 R4 -> FIRST DIGIT 00000725 SR R5,R5 R5 = RESULT 00000726 CVTLOOP EQU * 00000727 CLI 0(R4),C'0' CHECK FOR VALID DIGIT 00000728 BL RCRTN 00000729 CLI 0(R4),C'9' 00000730 BH RCRTN 00000731 SR R6,R6 CONVERT DIGIT TO BINARY 00000732 IC R6,0(R4) 00000733 S R6,=F'240' 00000734 CVTMULT MH R5,=H'10' RESULT = RESULT*10 + DIGIT 00000735 AR R5,R6 00000736 LA R4,1(R4) R4 -> NEXT DIGIT 00000737 BCT R3,CVTLOOP REPEAT FOR EACH DIGIT 00000738 LR R1,R5 COPY RESULT INTO R1 00000739 RCRTN LM R2,R15,RCSAVE RESTORE REGISTERS 00000740 BR R14 00000741 SPACE 00000742 RCSAVE DS 7D LOCAL SAVE AREA 00000743 EJECT 00000744 * CALCULATE CHECKSUM FOR STRING: R0 = LENGTH, R1 -> CHARACTERS. 00000745 * FOUR-BYTE CHECKSUM RETURNED IN R2. 00000746 CHKCALC EQU * 00000747 STM R0,R15,CHKSAVE SAVE REGISTERS 00000748 SR R5,R5 CHECKSUM = 0 00000749 STC R5,CHKFLAG FLAGS = 0 00000750 L R3,=A(TOASCSTD) R3 -> TRANSLATE TABLE 00000751 TM FLAGS3,ALTTR IF BROWN, USE SPECIAL TABLE 00000752 BZ CHKBINCK 00000753 L R3,=A(TOASCBRN) 00000754 CHKBINCK TM FLAGS2,BINXF ASCII XFER? 00000755 BZ CHKZERO NO, CONTINUE NORMALLY 00000756 C R0,=F'3' AT LEAST 3 CHARACTERS? 00000757 BL CHKZERO NO, CONTINUE NORMALLY 00000758 CLC 0(2,R1),=C'DB' DB RESPONSE? 00000759 BNE CHKZERO 00000760 OI CHKFLAG,CHKBIN SUPPRESS TRANSLATION 00000761 TR 0(2,R1),0(R3) TRANSLATE 'DB' TO ASCII 00000762 CHKZERO LTR R7,R0 00000763 BZ CHKCVT IF LENGTH 0, KEEP 0 CHECKSUM 00000764 LR R6,R1 R6 -> FIRST BYTE, R7 = BCT COUNT 00000765 L R8,=V(CRCTAB) R8 -> CRCTAB 00000766 CHKLOOP EQU * LOOP TO PROCESS EACH BYTE 00000767 SR R4,R4 R4 = DATA BYTE 00000768 IC R4,0(R6) 00000769 TM CHKFLAG,CHKBIN BINARY DATA? 00000770 BO CHKXOR YES, SKIP TRANSLATION 00000771 IC R4,0(R3,R4) TRANSLATE TO ASCII 00000772 CHKXOR XR R4,R5 XOR WITH LOW CHECKSUM BYTE 00000773 N R4,=X'000000FF' 00000774 SRL R5,8 SHIFT CRC RIGHT 8 BITS 00000775 SLL R4,1 GET TABLE INDEX 00000776 LH R4,0(R4,R8) R4 = HALFWORD FROM TABLE 00000777 N R4,=X'0000FFFF' 00000778 XR R5,R4 XOR WITH CHECKSUM 00000779 LA R6,1(R6) R6 -> NEXT BYTE 00000780 BCT R7,CHKLOOP CONTINUE TO END 00000781 CHKCVT STCM R5,B'0011',CHKDATA STORE FINAL CHECKSUM 00000782 UNPK CHKCHAR(5),CHKDATA(3) CONVERT TO HEX CHARS. 00000783 TR CHKCHAR(4),HEXCHARS-240 00000784 MVC CHKSAVE+8(4),CHKCHAR RETURN RESULT IN R2 00000785 TM CHKFLAG,CHKBIN BINARY DATA? 00000786 BZ CHKRTN NO, READY TO RETURN 00000787 MVC 0(2,R1),=C'DB' RESTORE 'DB' IN EBCDIC 00000788 CHKRTN LM R0,R15,CHKSAVE RESTORE REGISTERS 00000789 BR R14 00000790 CHKSAVE DS 8D LOCAL SAVE AREA 00000791 HEXCHARS DC C'0123456789ABCDEF' CHARACTERS FOR HEX CONVERSION 00000792 CHKDATA DS 2X CHECKSUM BYTES 00000793 DS 1X EXTRA BYTE FOR UNPK 00000794 CHKCHAR DS 5X CHARACTER CHECKSUM 00000795 CHKFLAG DS 1X LOCAL FLAG BYTE 00000796 CHKBIN EQU X'01' BINARY DATA 00000797 EJECT 00000798 * 00000799 * "WRITE" OUTPUTS A CHARACTER STRING TO THE TERMINAL. NO EXTRA 00000800 * BYTES (E.G. DC3) ARE TRANSMITTED FOLLOWING THE STRING. 00000801 * AT ENTRY, R1 -> STRING, AND R2 CONTAINS THE STRING LENGTH. 00000802 * 00000803 WRITE DS 0H 00000804 MVI WMODE,0 INDICATE WRITE ONLY 00000805 B WRBOTH 00000806 SPACE 00000807 WRITERD DS 0H 00000808 MVI WMODE,X'FF' INDICATE READ ALSO 00000809 WRBOTH STM R0,R15,WRSAVE SAVE REGISTERS 00000810 TM TRMFLAGS,GRAFTRM 3270 TERMINAL? 00000811 BO WRITEGRF YES, DO 3270 I/O 00000812 LR R3,R1 COPY STRING ADDRESS INTO R3 00000813 * R2 = LENGTH, R3 = ADDRESS OF STRING 00000814 LTR R2,R2 ANY BYTES LEFT? 00000815 BNP WRRTN IF NOT, RETURN 00000816 WRTERM (R3),(R2),EDIT=LONG WRITE (R2) BYTES FROM (R3) 00000817 B WRRTN RETURN 00000818 EJECT 00000819 WRITEGRF EQU * 3270 OUTPUT 00000820 LTR R2,R2 IF NO BYTES, JUST RETURN 00000821 BZ WRRTN 00000822 ***** LR R3,R1 ***** 00000823 ***** FSWRITE 'RMAC DEBUG A',BUFFER=(R3),BSIZE=(R2),RECFM=V ***** 00000824 ***** LR R1,R3 ***** 00000825 * STORE XPARENT OR WSF PREFIX 00000826 TM TRMFLAGS,MAC3270 WSF FOR MAC3270 00000827 BO WSFPFX 00000828 MVC GRAFDATA(7),=X'F3115D7F110000' XPARENT WRITE CODE 00000829 LA R3,7 00000830 CLI WMODE,0 JUST WRITE? 00000831 BE ADDPFX YES, HAVE THE RIGHT PREFIX 00000832 MVI GRAFDATA+6,X'01' ELSE CHANGE TO WRITE/READ 00000833 LA R4,0(R1,R2) R4 -> PAST LAST BYTE 00000834 MVC 0(4,R4),=X'0D256E12' SIMULATE LINE MODE PROMPT 00000835 LA R2,4(R2) ADJUST LENGTH 00000836 B ADDPFX 00000837 SPACE 00000838 WSFPFX LA R3,3(R2) GET WSF LENGTH AND STORE 00000839 STCM R3,B'0011',GRAFDATA 00000840 MVI GRAFDATA+2,X'20' APPEND XFER CODE 00000841 LA R3,3 R3 = TOTAL LENGTH 00000842 ADDPFX LA R4,GRAFDATA(R3) R4 -> PAST PREFIX 00000843 LR R6,R1 R6 -> SOURCE DATA 00000844 LR R1,R4 SAVE NEW LOCATION IN R1 00000845 LR R5,R2 R5, R7 = LENGTH 00000846 LR R7,R2 00000847 MVCL R4,R6 COPY DATA TO BUFFER 00000848 L R0,=A(TOASCSTD) R0 -> TRANSLATE TABLE 00000849 TM FLAGS3,ALTTR IF BROWN USE SPECIAL TABLE 00000850 BZ WRITETR 00000851 L R0,=A(TOASCBRN) 00000852 * R1 = ADDR., R2 = LENGTH 00000853 WRITETR BAL R14,LONGTR TRANSLATE TO ASCII 00000854 TM TRMFLAGS,MAC3270 SKIP NEXT XLATE IF MAC3270 00000855 BO WRDEFCCW 00000856 L R0,=A(HBITTAB) R0 -> TABLE 00000857 BAL R14,LONGTR TURN ON HIGH BIT OF ALL DATA 00000858 WRDEFCCW LA R3,0(R2,R3) R3 = TOTAL LENGTH 00000859 LH R2,CONADDR R2 = CONSOLE ADDRESS 00000860 ICM R2,B'1000',=X'01' INDICATE CMS CONSOLE 00000861 LA R13,R13SAVE R13 -> SAVE AREA 00000862 TM TRMFLAGS,MAC3270 USE WSF FOR MAC3270 00000863 BO WRWSF 00000864 * ELSE 7171 XPARENT WRITE 00000865 STH R3,WCCWLEN STORE DATA SIZE 00000866 LA R1,WCCW R1 -> CCW 00000867 L R15,=V(SCRIO) R15 -> ENTRY POINT 00000868 BALR R14,R15 EXECUTE TRANSPARENT WRITE 00000869 BNZ WRRTN RETURN IF ERROR 00000870 BAL R14,READ3270 WAIT FOR ATTN & ISSUE READ 00000871 CLI WMODE,0 JUST WRITE? 00000872 BE WRRTN YES, THEN RETURN NOW 00000873 B WRREAD PROCESS READ 00000874 SPACE 00000875 WRWSF STH R3,WSFCCWLN STORE LENGTH 00000876 LA R1,WSFCCW3 R1 -> CCW 00000877 L R15,=V(SCRIO) R15 -> ENTRY POINT 00000878 BALR R14,R15 EXECUTE WSF 00000879 BNZ WRRTN RETURN IF ERROR 00000880 CLI WMODE,0 JUST WRITE? 00000881 BE WRRTN YES, THEN RETURN NOW 00000882 BAL R14,READ3270 WAIT FOR ATTN & ISSUE READ 00000883 WRREAD EQU * PROCESS READ 00000884 LA R1,GRAFDATA R1 -> DATA 00000885 LH R2,GRAFLEN R2 = LENGTH 00000886 XC RECVLEN(2),RECVLEN SET LENGTH TO ZERO 00000887 LTR R2,R2 ANY BYTES READ? 00000888 BNP WRRTN NO, JUST RETURN 00000889 ***** LR R3,R1 ***** 00000890 ***** FSWRITE 'RMAC DEBUG A',BUFFER=(R3),BSIZE=(R2),RECFM=V ***** 00000891 ***** LR R1,R3 ***** 00000892 TM TRMFLAGS,MAC3270 FOR MAC3270 SKIP AID 00000893 BO SKIPAID 00000894 CLI 0(R1),X'E8' CHECK FOR NULL AID 00000895 BNE WRRTN RETURN IF NOT THERE 00000896 LA R1,3(R1) SKIP 7171 AID AND ADDR. 00000897 S R2,=F'4' ALSO SKIP CR AT END 00000898 B WRRDCOM 00000899 SPACE 00000900 SKIPAID CLI 0(R1),X'88' CHECK FOR WSF REPLY AID 00000901 BNE WRRTN RETURN IF NOT THERE 00000902 LA R1,1(R1) SKIP AID 00000903 BCTR R2,0 ADJUST LENGTH 00000904 WRRDCOM LTR R2,R2 ANY BYTES LEFT 00000905 BNP WRRTN NO, JUST RETURN 00000906 STH R2,RECVLEN STORE LENGTH FOR RECEIVE 00000907 LR R3,R2 R3, R5 = LENGTH 00000908 LR R5,R2 00000909 LA R2,RECVDATA R2 -> DESTINATION 00000910 LR R4,R1 R4 -> SOURCE 00000911 MVCL R2,R4 MOVE DATA 00000912 L R0,=A(FRASCSTD) R0 -> TRANSLATE TABLE 00000913 TM FLAGS3,ALTTR IF BROWN, USE SPECIAL TABLE 00000914 BZ WRITETR2 00000915 L R0,=A(FRASCBRN) 00000916 WRITETR2 LA R1,RECVDATA R1 -> DATA 00000917 LH R2,RECVLEN R2 = LENGTH 00000918 TM FLAGS2,BINXF BINARY TRANSFER? 00000919 BZ WRTXTTR NO, NORMAL TRANSLATE 00000920 C R2,=F'7' AT LEAST DB, CHECKSUM? 00000921 BL WRTXTTR NO, NORMAL TRANSLATE 00000922 CLC 0(2,R1),=X'4442' ASCII 'DB' AT START? 00000923 BNE WRTXTTR NO, NORMAL TRASLATE 00000924 LR R3,R0 R3 -> TRANSLATE TABLE 00000925 TR 0(2,R1),0(R3) TRANSLATE 'DB' 00000926 LA R2,0(R1,R2) R2 -> PAST LAST BYTE 00000927 S R2,=F'5' R2 -> CHECKSUM DELIMITER 00000928 TR 0(5,R2),0(R3) TRANSLATE CD, CHECKSUM 00000929 B WRRTN READY TO RETURN 00000930 SPACE 00000931 WRTXTTR BAL R14,LONGTR TRANSLATE DATA TO EBCDIC 00000932 WRRTN LM R0,R15,WRSAVE RESTORE REGISTERS 00000933 BR R14 RETURN TO CALLER 00000934 SPACE 00000935 WRSAVE DC 8D'0' SAVE AREA FOR R0-R15 00000936 WMODE DS 1X >0 = WRITE, READ FOR 3270 00000937 EJECT 00000938 * 00000939 * SUBCHK - CHECK FOR SUBSET MODE 00000940 * IF THE LAST COMMAND RESULTED IN RETURN CODE 11, ENTER SUBSET MODE, 00000941 * OR KEEP THE RETURN CODE AS IS TO ABORT THE TRANSFER. 00000942 * 00000943 SUBCHK DS 0H 00000944 STM R0,R15,SUBSAVE SAVE REGISTERS 00000945 SR R8,R8 R8 = 0 FOR NORMAL RETURN 00000946 CLC RECVDATA(6),=C'RC0011' ABORT/SUBSET RETURN CODE? 00000947 BNE SUBRETN IF NOT, CONTINUE NORMALLY 00000948 * RESTORE NORMAL TERMINAL ENVIRONMENT TEMPORARILY 00000949 TM TRMFLAGS,GRAFTRM SKIP ASCII STUFF IF 3270 00000950 BO WSUBCODE 00000951 CLC NODEID(8),BROWNID SKIP PROMPT COMMAND IF NOT BROWN 00000952 BNE PRSKIP2 00000953 LINEDIT TEXT='TERM PROMPT ON',DOT=NO,DISP=CPCOMM 00000954 PRSKIP2 EQU * 00000955 LINEDIT TEXT='TERM LINESIZE 80',DISP=CPCOMM,DOT=NO 00000956 LINEDIT TEXT='SET LINEDIT ON',DISP=CPCOMM,DOT=NO 00000957 DMSEXS MVC,AINTRTBL(4),INTAB RESTORE XLATE TABLES 00000958 DMSEXS MVC,AOUTRTBL(4),OUTTAB 00000959 WSUBCODE LA R1,SUBCODE R1 -> STRING 00000960 LA R2,1 R2 = LENGTH 00000961 BAL R14,WRITE TELL VMXFER TO CALL "SUBSET" 00000962 BAL R14,ENDFS EXIT FULL-SCREEN MODE 00000963 SUBPRMT WRTERM 'Enter ABORT, CONTINUE, or SUBSET',EDIT=NO 00000964 RDTERM RDRESP READ RESPONSE 00000965 CLC RDRESP(7),=CL7'SUBSET' ENTER SUBSET MODE IF WANTED 00000966 BE SUBSET 00000967 CLC RDRESP(6),=CL6'ABORT' ABORT IF WANTED 00000968 BE SUBREST 00000969 CLC RDRESP(9),=CL9'CONTINUE' JUST CONTINUE IF SPECIFIED 00000970 BE SUBCONT 00000971 B SUBPRMT ELSE TRY AGAIN FOR VALID ANSWER 00000972 SPACE 00000973 SUBSET LA R1,SUBCMMD ENTER SUBSET MODE 00000974 SVC 202 "SUBSET" COMMAND 00000975 DC AL4(*+4) 00000976 SUBCONT LA R8,1 INDICATE CP/M COMMAND RETRY 00000977 SUBREST EQU * RESTORE XFER ENVIRONMENT 00000978 BAL R14,BEGINFS RESTORE FULL-SCREEN MODE 00000979 LA R1,SUBCODE R1 -> STRING 00000980 LA R2,1 R2 = LENGTH 00000981 BAL R14,WRITE TELL VMXFER TO RETURN TO MAIN LOOP 00000982 TM TRMFLAGS,GRAFTRM IF 3270, READY TO RETURN 00000983 BO SUBRETN 00000984 MVC INTAB(4),AINTRTBL SAVE "SET INPUT" TABLE 00000985 MVC OUTTAB(4),AOUTRTBL SAVE "SET OUTPUT" TABLE 00000986 DMSEXS XC,AINTRTBL(4),AINTRTBL RESET INPUT TRANSLATION 00000987 DMSEXS XC,AOUTRTBL(4),AOUTRTBL RESET OUTPUT TRANSLATION 00000988 LINEDIT TEXT='SET LINEDIT OFF',DISP=CPCOMM,DOT=NO 00000989 LINEDIT TEXT='TERM LINESIZE OFF',DISP=CPCOMM,DOT=NO 00000990 CLC NODEID(8),BROWNID SET PROMPT IF BROWN 00000991 BNE SUBRETN 00000992 LINEDIT TEXTA=PRMTCMD,DISP=CPCOMM,DOT=NO 00000993 SUBRETN LTR R8,R8 SET CC FOR CPMCMMD 00000994 LM R0,R15,SUBSAVE RESTORE REGISTERS 00000995 BR R14 RETURN TO CPMCMMD 00000996 SPACE 00000997 SUBSAVE DC 8D'0' SAVE AREA R0-R15 00000998 SUBCMMD DC CL8'SUBSET' "SUBSET" COMMAND 00000999 DC 8X'FF' 00001000 SUBCODE DC X'3C' DC4 IS VMXFER SUBSET CODE 00001001 EJECT 00001002 * 00001003 * CHANGE DATE OF NEW FILE TO DATE OF MAC FILE 00001004 * 00001005 SETDATE DS 0H 00001006 STM R0,R15,SDSAVE SAVE REGISTERS 00001007 DMSKEY NUCLEUS WILL NEED SYSTEM KEY 00001008 * GET EDF DATE FROM CP/M DATE 00001009 PACK HEXBUFF(8),RECVATTR+4(15) CONVERT TO BINARY 00001010 MVC EDFDATE(6),HEXBUFF+1 COPY DATE AND TIME 00001011 YRUNPK UNPK CDFYEAR(3),EDFDATE(2) CHARACTER YEAR FOR CDF FST 00001012 * NOW READY TO UPDATE FST 00001013 LA R1,OUTFILE CALL FSTLKP FOR OUTPUT FILE 00001014 L R15,VCFSTLKP 00001015 BALR R14,R15 00001016 LTR R15,R15 00001017 BNZ SDRTN GIVE UP IF NOT FOUND (STRANGE) 00001018 L R5,AFVS ADDRESS FVSECT 00001019 USING FVSECT,R5 00001020 LR R2,R0 R0 -> ADT 00001021 USING ADTSECT,R2 00001022 LR R3,R1 R1 -> REAL FST 00001023 USING FSTSECT,R3 00001024 OI UFDBUSY,ERBIT UPDATING DISK- PREVENT HX 00001025 TM ADTFLG4,ADTEDF EDF DISK? 00001026 BO SETEDFD YES- SET EDF DATE 00001027 MVC FSTD(4),EDFDATE+1 COPY MM DD HH MM 00001028 MVC FSTYR(2),CDFYEAR COPY CHARACTER YEAR 00001029 B SDEND 00001030 SPACE 00001031 SETEDFD MVC FSTADATI(6),EDFDATE COPY YY MM DD HH MM SS 00001032 SDEND L R4,ADTCHBA INDICATE HYPERBLOCK CHANGED 00001033 USING DCHSECT,R4 00001034 OI DCHFLG1,DCHCHGD 00001035 DROP R2,R3,R4 00001036 LR R0,R2 RESTORE POINTER TO ADT 00001037 SR R1,R1 R1 = 0 FOR TFINIS 00001038 L R15,ATFINIS 00001039 BALR R14,R15 CALL TFINIS FOR DISK 00001040 LA R1,1 R1 > 0 FOR UPDISK 00001041 L R15,AUPDISK 00001042 BALR R14,R15 UPDATE DISK DIRECTORY 00001043 KXCHK ERBIT CHECK FOR HX NOW 00001044 DROP R5 END FVSECT ADDRESSING 00001045 SDRTN DMSKEY RESET RESTORE USER KEY 00001046 LM R0,R15,SDSAVE RESTORE REGISTERS 00001047 BR R14 RETURN TO CALLER 00001048 SPACE 00001049 SDSAVE DS 8D REGISTER SAVE AREA 00001050 HEXBUFF DS 1D BUFFER FOR PACK 00001051 EDFDATE DS 6X YY MM DD HH MM SS 00001052 CDFYEAR DS 3X CHARACTER YEAR FOR CDF FST 00001053 EJECT 00001054 * 00001055 * CHANGE DATE OF NEW FILE TO DATE OF CP/M FILE 00001056 * 00001057 SETDATEC DS 0H 00001058 STM R0,R15,SDSAVE SAVE REGISTERS 00001059 DMSKEY NUCLEUS WILL NEED SYSTEM KEY 00001060 * GET EDF DATE FROM CP/M DATE 00001061 TR RECVATTR+4(8),UNHEXTAB "C1" -> "FA" ETC. 00001062 PACK HEXBUFF(5),RECVATTR+4(9) CONVERT TO BINARY 00001063 MVC EDFDATE+3(2),HEXBUFF+2 COPY HOURS, MINUTES 00001064 MVI EDFDATE+5,0 SECONDS = 0 00001065 SR R3,R3 R3 = JULIAN DATE 00001066 ICM R3,B'0011',HEXBUFF 00001067 A R3,=F'28429' ADD CP/M ADJUSTMENT 00001068 * GET 4*JDATE + 3 00001069 SLL R3,2 00001070 LA R3,3(R3) 00001071 SR R2,R2 DIVIDE BY 1461 00001072 D R2,=F'1461' 00001073 * R2 = DAY, R3 = YEAR 00001074 SRL R2,2 DAY = DAY/4 + 1 00001075 LA R2,1(R2) 00001076 MH R2,=H'5' GET (5*DAY-3)/153 00001077 S R2,=F'3' 00001078 SR R4,R4 00001079 LR R5,R2 00001080 D R4,=F'153' 00001081 * R4 = DAY, R5 = MONTH 00001082 LR R2,R5 R2 = MONTH 00001083 SR R0,R0 DAY = DAY/5 + 1 00001084 LR R1,R4 00001085 D R0,=F'5' 00001086 LA R1,1(R1) R1 = DAY, R2 = MONTH, R3 = YEAR 00001087 LA R2,3(R2) MONTH = MONTH + 3 00001088 C R2,=F'12' IF > 12, SUBTRACT 12 00001089 BNH KEEPMON 00001090 S R2,=F'12' 00001091 LA R3,1(R3) AND ADD 1 TO YEAR 00001092 KEEPMON EQU * 00001093 SR R0,R0 GET BCD DAY 00001094 D R0,=F'10' 00001095 SLL R1,4 SHIFT TENS DIGIT 00001096 AR R1,R0 ADD ONES DIGIT 00001097 STC R1,EDFDATE+2 STORE DAY 00001098 SR R0,R0 GET BCD MONTH 00001099 LR R1,R2 00001100 D R0,=F'10' 00001101 SLL R1,4 SHIFT TENS DIGIT 00001102 AR R1,R0 ADD ONES DIGIT 00001103 STC R1,EDFDATE+1 STORE MONTH 00001104 SR R0,R0 GET BCD YEAR 00001105 LR R1,R3 00001106 D R0,=F'10' 00001107 SLL R1,4 SHIFT TENS DIGIT 00001108 AR R1,R0 ADD ONES DIGIT 00001109 STC R1,EDFDATE STORE YEAR 00001110 B YRUNPK JOIN MAC CODE 00001111 SPACE 00001112 UNHEXTAB DC 256AL1(*-UNHEXTAB) TABLE TO PREPARE FOR PACK 00001113 ORG UNHEXTAB+C'A' 00001114 DC X'FAFBFCFDFEFF' 00001115 ORG 00001116 EJECT 00001117 ZEROLAST STM R0,R3,SAVE4 SAVE REGISTERS 00001118 L R0,=A(RECVLAST) ADDRESS OF BUFFER 00001119 LA R1,1032 SIZE OF BUFFER 00001120 SR R2,R2 ZEROS FOR SOURCE 00001121 SR R3,R3 00001122 MVCL R0,R2 ZERO BUFFER 00001123 LM R0,R3,SAVE4 RESTORE REGISTERS 00001124 BR R14 RETURN TO CALLER 00001125 SPACE 00001126 ZERODATA STM R0,R3,SAVE4 SAVE REGISTERS 00001127 LA R0,RECVDATA ADDRESS OF BUFFER 00001128 LA R1,1032 SIZE OF BUFFER 00001129 SR R2,R2 ZEROS FOR SOURCE 00001130 SR R3,R3 00001131 MVCL R0,R2 ZERO BUFFER 00001132 LM R0,R3,SAVE4 RESTORE REGISTERS 00001133 BR R14 RETURN TO CALLER 00001134 SPACE 00001135 COPYDATA STM R0,R3,SAVE4 SAVE REGISTERS 00001136 L R0,=A(RECVLAST) DESTINATION ADDR. & LENGTH 00001137 LA R1,1032 00001138 LA R2,RECVDATA SOURCE ADDR. & LENGTH 00001139 LA R3,1032 00001140 MVCL R0,R2 COPY DATA 00001141 LM R0,R3,SAVE4 RESTORE REGISTERS 00001142 BR R14 RETURN TO CALLER 00001143 SPACE 00001144 COMPDATA STM R0,R3,SAVE4 SAVE REGISTERS 00001145 L R0,=A(RECVLAST) DESTINATION ADDR. & LENGTH 00001146 LA R1,1032 00001147 LA R2,RECVDATA SOURCE ADDR. & LENGTH 00001148 LA R3,1032 00001149 CLCL R0,R2 COMPARE DATA 00001150 LM R0,R3,SAVE4 RESTORE REGISTERS 00001151 BR R14 RETURN TO CALLER 00001152 SPACE 00001153 SAVE4 DS 2D SAVE AREA R0-R15 00001154 EJECT 00001155 * 00001156 * SUBROUTINE TO UPDATE TRANSFER RATE FROM LAST COMMAND TIMING 00001157 * 00001158 TIMEUPD DS 0H 00001159 STM R0,R15,TIMESAVE SAVE REGISTERS 00001160 L R1,WRCNT GET TOTAL CHARACTER COUNT 00001161 A R1,RDCNT 00001162 C R1,=F'1024' IGNORE IF < 1024 00001163 BL TIMERTN 00001164 A R1,TOTCHRS UPDATE TOTAL CHARACTERS 00001165 ST R1,TOTCHRS 00001166 LM R2,R3,ENDTIME GET ELAPSED TIME 00001167 SRDL R2,12 SHIFT TO GET MICROSECONDS 00001168 LM R4,R5,STRTTIME 00001169 SRDL R4,12 00001170 SLR R3,R5 GET LOW-ORDER DIFFERENCE 00001171 BNM MSSUB IF NO BORROW, READY FOR REST 00001172 SL R2,=F'1' PERFORM BORROW 00001173 MSSUB SLR R2,R4 GET HIGH-ORDER DIFFERENCE 00001174 LM R4,R5,TOTSECS GET PREVIOUS TOTAL 00001175 ALR R3,R5 GET LOW-ORDER SUM 00001176 BC 12,MSADD IF NO CARRY, READY FOR REST 00001177 AL R2,=F'1' PERFORM CARRY 00001178 MSADD ALR R2,R4 GET HIGH-ORDER RUM 00001179 STM R2,R3,TOTSECS STORE NEW TOTAL 00001180 D R2,=F'1000000' DIVIDE BY 1000000 TO GET SECONDS 00001181 C R2,=F'500000' IS REMAINDER MORE THAN HALF? 00001182 BNH USESECS NO, KEEP QUOTIENT 00001183 AL R3,=F'1' ELSE ADD 1 00001184 USESECS LTR R3,R3 ZERO SECONDS? 00001185 BZ TIMERTN YES, JUST RETURN 00001186 SR R0,R0 R0,R1 = TOTAL CHARACTERS 00001187 DR R0,R3 DIVIDE TO GET CHARS./SECOND IN R1 00001188 SRL R3,1 R3 = HALF OF SECONDS 00001189 CR R0,R3 IS REMAINDER MORE THAN HALF? 00001190 BNH USERATE NO, KEEP QUOTIENT 00001191 AL R1,=F'1' ELSE ADD 1 00001192 USERATE CVD R1,DECBUF CONVERT TO PACKED DECIMAL 00001193 UNPK DECBUF(5),DECBUF+5(3) CONVERT TO CHARS. 00001194 OI DECBUF+4,X'F0' FIX FIRST NIBBLE OF LAST BYTE 00001195 MVC XFSPEED(4),DECBUF+1 UPDATE XFSPEED WITH RESULT 00001196 TIMERTN LM R0,R15,TIMESAVE RESTORE REGISTERS 00001197 BR R14 RETURN 00001198 SPACE 00001199 TIMESAVE DS 8D LOCAL SAVE AREA 00001200 EJECT 00001201 * 00001202 * TERMTYPE - subroutine to determine terminal information and 00001203 * set TRMFLAGS accordingly. The 3270 console address 00001204 * is also determined and saved. 00001205 * 00001206 TERMTYPE DS 0H 00001207 STM R0,R15,TRMSAVE SAVE REGISTERS 00001208 L R4,=F'-1' GET CONSOLE ADDR. FROM CP 00001209 DIAG R4,R5,X'24' GET CONSOLE CHARACTERISTICS 00001210 BNZ TRMDONE IF ANY ERROR, TREAT AS ASCII 00001211 STCM R4,B'0011',CONADDR SAVE CONSOLE ADDRESS 00001212 LA R4,GRTSIZE GET GRAFTAB SIZE 00001213 LA R5,GRAFTAB R5 -> START OF TABLE 00001214 GRTLOOP EQU * CHECK FOR REAL 3270 00001215 CLM R6,B'1100',0(R5) CHECK REAL CLASS & TYPE 00001216 BE TRM3270 HAVE A 3270 IF MATCH 00001217 LA R5,4(R5) R5 -> NEXT ENTRY 00001218 BCT R4,GRTLOOP LOOP THROUGH TABLE 00001219 B TRMDONE TREAT AS ASCII IF NO MATCH 00001220 SPACE 00001221 TRM3270 EQU * NOW CHECK MODEL NUMBER 00001222 TM 3(R5),WSF MIGHT WSF BE SUPPORTED? 00001223 BZ MDLINIT NO, SKIP TO MODEL TEST 00001224 OI TRMFLAGS,SFDEV INDICATE WSF MAY WORK 00001225 MDLINIT LA R4,MDLSIZE GET MDLTAB SIZE 00001226 LA R5,MDLTAB R5 -> START OF TABLE 00001227 MDLLOOP EQU * SCAN FOR MATCHING MODEL 00001228 CLM R6,B'0010',0(R5) COMPARE MODELS 00001229 BE USE3270 READY TO USE IF A MATCH 00001230 LA R5,3(R5) R5 -> NEXT ENTRY 00001231 BCT R4,MDLLOOP LOOP THROUGH TABLE 00001232 MVI TRMFLAGS,0 TREAT AS ASCII IF NO MATCH 00001233 B TRMDONE 00001234 SPACE 00001235 USE3270 OI TRMFLAGS,GRAFTRM INDICATE 3270 TERMINAL 00001236 * CHECK FOR VTAM CONNECTION 00001237 LA R1,MSGOFF R1 -> TERM BREAKIN COMMAND 00001238 LA R3,MSGOFFLB R3 = COMMAND LENGTH 00001239 ICM R3,B'1000',=X'40' INDICATE RESPONSE IN A BUFFER 00001240 LA R2,RECVDATA R2 -> BUFFER 00001241 LA R4,128 R4 = BUFFER LENGTH 00001242 DIAG R1,R3,8 EXECUTE COMMAND 00001243 LTR R3,R3 DID IT WORK? 00001244 BZ NOTVTAM YES, MUST NOT BE VTAM 00001245 OI TRMFLAGS,VTAM SET VTAM FLAG 00001246 B VTAMEND 00001247 SPACE 00001248 NOTVTAM LA R1,MSGON RESTORE BREAKIN DEFAULT 00001249 LA R3,MSGONLB 00001250 DIAG R1,R3,8 00001251 VTAMEND BAL R14,BEGINFS ENTER FULL-SCREEN MODE 00001252 TM TRMFLAGS,SFDEV ANY POINT IN ISSUING WSF? 00001253 BZ TRMDONE NO, JUST RETURN 00001254 TRYWSF1 LA R1,WSFCCW1 R1 -> WSF CCW 00001255 LH R2,CONADDR R2 = CONSOLE ADDRESS 00001256 ICM R2,B'1000',=X'01' INDICATE CMS CONSOLE 00001257 LA R13,R13SAVE R13 -> SAVE AREA 00001258 L R15,=V(SCRIO) R15 -> ENTRY POINT 00001259 BALR R14,R15 EXECUTE WSF QUERY REPLY 00001260 BZ WSFREAD IF OK, READ AND INTERPRET 00001261 C R15,=X'0000008E' LINE-MODE INPUT WAITING? 00001262 BNE TRMDONE NO, MUST NOT BE SUPPORTED 00001263 RDTERM RECVDATA READ LINE MODE INPUT 00001264 B TRYWSF1 TRY AGAIN 00001265 SPACE 00001266 WSFREAD BAL R14,READ3270 READ RESPONSE INTO GRAFDATA 00001267 LA R2,GRAFDATA R2 -> START OF DATA 00001268 LH R3,GRAFLEN R3 = LENGTH OF DATA 00001269 C R3,=F'3' AT LEAST AID AND LENGTH? 00001270 BL TRMDONE IF NOT, NOTHING TO DO (STRANGE) 00001271 CLI 0(R2),X'88' CORRECT AID BYTE? 00001272 BNE TRMDONE NO, ALSO STRANGE 00001273 LA R2,1(R2) R2 -> FIRST FIELD 00001274 BCTR R3,0 R3 = BYTES REMAINING 00001275 * LOOP TO PROCESS FIELDS 00001276 QRNEWFLD EQU * START NEW FIELD 00001277 C R3,=F'4' AT LEAST 4 BYTES LEFT? 00001278 BL TRMDONE NO, MUST BE DONE 00001279 CLI 2(R2),X'81' QUERY REPLY ID? 00001280 BNE TRMDONE NO, CAN'T DEAL WITH THIS 00001281 SR R4,R4 GET FIELD LENGTH IN R4 00001282 ICM R4,B'0011',0(R2) 00001283 CR R3,R4 EXIT IF NOT THAT MUCH LEFT 00001284 BL TRMDONE (SHOULDN'T HAPPEN) 00001285 CLI 3(R2),X'80' SUMMARY CODE? 00001286 BNE QRNXTFLD NO, TRY NEXT FIELD 00001287 LA R5,4(R2) R5 -> FIRST SUMMARY CODE 00001288 LR R6,R3 R6 = COUNT OF CODES 00001289 S R6,=F'4' 00001290 BNP TRMDONE DONE IF NOT > 0 00001291 QRPQLP EQU * LOOK FOR RQPNAMES CODE 00001292 CLI 0(R5),X'A1' FOUND THE CODE 00001293 BE FOUNDRPQ YES, PROCESS 00001294 LA R5,1(R5) R5 -> NEXT CODE 00001295 BCT R6,QRPQLP TRY NEXT 00001296 B TRMDONE EXIT IF NOT FOUND 00001297 SPACE 00001298 QRNXTFLD AR R2,R4 INCREMENT POINTER 00001299 SR R3,R4 DECREMENT BYTES LEFT 00001300 B QRNEWFLD REPEAT TO END OF DATA 00001301 SPACE 00001302 FOUNDRPQ EQU * RETRIEVE RPQ NAMES DATA 00001303 TRYWSF2 LA R1,WSFCCW2 R1 -> WSF CCW 00001304 LH R2,CONADDR R2 = CONSOLE ADDRESS 00001305 ICM R2,B'1000',=X'01' INDICATE CMS CONSOLE 00001306 LA R13,R13SAVE R13 -> SAVE AREA 00001307 L R15,=V(SCRIO) R15 -> ENTRY POINT 00001308 BALR R14,R15 EXECUTE WSF QUERY REPLY 00001309 BZ RPQREAD IF OK, READ AND INTERPRET 00001310 C R15,=X'0000008E' LINE-MODE INPUT WAITING? 00001311 BNE TRMDONE NO, MUST NOT BE SUPPORTED 00001312 RDTERM RECVDATA READ LINE MODE INPUT 00001313 B TRYWSF2 TRY AGAIN 00001314 SPACE 00001315 RPQREAD BAL R14,READ3270 READ RESPONSE INTO GRAFDATA 00001316 LH R2,GRAFLEN GET SIZE OF RESPONSE 00001317 C R2,=F'19' AT LEAST 19 BYTES? 00001318 BL TRMDONE NO, CAN'T USE 00001319 CLI GRAFDATA,X'88' QUERY REPLY AID? 00001320 BNE TRMDONE NO, CAN'T USE 00001321 CLC GRAFDATA+3(2),=X'81A1' CORRECT REPLY? 00001322 BNE TRMDONE NO, CAN'T USE 00001323 CLC GRAFDATA+5(4),=C'GFTM' CORRECT DEVICE? 00001324 BNE TRMDONE NO, CAN'T USE 00001325 OI TRMFLAGS,MAC3270 SET MAC3270 FLAG 00001326 MVI M3270VER,C'A' 'A' FOR APPLETALK 00001327 MVC M3270VER+1(2),GRAFDATA+14 COPY VERSION 00001328 MVC M3270VER+3(2),GRAFDATA+17 00001329 TRMDONE LM R0,R15,TRMSAVE RESTORE REGISTERS 00001330 BR R14 RETURN 00001331 TRMSAVE DS 8D LOCAL SAVE AREA 00001332 SPACE 00001333 * 3270 LIST OF RDEVTYPC, RDEVTYPE, ERASE/WRITE OR ERASE/WRITE ALT. BITS 00001334 * AND MASK FOR APL/TEXT SUPPORT 00001335 GRAFTAB EQU * 00001336 DC AL1(CLASGRAF,TYP3277),X'80',AL1(0) LOCAL 3277 00001337 DC AL1(CLASGRAF,TYP3278),X'C0',AL1(WSF) LOCAL 3278,3279 00001338 DC AL1(CLASGRAF,TYP3276),X'C0',AL1(0) LOCAL 3276 00001339 DC AL1(CLASGRAF,TYP3275),X'80',AL1(0) LOCAL 3275 00001340 DC AL1(CLASTERM,TYP3277),X'80',AL1(0) REMOTE 3277 00001341 DC AL1(CLASTERM,TYP3278),X'C0',AL1(WSF) REMOTE 3278,3279 00001342 DC AL1(CLASTERM,TYP3276),X'C0',AL1(0) REMOTE 3276 00001343 DC AL1(CLASTERM,TYP3275),X'80',AL1(0) REMOTE 3275 00001344 GRTSIZE EQU (*-GRAFTAB)/4 NUMBER OF TABLE ENTRIES 00001345 SPACE 00001346 CLASTERM EQU X'80' TERMINAL DEVICE CLASS 00001347 CLASGRAF EQU X'40' GRAPHICS DEVICE CLASS 00001348 TYP3277 EQU X'04' 3277 DISPLAY STATION 00001349 TYP3276 EQU X'03' 3276 DISPLAY STATION 00001350 TYP3275 EQU X'02' 3275 DISPLAY STATION 00001351 TYP3278 EQU X'01' 3278 DISPLAY STATION 00001352 TYP3215 EQU X'00' 3215 CONSOLE 00001353 SPACE 00001354 WSF EQU X'01' WSF IS POTENTIALLY SUPPORTED 00001355 SPACE 00001356 * TABLE OF MODEL NUMBER BYTE , ROW COUNT, AND SCREEN WIDTH 00001357 MDLTAB EQU * 00001358 DC X'02',AL1(24),AL1(80) 24 ROWS, 80 COLUMNS 00001359 DC X'2A',AL1(20),AL1(80) 20 ROWS, 80 COLUMNS 00001360 DC X'03',AL1(32),AL1(80) 32 ROWS, 80 COLUMNS 00001361 DC X'04',AL1(43),AL1(80) 43 ROWS, 80 COLUMNS 00001362 DC X'05',AL1(27),AL1(132) 27 ROWS, 132 COLUMNS 00001363 DC X'01',AL1(12),AL1(80) 12 ROWS, 80 COLUMNS 00001364 MDLSIZE EQU (*-MDLTAB)/3 NUMBER OF TABLE ENTRIES 00001365 EJECT 00001366 * 00001367 * BEGINFS and ENDFS: subroutines to enter and leave 3270 00001368 * full-screen mode 00001369 DS 0H 00001370 BEGINFS EQU * 00001371 TM TRMFLAGS,GRAFTRM 3270 TERMINAL? 00001372 BZR R14 NO, JUST IGNORE 00001373 TM FLAGS,FS3270 ALREADY IN FULL-SCREEN MODE? 00001374 BOR R14 YES, JUST RETURN 00001375 STM R0,R15,FSSAVE SAVE REGISTERS 00001376 LA R1,MSGOFF R1 -> CP COMMANDS 00001377 LA R2,MSGOFFL R2 = LENGTH 00001378 TM TRMFLAGS,VTAM VTAM CONNECTION? 00001379 BZ OFFDIAG NO, CONTINUE 00001380 LA R1,MSGOFFV R1 -> VTAM CP COMMANDS 00001381 LA R2,MSGOFFVL R2 = LENGTH 00001382 OFFDIAG DIAG R1,R2,8 EXECUTE COMMANDS TO SUPPRESS MSGS. 00001383 LA R1,CANCLCCW R1 -> CANCEL CCW 00001384 LH R2,CONADDR R2 = CONSOLE ADDRESS 00001385 ICM R2,B'1000',=X'01' INDICATE CMS CONSOLE 00001386 LA R13,R13SAVE R13 -> SAVE AREA 00001387 L R15,=V(SCRIO) R15 -> ENTRY POINT 00001388 BALR R14,R15 EXECUTE CANCEL CCW 00001389 * NOTE: INTERRUPTS ARE NOW DISABLED 00001390 MVC GRAFDATA(4),=X'F3114040' WRITE WCC, SBA 00001391 MVC WCCWLEN(2),=H'4' LENGTH (OF WCC) = 1 00001392 LA R1,WCCW R1 -> CCW 00001393 L R15,=V(SCRIO) R15 -> ENTRY POINT 00001394 BALR R14,R15 ERASE/WRITE FOR FULL-SCREEN MODE 00001395 OI FLAGS,FS3270 REMEMBER IN FULL-SCREEN MODE 00001396 LM R0,R15,FSSAVE RESTORE REGISTERS 00001397 BR R14 RETURN TO CALLER 00001398 SPACE 00001399 ENDFS EQU * END FULL-SCREEN MODE 00001400 TM FLAGS,FS3270 IN FULL-SCREEN MODE? 00001401 BZR R14 NO, JUST RETURN 00001402 STM R0,R15,FSSAVE SAVE REGISTERS 00001403 LH R2,CONADDR R2 = CONSOLE ADDRESS 00001404 ICM R2,B'1000',=X'01' INDICATE CMS CONSOLE 00001405 LA R13,R13SAVE R13 -> SAVE AREA 00001406 MVC GRAFDATA(4),=X'F1114040' WRITE CCW, SBA 00001407 MVC WCCWLEN(2),=H'4' LENGTH (OF WCC) = 1 00001408 LA R1,WCCW R1 -> CCW 00001409 L R15,=V(SCRIO) R15 -> ENTRY POINT 00001410 BALR R14,R15 CLEAR SCREEN, LOCK KEYBOARD 00001411 SSM =X'FF' RESTORE INTERRUPTS 00001412 LA R1,MSGON R1 -> CP COMMANDS 00001413 LA R2,MSGONL R2 = LENGTH 00001414 TM TRMFLAGS,VTAM VTAM CONNECTION? 00001415 BZ ONDIAG NO, CONTINUE 00001416 LA R1,MSGONV R1 -> VTAM CP COMMANDS 00001417 LA R2,MSGONVL R2 = LENGTH 00001418 ONDIAG DIAG R1,R2,8 EXECUTE COMMANDS TO ALLOW MSGS. 00001419 NI FLAGS,255-FS3270 REMEMBER NOT IN FULL-SCREEN MODE 00001420 LM R0,R15,FSSAVE RESTORE REGISTERS 00001421 BR R14 RETURN TO CALLER 00001422 SPACE 00001423 FSSAVE DS 8D LOCAL SAVE AREA 00001424 R13SAVE DS 12D STANDARD SAVE AREA FOR SCRIO 00001425 CANCLCCW DC X'1900000020FF0001' DISPW CANCEL CCW 00001426 MSGOFF DC C'TERM BREAKIN GUESTCTL' CP COMMANDS FOR NO MESSAGES 00001427 MSGOFFLB EQU *-MSGOFF LENGTH OF TERM BREAKIN COMMAND 00001428 DC X'15' 00001429 DC C'SET WNG OFF' 00001430 DC X'15' 00001431 DC C'SET ACNT OFF' 00001432 MSGOFFL EQU *-MSGOFF 00001433 MSGON DC C'TERM BREAKIN IMMED' CP COMMANDS TO RESTORE MESSAGES 00001434 MSGONLB EQU *-MSGON LENGTH OF TERM BREAKIN COMMAND 00001435 DC X'15' 00001436 DC C'SET WNG ON' 00001437 DC X'15' 00001438 DC C'SET ACNT ON' 00001439 MSGONL EQU *-MSGON 00001440 MSGOFFV DC C'SET MSG OFF' VTAM CP COMMANDS FOR NO MESSAGES 00001441 DC X'15' 00001442 DC C'SET WNG OFF' 00001443 DC X'15' 00001444 DC C'SET ACNT OFF' 00001445 MSGOFFVL EQU *-MSGOFFV 00001446 MSGONV DC C'SET MSG ON' VTAM CP COMMANDS TO RESTORE MESSAGES 00001447 DC X'15' 00001448 DC C'SET WNG ON' 00001449 DC X'15' 00001450 DC C'SET ACNT ON' 00001451 MSGONVL EQU *-MSGONV 00001452 EJECT 00001453 * 00001454 * READ3270: Wait for attention from console and issue read-modified 00001455 * 00001456 READ3270 DS 0H 00001457 STM R0,R15,RDMSAVE SAVE REGISTERS 00001458 DMSKEY NUCLEUS NEED SYSTEM KEY FOR PSWS 00001459 RDWAIT EQU * DO READ-MODIFIED AFTER ATTN 00001460 MVC SAVEPSW(8),IONPSW SAVE CURRENT I/O NEW PSW 00001461 LA R1,FINWAIT STORE NEW INTERRUPT ADDRESS 00001462 ST R1,IONPSW+4 00001463 MVC SAVEEXT(8),EXTNPSW ALSO SAVE EXTERNAL NEW PSW 00001464 LA R1,EXTINT STORE NEW EXT. INT. ADDRESS 00001465 ST R1,EXTNPSW+4 00001466 LPSW EQU * 00001467 LPSW WAIT < < < W A I T > > > 00001468 EXTINT EQU * 00001469 MVC IONPSW(8),SAVEPSW RESTORE PSWS 00001470 MVC EXTNPSW(8),SAVEEXT 00001471 LA R1,RDWAIT TELL CMS WHERE TO GO BACK 00001472 ST R1,EXTOPSW+4 00001473 NI EXTOPSW+1,255-2 RESET WAIT BIT 00001474 NI EXTOPSW,0 DON'T RE-ENABLE INTERRUPTS YET 00001475 LPSW SAVEEXT PASS INTERRUPT TO CMS 00001476 SPACE 00001477 FINWAIT EQU * 00001478 MVC IONPSW(8),SAVEPSW RESTORE PSWS 00001479 MVC EXTNPSW(8),SAVEEXT 00001480 CLC IOOPSW+2(2),CONADDR IS IT THE VIRTUAL CONSOLE? 00001481 BE CHKATTN YES, CHECK FOR ATTENTION 00001482 CMSINT EQU * HAVE CMS HANDLE INTERRUPT 00001483 LA R1,RDWAIT TELL CMS WHERE TO GO BACK 00001484 ST R1,IOOPSW+4 00001485 NI IOOPSW+1,255-2 RESET WAIT BIT 00001486 NI IOOPSW,0 DON'T RE-ENABLE INTERRUPTS YET 00001487 LPSW SAVEPSW PASS INTERRUPT TO CMS 00001488 SPACE 00001489 CHKATTN TM CSW+4,X'80' IS THIS ATTN? 00001490 BZ CMSINT NO, PASS IT TO CMS 00001491 LA R1,RCCW R1 -> READ-MODIFIED CCW 00001492 LH R2,CONADDR R2 = CONSOLE ADDRESS 00001493 ICM R2,B'1000',=X'01' INDICATE CMS CONSOLE 00001494 LA R13,R13SAVE R13 -> SAVE AREA 00001495 L R15,=V(SCRIO) R15 -> ENTRY POINT 00001496 BALR R14,R15 DO FULL-SCREEN READ 00001497 BNZ RDERR CHECK FOR ANY ERROR 00001498 L R1,=F'4096' BYTES READ = BUFFER LENGTH 00001499 SR R1,R0 - RESIDUAL COUNT 00001500 STH R1,GRAFLEN STORE READ LENGTH 00001501 B RDMRTN READY TO RETURN 00001502 SPACE 00001503 RDERR SR R1,R1 FOR ERROR, RETURN SIZE 0 00001504 STH R1,GRAFLEN 00001505 RDMRTN DMSKEY RESET RESTORE USER KEY 00001506 LM R0,R15,RDMSAVE RESTORE REGISTERS 00001507 BR R14 RETURN TO CALLER 00001508 SPACE 00001509 RDMSAVE DS 8D LOCAL SAVE AREA 00001510 SAVEPSW DS 1D SAVED PSWS 00001511 SAVEEXT DS 1D 00001512 WAIT DC X'FF060000',AL4(LPSW) WAIT STATE PSW 00001513 EJECT 00001514 * 00001515 * LONGTR - execute TR for arbitrary length string 00001516 * R0 -> table, R1 -> string, R2 = length 00001517 * 00001518 LONGTR DS 0H 00001519 STM R0,R5,TRSAVE SAVE REGISTERS 00001520 LR R4,R0 R4 -> TRANSLATE TABLE 00001521 LR R3,R2 R3 = BYTES LEFT 00001522 SRL R3,8 SHIFT TO GET BCT COUNT 00001523 LTR R3,R3 IF ZERO, SKIP LOOP 00001524 BZ TREND 00001525 LTRLOOP EQU * LOOP FOR 256-BYTE PIECES 00001526 TR 0(256,R1),0(R4) DO THIS PIECES 00001527 LA R1,256(R1) INCREMENT ADDRESS 00001528 S R2,=F'256' DECREMENT LENGTH 00001529 BCT R3,LTRLOOP 00001530 TREND LTR R2,R2 RETURN IF NO BYTES LEFT 00001531 BZ TRRTN 00001532 BCTR R2,0 DECREMENT FOR EXECUTE 00001533 EX R2,TRINST 00001534 TRRTN LM R0,R5,TRSAVE RESTORE REGISTERS 00001535 BR R14 RETURN 00001536 SPACE 00001537 TRSAVE DS 3D LOCAL REGISTER SAVE AREA 00001538 TRINST TR 0(*-*,R1),0(R4) INSTRUCTION FOR EX 00001539 EJECT 00001540 * 00001541 * GETID - Invoke IDENTIFY to get the local node id. Set the 00001542 * node id to blanks if any error. 00001543 * 00001544 GETID DS 0H 00001545 STM R14,R1,GETSAVE SAVE REGISTERS 00001546 MVC NODEID(8),=CL8' ' INITIALIZE NODE ID TO BLANKS 00001547 LA R1,IDPLIST EXECUTE IDENTIFY 00001548 SVC 202 00001549 DC AL4(1) 00001550 LTR R15,R15 JUST RETURN IF ANY ERRORS 00001551 BNZ GETIDRTN 00001552 RDTERM RDRESP GET RESPONSE 00001553 C R0,=F'19' AT LEAST 19 BYTES? 00001554 BL GETIDRTN NO, JUST RETURN 00001555 MVC NODEID(8),RDRESP+12 COPY NODEID FROM IDENITFY 00001556 GETIDRTN LM R14,R1,GETSAVE RESTORE REGISTERS 00001557 BR R14 RETURN 00001558 SPACE 00001559 GETSAVE DS 2D SAVE AREA: R14, R15, R0, R1 00001560 IDPLIST DS 0D 00001561 DC CL8'IDENTIFY' IDENTIFY COMMAND 00001562 DC CL8'(' 00001563 DC CL8'LIFO' 00001564 DC 8X'FF' 00001565 EJECT 00001566 * 00001567 * RMAC DATA AREA: 00001568 * 00001569 ENDTIME DS 1D END TIME FOR RATE CALC. 00001570 DECBUF DS 2D BUFFER FOR CONVERSIONS 00001571 STRTTIME DS 1D START TIME FOR RATE CALC. 00001572 TOTSECS DS 1D TOTAL ELAPSED TIME 00001573 NODEID DS 1D MY NODEID 00001574 BROWNID DC CL8'BROWNVM' NODE ID AT BROWN 00001575 WCCW DS 0D 3270 WRITE CCW 00001576 DC X'29' OP-CODE 00001577 DC AL3(GRAFDATA) BUFFER ADDRESS 00001578 DC X'20' CCW FLAG BITS 00001579 DC X'80' CONTROL BITS FOR CP 00001580 WCCWLEN DC AL2(*-*) LENGTH 00001581 WSFCCW1 DS 0D 3270 WSF CCW 00001582 DC X'29' OP-CODE 00001583 DC AL3(WSFQRCMD) BUFFER ADDRESS 00001584 DC X'20' CCW FLAG BITS 00001585 DC X'20' CONTROL BITS FOR CP 00001586 DC AL2(5) LENGTH 00001587 WSFCCW2 DS 0D 3270 WSF CCW 00001588 DC X'29' OP-CODE 00001589 DC AL3(WSFRPQ) BUFFER ADDRESS 00001590 DC X'20' CCW FLAG BITS 00001591 DC X'20' CONTROL BITS FOR CP 00001592 DC AL2(7) LENGTH 00001593 WSFCCW3 DS 0D 3270 WSF CCW 00001594 DC X'29' OP-CODE 00001595 DC AL3(GRAFDATA) BUFFER ADDRESS 00001596 DC X'20' CCW FLAG BITS 00001597 DC X'20' CONTROL BITS FOR CP 00001598 WSFCCWLN DC AL2(*-*) LENGTH 00001599 RCCW DS 0D 3270 READ CCW 00001600 DC X'2A' OP-CODE 00001601 DC AL3(GRAFDATA) BUFFER ADDRESS 00001602 DC X'20' CCW FLAG BITS 00001603 DC X'80' CONTROL BITS FOR CP 00001604 DC AL2(4096) LENGTH 00001605 VTAMCCW DS 0D 3270 WRITE TO PREP. VTAM 00001606 DC X'29' OP-CODE 00001607 DC AL3(VTAMPREP) BUFFER ADDRESS 00001608 DC X'20' CCW FLAG BITS 00001609 DC X'80' CONTROL BITS FOR CP 00001610 DC AL2(VTAMPRPL) LENGTH 00001611 BUFSIZE DS 1F NO. OF BYTES IN OUTBUF 00001612 RETRYCNT DS 1F RETRY COUNT FOR ALL BLOCKS 00001613 WRCNT DS 1F BYTES WRITTEN FOR RATE CALC. 00001614 RDCNT DS 1F BYTES READ FOR RATE CALC. 00001615 TOTCHRS DS 1F TOTAL CHARACTERS FOR RATE CALC. 00001616 INTAB DS 1A SAVED USER INPUT TABLE 00001617 OUTTAB DS 1A SAVED USER OUTPUT TABLE 00001618 OUTFILE FSCB , OUTPUT FILE CONTROL BLOCK 00001619 OUTBUF DS CL256 BUFFER FOR OUTPUT FILE DATA 00001620 EJECT 00001621 OPTTAB DS 0F OPTION PROCESSING TABLE 00001622 DC CL8'BINARY',AL4(BINOPT) 00001623 DC CL8'MENU',AL4(MENUOPT) 00001624 DC CL8'NOMENU',AL4(NOMENOPT) 00001625 DC CL8'NOBINARY',AL4(NOBINOPT) 00001626 DC CL8'STDXLATE',AL4(STDXOPT) 00001627 DC 8X'FF',AL4(-1) 00001628 SENDLEN DS 1H BYTE COUNT FOR SEND BUFFER 00001629 RECVLEN DS 1H BYTE COUNT FOR RECEIVE BUFFER 00001630 GRAFLEN DS 1H BYTE COUNT FOR 3270 BUFFER 00001631 CONADDR DS 1H 3270 CONSOLE ADDRESS 00001632 WSFQRCMD DC X'000501FF02' WSF QUERY REPLY COMMAND 00001633 WSFRPQ DC X'000701FF0300A1' WSF QUERY LIST FOR RPQ NAMES 00001634 CTLFS DC X'2E2E' CTL-F (ACK) START XFER CODES 00001635 ABORTSTR DC X'02022F' START BYTES AND CTL-G 00001636 ABRTSTRC DC X'02022D' 00001637 RETRYMSG DC C'Retransmitting command',X'15' 00001638 DC X'2D' BELL AT END OF MESSAGE 00001639 RMSGL EQU *-RETRYMSG MESSAGE LENGTH 00001640 VTAMPREP DC X'F31340401140401DC1' 00001641 DC X'3C5D7F40' BLANKS TO END OF SCREEN 00001642 VTAMPRPL EQU *-VTAMPREP LENGTH TO SEND 00001643 DSKMODE DC CL2' ' DISK MODE FOR ERROR MESSAGE 00001644 RECVATTR DS 18C MAC FILE ATTRIBUTE DATA 00001645 MACID DC CL17' ' MACINTOSH FILE ID: FN.FT 00001646 PRMTCMD DC AL1(PRMTCMDL) CP PROMPT COMMAND FOR LINEDIT 00001647 DC C'TERM PROMPT >',X'12' 00001648 PRMTCMDL EQU *-PRMTCMD-1 00001649 CENTSGN DC X'4A' EBCDIC CENT SIGN 00001650 VERSDATA DS 5C VERSION DATA 00001651 M3270VER DS 5C MAC3270 VERSION DATA (FROM WSF) 00001652 XFSPEED DS 4C TRANSFER SPEED, CPS 00001653 DELIM DC C' ' DEFAULT DELIMITER 00001654 RDRESP DC CL130' ' RDTERM RESPONSE BUFFER 00001655 FLAGS DS 1X FLAG BYTE 00001656 FINIS EQU X'01' CALL FINIS FOR OUTPUT FILE 00001657 EOF EQU X'02' CP/M EOF BYTE READ 00001658 NOMENU EQU X'04' HAVE MAC SKIP FILE MENU 00001659 FS3270 EQU X'08' 3270 IN FULL SCREEN MODE 00001660 ROERR EQU X'10' FSWRITE R/O ERROR 00001661 FLAGS2 DS 1X SECOND FLAG BYTE 00001662 BINXF EQU X'01' BINARY TRANSFER 00001663 TERMINIT EQU X'02' TERMINAL INIT. DONE 00001664 VTAMRB EQU X'04' RB COMMAND WITH VTAM 00001665 FLAGS3 DS 1X THIRD FLAG BYTE 00001666 ALTTR EQU X'01' USE ALT. XLATE TABLES 00001667 TRMFLAGS DS 1X FLAG BYTE FOR TERMINAL STATUS 00001668 SFDEV EQU X'01' WSF MAY BE SUPPORTED 00001669 GRAFTRM EQU X'02' 3270 TERMINAL 00001670 MAC3270 EQU X'04' MAC3270 IN USE 00001671 VTAM EQU X'08' VTAM CONNECTION 00001672 SYN DC CL3'SYN' SYNCHRONIZATION (BAD) COMMAND 00001673 LTORG 00001674 SPACE 00001675 SENDSTRT DC 2X'02' HEADER: 2 START BYTES 00001676 SENDDATA DS CL128 SEND DATA BUFFER 00001677 RECVDATA DS CL1032 RECEIVE DATA BUFFER 00001678 RECVLAST DS CL1032 PREVIOUS RECEIVED DATA (ASCII) OR 00001679 * MORE OF RECEIVE BUFFER (MAC3270) 00001680 DS CL248 MORE OF RECEIVE BUFFER (MAC3270) 00001681 GRAFDATA DS 512D 3270 I/O BUFFER 00001682 EJECT 00001683 TOASCBRN DS 0D BROWN'S CP EBCDIC TO ASCII TRANSLATE TABLE 00001684 DC X'000102037F097F7F7F7F7F0B0C0D0E0F' *....".""""".....* 00001685 DC X'101112137F0A087F18197F7F1C1D1E1F' *....".."..""....* 00001686 DC X'7F7F1C7F7F0A171B7F7F7F7F7F050607' *"".""..."""""...* 00001687 DC X'7F7F167F7F1E7F047F7F7F1314157F1A' *"".""."."""...".* 00001688 DC X'207F7F7F7F7F7F7F7F7F5B2E3C282B5E' *."""""""""$....;* 00001689 DC X'267F7F7F7F7F7F7F7F7F21242A293B7E' *.""""""""".....=* 00001690 DC X'2D2F7F7F7F7F7F7F7F7F7C2C255F3E3F' *..""""""""@..^..* 00001691 DC X'7F7F7F7F7F7F7F7F607F3A2340273D22' *""""""""-".. ...* 00001692 DC X'7F6162636465666768697F7B7F7F7F7F' *"/........"#""""* 00001693 DC X'7F6A6B6C6D6E6F7071727F7D7F7F7F7F' *".,%_>?..."'""""* 00001694 DC X'7F7F737475767778797A7F7F7F5B7F7F' *"".......:"""$""* 00001695 DC X'7F7F7F7F7F7F7F7F7F7F7F7F7F5D7F7F' *""""""""""""")""* 00001696 DC X'7F4142434445464748497F7F7F7F7F7F' *".........""""""* 00001697 DC X'7F4A4B4C4D4E4F5051527F7F7F7F7F7F' *"..<(+|&..""""""* 00001698 DC X'5C7F535455565758595A7F7F7F7F7F7F' **".......!""""""* 00001699 DC X'303132333435363738397F7F7F7F7F7F' *..........""""""* 00001700 SPACE 00001701 FRASCBRN DS 0D BROWN'S CP ASCII TO EBCDIC TRANSLATE TABLE 00001702 DC X'00010203372D2E2F1605250B0C0D0E0F' 00001703 DC X'FF11123B3C3D322618193F271C1D1E1F' 00001704 DC X'405A7F7B5B6C507D4D5D5C4E6B604B61' 00001705 DC X'F0F1F2F3F4F5F6F7F8F97A5E4C7E6E6F' 00001706 DC X'7CC1C2C3C4C5C6C7C8C9D1D2D3D4D5D6' 00001707 DC X'D7D8D9E2E3E4E5E6E7E8E9ADE0BD4F6D' 00001708 DC X'78818283848586878889919293949596' 00001709 DC X'979899A2A3A4A5A6A7A8A98B6A9B5F07' 00001710 DC X'00010203372D2E2F1605250B0C0D0E0F' 00001711 DC X'FF11123B3C3D322618193F271C1D1E1F' 00001712 DC X'405A7F7B5B6C507D4D5D5C4E6B604B61' 00001713 DC X'F0F1F2F3F4F5F6F7F8F97A5E4C7E6E6F' 00001714 DC X'7CC1C2C3C4C5C6C7C8C9D1D2D3D4D5D6' 00001715 DC X'D7D8D9E2E3E4E5E6E7E8E9ADE0BD4F6D' 00001716 DC X'78818283848586878889919293949596' 00001717 DC X'979899A2A3A4A5A6A7A8A98B6A9B5F07' 00001718 TOASCSTD DS 0D STANDARD CP EBCDIC TO ASCII TABLE 00001719 DC X'000102037F097F7F7F7F7F0B0C0D0E0F' *....".""""".....* 00001720 DC X'101112137F0A080018197F7F1C1D1E1F' *....".....""....* 00001721 DC X'7F7F7F7F7F0A171B7F7F7F7F7F050607' *"""""..."""""...* 00001722 DC X'7F7F167F7F7F7F047F7F7F7F14157F1A' *""."""".""""..".* 00001723 DC X'207F7F7F7F7F7F7F7F7F7F2E3C282B7C' *.""""""""""....@* 00001724 DC X'267F7F7F7F7F7F7F7F7F21242A293B5E' *.""""""""".....;* 00001725 DC X'2D2F7F7F7F7F7F7F7F7F7C2C255F3E3F' *..""""""""@..^..* 00001726 DC X'7F7F7F7F7F7F7F7F7F603A2340273D22' *"""""""""-.....* 00001727 DC X'7F6162636465666768697F7F7F7F7F7F' *"/........""""""* 00001728 DC X'7F6A6B6C6D6E6F7071727F7F7F7F7F7F' *".,%_>?...""""""* 00001729 DC X'7F7E737475767778797A7F7F7F5B7F7F' *"=.......:"""$""* 00001730 DC X'7F7F7F7F7F7F7F7F7F7F7F7F7F5D7F7F' *""""""""""""")""* 00001731 DC X'7B4142434445464748497F7F7F7F7F7F' *#.........""""""* 00001732 DC X'7D4A4B4C4D4E4F5051527F7F7F7F7F7F' *'º.<(+|&..""""""* 00001733 DC X'5C7F535455565758595A7F7F7F7F7F7F' **".......!""""""* 00001734 DC X'303132333435363738397F7F7F7F7F7F' *..........""""""* 00001735 EJECT 00001736 FRASCSTD DS 0D STANDARD CP ASCII TO EBCDIC TABLE 00001737 DC X'00010203372D2E2F1605250B0C0D0E0F' 00001738 DC X'101112133C3D322618193F271C1D1E1F' 00001739 DC X'405A7F7B5B6C507D4D5D5C4E6B604B61' 00001740 DC X'F0F1F2F3F4F5F6F7F8F97A5E4C7E6E6F' 00001741 DC X'7CC1C2C3C4C5C6C7C8C9D1D2D3D4D5D6' 00001742 DC X'D7D8D9E2E3E4E5E6E7E8E9ADE0BD5F6D' 00001743 DC X'79818283848586878889919293949596' 00001744 DC X'979899A2A3A4A5A6A7A8A9C04FD0A107' 00001745 DC X'00010203372D2E2F1605250B0C0D0E0F' 00001746 DC X'101112133C3D322618193F271C1D1E1F' 00001747 DC X'405A7F7B5B6C507D4D5D5C4E6B604B61' 00001748 DC X'F0F1F2F3F4F5F6F7F8F97A5E4C7E6E6F' 00001749 DC X'7CC1C2C3C4C5C6C7C8C9D1D2D3D4D5D6' 00001750 DC X'D7D8D9E2E3E4E5E6E7E8E9ADE0BD5F6D' 00001751 DC X'79818283848586878889919293949596' 00001752 DC X'979899A2A3A4A5A6A7A8A9C04FD0A107' 00001753 SPACE 00001754 TOLOWER DC 256AL1(*-TOLOWER) UPPER -> LOWERCASE XTAB 00001755 ORG TOLOWER+C'^' "^" -> BLANK 00001756 DC C' ' 00001757 ORG TOLOWER+C'A' 00001758 DC C'abcdefghi' 00001759 ORG TOLOWER+C'J' 00001760 DC C'jklmnopqr' 00001761 ORG TOLOWER+C'S' 00001762 DC C'stuvwxyz' 00001763 ORG 00001764 SPACE 00001765 HBITTAB DC 128AL1(*-HBITTAB+128) TABLE TO TURN ON HIGH-ORDER 00001766 DC 128AL1(*-HBITTAB) BIT FOR 7171 00001767 SPACE 2 00001768 ADT 00001769 DCH 00001770 FSCBD 00001771 FSTB 00001772 FVS 00001773 NUCON 00001774 END 00001775