kermit.columbia.edu

home *** CD-ROM | disk | FTP | other *** search

/ kermit.columbia.edu / kermit.columbia.edu.tar / kermit.columbia.edu / archives / deleteme.zip / ik0cmd.asm < prev next >

Wrap

Assembly Source File | 1993-10-21 | 223KB | 2,726 lines

*COPY IK0CMD 03000000 CHECKVER IK0CMD,4.3 @SC90072 03000500 TITLE 'USNTRF Routine - execute main loop' 03001000 * Execute Kermit commands (beginning with default TAKE files) 03001500 * Entry: environment already set up 03002000 * Exit: R15=0 03002500 * ERRNUM set appropriately 03003000 USNTRF ENTER 03003500 LA 0,KRMPROT @SC86295 03004000 LA 1,USNCMD Full list of commands @SC87117 03004500 BAL 14,LOOPS Set up loop return @SC86295 03005000 LA 2,USRTAKE 03005500 LA 1,LUSRT Length of name @SC86295 03006000 BAL 9,LUPTIN Test user KERMINI @SC86295 03006500 NOP 0 Not found, skip it @SC86295 03007000 LA 2,SYSTAKE @SC86135 03007500 LA 1,LSYST Length of name @SC86295 03008000 BAL 9,LUPTIN Test system KERMINI @SC86295 03008500 NOP 0 Not found, skip it @SC86295 03009000 MVI ERRNUM,ERRNFT No transfers yet @SC86295 03009500 KCALL SUPFNC,6,E=LOOP @SC86295 03010000 OI KFLG,CMDL+SIGN Got command line, suppress banner@SC86295 03010500 B LOOP @SC86295 03011000 * 03011500 KRMININC WTEXT 'Kermit-&KSYS Version &KVRSN..&KEDIT &KTAG (&KDATE.)' 03012000 WTEXT '&ENTHINT' @SC91295 03012500 OI KFLG,SIGN Banner done @SC86295 03013000 KRMPROB PTEXT BLANK,1 And leave a blank line 03013500 B LUPWRT Not an error @SC86295 03014000 * 03014500 KRMPROT TM KFLG,CMDL @SC86295 03015000 BZ KRMPROCL Go if Not cmd line 03015500 NI KFLG,255-CMDL Turn off command line @SC86295 03016000 OI KFLG,CMDC Command from cmd line @SC86295 03016500 L 1,CBUF address of cmd 03017000 L 0,CLEN Length @SC86171 03017500 B LUPPRS Go process it @SC86295 03018000 * 03018500 KRMPROCL TM KFLG,CMDC @SC86295 03019000 BZ KRMPROR Go if not cmd line 03019500 KCALL SUPFNC,7,E=(KRMXITQ,Z) Go if nothing stacked @SC86295 03020000 KRMPROR TM KFLG,SIGN Already printed banner? @SC86295 03020500 BO KRMPROX Yes, or suppressed @SC86295 03021000 KCALL SUPFNC,7,E=(KRMININC,Z) Go if nothing stacked @SC86295 03021500 KRMPROX LA 3,CMD @SC86295 03022000 LA 4,KPRPT Current prompt @SC87268 03022500 SR 0,0 @SC87268 03023000 IC 0,KPRPL Prompt length @SC87268 03023500 RTEXT (3),PROMPT=((4),(0)) @SC87268 03024000 LA 1,CMD Ptr to command @SC86171 03024500 B LUPPRS Go process it @SC86295 03025000 * 03025500 USNCMD KW '&AAAEXIT',KRMXIT,MIN=2 @SC92300 03026000 KW '&AAAQUIT',KRMXIT @SC92300 03026500 AIF ('&KSYS' NE 'TSO').TS0Z @SC88035 03027000 KW '&AAAAEND',KRMXIT,MIN=2 Synonym for QUIT @SC88035 03027500 .TS0Z ANOP 03028000 USNCMDX KW '&AAAABYE',KRMBYE,MIN=3 @SC86155 03028500 KW '&AAAADIR',KRMDIR,MIN=3 @SC86295 03029000 KW '&AAAECHO',KRMECO,MIN=2 @SC92300 03029500 KW '&AAAAFIN',KRMFIN,MIN=3 @SC86155 03030000 KW '&AAAAGET',KRMGET @SC86155 03030500 KW '&AAAHELP',KRMHLP @SC92300 03031000 KW '&AALOCAL',LUPTOK,MIN=3 @SC86295 03031500 KW '&RECEIVE',KRMREC,MIN=3 @SC92300 03032000 KW '&REMOTE',KRMREM,MIN=3 @SC86155 03032500 KW '&AAASEND',KRMSND,MIN=3 @SC92300 03033000 KW '&AAASERV',KRMSRV,MIN=3 @SC92300 03033500 KW '&AAXECHO',KRMXPE,MIN=2 @SC86204 03034000 KW '&AAXTYPE',KRMNPS,MIN=2 @SC86204 03034500 SRVKCMD KW '&KSYS.',LUPHST,MIN=2 Valid in Server mode ... @SC86295 03035000 AIF ('&KSYS' NE 'CMS').CM0Z @SC86355 03035500 KW 'CP',LUPCP,MIN=2 @SC86295 03036000 .CM0Z KW 'CWD',LUPCWD,MIN=2 @SC86295 03036500 KW '&AAAGIVE',LUPGIV,MIN=2 @SC87117 03037000 KW '&AAAHINT',LUPHNTS @SC91295 03037500 KW '&AAAHOST',LUPHST,MIN=2 @SC87253 03038000 KW 'KERMIT',LUPKRM @SC90059 03038500 KW '&SIMULAT',LUPSIM,MIN=2 @SC91312 03039000 USNCSET KW '&AAAASET',LUPSET,MIN=3 @SC91320 03039500 KW '&AAASHOW',LUPSHO,MIN=2 @SC86295 03040000 KW '&AASPACE',LUPSPA,MIN=2 @SC86295 03040500 KW '&ASTATUS',LUPSTA,MIN=2 @SC86295 03041000 KW '&AAATAKE',LUPTAK,MIN=2 @SC86295 03041500 KW '&AATDUMP',LUPDMP,MIN=2 @SC86295 03042000 KW '&AAATYPE',LUPHSTI,MIN=TYPMIN @SC88018 03042500 KW '&VERSION',LUPVERS,MIN=2 @SC90339 03043000 KW 03043500 * 03044000 KRMECO L 3,ADR Pick rest of line 03044500 ICM 4,B'1111',LEN Remaining data length 03045000 BNP KRMPROB Go if nothing left in cmd 03045500 B LUPWRT Else, print the rest @SC86295 03046000 * @SC86155 03046500 KRMREM KCALL GENCMD,0,E=LUPERK Send remote command @SC86295 03047000 B KRMXFZ @SC87300 03047500 * @SC86155 03048000 KRMBYE BAL 14,LUPCNF Check for illegal extras @SC86295 03048500 KCALL GENCMD,AL Send Logout command @SC86155 03049000 B KRMXFZ @SC87300 03049500 * 03050000 KRMFIN BAL 14,LUPCNF Check for illegal extras @SC86295 03050500 KCALL GENCMD,AF Send Finish command @SC86155 03051000 B KRMXFZ @SC87300 03051500 * 03052000 KRMGET PTEXT '&FORFSPC - ',AREG=1,LREG=0 @SC88035 03052500 BAL 2,USNASKA Prompt if user omitted args @SC88035 03053000 LA 0,FFGET @SC88049 03053500 KCALL FSPEC,JFSPEC Get foreign filespec @SC86295 03054000 BAL 14,LUPCKFN @SC86295 03054500 PTEXT '&SYSFSPC - ',AREG=1,LREG=0 @SC88035 03055000 BAL 2,USNASKT Prompt if necessary @SC88035 03055500 LA 0,FFGET+FFRCF @SC88049 03056000 KCALL FSPEC,FILNAM Get native filespec, if any @SC86295 03056500 BAL 14,LUPCKFN @SC86295 03057000 BAL 14,LUPCNF Check for illegal extras @SC86295 03057500 TM FL3,APPN Going to append anyway? @SC90033 03058000 BO USNGCK Yes, ignore collisions @SC90033 03058500 TM FL1,REN+ROVR Warning ON and name given? @SC88089 03059000 BNO USNGCK No, don't check for collision yet @SC88089 03059500 LA 0,FFNEW+FFGET @SC87012 03060000 KCALL FSPEC,FILNAM,E=LUPWRTE Avoid collisions @SC87012 03060500 USNGCK DS 0H @SC88089 03061000 BAL 8,IPKSET Set state table, exchange parms @SC86295 03061500 * Init packet Rpack interpret input tables @SC86155 03062000 DC AL1(AY),AL3(0) ACK'ed @SC86155 03062500 DC XL1'FF',AL3(KRMGETAB) Stop @SC88074 03063000 DC AL1(00),AL3(KRMGETAB) Error @SC86155 03063500 BAL 9,PAKFIL Copy file specification to buffer @HF86223 03064000 BAL 9,ENCODEN Encode file-spec @SC86295 03064500 MVI STYPE,AR Packet type = receive initiate @SC86155 03065000 KCALL SPACK,E=KRMGETAB Send name @SC86155 03065500 KCALL RECEIV @SC86155 03066000 B KRMXFZ @SC86239 03066500 * 03067000 KRMGETAB KCALL INTINI,0 @SC86155 03067500 B KRMXFZ @SC87300 03068000 * 03068500 KRMREC LA 0,FFRCF @SC86295 03069000 KCALL FSPEC,FILNAM Get filespec @SC86295 03069500 BAL 14,LUPCKFN @SC86295 03070000 BAL 14,LUPCNF Check for illegal extras @SC86295 03070500 TM FL3,APPN Going to append anyway? @SC90033 03071000 BO USNRCK Yes, ignore collisions @SC90033 03071500 TM FL1,REN+ROVR Warning ON and name given? @SC88089 03072000 BNO USNRCK No, don't check for collision yet @SC88089 03072500 LA 0,FFNEW+FFGET @SC87012 03073000 KCALL FSPEC,FILNAM,E=LUPWRTE Avoid collisions @SC87012 03073500 TM FL4,NMCHNG @SC90061 03074000 BZ USNRCK @SC90061 03074500 PTEXT '&COLDISC' @SC90061 03075000 CLI CLSNFL,C'D' @SC90061 03075500 BE LUPWRTE @SC90061 03076000 USNRCK DS 0H @SC88089 03076500 KCALL INTINI,3,E=KRMXFZ Initialize for receive @SC87300 03077000 MVI RTYPE,0 No packet read yet @SC88074 03077500 KCALL RECEIV 03078000 B KRMXFZ @SC86239 03078500 * 03079000 KRMNPS OI FL4,NPS @SC86165 03079500 MVI TCTLQ,0 Turn off control quoting @SC86165 03080000 * 03080500 KRMSND PTEXT '&SYSFSPC - ',AREG=1,LREG=0 @SC88035 03081000 BAL 2,USNASKA Prompt if necessary @SC88035 03081500 SR 6,6 No extra files yet @SC88306 03082000 L 7,MSNDBUF Start of buffer @SC88306 03082500 USNSND1 DS 0H @SC88306 03083000 LA 0,FFSND @SC88035 03083500 KCALL FSPEC,IFILE Get filespec @SC86295 03084000 BAL 14,LUPCKFN @SC86295 03084500 PTEXT '&FORFSPC - ',AREG=1,LREG=0 @SC88035 03085000 BAL 2,USNASKT Prompt if user omitted args @SC88035 03085500 LA 0,FFSND+FFRCF @SC86295 03086000 KCALL FSPEC,JFSPEC Get filespec @SC86295 03086500 BAL 14,LUPCKFN @SC86295 03087000 CLI BRK,C',' Multi-file option? @SC88306 03087500 BNE USNSND2 @SC88306 03088000 A 6,F1 Count files to send @SC88306 03088500 PTEXT '&MANYFIL' @SC88306 03089000 CH 6,=Y(MSNDMAX) Too many? @SC88306 03089500 BH LUPINV Too bad @SC88306 03090000 MVC 0(LFSTF,7),IFILE Save filespecs + options @SC89218 03090500 LA 7,LFSTF(,7) Advance ptr into buffer @SC89218 03091000 PTEXT '&SYSFSPC - ',AREG=1,LREG=0 @SC88306 03091500 BAL 2,USNASKT Prompt if necessary @SC88306 03092000 B USNSND1 Go for another name @SC88306 03092500 USNSND2 ST 7,MSNDPTR Save buffer scan ptr @SC88306 03093000 BAL 14,LUPCNF Check for illegal extras @SC86295 03093500 KRMSNDBG KCALL SEND,0 @SC90239 03094000 KRMXFZ SR 3,3 @SC86355 03094500 ICM 3,1,ERRNUM Ok? @SC86355 03095000 BZ LOOP Yes, get next command @SC86355 03095500 KCALL PEMSG No, convert error number @SC91064 03096000 OI FL5,CMERR Note error @SC91064 03096500 B LOOP @SC91064 03097000 * 03097500 USNASKA NI KFLG,255-PRMP Assume no prompting @SC88035 03098000 FTOKN N=USNASK Check for some text waiting @SC88035 03098500 BR 2 Ok, use it @SC88035 03099000 USNASKT TM KFLG,PRMP Is prompting required? @SC88035 03099500 BZR 2 No, ok @SC88035 03100000 USNASK OI KFLG,PRMP Must prompt for both filespecs @SC88035 03100500 LA 3,CMD Use input buffer @SC88035 03101000 ST 3,ADR @SC88035 03101500 RTEXT (3),PROMPT=((1),(0)) Ask for filespec @SC88035 03102000 ST 0,LEN Save string length @SC88035 03102500 BR 2 @SC88035 03103000 * 03103500 KRMXPE L 5,ADR Pointer to rest of line @HF86150 03104000 ICM 4,15,LEN Remaining data length @HF86150 03104500 BNP KRMXPEH Go if nothing specified @HF86150 03105000 L 3,RBUF @HF86150 03105500 MVC 0(256,3),0(5) Copy to disk read buffer @HF86150 03106000 AR 4,3 Get end @HF86150 03106500 STM 3,4,TXTPTR Point to text to copy @HF86150 03107000 OI FL4,SFM+NPS Data source: text string @SC86165 03107500 XC FLNOPTS(LFOPTS),FLNOPTS @SC91116 03108000 MVI TCTLQ,AUP Turn on control quoting @SC86165 03108500 MVC MSNDPTR,MSNDBUF No extra files @SC88306 03109000 B KRMSNDBG @SC86165 03109500 * 03110000 KRMXPEH PTEXT '&XTYPMSG' @SC86165 03110500 B LUPWRT @SC86295 03111000 * 03111500 KRMSRV BAL 14,LUPCNF Check for illegal extras @SC86295 03112000 KCALL SERVER Call SERVER routine @SC86295 03112500 B KRMXFZ Return to normal mode @SC86355 03113000 * 03113500 KRMDIR LA 0,FFUTL+FFWLD @SC86295 03114000 KCALL FSPEC,FILNAM Get pattern filespec @SC86295 03114500 BAL 14,LUPCKFN Make sure ok @SC86295 03115000 PTEXT '&NOTFOUN' File not found if error here @SC90264 03115500 LA 0,13 @SC86295 03116000 KCALL DISKIO,FILNAM,E=LUPFNF Do a DIR on it @SC90264 03116500 MVI ERRNUM,ERRNOE No problem @SC90264 03117000 B LOOP @SC86295 03117500 * 03118000 KRMHLP KCALL KHELP Issue help request @SC86355 03118500 B LOOP @SC86355 03119000 * 03119500 KRMXIT FTOKN N=KRMXITQ,H=LUPCRH Check for illegal extras @SC86295 03120000 B LUPBAD Not just QUIT, maybe system Q @SC86295 03120500 * 03121000 KRMXITQ NXTFSET ,END Flush pending file list @SC86355 03121500 L 2,TAKLEVK @SC86295 03122000 KRMXITL BCTR 2,0 @SC86295 03122500 LTR 3,2 Any pending TAKE files? @SC86295 03123000 BM RTRN0 No @SC86295 03123500 SLA 3,2 @SC86295 03124000 CLOSF TAKTABK(3) Close the open file @SC86295 03124500 B KRMXITL Keep checking @SC86295 03125000 LOCALS , @SC86295 03125500 * See SERVER for mapping @SC86295 03126000 DS A Return adr if no more TAKE stuff @SC86295 03126500 DS A Adr of command table @SC86295 03127000 TAKLEVK DS F Take file level @SC86295 03127500 TAKTABK DS (TAKMAX)F Tickets for I/O @SC86295 03128000 KFLG DS X Local flags in main program @SC86295 03128500 PRMP EQU X'10' Prompting for filespecs @SC88035 03129000 SIGN EQU X'04' Already printed Kermit banner @SC86295 03129500 CMDC EQU X'02' Command gotten from cmd 03130000 CMDL EQU X'01' Data on cmd line 03130500 USNTRF EXIT 03131000 TITLE 'SIMLAT Routine - set up to replay a file' @SC91312 03131500 * Begin to read a file for supplying incoming packets in lieu @SC91312 03132000 * of reading them from the communication line @SC91312 03132500 * Entry: ADR,LEN point to file name @SC91312 03133000 * Exit: R15=0 if ok, 1 if bad (message already printed) @SC91312 03133500 * ERRNUM set appropriately @SC91312 03134000 SIMLAT ENTER , @SC91312 03134500 BAL 9,SIMCLS Close old input file, if any @SC91312 03135000 SR 0,0 @SC91312 03135500 KCALL FSPEC,FILNAM,E=SIMERR Get filespec @SC91312 03136000 MVI ERRNUM,ERRNOE Reset error @SC91312 03136500 FTOKN N=SIMOK,H=SIMCRH @SC91312 03137000 PTEXT '&EXTRAOP' @SC91312 03137500 B SIMERR @SC91312 03138000 SIMOK OPENF I,FILNAM,FILFDB,SIMPTR,E=SIMFNF @SC91312 03138500 B RTRN0 @SC91312 03139000 SIMFNF BAL 9,SIMCLS Close input file @SC91312 03139500 MVI ERRNUM,ERRFNF File not found @SC91312 03140000 SIMERF PTEXT '&SIMSHRT' @SC91312 03140500 B SIMERR @SC91312 03141000 * 03141500 SIMCLS CLOSF SIMPTR Close it @SC91312 03142000 BR 9 @SC91312 03142500 * 03143000 SIMCRH PTEXT '&NOOPERS' @SC91312 03143500 SIMERR WTEXT (3),(4) Return error message @SC91312 03144000 B RTRN1 @SC91312 03144500 * 03145000 LOCALS , @SC91312 03145500 EXIT @SC91312 03146000 TITLE 'SET Routine - perform SET command options' 03146500 * Set/change values in STORAG. 03147000 * Entry: SCANPTR string has option 03147500 * Exit: R15=0 if ok, 1 if help needed, 2 if bad parameter name 03148000 * ERRNUM unchanged 03148500 SET ENTER 03149000 MVI SETXI,X'97' XI instruction @SC86273 03149500 NTOKN N=RTRN2 @SC86171 03150000 NI FL3,255-PXCH Make sure server renegotiates @SC86295 03150500 L 3,=A(SETCMDS) @SC90040 03151000 USING SETCMDS,3 Address CSECT throughout @SC90040 03151500 SCAN SETCMDKW,RTRN1 @SC86295 03152000 B RTRN2 @SC86295 03152500 * 03153000 SETCMDS CSECT @SC90040 03153500 SETTTKW KW 'KP',SETTTKP Special TTABLE option @SC90278 03154000 KW '&AAAAOFF',SETTTF,MIN=2 @SC92352 03154500 KW '&AAAAAON',SETTTN,MIN=2 @SC92352 03155000 KW , @SC92352 03155500 * 03156000 SETOOKW KW '&AAAAOFF',SETOFF,MIN=2 @SC87166 03156500 KW '&AAAAAON',SETON,MIN=2 @SC87166 03157000 KW , @SC87166 03157500 * 03158000 SETOOFRC KW '&AAAAOFF',SETOFFL,MIN=2 @SC91275 03158500 SETOFRC KW '&AAAAAON',SETONL,MIN=2 @SC91275 03159000 KW '&AFORCED',SETFRC @SC91275 03159500 KW , @SC91275 03160000 * 03160500 SETCMDOO KW '&AAAAOFF',SETOFFS,MIN=2 @SC87166 03161000 SETONKW KW '&AAAAAON',SETONS,MIN=2 @SC87166 03161500 KW , @SC86171 03162000 SET CSECT @SC90040 03162500 * 03163000 SETFRC MVI LCKFRC,X'21' Enable FORCE mode @SC91275 03163500 B SETON @SC91275 03164000 * 03164500 SETTTF LA 1,ATOE Use normal tables @SC92352 03165000 LA 2,ETOA @SC92352 03165500 STM 1,2,AEPTRS @SC92352 03166000 B SETOFF @SC92352 03166500 SETOFFL MVI LCKFRC,0 Disable FORCE mode @SC91275 03167000 SETOFF EX 0,0(9) Yes, first turn flag on... @SC87166 03167500 EX 0,SETXI Then off @SC86273 03168000 B RTRN0 @SC87166 03168500 * 03169000 SETONL MVI LCKFRC,0 Disable FORCE mode @SC91275 03169500 SETON EX 0,0(9) Turn flag on @SC87166 03170000 B RTRN0 @SC87166 03170500 * 03171000 SETOFFS B 4(9) @SC87166 03171500 * 03172000 SETONS BR 9 Go to ON handler @SC87166 03172500 * 03173000 SETCMDS CSECT @SC90040 03173500 SETTRKW KW '&AAAATTY',SETT,T @SC91320 03174000 KW '&SERIES1',SETT,S @SC91320 03174500 KW '&GRAPHIC',SETT,G @SC91320 03175000 KW '&AAAAAEA',SETT,A @SC91320 03175500 KW '&VTAMTTY',SETT,V @SC91320 03176000 KW '&FULLSCR',SETT,F @SC92030 03176500 KW '&AAANONE',SETT,N @SC91320 03177000 KW , @SC87166 03177500 * 03178000 SETBLKKW KW '1-BYTE',SETT,1 @SC92085 03178500 KW '2-BYTE',SETT,2 @SC92085 03179000 KW '3-BYTE',SETT,3 @SC92085 03179500 KW '&BLNKFRE',SETT,B @SC92085 03180000 KW , @SC92085 03180500 SET CSECT @SC90040 03181000 * 03181500 SETT MVC 0(1,8),KWCODE(1) Save value in specified field @SC91320 03182000 B RTRN0 @SC87166 03182500 * 03183000 SETCMDS CSECT @SC90040 03183500 PFXUNPFX KW '&PREFIXD',SETCTL1,0 @SC93173 03184000 KW '&UNPREFD',SETCTL1,1 @SC93173 03184500 KW , @SC93173 03185000 * 03185500 SETSWT KW '&CONTINU',SETOFF @SC86171 03186000 KW '&AAAHALT',SETON @SC86171 03186500 KW , @SC86171 03187000 * 03187500 SETDSC KW '&DISCARD',SETOFF @SC86225 03188000 KW '&AAAKEEP',SETON @SC86225 03188500 KW , @SC86225 03189000 * 03189500 SETCLSKW KW '&AAPPEND',SETCLSA,A @SC91320 03190000 KW '&ABACKUP',SETCLSR,B @SC91320 03190500 KW '&DISCARD',SETCLSR,D @SC91320 03191000 KW '&OVERWRI',SETCLSN,O @SC91320 03191500 KW '&ARENAME',SETCLSR,R @SC91320 03192000 KW , @SC90033 03192500 * 03193000 SETOVWKW KW '&DEFAULT',SETOFF @SC90033 03193500 KW '&PRESERV',SETON @SC90033 03194000 KW , @SC90033 03194500 * 03195000 SETPAR KW '&AAAMARK',SETOFF @SC86316 03195500 KW '&AAANONE',SETON @SC86316 03196000 KW , @SC86316 03196500 SET CSECT @SC90040 03197000 * 03197500 SETTABS LA 4,SETCMDOO @SC87166 03198000 BAL 14,SETSCN @SC87166 03198500 B SETTBON Turn on @SC86355 03199000 NI FL2,255-TABS Turn off @SC86355 03199500 MVC TABCNT,F0 Clear count @SC86355 03200000 B RTRN0 @SC86295 03200500 SETTBON OI FL2,TABS Turn on @SC86355 03201000 MVC TABCNT,F0 Clear count @SC86355 03201500 SR 0,0 Init previous tab @SC86355 03202000 LA 3,TABTBL Point to start of tab table @TS86100 03202500 LA 8,255 Limit on tab stops @SC86355 03203000 LA 5,TABCNT End of table @SC86355 03203500 SETTBLP ICM 2,15,LEN Any more tokens? @SC86355 03204000 BNP SETTBN No, done @SC86355 03204500 STC 0,0(3) Save previous tab @SC86355 03205000 BAL 2,SETNUM Read number @SC86355 03205500 CLM 0,1,0(3) Is this tab higher than previous? @SC86355 03206000 BNH SETTBSEQ No, tab out of sequence @TS86100 03206500 CR 3,5 Exceeded capacity? @SC86355 03207000 BNL SETTBHI Yes @TS86100 03207500 STC 0,0(3) Save tab setting @TS86100 03208000 LA 3,1(3) Bump counter @SC86355 03208500 B SETTBLP @SC86355 03209000 SETTBN LA 0,TABTBL Point to start of tab table @SC86355 03209500 SR 3,0 Get length of table @SC86355 03210000 STH 3,TABCNT Save the tab count @TS86100 03210500 B RTRN0 @SC86355 03211000 SETTBHI PTEXT '&MANYTAB' @SC86355 03211500 B SETTBER Return error @SC86355 03212000 SETTBSEQ PTEXT '&BADTABS' @TS86100 03212500 SETTBER NI FL2,255-TABS Turn off @SC86355 03213000 B SUBERR Return error @TS86100 03213500 * 03214000 SETLIN BAL 2,SETFSTR Get fixed-format string @SC86166 03214500 PTEXT '&BADCOMM' @SC87351 03215000 KCALL SETMSG,5,E=SUBERR Make sure it's ok @SC87351 03215500 B RTRN0 @SC86166 03216000 * 03216500 SETPRP LA 0,KPRPT Ptr to new prompt string @SC87351 03217000 KCALL SUPFNC,11 Ok it with system @SC87351 03217500 B RTRN0 @SC87351 03218000 * 03218500 SETCLSA OI FL3,APPN Set APPEND ON @SC90033 03219000 NI FL1,255-REN ... and "WARN" OFF @SC90033 03219500 B SETCLSZ @SC90033 03220000 SETCLSR OI FL1,REN Set "WARN" ON @SC90033 03220500 B SETCLSY ... and APPEND OFF @SC90033 03221000 SETCLSN NI FL1,255-REN @SC90033 03221500 SETCLSY NI FL3,255-APPN @SC90033 03222000 SETCLSZ B SETT Save collision code @SC91320 03222500 * 03223000 KSETPRC , System-specific options @SC86355 03223500 * 03224000 SETCMDS CSECT @SC90040 03224500 * An alternate name must follow immediately the primary. @SC92113 03225000 * All primary names must be the same length (with blanks). @SC92113 03225500 * (but names not associated in pairs can be any length). @SC92233 03226000 SETALFKW KW 'LATIN1 ',SETALF1,MIN=6 @SC91325 03226500 SETALFL1 KW 'L1',SETALFX,MIN=2 Alternate name @SC90152 03227000 KW 'ARABIC',SETALF1,MIN=2 @SC93027 03227500 KW 'ASCII ',SETALF1,MIN=2 @SC90152 03228000 KW '&CYRILLC',SETALF1,MIN=2 @SC90152 03228500 KW '&AAGREEK',SETALF1,MIN=2 @SC90152 03229000 KW '&HEBREW',SETALF1,MIN=2 @SC90152 03229500 KW '&JAPNEUC',SETALF1,MIN=3 @SC91325 03230000 KW 'KATAKANA',SETALF1,MIN=2 @SC90152 03230500 KW 'LATIN2 ',SETALF1,MIN=6 @SC90152 03231000 KW 'L2',SETALFX,MIN=2 Alternate name @SC90152 03231500 KW 'LATIN3 ',SETALF1,MIN=6 @SC90152 03232000 KW 'L3',SETALFX,MIN=2 Alternate name @SC90152 03232500 KW 'THAI',SETALF1,MIN=2 @SC92233 03233000 KW '&TRANSPA',SETALF1,MIN=2 @SC90250 03233500 KW , @SC90040 03234000 SETFALFK KW 'EBCDIC ',SETALF1,MIN=6 @SC90040 03234500 KW 'CP1047',SETALFX,MIN=6 Alternate name @SC92113 03235000 KW 'CP037 ',SETALF1,MIN=5 @SC90040 03235500 KW 'CP273 ',SETALF1,MIN=5 @SC90040 03236000 KW 'CP275 ',SETALF1,MIN=5 @SC90040 03236500 KW 'CP277 ',SETALF1,MIN=5 @SC90040 03237000 KW 'CP278 ',SETALF1,MIN=5 @SC90040 03237500 KW 'CP280 ',SETALF1,MIN=5 @SC90040 03238000 KW 'CP281',SETALF1,MIN=5 @SC91325 03238500 KW 'CP282 ',SETALF1,MIN=5 @SC90040 03239000 KW 'CP284 ',SETALF1,MIN=5 @SC90040 03239500 KW 'CP285 ',SETALF1,MIN=5 @SC90040 03240000 KW 'CP297 ',SETALF1,MIN=5 @SC90040 03240500 KW 'CP290 ',SETALF1,MIN=5 @SC90040 03241000 KW 'CP420',SETALF1,MIN=5 @SC93027 03241500 KW 'CP424 ',SETALF1,MIN=5 @SC90040 03242000 KW 'CP500 ',SETALF1,MIN=5 @SC90040 03242500 KW 'CP838',SETALF1,MIN=5 @SC92233 03243000 KW 'CP870 ',SETALF1,MIN=5 @SC90152 03243500 KW 'CP871 ',SETALF1,MIN=5 @SC90040 03244000 KW 'CP875 ',SETALF1,MIN=5 @SC90040 03244500 KW 'CP880 ',SETALF1,MIN=5 @SC90152 03245000 KW 'CP905 ',SETALF1,MIN=5 @SC90152 03245500 KW '&CZECH',SETALF1,MIN=2 @SC90152 03246000 KW 'DKOI ',SETALF1,MIN=4 @SC90040 03246500 KW 'H-EBCDIK-DASH',SETALF1,MIN=3 @SC91325 03247000 KW 'KANJI',SETKANJ,MIN=3 @SC91325 03247500 KANJIF KW 'FUJITSU-KANJI',SETALF1,MIN=3 @SC91325 03248000 KANJIH KW 'HITACHI-KANJI',SETALF1,MIN=3 @SC91325 03248500 KANJII KW 'IBM-KANJI',SETALF1,MIN=3 @SC91325 03249000 KW , @SC90040 03249500 * 03250000 SETFKW KW '&AALRECL',SHOLR **COMPAT** @SC87166 03250500 KW '&LONGLIN',SHOLNG,MIN=2 **COMPAT** @SC88120 03251000 KW '&COLLISN',SHOCLSN,MIN=2 **COMPAT** @SC90033 03251500 KW '&OVERWRI',SHOOVWR **COMPAT** @SC90033 03252000 AIF ('&ATTTYPE'(1,1) NE '&AAATEXT'(1,1)).CMPAT01 @SC92300 03252500 KW 'T',SETFT,T **COMPAT** @SC91320 03253000 .CMPAT01 ANOP @SC92300 03253500 KW '&ATTTYPE',SHOFILT **COMPAT** @SC87166 03254000 KFILKW , **COMPAT** @SC87166 03254500 KW '&CHARSET',SHOFALF,MIN=2 @SC90040 03255000 SETFIL KW '&AAATEXT',SETFILET,T @SC91320 03255500 KW '&AAAABIN',SETFILEB,B @SC91320 03256000 SETDBIN KW '&AAADBIN',SETFILEB,D @SC91320 03256500 KW '&AAAVBIN',SETFILEB,V @SC91320 03257000 KW 03257500 SET CSECT @SC90040 03258000 * 03258500 SETKANJ L 1,=A(KANJI&KNJLAB) Use default @SC91325 03259000 B SETALF1 @SC91325 03259500 SETALFX SH 1,=Y(SETALFL1-SETALFKW) Convert to proper entry @SC90152 03260000 SETALF1 MVC 0(LALF,8),=CL(LALF)' ' Fill with blanks @SC91325 03260500 IC 14,KWLEN(,1) Get length-1 of keyword @SC91325 03261000 CLM 14,1,SETALF1+1 See if too long for field @SC91325 03261500 BNH *+8 Ok @SC91325 03262000 IC 14,SETALF1+1 Too long, use field length @SC91325 03262500 EX 14,SETALFMV Copy keyword to field @SC91325 03263000 LR 0,8 Pass ptr to the changed code @SC90040 03263500 KCALL TBLSET,ATOE Set up translations @SC90040 03264000 B RTRN @SC90040 03264500 SETALFMV MVC 0(,8),KWNAME(1) @SC91325 03265000 * 03265500 SETFILEB OI FL1,BINF Set binary on 03266000 B SETT @SC91320 03266500 * 03267000 SETFILET NI FL1,255-BINF Set it OFF 03267500 B SETT @SC91320 03268000 * 03268500 SETCMDS CSECT @SC90040 03269000 SETLNGKW KW '&AAAFOLD',SETT,F @SC91320 03269500 KW '&AAAHALT',SETT,H @SC91320 03270000 KW '&TRUNCAT',SETT,T @SC91320 03270500 KW , @SC88120 03271000 SET CSECT @SC90040 03271500 * 03272000 KFILSET , @SC87012 03272500 * 03273000 SETDEB BAL 4,SETSCN Select among possibilities @SC88168 03273500 KW '&AAAAAON',SETDON @SC88168 03274000 KW '&AAAAOFF',SETDEND,MIN=2 @SC88168 03274500 SETRAW KW '&AAAARAW',SETDRAW @SC88168 03275000 KW '&AAAAAIO',SETDIO @SC88168 03275500 KW '&AAALONG',SETDLO @SC90222 03276000 KW '&AAASAVE',SETDSV @SC88168 03276500 KW '&AAATIME',SETDTM @SC91172 03277000 KW , @SC88168 03277500 SETDEBOF NI FL1,255-DEBUG Set it OFF 03278000 CLOSF LOGPTR Done logging @SC86135 03278500 B RTRN0 @SC86295 03279000 * 03279500 SETDRAW OI SHODBG,DBGON+DBGRW RAW -> ON @SC88168 03280000 B SETDB1 @SC88168 03280500 SETDIO OI SHODBG,DBGON+DBGIO I/O -> ON @SC88168 03281000 B SETDB1 @SC88168 03281500 SETDLO OI SHODBG,DBGON+DBGLO+DBGIO LONG-> ON + I/O @SC90332 03282000 B SETDB1 @SC90222 03282500 SETDSV OI SHODBG,DBGON+DBGSV SAVE-> ON @SC88168 03283000 B SETDB1 @SC88168 03283500 SETDTM OI SHODBG,DBGON+DBGTI TIME-> ON @SC91172 03284000 B SETDB1 @SC91172 03284500 SETDON OI SHODBG,DBGON @SC88168 03285000 SETDB1 ICM 2,15,LEN Any more options? @SC88168 03285500 BP SETDEB Yes, interpret them @SC88168 03286000 SETDEND XC SHODBG,DBGFLG Get changed flags in SHODBG @SC88168 03286500 XC DBGFLG,SHODBG Install new flags @SC88168 03287000 TM SHODBG,DBGON ON/OFF changed? @SC88168 03287500 BZ RTRN0 No, done @SC88168 03288000 TM DBGFLG,DBGON Turned ON? @SC88168 03288500 BZ SETDEBOF No, turn it off @SC88168 03289000 NI LOGFLGS,255-APPN @SC86295 03289500 LA 0,L'LOGNAM Name string length @SC86295 03290000 LA 1,LOGNAM and address @SC86295 03290500 STM 0,1,SCANPTR @SC86295 03291000 LA 0,FFRCF @SC86295 03291500 KCALL FSPEC,IFILE Convert to filespec @SC86295 03292000 PTEXT '&DEBGERR' @SC87012 03292500 OPENF O,IFILE,LOGFDB,LOGPTR,E=SUBERR @SC87012 03293000 OI FL1,DEBUG Enable logging @SC87012 03293500 MVI ERRNUM,ERRNOE Insist no errors @SC88168 03294000 B RTRN0 @SC86295 03294500 * 03295000 SET8B NTOKN N=SET8BH,H=SET8BH @SC87008 03295500 LA 4,AAMP Default value @SC87008 03296000 LA 9,SET8BS @SC87008 03296500 SCAN SETONKW,RTRN2 03297000 SR 4,4 Zero value means OFF @SC87008 03297500 LTR 7,7 Length=1? @SC87008 03298000 BNZ SET8BS No, can't be ON @SC87008 03298500 BAL 2,SETQCH2 Make sure it's valid @SC87008 03299000 SET8BS STC 4,EBQC New value @SC87008 03299500 B RTRN0 @SC87008 03300000 SET8BH PTEXT '&ONOFFCH' @SC87008 03300500 B SUBERR @SC87008 03301000 * 03301500 SETSTR LR 2,14 @SC87268 03302000 MVI 0(8),0 Default to blank @SC87166 03302500 BAL 9,WSP Remaining data length @SC86224 03303000 B RTRN0 Null string @SC86295 03303500 LR 1,4 Max length allowed @SC87268 03304000 CR 6,1 @SC86345 03304500 BH SETSTRH Too long @SC86345 03305000 STC 6,0(8) Save length @SC87166 03305500 LA 8,1(8) Skip over length byte @SC87268 03306000 XR 6,7 Exchange ptr and length @SC87268 03306500 XR 7,6 @SC87268 03307000 XR 6,7 @SC87268 03307500 B SETFST1 Go copy string @SC87268 03308000 * 03308500 SETRCTLQ BAL 2,SETQCHR Get a char for Receive-Ctl-quote 03309000 STC 4,RCTLQ(5) Set receive ctl quote @SC86164 03309500 LTR 5,5 Done if SEND @SC86223 03310000 BNZ RTRN0 @SC86295 03310500 STC 4,DEFPARM+5 Set default for SPAR @SC86120 03311000 B RTRN0 @SC86295 03311500 * 03312000 SETQCHR NTOKN H=SETQCHRH,N=SETQCHRH 03312500 LTR 7,7 Token length - 1 03313000 BP SETQCHRH Pos: token is too long 03313500 SETQCH2 SR 4,4 @SC87008 03314000 IC 4,0(6) Get the quote char @SC86120 03314500 IC 4,ETOAD(4) Get ASCII form @SC89301 03315000 NOTQR SETQCHRH Go if not 33-62 or 96-126 @SC86120 03315500 BR 2 03316000 * 03316500 SETQCHRH PTEXT '&ASCQUOT' @SC86224 03317000 B SUBERR @SC86295 03317500 * 03318000 SETLR ST 0,MAXOUT Max output buffer size @SC87166 03318500 B RTRN0 @SC86295 03319000 * 03319500 SETTIMO BCT 5,RTRN0 Done if rec @SC87166 03320000 TOCHR 0,,DEFPARM+1 Set default for SPAR @SC86164 03320500 B RTRN0 @SC86295 03321000 * 03321500 SETPADN BCT 5,RTRN0 Done if rec @SC87166 03322000 TOCHR 0,,DEFPARM+2 Set default for SPAR @SC86164 03322500 B RTRN0 @SC86295 03323000 * 03323500 SETPADC BCT 5,RTRN0 Done if rec @SC87166 03324000 CTL 0,,DEFPARM+3 Set default for SPAR @SC86164 03324500 B RTRN0 @SC86295 03325000 * 03325500 SETEOL BCT 5,RTRN0 Done if rec @SC87166 03326000 STC 0,S1EOL Extra copy for prompting @SC87274 03326500 TOCHR 0,,DEFPARM+4 Set default for SPAR 03327000 B RTRN0 @SC86295 03327500 * 03328000 SETSIZ C 0,AKMIN Less than min Kermit size? @SC87166 03328500 BL SETKSIZH Yes, error @SC86164 03329000 C 0,AKMAX More than max Kermit size? @SC86164 03329500 BNH SETRPS1 No, skip message call @TB86196 03330000 LTR 5,5 SEND? @SC86224 03330500 BNZ SETKSIZH Yes, can't set it long @SC86224 03331000 L 0,AKMAX Use max Kermit size for default @SC90122 03331500 SETRPS1 DS 0H @TB86196 03332000 BCT 5,RTRN0 Done if recv @SC86295 03332500 TOCHR 0,,DEFPARM+0 Set default for SPAR 03333000 B RTRN0 @SC86295 03333500 * 03334000 SETKSIZH PTEXT '&SENDPAK' @SC90122 03334500 B SUBERR @SC86295 03335000 * 03335500 SETCTL LA 4,PFXUNPFX Select among possibilities @SC93173 03336000 B SETSCN @SC93173 03336500 SETCTL1 IC 3,KWCODE(1) Get code (0=>must prefix, 1=>not) @SC93173 03337000 N 3,F1 @SC93173 03337500 ICM 0,15,LEN Any more tokens? @SC93173 03338000 BP SETCTL2 Yes, must be numeric @SC93173 03338500 STC 3,CTLTAB No, just do whole table @SC93173 03339000 MVC CTLTAB+1(159),CTLTAB @SC93173 03339500 B RTRN0 @SC93173 03340000 SETCTL2 LA 8,159 Limit for control list @SC93173 03340500 BAL 2,SETNUM Get a number for table offset @SC93173 03341000 LA 7,CTLTAB @SC93173 03341500 AR 7,0 Ptr to proper table entry @SC93173 03342000 STC 3,0(,7) @SC93173 03342500 B RTRN0 All done @SC93173 03343000 * 03343500 SETETOA LA 3,ETOA Address of table to change @SC86265 03344000 NI ATFL2,255-ATFENC Suppress Encoding attribute now@SC90040 03344500 B SETTET2 @SC87117 03345000 SETTET LA 3,TETOA Address of table to change @SC87117 03345500 SETTET2 LA 2,ETOAD Address of original @SC87117 03346000 SETTR0 ICM 0,15,LEN Any more tokens? @SC87117 03346500 BP SETTR1 Yes, must be numeric @SC87117 03347000 MVC 0(256,3),0(2) No, just reset table @SC87117 03347500 B RTRN0 @SC87117 03348000 SETTR1 LA 8,255 Limit for each @SC87117 03348500 BAL 2,SETNUM Get a number for table offset @SC86295 03349000 AR 3,0 Save table offset here @SC86295 03349500 BAL 2,SETNUM Get a number for value @SC86295 03350000 STC 0,0(3) Change value @SC86295 03350500 B RTRN0 All done @SC86295 03351000 * 03351500 SETATOE LA 3,ATOE Adr of table to edit @SC86265 03352000 NI ATFL2,255-ATFENC Suppress Encoding attribute now@SC90040 03352500 B SETTAT2 @SC87117 03353000 SETTAT LA 3,TATOE Address of table to change @SC87117 03353500 SETTAT2 LA 2,ATOED Address of original @SC87117 03354000 B SETTR0 Use common routine 03354500 * 03355000 SETTTB LA 4,SETTTKW List of choices: ON, OFF, KP @SC90278 03355500 BAL 14,SHOXY ON or OFF just handles flag @SC90278 03356000 SETTTKP OI FL4,TTAB KP comes here and changes table @SC90278 03356500 L 1,=A(ATOEKP) Replacement table (invertible) @SC90278 03357000 MVC TATOE,0(1) @SC90278 03357500 SR 2,2 @SC90278 03358000 LA 1,255 Now invert into other table @SC90278 03358500 IC 2,TATOE(1) @SC90278 03359000 STC 1,TETOA(2) @SC90278 03359500 BCT 1,*-8 @SC90278 03360000 MVI TETOA,0 Null is always null! @SC90278 03360500 SETTTN LA 1,TATOE Use "T" tables @SC92352 03361000 LA 2,TETOA @SC92352 03361500 STM 1,2,AEPTRS @SC92352 03362000 B SETON @SC92352 03362500 * 03363000 * 03363500 * R6 points to token, R7 has length-1. Convert to binary in R0. 03364000 * Return via R2 03364500 SETNUM2 LR 2,14 Save return @SC87166 03365000 SETNUM NTOKN H=SETNUMH,N=SETNUMH @SC86295 03365500 LA 7,1(7) Length @SC86316 03366000 BAL 14,GETNUM @SC86316 03366500 B SETNUMH @SC86316 03367000 CLR 0,8 Within limit? @SC86295 03367500 BH SETNUMH Too big @SC87166 03368000 CLI 0(2),X'47' Entered at SETNUM2? @SC87166 03368500 BNER 2 No, return immediately @SC87166 03369000 LR 14,2 Ptr to caller @SC87166 03369500 S 14,F8 Back up to the LOAD instr @SC87166 03370000 MVC SETXI,0(14) Copy and modify op instr @SC87166 03370500 NC SETXI(2),=X'F60F' @SC87166 03371000 CLI SETXI,X'B6' Was is ICM? @SC87166 03371500 BNE *+8 No, ok @SC87166 03372000 MVI SETXI,X'BE' Yes, make into STCM @SC87166 03372500 EX 0,SETXI Store value @SC87166 03373000 BR 2 Return @SC87166 03373500 * 03374000 SETNUMH LA 15,CMD+&LOPRNUM @SC86295 03374500 SETMAXH MVC CMD(&LOPRMUS),=C'&OPRMUB&OPRMUL' @SC86295 03375000 MVI 0(15),C'<' @SC86295 03375500 LA 15,1(15) @SC86295 03376000 LR 4,8 @SC86345 03376500 A 4,F1 @SC86345 03377000 BAL 2,EDDEC Put limit into message @SC86295 03377500 LR 4,15 End @SC86295 03378000 LA 3,CMD @SC86295 03378500 SR 4,3 @SC86295 03379000 B SUBERR @SC86295 03379500 * 03380000 SETFSTR LR 1,9 Save length @SC87166 03380500 NTOKN N=SETFST0,H=SETSTRH @SC87166 03381000 LA 7,1(7) @SC86295 03381500 CR 7,1 Name too long? @SC86295 03382000 BNH SETFST1 No, do it @SC86295 03382500 SETSTRH LR 8,1 Copy max length @SC86295 03383000 LA 15,CMD+&LOPRMUS Base message size @SC86295 03383500 B SETMAXH @SC86295 03384000 SETFST0 SR 7,7 Empty string @SC86295 03384500 SETFST1 ICM 7,8,BLANK Set for blank fill @SC86295 03385000 LR 9,1 @SC87166 03385500 MVCL 8,6 Copy name @SC87166 03386000 BR 2 @SC86295 03386500 TITLE 'SHOW Routine - performs SHOW command options' 03387000 * Display current values in STORAG. 03387500 * Entry: SCANPTR string has option 03388000 * Exit: R15=0 if ok, 1 if help needed, 2 if bad parameter name 03388500 * ERRNUM unchanged 03389000 SHOW ENTER ALT @SC86133 03389500 LA 0,CMD @SC86227 03390000 ST 0,SHOPTR Initialize output ptr @SC86227 03390500 MVI SETXI,X'91' TM instruction @SC87166 03391000 L 3,=A(SETCMDS) Addressibility @SC90040 03391500 NTOKN N=SHOALL @SC86133 03392000 SCAN SHOCMDAL,RTRN1 @SC88293 03392500 SHOBAD B RTRN2 Invalid operand @SC86295 03393000 * 03393500 SETCMDS CSECT @SC90040 03394000 SETCMDKW DS 0H @SC87166 03394500 KW '&AAAATOE',SETATOE,MIN=4 @SC87166 03395000 KW '&CTRLCHR',SETCTL,MIN=8 @SC93173 03395500 KW '&AAAETOA',SETETOA,MIN=4 @SC87166 03396000 KW '&FILTYPE',SHOFILT,MIN=5 @SC87166 03396500 KW '&AATATOE',SETTAT,MIN=5 @SC87166 03397000 KW '&AATETOA',SETTET,MIN=5 @SC87166 03397500 KW GOTO,SHOCMDS Skip over 'ALL' @SC88293 03398000 * 03398500 SHOATKW KW '&ATTLENG',SHOATLN @SC90037 03399000 KW '&ATTTYPE',SHOATTP @SC90037 03399500 KW '&ATTDATE',SHOATDT,MIN=2 @SC90037 03400000 KW '&ATTCRET',SHOATCR,MIN=2 @SC90037 03400500 KW '&ATTACCT',SHOATACT,MIN=4 @SC90037 03401000 KW '&ATTAREA',SHOATAR,MIN=2 @SC90037 03401500 KW '&ATTPASS',SHOATPW,MIN=2 @SC90037 03402000 KW '&ATTBLKS',SHOATBLK @SC90037 03402500 KW '&ATTACSS',SHOATACC,MIN=3 @SC90037 03403000 KW '&ATTENCD',SHOATENC @SC90037 03403500 KW '&ATTDISP',SHOATDSP,MIN=2 @SC90037 03404000 KW '&ATTPROT',SHOATPRO,MIN=2 @SC90037 03404500 KW '&ATTORIG',SHOATORG @SC90037 03405000 KW '&ATTFRMT',SHOATFMT @SC90037 03405500 KW '&ATTSINF',SHOATSFO,MIN=2 @SC90037 03406000 KW '&ATTBLEN',SHOATXLN,MIN=2 @SC90037 03406500 KW '&AAAAEND',SHOATEND,MIN=3 @SC91109 03407000 KW , @SC90037 03407500 * 03408000 SHOCMDAL KW '&AAAAALL',SHOALL,MIN=3 @SC88293 03408500 SHOCMDS EQU * @SC90037 03409000 SHOATCM KW '&ATTRIBU',SHOATT,MIN=3 @SC90037 03409500 * 03410000 KW '&AARECFM',SHORFM,MIN=4 @SC87012 03410500 KW '&AALRECL',SHOLR @SC86133 03411000 KW '&WARNING',SHOWARN ***COMPAT*** @SC90033 03411500 KW '&AAPPEND',SHOAPP,MIN=3 ***COMPAT*** @SC90033 03412000 KW '&AAABAUD',SHOBAUD,MIN=2 ***COMPAT*** @SC90099 03412500 SHOCMDKW EQU * Must match order of code 03413000 KW '&TABSEXP',SHOTABS @SC86133 03413500 KW '&AAAAEOF',SHOEOF,MIN=3 @SC86133 03414000 KW '&AADEBUG',SHODEB @SC86133 03414500 KW '&BLKCHCK',SHOBLK @SC86133 03415000 KW '&A8THBQU',SHO8B @SC87008 03415500 KW '&APROMPT',SHOPRP,MIN=2 @SC87268 03416000 KW '&AAALINE',SHOLIN,MIN=3 @SC87166 03416500 KW '&CONTRLR',SHOTRM,MIN=3 @SC87268 03417000 KW '&HANDSHK',SHOHND @SC87274 03417500 KW '&AASPEED',SHOBAUD,MIN=2 @SC90099 03418000 KW '&ASYSCMD',SHOSYS,MIN=2 @SC86295 03418500 KW '&TTTABLE',SHOTTB,MIN=2 @SC87117 03419000 KW '&AADELAY',SHODLY,MIN=3 @SC86164 03419500 KW '&INCOMPL',SHOINC,MIN=3 @SC86225 03420000 KW '&AAATEST',SHOTST,MIN=4 @SC87166 03420500 KW '&SRVTIME',SHOSERV,MIN=3 @SC90045 03421000 KSETKW , Specific parameters @SC87166 03421500 KW '&TRANSFR',SHOTRN,MIN=2 @SC90040 03422000 KW '&AAAFILE',SHOFIL @SC86295 03422500 KW '&AMARGIN',SHOMRG @SC87253 03423000 KW '&FOREIGN',SHOFOR,MIN=3 @HF86223 03423500 KW '&AARETRY',SHORETR,MIN=3 @SC86345 03424000 KW '&AAATAKE',SHOTAK,MIN=3 @SC86171 03424500 KW '&RECEIVE',SHORECV,MIN=3 @SC86133 03425000 KW '&AAASEND',SHOSEND,MIN=3 @SC86224 03425500 KW , @SC86133 03426000 SET CSECT @SC90040 03426500 * 03427000 SHOATT MVC SHOTMP(8),SCANPTR Save string ptrs @SC90037 03427500 LA 0,3 Max interesting count @SC90037 03428000 SHOATL1 NTOKN N=SHOATL2 Count tokens after ATTRIB @SC90037 03428500 BCT 0,SHOATL1 R0=3 => 0 @SC90037 03429000 SHOATL2 MVC SCANPTR(8),SHOTMP Restore 2 => 1 @SC90037 03429500 CLI SETXI,X'97' SET? 1 => 2 @SC90037 03430000 BE *+6 Yes, 2 more means "item" 0 => >2 @SC90037 03430500 BCTR 0,0 No, 1 more means "item" @SC90037 03431000 BCT 0,SHOATS Go if not "item" @SC90037 03431500 LA 4,SHOATKW List of possible items @SC90037 03432000 B SHOGRP Do the right one @SC90037 03432500 SHOATS OI SFLG,ALLF+ASRF Set to display both levels.. @SC90037 03433000 BAL 14,SHOOO Just SET ATT or SHO ATT @SC90037 03433500 OI SCAPA,8 @SC90037 03434000 LA 1,SHOATCM Point at keywork again (SHO ATT) @SC90037 03434500 LA 4,SHOATKW Do whole list @SC90037 03435000 B SHOGRP @SC90037 03435500 SHOATLN BAL 14,SHOOO Length @SC90037 03436000 OI ATFLG,ATFLNG @SC90037 03436500 SHOATTP BAL 14,SHOOO Type @SC90037 03437000 OI ATFLG,ATFTYP @SC90037 03437500 SHOATDT BAL 14,SHOOO Date @SC90037 03438000 OI ATFLG,ATFDAT @SC90037 03438500 SHOATCR BAL 14,SHOOO Creator @SC90037 03439000 OI ATFLG,ATFCRE @SC90037 03439500 SHOATACT BAL 14,SHOOO Account @SC90037 03440000 OI ATFLG,ATFACT @SC90037 03440500 SHOATAR BAL 14,SHOOO Area @SC90037 03441000 OI ATFLG,ATFARE @SC90037 03441500 SHOATPW BAL 14,SHOOO Password @SC90037 03442000 OI ATFLG,ATFPWD @SC90037 03442500 SHOATBLK BAL 14,SHOOO Blocksize @SC90037 03443000 OI ATFLG,ATFBLK @SC90037 03443500 SHOATACC BAL 14,SHOOO Access @SC90037 03444000 OI ATFL2,ATFACC @SC90037 03444500 SHOATENC BAL 14,SHOOO Encoding @SC90037 03445000 OI ATFL2,ATFENC @SC90037 03445500 SHOATDSP BAL 14,SHOOO Disposition @SC90037 03446000 OI ATFL2,ATFDSP @SC90037 03446500 SHOATPRO BAL 14,SHOOO Protection @SC90037 03447000 OI ATFL2,ATFPRO @SC90037 03447500 SHOATORG BAL 14,SHOOO Origin @SC90037 03448000 OI ATFL2,ATFORG @SC90037 03448500 SHOATFMT BAL 14,SHOOO Format @SC90037 03449000 OI ATFL2,ATFFMT @SC90037 03449500 SHOATSFO BAL 14,SHOOO System info @SC90037 03450000 OI ATFL2,ATFSFO @SC90037 03450500 SHOATXLN BAL 14,SHOOO Byte count @SC90037 03451000 OI ATFL3,ATFXLN @SC90037 03451500 SHOATEND BAL 14,SHOOO End @SC91109 03452000 OI ATFL4,ATFEND @SC91109 03452500 B SHOGRPZ @SC90037 03453000 * 03453500 SHOALL OI SFLG,ALLF Do all @SC86295 03454000 SR 0,0 Clear screen (if fullscreen) @SC90045 03454500 KCALL SCRNIO @SC90045 03455000 LA 1,SHOCMDKW Start at beginning @SC86133 03455500 * 03456000 * Each routine begins with R1-> keyword item @SC86133 03456500 SHOTABS CLI SETXI,X'97' SET or SHOW? @SC87166 03457000 BE SETTABS @SC87166 03457500 BAL 14,SHOOO On or off @SC86133 03458000 OI FL2,TABS @SC87166 03458500 SHOTABSZ LH 5,TABCNT Count of tabs @SC86355 03459000 LA 3,TABTBL Ptr to table of tabs @SC86355 03459500 BAL 14,SHOLIST Display list of tab stops, if any @SC86355 03460000 NOP 0 @SC87166 03460500 SHOEOF BAL 14,SHOOO On or off @SC86133 03461000 OI FL2,EOFZ @SC87166 03461500 SHODEB CLI SETXI,X'97' SET or SHOW? @SC87166 03462000 BE SETDEB @SC87166 03462500 BAL 14,SHOOO 1st get ON vs. OFF @SC88168 03463000 OI FL1,DEBUG @SC88168 03463500 SHODEBZ MVC SHODBG,DBGFLG Copy flags for decoding @SC88168 03464000 LA 6,SETRAW List of options @SC88168 03464500 BAL 4,SHOMULT See if any extra flags on @SC88168 03465000 NOP 0 @SC88168 03465500 SHOBLK LA 4,SETBLKKW @SC92085 03466000 LA 6,BCTC Get block check type @SC92085 03466500 BAL 14,SHOBRV Print it @SC92085 03467000 NOP 0 OK @SC92085 03467500 SHO8B LA 8,EBQC @SC87008 03468000 BAL 14,SHOCHRA Display ASCII char @SC87008 03468500 B SET8B @SC87166 03469000 SHOPRP LA 8,KPRPL Ptr to prompt @SC87268 03469500 LA 4,20 Max length @SC87268 03470000 BAL 14,SHOSTR @SC87268 03470500 B SETPRP Do any system-dependent setup @SC87351 03471000 SHOLIN LA 8,TRMLIN @SC87166 03471500 LA 9,L'TRMLIN @SC87166 03472000 BAL 14,SHOCHRN @SC87166 03472500 B SETLIN @SC87166 03473000 SHOTRM LA 4,SETTRKW @SC87166 03473500 LA 6,TRMTP @SC87166 03474000 BAL 14,SHOBRV Get full name from abbrev. @SC87166 03474500 NOP 0 @SC87166 03475000 SHOHND SR 4,4 @SC87274 03475500 IC 4,S1HND @SC87274 03476000 BAL 14,SHOCTL Print it @SC87274 03476500 B RTRN0 @SC87274 03477000 SHOBAUD L 4,BAUD @SC86164 03477500 BAL 14,SHONBIG Print it @SC86164 03478000 B RTRN0 @SC87166 03478500 SHOSYS BAL 14,SHOOO On or off @SC86295 03479000 OI FL2,PASS @SC87166 03479500 SHOTTB CLI SETXI,X'97' @SC90278 03480000 BE SETTTB Do SET subcommand separately @SC90278 03480500 BAL 14,SHOOO On or off @SC90278 03481000 OI FL4,TTAB @SC87166 03481500 SHODLY L 4,LCLDLY @SC86164 03482000 BAL 14,SHONBIG Print it @SC86164 03482500 B RTRN0 @SC87166 03483000 SHOINC LA 4,SETDSC List of possibles @SC87166 03483500 BAL 14,SHOXY @SC86225 03484000 OI FL1,KEEP @SC90037 03484500 SHOTST BAL 14,SHOOO @SC87166 03485000 OI FL1,TSTF Turn on @SC87166 03485500 SHOSERV SR 4,4 @SC90045 03486000 IC 4,TIMOSRV Server timeout (also switch) @SC90045 03486500 BAL 14,SHONBIG @SC90045 03487000 B RTRN0 Index for server @SC90045 03487500 * 03488000 KSHOPRC , System-specific options @SC86355 03488500 * 03489000 SHOTRN LA 4,SHOTRNKW Ptr to sublist @SC90040 03489500 BAL 14,SHOGRP @SC90040 03490000 SHOFIL LA 4,SHOFILKW Ptr to sublist @SC87166 03490500 CLI SETXI,X'97' SET or SHOW **COMPAT** @SC87166 03491000 BNE *+8 SHOW **COMPAT** @SC87166 03491500 LA 4,SETFKW SET **COMPAT** @SC87166 03492000 LA 8,TYPFIL In case just 'SET F T' @SC91320 03492500 BAL 14,SHOGRP @SC86295 03493000 SHOMRG LA 4,SHOMRGKW Ptr to sublist @SC87253 03493500 BAL 14,SHOGRP @SC87253 03494000 SHOFOR LA 4,SHOFORKW Ptr to sublist @SC87166 03494500 BAL 14,SHOGRP @SC86224 03495000 SHORETR LA 4,SHORETKW Ptr to sublist @SC87166 03495500 BAL 14,SHOGRP @SC86345 03496000 SHOTAK LA 4,SHOTAKKW Ptr to sublist @SC87166 03496500 BAL 14,SHOGRP @SC86224 03497000 SHORECV SR 5,5 Index for recv @SC86224 03497500 BAL 14,SHOGRPR @SC86224 03498000 SHOSEND LA 5,1 Index for send @SC86224 03498500 LA 14,SHOZZW @SC87166 03499000 SHOGRPR LA 4,SHORECKW Ptr to common sublist @SC87166 03499500 SHOGRP LR 2,14 Save return adr @SC87166 03500000 STM 1,4,SHOTMP Save top level ptr, return adr @SC87166 03500500 TM SFLG,ALLF Doing all? @SC86295 03501000 BO SHORAL2 Yes @SC86133 03501500 SETSCN LR 2,14 Copy return adr (again) @SC87166 03502000 NTOKN N=SHORALL @SC86133 03502500 LR 9,2 ??? @SC87166 03503000 SCAN (4),RTRN1 @SC87166 03503500 SHOHLP HELP (4),RTRN1 @SC87166 03504000 * 03504500 SETCMDS CSECT @SC90040 03505000 SHOTRNKW KW '&LOCKSHF',SHOLCK @SC91275 03505500 KW '&CHARSET',SHOALF @SC91275 03506000 KW , @SC90040 03506500 * 03507000 SHOFILKW KW '&ATTTYPE',SHOFILT @SC86295 03507500 KW '&LONGLIN',SHOLNG,MIN=2 @SC88120 03508000 KW '&COLLISN',SHOCLSN,MIN=2 @SC90033 03508500 KW '&OVERWRI',SHOOVWR @SC90033 03509000 KW '&AALRECL',SHOLR @SC86133 03509500 KFILKW @SC87166 03510000 KW '&CHARSET',SHOFALF @SC90040 03510500 KW , @SC87012 03511000 * 03511500 SHOMRGKW KW '&AAALEFT',SHOLFT @SC87253 03512000 KW '&AARIGHT',SHORGT @SC87253 03512500 KW , @SC87253 03513000 * 03513500 SHORECKW KW '&ENDOFLI',SHOEOL @SC86133 03514000 KW '&ENDOFPA',SHOEOL @SC86133 03514500 KW '&AAAAEOL',SHOEOL,MIN=3 @SC86133 03515000 KW '&PACKLEN',SHOSIZ @SC90150 03515500 SHOPSKW KW '&PACKSIZ',SHOSIZ @SC86133 03516000 KW '&PADCHAR',SHOPADC,MIN=5 @SC86164 03516500 KW '&PADDING',SHOPADN,MIN=3 @SC86164 03517000 KW '&AAQUOTE',SHOQUO @SC86133 03517500 KW '&STARTOP',SHOMARK @SC86133 03518000 KW '&TIMEOUT',SHOTIMO @SC86164 03518500 KW '&APARITY',SHOPRTY @SC88288 03519000 KW , @SC86133 03519500 * 03520000 SHOTAKKW KW '&AAAECHO',SHOECO,MIN=3 @SC86171 03520500 KW '&ERRACTI',SHOHLT,MIN=3 @SC86171 03521000 KW , @SC86171 03521500 * 03522000 SHOFORKW KW '&APREFIX',SHOPFX @HF86223 03522500 KW '&ASUFFIX',SHOSFX @HF86223 03523000 KW , @HF86223 03523500 * 03524000 SHORETKW KW '&INITIAL',SHORETI @SC86345 03524500 KW '&PACKETS',SHORETN @SC86345 03525000 KW , @SC86345 03525500 SET CSECT @SC90040 03526000 * 03526500 SHORALL OI SFLG,ALLF+ASRF Do just all send/recv items @SC86295 03527000 LA 14,SHOHLP Just help if SET @SC87166 03527500 SHORAL2 BAL 2,SHOKW Get ptr to kw send or receive @SC86133 03528000 BER 14 Help for SET @SC87166 03528500 L 15,SHOPTR Output line buffer ptr @SC86227 03529000 LA 1,CMD @SC86227 03529500 SR 15,1 Anything there? @SC86227 03530000 BNP SHORAL3 No @SC86227 03530500 ST 1,SHOPTR Yes, reset ptr @SC86227 03531000 WTEXT (1),(15) And write it out @SC86227 03531500 SHORAL3 DS 0H @SC86227 03532000 MVC CMD(2),=C' ' @SC86133 03532500 MVC CMD+2(15),0(6) Copy send or receive or ... @SC89226 03533000 LA 0,CMD+2(7) Point past category @SC86316 03533500 ST 0,SHOPTR Save output ptr @SC86316 03534000 L 1,SHOTMP+12 Start at beginning @SC87166 03534500 ICM 14,7,KWADR(1) Ptr to 1st routine @SC90239 03535000 BR 14 @SC86171 03535500 * 03536000 SHOLCK LA 4,SETOOFRC On, Off, Forced @SC91275 03536500 CLI SETXI,X'97' SET or SHOW? @SC91275 03537000 BE SHOLCK1 SET - do it directly @SC91275 03537500 TM LCKFRC,1 @SC91275 03538000 BZ SHOLCK1 @SC91275 03538500 LA 4,SETOFRC Just Forced @SC91275 03539000 SHOLCK1 BAL 14,SHOXY Get ON vs. OFF or FORCED @SC91275 03539500 OI SCAPA,X'20' @SC91275 03540000 * 03540500 SHOALF LA 4,SETALFKW NOTE: this must be last parm @SC90040 03541000 LA 8,TRNALF Ptr to transfer character name @SC90040 03541500 B SHOALFC Processing same as file char set @SC90040 03542000 * 03542500 AIF ('&ATTTYPE'(1,1) NE '&AAATEXT'(1,1)).CMPAT02 @SC92300 03543000 SETFT ICM 15,15,LEN SET F T ... **COMPAT** @SC87166 03543500 LA 8,TYPFIL In case just 'SET F T' @SC91320 03544000 BNP SETFILET Nothing after: 'SET FILE-TYPE T' @SC87166 03544500 .CMPAT02 ANOP @SC92300 03545000 * 03545500 SHOFILT LA 4,SETFIL List of possibles @SC86151 03546000 LA 6,TYPFIL @SC87166 03546500 BAL 14,SHOBRV Get full name from abbrev. @SC87166 03547000 NOP 0 @SC87166 03547500 SHOLNG LA 4,SETLNGKW List of possibles @SC88120 03548000 LA 6,TRNCFL @SC88120 03548500 BAL 14,SHOBRV Get full name from abbrev. @SC88120 03549000 NOP 0 @SC88120 03549500 SHOCLSN LA 4,SETCLSKW List of COLLISION options @SC90033 03550000 LA 6,CLSNFL @SC90033 03550500 BAL 14,SHOBRV @SC90033 03551000 NOP 0 @SC90033 03551500 SHOOVWR LA 4,SETOVWKW List of possibles @SC90033 03552000 BAL 14,SHOXY @SC90033 03552500 OI FL3,SVATT @SC90033 03553000 SHOLR SR 4,4 @SC86133 03553500 L 8,MAXLRC Upper limit @SC87166 03554000 ICM 4,3,FILLRC @SC88120 03554500 BAL 14,SHONUM Print it @SC86133 03555000 B SETLR @SC87166 03555500 KFILSHO , @SC87012 03556000 SHOFALF LA 4,SETFALFK NOTE: this must be last parm @SC90040 03556500 LA 8,FILALF Ptr to file character name @SC90040 03557000 LA 9,2*LALF @SC91325 03557500 CLC FILALF,FILALF2 @SC91325 03558000 BNE SHOALF2 @SC91325 03558500 SHOALFC LA 9,LALF @SC91325 03559000 SHOALF2 DS 0H @SC91325 03559500 BAL 14,SHOCHRN Get name @SC90040 03560000 B SETSCN @SC90040 03560500 B SHOGRPZ @SC86295 03561000 * 03561500 SHOLFT L 4,LMARG @SC87253 03562000 BAL 14,SHONBIG Print it @SC87253 03562500 B RTRN0 @SC87253 03563000 SHORGT L 4,RMARG @SC87253 03563500 BAL 14,SHONBIG Print it @SC87253 03564000 B RTRN0 @SC87253 03564500 B SHOGRPZ @SC87253 03565000 * 03565500 SHOWARN BAL 14,SHOOO On or off ***COMPAT*** @SC90033 03566000 OI FL1,REN @SC90033 03566500 SHOAPP BAL 14,SHOOO On or off ***COMPAT*** @SC90033 03567000 OI FL3,APPN @SC90033 03567500 * 03568000 SHOECO BAL 14,SHOOO On or off @SC86171 03568500 OI FL2,ECHO @SC87166 03569000 SHOHLT LA 4,SETSWT List of possibles @SC87166 03569500 BAL 14,SHOXY @SC86171 03570000 OI FL5,TKHLT @SC87166 03570500 B SHOGRPZ @SC86171 03571000 * 03571500 SHOPFX LA 8,PREFIX Point to prefix @HF86223 03572000 LA 4,FORMAXL Max length @SC87268 03572500 BAL 14,SHOSTR Print message @SC86224 03573000 B RTRN0 @SC87268 03573500 SHOSFX LA 8,SUFFIX Point to suffix @HF86223 03574000 LA 4,FORMAXL Max length @SC87268 03574500 BAL 14,SHOSTR Print message @SC86224 03575000 B RTRN0 @SC87268 03575500 B SHOGRPZ @HF86223 03576000 * 03576500 SHORETI L 4,MAXTNT Initial retry limit @SC86345 03577000 BAL 14,SHONBIG Print it @SC87166 03577500 B RTRN0 @SC87166 03578000 SHORETN L 4,MAXTRY Normal retry limit @SC86345 03578500 BAL 14,SHONBIG Print it @SC87166 03579000 B RTRN0 @SC87166 03579500 B SHOGRPZ @SC86345 03580000 * 03580500 SHOEOL SR 4,4 @SC86133 03581000 IC 4,REOL(5) @SC86133 03581500 BAL 14,SHOCTL Print it @SC87166 03582000 B SETEOL @SC87166 03582500 LA 1,SHOPSKW Skip aliases @SC86133 03583000 SHOSIZ L 8,=A(KMAXE) Limit @SC87166 03583500 LR 3,5 @SC87166 03584000 SLA 3,2 Get fullword index @SC87166 03584500 L 4,RPSIZ(3) @SC87166 03585000 BAL 14,SHONUM Print number @SC86133 03585500 B SETSIZ @SC87166 03586000 SHOPADC SR 4,4 @SC86164 03586500 IC 4,RPADC(5) Pad character @SC86164 03587000 BAL 14,SHOCTL @SC87166 03587500 B SETPADC @SC87166 03588000 SHOPADN SR 4,4 @SC86164 03588500 LA 8,KMAX Same upper limit as packets @SC87166 03589000 IC 4,RPADN(5) Pad count @SC86164 03589500 BAL 14,SHONUM @SC86164 03590000 B SETPADN @SC87166 03590500 SHOQUO LA 8,RCTLQ(5) @SC86133 03591000 BAL 14,SHOCHRA Print as ascii @SC86133 03591500 B SETRCTLQ @SC87166 03592000 SHOMARK SR 4,4 @SC86133 03592500 IC 4,RMARK(5) @SC86133 03593000 BAL 14,SHOCTL @SC87166 03593500 B RTRN0 @SC87166 03594000 SHOTIMO SR 4,4 @SC86164 03594500 IC 4,RTIMO(5) Timeout limit @SC86164 03595000 BAL 14,SHONBIG @SC87166 03595500 B SETTIMO @SC87166 03596000 SHOPRTY LA 4,SETPAR @SC88288 03596500 LA 3,RPRTY(5) Ptr to proper flag @SC88288 03597000 BAL 14,SHOXY @SC88288 03597500 OI 0(3),DAT8 @SC88288 03598000 * 03598500 SHOGRPZ TM SFLG,ASRF Doing just receive/send? @SC86295 03599000 BO SHOZZW Yes, write last line @SC86227 03599500 LM 1,2,SHOTMP Get top level ptr, return adr @SC87166 03600000 LR 14,2 @SC86224 03600500 BAL 2,SHOKW Get ptr to name @SC86133 03601000 LA 1,0(7,6) Advance to next @SC86133 03601500 BR 14 @SC86224 03602000 * 03602500 SHOMULT LR 5,1 Save ptr to current option @SC88168 03603000 LR 1,6 Use ptr to list of suboptions @SC88168 03603500 SHOMULQ ICM 14,7,KWADR(1) Get ptr to handler (assume OI x,y)@SC90239 03604000 BAL 2,SHOKW Get ptrs to KW string, fix SETXI @SC88168 03604500 EX 0,SETXI TM x,y @SC88168 03605000 BNO SHOMULP Not this one @SC88168 03605500 MVI 0(15),C',' Yes, punctuate display @SC88168 03606000 LA 15,1(15) @SC88168 03606500 LR 8,6 @SC88168 03607000 LR 9,7 @SC88168 03607500 BAL 2,EDCHAR Copy this KW to display @SC88168 03608000 SHOMULP LA 1,0(7,6) On to next in list @SC88168 03608500 CLI KWLEN(1),254 End of list? @SC90239 03609000 BL SHOMULQ No, keep checking @SC88168 03609500 LR 14,4 Proper place for return adr @SC88168 03610000 LR 1,5 Restore ptr to current option @SC88168 03610500 B SHOZZZ End of item @SC88168 03611000 * 03611500 SHOLIST LTR 5,5 Length of list @SC86355 03612000 BZ SHOZZ Empty, we're done @SC86355 03612500 LA 0,CMD+75 Set right margin @SC86355 03613000 MVI 0(15),C' ' Start with blank @SC86355 03613500 B *+8 @SC86355 03614000 SHOLSLP MVI 0(15),C',' Insert delimiter @SC86355 03614500 LA 15,1(15) @SC86355 03615000 CR 15,0 Any room? @SC86355 03615500 BL SHOLSED Yes, ok @SC86355 03616000 LA 1,CMD No, dump line @SC86355 03616500 SR 15,1 @SC86355 03617000 WTEXT (1),(15) @SC86355 03617500 MVI CMD,C' ' @SC86355 03618000 LA 15,CMD+1 Start indented @SC86355 03618500 LA 0,CMD+75 @SC86355 03619000 SHOLSED SR 4,4 @SC86355 03619500 IC 4,0(3) Get 1-byte item @SC86355 03620000 BAL 2,EDDEC Format it @SC86355 03620500 LA 3,1(3) Point to next item in list @SC86355 03621000 BCT 5,SHOLSLP @SC86355 03621500 B SHOZZ Finished list @SC86355 03622000 * 03622500 SHOKW MVC SETXI+1(3),1(14) Copy instr operands @SC87166 03623000 CLI SETXI,X'97' 'OI' if SET, but 'TM' if SHOW @SC87166 03623500 LA 6,KWNAME(1) Ptr to name @SC90239 03624000 LA 7,0 Preserve CC @SC86133 03624500 IC 7,KWLEN(1) Length (assumes high bytes clear) @SC90239 03625000 LA 7,1(7) @SC86133 03625500 BR 2 @SC86133 03626000 * 03626500 SHOCTL LA 8,ABL-1 Max control character (ASCII) @SC87166 03627000 CLI TRMTP,C'F' Full-screen non-transparent? @SC92030 03627500 BE SHONBIG Yes, allow any packet char, etc. @SC92030 03628000 TM FL1,TSTF @SC86295 03628500 BZ SHONUM @SC87166 03629000 SHONBIG L 8,=F'999999998' Almost anything @SC87166 03629500 SHONUM BAL 2,SHOKW @SC86133 03630000 BE SETNUM2 Get value for SET @SC87166 03630500 BAL 2,SHONAM Copy option name @SC86209 03631000 BAL 2,EDDEC Edit (R4) as decimal @SC86295 03631500 B SHOZZ @SC86133 03632000 * 03632500 SHOCHRA MVC TMP,0(8) Copy ascii char @SC86133 03633000 PTEXT SETOOKW+KWNAME,3,AREG=8,LREG=9 @SC91320 03633500 TM TMP,X'60' Is it printable? @SC87008 03634000 BZ SHOCHRN No, say it's OFF @SC87008 03634500 TR TMP,ATOED Convert to EBCDIC @SC89301 03635000 LA 8,TMP @SC86133 03635500 B SHOCHR @SC86224 03636000 SHOSTR BAL 2,SHOKW Get ptrs to name @SC87268 03636500 BE SETSTR Branch to dispatch for SET @SC87268 03637000 SR 9,9 Variable-length string @SC86224 03637500 IC 9,0(8) Get length @SC86224 03638000 LA 8,1(8) Ptr to text @SC86224 03638500 B SHOCHRD @SC87268 03639000 SHOCHR LA 9,1 Length is 1 @SC86224 03639500 SHOCHRN BAL 2,SHOKW Get ptrs to name @SC86224 03640000 BER 14 Branch to dispatch for SET @SC87166 03640500 SHOCHRD BAL 2,SHONAM Copy option name @SC87268 03641000 BAL 2,EDCHAR Append string at (R8) @SC87034 03641500 B SHOZZ Print message @SC87034 03642000 * 03642500 SHOBRV CLI SETXI,X'97' SET or SHOW? @SC87166 03643000 LR 8,6 Save ptr to code field @SC91320 03643500 BE SETSCN @SC87166 03644000 LR 9,14 Save return adr @SC87166 03644500 LR 8,1 Save list ptr @SC87166 03645000 LR 1,4 Use list of suboptions @SC87166 03645500 ICM 7,4,0(6) Use code to look up @SC91320 03646000 ICM 7,8,* Indicate just search @SC87166 03646500 BAL 14,SCAN @SC87166 03647000 CR 0,0 These two skipped @SC87166 03647500 LR 4,1 if bad value @SC87166 03648000 LR 1,8 Retrieve ptrs @SC87166 03648500 LR 14,9 @SC87166 03649000 B SHOXY Display it @SC87166 03649500 * 03650000 SHOOO LA 4,SETOOKW Ptr to on/off @SC87166 03650500 SHOXY BAL 2,SHOKW Set up name @SC86133 03651000 BE SETSCN Parse value for SET @SC87166 03651500 LA 8,KWNAME(4) Value if off @SC90239 03652000 SR 9,9 @SC87166 03652500 IC 9,KWLEN(4) Length of name - 1 @SC90239 03653000 EX 0,SETXI Test bit @SC87166 03653500 BZ *+12 @SC86133 03654000 LA 8,KWNAME+1(9,8) Flag is on, advance to other @SC90239 03654500 IC 9,KWNAME+1(9,4) Length-1 of other item @SC90239 03655000 LA 9,1(9) @SC86133 03655500 SHOXL BAL 2,SHONAM Copy option name @SC86209 03656000 BAL 2,EDCHAR Append string at (R8) @SC86295 03656500 SR 15,9 Back up to string @SC87034 03657000 TR 0(30,15),LOCASE And make it lower case @SC87034 03657500 AR 15,9 Resume @SC87034 03658000 SHOZZ LA 1,0(7,6) Advance to next option @SC88168 03658500 SHOZZZ ST 15,SHOPTR Save end of display buffer @SC88168 03659000 L 3,=A(SETCMDS) Recover base reg. @SC90040 03659500 LA 14,4(14) Skip over SET branch @SC87166 03660000 CLM 14,7,=AL3(SHOTABSZ) @SC86355 03660500 BER 14 Special treatment for tabs @SC86355 03661000 CLM 14,7,=AL3(SHODEBZ) @SC88168 03661500 BER 14 Special treatment for DEBUG, too @SC88168 03662000 TM SFLG,ALLF Doing all? @SC86295 03662500 BOR 14 And resume if yes @SC86227 03663000 SHOZZW LA 1,CMD No, get address of buffer @SC86227 03663500 SR 15,1 Get length @SC86227 03664000 WTEXT (1),(15) Write it out @SC86227 03664500 B RTRN0 That's all @SC86295 03665000 * 03665500 SHONAM LA 15,CMD Output message buffer @SC86209 03666000 L 0,SHOPTR End of prev. msg @SC86227 03666500 CR 0,15 Empty? @SC86227 03667000 BE SHON1 Yes, start here @SC86227 03667500 LA 1,CMD+23 2nd column @SC86227 03668000 SR 1,0 Far enough? @SC86227 03668500 BP SHONF Yes, blank fill @SC86227 03669000 AH 1,=H'23' Try 3rd column @SC86227 03669500 BP SHONF OK @SC86227 03670000 SR 0,15 No room, dump line @SC86227 03670500 WTEXT (15),(0) @SC86227 03671000 LA 15,CMD And start over @SC86227 03671500 B SHON1 @SC86227 03672000 SHONF SR 15,15 @SC86295 03672500 ICM 15,8,BLANK @SC86295 03673000 MVCL 0,14 Fill with blanks to next column @SC86227 03673500 LR 15,0 New output ptr @SC86227 03674000 SHON1 MVC 0(40,15),0(6) Copy option name @SC87034 03674500 TR 1(39,15),LOCASE And beautify it @SC87034 03675000 AR 15,7 Space over it @SC86209 03675500 INITSTR '&AAAAAIS' @SC92300 03676000 BR 2 @SC86209 03676500 DROP 3 @SC90040 03677000 * 03677500 LOCALS , @SC86295 03678000 SHOTMP DS 4F @SC87166 03678500 SHOPTR DS A More temporaries @SC86227 03679000 SETXI DS F XI executable instr @SC86273 03679500 SFLG DS X Local flags @SC86295 03680000 ALLF EQU X'80' Doing SHOW ALL @SC86295 03680500 ASRF EQU X'40' Doing SHOW REC or SHOW SEND @SC86295 03681000 SHODBG DS X Temp for DEBUG flags @SC88168 03681500 SHOW EXIT 03682000 TITLE 'STATUS Routine - display latest error, etc.' @SC86295 03682500 * Exit: R15=0. ERRNUM unchanged. 03683000 STATUS ENTER @SC86156 03683500 CLI ERRNUM,ERRNFT Actual error? @BS86090 03684000 BNH STAMSG No @BS86090 03684500 CLI ERRNUM,ERRKCE Last command invalid? @SC86295 03685000 BE STAMSG Yes, do not show last file @HF86232 03685500 CLI FILNAM,0 File name defined? @BS86090 03686000 BE STAMSG No @BS86090 03686500 INITSTR '&LASTFIL',CMD,REG=7 @SC92300 03687000 LA 1,FILNAM @SC86295 03687500 BAL 2,STAFSP Copy name and print @SC86295 03688000 STAMSG ICM 4,15,NSENT Number of files sent @SC86295 03688500 BZ STASNTZ @SC86295 03689000 LA 15,CMD Start of message buffer @SC86295 03689500 BAL 2,EDDEC Format number as decimal @SC86295 03690000 INITSTR '&FSENLST' @SC92300 03690500 BAL 2,STAPM15 Show message @SC86295 03691000 STASNTZ ICM 0,15,PAKCNT Any transfer statistics? @SC86295 03691500 BZ STADATR No, skip it @SC86316 03692000 ICM 6,7,=C'&PKTABBR' @SC86295 03692500 BAL 3,STADPR Format msg @SC86295 03693000 ICM 0,15,SECTOT Any duration? @SC86295 03693500 BZ STADATR No, must have been very short @SC86316 03694000 ICM 6,7,=C'&SECABBR' @SC86295 03694500 BAL 3,STADPR Format msg @SC86295 03695000 INITSTR '&BYTPSEC',CMD @SC92300 03695500 L 0,SECTOT @SC86295 03696000 LM 4,5,DSKTOT @SC86295 03696500 BAL 2,STAVB Format ratio @SC86295 03697000 ICM 1,15,BAUD Efficiency only if speed defined @SC93014 03697500 BNP STADEFCZ @SC93014 03698000 MVC 0(3,15),=C' = ' @SC93014 03698500 LA 15,3(,15) @SC93014 03699000 M 4,=F'1000' *10*100 for bits/byte and percent @SC93014 03699500 L 0,BAUD Compute percentage of line speed @SC93014 03700000 BAL 2,STAVB Format ratio @SC93014 03700500 INITSTR '% (&AASPEED.&AAAAAIS' Remind of rating @SC93014 03701000 L 4,BAUD @SC93014 03701500 BAL 2,EDDEC @SC93014 03702000 MVI 0(15),C')' @SC93014 03702500 LA 15,1(,15) @SC93014 03703000 STADEFCZ DS 0H @SC93014 03703500 BAL 2,STAPM15 Print line @SC86295 03704000 STADATR ICM 4,15,RTRCNT Any retries? @SC86316 03704500 BZ STADATZ No @SC86316 03705000 LA 15,CMD Yes, issue message @SC86316 03705500 BAL 2,EDDEC @SC86316 03706000 INITSTR '&REPTCNT' @SC92300 03706500 BAL 2,STAPM15 Print line @SC86316 03707000 XC TINSV(48),TINSV Completely clear data @SC88325 03707500 KCALL OPTPKT Get best packet size @SC88325 03708000 LTR 4,15 Valid? @SC86345 03708500 BNP STADATZ No, skip it @SC86345 03709000 INITSTR '&OPTSIZE',CMD @SC92300 03709500 BAL 2,EDDEC Format it @SC86345 03710000 BAL 2,STAPM15 @SC86345 03710500 STADATZ ICM 4,15,RECTRC Any truncated records? @SC87268 03711000 BZ STATRCZ No, ok @SC87268 03711500 LA 15,CMD Yes, issue message @SC87268 03712000 BAL 2,EDDEC @SC87268 03712500 INITSTR '&MRCTRNC' @SC92300 03713000 BAL 2,STAPM15 @SC87268 03713500 STATRCZ DS 0H @SC87268 03714000 ICM 4,15,RECFLD Any folded records? @SC88120 03714500 BZ STATFDZ No, ok @SC88120 03715000 LA 15,CMD Yes, issue message @SC88120 03715500 BAL 2,EDDEC @SC88120 03716000 INITSTR '&RECFOLD' @SC92300 03716500 BAL 2,STAPM15 @SC88120 03717000 STATFDZ DS 0H @SC88120 03717500 STAPEMSG DS 0H @SC91064 03718000 SR 5,5 @SC86156 03718500 IC 5,ERRNUM Get offset into error table @SC86156 03719000 SLL 5,2 Get fullword index @SC86156 03719500 A 5,=A(ERRTAB) Pointer address @SC89215 03720000 L 1,0(5) Msg ptr @SC86156 03720500 SR 0,0 @SC86268 03721000 SLDL 0,8 Msg length @SC86316 03721500 SRL 1,8 Realign adr @SC86316 03722000 WTEXT (1),(0) Print message @SC86268 03722500 CLI ERRNUM,ERRTRC Cancelled? @SC86316 03723000 BNE STACKAB No @SC86316 03723500 SR 1,1 @SC86316 03724000 CLI REASON,STACNN Within table? @SC90033 03724500 BH *+8 No, must be new @SC86316 03725000 IC 1,REASON Ok, get the complaint code @SC86316 03725500 SLL 1,3 Index into table @SC86316 03726000 LA 1,STACNTB(1) @SC86316 03726500 LA 0,8 Length of items @SC86316 03727000 WTEXT (1),(0) @SC86316 03727500 STACKAB CLI ERRNUM,ERRABO Micro aborted? @BS86090 03728000 BE *+12 Yes @SC87338 03728500 CLI ERRNUM,ERRDIE No, disk I/O error? @SC87338 03729000 BNE STARET No @BS86090 03729500 ICM 0,15,EMSGL Yes, any message? @SC86268 03730000 BZ STARET No @BS86090 03730500 L 1,EMSGP @BS86090 03731000 WTEXT (1),(0) Yes, show it @SC86268 03731500 STARET TM FL1,TSTF @SC89089 03732000 BZ RTRN0 Skip this message unless testing @SC89089 03732500 LM 3,4,STKLO Get start and end of stack use @SC89089 03733000 SR 4,3 Get length (is mult. of 8) @SC89089 03733500 SRL 4,3 Convert to doublewords @SC89089 03734000 LA 15,CMD Sart of msg buffer @SC89089 03734500 BAL 2,EDDEC Format number @SC89089 03735000 INITSTR '&DWRDSTK' @SC92300 03735500 BAL 2,STAPM15 @SC89089 03736000 B RTRN0 @SC89089 03736500 * 03737000 STADPR INITSTR '&ZZBYTES',CMD @SC92300 03737500 MVC 0(8,15),=C'/___: S=' @SC92300 03738000 STCM 6,7,1(15) Fill in unit name (pkt or sec) @SC92300 03738500 LA 15,8(,15) @SC92300 03739000 LM 4,5,TOUTOT @SC86295 03739500 BAL 2,STAVB Format ratio @SC86295 03740000 MVC 0(3,15),=C' R=' @SC86295 03740500 LA 15,3(15) @SC86295 03741000 LM 4,5,TINTOT @SC86295 03741500 BAL 2,STAVB Format ratio @SC86295 03742000 INITSTR '&REQUIRG' @SC92300 03742500 LR 4,0 @SC86295 03743000 BAL 2,EDDEC Format number of units @SC86295 03743500 MVI 0(15),C' ' @SC86295 03744000 STCM 6,7,1(15) @SC86295 03744500 LA 0,4(15) End of msg @SC86295 03745000 BAL 2,STAPMSG Print it @SC86295 03745500 BR 3 @SC86295 03746000 * 03746500 STAVB DR 4,0 Get ratio @SC86295 03747000 AR 4,4 @SC86295 03747500 CR 4,0 @SC86295 03748000 BL *+8 @SC86295 03748500 A 5,F1 Round up @SC86295 03749000 LR 4,5 @SC86295 03749500 B EDDEC Format it @SC86295 03750000 * 03750500 * Display just error message and its backup explanations. @SC91064 03751000 * (same as STATUS) @SC91064 03751500 PEMSG ENTER ALT @SC91064 03752000 B STAPEMSG Do it @SC91064 03752500 * 03753000 * Table of reasons for rejecting Attribute packet @SC86316 03753500 STACNTB DC C'-&ATTUNK.-&ATTLEN.-&ATTTYP.-&ATTDAT.' @SC92300 03754000 DC C'-&ATTCRE.-&ATTACC.-&ATTARE.-&ATTPAS.' @SC92300 03754500 DC C'-&ATTBLK.-&ATTACS.-&ATTENC.-&ATTDIS.' @SC92300 03755000 DC C'-&ATTPRO.-&ATTPRO.-&ATTORI.-&ATTFRM.' @SC92300 03755500 DC C'-&ATTSIN.-&ATTBLE.' @SC92300 03756000 DC (32-(*-STACNTB)/8)CL8'-??' @SC91109 03756500 DC C'-&AAAAEN.' 32- @SC92300 03757000 STACNCLS EQU (*-STACNTB)/8 One extra reason stuck on the end @SC90033 03757500 DC C'-&COLLIS.' @SC92300 03758000 STACNN EQU (*-STACNTB)/8-1 @SC90033 03758500 LOCALS , @SC91109 03759000 EXIT @SC91109 03759500 TITLE 'DUMP Routine - print translation table' 03760000 * Display current values in STORAG. 03760500 * Entry: SCANPTR string has option 03761000 * Exit: R15=0 if ok, R15=1 if error or help needed. ERRNUM unchanged. 03761500 DUMP ENTER , @SC91109 03762000 NTOKN N=DUMPH A or E? @SC86156 03762500 SCAN DUMPKW,RTRN1 @SC86295 03763000 DUMPH HELP DUMPKW,RTRN1 @SC86295 03763500 * 03764000 DUMPKW KW '&AAAATOE',DUMPA @SC86156 03764500 KW '&CTRLCHR',DUMPCT @SC93173 03765000 KW '&AAAETOA',DUMPE @SC86156 03765500 KW '&AANAMES',DMPN @SC86295 03766000 KW '&AATATOE',DUMPTA,MIN=2 @SC87117 03766500 KW '&AATETOA',DUMPTE,MIN=2 @SC87117 03767000 AIF ('&KTRACE' NE 'YES').NODUMTR @SC92169 03767500 KW '&AATRACE',DUMPTR,MIN=2 @SC92169 03768000 .NODUMTR ANOP @SC92169 03768500 KW , @SC86156 03769000 * 03769500 DUMPTR KTRACE DUMP Dump trace table (only if enabled)@SC92169 03770000 * 03770500 DMPN L 5,TSENT Table ptr @SC86295 03771000 ICM 6,15,NSENT Number of files sent @SC86295 03771500 BNZ DMPNL @SC86295 03772000 WTEXT '&NOFSENT' @SC86295 03772500 B RTRN0 @SC86295 03773000 USING ACTBUF,5 @SC91172 03773500 DMPNL LA 7,CMD Start of message buffer @SC86295 03774000 SR 15,15 @SC91172 03774500 ICM 15,7,ACTBEG Starting time @SC91172 03775000 BAL 2,DMPTIM @SC91172 03775500 LA 0,FFDSP @SC88092 03776000 KCALL FSPEC,ACTFID Copy name for display @SC91172 03776500 MVC 0(2,15),=C' (' @SC88092 03777000 LA 15,2(15) @SC88092 03777500 ICM 4,15,ACTSIZ Get file size @SC91172 03778000 BAL 2,EDDEC Format into message @SC88092 03778500 MVC 0(2,15),=C'k)' @SC88092 03779000 LA 15,2(15) @SC88092 03779500 SR 2,2 @SC88092 03780000 ICM 2,1,ACTERR Get corresponding error code @SC91172 03780500 BZ DMPNN No error, that's fine @SC88092 03781000 SLL 2,2 @SC88092 03781500 A 2,=A(ERRTAB) Get ptr into error table @SC89215 03782000 SR 3,3 @SC88092 03782500 IC 3,0(2) Length of message @SC88092 03783000 L 2,0(2) And message ptr @SC88092 03783500 MVC 0(4,15),=C' -- ' @SC88092 03784000 MVC 4(50,15),0(2) Copy message @SC88092 03784500 LA 15,4(3,15) @SC88092 03785000 CLI ACTERR,ERRTRC Cancelled? @SC91172 03785500 BNE DMPNN No @SC91172 03786000 SR 1,1 @SC91172 03786500 CLI ACTREA,STACNN Within table? @SC91172 03787000 BH *+8 No, must be new @SC91172 03787500 IC 1,ACTREA Ok, get the complaint code @SC91172 03788000 SLL 1,3 Index into table @SC91172 03788500 A 1,=A(STACNTB) @SC91172 03789000 MVI 0(15),C' ' Leave a space @SC91172 03789500 MVC 1(8,15),0(1) Copy to message @SC91172 03790000 LA 15,9(,15) Length of items @SC91172 03790500 DMPNN BAL 2,STAPM15 Display name (+ error) @SC88092 03791000 A 5,FLFID1 Next filespec @SC88092 03791500 BCT 6,DMPNL @SC86295 03792000 LA 7,CMD Start of message buffer @SC91172 03792500 ICM 15,15,TRANEND Quitting time @SC92210 03793000 BAL 2,DMPTIM @SC91172 03793500 LR 15,7 @SC92300 03794000 INITSTR '&FINISHD' @SC92300 03794500 BAL 2,STAPM15 @SC91172 03795000 B RTRN0 @SC86295 03795500 DROP 5 @SC91172 03796000 * Display TOD from R15 as hh:mm:ss in buffer at R7; @SC91172 03796500 * return via R2; clobber R1,R4,R14,R15; update R7. @SC91172 03797000 DMPTIM LA 1,8 Length of output string @SC91172 03797500 BCTR 7,0 Allow for index to start at 1 @SC91172 03798000 SR 4,4 Clear divisor @SC91172 03798500 DMTLP IC 4,DVSR-1(1) Get next divisor @SC91172 03799000 LTR 4,4 See if time for a colon @SC91172 03799500 BNZ DMTDIG Not yet... @SC91172 03800000 LA 14,C':' Yes, put in colon @SC91172 03800500 B DMTSTOR @SC91172 03801000 DMTDIG SR 14,14 Set up next division @SC91172 03801500 DR 14,4 Get remainder for next digit @SC91172 03802000 LA 14,C'0'(,14) Convert to printable @SC91172 03802500 DMTSTOR STC 14,0(1,7) Store character in buffer @SC91172 03803000 BCT 1,DMTLP @SC91172 03803500 MVI 9(7),C' ' Leave a blank @SC91172 03804000 LA 7,10(,7) Space over string @SC91172 03804500 BR 2 @SC91172 03805000 DVSR DC AL1(6,10,0,6,10,0,6,10) @SC91172 03805500 * 03806000 DUMPCT LA 3,CTLTAB @SC93173 03806500 LA 7,160(,3) End of table @SC93173 03807000 B DUMPAEX @SC93173 03807500 DUMPA LA 3,ATOE @SC86156 03808000 B DUMPAE @SC86156 03808500 DUMPE LA 3,ETOA @SC86156 03809000 B DUMPAE @SC87117 03809500 DUMPTA LA 3,TATOE @SC87117 03810000 B DUMPAE @SC87117 03810500 DUMPTE LA 3,TETOA @SC87117 03811000 DUMPAE LA 7,256(,3) End of table @SC93173 03811500 DUMPAEX LA 4,4 Bytes per word @SC93173 03812000 LA 5,15(3) End of 1st line @SC86156 03812500 LA 6,16 Bytes per line @SC86156 03813000 DUMPLL LA 2,CMD Output buffer @SC86156 03813500 DUMPLW UNPK 0(9,2),0(5,3) Convert a word @SC86156 03814000 TR 0(8,2),TRHEX Hex notation @SC86156 03814500 MVI 8(2),C' ' Leave a space between words @SC86156 03815000 LA 2,9(2) @SC86156 03815500 BXLE 3,4,DUMPLW Do next word @SC86156 03816000 LA 1,CMD Done line of 4 @SC86156 03816500 LA 0,35 @SC86268 03817000 WTEXT (1),(0) Print it @SC86268 03817500 BXLE 5,6,DUMPLL Done line, go to next @SC86156 03818000 B RTRN0 03818500 SPACE 3 @SC91172 03819000 * Extra entry point for dumping TOD (in sec) from R0 into buf @SC91172 03819500 * at R1 and return updated buffer ptr in R15 @SC91172 03820000 DUMPTOD ENTER ALT @SC91172 03820500 LR 15,0 Time in sec @SC91172 03821000 LR 7,1 Buffer ptr @SC91172 03821500 BAL 2,DMPTIM Dump it @SC91172 03822000 LR 15,7 @SC91172 03822500 B RTRN @SC91172 03823000 TITLE 'GIVTAB Routine - save translation table' 03823500 * Save current values in STORAG into a TAKE file on disk 03824000 * Entry: SCANPTR string has option 03824500 * Exit: R15=0 if ok, R15=1 if error or help needed. ERRNUM set 03825000 * appropriately as long as command syntax is ok, else unchanged. 03825500 GIVTAB ENTER ALT @SC87117 03826000 NTOKN N=GIVH A or E? @SC87117 03826500 SCAN GIVKW,RTRN1 @SC87117 03827000 GIVH HELP GIVKW,RTRN1 @SC87117 03827500 * 03828000 GIVKW KW '&AAAATOE',GIVA @SC87117 03828500 KW '&CTRLCHR',GIVCTL @SC93173 03829000 KW '&AAAETOA',GIVE @SC87117 03829500 KW '&AATATOE',GIVTA,MIN=2 @SC87117 03830000 KW '&AATETOA',GIVTE,MIN=2 @SC87117 03830500 KW , @SC87117 03831000 * 03831500 GIVCTL LA 6,CTLTAB-1 Permission to transmit "as is" @SC93173 03832000 LA 0,=160X'01' Assume most are permitted @SC93173 03832500 LA161 LA 5,161 Length of table (+ 1) @SC93173 03833000 B GIVANY @SC93173 03833500 GIVA LA 6,ATOE-ATOE ATOE table is first in storage @SC90040 03834000 B GIVSET @SC90040 03834500 GIVE LA 6,ETOA-ATOE i.e., 256 @SC90040 03835000 GIVSET LR 7,1 Save ptr to cmd option @SC90040 03835500 XR 0,0 Quit if invalid pair @SC90040 03836000 L 1,CBUF @SC90040 03836500 KCALL TBLSET,E=RTRN1 Load base tables into CBUF @SC90040 03837000 LA 0,0(6,1) R0->base table @SC90040 03837500 LA 6,ATOE-1(6) R6->working table - 1 @SC90040 03838000 LR 1,7 R1->item in keywords list @SC90040 03838500 B GIVAE @SC90040 03839000 GIVTA LA 6,TATOE-1 @SC87117 03839500 GIVA1 LA 0,ATOED @SC87117 03840000 B GIVAE @SC87117 03840500 GIVTE LA 6,TETOA-1 @SC87117 03841000 GIVE1 LA 0,ETOAD @SC87117 03841500 GIVAE LA 5,257 Length of table (+ 1) @SC93173 03842000 GIVANY SR 15,15 @SC93173 03842500 IC 15,0(1) Get length of name @SC88298 03843000 INITSTR '&AAAASET',GIVBUF,REG=7 @SC92300 03843500 MVI 0(7),C' ' @SC92300 03844000 MVC 1(20,7),KWNAME(1) Copy name to command @SC93173 03844500 LA 15,2(15,7) @SC92300 03845000 MVI 0(15),C' ' @SC87117 03845500 LA 15,1(15) Get ptr for 1st argument @SC87117 03846000 LR 1,0 @SC87117 03846500 BCTR 0,0 Back up to start at "difference" @SC87117 03847000 STM 15,1,GIVSV Save ptrs: cmd, table, table start@SC87117 03847500 LR 7,5 Table length + 1 @SC93173 03848000 LA 0,FFGIV @SC87117 03848500 KCALL FSPEC,FILNAM,E=GIVFNE Error @SC87117 03849000 MVI ERRNUM,ERRNOE Ok now @SC87117 03849500 OPENF O,FILNAM,LOGFDB,GIVPTR,E=GIVOPERR @SC87117 03850000 CH 5,LA161+2 See if doing controls @SC93173 03850500 BNE GIVLP No, just start loop @SC93173 03851000 L 4,GIVSV @SC93173 03851500 MVC 0(,4),=CL1'&UNPREFD' First, set all unprefixed @SC93173 03852000 LA 15,1(,4) @SC93173 03852500 LA 2,GIVBUF @SC93173 03853000 SR 15,2 Length of line @SC93173 03853500 WRITF GIVPTR,BUFFER=(2),BSIZE=(15),E=GIVWRERR @SC93173 03854000 MVC 0(,4),=CL1'&PREFIXD' Then reset infividuals @SC93173 03854500 MVI 1(4),C' ' @SC93173 03855000 LA 4,2(,4) @SC93173 03855500 ST 4,GIVSV @SC93173 03856000 GIVLP LM 15,0,GIVSV Get output ptr, table scan ptr @SC87117 03856500 A 6,F1 Skip last difference @SC93173 03857000 A 0,F1 @SC93173 03857500 BCTR 7,0 New length left @SC87117 03858000 LR 1,7 Copy length @SC87117 03858500 CLCL 0,6 Find next difference @SC87117 03859000 BE GIVFIN All done @SC87117 03859500 ST 0,GIVSV+4 Save new ptr @SC87117 03860000 LR 4,0 Get offset @SC87117 03860500 S 4,GIVSV+8 @SC87117 03861000 BAL 2,EDDEC Write as decimal @SC87117 03861500 CH 5,LA161+2 Doing controls? @SC93173 03862000 BE GIVWRT Yes, skip value @SC93173 03862500 MVI 0(15),C' ' Leave space @SC87117 03863000 LA 15,1(15) @SC87117 03863500 IC 4,0(6) Get tailored character @SC87117 03864000 BAL 2,EDDEC Write as decimal @SC87117 03864500 GIVWRT DS 0H @SC93173 03865000 LA 2,GIVBUF @SC87117 03865500 SR 15,2 Length of line @SC87117 03866000 WRITF GIVPTR,BUFFER=(2),BSIZE=(15),E=GIVWRERR @SC87117 03866500 B GIVLP @SC87117 03867000 GIVWRERR CLOSF GIVPTR Close output file @SC87117 03867500 GIVOPERR PTEXT '&NOWRITE' @SC87117 03868000 GIVFNE WTEXT (3),(4) Show message @SC87117 03868500 B RTRN1 @SC87117 03869000 GIVFIN CLOSF GIVPTR,E=GIVOPERR Close output file @SC87117 03869500 B RTRN0 @SC86295 03870000 LOCALS , @SC86295 03870500 GIVSV DS 3F Saved ptrs for saving table @SC87117 03871000 GIVPTR DS A Ticket for disk I/O @SC87117 03871500 DS (MAXDOF)X Leave room for data offset @SC90264 03872000 GIVBUF DS CL25 Buffer for new file @SC87117 03872500 AIF ('&KTRACE' NE 'YES').NODUMTB @SC92169 03873000 ORG GIVSV @SC92169 03873500 DUMTBL DS (45*16)X @SC92169 03874000 .NODUMTB ANOP @SC92169 03874500 EXIT @SC86164 03875000 TITLE 'OPTPKT Routine - compute optimum packet size' @SC88325 03875500 * Entry: TINSV contains stack of data 03876000 * Exit: R15=0 if no limit, else optimum packet size 03876500 OPTPKT ENTER , @SC88325 03877000 LM 1,2,TINTOT Get byte count @SC88325 03877500 AL 2,TOUTOT+4 @SC88325 03878000 BC 12,*+8 @SC88092 03878500 AL 1,F1 @SC88325 03879000 AL 1,TOUTOT @SC88325 03879500 LM 3,4,PAKCNT Get packets, errors @SC88325 03880000 L 5,CSECTOT Get time (elapsed, if done) @SC88325 03880500 LM 6,9,TINSV 3rd-last snapshot @SC88325 03881000 MVC TINSV(32),TINSV+16 Shift snapshots back @SC88325 03881500 STM 2,5,TINSV+32 And insert latest @SC88325 03882000 LTR 4,4 Any errors ever? @SC88325 03882500 BZ RTRN0 No, use max buffer @SC88325 03883000 SLR 2,6 Get incremental counts: bytes, @SC88325 03883500 SR 3,7 ... packets, @SC88325 03884000 BP *+8 @SC89275 03884500 LA 3,1 Mustn't divide by 0! @SC89275 03885000 SR 4,8 ... errors, @SC88325 03885500 BP *+8 @SC88325 03886000 LA 4,1 Mustn't divide by 0! @SC88325 03886500 SR 5,9 ... and csec. @SC88325 03887000 BNM *+8 @SC88325 03887500 A 5,=F'1759218604' Wraps by 2**44/10000 @SC88325 03888000 LR 7,4 Save error count @SC88325 03888500 M 4,BAUD Total possible transmission @SC88325 03889000 C 4,=F'500' @SC88325 03889500 BNL RTRN0 @SC88325 03890000 D 4,=F'1000' Correct for 10 baud, 100 csec @SC88325 03890500 SR 5,2 Possible - actual @SC88325 03891000 BNP RTRN0 ?? @SC88325 03891500 MR 6,3 Errors * packets @SC88325 03892000 SLA 3,4 Packets * 16 (16 apprx 19) @SC88325 03892500 SR 2,3 Useful bytes @SC88325 03893000 LR 3,2 @SC88325 03893500 SLR 2,2 Prepare divide @SC88325 03894000 DR 2,7 @SC88325 03894500 MR 2,5 @SC88325 03895000 * Compute sq rt of value in (2,3), return in 15. Uses 2,3,4,5,14. 03895500 SQRT LR 14,2 Copy for sqrt @SC86345 03896000 LR 15,3 @SC86345 03896500 LA 4,31 Count bits @SC86345 03897000 SQRL1 CL 2,=XL4'10000000' @SC86345 03897500 BNL SQRL2 Justified now @SC86345 03898000 SLDL 2,2 Keep shifting @SC86345 03898500 BCT 4,SQRL1 @SC86345 03899000 SQRL2 LCR 4,4 @SC86345 03899500 AL 2,=XL4'10000000' 1st guess at sqrt @SC86345 03900000 SRDL 2,62(4) Shift back @SC86345 03900500 LTR 3,3 @SC86345 03901000 BNP SQRX Too small anyway @SC86345 03901500 LA 2,3 @SC86345 03902000 SQRL3 LR 4,14 @SC86345 03902500 LR 5,15 @SC86345 03903000 DR 4,3 Get next guess @SC86345 03903500 AR 3,5 @SC86345 03904000 SRA 3,1 @SC86345 03904500 BCT 2,SQRL3 @SC86345 03905000 SQRX LR 15,3 @SC86345 03905500 B RTRN @SC88325 03906000 LOCALS , @SC88325 03906500 EXIT , @SC88325 03907000 TITLE 'GENCMD Routine - send a Generic command' @SC86155 03907500 * Entry: SCANPTR has string 03908000 * Exit: R15=0 if ok, 1 if help needed, 2 if bad parameter 03908500 * ERRNUM set appropriately 03909000 GENCMD ENTER @SC86155 03909500 LA 8,1 One operand @SC86295 03910000 LTR 1,1 @SC86295 03910500 BZ REMCMD Parse REMOTE command @SC86295 03911000 LA 0,AG Packet type = generic command @SC86155 03911500 GENNUL SR 5,5 NO ARGUMENTS @SC86316 03912000 GENFILL STC 0,STYPE Set packet type @SC86155 03912500 L 3,RBUF Put string here @SC86155 03913000 CLI STYPE,AG Generic? @SC86155 03913500 BNE GENOTH1 No subcommand @SC86155 03914000 STC 1,0(3) Save subcommand byte @SC86155 03914500 LA 3,1(3) Move to next character position @SC86155 03915000 B GENOTH1 @SC86295 03915500 GENNXT NTOKN N=RTRN1 Get next argument @SC86295 03916000 LA 5,1(7) Length @SC86295 03916500 LR 4,6 Address @SC86295 03917000 GENOTH1 LTR 1,5 Any argument? @SC86155 03917500 BZ GENFILZ No, done @SC86155 03918000 CLI STYPE,AG Generic? @SC86155 03918500 BNE GENOTH2 No, skip length indicator @SC86155 03919000 TOCHR 1,,0(3) Yes, do it @SC86155 03919500 LA 3,1(3) @SC86155 03920000 GENOTH2 MVC 0(96,3),0(4) Copy argument @SC86155 03920500 LA 1,ETOA Current E-to-A @SC91284 03921000 CLC =C'&TRANSPA',TRNALF @SC91284 03921500 BNE *+8 @SC91284 03922000 LA 1,ETOAD Use default if "transparent" @SC91284 03922500 TR 0(96,3),0(1) in ASCII @SC91284 03923000 AR 3,5 Advance ptr @SC86155 03923500 BCT 8,GENNXT @SC86295 03924000 GENFILZ S 3,RBUF Length of buffer @SC86155 03924500 ST 3,RBUFL Set buffer size @SC86155 03925000 BAL 8,IPKSET Set state table, exchange parms @SC86155 03925500 DC AL1(AY),AL3(0) ACK'ed Must be just @SC86155 03926000 DC XL1'FF',AL3(GENRET) Stop these 3 @SC88074 03926500 DC AL1(00),AL3(GENAB3) Error items. @SC88074 03927000 BAL 8,GENSET Set state table @SC86155 03927500 * Server cmd Rpack interpret input table @SC86155 03928000 DC AL1(AY),AL3(0) ACK'ed @SC86155 03928500 DC AL1(AS),AL3(GENRPL) Long reply @SC86155 03929000 DC AL1(AX),AL3(GENRPX) Long reply already INIT @SC88074 03929500 DC AL1(AF),AL3(GENRPX) Long reply already INIT @SC88074 03930000 DC XL1'FF',AL3(GENRET) Stop @SC88074 03930500 DC AL1(00),AL3(GENAB3) Error @SC88074 03931000 GENSET BAL 9,ENCODEN Encode command @SC86295 03931500 BAL 9,INPUTSPK Send, get response @SC86295 03932000 MVI ERRNUM,ERRNOE No errors @SC86155 03932500 ICM 0,15,DATL Any short reply? @SC86155 03933000 BZ GENRET No, done @SC86155 03933500 NI FL1,255-EOF Yes, set flags @SC86155 03934000 XC WBUFL,WBUFL Clear old data @SC86155 03934500 OI LOGFLGS,APPN DISP=MOD @SC86295 03935000 BAL 2,GENRPS Set up file name @SC86295 03935500 OPENF O,FILNAM,LOGFDB,FILPTR,E=GENABR @SC89013 03936000 USING FDBD,1 @SC86295 03936500 L 0,FABLRTR Get effective record length @SC88120 03937000 ST 0,MAXOUT Save for folding (if need be) @SC88120 03937500 ST 0,FSIZE Copy LRECL @SC86295 03938000 MVC FRECF,FDBRCF Copy RECFM @SC86295 03938500 DROP 1 @SC86155 03939000 GENOPN KCALL DECODE,E=GENAB2 Copy message to output @SC86155 03939500 ICM 1,15,WBUFL Check length in buffer @SC88120 03940000 BE GENRPZ @SC86155 03940500 KCALL OUTBUF,E=GENAB2 Yes, copy that as well @SC86155 03941000 GENRPZ CLOSF FILPTR @SC86295 03941500 MVI ERRNUM,ERRNOE No errors @SC86155 03942000 B GENFIN @SC86295 03942500 * 03943000 GENRPX CLI BCTR,A1 This works only with 1-byte check @SC92085 03943500 BNE GENAB3 @SC88074 03944000 GENRPL DS 0H Long reply @SC88074 03944500 BAL 2,GENRPS Set up file name @SC86295 03945000 KCALL RECEIV @SC86155 03945500 B GENFIN @SC86155 03946000 * 03946500 GENRPS LA 0,L'REPNAM Name string length @SC86295 03947000 LA 1,REPNAM and address @SC86295 03947500 STM 0,1,SCANPTR @SC86295 03948000 LA 0,FFRCF @SC86295 03948500 KCALL FSPEC,FILNAM Convert to filespec @SC86295 03949000 IC 9,FL3 Save flags @SC86295 03949500 OI FL3,APPN Don't erase it @SC86295 03950000 BR 2 @SC86295 03950500 * 03951000 GENAB2 CLOSF FILPTR @SC86295 03951500 B GENABR @SC88074 03952000 GENAB3 IC 9,FL3 Save flags @SC88074 03952500 GENABR KCALL ERPACK @SC86155 03953000 GENFIN STC 9,FL3 Restore flags @SC86295 03953500 GENRET KCALL INTINI,0 @SC86155 03954000 B RTRN0 @SC86295 03954500 * 03955000 * Make foreign Kermit execute command 03955500 REMCMD NTOKN N=RTRN2 @SC86295 03956000 SCAN REMCMDKW,RTRN1 @SC86295 03956500 B RTRN2 @SC86295 03957000 * 03957500 REMCMDKW KW '&AAACOPY',REMREN,K,MIN=2 @SC91320 03958000 KW 'CWD',REMARG,C,MIN=3 @SC91320 03958500 KW '&AAAADIR',REMARG,D,MIN=3 @SC91320 03959000 KW '&AAERASE',REMARG,E @SC91320 03959500 KW '&AAAHELP',REMARG,H @SC91320 03960000 KW '&AAAHOST',REMKRM,C,MIN=2 @SC91320 03960500 KW 'KERMIT',REMKRM,K @SC91320 03961000 KW '&AAAMAIL',REMPRT,M @SC91320 03961500 KW '&AAPRINT',REMPRT,P @SC91320 03962000 KW '&ARENAME',REMREN,R @SC91320 03962500 KW '&AASPACE',REMARG,U,MIN=2 @SC91320 03963000 KW '&ASUBMIT',REMPRT,S,MIN=2 @SC91320 03963500 KW '&AAATYPE',REMARG,T,MIN=2 @SC91320 03964000 KW , @SC86155 03964500 * 03965000 REMKRM SR 15,15 @SC91320 03965500 IC 15,KWCODE(1) Get one-letter code @SC91320 03966000 IC 15,ETOAD(15) ASCIIify it @SC91320 03966500 LR 0,15 Use it in generic command @SC91320 03967000 REMPRS FTOKN N=RTRN1 See if anything given @SC86295 03967500 LR 4,7 @SC86295 03968000 LR 5,6 Use whole string @SC86295 03968500 B GENFILL @SC86295 03969000 * 03969500 REMREN LA 8,2 Copy or rename: two files @SC91320 03970000 * 03970500 REMARG SR 15,15 @SC91320 03971000 IC 15,KWCODE(1) Get one-letter code @SC91320 03971500 IC 15,ETOAD(15) ASCIIify it @SC91320 03972000 LR 1,15 Use it in generic command @SC91320 03972500 REMPRSG LA 0,AG (generic) @SC86155 03973000 NTOKN N=GENNUL Skip any blanks @SC86295 03973500 LA 5,1(7) Save length @SC86295 03974000 LR 4,6 Save ptr @SC86295 03974500 B GENFILL Copy to output @SC86155 03975000 * 03975500 REMPRT MVC REMPNM,KWNAME(1) Copy command name from table @SC90239 03976000 MVC REMPCD,KWCODE(1) Copy command code from table @SC91320 03976500 MVC REMLEN,KWLEN(1) And length-1 @SC90239 03977000 LA 0,FFSND @SC90239 03977500 KCALL FSPEC,IFILE,E=REMPFIL Get filespec @SC90239 03978000 BAL 9,WSP Skip to options, if any @SC90239 03978500 NOP 0 @SC90239 03979000 XC LEN,LEN Now hide the options @SC90239 03979500 CH 6,=H'70' Can we fit options into A-packet? @SC90239 03980000 BH REMPER Doesn't look good @SC90239 03980500 LTR 6,6 @SC90239 03981000 BNM *+6 @SC90239 03981500 SR 6,6 Don't allow negative count @SC90239 03982000 TM SCAPA,8 Attributes enabled @SC90239 03982500 BZ REMPNO No, can't do it @SC90239 03983000 TM ATFL2,ATFDSP Disposition attribute enabled? @SC90239 03983500 BZ REMPNO Can't do it @SC90239 03984000 LA 0,FFSND+FFRCF @SC90239 03984500 KCALL FSPEC,JFSPEC Default foreign filespec @SC90239 03985000 ST 6,LEN Restore length of options @SC90239 03985500 MVC MSNDPTR,MSNDBUF No extra files @SC90239 03986000 SR 1,1 @SC90239 03986500 IC 1,REMPCD Pass command code for attribute @SC91320 03987000 IC 1,ETOAD(1) (use ASCII version) @SC90239 03987500 KCALL SEND @SC90239 03988000 B RTRN0 @SC90239 03988500 * 03989000 REMPFIL WTEXT (3),(4) @SC90239 03989500 B RTRN1 Indicate kermit command error @SC90239 03990000 REMPNO WTEXT '&ATTRIBU &AZDISAB' @SC90239 03990500 B REMPCNT @SC90239 03991000 REMPER WTEXT '&MANYOPT' @SC90239 03991500 REMPCNT SR 14,14 @SC90239 03992000 IC 14,REMLEN Length-1 of command @SC90239 03992500 LA 0,L'REMMSG+1(,14) Length of explanation @SC90239 03993000 MVC REMMSG,=C'&CANNOT' @SC90239 03993500 WTEXT REMMSG,(0) @SC90239 03994000 B RTRN1 Indicate kermit command error @SC90239 03994500 LOCALS , @SC86295 03995000 REMLEN DS X Length-1 of command name @SC90239 03995500 REMMSG DS C'&CANNOT' @SC90239 03996000 REMPNM DS CL6 MAIL, PRINT, or SUBMIT @SC90239 03996500 REMPCD DS C M, P, or S @SC91320 03997000 REMCMD EXIT , @SC86155 03997500 TITLE 'TBLSET Routine - set up character set' @SC90040 03998000 * Define new translation tables 03998500 * Entry: Names of table in TRNALF and FILALF, R1->tables 03999000 * R0->item just changed, if any (else, 0) 03999500 * Tables should be a pair with ATOE first 04000000 * Exit: R15=0 if ok, R15=1 if error ERRNUM unchanged. 04000500 TBLSET ENTER , @SC90040 04001000 LR 9,1 Save ptr to pair of tables @SC90040 04001500 CLC TRNALF,=CL(LALF)'&TRANSPA' @SC91325 04002000 BE TBLNUL Special "set" - no translation @SC90250 04002500 LA 1,ATOE Usual table to fill @SC90040 04003000 CR 1,9 @SC90040 04003500 BNE *+8 Special case, don't enable attr. @SC90040 04004000 OI ATFL2,ATFENC Now allow Encoding attribute @SC90040 04004500 LA 5,TRNTBL Ptr to list @SC90040 04005000 LA 6,LTRNTBL @SC90040 04005500 LA 7,TRNTBLZ Ptr to end of list @SC90040 04006000 LA 1,TRNALF Ptr to transfer set name @SC90040 04006500 TBLLKP CLC 0(2*LALF,5),0(1) Compare both names @SC91325 04007000 BE TBLFND Got it! @SC90040 04007500 BXLE 5,6,TBLLKP @SC90040 04008000 LTR 0,0 Which char set just changed? @SC90040 04008500 BNZ TBLFIX Patch other to make valid combo @SC90040 04009000 TBLNFND WTEXT '&UNDEFTR' @SC90040 04009500 B RTRN1 @SC90040 04010000 * 04010500 TBLREP MVC TRNALF(2*LALF),0(5) Set up new table name @SC91325 04011000 * Enter here with R9->tables, R5->needed translation entry @SC90040 04011500 TBLFND MVC CDESPTR,2*LALF+16(5) Save char-set designator @SC91325 04012000 LR 1,9 Fill in ATOE table first @SC91325 04012500 LM 6,7,2*LALF(5) @SC91325 04013000 LTR 6,6 @SC91325 04013500 BM TBLSPEC Special translation type @SC91325 04014000 BAL 2,TBLCPY @SC90040 04014500 LA 1,256(,9) Fill in ETOA table second @SC90040 04015000 LM 6,7,2*LALF+8(5) @SC91325 04015500 BAL 2,TBLCPY @SC90040 04016000 MVC FILALF2,FILALF Actual set matches logical @SC91325 04016500 B RTRN0 @SC90040 04017000 * 04017500 TBLSPEC LR 8,7 R7->list of permitted char sets @SC91325 04018000 TBLSPL1 CLC FILALF2,0(8) See if actual file char set is ok @SC91325 04018500 BE TBLSPFN Yes, all done @SC91325 04019000 LA 8,LALF(,8) Not this one, keep checking @SC91325 04019500 CLI 0(8),0 End of list? @SC91325 04020000 BNE TBLSPL1 No, keep looking @SC91325 04020500 MVC FILALF,0(7) Yes, switch to 1st in list @SC91325 04021000 LA 0,FILALF Indicate the file set is changed @SC91325 04021500 KCALL TBLSET Fill in tables (R1->ATOE already) @SC91325 04022000 MVC TRNALF(2*LALF),0(5) Restore logical char sets @SC91325 04022500 MVC CDESPTR,2*LALF+16(5) Resave char-set designator @SC91325 04023000 TBLSPFN DS 0H @SC91325 04023500 B RTRN0 @SC91325 04024000 * 04024500 TBLFIX LA 5,TRNTBL Ptr to list again @SC90040 04025000 CR 0,1 Giving precedence to transfer set?@SC90040 04025500 BNE TBLLKF No, insist on file set @SC90040 04026000 TBLLKT CLC 0(LALF,5),0(1) Compare just transfer set @SC91325 04026500 BE TBLREP First such entry selects file set @SC90040 04027000 BXLE 5,6,TBLLKT @SC90040 04027500 TBLLKF CLC LALF(LALF,5),LALF(1) Compare just file set @SC91325 04028000 BNE TBLLKFZ Keep looking @SC90040 04028500 ICM 0,15,LTRNTBL-4(5) Any preferred transfer set? @SC90040 04029000 BM TBLREP Yes, this very one @SC90040 04029500 TBLLKFZ BXLE 5,6,TBLLKF @SC90040 04030000 B TBLNFND Something bizarre happened @SC90040 04030500 * 04031000 * Make both tables null translators: at R9 and R9 + 256 @SC90250 04031500 TBLNUL NI ATFL2,255-ATFENC Suppress Encoding attribute @SC90250 04032000 LA 7,255 @SC90250 04032500 STC 7,0(7,9) Fill with self mapping @SC90250 04033000 BCT 7,*-4 @SC90250 04033500 MVI 0(9),0 Also map NULL to NULL @SC90250 04034000 MVC 256(256,9),0(9) and copy to 2nd table @SC90250 04034500 B RTRN0 @SC90250 04035000 * 04035500 * Entry: R6->Designator string, R7=length @SC90040 04036000 * Exit: Correct table set up and R15=0 if ok, else 1 @SC90040 04036500 TBLATT ENTER ALT @SC90040 04037000 LA 1,TBLDS Start of designator list @SC90040 04037500 SR 3,3 @SC90040 04038000 TBLALP ICM 3,1,4(1) Get length of next item in list @SC90040 04038500 BZ RTRN1 End. String not found @SC90040 04039000 CR 3,7 Right length? @SC90040 04039500 BNE TBLALQ No, keep looking @SC90040 04040000 LR 4,3 Get length for EX @SC90040 04040500 BCTR 4,0 @SC90040 04041000 EX 4,TBLACLC Strings match? @SC90040 04041500 BNE TBLALQ No, keep looking @SC90040 04042000 ICM 5,15,0(1) Yes, get table pointer @SC90040 04042500 LR 6,5 Set to scan through tables @SC90040 04043000 TBLAFLP CLC 0(LALF,6),0(5) See if still same transfer set @SC91325 04043500 BNE TBLAFND No, use default ??? @SC90040 04044000 CLC FILALF,LALF(6) See if found right local set @SC91325 04044500 BE TBLAFNO Yes, use this table @SC90040 04045000 LA 6,LTRNTBL(,6) No, try next @SC90040 04045500 B TBLAFLP @SC90040 04046000 TBLAFNO LR 5,6 @SC90040 04046500 TBLAFND CLC TRNALF(2*LALF),0(5) Already have this table? @SC91325 04047000 BE RTRN0 Yes, all done @SC90040 04047500 MVC TRNALF(2*LALF),0(5) Set up new table name @SC91325 04048000 LA 9,ATOE Set ptr to working tables @SC90040 04048500 B TBLFND Adopt table @SC90040 04049000 TBLALQ LA 1,5(3,1) @SC90040 04049500 B TBLALP @SC90040 04050000 TBLACLC CLC 0(,6),5(1) Compare against list item @SC90040 04050500 * 04051000 * Copy info into table: basic stuff + any "corrections" @SC90040 04051500 * R1->table, R6->basic stuff, R7->corrections, if any @SC90040 04052000 * R9->ATOE table @SC90250 04052500 TBLCPY LTR 6,6 @SC90040 04053000 BZ TBLCPI No EtoA table - just invert AtoE @SC90040 04053500 MVC 0(256,1),0(6) Basic pattern @SC90040 04054000 LTR 7,7 Ptr to modification list @SC90040 04054500 BZR 2 No list @SC90040 04055000 SR 6,6 @SC90040 04055500 TBLCPL ICM 6,1,0(7) Get offset into table @SC90040 04056000 BZR 2 End of list @SC90040 04056500 IC 0,1(,7) Get changed value @SC90040 04057000 STC 0,0(6,1) @SC90040 04057500 LA 7,2(,7) @SC90040 04058000 B TBLCPL @SC90040 04058500 TBLCPI SR 7,7 Clear work regs. @SC90040 04059000 XC 0(256,1),0(1) Clear out table @SC90040 04059500 LA 7,255 @SC90040 04060000 TBLCPIL IC 6,0(7,9) Get EBCDIC for (7) @SC90250 04060500 STC 7,0(6,1) And store inverse @SC90040 04061000 BCT 7,TBLCPIL Do all but NULL @SC90040 04061500 IC 6,0(7,9) Get EBCDIC for NULL @SC90250 04062000 STC 7,0(6,1) And store inverse @SC90250 04062500 BR 2 @SC90040 04063000 * 04063500 * Format is: CL(LALF)'transfer',CL(LALF)'local' @SC91325 04064000 * A(t-to-l,adjusts,l-to-t,adjusts,designator,flag) @SC90040 04064500 * if any or 0 if any @SC90040 04065000 * Items should be grouped by transfer set, default 1st @SC90040 04065500 * Flag is -1 in exactly one entry for each possible file set, @SC90040 04066000 * but flag is 0 for any others. "-1" marks preferred entry. @SC90040 04066500 TRNTBL DS 0F Table of translations @SC90040 04067000 DC CL(LALF)'ASCII',CL(LALF)'EBCDIC' *** Default ***@SC91325 04067500 DC A(ATOED,0,ETOAD,0,0,0) @SC90040 04068000 LTRNTBL EQU *-TRNTBL Item length @SC91325 04068500 DC CL(LALF)'ASCII',CL(LALF)'CP037' @SC91325 04069000 DC A(ATOED,ASE37F,ETOAD,0,0,0) @SC90040 04069500 DC CL(LALF)'ASCII',CL(LALF)'CP500' @SC91325 04070000 DC A(ATOED,ASE5F,ETOAD,0,0,0) @SC90040 04070500 DC CL(LALF)'ASCII',CL(LALF)'DKOI' @SC91325 04071000 DC A(CYTODKOI,ASDKF,DKOITOAS,0,0,0) @SC90040 04071500 DC CL(LALF)'ASCII',CL(LALF)'CP880' @SC91325 04072000 DC A(CYTODKOI,ASDKF,DKOITOAS,E880ASF,0,0) @SC90271 04072500 TRNTNCY DC CL(LALF)'&CYRILLC',CL(LALF)'DKOI' USSR @SC91325 04073000 DC A(CYTODKOI,0,0,0,TBLDSCY,-1) @SC90040 04073500 DC CL(LALF)'&CYRILLC',CL(LALF)'CP880' USSR @SC91325 04074000 DC A(CYTODKOI,CYE880F,0,0,TBLDSCY,-1) @SC90152 04074500 TRNTNAR DC CL(LALF)'ARABIC',CL(LALF)'CP420' Arabic @SC93027 04075000 DC A(ARTOE420,0,0,0,TBLDSAR,-1) @SC93027 04075500 TRNTNL1 DC CL(LALF)'LATIN1',CL(LALF)'EBCDIC' Default L1 @SC91325 04076000 DC A(L1TOE,0,0,0,TBLDSL1,-1) @SC90040 04076500 TRNTNCA DC CL(LALF)'LATIN1',CL(LALF)'CP037' US, etc @SC91325 04077000 DC A(L1TOE,L1E37F,0,0,TBLDSL1,-1) @SC90040 04077500 TRNTNDE DC CL(LALF)'LATIN1',CL(LALF)'CP273' Germany @SC91325 04078000 DC A(L1TOE,L1E273F,0,0,TBLDSL1,-1) @SC90040 04078500 TRNTNBR DC CL(LALF)'LATIN1',CL(LALF)'CP275' Brazil @SC91325 04079000 DC A(L1TOE,L1E275F,0,0,TBLDSL1,-1) @SC90040 04079500 TRNTNDK DC CL(LALF)'LATIN1',CL(LALF)'CP277' Denmark, Norway@SC91325 04080000 DC A(L1TOE,L1E277F,0,0,TBLDSL1,-1) @SC90040 04080500 TRNTNSE DC CL(LALF)'LATIN1',CL(LALF)'CP278' Finland, Sweden@SC91325 04081000 DC A(L1TOE,L1E278F,0,0,TBLDSL1,-1) @SC90040 04081500 TRNTNIT DC CL(LALF)'LATIN1',CL(LALF)'CP280' Italy @SC91325 04082000 DC A(L1TOE,L1E280F,0,0,TBLDSL1,-1) @SC90040 04082500 TRNTNJR DC CL(LALF)'LATIN1',CL(LALF)'CP281' Japan @SC91325 04083000 DC A(L1TOE,L1E281F,0,0,TBLDSL1,-1) @SC91325 04083500 TRNTNPT DC CL(LALF)'LATIN1',CL(LALF)'CP282' Portugal @SC91325 04084000 DC A(L1TOE,L1E282F,0,0,TBLDSL1,-1) @SC90040 04084500 TRNTNES DC CL(LALF)'LATIN1',CL(LALF)'CP284' Spain @SC91325 04085000 DC A(L1TOE,L1E284F,0,0,TBLDSL1,-1) @SC90040 04085500 TRNTNUK DC CL(LALF)'LATIN1',CL(LALF)'CP285' UK @SC91325 04086000 DC A(L1TOE,L1E285F,0,0,TBLDSL1,-1) @SC90040 04086500 TRNTNFR DC CL(LALF)'LATIN1',CL(LALF)'CP297' France @SC91325 04087000 DC A(L1TOE,L1E297F,0,0,TBLDSL1,-1) @SC90040 04087500 TRNTNBE DC CL(LALF)'LATIN1',CL(LALF)'CP500' Belgium, etc @SC91325 04088000 DC A(L1TOE,L1E5F,0,0,TBLDSL1,-1) @SC90040 04088500 TRNTNIS DC CL(LALF)'LATIN1',CL(LALF)'CP871' Iceland @SC91325 04089000 DC A(L1TOE,L1E871F,0,0,TBLDSL1,-1) @SC90040 04089500 TRNTNL2 DC CL(LALF)'LATIN2',CL(LALF)'CP870' Yugoslavia @SC91325 04090000 DC A(L2TOE870,0,0,0,TBLDSL2,-1) @SC90152 04090500 TRNTNCZ DC CL(LALF)'LATIN2',CL(LALF)'&CZECH' Czechoslovakia@SC91325 04091000 DC A(L2TOE870,L2ECZF,0,0,TBLDSL2,-1) @SC90152 04091500 TRNTNL3 DC CL(LALF)'LATIN3',CL(LALF)'CP905' Turkey @SC91325 04092000 DC A(L3TOE905,0,0,0,TBLDSL3,-1) @SC90152 04092500 TRNTNGR DC CL(LALF)'&AAGREEK',CL(LALF)'CP875' Greece @SC91325 04093000 DC A(GRTOE875,0,0,0,TBLDSGR,-1) @SC90040 04093500 TRNTNIL DC CL(LALF)'&HEBREW',CL(LALF)'CP424' Israel @SC91325 04094000 DC A(L8TOE424,0,0,0,TBLDSHE,-1) @SC90040 04094500 TRNTNTH DC CL(LALF)'THAI',CL(LALF)'CP838' Thailand @SC92233 04095000 DC A(THTOE838,0,0,0,TBLDSTH,-1) @SC92233 04095500 TRNTNKN DC CL(LALF)'&JAPNEUC',CL(LALF)'&KNJDEF.-KANJI' @SC91325 04096000 DC A(-1,TBVJP&KNJLAB,0,0,TBLDSKN,-1) @SC91325 04096500 AIF ('&KNJLAB' EQ 'F').TRNTHIT @SC91325 04097000 DC CL(LALF)'&JAPNEUC',CL(LALF)'FUJITSU-KANJI' @SC91325 04097500 DC A(-1,TBVJPF,0,0,TBLDSKN,-1) @SC91325 04098000 .TRNTHIT AIF ('&KNJLAB' EQ 'H').TRNTIBM @SC91325 04098500 DC CL(LALF)'&JAPNEUC',CL(LALF)'HITACHI-KANJI' @SC91325 04099000 DC A(-1,TBVJPH,0,0,TBLDSKN,-1) @SC91325 04099500 .TRNTIBM AIF ('&KNJLAB' EQ 'I').TRNTKZ @SC91325 04100000 DC CL(LALF)'&JAPNEUC',CL(LALF)'IBM-KANJI' @SC91325 04100500 DC A(-1,TBVJPI,0,0,TBLDSKN,-1) @SC91325 04101000 .TRNTKZ ANOP @SC91325 04101500 TRNTNJP EQU * @SC91325 04102000 AIF ('&KNJLAB' EQ 'H').TRNTK1H @SC91325 04102500 DC CL(LALF)'KATAKANA',CL(LALF)'CP290' Japan @SC91325 04103000 DC A(KATOE290,0,0,0,TBLDSKA,-1) @SC91325 04103500 .TRNTK1H DC CL(LALF)'KATAKANA',CL(LALF)'H-EBCDIK-DASH' Japan@SC91325 04104000 DC A(KATOHEBK,0,0,0,TBLDSKA,-1) @SC91325 04104500 AIF ('&KNJLAB' NE 'H').TRNTK2H @SC91325 04105000 DC CL(LALF)'KATAKANA',CL(LALF)'CP290' Japan @SC91325 04105500 DC A(KATOE290,0,0,0,TBLDSKA,-1) @SC91325 04106000 .TRNTK2H ANOP @SC91325 04106500 TRNTBLZ EQU *-LTRNTBL @SC91325 04107000 * 04107500 * List of transfer character set designators @SC90040 04108000 TBLDS EQU * @SC90040 04108500 TBLDSAR DC AL4(TRNTNAR),AL1(6,AI,A6,ASL,A1,A2,A7) I6/127 @SC93027 04109000 TBLDSCY DC AL4(TRNTNCY),AL1(6,AI,A6,ASL,A1,A4,A4) I6/144 @SC90040 04109500 TBLDSGR DC AL4(TRNTNGR),AL1(6,AI,A6,ASL,A1,A2,A6) I6/126 @SC90040 04110000 TBLDSHE DC AL4(TRNTNIL),AL1(6,AI,A6,ASL,A1,A3,A8) I6/138 @SC90040 04110500 TBLDSKA DC AL4(TRNTNJP),AL1(6,AI,A1,A4,ASL,A1,A3) I14/13 @SC90040 04111000 TBLDSKN DC AL4(TRNTNKN),AL1(9,AI,A1,A4,ASL,A8,A7,ASL,A1,A3) SC91325 04111500 DC AL4(TRNTNKN),AL1(7,AI,A1,A4,ASL,A8,A7,AE) I14/87E *TEMP* 04112000 TBLDSL1 DC AL4(TRNTNL1),AL1(6,AI,A6,ASL,A1,A0,A0) I6/100 @SC90040 04112500 DC AL4(TRNTNL1),AL1(6,AI,A2,ASL,A1,A0,A0) **TEMP** @SC90040 04113000 TBLDSL2 DC AL4(TRNTNL2),AL1(6,AI,A6,ASL,A1,A0,A1) I6/101 @SC90152 04113500 TBLDSL3 DC AL4(TRNTNL3),AL1(6,AI,A6,ASL,A1,A0,A9) I6/109 @SC90152 04114000 TBLDSTH DC AL4(TRNTNTH),AL1(6,AI,A6,ASL,A1,A6,A6) I6/166 @SC92233 04114500 DC XL5'0' End of table @SC90040 04115000 * 04115500 * Lists of file char-sets to go with complex translations @SC91325 04116000 TBVJPH DC CL(LALF)'H-EBCDIK-DASH' @SC91325 04116500 TBVJPF EQU * @SC91325 04117000 TBVJPI EQU * @SC91325 04117500 TBVJP DC CL(LALF)'CP290',CL(LALF)'CP500',CL(LALF)'CP281' @SC91325 04118000 DC CL(LALF)'H-EBCDIK-DASH' @SC91325 04118500 DC X'00' @SC91325 04119000 LOCALS , @SC90040 04119500 TBLSET EXIT , @SC90040 04120000 TRNTBLD CSECT @SC90040 04120500 * 04121000 * Corrections: ASCII -> DKOI @SC90040 04121500 * ref: Konstantin Vinogradov (ICSTI) @SC90040 04122000 ASDKF HTBL 60B8,61B9,62BA,63BB,64BC,65BD @SC90271 04122500 DC X'66BE',X'67BF',X'68CA',X'69CB',X'6ACC',X'6BCD' @SC90040 04123000 DC X'6CCE',X'6DCF',X'6EDA',X'6FDB',X'70DC',X'71DD' @SC90040 04123500 DC X'72DE',X'73DF',X'74EA',X'75EB',X'76EC',X'77ED' @SC90040 04124000 DC X'78EE',X'79EF',X'7AFA',X'7BFB',X'7CFC',X'7DFD' @SC90040 04124500 HTBL 7EFE,00 @SC90271 04125000 * 04125500 * Corrections: LATIN1 -> CP 037 @SC90040 04126000 * ref: Andre Pirard (U Liege) @SC90040 04126500 L1E37F DC X'AC5F',X'DDAD',X'A8BD' @SC90040 04127000 ASE37F DC X'5BBA',X'5DBB',X'5EB0',X'0' @SC90040 04127500 * 04128000 * Corrections: LATIN1 -> CP 273 @SC90040 04128500 * ref: Andre Pirard (U Liege) @SC90040 04129000 L1E273F DC X'214F',X'40B5',X'5B63',X'5CEC',X'5DFC',X'7B43' @SC90040 04129500 DC X'7CBB',X'7DDC',X'7E59',X'A2B0',X'A6CC',X'A77C' @SC90040 04130000 DC X'A8BD',X'ACBA',X'C44A',X'D6E0',X'DC5A',X'DDAD' @SC90040 04130500 DC X'DFA1',X'E4C0',X'F66A',X'FCD0',X'0' @SC90040 04131000 * 04131500 * Corrections: LATIN1 -> CP 275 @SC90040 04132000 * ref: About Type (IBM S544-3516-02) @SC90040 04132500 L1E275F DC X'214F',X'23EF',X'245A',X'4066',X'5B71',X'5D68' @SC90040 04133000 DC X'6046',X'7BCF',X'7CBB',X'7D51',X'A2B0',X'A648' @SC90040 04133500 DC X'A8BD',X'ACBA',X'C37B',X'C75B',X'C94A',X'D57C' @SC90040 04134000 DC X'DDAD',X'E379',X'E76A',X'E9D0',X'F5C0',X'0' @SC90040 04134500 * 04135000 * Corrections: LATIN1 -> CP 277 @SC90040 04135500 * ref: Andre Pirard (U Liege) @SC90040 04136000 L1E277F DC X'214F',X'234A',X'2467',X'4080',X'5B9E',X'5D9F' @SC90040 04136500 DC X'7B9C',X'7CBB',X'7D47',X'7EDC',X'A2B0',X'A45A' @SC90040 04137000 DC X'A670',X'A8BD',X'ACBA',X'C55B',X'C67B',X'D87C' @SC90040 04137500 DC X'DDAD',X'E5D0',X'E6C0',X'F86A',X'FCA1',X'0' @SC90040 04138000 * 04138500 * Corrections: LATIN1 -> CP 278 @SC90040 04139000 * ref: Andre Pirard (U Liege) @SC90040 04139500 L1E278F DC X'214F',X'2363',X'2467',X'40EC',X'5BB5',X'5C71' @SC90040 04140000 DC X'5D9F',X'6051',X'7B43',X'7CBB',X'7D47',X'7EDC' @SC90040 04140500 DC X'A2B0',X'A45A',X'A6CC',X'A74A',X'A8BD',X'ACBA' @SC90040 04141000 DC X'C47B',X'C55B',X'C9E0',X'D67C',X'DDAD',X'E4C0' @SC90040 04141500 DC X'E5D0',X'E979',X'F66A',X'FCA1',X'0' @SC90040 04142000 * 04142500 * Corrections: LATIN1 -> CP 280 @SC90040 04143000 * ref: Andre Pirard (U Liege) @SC90040 04143500 L1E280F DC X'214F',X'23B1',X'40B5',X'5B90',X'5C48',X'5D51' @SC90040 04144000 DC X'60DD',X'7B44',X'7CBB',X'7D54',X'7E58',X'A2B0' @SC90040 04144500 DC X'A37B',X'A6CD',X'A77C',X'A8BD',X'ACBA',X'B04A' @SC90040 04145000 DC X'DDAD',X'E0C0',X'E7E0',X'E8D0',X'E95A',X'ECA1' @SC90040 04145500 DC X'F26A',X'F979',X'0' @SC90040 04146000 * 04146500 * Corrections: LATIN1 -> CP 281 @SC91325 04147000 * ref: IBM C-H 3-220-050 (1989) @SC91325 04147500 L1E281F HTBL 24E0,5BB1,5CB2,5DBB,5EBA,7EBC,A2B0,A34A,A55B @SC91325 04148000 HTBL A8BD,AC5F,AFA1,DDAD,00 @SC91325 04148500 * 04149000 * Corrections: LATIN1 -> CP 282 @SC90040 04149500 * ref: About Type (IBM S544-3516-02) @SC90040 04150000 L1E282F DC X'214F',X'2366',X'40EF',X'5B4A',X'5C68',X'5D5A' @SC90040 04150500 DC X'7B46',X'7CBB',X'7DBE',X'7E48',X'A2B0',X'A6CF' @SC90040 04151000 DC X'A8BD',X'ACBA',X'B4D0',X'C37B',X'C7E0',X'D57C' @SC90040 04151500 DC X'DDAD',X'E3C0',X'E7A1',X'F56A',X'0' @SC90040 04152000 * 04152500 * Corrections: LATIN1 -> CP 284 @SC90040 04153000 * ref: Andre Pirard (U Liege) @SC90040 04153500 L1E284F DC X'21BB',X'2369',X'5B4A',X'5D5A',X'5EBA',X'7EBD' @SC90040 04154000 DC X'A2B0',X'A649',X'A8A1',X'AC5F',X'D17B',X'DDAD' @SC90040 04154500 DC X'F16A',X'0' @SC90040 04155000 * 04155500 * Corrections: LATIN1 -> CP 285 @SC90040 04156000 * ref: Andre Pirard (U Liege) @SC90040 04156500 L1E285F DC X'244A',X'5BB1',X'5DBB',X'5EBA',X'7EBC',X'A2B0' @SC90040 04157000 DC X'A35B',X'A8BD',X'AC5F',X'AFA1',X'DDAD',X'0' @SC90040 04157500 * 04158000 * Corrections: LATIN1 -> CP 297 @SC90040 04158500 * ref: Andre Pirard (U Liege) @SC90040 04159000 L1E297F DC X'214F',X'23B1',X'4044',X'5B90',X'5C48',X'5DB5' @SC90040 04159500 DC X'60A0',X'7B51',X'7CBB',X'7D54',X'7EBD',X'A2B0' @SC90040 04160000 DC X'A37B',X'A6DD',X'A75A',X'A8A1',X'ACBA',X'B04A' @SC90040 04160500 DC X'B579',X'DDAD',X'E07C',X'E7E0',X'E8D0',X'E9C0' @SC90040 04161000 DC X'F96A',X'0' @SC90040 04161500 * 04162000 * Corrections: LATIN1 -> CP 500 @SC90040 04162500 * ref: Andre Pirard (U Liege) @SC90040 04163000 L1E5F DC X'A2B0',X'A8BD',X'ACBA',X'DDAD' @SC90040 04163500 ASE5F DC X'214F',X'5B4A',X'5D5A',X'7CBB',X'0' @SC90040 04164000 * 04164500 * Corrections: LATIN1 -> CP 871 @SC90040 04165000 * ref: About Type (IBM S544-3516-02) @SC90040 04165500 L1E871F DC X'214F',X'40AC',X'5BAE',X'5CBE',X'5D9E',X'5EEC' @SC90040 04166000 DC X'608C',X'7B8E',X'7CBB',X'7D9C',X'7ECC',X'A2B0' @SC90040 04166500 DC X'A8BD',X'ACBA',X'B4E0',X'C65A',X'D07C',X'D65F' @SC90040 04167000 DC X'DDAD',X'DE4A',X'E6D0',X'F079',X'F6A1',X'FEC0' @SC90040 04167500 DC X'0' @SC90040 04168000 * 04168500 * Corrections: CYRILLIC -> CP 880 @SC90152 04169000 * ref: 3174 Character Set Reference (IBM GA27-3831-02)@SC90152 04169500 CYE880F HTBL A163,A259,A362,A464,A565,A666,A767,A868,A969 @SC90152 04170000 HTBL AA70,AB71,AC72,AD73,AE74,AF75,CA57,F144,F242 @SC90152 04170500 HTBL F343,F445,F546,F647,F748,F849,F951,FA52,FB53 @SC90152 04171000 HTBL FC54,FD55,FEFF,FF56,00 @SC90152 04171500 * 04172000 * Corrections: LATIN2 -> CZECH @SC90152 04172500 * ref: Konstantin Vinogradov (ICSTI) @SC90152 04173000 L2ECZF HTBL A178,A243,A465,A5CE,A671,A8B8,A9DF,AA75,ABEA @SC90152 04173500 HTBL ACAE,ADEE,AEFA,B054,B167,B263,B355,B4EC,B59B @SC90152 04174000 HTBL B645,B858,B9AB,BA51,BBAC,BEB2,BF8D,C0BE,C1B9 @SC90152 04174500 HTBL C4DD,C5CD,C8BB,C9ED,CCBD,CDCB,CFBC,D074,D1B6 @SC90152 04175000 HTBL D2DA,D3DB,D4DC,D5FE,D6CF,D8DE,D9CC,DAEB,DCCA @SC90152 04175500 HTBL DDEF,E08C,E177,E4A0,E59A,E880,E9AF,EC8B,ED8F @SC90152 04176000 HTBL EF8A,F047,F157,F29D,F39E,F49F,F5FC,F69C,F8AA @SC90152 04176500 HTBL F990,FAAD,FBFD,FC8E,FDB1,00 @SC90152 04177000 * 04177500 L1TOE EQU * LATIN1 to EBCDIC @SC90040 04178000 * ref: composite @SC90040 04178500 * 0 1 2 3 4 5 6 7 8 9 A B C D E F @SC90040 04179000 HTBL 00,01,02,03,37,2D,2E,2F,16,05,25,0B,0C,0D,0E,0F 0 C90040 04179500 HTBL 10,11,12,13,3C,3D,32,26,18,19,3F,27,1C,1D,1E,1F 1 C90040 04180000 HTBL 40,5A,7F,7B,5B,6C,50,7D,4D,5D,5C,4E,6B,60,4B,61 2 C90040 04180500 HTBL F0,F1,F2,F3,F4,F5,F6,F7,F8,F9,7A,5E,4C,7E,6E,6F 3 C90040 04181000 HTBL 7C,C1,C2,C3,C4,C5,C6,C7,C8,C9,D1,D2,D3,D4,D5,D6 4 C90040 04181500 HTBL D7,D8,D9,E2,E3,E4,E5,E6,E7,E8,E9,AD,E0,BD,5F,6D 5 C90040 04182000 HTBL 79,81,82,83,84,85,86,87,88,89,91,92,93,94,95,96 6 C90040 04182500 HTBL 97,98,99,A2,A3,A4,A5,A6,A7,A8,A9,C0,4F,D0,A1,07 7 C90040 04183000 HTBL 20,21,22,23,24,15,06,17,28,29,2A,2B,2C,09,0A,1B 8 C90040 04183500 HTBL 30,31,1A,33,34,35,36,08,38,39,3A,3B,04,14,3E,FF 9 C90040 04184000 HTBL 41,AA,4A,B1,9F,B2,6A,B5,BB,B4,9A,8A,B0,CA,AF,BC A C90040 04184500 HTBL 90,8F,EA,FA,BE,A0,B6,B3,9D,DA,9B,8B,B7,B8,B9,AB B C90040 04185000 HTBL 64,65,62,66,63,67,9E,68,74,71,72,73,78,75,76,77 C C90040 04185500 HTBL AC,69,ED,EE,EB,EF,EC,BF,80,FD,FE,FB,FC,BA,AE,59 D C90040 04186000 HTBL 44,45,42,46,43,47,9C,48,54,51,52,53,58,55,56,57 E C90040 04186500 HTBL 8C,49,CD,CE,CB,CF,CC,E1,70,DD,DE,DB,DC,8D,8E,DF F C90040 04187000 * 04187500 ARTOE420 EQU * Arabic ISO (+CP864) to CP420 @SC93027 04188000 * ref: IBM code page registry @SC93027 04188500 * 0 1 2 3 4 5 6 7 8 9 A B C D E F @SC93027 04189000 HTBL 00,01,02,03,37,2D,2E,2F,16,05,25,0B,0C,0D,0E,0F 0 C93027 04189500 HTBL 10,11,12,13,3C,3D,32,26,18,19,3F,27,1C,1D,1E,1F 1 C93027 04190000 HTBL 40,5A,7F,7B,5B,6C,50,7D,4D,5D,5C,4E,6B,60,4B,61 2 C93027 04190500 HTBL F0,F1,F2,F3,F4,F5,F6,F7,F8,F9,7A,5E,4C,7E,6E,6F 3 C93027 04191000 HTBL 7C,C1,C2,C3,C4,C5,C6,C7,C8,C9,D1,D2,D3,D4,D5,D6 4 C93027 04191500 HTBL D7,D8,D9,E2,E3,E4,E5,E6,E7,E8,E9,53,54,B6,B7,6D 5 C93027 04192000 HTBL CC,81,82,83,84,85,86,87,88,89,91,92,93,94,95,96 6 C93027 04192500 HTBL 97,98,99,A2,A3,A4,A5,A6,A7,A8,A9,CE,4F,E1,EC,07 7 C93027 04193000 HTBL 09,0A,14,1B,2C,20,21,2A,28,29,06,17,24,15,22,23 8 C93027 04193500 HTBL 30,31,1A,33,34,35,36,08,38,B4,B5,3B,04,B8,B9,45 9 C93027 04194000 HTBL 41,68,48,FA,FF,51,2B,39,57,59,63,65,79,CA,69,71 A C93027 04194500 HTBL DF,EA,EB,ED,EE,EF,FB,FC,FD,FE,AB,C0,77,80,8B,D0 B C93027 04195000 HTBL 4A,46,47,49,52,9B,55,56,58,62,64,66,67,70,72,73 C C93027 04195500 HTBL 74,75,76,78,8A,8C,8E,8F,90,9C,A0,6A,5F,A1,E0,9A D C93027 04196000 HTBL 44,AC,AE,B0,BA,BC,BE,CB,CF,DA,DE,8D,9D,9F,9E,BB E C93027 04196500 HTBL 43,42,BD,BF,CD,DB,DD,AA,AD,B2,B3,B1,AF,DC,3E,3A F C93027 04197000 * 04197500 DKOITOAS EQU * DKOI (EBCDIC) to ASCII @SC90040 04198000 * ref: Konstantin Vinogradov (ICSTI) @SC90040 04198500 * 0 1 2 3 4 5 6 7 8 9 A B C D E F @SC90040 04199000 HTBL 00,01,02,03,1C,09,06,7F,17,0D,0E,0B,0C,0D,0E,0F 0 C90271 04199500 HTBL 10,11,12,13,1D,05,08,07,18,19,12,0F,1C,1D,1E,1F 1 C90271 04200000 HTBL 00,01,02,03,04,0A,17,1B,08,09,0A,0B,0C,05,06,07 2 C90271 04200500 HTBL 10,11,16,13,14,15,16,04,18,19,1A,1B,14,15,1E,1A 3 C90271 04201000 HTBL 20,20,65,00,00,00,53,49,49,4A,5B,2E,3C,28,2B,21 4 C90271 04201500 HTBL 26,00,00,00,6B,2D,75,00,00,65,5D,24,2A,29,3B,5E 5 C90271 04202000 HTBL 2D,2F,00,00,00,53,49,49,4A,00,5C,2C,25,5F,3E,3F 6 C90271 04202500 HTBL 00,00,6B,00,75,27,60,61,62,40,3A,23,40,27,3D,22 7 C90271 04203000 HTBL 63,41,42,43,44,45,46,47,48,49,64,65,66,67,68,69 8 C90040 04203500 HTBL 6A,4A,4B,4C,4D,4E,4F,50,51,52,6B,6C,6D,6E,6F,70 9 C90040 04204000 HTBL 71,5E,53,54,55,56,57,58,59,5A,72,73,74,75,76,77 A C90271 04204500 HTBL 78,79,7A,7B,7C,7D,7E,27,60,61,62,63,64,65,66,67 B C90040 04205000 HTBL 5B,41,42,43,44,45,46,47,48,49,68,69,6A,6B,6C,6D C C90271 04205500 HTBL 5D,4A,4B,4C,4D,4E,4F,50,51,52,6E,6F,70,71,72,73 D C90271 04206000 HTBL 5C,1F,53,54,55,56,57,58,59,5A,74,75,76,77,78,79 E C90271 04206500 HTBL 30,31,32,33,34,35,36,37,38,39,7A,7B,7C,7D,7E,00 F C90040 04207000 * 04207500 * Corrections for CP880 -> ASCII @SC90271 04208000 E880ASF HTBL 4200,4465,5500,5600,5727,5900,6365,732D,7500 @SC90271 04208500 HTBL FF75,00 @SC90271 04209000 * 04209500 CYTODKOI EQU * CYRILLIC to DKOI (EBCDIC) @SC90040 04210000 * 0 1 2 3 4 5 6 7 8 9 A B C D E F @SC90040 04210500 HTBL 00,01,02,03,37,2D,2E,2F,16,05,25,0B,0C,0D,0E,0F 0 C90040 04211000 HTBL 10,11,12,13,3C,3D,32,26,18,19,3F,27,1C,1D,1E,1F 1 C90040 04211500 HTBL 40,4F,7F,7B,5B,6C,50,7D,4D,5D,5C,4E,6B,60,4B,61 2 C90040 04212000 HTBL F0,F1,F2,F3,F4,F5,F6,F7,F8,F9,7A,5E,4C,7E,6E,6F 3 C90040 04212500 HTBL 7C,C1,C2,C3,C4,C5,C6,C7,C8,C9,D1,D2,D3,D4,D5,D6 4 C90040 04213000 HTBL D7,D8,D9,E2,E3,E4,E5,E6,E7,E8,E9,4A,E0,5A,5F,6D 5 C90040 04213500 HTBL 79,81,82,83,84,85,86,87,88,89,91,92,93,94,95,96 6 C90040 04214000 HTBL 97,98,99,A2,A3,A4,A5,A6,A7,A8,A9,C0,6A,D0,A1,07 7 C90040 04214500 HTBL 20,21,22,23,24,15,06,17,28,29,2A,2B,2C,09,0A,1B 8 C90040 04215000 HTBL 30,31,1A,33,34,35,36,08,38,39,3A,3B,04,14,3E,E1 9 C90040 04215500 HTBL 41,42,43,44,45,46,47,48,49,51,52,53,54,55,56,57 A C90040 04216000 HTBL B9,BA,ED,BF,BC,BD,EC,FA,CB,CC,CD,CE,CF,DA,DB,DC B C90040 04216500 HTBL DE,DF,EA,EB,BE,CA,BB,FE,FB,FD,75,EF,EE,FC,B8,DD C C90040 04217000 HTBL 77,78,AF,8D,8A,8B,AE,B2,8F,90,9A,9B,9C,9D,9E,9F D C90040 04217500 HTBL AA,AB,AC,AD,8C,8E,80,B6,B3,B5,B7,B1,B0,B4,76,A0 E C90040 04218000 HTBL 58,59,62,63,64,65,66,67,68,69,70,71,72,73,74,FF F C90040 04218500 * 04219000 GRTOE875 EQU * Latin/Greek to Greece EBCDIC @SC90040 04219500 * ref: Michel Suignard @SC90040 04220000 * 0 1 2 3 4 5 6 7 8 9 A B C D E F @SC90040 04220500 HTBL 00,01,02,03,37,2D,2E,2F,16,05,25,0B,0C,0D,0E,0F 0 C90040 04221000 HTBL 10,11,12,13,3C,3D,32,26,18,19,3F,27,1C,1D,1E,1F 1 C90040 04221500 HTBL 40,4F,7F,7B,5B,6C,50,7D,4D,5D,5C,4E,6B,60,4B,61 2 C90040 04222000 HTBL F0,F1,F2,F3,F4,F5,F6,F7,F8,F9,7A,5E,4C,7E,6E,6F 3 C90040 04222500 HTBL 7C,C1,C2,C3,C4,C5,C6,C7,C8,C9,D1,D2,D3,D4,D5,D6 4 C90040 04223000 HTBL D7,D8,D9,E2,E3,E4,E5,E6,E7,E8,E9,4A,E0,5A,5F,6D 5 C90040 04223500 HTBL 79,81,82,83,84,85,86,87,88,89,91,92,93,94,95,96 6 C90040 04224000 HTBL 97,98,99,A2,A3,A4,A5,A6,A7,A8,A9,C0,6A,D0,A1,07 7 C90040 04224500 HTBL 20,21,22,23,24,15,06,17,28,29,2A,2B,2C,09,0A,1B 8 C90040 04225000 HTBL 30,31,1A,33,34,35,36,08,38,39,3A,3B,04,14,3E,FF 9 C90040 04225500 HTBL 74,CE,DE,B0,DC,E1,DF,EB,70,FB,EC,EE,EF,CA,ED,CF A C90040 04226000 HTBL 90,DA,EA,FA,A0,80,71,DD,72,73,75,FE,76,DB,77,78 B C90040 04226500 HTBL CC,41,42,43,44,45,46,47,48,49,51,52,53,54,55,56 C C90040 04227000 HTBL 57,58,FC,59,62,63,64,65,66,67,68,69,B1,B2,B3,B5 D C90040 04227500 HTBL CD,8A,8B,8C,8D,8E,8F,9A,9B,9C,9D,9E,9F,AA,AB,AC E C90040 04228000 HTBL AD,AE,BA,AF,BB,BC,BD,BE,BF,CB,B4,B8,B6,B7,B9,FD F C90040 04228500 * 04229000 L8TOE424 EQU * Latin/Hebrew to Israel EBCDIC @SC90040 04229500 * ref: Jonathan Rosenne (IBM Israel) @SC90040 04230000 * 0 1 2 3 4 5 6 7 8 9 A B C D E F @SC90040 04230500 HTBL 00,01,02,03,37,2D,2E,2F,16,05,25,0B,0C,0D,0E,0F 0 C90040 04231000 HTBL 10,11,12,13,3C,3D,32,26,18,19,3F,27,1C,1D,1E,1F 1 C90040 04231500 HTBL 40,5A,7F,7B,5B,6C,50,7D,4D,5D,5C,4E,6B,60,4B,61 2 C90040 04232000 HTBL F0,F1,F2,F3,F4,F5,F6,F7,F8,F9,7A,5E,4C,7E,6E,6F 3 C90040 04232500 HTBL 7C,C1,C2,C3,C4,C5,C6,C7,C8,C9,D1,D2,D3,D4,D5,D6 4 C90040 04233000 HTBL D7,D8,D9,E2,E3,E4,E5,E6,E7,E8,E9,BA,E0,BB,B0,6D 5 C90040 04233500 HTBL 79,81,82,83,84,85,86,87,88,89,91,92,93,94,95,96 6 C90040 04234000 HTBL 97,98,99,A2,A3,A4,A5,A6,A7,A8,A9,C0,4F,D0,A1,07 7 C90040 04234500 HTBL 20,21,22,23,24,15,06,17,28,29,2A,2B,2C,09,0A,1B 8 C90040 04235000 HTBL 30,31,1A,33,34,35,36,08,38,39,3A,3B,04,14,3E,FF 9 C90040 04235500 HTBL 74,AA,4A,B1,9F,B2,6A,B5,BD,B4,BF,8A,5F,CA,AF,BC A C90040 04236000 HTBL 90,8F,EA,FA,BE,A0,B6,B3,9D,DA,E1,8B,B7,B8,B9,AB B C90040 04236500 HTBL CB,CC,CD,9C,CE,CF,9E,9B,DD,DE,72,73,70,75,76,77 C C90040 04237000 HTBL AC,8C,ED,EE,EB,EF,EC,9A,80,FD,FE,FB,FC,AD,AE,78 D C90040 04237500 HTBL 41,42,43,44,45,46,47,48,49,51,52,53,54,55,56,57 E C90040 04238000 HTBL 58,59,62,63,64,65,66,67,68,69,71,DB,DC,8D,8E,DF F C90040 04238500 * 04239000 KATOE290 EQU * KATAKANA to Japanese EBCDIC (290) @SC90040 04239500 * ref: C-H 3-3220-050, composite @SC91067 04240000 * 0 1 2 3 4 5 6 7 8 9 A B C D E F @SC90040 04240500 HTBL 00,01,02,03,37,2D,2E,2F,16,05,25,0B,0C,0D,0E,0F 0 C90040 04241000 HTBL 10,11,12,13,3C,3D,32,26,18,19,3F,27,1C,1D,1E,1F 1 C90040 04241500 HTBL 40,5A,7F,7B,E0,6C,50,7D,4D,5D,5C,4E,6B,60,4B,61 2 C90040 04242000 HTBL F0,F1,F2,F3,F4,F5,F6,F7,F8,F9,7A,5E,4C,7E,6E,6F 3 C90040 04242500 HTBL 7C,C1,C2,C3,C4,C5,C6,C7,C8,C9,D1,D2,D3,D4,D5,D6 4 C90040 04243000 HTBL D7,D8,D9,E2,E3,E4,E5,E6,E7,E8,E9,70,5B,80,B0,6D 5 C91067 04243500 HTBL 79,62,63,64,65,66,67,68,69,71,72,73,74,75,76,77 6 C91067 04244000 HTBL 78,8B,9B,AB,B3,B4,B5,B6,B7,B8,B9,C0,4F,D0,A1,07 7 C91067 04244500 HTBL 20,21,22,23,24,15,06,17,28,29,2A,2B,2C,09,0A,1B 8 C90040 04245000 HTBL 30,31,1A,33,34,35,36,08,38,39,3A,3B,04,14,3E,4A 9 C91325 04245500 HTBL 57,41,42,43,44,45,46,47,48,49,51,52,53,54,55,56 A C91325 04246000 HTBL 58,81,82,83,84,85,86,87,88,89,8A,8C,8D,8E,8F,90 B C90040 04246500 HTBL 91,92,93,94,95,96,97,98,99,9A,9D,9E,9F,A2,A3,A4 C C90040 04247000 HTBL A5,A6,A7,A8,A9,AA,AC,AD,AE,AF,BA,BB,BC,BD,BE,BF D C90040 04247500 HTBL 59,5F,6A,9C,A0,B1,B2,CA,DA,DF,EA,EB,EC,ED,EE,EF E C91325 04248000 HTBL FA,FB,CD,CE,CB,CF,CC,E1,FC,DD,DE,DB,DC,FD,FE,FF F C91325 04248500 * 04249000 KATOHEBK EQU * KATAKANA to Hitachi EBCDIK @SC91325 04249500 * ref: Hitachi manual, composite @SC91325 04250000 HTBL 00,01,02,03,37,2D,2E,2F,16,05,25,0B,0C,0D,0E,0F 0 C91325 04250500 HTBL 10,11,12,13,3C,3D,32,26,18,19,3F,27,1C,1D,1E,1F 1 C91325 04251000 HTBL 40,4F,7F,7B,E0,6C,50,7D,4D,5D,5C,4E,6B,60,4B,61 2 C91325 04251500 HTBL F0,F1,F2,F3,F4,F5,F6,F7,F8,F9,7A,5E,4C,7E,6E,6F 3 C91325 04252000 HTBL 7C,C1,C2,C3,C4,C5,C6,C7,C8,C9,D1,D2,D3,D4,D5,D6 4 C91325 04252500 HTBL D7,D8,D9,E2,E3,E4,E5,E6,E7,E8,E9,4A,5B,5A,5F,6D 5 C91325 04253000 HTBL 79,59,62,63,64,65,66,67,68,69,70,71,72,73,74,75 6 C91325 04253500 HTBL 76,77,78,80,8B,9B,9C,A0,AB,B0,B1,C0,6A,D0,A1,07 7 C91325 04254000 HTBL 20,21,22,23,24,15,06,17,28,29,2A,2B,2C,09,0A,1B 8 C91325 04254500 HTBL 30,31,1A,33,34,35,36,08,38,39,3A,3B,04,14,3E,B9 9 C91325 04255000 HTBL 57,41,42,43,44,45,46,47,48,49,51,52,53,54,55,56 A C91325 04255500 HTBL 58,81,82,83,84,85,86,87,88,89,8A,8C,8D,8E,8F,90 B C91325 04256000 HTBL 91,92,93,94,95,96,97,98,99,9A,9D,9E,9F,A2,A3,A4 C C91325 04256500 HTBL A5,A6,A7,A8,A9,AA,AC,AD,AE,AF,BA,BB,BC,BD,BE,BF D C91325 04257000 HTBL B3,B4,B5,B6,B7,B8,B2,CA,DA,DF,EA,EB,EC,ED,EE,EF E C91325 04257500 HTBL FA,FB,CD,CE,CB,CF,CC,E1,FC,DD,DE,DB,DC,FD,FE,FF F C91325 04258000 * 04258500 L2TOE870 EQU * Latin-2 to ROECE EBCDIC @SC90152 04259000 * ref: 3174 Character Set Reference (IBM GA27-3831-02)@SC90152 04259500 * 0 1 2 3 4 5 6 7 8 9 A B C D E F @SC90152 04260000 HTBL 00,01,02,03,37,2D,2E,2F,16,05,25,0B,0C,0D,0E,0F 0 C90152 04260500 HTBL 10,11,12,13,3C,3D,32,26,18,19,3F,27,1C,1D,1E,1F 1 C90152 04261000 HTBL 40,4F,7F,7B,5B,6C,50,7D,4D,5D,5C,4E,6B,60,4B,61 2 C90152 04261500 HTBL F0,F1,F2,F3,F4,F5,F6,F7,F8,F9,7A,5E,4C,7E,6E,6F 3 C90152 04262000 HTBL 7C,C1,C2,C3,C4,C5,C6,C7,C8,C9,D1,D2,D3,D4,D5,D6 4 C90152 04262500 HTBL D7,D8,D9,E2,E3,E4,E5,E6,E7,E8,E9,4A,E0,5A,5F,6D 5 C90152 04263000 HTBL 79,81,82,83,84,85,86,87,88,89,91,92,93,94,95,96 6 C90152 04263500 HTBL 97,98,99,A2,A3,A4,A5,A6,A7,A8,A9,C0,6A,D0,A1,07 7 C90152 04264000 HTBL 20,21,22,23,24,15,06,17,28,29,2A,2B,2C,09,0A,1B 8 C90152 04264500 HTBL 30,31,1A,33,34,35,36,08,38,39,3A,3B,04,14,3E,FF 9 C90152 04265000 HTBL 41,B1,80,BA,9F,77,AA,B5,BD,BC,AF,FD,B9,CA,B8,B4 A C90152 04265500 HTBL 90,A0,9E,9A,BE,57,8A,70,9D,9C,8F,DD,B7,64,B6,B2 B C90152 04266000 HTBL ED,65,62,66,63,78,69,68,67,71,72,73,DA,75,76,FA C C90152 04266500 HTBL AC,BB,AB,EE,EB,EF,EC,BF,AE,74,FE,FB,FC,AD,B3,59 D C91067 04267000 HTBL CD,45,42,46,43,58,49,48,47,51,52,53,DF,55,56,EA E C90152 04267500 HTBL 8C,9B,8B,CE,CB,CF,CC,E1,8E,54,DE,DB,DC,8D,44,B0 F C91067 04268000 * 04268500 L3TOE905 EQU * Latin-3 to Turkish EBCDIC @SC90152 04269000 * ref: 3174 Character Set Reference (IBM GA27-3831-02)@SC90152 04269500 * 0 1 2 3 4 5 6 7 8 9 A B C D E F @SC90152 04270000 HTBL 00,01,02,03,37,2D,2E,2F,16,05,25,0B,0C,0D,0E,0F 0 C90152 04270500 HTBL 10,11,12,13,3C,3D,32,26,18,19,3F,27,1C,1D,1E,1F 1 C90152 04271000 HTBL 40,4F,FC,EC,B9,6C,50,7D,4D,5D,5C,4E,6B,60,4B,61 2 C90152 04271500 HTBL F0,F1,F2,F3,F4,F5,F6,F7,F8,F9,7A,5E,4C,7E,6E,6F 3 C90152 04272000 HTBL AF,C1,C2,C3,C4,C5,C6,C7,C8,C9,D1,D2,D3,D4,D5,D6 4 C90152 04272500 HTBL D7,D8,D9,E2,E3,E4,E5,E6,E7,E8,E9,68,DC,B6,5F,6D 5 C90152 04273000 HTBL DA,81,82,83,84,85,86,87,88,89,91,92,93,94,95,96 6 C90152 04273500 HTBL 97,98,99,A2,A3,A4,A5,A6,A7,A8,A9,48,8F,B3,CC,07 7 C90152 04274000 HTBL 20,21,22,23,24,15,06,17,28,29,2A,2B,2C,09,0A,1B 8 C90152 04274500 HTBL 30,31,1A,33,34,35,36,08,38,39,3A,3B,04,14,3E,FF 9 C90152 04275000 HTBL 41,AA,80,B1,9F,70,BA,B5,BD,5B,7C,5A,BC,CA,AE,B4 A C90152 04275500 HTBL 90,8A,EA,FA,BE,A0,9A,B7,9D,79,6A,D0,9C,B8,DF,B2 B C90152 04276000 HTBL 64,65,62,66,63,67,AB,4A,74,71,72,73,78,75,76,77 C C90152 04276500 HTBL 8E,69,ED,EE,EB,EF,7B,BF,BB,FD,FE,FB,7F,AD,AC,59 D C90152 04277000 HTBL 44,45,42,46,43,47,8B,C0,54,51,52,53,58,55,56,57 E C90152 04277500 HTBL 9E,49,CD,CE,CB,CF,A1,E1,9B,DD,DE,DB,E0,8D,8C,B0 F C90152 04278000 * 04278500 THTOE838 EQU * Thai ISO to Thai EBCDIC @SC92233 04279000 * ref: IBM code page registry + Trin Tantsetthi @SC92233 04279500 * 0 1 2 3 4 5 6 7 8 9 A B C D E F @SC92233 04280000 HTBL 00,01,02,03,37,2D,2E,2F,16,05,25,0B,0C,0D,0E,0F 0 C92233 04280500 HTBL 10,11,12,13,3C,3D,32,26,18,19,3F,27,1C,1D,1E,1F 1 C92233 04281000 HTBL 40,5A,7F,7B,5B,6C,50,7D,4D,5D,5C,4E,6B,60,4B,61 2 C92233 04281500 HTBL F0,F1,F2,F3,F4,F5,F6,F7,F8,F9,7A,5E,4C,7E,6E,6F 3 C92233 04282000 HTBL 7C,C1,C2,C3,C4,C5,C6,C7,C8,C9,D1,D2,D3,D4,D5,D6 4 C92233 04282500 HTBL D7,D8,D9,E2,E3,E4,E5,E6,E7,E8,E9,49,E0,59,69,6D 5 C92233 04283000 HTBL 79,81,82,83,84,85,86,87,88,89,91,92,93,94,95,96 6 C92233 04283500 HTBL 97,98,99,A2,A3,A4,A5,A6,A7,A8,A9,C0,4F,D0,A1,07 7 C92233 04284000 HTBL 20,21,22,23,24,15,06,17,28,29,2A,2B,2C,09,0A,1B 8 C92233 04284500 HTBL 30,31,1A,33,34,35,36,08,38,39,3A,3B,04,14,3E,FF 9 C92233 04285000 HTBL 41,42,43,44,45,46,47,48,52,53,54,55,56,57,58,62 A C92233 04285500 HTBL 63,64,65,66,67,68,72,73,74,75,76,77,78,8A,8B,8C B C92233 04286000 HTBL 8D,8E,8F,9A,9B,9C,9D,9E,9F,AA,AB,AC,AD,AE,AF,BA C C92233 04286500 HTBL BB,BC,BD,BE,BF,CB,CC,CD,CE,CF,DA,51,CA,FD,FE,70 D C92233 04287000 HTBL DB,DC,DD,DE,DF,EA,EB,EC,ED,EE,EF,FA,FB,FC,71,80 E C92233 04287500 HTBL B0,B1,B2,B3,B4,B5,B6,B7,B8,B9,90,A0,4A,5F,6A,E1 F C92233 04288000 * 04288500 TITLE 'SETCON Routine - set correct controller type' @SC91311 04289000 * Set TRMTP after determining that it's fullscreen @SC91311 04289500 * Entry: R1= flags for desired technique: @SC91311 04290000 STCQBIT EQU X'01' WSF Query is allowed @SC91311 04290500 STCQNS1 EQU X'02' WSF Q implies *not* S/1 @SC91311 04291000 STCS1 EQU X'04' Always assume S/1 @SC91311 04291500 STCNOS1 EQU X'08' Always assume *not* S/1 @SC91311 04292000 STCNORD EQU X'10' Asynch READ MOD is forbidden @SC91311 04292500 * Exit: R15=0 if ok. TRMTP set. @SC91311 04293000 SETCON ENTER @SC91311 04293500 STC 1,STCFLGS @SC91311 04294000 MVI TRMTP,C'S' Remember going via S/1 @SC87166 04294500 TM STCFLGS,STCS1 @SC91311 04295000 BO RTRN0 Never check for S/1, assume it @SC91311 04295500 TM STCFLGS,STCNOS1 @SC91311 04296000 BO STCGRP Assume not S/1 @SC91311 04296500 TM STCFLGS,STCQBIT+STCQNS1 @SC91311 04297000 BO STCGRP Definitely not S1 @SC91311 04297500 MVC WRCMDL+4(4),F3 Preset the length to skip @SC91150 04298000 L 8,RIOPTRS @SC90173 04298500 XC 0(9,8),0(8) Zero out buffer @SC88203 04299000 LA 0,1 @SC88203 04299500 KCALL SCRNIO Clear screen and set up @SC88203 04300000 LA 0,6 @SC88203 04300500 KCALL SCRNIO,STCS1ST,E=(STCSC,M) Issue status request @SC91311 04301000 TM STCFLGS,STCNORD READ MOD forbidden? @SC91311 04301500 BZ STCSRST No, do it @SC91311 04302000 LA 0,7 @SC90264 04302500 KCALL SCRNIO,RIOPTRS,E=(STCSC,NP) Read back screen @SC91150 04303000 CLC =X'5BBC',4(8) @SC90264 04303500 BE STCSC String appeared on screen, not S1 @SC91150 04304000 CLC =X'5B60',4(8) @SC93147 04304500 BE STCSC Possible alternate appearance @SC93147 04305000 LA 0,6 @SC91150 04305500 KCALL SCRNIO,STCS1STI,E=(STCSC,M) Again, with intrpt. @SC91150 04306000 STCSRST LA 0,5 @SC91311 04306500 KCALL SCRNIO,RIOPTRS Read back status @SC90173 04307000 STCSC DS 0H @SC91311 04307500 LA 0,2 @SC88203 04308000 KCALL SCRNIO Release screen @SC88203 04308500 CLI 0(8),X'E4' Check for Yale status response @SC88203 04309000 BE *+12 Ok, I trust @SC88294 04309500 CLI 0(8),0 Other possibility @SC88294 04310000 BNE STCGRP No, must be something else @SC88294 04310500 CLI 3(8),X'11' @SC88203 04311000 BNE STCGRP No, must be something else @SC88203 04311500 CLC =X'2B5B5B',6(8) @SC88203 04312000 BE RTRN0 Yes, all set @SC88203 04312500 STCGRP MVI TRMTP,C'A' Assume AEA device @SC90173 04313000 MVI WRRD,5 Will want a reply in the test @SC91311 04313500 TM STCFLGS,STCQBIT Query allowed? @SC91311 04314000 BZ STCGRG No, assume GRAPHICS @SC91311 04314500 L 8,RIOPTRS @SC90173 04315000 XC 0(9,8),0(8) Zero out buffer @SC90173 04315500 LA 0,1 @SC90173 04316000 KCALL SCRNIO Clear screen and set up @SC90173 04316500 LA 0,4 @SC90173 04317000 KCALL SCRNIO,STCAEAST,E=(STCAC,M) Issue Read Part'n @SC91311 04317500 LA 0,5 @SC90173 04318000 KCALL SCRNIO,RIOPTRS Read back status @SC90173 04318500 STCAC DS 0H @SC91311 04319000 LA 0,2 @SC90173 04319500 KCALL SCRNIO Release screen @SC90173 04320000 CLI 0(8),X'88' Check for WSF query reply @SC90173 04320500 BNE STCGRG No, must be something else @SC90173 04321000 CLC 3(2,8),=X'8180' Summary of replies 1st? @SC90173 04321500 BNE STCGRG No, must be something else @SC90173 04322000 SR 1,1 @SC90173 04322500 ICM 1,3,1(8) Get length of reply @SC90173 04323000 C 1,F64 @SC90173 04323500 BNL STCGRN Too big, give up @SC90173 04324000 LA 2,0(8,1) Point to end @SC90173 04324500 STC5AL CLI 0(2),X'8F' OEM Aux device? @SC90173 04325000 BE RTRN0 Yes, all set @SC90173 04325500 BCTR 2,0 No, keep looking @SC90173 04326000 BCT 1,STC5AL @SC90173 04326500 STCGRN MVI TRMTP,C'N' Probably unsupported device @SC90173 04327000 B RTRN0 That's all @SC90173 04327500 STCGRG MVI TRMTP,C'G' Assume graphics device @SC90173 04328000 B RTRN0 @SC90173 04328500 * 04329000 STCS1ST DC A(STCS1ORD,STCS1OL) @SC91311 04329500 STCS1ORD DC &S1CMD1,AL1(SBA),X'4040' Top of screen @SC93147 04330000 DC X'2B5BBC' Yale ASCII status request @SC93147 04330500 STCS1OL EQU *-STCS1ORD @SC91311 04331000 STCS1STI DC A(STCS1ORI,STCS1OIL) @SC91311 04331500 STCS1ORI DC &S1CMD1,X'2B5BBE' Yale ASCII status w/ intrpt @SC91311 04332000 STCS1OIL EQU *-STCS1ORI @SC91311 04332500 STCAEAST DC A(STCAEAQP,STCAEAL) @SC90173 04333000 STCAEAQP DC &AEACMD,X'000501FF02' Read Partition Query @SC90173 04333500 STCAEAL EQU *-STCAEAQP @SC90173 04334000 * 04334500 LOCALS , @SC86295 04335000 STCFLGS DS X Flags for operation @SC91311 04335500 EXIT , @SC86295 04336000 TITLE 'HINTS Routine - give tips on setup etc' @SC91295 04336500 HINTS ENTER , @SC91295 04337000 SR 0,0 Clear screen (if fullscreen) @SC91295 04337500 KCALL SCRNIO @SC91295 04338000 ** BEGIN LANGUAGE-SPECIFIC DATA ** @SC92300 04338500 WTEXT 'Enter ? for a list of valid commands.' @SC91295 04339000 WTEXT 'Enter ? at any point (and press ENTER) for a list of op.04339500 tions. The minimum' @SC91295 04340000 WTEXT ' abbreviations will be in uppercase.' @SC91295 04340500 WTEXT 'Generally, RECEIVE PACKET-SIZE should be set as large a.04341000 s possible (to maximize' @SC91295 04341500 WTEXT ' efficiency), but there may be buffer size limits due .04342000 to comm hard/software.' @SC91295 04342500 WTEXT ' For safety, set BLOCK-CHECK to 2 or 3 for packets >10.04343000 0.' @SC91295 04343500 WTEXT 'For safety in sending binary files, set the FILE TYPE t.04344000 o BINARY at both ends,' @SC91295 04344500 WTEXT ' but maybe use V-BINARY at this end to preserve record.04345000 boundaries of the' @SC91295 04345500 WTEXT ' original file. Many Kermits convey the FILE TYPE aut.04346000 omatically.' @SC92300 04346500 WTEXT ' Note: V-BINARY with RECEIVE is only for files origina.04347000 lly sent that way.' @SC91295 04347500 WTEXT 'Set the TRANSFER CHARACTER-SET to something appropriate.04348000 (the default of ASCII' @SC91295 04348500 WTEXT ' limits text files to 128 code points, but it maps som.04349000 e common EBCDIC' @SC91295 04349500 WTEXT ' variants to the "expected" ASCII characters). Reset .04350000 the tables as needed.' @SC91295 04350500 WTEXT 'Hint: gather your habitual setups into an INIT file.' 04351000 ** END LANGUAGE-SPECIFIC DATA ** @SC92300 04351500 WTEXT ' ' @SC91295 04352000 STRTMSGS , Any system-specific messages... @SC91295 04352500 CLC =C'ASCII',TRNALF Is it still default? @SC91295 04353000 BNE HINTS1 @SC91295 04353500 WTEXT '&TRANSFR &CHARSET&AAAAAIS.ASCII (7-bit)' @SC91295 04354000 HINTS1 CLC RPSIZ,=A(KMAX) Default packet size (short)? @SC91295 04354500 BE HINTS2 Yes, issue message @SC91295 04355000 BL HINTS3 Actually smaller -- assume need @SC91295 04355500 CLI BCTC,C'1' Greater, desire thorough check @SC92085 04356000 BNE HINTS3 Ok, we're happy @SC92085 04356500 WTEXT '&BLKCHCK&AAAAAIS.1 (&ZZSHORT)' @SC91295 04357000 B HINTS3 @SC91295 04357500 HINTS2 WTEXT '&RECEIVE &PACKSIZ&AAAAAIS.94 (&ZZSHORT)' @SC91295 04358000 HINTS3 CLI CLSNFL,C'O' Overwrite? @SC91295 04358500 BNE HINTS4 No, don't quibble @SC91295 04359000 WTEXT '&AAAFILE &COLLISN&AAAAAIS.&OVERWRI (&ZZBEWAR)' @SC92300 04359500 HINTS4 DS 0H @SC91295 04360000 RET , @SC91295 04360500 * 04361000 LOCALS , @SC91295 04361500 EXIT , @SC91295 04362000