home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Columbia Kermit
/
kermit.zip
/
ibm370
/
ik0cmd.asm
< prev
next >
Wrap
Assembly Source File
|
2020-01-01
|
221KB
|
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
