{ Common QIO definitions. These definitions were obtained from the system library LB:[1,1]SYSLIB.OLB on our VAX/VMS system, and they may be different for your system. } CONST {[s=4]} { Terminal support attributes (returned by IO.GTS) } f1_acr = 000001B; f1_btw = 000002B; f1_buf = 000004B; f1_cco = 000020B; f1_esq = 000040B; f1_hld = 000100B; f1_lwc = 000200B; f1_rne = 000400B; f1_rpr = 001000B; f1_rst = 002000B; f1_rub = 004000B; f1_syn = 010000B; f1_trw = 020000B; f1_uia = 000010B; f1_utb = 040000B; f1_vbf = 100000B; f2_alt = 000020B; f2_cup = 000100B; f2_dch = 000004B; f2_dkl = 000010B; f2_gch = 000002B; f2_sch = 000001B; f2_sff = 000040B; { Error status values returned in the io_status_block } ie_2dv = 177720B; ie_abo = 177761B; ie_act = 177771B; ie_adp = 177636B; ie_alc = 177654B; ie_alg = 177654B; ie_aln = 177736B; ie_ast = 177660B; ie_bad = 177777B; ie_bbe = 177710B; ie_bcc = 177676B; ie_bdi = 177714B; ie_bdr = 177716B; ie_bdv = 177711B; ie_bhd = 177700B; ie_blb = 177672B; ie_blk = 177754B; ie_bnm = 177712B; ie_btf = 177664B; ie_btp = 177725B; ie_bvr = 177701B; ie_byt = 177755B; ie_ckp = 177766B; ie_cks = 177742B; ie_clo = 177732B; ie_cnr = 177667B; ie_con = 177752B; ie_daa = 177770B; ie_dao = 177763B; ie_dfu = 177750B; ie_dna = 177771B; ie_dnr = 177775B; ie_dun = 177767B; ie_dup = 177707B; ie_eof = 177766B; ie_eot = 177702B; ie_eov = 177765B; ie_exp = 177665B; ie_fex = 177717B; ie_fhe = 177705B; ie_fix = 177767B; ie_flg = 177647B; ie_fln = 177657B; ie_fop = 177713B; ie_hfu = 177744B; ie_hwr = 177772B; ie_ibs = 177647B; ie_ice = 177721B; ie_idu = 177644B; ie_ief = 177637B; ie_ies = 177656B; ie_ifc = 177776B; ie_ifu = 177747B; ie_ill = 177726B; ie_ilu = 177640B; ie_ilv = 177755B; ie_ins = 177776B; ie_iop = 177655B; ie_ipr = 177641B; ie_isq = 177703B; ie_iti = 177643B; ie_itp = 177650B; ie_its = 177770B; ie_iui = 177645B; ie_lck = 177745B; ie_lnl = 177646B; ie_map = 177657B; ie_mod = 177753B; ie_nbf = 177731B; ie_nbk = 177727B; ie_ndr = 177670B; ie_nfi = 177704B; ie_nfw = 177673B; ie_nlk = 177661B; ie_nln = 177733B; ie_nnc = 177663B; ie_nnl = 177662B; ie_nnn = 177674B; ie_nod = 177751B; ie_nsf = 177746B; ie_nst = 177660B; ie_nsw = 177756B; ie_ntr = 177651B; ie_nvr = 177652B; ie_nvw = 177651B; ie_ofl = 177677B; ie_onl = 177675B; ie_onp = 177773B; ie_ovr = 177756B; ie_pes = 177655B; ie_pns = 177642B; ie_pri = 177760B; ie_pts = 177775B; ie_rac = 177724B; ie_rat = 177723B; ie_rbg = 177730B; ie_rbs = 177761B; ie_rcn = 177722B; ie_rej = 177650B; ie_rer = 177740B; ie_rnm = 177715B; ie_rsu = 177757B; ie_sdp = 177635B; ie_snc = 177735B; ie_spc = 177772B; ie_sqc = 177734B; ie_sre = 177762B; ie_stk = 177706B; ie_tch = 177765B; ie_tmm = 177671B; ie_tmo = 177666B; ie_ulk = 177653B; ie_uln = 177773B; ie_uns = 177774B; ie_upn = 177777B; ie_ver = 177774B; ie_wac = 177743B; ie_wat = 177741B; ie_wck = 177652B; ie_wer = 177737B; ie_wlk = 177764B; ie_wov = 177653B; { QIO function codes } io_ace = 007400B; io_acr = 006400B; io_acw = 007000B; io_ads = 014000B; io_apc = 014000B; io_apv = 014010B; io_ata = 001410B; io_atf = 001000B; io_att = 001400B; io_atx = 000400B; io_bls = 004010B; io_cas = 015420B; io_cbo = 015510B; io_cci = 014000B; io_cco = 000440B; io_cer = 004200B; io_cew = 004210B; io_cin = 016500B; io_clk = 015000B; io_cln = 003400B; io_cnt = 017000B; io_con = 015400B; io_cpr = 015410B; io_cpw = 016520B; io_crc = 001040B; io_cre = 012000B; io_crj = 015440B; io_crx = 014400B; io_csi = 013000B; io_csm = 016470B; io_csr = 015000B; io_cti = 015400B; io_ctl = 016400B; io_ctr = 015610B; io_cty = 003400B; io_dac = 010000B; io_dci = 014400B; io_del = 012400B; io_det = 002000B; io_dgn = 004150B; io_dis = 016000B; io_dlb = 016540B; io_dpt = 016010B; io_drx = 015000B; io_dse = 003040B; io_dsi = 013400B; io_dti = 016000B; io_dty = 006400B; io_ena = 006000B; io_eof = 003000B; io_ers = 003020B; io_ext = 011400B; io_fdx = 003020B; io_fln = 012400B; io_fna = 004400B; io_glc = 016430B; io_gli = 016420B; io_gni = 016410B; io_grc = 016450B; io_gri = 016440B; io_grn = 016460B; io_gts = 002400B; io_hdx = 003010B; io_his = 015000B; io_hms = 004000B; io_hng = 003000B; io_ini = 014400B; io_inl = 002400B; io_iti = 017000B; io_kil = 000012B; io_ldi = 007000B; io_led = 012000B; io_lei = 007410B; io_lke = 012000B; io_lod = 014000B; io_lov = 001010B; io_lpc = 004100B; io_lsi = 011000B; io_lti = 007400B; io_ltk = 000050B; io_lty = 010000B; io_mao = 003410B; io_mcs = 013400B; io_mda = 016000B; io_mdi = 014400B; io_mdo = 015400B; io_mlo = 006000B; io_mod = 003000B; io_mso = 005000B; io_nlb = 016530B; io_nlk = 011400B; io_off = 004020B; io_onl = 017400B; io_r1c = 002400B; io_rad = 010400B; io_ral = 001010B; io_rat = 013000B; io_rbc = 003000B; io_rci = 015000B; io_rcv = 015000B; io_rdb = 001200B; io_rdd = 010010B; io_rdh = 004030B; io_rdn = 000022B; io_rel = 013400B; io_rhd = 001010B; io_rlb = 001000B; io_rlc = 001020B; io_rlv = 001100B; io_rmt = 010020B; io_rna = 005400B; io_rnc = 001040B; io_rne = 001020B; io_rnf = 004060B; io_rnr = 004070B; io_rns = 001020B; io_rpb = 001040B; io_rpd = 004170B; io_rpr = 004400B; io_rst = 001001B; io_rtc = 003400B; io_rtd = 004120B; io_rtf = 015400B; io_rti = 016400B; io_rtk = 000060B; io_rtm = 001200B; io_rtt = 005001B; io_rvb = 010400B; io_rwd = 002400B; io_rwu = 002540B; io_sao = 004000B; io_scf = 001200B; io_scs = 013000B; io_sdi = 013000B; io_sdo = 012400B; io_sec = 002520B; io_set = 000030B; io_slo = 005400B; io_smd = 002510B; io_smo = 002560B; io_spb = 002420B; io_spf = 002440B; io_spw = 016510B; io_sso = 004400B; io_sta = 015400B; io_stc = 002500B; io_stp = 016400B; io_swi = 016400B; io_syn = 003040B; io_tdd = 004140B; io_trm = 002410B; io_udi = 011410B; io_uei = 011450B; io_uer = 011440B; io_ulk = 005000B; io_unl = 000042B; io_usi = 011460B; io_uti = 011420B; io_uty = 011430B; io_wal = 000410B; io_wat = 013400B; io_wbt = 000500B; io_wck = 004050B; io_wdd = 000540B; io_wdh = 004040B; io_wlb = 000400B; io_wlc = 000420B; io_wls = 000410B; io_wlt = 000410B; io_wlv = 000500B; io_wms = 000420B; io_wns = 000420B; io_wpb = 000440B; io_wpd = 004160B; io_wtd = 004130B; io_wvb = 011000B; io_xmt = 014400B; io_xna = 014410B; { Successful status returns. These values are also returned in the io_status_block. } is_bv = 000005B; is_cc = 001401B; is_clr = 000000B; is_cr = 006401B; is_eot = 002001B; is_esc = 015401B; is_esq = 115401B; is_pes = 100001B; is_pnd = 000000B; is_rdd = 000002B; is_set = 000002B; is_spd = 000002B; is_suc = 000001B; is_tab = 004401B; is_tmo = 000002B; is_tnc = 000002B; { Unknown? } qi_ver = 000337B; se_bin = 000003B; se_fix = 000002B; se_icn = 000001B; se_lpr = 000011B; se_nih = 000014B; se_nsc = 000012B; se_par = 000010B; se_spd = 000006B; se_spl = 000007B; se_ter = 000005B; se_upn = 000013B; se_val = 000004B; { Special function codes. } sf_def = 000010B; sf_gac = 002600B; sf_gmc = 002560B; sf_gsc = 002540B; sf_rdf = 002460B; sf_sac = 002620B; sf_smc = 002440B; sf_ssc = 002420B; sf_sts = 002520B; sf_stt = 002500B; { Terminal speeds. } s_100 = 000004B; s_110 = 000005B; s_1200 = 000013B; s_134 = 000006B; s_150 = 000007B; s_1800 = 000014B; s_2000 = 000015B; s_200 = 000010B; s_2400 = 000016B; s_300 = 000011B; s_3600 = 000017B; s_4800 = 000020B; s_50 = 000002B; s_600 = 000012B; s_7200 = 000021B; s_75 = 000003B; s_9600 = 000022B; s_exta = 000023B; s_extb = 000024B; { Terminal characteristics } tc_8bc = 000067B; tc_acr = 000024B; tc_alt = 000031B; tc_bin = 000065B; tc_blk = 000042B; tc_bsp = 000023B; tc_ccf = 000030B; tc_ceq = 000046B; tc_cts = 000072B; tc_dlu = 000041B; tc_epa = 000040B; tc_esq = 000035B; tc_fdx = 000064B; tc_frm = 000043B; tc_hff = 000017B; tc_hfl = 000013B; tc_hht = 000021B; tc_hld = 000044B; tc_img = 000032B; tc_isl = 000006B; tc_lcp = 000036B; tc_lpp = 000002B; tc_lvf = 000020B; tc_max = 000073B; tc_nec = 000047B; tc_nkb = 000033B; tc_nl = 000015B; tc_npr = 000034B; tc_nst = 000022B; tc_p8b = 000070B; tc_par = 000037B; tc_pri = 000051B; tc_rat = 000007B; tc_rem = 000066B; tc_rsp = 000003B; tc_scp = 000012B; tc_scr = 000011B; tc_sff = 000016B; tc_slv = 000050B; tc_smo = 000027B; tc_smp = 000026B; tc_smr = 000025B; tc_stb = 000005B; tc_tap = 000045B; tc_tbf = 000071B; tc_ttp = 000010B; tc_uc0 = 000052B; tc_uc1 = 000053B; tc_uc2 = 000054B; tc_uc3 = 000055B; tc_uc4 = 000056B; tc_uc5 = 000057B; tc_uc6 = 000060B; tc_uc7 = 000061B; tc_uc8 = 000062B; tc_uc9 = 000063B; tc_vfl = 000014B; tc_wid = 000001B; tc_xsp = 000004B; { Terminal subfunction codes } tf_ast = 000010B; tf_bin = 000002B; tf_cbf = 000040B; tf_cco = 000040B; tf_esq = 000020B; tf_not = 000002B; tf_ral = 000010B; tf_rcu = 000001B; tf_rnc = 000040B; tf_rne = 000020B; tf_rst = 000001B; tf_syn = 000200B; tf_tmo = 000200B; tf_wal = 000010B; tf_wbt = 000100B; tf_wms = 000020B; tf_xcc = 000001B; tf_xof = 000100B; { Terminal types } t_as33 = 000001B; t_as35 = 000003B; t_ks33 = 000002B; t_l120 = 000016B; t_l180 = 000014B; t_l30p = 000005B; t_l30s = 000004B; t_la36 = 000006B; t_scr0 = 000017B; t_unk0 = 000000B; t_usr0 = 000020B; t_usr1 = 000021B; t_usr2 = 000022B; t_usr3 = 000023B; t_usr4 = 000024B; t_v100 = 000015B; t_vt05 = 000007B; t_vt50 = 000010B; t_vt52 = 000011B; t_vt55 = 000012B; t_vt61 = 000013B; {[s=1]} TYPE io_status_block = PACKED RECORD status: - 128..127; { I/O status (ie_???) } term: char; { Character which terminated I/O operation } length: 0..65535; { Length of data transfer } END; qio_parameter_block = ARRAY [1..6] OF integer; VAR null ORIGIN 177777B: integer; { Specifies null parameter for Fortran } { Issue QIO without waiting for completion } PROCEDURE qio(VAR fnc: integer; { I/O function } VAR lun: integer; { Logical Unit Number } VAR efn: integer; { Event flag } VAR pri: integer; { Priority } VAR isb: io_status_block; { Status of operation } VAR param: qio_parameter_block; { Directive parameters } VAR ids: integer { Directive status } ); NONPASCAL; { Issue QIO and wait for completion } PROCEDURE wtqio(VAR fnc: integer; { I/O function } VAR lun: integer; { Logical Unit Number } VAR efn: integer; { Event flag } VAR pri: integer; { Priority } VAR isb: io_status_block; { Status of operation } VAR param: qio_parameter_block; { Directive parameters } VAR ids: integer { Directive status } ); NONPASCAL; { This dummy procedure is required since the Fortran entry points for the QIO directives call the Fortran termination routine ($EXIT) for some kinds of obscure errors. This procedure is provided to prevent UNDEFINED GLOBAL error messages from the Task Builder. } PROCEDURE $exit; EXTERNAL; PROCEDURE $exit; BEGIN END;