%recordformat eventfm(%integer a, b, c, %string (31) message) ! I/O package constants added ! Operating constants %const %integer max streams = 5; ! ie can select input/output 0-5 %const %integer max units = 10; ! # of logical disk units allowed %const %integer max devs = 10; ! # of different device names %const %integer max fsys = 8_77; ! # of directories/logical disk ! Values for TYPE field in SDFM %const %integer null type = -1, char type = 0, file type = 1 ! Values for STATE field (i.e. state of SYM) %const %integer valid = 0, invalid = 1, EOF = 2 ! Error exit codes (event info in %signal) %const %integer FNF = 25, { File Not Found } bad file = 26, { Syntax fault in file name } disc flt = 27, { Bad block number (or H/W error?) } discfull = 28, { No room in directory or on disk } open2 = 29; { File open twice for output } ! Note alias: MAKESHARE generates ! .EVENT:: .word EVENT %external %record(eventfm) %name %spec ev %alias ".EVENT" ! read/write function codes to disk/device handlers %const %integer read fn = 0, write fn = 1 ! Directory function codes for disk files %const %integer examine = 0, getnext = 1, destroy = 2, create = 3, append = 4, rename = 5, rentemp = 6 ! I/O related record formats added ! File descriptor for directory service %record %format fdfm ( %c %byte unit, fsys, %byte %array fname(1:6) %c ) ! Internal stream descriptor %record %format sdfm ( %c %integer type, { =char/file type etc. } (%record(fdfm) file %or { descr. for Dir.fn. } %string(7) device), (%integer block %or { current block number } %integer len), { length of output line} %integer buffad, buffp, { address of next char } ebp, { 1 beyond last char } %byte ser, { of handler process. } sym, { this char } %integer state, { of stream } refs { for buffer management} %c ) ! Combined descriptor/buffer format - for file streams %record %format sbfm ( %c %record(sdfm) sd, %bytearray bf (0:511) %c ) %const %record(sdfm) %name null == 0 ! Segment 7 I/O layout included ! Layout of segment 7: ALL I/O status variables live here. ! Hence any process calling MAP VIRT (this id, 7, 7) can pick ! up entire state of this process' I/O. ! See e.g. new IMP-77 compiler control process. Each pass maps its ! Seg 7 onto that of control process, and control proc. performs ! all opening/closing of files instead of individual passes. Hence ! less code is required to support each pass, easing shoe-horning ! problems! %record %format pf (%byte ser,reply,%integer a,b,c) %externalroutinespec ponoff(%record (pf) %name p); ! dummy ????? !!!!! %record %format seg7fm ( %c %string(*)%name param str, { ->string param from parent via loader } %integer load flag, { Type of load: generally ignored? } %byte unit, fsys, { Current disk + file system number } callid, strm0id, { Parent task, SER of TTY for this task } id, dummy1, { Real identity of this task } %integer gvar, { Var for GOT SYM - makes it go faster } %record(sdfm) %name inx, outx, { -> current stream descriptors } %string(31) prompt, { Current prompt string } %byte int char, dummy2, { Last int. Offset=8_60 *CRITICAL* } %integer instrmx, outstrmx, { Current stream numbers } %record(pf) p, { For all I/O Package message passing } %byte %array param space (8_76:8_237), { Covers 8_112:8_237 *CRITICAL* } %record(sdfm) %name %array %c in strm (0:max streams), { -> corresponding stream descs } out strm (0:max streams), { " " " " " " " " " } %record(sdfm) ttin, ttout, { TTY I/O stream descriptors } %byte %array tt in buff (0:127), { TTY I/O buffers } tt out buff (0:127), %record(sbfm) %array %c sb (1:max streams*2) { (Desc+buffer)s for file streams } %c ) ! Mapped onto virtual store by... %const %record(seg7fm) %name S7 == 8_160000 ! I/O package procedure specs added %external %routine %spec OPEN %alias "IO$OPEN" %c (%string(*) %name s, %integer stream) %external %routine %spec DIR FN %alias "IO$DIRFN" %c (%record(sdfm)%name x, %integer func) %external %routine %spec DEV FN %alias "IO$DEVFN" %c (%record(sdfm) %name x, %integer func) %external %routine %spec FLUSH OUT %alias "IO$FLUSH" %external %routine %spec SET EOT %alias "IO$SETEOT" (%integer buffad) %external %predicate %spec GOT SYM %alias "IO$GOTSYM" %external %predicate %spec PARSE %alias "IO$PARSE" %c (%string(*)%name file, %record(sdfm)%name t) %external %integer %function %spec CHECK %alias "IO$CHECK" %c (%integer sno, min) %external %string(12) %function %spec CONSTRUCT %alias "IO$CONS" %c (%record(sdfm)%name d) ! *** Member: ABANDONO *** %control 0 %external %routine ABANDON OUTPUT %if S7_outstrmx # 0 %and S7_outx ## null %start flush out %if S7_outx_type = char type S7_outx_refs = S7_outx_refs - 1 S7_outx == null S7_outstrm(S7_outstrmx) == null %finish %end ! *** Member: BASENAME *** %external %string(12) %function %spec EXPAND (%string(127) file) %external %string(6) %function BASE NAME (%string(127) file) %string(3) grot file = expand (file); ! If fails, %signal 9, 3, bad file %if file -> file . ("(") . grot %start; ! Normal file charno(file, 2) = length(file) - 2; ! Cut out disc number + '.' %result = string(addr(file)+2) %finish %result = file; ! Device or ".N" %end ! *** Member: CALLERID *** %external %byte %map CALLER ID %result == S7_call id %end ! *** Member: CHECK *** %external %integer %function CHECK %alias "IO$CHECK" %c (%integer sno, min) %signal 9, 2, sno %unless min <= sno <= max streams %result = sno %end ! *** Member: CLIPARAM *** %external %string(127) %function CLI PARAM ! Returns the parameter string passed into this task ! by the Command Interpreter, after suitable conversion. %integer l, ad, s %owninteger called = 0 %if called = 0 %start ad = addr(S7_param str) ad = ad + 1 %while byteinteger(ad) = ' '; ! skip leading spaces s = ad; ! mark start ad = ad + 1 %while byteinteger (ad) # nl; ! find end l = ad - s; ! find length %while ad # s %cycle byteinteger (ad) = byteinteger (ad-1); ! shuffle up 1 place ad = ad - 1 %repeat length(S7_param str) = l; ! set length byte called = \called; ! conversion done flag %finish %result = S7_param str %end ! *** Member: CLOSEIN *** %external %routine CLOSE INPUT %if S7_instrmx # 0 %and S7_inx ## null %start S7_inx_refs = S7_inx_refs - 1 S7_inx == null S7_instrm(S7_instrmx) == null %finish %end ! *** Member: CLOSEOUT *** %external %routine CLOSE OUTPUT %if S7_outstrmx # 0 %and S7_outx ## null %start flush out %if S7_outx_type = file type %start dir fn (S7_outx, rentemp) %finish S7_outx_refs = S7_outx_refs - 1 S7_outx == null S7_outstrm(S7_outstrmx) == null %finish %end ! *** Member: DEVFN *** %external %routine DEV FN %alias "IO$DEVFN" %c (%record(sdfm) %name x, %integer func) S7_p_a = func; ! Read/write S7_p_ser = x_ser S7_p_reply = S7_id S7_p_b = x_buffad; ! Start of stream buffer S7_p_c = x_block; ! Disk address or output length ponoff (S7_p) %end ! *** Member: DIRFN *** %external %routine DIR FN %alias "IO$DIRFN" %c (%record(sdfm)%name x, %integer func) S7_p_a = func S7_p_ser = x_ser + 1; ! Directory service S7_p_reply = S7_id S7_p_b = addr(x_file); ! File name descriptor S7_p_c = x_block; ! Want first (next) block number ponoff (S7_p) x_block = S7_p_a %end ! *** Member: EMTS *** ! DEIMOS EMT service number constants included %const %integer emt wait = 1 %const %integer emt pon = 2 %const %integer emt poff = 3 %const %integer emt delete = 5 %const %integer emt timer = 8 %const %integer emt mapvirt = 10 %const %integer emt getabs = 11 %const %integer emt getid = 12 %const %integer emt linkin = 13 %const %integer emt mapshr = 14 %const %integer emt maphwr = 15 %const %integer emt mappsct = 16 %const %integer emt ponoff = 17 %const %integer emt toff = 20 %const %integer emt time = 23 ! *** Member: ENDOFIN *** %external %predicate END OF INPUT %true %unless got sym %false %end ! *** Member: EVENT *** %external %record(eventfm) eventz %alias ".EVENT" %external %record(eventfm) %map EVENT %result == eventz %end ! *** Member: EXISTS *** %external %predicate EXISTS (%string(*)%name file, %integer n) ! Note the string param frigg as usual.. %record(sdfm) t %if parse (file, t) %start %if t_type = file type %start; ! Look for file t_block = 0; ! Want first block no dir fn (t, examine) %false %if t_block = 0 %finish %true %finish %false %end ! *** Member: EXPAND *** %external %string(12) %function EXPAND (%string(127) s) ! Returns the full file-name from a (possibly) partial form, ! inserting unit and fsys number for files, etc %record(sdfm) t %if parse (s, t) %start %result = construct (t) %finish %signal 9, 3, bad file %end ! *** Member: FLUSHOUT *** %external %routine FLUSH OUT %alias "IO$FLUSH" %return %if S7_outx == null %if S7_outx_type = char type %start;! Set up length to be written S7_outx_len = S7_outx_buffp - S7_outx_buffad %else; ! File - create or append? %if S7_outx_block = 0 %start; ! Doesn't yet exist - open temp S7_outx_file_fname(1) = S7_outx_file_fname(1)!128 dir fn (S7_outx, destroy); ! Throw away old temp, if any. dir fn (S7_outx, create); ! Make new temp (returns 1st block no) %else dir fn (S7_outx, append); ! Find new disk block %finish %signal 9, 3, disc full %if S7_p_a = 0; ! No room on disk (or in Dir.) %finish dev fn (S7_outx, write fn); ! Write to device or disk %if S7_outx_type = file type %start %signal 9, 3, disc flt %if S7_p_a # 0; ! Failed to write set EOT (S7_outx_buffad); ! Set up disk buffer to EOT %finish S7_outx_buffp = S7_outx_buffad; ! Buffer now empty %end ! *** Member: FSYS *** %external %byte %map F SYS ! Points at file-system number %result == S7_fsys %end ! *** Member: GOTSYM *** %external %predicate GOT SYM %alias "IO$GOTSYM" -> false %if S7_inx == null; ! Permanent EOF from .N %if S7_inx_state # valid %start -> false %if S7_inx_state = EOF ! Invalid - try to get next character %if S7_inx_buffp = S7_inx_ebp %start; ! At end of buffer -> nogo %if S7_inx_type = file type %and S7_inx_block = 0; ! No more blocks %if S7_inx_type = char type %start;! Put out prompt S7_p_ser = S7_inx_ser S7_p_reply = S7_id S7_p_a = write fn S7_p_b = addr(S7_prompt) + 1 S7_p_c = length(S7_prompt) ponoff (S7_p) %finish dev fn (S7_inx, read fn) S7_gvar = S7_p_a %if S7_inx_type = file type %start -> nogo %if S7_gvar # 0; ! Disk read error S7_gvar = 512; ! Size of disk block dir fn (S7_inx, get next); ! ready for next read %else; ! Character device: p_a = # chars %if S7_gvar = 0 %start; ! EOF from TTY nogo: S7_inx_state = EOF false: %false %finish %finish S7_inx_buffp = S7_inx_buffad S7_inx_ebp = S7_inx_buffad + S7_gvar; ! end of buffer %finish S7_inx_sym = byteinteger(S7_inx_buffp) S7_inx_buffp = S7_inx_buffp + 1 S7_inx_state = valid %finish %true %end ! *** Member: ID *** %external %byte %map ID %result == S7_id %end ! *** Member: IMPSTOP *** ! ! IMP$STOP1 ! ! This routine is called by $EXIT if the program ! was linked using other than the .NOTTY or .NOIO ! options.. Its function is to close or abandon each ! open output stream as appropriate, depending on ! the exist status passed as parameter (#0 => failure). ! %external %routine STOP IO %alias "IMP$STOP1" (%integer status) %integer j select output (0); ! Always flush TTY stream newline %if S7_outx_buffp # S7_outx_buffad %for j = 1, 1, max streams %cycle select output (j) %if status # 0 %then abandon output %c %else close output %repeat %end ! *** Member: INFILE *** %external %string(12) %function IN FILE NAME %result = construct (S7_inx) %end ! *** Member: INITIO *** %external %routine INIT IO %alias "IO$INIT" S7_ttin_type = char type S7_ttin_buffad = addr(S7_ttinbuff(0)) S7_ttin_ebp = addr(S7_ttinbuff(0)) S7_ttin_buffp = addr(S7_ttinbuff(0)) S7_ttin_state = invalid S7_ttin_ser = S7_strm0id S7_ttin_device = ".TT" S7_instrm(0) == S7_ttin S7_instrm(1) == S7_ttin S7_ttin_refs = 2 S7_instrm(2) == null S7_instrm(3) == null S7_instrmx = 1 S7_inx == S7_ttin S7_prompt = "I wanna cookie:" S7_ttout_type = char type S7_ttout_buffad = addr(S7_ttoutbuff(0)) S7_ttout_buffp = addr(S7_ttoutbuff(0)) S7_ttout_ebp = addr(S7_ttoutbuff(127))+1 S7_ttout_ser = S7_strm0id S7_ttout_device = S7_ttin_device S7_outstrm(0) == S7_ttout S7_outstrm(1) == S7_ttout S7_ttout_refs = 2 S7_outstrm(2) == null S7_outstrm(3) == null S7_outstrmx = 1 S7_outx == S7_ttout %end ! *** Member: INSTREAM *** %external %integer %function IN STREAM %result = S7_instrmx %end ! *** Member: INTCHAR *** %external %byte %map INT CHAR %result == S7_int char %end ! *** Member: MOVOSTR *** %external %routine MOVE OUTPUT STREAM %alias "IO$MOS" %c (%integer from, to) ! Copy the state of one output stream to another, ! closing the first (if it's not stream 0). Of limited ! general use, but is required by compiler driver, to ! save state of Listing stream (2) between end of pass 1 ! and start of pass 2, since pass 2 uses output stream ! 2 for another purpose. %if check (from, 0) # check (to, 1) %start S7_gvar = S7_instrmx; ! Remember where we are select output (to) close output; ! Close TO (if open!) S7_outstrm(to) == S7_outstrm(from); ! Copy descriptor pointers %if from # 0 %start; ! Leave TTY stream alone S7_outstrm(from) == null; ! Effectively close FROM %finish select output (S7_gvar); ! Return to original stream %finish %end ! *** Member: NEXTSYM *** %external %integer %function NEXT SYMBOL %result = S7_inx_sym %if got sym %signal 9, 1 %end ! *** Member: OPEN *** %record(sdfm) %map NEW SD (%record(sdfm)%name skeleton, %integer strm) %record(sdfm) %name x %system %integer %spec n streams; ! Set up by linker... %integer j, size size = 512 size = 128 %if skeleton_type = char type; ! shorter buffer j = 0 %cycle; ! Hunt for spare descriptor+buffer j = j + 1 %signal 2, 1, 0 %if j > addr(n streams); ! none free x == S7_sb(j)_sd %if x_refs = 0 %start; ! Found one x = skeleton; ! Copy existing fields x_refs = 1 x_buffad = addr(S7_sb(j)_bf(0)) x_ebp = x_buffad + size %if strm < 0 %start; ! Input stream x_buffp = x_ebp; ! Make read necessary %else x_buffp = x_buffad; ! Empty buffer set EOT (x_buffad) %if size = 512;! Fill disk block with EOT %finish %result == x %finish %repeat %end %external %routine XOPEN %alias "IO$OPEN" %c (%string(*) %name file, %integer strm) ! strm < 0 for input stream, > 0 for output (Streams 0 already open) %record(sdfm) t %record(sdfm) %name sd, t2 %record(sdfm) %name %array %name da %integer dser, j, sno da == S7_out strm; sno = strm da == S7_in strm %and sno = -sno %if sno < 0 %if parse (file, t) %start ! Some fields of t filled in... %if t_type = char type %start; ! Look for open device stream dser = t_ser %for j = 0, 1, max streams %cycle sd == da(j); %continue %if sd == null %if sd_type = char type %and sd_ser = dser %start sd_refs = sd_refs + 1 -> got it %finish %repeat %else %if t_type = null type sd == null -> got it %finish sd == new sd (t, strm); ! Find free buffer.. got it: da(sno) == sd; ! Point stream descr. at it %else %signal 9, 3, bad file; ! Could not parse name %finish %end ! *** Member: OPENIN *** %external %routine OPEN INPUT (%integer sno, %string(127) file) %record(sdfm) %name x %integer old in = S7_instrmx x == S7_instrm(check (sno, 1)) %if x ## null %start x_refs = x_refs - 1 %finish open (file, -sno); ! negative for input stream select input (old in) x == S7_instrm(sno) %if x ## null %start; ! Final setting up.. %if x_type = file type %start x_block = 0; ! Want first block dir fn (x, examine); ! Check exists, get block no. %if x_block = 0 %start; ! File not found ev_message = file %signal 9, 3, FNF %finish %finish x_state = invalid %if x_refs = 1;! Sym not valid for new stream %finish %end ! *** Member: OPENOUT *** %external %routine OPEN OUTPUT (%integer sno, %string(127) file) %record(sdfm) %name x, Y %integer old out, j, k old out = S7_outstrmx x == S7_outstrm(check (sno, 1)); ! Look at existing stream %if x ## null %start select output (sno) close output %finish open (file, sno) x == S7_outstrm(sno) %if x ## null %and x_type = file type %start %for j = 1, 1, max streams %cycle; ! Check for double open %continue %if j = sno y == S7_outstrm(j) %continue %if y == null %or y_type # file type %or x_file_unit # y_file_unit %or x_file_fsys # y_file_fsys %for k = 1, 1, 6 %cycle -> ok %if x_file_fname(k) # y_file_fname(k) %repeat ! If we get here, we are trying to write to the same file ! on two separate streams, which is not really a good idea... x_refs = 0; ! Release buffer S7_outstrm(sno) == null; ! Make stream null select output (old out) ev_message = file; ! Record which file it is %signal 9, 3, open2 ok: %repeat x_block = 0; ! Create new file (when FLUSHed) %finish select output (old out) %end ! *** Member: OUTFILE *** %external %string(12) %function OUT FILE NAME %result = construct (S7_outx) %end ! *** Member: OUTTYPE *** %external %integer %function OUT TYPE %result = -1 %if S7_outx == null %result = S7_outx_type %end ! *** Member: PARSE *** ! ! PARSE ! ! This module contains code to parse a DEIMOS filename or ! device code. ! The syntax of filenames is ! ! {unit-number '.'}? file-name {'(' fsys-number ')'}? ! ! where ! unit number = a digit in the range 0-9, ! file-name = 1-6 alphanumeric characters; ! the first a letter; ! fsys-number = a 1- or 2-digit octal number. ! ! The syntax of device codes is ! ! '.' device-name ! ! where device-name is a 1- or 2-character mnemonic ! for the device concerned, eg TT, LP, PP etc. The ! actual names considered valid are determined by ! the contents of the device name table given here ! (the same is true of unit-numbers in the case of ! files). In this way it is possible for a (privileged) ! supervisor routine to dynamically "install" a new ! device/unit by extending this table (which is not ! writeable by ordinary tasks). ! ! The case of alphabetic characters is not significant. ! ! If the string passed as parameter is valid, the ! record addressed by the second parameter is filled ! in with (skeleton) information needed by the rest ! of the I/O package to actually access the file/device. ! This involves eg. filling in the name field with ! the basic name or device mnemonic, inserting the ! appropriate device SER number for inter-task calls, ! as looked up in the table given below, etc.. ! PARSE returns %true if the filename is valid and ! the device/unit specified is known. Otherwise ! %false is returned, and in addition the message field ! of the standard EVENT record is set to contain the ! text supplied by the caller of PARSE, so that the ! information is available for a consequent %signal. ! %external %integer dev lim %alias "IO$DEVLIM" = 3 %external %integer %array dev name %alias "IO$DEVNAME" (0 : max devs) = m'TT', m'LP', m'T2', m'T3', 0(*) %external %byte %array dev ser %alias "IO$DEVSER" (0 : max devs) = 0, 12, 19, 21, 0(*) %external %integer unit lim %alias "IO$UNITLIM" = 5 %external %integer %array unit no %alias "IO$UNITNO" (0 : max units) = 0, 1, 2, 3, 4, 0(*) %external %byte %array unit ser %alias "IO$UNITSER" (0 : max units) = 3, 3, 8, 14, 28, 0(*) %integer %function FIND KEY (%integerarrayname keys, %integer key, lim) %cycle %exit %if keys (lim) = key lim = lim - 1 %repeat %until lim < 0 %result = lim %end %external %predicate PARSE %alias "IO$PARSE" %c (%string(*)%name file, %record(sdfm)%name xx) %integer alpha, num, lim, p, end %integer b, flag, x, dev, c, cm, unit %byte y, fsys %label getch, back %predicate GETC ! Attempt to fetch another character from ! the user-supplied string parameter. ! Character is left in C, and ALPHA and ! NUM are set up if the character is ! a (letter)/(digit in range '0':lim). ! Code here is nastily fiddled (because ! the compiler currently makes a VERY ! bad job of out-of-block data references. ! (ie they work, but the code is a disaster) ! The actual code for GETC is compiled at ! outer level, hence references to PARSE's ! local variables go direct through LNB. ! (This works since the compiler assumes LNB ! untouched by the code here... ie no entry seq.) *jmp _ getch; ! dive off to REAL code (see end of PARSE) ! The next line is actually unreachable, but is ! needed to satisfy pass 1, which doesn't understand ! what the M/C actually does... %true %end p = addr(file) end = p + byteinteger(p) lim = '9'; ! Units have decimal numbers -> nul %if %not getc; ! "" = ".N" %if c = '.' %start; ! Device -> err %unless getc dev = c %if %not getc %start; ! . + 1 char - .N ? -> err %if dev # 'N' nul: xx_type = null type %else length(xx_device) = 3 charno(xx_device,1) = '.' charno(xx_device,2) = dev charno(xx_device,3) = c dev = swab (dev) ! c; ! Get to form m'dd' x = find key (dev name, dev, dev lim) -> err %if x < 0; ! No match xx_ser = S7_strm0id %if x = 0 %then xx_ser = dev ser(x) xx_type = char type %finish %else; ! File unit = S7_unit; ! Default unit %if num >= 0 %start; ! Unit number ? unit = num %while getc %and num >= 0 %cycle;! Get unit number unit = unit*10 + num %repeat -> err %unless getc %and c = '.' %and getc %finish %if alpha = 0 %start; ! Must start with letter err: y = length(file) length(file) = 63 %if y > 63 ev_message = file; ! For benefit of caller length(file) = y; ! So as not to corrupt it %false; ! PARSE Fails %finish flag = 0; b = -6; lim = '9'; ! All decimal digits valid %cycle xx_file_fname(b+7) = c %if flag = 0 %start %if getc %start flag = c %if num < 0 = alpha; ! got non-alphanumeric %else flag = flag - 1; ! end of chars %finish c = ' ' %if flag # 0 %finish b = b + 1 %repeat %until b = 0 fsys = S7_fsys; ! Default fsys %if flag > 0 %start; ! More to come - file system ? -> err %if flag # '(' lim = '7'; ! Octal number required b = 0; flag = 0 %while getc %and num >= 0 %cycle; ! Pick up fsys number b = b<<3 ! num flag = flag + 1 %repeat -> err %if flag = 0 %or flag > 2 %or c # ')' fsys = b %finish x = find key (unit no, unit, unit lim) -> err %if x < 0 xx_ser = unit ser (x) xx_file_unit = unit xx_file_fsys = fsys xx_type = file type %finish -> err %if getc; ! Should be at end %true ! Real code for GETC starts here.. getch: alpha = 0; num = -1 %if p > end %start *clc; ! Clear carry = GETC %false back: *rts _ 7; ! and return from GETC %finish c = byteinteger(p) p = p + 1 cm = c & (128!95); ! drop U/Case bit (fiddle!) c = cm %and alpha = \alpha %if 'A' <= cm <= 'Z' %if c # 0 %start num = c - '0' %if '0' <= c <= lim %else Help the compiler generate %c better code by having a %c label here to make it %c forget C: c = c + 1; ! prevent null for name-parse algorithm! %finish *sec; ! %true return from GETC -> back; ! Prevent access complaint %end ! *** Member: PERMP *** %external %integer %function rsym %alias "PERM$P" %if got sym %start S7_inx_state = invalid; ! Knock down flag %result = S7_inx_sym %finish %signal 9, 1 %end ! *** Member: PRINTSYM *** %external %routine PRINT SYMBOL (%integer sym) %if S7_outx ## null %start byteinteger (S7_outx_buffp) = sym S7_outx_buffp = S7_outx_buffp + 1 flush out %if (S7_outx_type = char type %and sym = nl) %or S7_outx_buffp = S7_outx_ebp %finish %end ! *** Member: PROMPT *** %external %routine PROMPT (%string(31) text) %signal 1, 3, 0 %if length(text) > 31 S7_prompt = text %end ! *** Member: PSTRING *** %external %routine PRINT STRING (%string(*) %name x, %integer p) ! x is in R1, n in R0: saves unnecessary string copy %integer len, c %if S7_outx ## null %start len = length(x) %if len # 0 %start p = addr(x) + 1 %cycle c = byteinteger (p); p = p + 1 byteinteger (S7_outx_buffp) = c S7_outx_buffp = S7_outx_buffp + 1 flush out %if S7_outx_buffp = S7_outx_ebp %or (c = nl %and S7_outx_type = char type) len = len - 1 %repeat %until len = 0 %finish %finish %end ! *** Member: RESETIN *** %external %routine RESET INPUT %if S7_inx ## null %start %if S7_inx_type = char type %start S7_inx_state = invalid %if S7_inx_state = EOF; ! Clear TTY EOF %else S7_inx_block = 0 dir fn (S7_inx, examine); ! Pick up block #1 again, S7_inx_buffp = S7_inx_ebp; ! and empty the buffer, so S7_inx_state = invalid; ! will need a disk read for input %finish %finish %end ! *** Member: RESETOUT *** %external %routine RESET OUTPUT %if S7_outx ## null %and S7_outx_type = file type %start S7_outx_buffp = S7_outx_buffad; ! Zero buffer set EOT (S7_outx_buffad) S7_outx_block = 0; ! FLUSH OUT will recreate temp %finish %end ! *** Member: SELIN *** %external %routine SELECT INPUT (%integer sno) S7_instrmx = check (sno, 0) S7_inx == S7_instrm(sno) %end ! *** Member: SELOUT *** %external %routine SELECT OUTPUT (%integer sno) S7_outstrmx = check (sno, 0) S7_outx == S7_outstrm(S7_outstrmx) %end ! *** Member: SETEOT *** %constinteger r0 = 0, r1 = 1, r2 = 2 %external %routine SETEOT %alias "IO$SETEOT" (%integer adr) ! Parameter not referenced as such in M/C version, = r0 ! ! Reason for use of M/C code - the following ! original version takes up 60 bytes of code, ! and quite unnecessarily fiddles around with DS, LNB ! etc.. ! ! %for adr = adr, 2, adr + 510 %cycle ! integer(adr) = 4 + 4<<8; ! Fill with EOT ! %repeat ! %label lp *mov_#256,r1; ! Clear 256 words *mov_#8_2004,r2; ! = EOT + EOT << 8 lp: *mov_r2,(r0)+; ! set up 2 bytes *sob_r1,lp; ! loop till all done %end ! *** Member: SYSMESS *** %external %string(5) %function %spec ITOS0 (%integer n) %external %string(31) %function SYS MESS (%integer n) %own %string(19) err num = "Error number_xxxxxx" %switch x (FNF : open2) -> x (n) %if FNF <= n <= open2 string(addr(err num) + 13) = itos0 (n) length(err num) = 13 + charno(err num, 13) charno(err num, 13) = ' ' %result = err num x(FNF): %result = "File not found" x(bad file): %result = "Bad file or device syntax" x(disc flt): %result = "Disc access fault" x(disc full): %result = "Disc or directory full" x(open2): %result = "File open twice for output" %end ! *** Member: TTNO *** %external %byte %map TT NO ! Points to SER of handler for user's terminal %result == S7_strm0id %end ! *** Member: UNIT *** %external %byte %map UNIT %result == S7_unit %end ! *** Member: USETT *** ! USE TT ! This routine has the effect of switching all stream references ! to ".TT" to make them use another SERvice no. This includes ! stream 0.. %external %routine USE TT (%integer ser) %integer n = S7_outstrmx %signal 9, 2, ser %unless 0 <= ser <= 255;! Must be byte!! select output (0) flush out; select output (n); ! Clear out old stream, if any S7_strm 0 id = ser; ! Reference value S7_ttout_ser = ser; ! & output value S7_ttin_ser = ser; ! & input S7_ttin_buffp = S7_ttin_ebp; ! - invalidate in stream S7_ttin_state = invalid; ! so read is req'd %end %end %of %file