├── test ├── e.sbl ├── en.sbl ├── dt.sbl ├── hs.sbl ├── hello.sbl ├── hi.sbl ├── copy.sbl ├── trim.sbl ├── reverse.sbl ├── sv.sbl ├── host.sbl ├── module.sbl ├── save.sbl ├── h.sbl ├── lower.sbl ├── sep.sbl ├── cc.sbl ├── uc.sbl ├── chars.sbl ├── skel.html ├── sem.sbl ├── tbl.sbl ├── float.sbl ├── slice.sbl ├── rn.sbl ├── arcput.sbl ├── arcget.sbl ├── enum.sbl ├── args.sbl ├── c.sbl ├── equ.sbl ├── i.sbl ├── cfreq.sbl ├── rev.sbl ├── g.sbl ├── d.sbl ├── ru.txt ├── fmt.sbl ├── memoff.sbl ├── z.sbl ├── trc.sbl ├── if.sbl └── pre.sbl ├── demos ├── hi.sbl ├── keywords ├── rn.sbl ├── treesort.in ├── keytext ├── gotos.sbl ├── keyword.sbl ├── kwic1.sbl ├── treesort.sbl ├── sentenc.sbl ├── kwic2.sbl └── atn.in ├── bin ├── sbl_osx ├── sbl_unix └── sbl_unix_32 ├── docs ├── green-book.pdf └── spitbol-manual-v3.7.pdf ├── .gitignore ├── README.md ├── COPYING-SAVE-FILES ├── COPYING-LOAD-MODULES ├── nasm ├── sanity_check_unix_32 ├── sanity_check_unix_64 └── z.sbl ├── osint ├── system.h ├── stubs.c ├── sysul.c ├── dosys.c ├── sysep.c ├── syspp.c ├── sysmx.c ├── getshell.c ├── fakexit.c ├── sysax.c ├── systype.h ├── sysil.c ├── checkfpu.c ├── sysgc.c ├── sysrw.c ├── sysen.c ├── cpys2sc.c ├── st2d.c ├── sysdc.c ├── sysef.c ├── sysid.c ├── break.c ├── oswait.c ├── testty.c ├── syspl.c ├── syscm.c ├── systm.c ├── sysex.c ├── sysej.c ├── sysou.c ├── optfile.c ├── rdenv.c ├── math.c ├── gethost.c ├── osclose.c ├── sysin.c ├── sysld.c ├── prompt.c ├── trypath.c ├── sysea.c ├── sysmm.c ├── flush.c ├── arith.c ├── systty.c ├── sysdt.c ├── sysbx.c ├── save.h ├── lenfnm.c ├── sysbs.c ├── sysst.c ├── sysem.c ├── sysif.c ├── doset.c └── swcoup.c └── gas ├── osx.asm ├── unix.asm └── osx.sbl /test/e.sbl: -------------------------------------------------------------------------------- 1 | end 2 | -------------------------------------------------------------------------------- /test/en.sbl: -------------------------------------------------------------------------------- 1 | end 2 | -------------------------------------------------------------------------------- /test/dt.sbl: -------------------------------------------------------------------------------- 1 | output = date() 2 | end 3 | -------------------------------------------------------------------------------- /test/hs.sbl: -------------------------------------------------------------------------------- 1 | output = host() 2 | end 3 | -------------------------------------------------------------------------------- /demos/hi.sbl: -------------------------------------------------------------------------------- 1 | output = 'hello' 2 | END 3 | -------------------------------------------------------------------------------- /test/hello.sbl: -------------------------------------------------------------------------------- 1 | output = 'Hello World' 2 | end 3 | -------------------------------------------------------------------------------- /test/hi.sbl: -------------------------------------------------------------------------------- 1 | output = 'hello dave' 2 | end 3 | END 4 | -------------------------------------------------------------------------------- /test/copy.sbl: -------------------------------------------------------------------------------- 1 | loop 2 | output = input :s(loop) 3 | end 4 | -------------------------------------------------------------------------------- /test/trim.sbl: -------------------------------------------------------------------------------- 1 | loop 2 | output = trim(input) :s(loop) 3 | end 4 | -------------------------------------------------------------------------------- /bin/sbl_osx: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/hardbol/spitbol/HEAD/bin/sbl_osx -------------------------------------------------------------------------------- /test/reverse.sbl: -------------------------------------------------------------------------------- 1 | loop 2 | output = reverse(input) :s(loop) 3 | end 4 | -------------------------------------------------------------------------------- /bin/sbl_unix: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/hardbol/spitbol/HEAD/bin/sbl_unix -------------------------------------------------------------------------------- /bin/sbl_unix_32: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/hardbol/spitbol/HEAD/bin/sbl_unix_32 -------------------------------------------------------------------------------- /test/sv.sbl: -------------------------------------------------------------------------------- 1 | OUTPUT = 'saving ...' 2 | EXIT(-3) 3 | OUTPUT = 'resuming' 4 | END 5 | -------------------------------------------------------------------------------- /docs/green-book.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/hardbol/spitbol/HEAD/docs/green-book.pdf -------------------------------------------------------------------------------- /test/host.sbl: -------------------------------------------------------------------------------- 1 | OUTPUT = "host(): " HOST() 2 | OUTPUT = "host(0)" HOST(0) 3 | END 4 | -------------------------------------------------------------------------------- /docs/spitbol-manual-v3.7.pdf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/hardbol/spitbol/HEAD/docs/spitbol-manual-v3.7.pdf -------------------------------------------------------------------------------- /test/module.sbl: -------------------------------------------------------------------------------- 1 | exit(-3,'module.out') 2 | OUTPUT = "Resuming execution of saved module" 3 | END 4 | -------------------------------------------------------------------------------- /demos/keywords: -------------------------------------------------------------------------------- 1 | BREEZE 2 | DAY 3 | MOON 4 | OCEAN 5 | SEA 6 | SHIP 7 | SUN 8 | THE 9 | TWAS 10 | WATER 11 | -------------------------------------------------------------------------------- /test/save.sbl: -------------------------------------------------------------------------------- 1 | output = 'writing save file' 2 | exit(-3,'save.spx') 3 | output = 'Resuming after save' 4 | end 5 | -------------------------------------------------------------------------------- /test/h.sbl: -------------------------------------------------------------------------------- 1 | output = 'hello world' 2 | output(.file,2,'dave.s') 3 | file = 'shields' 4 | i = 5 5 | j = 10 6 | output = i + j 7 | 8 | end 9 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | # object files 2 | *.o 3 | # listing files 4 | *.lst 5 | # temporary files 6 | *.tmp 7 | # my temporary outfiles 8 | *.ao 9 | *.ap 10 | ./osint/*.ao 11 | ./osint/*.ap 12 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | spitbol 2 | ======= 3 | 4 | The SPITBOL repository now lives at https://github.com/spitbol/spitbol. 5 | 6 | (No further work will be done on this version after 14 June 2015.) 7 | -------------------------------------------------------------------------------- /test/lower.sbl: -------------------------------------------------------------------------------- 1 | * translate lower to upper case to lower 2 | &trim = &anchor = 1 3 | loop 4 | output = replace(input, 5 | + 'ABCDEFGHIJKLMNOPQRSTUVWXYZ', 6 | + 'abcdefghijklmnopqrstuvwxyz') :s(loop) 7 | end 8 | -------------------------------------------------------------------------------- /test/sep.sbl: -------------------------------------------------------------------------------- 1 | &anchor = &trim = 1 2 | whitespace = ' ' char(9) 3 | :(next) 4 | copy 5 | output = line 6 | next line = input :f(end) 7 | line ' ' notany(whitespace) . chr = char(9) chr :(copy) 8 | 9 | end 10 | 11 | -------------------------------------------------------------------------------- /demos/rn.sbl: -------------------------------------------------------------------------------- 1 | 2 | &anchor = &trim = 1 3 | loop line = input :f(end) 4 | output = 'mv ' line '.spt ' line '.sbl' :(loop) 5 | end 6 | atn 7 | eliza 8 | gotos 9 | hi 10 | kalah 11 | keyword 12 | kwic1 13 | kwic2 14 | sentenc 15 | treesort 16 | -------------------------------------------------------------------------------- /demos/treesort.in: -------------------------------------------------------------------------------- 1 | 1876 BELL A G : TELEPHONE 2 | 1896 MARCONI G : RADIO 3 | 1609 GALILEO : TELESCOPE 4 | 1903 WRIGHT O & W : POWERED FLIGHT 5 | 1835 TALBOT W F : PHOTOGRAPHY 6 | 1896 DIESEL R : DIESEL ENGINE 7 | -------------------------------------------------------------------------------- /test/cc.sbl: -------------------------------------------------------------------------------- 1 | * change /* ... */ comments to '// ... 2 | * dave shields 29 jan 2013 3 | 4 | &anchor = 0 5 | :(loop) 6 | copy output = line 7 | loop line = input :f(end) 8 | line arb . first '/*' arb . text '*/' rpos(0) = first '//' text :(copy) 9 | end 10 | -------------------------------------------------------------------------------- /test/uc.sbl: -------------------------------------------------------------------------------- 1 | S = '' 2 | LOW = 63; HIGH = 126;* ASCII 3 | LOW = 1040; HIGH = 1104;* CYRILLIC 4 | LOW = 1424; HIGH = 1524;* HEBREW 5 | 6 | I = LOW 7 | LOOP 8 | S = S CHAR(I) 9 | LE(I = I + 1, HIGH) :S(LOOP) 10 | OUTPUT = S 11 | OUTPUT = SIZE(S) 12 | OUTPUT = I 13 | END 14 | -------------------------------------------------------------------------------- /test/chars.sbl: -------------------------------------------------------------------------------- 1 | i* count number of instances of each character 2 | &anchor = 1 3 | &dump = 2 4 | count = table() 5 | next 6 | line = input :f(done) 7 | cloop 8 | line len(1) . chr = :f(next) 9 | * nchar = integer(chr) 10 | count[chr] = count[chr] + 1 :(cloop) 11 | done 12 | end 13 | 14 | 15 | -------------------------------------------------------------------------------- /test/skel.html: -------------------------------------------------------------------------------- 1 | 2 | 4 | 5 | 6 | 7 | 8 | 9 | root 10 | 11 | 12 | 13 | 14 | 15 | 16 | -------------------------------------------------------------------------------- /test/sem.sbl: -------------------------------------------------------------------------------- 1 | &anchor = &trim = 1 2 | inside = 3 | :(next) 4 | copy 5 | output = line 6 | next line = input :f(end) 7 | line '/*' :s(in.comment) 8 | line '*/' :s(out.comment) 9 | ident(inside) :s(copy) 10 | line ';' = :(copy) 11 | in.comment 12 | inside = 1 :(copy) 13 | out.comment 14 | inside = :(copy) 15 | 16 | end 17 | 18 | -------------------------------------------------------------------------------- /test/tbl.sbl: -------------------------------------------------------------------------------- 1 | &anchor = &trim = 1 2 | 3 | loop 4 | line = input :f(end) 5 | line break(' ') . sec span(' ') break(' ') . op 6 | + span(' ') break(' ') . args span(' ') rem . desc 7 | output = '' 8 | output = '' sec '' 9 | output = '' op '' 10 | output = '' args '' 11 | output = '' desc '' 12 | output = '' 13 | :(loop) 14 | end 15 | -------------------------------------------------------------------------------- /test/float.sbl: -------------------------------------------------------------------------------- 1 | define('chk(expr,val)') :(chk.end) 2 | chk 3 | output = rpad(expr,16) "expect " val 4 | :(return) 5 | chk.end 6 | r2 = 2.0 7 | r3 = 3.0 8 | chk(r2 + r3, "5.0") 9 | chk(r2 - r3, "-1.0") 10 | chk(r2 * r3, "6.0") 11 | chk(r2 / r3, ".666..") 12 | chk(-r2, "-2.0") 13 | chk(sqrt(r2), "sqrt(2)") 14 | end 15 | output = r2 - r3 16 | * output = r2 - r3 17 | * output = r3 - r2 18 | * output = sin(r2) 19 | end 20 | -------------------------------------------------------------------------------- /test/slice.sbl: -------------------------------------------------------------------------------- 1 | * extract slice from file, option of form first:last with last negative to copy to end of file 2 | 3 | first = 1 4 | last = -1 5 | option = differ(host(0)) host(0) 6 | option break(':') . first len(1) rem . last 7 | lines = 0 :(loop) 8 | copy 9 | output = line 10 | loop 11 | line = input :f(end) 12 | lines = lines + 1 13 | lt(lines,first) :s(loop) 14 | gt(last,0) gt(lines,last) :s(end)f(copy) 15 | end 16 | -------------------------------------------------------------------------------- /test/rn.sbl: -------------------------------------------------------------------------------- 1 | 2 | &anchor = &trim = 1 3 | loop line = input :f(end) 4 | output = 'mv ' line '.spt ' line '.sbl' :(loop) 5 | end 6 | arcget 7 | arcput 8 | args 9 | cc 10 | cfreq 11 | chars 12 | copy 13 | c 14 | def 15 | d 16 | dt 17 | en 18 | enum 19 | equ 20 | e 21 | float 22 | fmt 23 | g 24 | hello 25 | hi 26 | host 27 | hs 28 | lower 29 | map-x32 30 | map-x64 31 | module 32 | op 33 | reverse 34 | rev 35 | save 36 | sv 37 | tbl 38 | trim 39 | uc 40 | -------------------------------------------------------------------------------- /COPYING-SAVE-FILES: -------------------------------------------------------------------------------- 1 | A "save file" records the program object code and data in SPITBOL's 2 | heap as well as other information necessary to resume the program. 3 | 4 | You can create a save file by specifying the -y command-line option. 5 | The save file is created immediately after program compilation and prior to execution. 6 | 7 | You can also create a save file by calling the function EXIT(-3,filename). 8 | 9 | Since save files contain no code from the SPITBOL system, they are NOT subject 10 | to the terms of the GPLv3 license. You can license them however you please. -------------------------------------------------------------------------------- /test/arcput.sbl: -------------------------------------------------------------------------------- 1 | * create archive from list of files 2 | * give in standard input. For example 3 | * ls *.[ch] | spitbol arcput.spt >ch.arc 4 | * will create ch.arc with a copy of all the .c and 5 | * .h files in the current directory 6 | 7 | &trim = 1 8 | &stlimit = 1200000 9 | loop 10 | filename = input :f(end) 11 | output = '!@#$' filename 12 | terminal = 'archiving ' filename 13 | input(.file, 1, filename) 14 | copy 15 | line = file :f(done) 16 | output = trim(line) :(copy) 17 | done 18 | endfile(1) :(loop) 19 | end 20 | -------------------------------------------------------------------------------- /demos/keytext: -------------------------------------------------------------------------------- 1 | THE FAIR BREEZE BLEW, THE WHITE FOAM FLEW, 2 | THE FURROW FOLLOWED FREE: 3 | WE WERE THE FIRST THAT EVER BURST 4 | INTO THAT SILENT SEA. 5 | 6 | DOWN DROPT THE BREEZE, THE SAILS DROPT DOWN, 7 | 'TWAS SAD AS SAD COULD BE; 8 | AND WE DID SPEAK ONLY TO BREAK 9 | THE SILENCE OF THE SEA! 10 | 11 | DAY AFTER DAY, DAY AFTER DAY, 12 | WE STUCK, NOR BREATH NOR MOTION; 13 | AS IDLE AS A PAINTED SHIP 14 | UPON A PAINTED OCEAN. 15 | 16 | WATER, WATER, EVERY WHERE, 17 | AND ALL THE BOARDS DID SHRINK; 18 | WATER, WATER, EVERY WHERE, 19 | NOR ANY DROP TO DRINK. 20 | 21 | SAMUEL TAYLOR COLERIDGE 22 | -------------------------------------------------------------------------------- /test/arcget.sbl: -------------------------------------------------------------------------------- 1 | * extract archive from standard input 2 | 3 | &anchor = 1 4 | &stlimit = 1200000 5 | &dump = 2 6 | files = 0 7 | loop 8 | line = trim(input) :f(atend) 9 | line '!@#$' :f(copy) 10 | line len(4) rem . filename 11 | filename = trim(filename) 12 | terminal = 'extracting ' filename 13 | files = files + 1 14 | eq(files,1) :s(first) 15 | endfile(1) 16 | first 17 | output(.file, 1, filename) :(loop) 18 | copy 19 | file = trim(line) :(loop) 20 | done 21 | endfile(1) :(loop) 22 | atend 23 | &dump = 0 24 | end 25 | -------------------------------------------------------------------------------- /test/enum.sbl: -------------------------------------------------------------------------------- 1 | * generate enum for list of SPITBOL accessible values 2 | tab = char(9) 3 | loop 4 | name = input :f(end) 5 | output = tab name ',' tab tab '/* ' lpad(count,2) ' */' 6 | count = count + 1 :s(loop) 7 | end 8 | GBCNT 9 | HEADV 10 | MXLEN 11 | STAGE 12 | TIMSX 13 | DNAMB 14 | DNAMP 15 | STATE 16 | STBAS 17 | STATB 18 | POLCT 19 | TYPET 20 | LOWSPMIN 21 | FLPRT 22 | FLPTR 23 | GTCEF 24 | HSHTB 25 | PMHBS 26 | R_FCB 27 | C_AAA 28 | C_YYY 29 | G_AAA 30 | W_YYY 31 | R_COD 32 | KVSTN 33 | KVDMP 34 | KVFTR 35 | KVCOM 36 | KVPFL 37 | CSWFL 38 | STMCS 39 | STMCT 40 | TICBLK 41 | TSCBLK 42 | ID1 43 | ID2BLK 44 | INPBUF 45 | TTYBUF 46 | END_MIN_DATA 47 | -------------------------------------------------------------------------------- /test/args.sbl: -------------------------------------------------------------------------------- 1 | * express program arguments into table 2 | * 3 | * add trailing blank so always have blank after an argument 4 | 5 | s = host(0) ' ' 6 | options = table(10) 7 | options.ini 8 | ident(s) :s(options.done) 9 | s break(' ') . arg span(' ') = :f(options.done) 10 | arg break('=') :s(options.1) 11 | * here if arg with no argument 12 | options[arg] = arg :(options.ini) 13 | options.1 14 | arg break('=') . nam '=' rem . val 15 | options[nam] = val :(options.ini) 16 | options.done 17 | * sample usage 18 | if_osx = (ident(options['os'],'osx') 1, 0) 19 | arch = (differ(options['32']) '32', '64') 20 | * lazy listing of table via dump 21 | &dump = 3 22 | end 23 | -------------------------------------------------------------------------------- /test/c.sbl: -------------------------------------------------------------------------------- 1 | * 2 | 3 | &anchor = &trim = 1 4 | lastline = 5 | * state is null when normal text, non-null when processing block 6 | * comment 7 | inside.comment = 8 | :(loop) 9 | copy.comment 10 | line = trim(' ' substr(line,2)) 11 | copy 12 | output = line 13 | loop 14 | line = input :f(end) 15 | ident(line) :s(copy) 16 | differ(inside.comment) :s(com) 17 | * here if in normal text, look for block opener 18 | leq(substr(line,1,1),'{') :f(copy) 19 | inside.comment = 1 :(copy) 20 | com 21 | * here if in block comment, look for closer 22 | line = trim( (ident(substr(line,1,1), '*') ' ' substr(line,2))) 23 | leq(substr(line,1,1),'}') :f(copy) 24 | inside.comment = :(copy) 25 | end 26 | -------------------------------------------------------------------------------- /test/equ.sbl: -------------------------------------------------------------------------------- 1 | * generate enum for list of SPITBOL accessible values 2 | tab = char(9) 3 | loop 4 | name = input :f(end) 5 | output = name tab 'equ ' lpad(count,2) 6 | count = count + 1 :s(loop) 7 | end 8 | B_EFC 9 | B_ICL 10 | B_RCL 11 | B_SCL 12 | B_VCT 13 | B_XNT 14 | B_XRT 15 | C_AAA 16 | CSWFL 17 | C_YYY 18 | DFFNC 19 | DNAMB 20 | DNAMP 21 | FLPRT 22 | FLPTR 23 | G_AAA 24 | GBCNT 25 | GTCEF 26 | HEADV 27 | HSHTB 28 | ID1 29 | ID2BLK 30 | INPBUF 31 | KVCOM 32 | KVDMP 33 | KVFTR 34 | KVPFL 35 | KVSTN 36 | LOWSPMIN19 37 | MXLEN 38 | PMHBS 39 | POLCT 40 | R_COD 41 | R_FCB 42 | S_AAA 43 | STAGE 44 | STATB 45 | STATE 46 | STBAS 47 | STMCS 48 | STMCT 49 | S_YYY 50 | TICBLK 51 | TIMSX 52 | TSCBLK 53 | TTYBUF 54 | TYPET 55 | W_YYY 56 | -------------------------------------------------------------------------------- /COPYING-LOAD-MODULES: -------------------------------------------------------------------------------- 1 | A "load module" is an executable file containing the entire SPITBOL 2 | system in addition to your program's object code and data. 3 | 4 | Load modules can be created just prior to program execution by 5 | specifying the -w command line option. 6 | 7 | Load modules may also be written during program execution by calling EXIT(3,filename). 8 | 9 | Since load modules contain a copy of the entire SPITBOL system, they 10 | are subject to the terms of the GPLv2 (or later) license. You must meet the terms 11 | of the GPLv3 license if you distribute a load module. 12 | 13 | If a load module is created after you have used SPITBOL's LOAD 14 | function to load an external function, then the files that have been 15 | loaded are subject to the terms of the GPLv3 license. 16 | 17 | -------------------------------------------------------------------------------- /test/i.sbl: -------------------------------------------------------------------------------- 1 | output = sqrt(2.0) 2 | i = 0 3 | j = 3 4 | k = 5 5 | output = i 6 | output = j 7 | output = k 8 | t = i + j 9 | output = t 10 | *end 11 | t = i * j 12 | output = t 13 | t = t - 5 14 | 15 | * output = t 16 | t = (i + j) * k 17 | output = t 18 | t = t / k 19 | output = t 20 | t = k * k + k - (6 * k) 21 | output = t 22 | t = k * k - (6 * k) 23 | output = t 24 | end 25 | 26 | 27 | output = 'hello world' 28 | output = remdr(1234,100) 29 | str = '123' 30 | n = +str 31 | output = n 32 | output = n 'ave' 33 | output = 'five test' 34 | i = 5 35 | t = i * i 36 | output = t 37 | t = t + i 38 | output = t 39 | t = t - (6 * i) 40 | output = t 41 | t = i * i - (6 * i) 42 | output = t 43 | t = i * i 44 | output = t 45 | t = t - (i * 6) 46 | output = t 47 | -------------------------------------------------------------------------------- /test/cfreq.sbl: -------------------------------------------------------------------------------- 1 | * find character frequencies in standard input and write out two sorted listings, 2 | * first by character code, then by the number of occurrences. 3 | * 4 | * copyright 2013 David Shields 5 | 6 | freq = table(1000) 7 | define('write(title,array)i') :(write.end) 8 | write 9 | output = 'sort by ' title 10 | i = 0 11 | write.1 12 | key = array :f(return) 13 | val = array 14 | output = " '" key "' " lpad(val,6) 15 | :(write.1) 16 | write.end 17 | 18 | loop 19 | line = input :f(finis) 20 | next 21 | line len(1) . ch = :f(loop) 22 | freq[ch] = freq[ch] + 1 :(next) 23 | finis 24 | write('character code',sort(freq,1)) 25 | write('frequency',rsort(freq,2)) 26 | end 27 | -------------------------------------------------------------------------------- /nasm/sanity_check_unix_32: -------------------------------------------------------------------------------- 1 | #!/bin/bash --verbose 2 | # Copyright 2012-2013 David Shields 3 | # 4 | # This program does a sanity test on spitbol to verify that spitbol is able to compile itself. 5 | # This is done by building the system three times, and comparing the generated assembly (.s) 6 | # filesbl. Normally, all three assembly files wil be equal. However, if a new optimization is 7 | # being introduced, the first two may differ, but the second and third should always agree. 8 | # 9 | rm tbol.* 10 | echo "start 32-bit sanity test" 11 | cp ./bin/sbl_unix_32 tbol 12 | make clean>/dev/null 13 | make BASEBOL=./tbol unix_32 14 | mv sbl.lex tbol.lex.0 15 | mv sbl.s tbol.s.0 16 | cp sbl tbol 17 | make BASEBOL=./tbol unix_32 18 | mv sbl.lex tbol.lex.1 19 | mv sbl.s tbol.s.1 20 | cp sbl tbol 21 | make BASEBOL=./tbol unix_32 22 | mv sbl.lex tbol.lex.2 23 | mv sbl.s tbol.s.2 24 | echo "comparing generated .s files" 25 | diff tbol.s.1 tbol.s.2 26 | echo "end sanity test" 27 | -------------------------------------------------------------------------------- /nasm/sanity_check_unix_64: -------------------------------------------------------------------------------- 1 | #!/bin/bash --verbose 2 | # Copyright 2012-2013 David Shields 3 | # 4 | # This program does a sanity test on spitbol to verify that spitbol is able to compile itself. 5 | # This is done by building the system three times, and comparing the generated assembly (.s) 6 | # filesbl. Normally, all three assembly files wil be equal. However, if a new optimization is 7 | # being introduced, the first two may differ, but the second and third should always agree. 8 | # 9 | rm tbol.* 10 | echo "start 64-bit sanity test" 11 | make clean>/dev/null 12 | cp ./bin/sbl_unix_64 tbol 13 | make basebol=./tbol unix_64_nasm 14 | mv bld/sbl.lex tbol.lex.0 15 | mv bld/sbl.s tbol.s.0 16 | cp sbl tbol 17 | make basebol=./tbol unix_64_nasm 18 | mv bld/sbl.lex tbol.lex.1 19 | mv bld/sbl.s tbol.s.1 20 | cp sbl tbol 21 | make basebol=./tbol unix_64_nasm 22 | mv bld/sbl.lex tbol.lex.2 23 | mv bld/sbl.s tbol.s.2 24 | echo "comparing generated .s files" 25 | diff tbol.s.1 tbol.s.2 26 | echo "end sanity test" 27 | -------------------------------------------------------------------------------- /osint/system.h: -------------------------------------------------------------------------------- 1 | /* 2 | Copyright 1987-2012 Robert B. K. Dewar and Mark Emmer. 3 | Copyright 2012-2013 David Shields 4 | 5 | This file is part of Macro SPITBOL. 6 | 7 | Macro SPITBOL is free software: you can redistribute it and/or modify 8 | it under the terms of the GNU General Public License as published by 9 | the Free Software Foundation, either version 2 of the License, or 10 | (at your option) any later version. 11 | 12 | Macro SPITBOL is distributed in the hope that it will be useful, 13 | but WITHOUT ANY WARRANTY; without even the implied warranty of 14 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 15 | GNU General Public License for more details. 16 | 17 | You should have received a copy of the GNU General Public License 18 | along with Macro SPITBOL. If not, see . 19 | */ 20 | 21 | // ------------------------- system.h ------------------------------- 22 | 23 | /* 24 | * Define system type. 25 | */ 26 | 27 | #define gcc32 1 28 | #define gcc64 0 29 | #define gcc (gcc32 | gcc64) 30 | 31 | -------------------------------------------------------------------------------- /gas/osx.asm: -------------------------------------------------------------------------------- 1 | # unix and osx use differnt conventions for defining a macro. This one is for unix. 2 | .macro syscall 3 | popq %rax # save minimal return address 4 | movq %rax,reg_pc(%rip) 5 | call syscall_init # save registers 6 | movq %rsp,compsp(%rip) # save minimal stack 7 | movq osisp(%rip),%rsp # switch to osint stack 8 | call $0 # call target procedure 9 | call syscall_exit # save result, restore registers, switch back to minimal stack, and return 10 | .endm 11 | 12 | .macro syscallf cproc 13 | popq %rax # save minimal return address 14 | movq %rax,reg_pc(%rip) 15 | call syscallf_init # save registers 16 | movq %rsp,compsp(%rip) # save minimal stack 17 | movq osisp(%rip),%rsp # switch to osint stack 18 | pushfq # save flag register 19 | movq (%rsp),%rax 20 | movq %rax,trc_fl(%rip) 21 | popq %rax 22 | call $0 23 | movq trc_fl(%rip),%rax # restore flag register 24 | pushq %rax 25 | popfq 26 | call syscallf_exit # save result, restore registers, switch back to minimal stack, and return 27 | .endm 28 | 29 | -------------------------------------------------------------------------------- /test/rev.sbl: -------------------------------------------------------------------------------- 1 | optab = table() 2 | &anchor = &trim = 1 3 | optab['MOV'] = 1 4 | optab['ADD'] = 1 5 | optab['SUB'] = 1 6 | * optab['aov'] = 1 7 | optab['ORB'] = 1 8 | optab['ANB'] = 1 9 | optab['XOB'] = 1 10 | :(loop) 11 | copy 12 | output = line 13 | loop 14 | line = input :f(finis) 15 | lines = lines + 1 16 | ident(line) :s(copy) 17 | line '*' :s(copy) 18 | line '{' :s(block) 19 | line ? len(7) . p1 len(3) . opc ' ' break(',') . a1 ',' break(' ') . a2 ' ' rem . rest :f(stmt1) 20 | ident(optab[opc]) :s(copy) 21 | output = p1 opc ' ' a2 ',' a1 ' ' rest 22 | :(loop) 23 | stmt1 24 | * look for operation with no trailing comment 25 | line ? len(7) . p1 len(3) . opc ' ' break(',') . a1 ',' rem . a2 :f(copy) 26 | ident(optab[opc]) :s(copy) 27 | * output = 'no comment' 28 | * output = 'old' char(9) line 29 | * output = 'new ' char(9) p1 opc ' ' a2 ',' a1 30 | output = p1 opc ' ' a2 ',' a1 :(loop) 31 | block 32 | * here in block comment, just copy until closer seen 33 | output = line 34 | bloop 35 | line = input :f(finis) 36 | line '}' :f(block)s(copy) 37 | 38 | finis 39 | end 40 | -------------------------------------------------------------------------------- /gas/unix.asm: -------------------------------------------------------------------------------- 1 | # unix and osx use differnt conventions for defining a macro. This one is for unix. 2 | .macro syscall cproc 3 | popq %rax # save minimal return address 4 | movq %rax,reg_pc(%rip) 5 | call syscall_init # save registers 6 | movq %rsp,compsp(%rip) # save minimal stack 7 | movq osisp(%rip),%rsp # switch to osint stack 8 | call \cproc # call target procedure 9 | call syscall_exit # save result, restore registers, switch back to minimal stack, and return 10 | .endm 11 | 12 | .macro syscallf cproc 13 | popq %rax # save minimal return address 14 | movq %rax,reg_pc(%rip) 15 | call syscallf_init # save registers 16 | movq %rsp,compsp(%rip) # save minimal stack 17 | movq osisp(%rip),%rsp # switch to osint stack 18 | pushfq # save flag register 19 | movq (%rsp),%rax 20 | movq %rax,trc_fl(%rip) 21 | popq %rax 22 | call \cproc # call target procedure 23 | movq trc_fl(%rip),%rax # restore flag register 24 | pushq %rax 25 | popfq 26 | call syscallf_exit # save result, restore registers, switch back to minimal stack, and return 27 | .endm 28 | 29 | -------------------------------------------------------------------------------- /test/g.sbl: -------------------------------------------------------------------------------- 1 | 2 | &trim = 1 3 | &anchor = 0 4 | ops = 5 | . 'flc ' 6 | . 'add adi adr anb aov atn ' 7 | . 'bod bev ' 8 | . 'bct beq bge bgt ' 9 | . 'bhi ble blo ' 10 | . 'blt bne bnz brn ' 11 | . 'bri bsw btw ' 12 | . 'bze ceq ' 13 | . 'chk chp cmb cmc cne cos csc ctb ' 14 | . 'ctw cvd cvm dac dbc dca dcv ' 15 | . 'def dic drc dtc dvi dvr ejc ' 16 | . 'else end enp ent equ ' 17 | . 'erb err esw etx exi exp fi ' 18 | . 'ica icp icv ieq if iff ige ' 19 | . 'igt ile ilt ine ino inp ' 20 | . 'inr iov itr jsr lch lct lcp ' 21 | . 'lcw ldi ldr lei lnf lsh lsx mcb ' 22 | . 'mfi mli mlr mnz mov mti ' 23 | . 'mvc mvw mwb ngi ngr nzb ' 24 | . 'orb plc ppm prc psc req ' 25 | . 'rge rgt rle rlt rmi rne rno ' 26 | . 'rov rsh rsx rti rtn sbi ' 27 | . 'sbr sch scp sec sin sqr ssl sss ' 28 | . 'sti str sub tan then trc ttl ' 29 | . 'undef wtb xob zer zgb zrb ' 30 | 31 | * output = ops 32 | loop 33 | ops break(' ') . opc span(' ') = :f(finis) 34 | output = '* ' '"opc"' 35 | c = " line " 36 | c = c " any(' .,') . sep1 " 37 | c = c " '" opc "'" 38 | c = c " any(' .,') . sep2 " 39 | c = c " = sep1 " "'{'" " '" opc "' " "'}'" sep2 40 | output = c 41 | * output = " any(' .,') . sep1 " opc 42 | *+ " any(' ,.') . sep2 " = " pre sep1 '{' " opc " '}'" sep2 43 | :(loop) 44 | finis 45 | end 46 | 47 | -------------------------------------------------------------------------------- /osint/stubs.c: -------------------------------------------------------------------------------- 1 | /* 2 | Copyright 1987-2012 Robert B. K. Dewar and Mark Emmer. 3 | Copyright 2012-2013 David Shields 4 | 5 | This file is part of Macro SPITBOL. 6 | 7 | Macro SPITBOL is free software: you can redistribute it and/or modify 8 | it under the terms of the GNU General Public License as published by 9 | the Free Software Foundation, either version 2 of the License, or 10 | (at your option) any later version. 11 | 12 | Macro SPITBOL is distributed in the hope that it will be useful, 13 | but WITHOUT ANY WARRANTY; without even the implied warranty of 14 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 15 | GNU General Public License for more details. 16 | 17 | You should have received a copy of the GNU General Public License 18 | along with Macro SPITBOL. If not, see . 19 | */ 20 | 21 | /* 22 | / File: STUBS.C Version: 01.02 23 | / --------------------------------------- 24 | / 25 | / Contents: Function zysdc 26 | / Function zysdm 27 | / Function zystt 28 | */ 29 | 30 | /* 31 | / All functions are "dummy" functions not supported by this 32 | / implementation. 33 | */ 34 | 35 | #include "port.h" 36 | 37 | zysdm() 38 | { 39 | return NORMAL_RETURN; 40 | } 41 | 42 | 43 | zystt() 44 | { 45 | return NORMAL_RETURN; 46 | } 47 | 48 | -------------------------------------------------------------------------------- /osint/sysul.c: -------------------------------------------------------------------------------- 1 | /* 2 | Copyright 1987-2012 Robert B. K. Dewar and Mark Emmer. 3 | Copyright 2012-2013 David Shields 4 | 5 | This file is part of Macro SPITBOL. 6 | 7 | Macro SPITBOL is free software: you can redistribute it and/or modify 8 | it under the terms of the GNU General Public License as published by 9 | the Free Software Foundation, either version 2 of the License, or 10 | (at your option) any later version. 11 | 12 | Macro SPITBOL is distributed in the hope that it will be useful, 13 | but WITHOUT ANY WARRANTY; without even the implied warranty of 14 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 15 | GNU General Public License for more details. 16 | 17 | You should have received a copy of the GNU General Public License 18 | along with Macro SPITBOL. If not, see . 19 | */ 20 | 21 | /* 22 | / File: SYSUL.C Version: 01.00 23 | / --------------------------------------- 24 | / 25 | / Contents: Function zysul 26 | / 27 | */ 28 | 29 | /* 30 | / zysul - unload external function 31 | / 32 | / Parameters: 33 | / XR - pointer to EFBLK 34 | / Returns: 35 | / nothing 36 | */ 37 | 38 | #include "port.h" 39 | 40 | 41 | zysul() 42 | { 43 | #if EXTFUN 44 | unldef(XR(struct efblk *)); 45 | #endif // EXTFUN 46 | return NORMAL_RETURN; 47 | } 48 | -------------------------------------------------------------------------------- /osint/dosys.c: -------------------------------------------------------------------------------- 1 | /* 2 | Copyright 1987-2012 Robert B. K. Dewar and Mark Emmer. 3 | Copyright 2012-2013 David Shields 4 | 5 | This file is part of Macro SPITBOL. 6 | 7 | Macro SPITBOL is free software: you can redistribute it and/or modify 8 | it under the terms of the GNU General Public License as published by 9 | the Free Software Foundation, either version 2 of the License, or 10 | (at your option) any later version. 11 | 12 | Macro SPITBOL is distributed in the hope that it will be useful, 13 | but WITHOUT ANY WARRANTY; without even the implied warranty of 14 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 15 | GNU General Public License for more details. 16 | 17 | You should have received a copy of the GNU General Public License 18 | along with Macro SPITBOL. If not, see . 19 | */ 20 | 21 | /* 22 | / dosys( cmd, path ) 23 | / 24 | / dosys() does a "system" function call with the string contained in cmd. 25 | / 26 | / Parameters: 27 | / cmd C-string of command to execute 28 | / path C-string of optional pathspec of program to execute. 29 | / May be null string. 30 | / Returns: 31 | / code returned by system 32 | */ 33 | 34 | #include "port.h" 35 | 36 | int dosys( cmd, path ) 37 | char *cmd; 38 | char *path; 39 | { 40 | return system( cmd ); 41 | } 42 | 43 | -------------------------------------------------------------------------------- /osint/sysep.c: -------------------------------------------------------------------------------- 1 | /* 2 | Copyright 1987-2012 Robert B. K. Dewar and Mark Emmer. 3 | Copyright 2012-2013 David Shields 4 | 5 | This file is part of Macro SPITBOL. 6 | 7 | Macro SPITBOL is free software: you can redistribute it and/or modify 8 | it under the terms of the GNU General Public License as published by 9 | the Free Software Foundation, either version 2 of the License, or 10 | (at your option) any later version. 11 | 12 | Macro SPITBOL is distributed in the hope that it will be useful, 13 | but WITHOUT ANY WARRANTY; without even the implied warranty of 14 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 15 | GNU General Public License for more details. 16 | 17 | You should have received a copy of the GNU General Public License 18 | along with Macro SPITBOL. If not, see . 19 | */ 20 | 21 | /* 22 | / File: SYSEP.C Version: 01.01 23 | / --------------------------------------- 24 | / 25 | / Contents: Function zysep 26 | */ 27 | 28 | /* 29 | / zysep - eject printer (standard output) 30 | / 31 | / zysep writes an eject to the standard output. 32 | / 33 | / Parameters: 34 | / None 35 | / Returns: 36 | / Nothing 37 | / Exits: 38 | / None 39 | */ 40 | 41 | #include "port.h" 42 | 43 | zysep() 44 | { 45 | write( 1, "\f", 1 ); 46 | return NORMAL_RETURN; 47 | } 48 | 49 | -------------------------------------------------------------------------------- /osint/syspp.c: -------------------------------------------------------------------------------- 1 | /* 2 | Copyright 1987-2012 Robert B. K. Dewar and Mark Emmer. 3 | Copyright 2012-2013 David Shields 4 | 5 | This file is part of Macro SPITBOL. 6 | 7 | Macro SPITBOL is free software: you can redistribute it and/or modify 8 | it under the terms of the GNU General Public License as published by 9 | the Free Software Foundation, either version 2 of the License, or 10 | (at your option) any later version. 11 | 12 | Macro SPITBOL is distributed in the hope that it will be useful, 13 | but WITHOUT ANY WARRANTY; without even the implied warranty of 14 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 15 | GNU General Public License for more details. 16 | 17 | You should have received a copy of the GNU General Public License 18 | along with Macro SPITBOL. If not, see . 19 | */ 20 | 21 | 22 | /* 23 | / zyspp - obtain print parameters 24 | */ 25 | 26 | #include "port.h" 27 | 28 | zyspp() 29 | 30 | { 31 | /* 32 | / Set default case flag here; cannot set before starting up 33 | / compiler because of its clearing of its local data. 34 | */ 35 | /* 36 | / Set page width, lines per page, and compiler flags. 37 | */ 38 | 39 | SET_WA( pagewdth ); 40 | SET_WB( lnsppage ); 41 | SET_WC( spitflag ); 42 | 43 | return NORMAL_RETURN; 44 | } 45 | -------------------------------------------------------------------------------- /osint/sysmx.c: -------------------------------------------------------------------------------- 1 | /* 2 | Copyright 1987-2012 Robert B. K. Dewar and Mark Emmer. 3 | Copyright 2012-2013 David Shields 4 | 5 | This file is part of Macro SPITBOL. 6 | 7 | Macro SPITBOL is free software: you can redistribute it and/or modify 8 | it under the terms of the GNU General Public License as published by 9 | the Free Software Foundation, either version 2 of the License, or 10 | (at your option) any later version. 11 | 12 | Macro SPITBOL is distributed in the hope that it will be useful, 13 | but WITHOUT ANY WARRANTY; without even the implied warranty of 14 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 15 | GNU General Public License for more details. 16 | 17 | You should have received a copy of the GNU General Public License 18 | along with Macro SPITBOL. If not, see . 19 | */ 20 | 21 | /* 22 | / File: SYSMX.C Version: 01.01 23 | / --------------------------------------- 24 | / 25 | / Contents: Function zysmx 26 | */ 27 | 28 | /* 29 | / zysmx - return maximum size in bytes of any created object 30 | / 31 | / Parameters: 32 | / XR - tentative end of static 33 | / Returns: 34 | / WA - maximum created object size in bytes 35 | / Exits: 36 | / None 37 | */ 38 | 39 | #include "port.h" 40 | 41 | zysmx() 42 | 43 | { 44 | SET_WA( maxsize ); 45 | return NORMAL_RETURN; 46 | } 47 | -------------------------------------------------------------------------------- /osint/getshell.c: -------------------------------------------------------------------------------- 1 | /* 2 | Copyright 1987-2012 Robert B. K. Dewar and Mark Emmer. 3 | Copyright 2012-2013 David Shields 4 | 5 | This file is part of Macro SPITBOL. 6 | 7 | Macro SPITBOL is free software: you can redistribute it and/or modify 8 | it under the terms of the GNU General Public License as published by 9 | the Free Software Foundation, either version 2 of the License, or 10 | (at your option) any later version. 11 | 12 | Macro SPITBOL is distributed in the hope that it will be useful, 13 | but WITHOUT ANY WARRANTY; without even the implied warranty of 14 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 15 | GNU General Public License for more details. 16 | 17 | You should have received a copy of the GNU General Public License 18 | along with Macro SPITBOL. If not, see . 19 | */ 20 | 21 | #include "port.h" 22 | 23 | /* 24 | / getshell() 25 | / 26 | / Function getshell returns the path for the current shell. 27 | / 28 | / Parameters: 29 | / None 30 | / Returns: 31 | / Pointer to character string representing current shell path 32 | */ 33 | 34 | char *getshell() 35 | { 36 | register char *p; 37 | 38 | if ((p = findenv(SHELL_ENV_NAME, sizeof(SHELL_ENV_NAME))) == (char *)0) 39 | p = SHELL_PATH; // failure -- use default 40 | return p; // value (with a null terminator) 41 | } 42 | -------------------------------------------------------------------------------- /osint/fakexit.c: -------------------------------------------------------------------------------- 1 | /* 2 | Copyright 1987-2012 Robert B. K. Dewar and Mark Emmer. 3 | Copyright 2012-2013 David Shields 4 | 5 | This file is part of Macro SPITBOL. 6 | 7 | Macro SPITBOL is free software: you can redistribute it and/or modify 8 | it under the terms of the GNU General Public License as published by 9 | the Free Software Foundation, either version 2 of the License, or 10 | (at your option) any later version. 11 | 12 | Macro SPITBOL is distributed in the hope that it will be useful, 13 | but WITHOUT ANY WARRANTY; without even the implied warranty of 14 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 15 | GNU General Public License for more details. 16 | 17 | You should have received a copy of the GNU General Public License 18 | along with Macro SPITBOL. If not, see . 19 | */ 20 | 21 | /* 22 | / File: FAKEXIT.C Version: 01.00 23 | / --------------------------------------- 24 | / 25 | / Contents: Function exit 26 | */ 27 | 28 | /* 29 | / exit() 30 | / 31 | / This is a "fake" exit() function that prevents the linker from linking 32 | / in the standard C exit() function with all the associated stdio library 33 | / functions. 34 | */ 35 | #include "port.h" 36 | #if !VCC 37 | void exit(status) 38 | int status; 39 | {} 40 | #endif 41 | 42 | extern void _exit (int status); 43 | 44 | void __exit(code) 45 | int code; 46 | { 47 | _exit(code); 48 | } 49 | -------------------------------------------------------------------------------- /osint/sysax.c: -------------------------------------------------------------------------------- 1 | /* 2 | Copyright 1987-2012 Robert B. K. Dewar and Mark Emmer. 3 | Copyright 2012-2013 David Shields 4 | 5 | This file is part of Macro SPITBOL. 6 | 7 | Macro SPITBOL is free software: you can redistribute it and/or modify 8 | it under the terms of the GNU General Public License as published by 9 | the Free Software Foundation, either version 2 of the License, or 10 | (at your option) any later version. 11 | 12 | Macro SPITBOL is distributed in the hope that it will be useful, 13 | but WITHOUT ANY WARRANTY; without even the implied warranty of 14 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 15 | GNU General Public License for more details. 16 | 17 | You should have received a copy of the GNU General Public License 18 | along with Macro SPITBOL. If not, see . 19 | */ 20 | 21 | /* 22 | / File: SYSAX.C Version: 01.01 23 | / --------------------------------------- 24 | / 25 | / Contents: Function zysax 26 | */ 27 | 28 | /* 29 | / 30 | / zysax - after execution cleanup 31 | / 32 | / Here we just indicate that further output should go to the 33 | / compiler output file, as opposed to stdout from executing program. 34 | / 35 | / Parameters: 36 | / None 37 | / Returns: 38 | / Nothing 39 | / Exits: 40 | / None 41 | */ 42 | 43 | #include "port.h" 44 | 45 | zysax() 46 | { 47 | // swcoup does real work 48 | swcoup( outptr ); 49 | return NORMAL_RETURN; 50 | } 51 | -------------------------------------------------------------------------------- /osint/systype.h: -------------------------------------------------------------------------------- 1 | /* 2 | Copyright 1987-2012 Robert B. K. Dewar and Mark Emmer. 3 | Copyright 2012-2013 David Shields 4 | 5 | This file is part of Macro SPITBOL. 6 | 7 | Macro SPITBOL is free software: you can redistribute it and/or modify 8 | it under the terms of the GNU General Public License as published by 9 | the Free Software Foundation, either version 2 of the License, or 10 | (at your option) any later version. 11 | 12 | Macro SPITBOL is distributed in the hope that it will be useful, 13 | but WITHOUT ANY WARRANTY; without even the implied warranty of 14 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 15 | GNU General Public License for more details. 16 | 17 | You should have received a copy of the GNU General Public License 18 | along with Macro SPITBOL. If not, see . 19 | */ 20 | 21 | /* 22 | / The following manifest constants define the target hardware platform 23 | / and tool chain. 24 | / 25 | / GCCi32 Intel 32-bit x86, GNU GCC 26 | / GCCi64 Intel 64-bit x86, GNU GCC 27 | / 28 | */ 29 | 30 | /* Override default values in port.h. It is necessary for a user configuring 31 | * SPITBOL to examine all the default values in port.h and override those 32 | * that need to be altered. 33 | */ 34 | /* Values for x86 Linux 32-bit SPITBOL. 35 | */ 36 | #define EXECFILE 0 37 | #define FLTHDWR 0 // Change to 1 when do floating ops inline 38 | #define GCCi32 1 39 | -------------------------------------------------------------------------------- /osint/sysil.c: -------------------------------------------------------------------------------- 1 | /* 2 | Copyright 1987-2012 Robert B. K. Dewar and Mark Emmer. 3 | Copyright 2012-2013 David Shields 4 | 5 | This file is part of Macro SPITBOL. 6 | 7 | Macro SPITBOL is free software: you can redistribute it and/or modify 8 | it under the terms of the GNU General Public License as published by 9 | the Free Software Foundation, either version 2 of the License, or 10 | (at your option) any later version. 11 | 12 | Macro SPITBOL is distributed in the hope that it will be useful, 13 | but WITHOUT ANY WARRANTY; without even the implied warranty of 14 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 15 | GNU General Public License for more details. 16 | 17 | You should have received a copy of the GNU General Public License 18 | along with Macro SPITBOL. If not, see . 19 | */ 20 | 21 | /* 22 | / File: SYSIL.C Version: 01.03 23 | / --------------------------------------- 24 | / 25 | / Contents: Function zysil 26 | */ 27 | 28 | /* 29 | / zysil - get input record length 30 | / 31 | / Parameters: 32 | / WA - pointer to FCBLK 33 | / Returns: 34 | / WA - length of next record to be read 35 | / WC - 0 if binary file, 1 if text file 36 | / Exits: 37 | / None 38 | */ 39 | 40 | #include "port.h" 41 | 42 | zysil() 43 | 44 | { 45 | register struct fcblk *fcb = WA (struct fcblk *); 46 | 47 | SET_WA( fcb->rsz ); 48 | SET_WC( fcb->mode ); 49 | 50 | // normal return 51 | return NORMAL_RETURN; 52 | } 53 | -------------------------------------------------------------------------------- /demos/gotos.sbl: -------------------------------------------------------------------------------- 1 | * The following trace function will give the last 10 or so GOTOS 2 | * of a SNOBOL4 program before it ends. This history is kept in the 3 | * form of a string so that it will get dumped if execution ends 4 | * abnormally. You can also send all error conditions to the statement: 5 | * ERROR OUTPUT = GOTOS_QUEUE 6 | * 7 | * The string GOTOS_QUEUE will have entries in the form: 8 | * 9 | * F1>T1;F2>T2;... 10 | * 11 | * where entries are delimited by the semicolon. Fn is the 12 | * 'FROM' statement where a GOTO was made to the 'TO' statement, Tn. 13 | * The most recent GOTO is at the beginning of string, and ages to the 14 | * right. 15 | * 16 | * From a note in the Dec., 1975 newsletter of SIGPLAN from 17 | * Gideon Yuval, Computer Science Dept., Hebrew University, 18 | * Jerusalem, Israel. 19 | * 20 | * (c) Copyright 1985 - Catspaw, Incorporated 21 | * 22 | DEFINE( 'GOTOS_()' ) 23 | GOTOS_LENGTH = 119 24 | GOTOS_QUEUE = DUPL( '.' , GOTOS_LENGTH) 25 | GOTOS_PAT = POS(0) LEN(GOTOS_LENGTH) . GOTOS_QUEUE :(GOTOS_END) 26 | 27 | GOTOS_ GOTOS_NO = &LASTNO 28 | EQ(GOTOS_LAST, GOTOS_NO) :S(RETURN) 29 | GOTOS_LAST = EQ(GOTOS_NO, GOTOS_LAST + 1) GOTOS_NO :S(RETURN) 30 | (GOTOS_LAST '>' GOTOS_NO ';' GOTOS_QUEUE) ? GOTOS_PAT 31 | GOTOS_LAST = GOTOS_NO :(RETURN) 32 | GOTOS_END 33 | 34 | TRACE( 'STCOUNT', 'KEYWORD', , 'GOTOS_') 35 | &TRACE = 50000 36 | &DUMP = 1 37 | 38 | * Sample Program: 39 | * 40 | &STLIMIT = 200 ;* Limit to 200 statements 41 | 42 | A :(B) 43 | C :(D) 44 | B :(C) 45 | D :(A) 46 | 47 | END 48 | -------------------------------------------------------------------------------- /osint/checkfpu.c: -------------------------------------------------------------------------------- 1 | /* 2 | Copyright 1987-2012 Robert B. K. Dewar and Mark Emmer. 3 | Copyright 2012-2015 David Shields 4 | 5 | This file is part of Macro SPITBOL. 6 | 7 | Macro SPITBOL is free software: you can redistribute it and/or modify 8 | it under the terms of the GNU General Public License as published by 9 | the Free Software Foundation, either version 2 of the License, or 10 | (at your option) any later version. 11 | 12 | Macro SPITBOL is distributed in the hope that it will be useful, 13 | but WITHOUT ANY WARRANTY; without even the implied warranty of 14 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 15 | GNU General Public License for more details. 16 | 17 | You should have received a copy of the GNU General Public License 18 | along with Macro SPITBOL. If not, see . 19 | */ 20 | 21 | /* 22 | * checkfpu - check if floating point hardware is present. 23 | * 24 | * Used on those systems where hardware floating point is 25 | * optional. On those systems where it is standard, the 26 | * floating point ops are coded in line, and this module 27 | * is not linked in. 28 | * 29 | * Returns 0 if absent, -1 if present. 30 | */ 31 | 32 | 33 | #include "port.h" 34 | 35 | #if FLOAT 36 | #if FLTHDWR 37 | checkfpu() 38 | { 39 | return -1; // Hardware flting pt always present 40 | } 41 | #else // FLTHDWR 42 | 43 | checkfpu() 44 | { 45 | return -1; // Assume all modern machines have FPU (excludes 80386 without 80387) 46 | } 47 | 48 | #endif // FLTHDWR 49 | #endif // FLOAT 50 | -------------------------------------------------------------------------------- /test/d.sbl: -------------------------------------------------------------------------------- 1 | * 2 | 3 | &anchor = &trim = 1 4 | lastline = 5 | * state is null when normal text, non-null when processing block 6 | * comment 7 | inside.comment = 8 | :(loop) 9 | copy.comment 10 | thisline = trim(' ' substr(thisline,2)) 11 | copy 12 | output = thisline 13 | loop 14 | thisline = nextline 15 | nextline = trim(input) :f(end) 16 | lines = lines + 1 17 | output = lpad( lines,5) ' ' 'this ' thisline '$' 18 | output = lpad( lines,5) ' ' 'next ' nextline '$' 19 | output = lpad( lines,5) ' ' inside.comment 20 | 21 | * gt(lines,27200) :s(copy.rest) 22 | * gt(lines,1000) :s(end) 23 | differ(inside.comment) :s(in.comment) 24 | * here looking for start of block 25 | ident(nextline) :s(copy) 26 | * turn line with only initial comment characer into null line 27 | thisline = ident(thisline,'*') :s(copy) 28 | differ(substr(nextline,1,1), '{') :s(copy) 29 | output = 'BLOCK comment start at ' lines 30 | inside.comment = 'yes' 31 | * if opener stands alone, just copy it out 32 | eq(size(thisline),1) :s(copy) 33 | * here to swap opener in next line with this line 34 | output = '{' 35 | output = ' ' substr(nextline,2) 36 | nextline = input :(loop) 37 | 38 | in.comment 39 | * here if inside block comment 40 | ident(thisline) :s(copy) 41 | leq(substr(thisline,1,1), '*') :s(copy.comment) 42 | leq(substr(thisline,1,1), ' ') :s(copy.comment) 43 | output = 'BLOCK comment end ' lines 44 | output = '}' 45 | inside.comment = :(copy) 46 | copy.rest 47 | output = thisline 48 | output = nextline 49 | copy.r 50 | output = input :s(copy.r) 51 | * initial state 52 | end 53 | -------------------------------------------------------------------------------- /osint/sysgc.c: -------------------------------------------------------------------------------- 1 | /* 2 | Copyright 1987-2012 Robert B. K. Dewar and Mark Emmer. 3 | Copyright 2012-2013 David Shields 4 | 5 | This file is part of Macro SPITBOL. 6 | 7 | Macro SPITBOL is free software: you can redistribute it and/or modify 8 | it under the terms of the GNU General Public License as published by 9 | the Free Software Foundation, either version 2 of the License, or 10 | (at your option) any later version. 11 | 12 | Macro SPITBOL is distributed in the hope that it will be useful, 13 | but WITHOUT ANY WARRANTY; without even the implied warranty of 14 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 15 | GNU General Public License for more details. 16 | 17 | You should have received a copy of the GNU General Public License 18 | along with Macro SPITBOL. If not, see . 19 | */ 20 | 21 | /* 22 | / File: SYSGC.C Version: 01.01 23 | / --------------------------------------- 24 | / 25 | / zysgc - notification of system garbage collection 26 | / 27 | / zysgc is called before and after a garbage collection. 28 | / Some systems may wish to take special action using this information. 29 | / 30 | / Parameters: 31 | / XR - flag for garbage collection 32 | / <>0 garbage collection commencing 33 | / =0 garbage collection concluding 34 | / WA - starting location of dynamic area 35 | / WB - next available location 36 | / WC - last available location 37 | / Returns 38 | / Nothing 39 | / Preserves all registers 40 | */ 41 | 42 | #include "port.h" 43 | #include "save.h" 44 | 45 | zysgc() 46 | { 47 | in_gbcol = XR(word); // retain information 48 | return NORMAL_RETURN; 49 | } 50 | -------------------------------------------------------------------------------- /demos/keyword.sbl: -------------------------------------------------------------------------------- 1 | * PROGRAM TO COUNT THE OCCURRENCES OF KEYWORDS 2 | * IN A PIECE OF TEXT. THE SEARCH FOR KEYWORDS 3 | * IS EFFICIENTLY PERFORMED BY HASHING IN A TABLE 4 | * 5 | * Reads keywords to index from file "keywords", and 6 | * main text from file "keytext". 7 | * 8 | * Demonstration program by Robert B. K. Dewar 9 | * 10 | &ANCHOR = &TRIM = 1 11 | INPUT(.KEYS,1,'keywords') :F(NOFILE1) 12 | INPUT(.INPUT,2,'keytext') :F(NOFILE2) 13 | 14 | PUNC = " .,;:'!" 15 | WORDPAT = BREAK(PUNC) $ WORD SPAN(PUNC) 16 | KEYTABLE = TABLE(1001) 17 | * 18 | * LOOP TO READ AND HASH KEYS 19 | * 20 | KEYLOOP KEYTABLE = 0 :S(KEYLOOP) 21 | * 22 | * A SPACE IS ADDED TO LINES OF TEXT TO ENSURE MATCH SUCCESS 23 | * 24 | READLOOP INP = INPUT ' ' :F(CONVERT) 25 | * 26 | * INDIVIDUAL WORDS ARE EXTRACTED BY PATTERN MATCHING 27 | * 28 | WORDLOOP INP ? WORDPAT = 29 | * 30 | * ONLY INCREMENT IF IT IS A DESIRED KEYWORD 31 | * 32 | KEYTABLE = DIFFER(ENTRY = KEYTABLE) ENTRY + 1 33 | DIFFER(INP) :S(WORDLOOP)F(READLOOP) 34 | * 35 | * FAILURE POINT 36 | * 37 | NOFILE1 TERMINAL = 'Missing input file "Keywords"' :(END) 38 | NOFILE2 TERMINAL = 'Missing input file "Keytext"' :(END) 39 | CONVFL TERMINAL = 'NO KEYWORDS FOUND' :(END) 40 | * 41 | * EXTRACT THE ENTRIES FROM THE TABLE INTO AN ARRAY 42 | * 43 | CONVERT A = CONVERT(KEYTABLE,'ARRAY') :F(CONVFL) 44 | OUTPUT = ' KEYWORD NUMBER OF OCCURRENCES' 45 | OUTPUT = ' ------- ---------------------' 46 | OUTPUT = 47 | * 48 | * PRINT THE ENTRIES 49 | * 50 | I = 1 51 | PRINT OUTPUT = LPAD(A[I,1],13) DUPL(' . ',5) A[I,2] :F(END) 52 | I = I + 1 :(PRINT) 53 | END 54 | -------------------------------------------------------------------------------- /osint/sysrw.c: -------------------------------------------------------------------------------- 1 | /* 2 | Copyright 1987-2012 Robert B. K. Dewar and Mark Emmer. 3 | Copyright 2012-2013 David Shields 4 | 5 | This file is part of Macro SPITBOL. 6 | 7 | Macro SPITBOL is free software: you can redistribute it and/or modify 8 | it under the terms of the GNU General Public License as published by 9 | the Free Software Foundation, either version 2 of the License, or 10 | (at your option) any later version. 11 | 12 | Macro SPITBOL is distributed in the hope that it will be useful, 13 | but WITHOUT ANY WARRANTY; without even the implied warranty of 14 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 15 | GNU General Public License for more details. 16 | 17 | You should have received a copy of the GNU General Public License 18 | along with Macro SPITBOL. If not, see . 19 | */ 20 | 21 | /* 22 | / zysrw - rewind file 23 | / 24 | / Parameters 25 | / WA - pointer to FCBLK or 0 26 | / XR - pointer to SCBLK containing rewind argument 27 | / Returns: 28 | / Nothing 29 | / Exits: 30 | / 1 - file doesn't exit 31 | / 2 - rewind not allowed on this device 32 | / 3 - I/O error 33 | / 34 | */ 35 | 36 | #include "port.h" 37 | 38 | zysrw() 39 | { 40 | register struct fcblk *fcb = WA (struct fcblk *); 41 | register struct ioblk *iob = ((struct ioblk *) (fcb->iob)); 42 | 43 | // ensure the file is open 44 | if ( !(iob->flg1 & IO_OPN) ) 45 | return EXIT_1; 46 | 47 | // see if this file can be LSEEK'ed 48 | if ( LSEEK(iob->fdn, (FILEPOS)0, 1) < (FILEPOS)0 ) 49 | return EXIT_2; 50 | 51 | // seek to the beginning 52 | if (doset( iob, 0L, 0 ) == (FILEPOS)-1) 53 | return EXIT_3; 54 | 55 | return NORMAL_RETURN; 56 | } 57 | -------------------------------------------------------------------------------- /test/ru.txt: -------------------------------------------------------------------------------- 1 | т 2 | табак 3 | Красавице, которая нюхала 4 | 5 | Возможно ль? вместо роз, Амуром 6 | насажденных, 7 | Тюльпанов, гордо наклоненных, 8 | Душистых ландышей, ясминов и лилей, 9 | Которых ты всегда любила 10 | И прежде всякий день носила 11 | На мраморной груди твоей-- 12 | Возможно ль, милая Климена? 13 | Какая странная во вкусе перемена! . . 14 | Ты любишь обонять не утренний цветок, 15 | А вредную траву зелену, 16 | Искусством превращену 17 | В пушистый порошок! 18 | Пускай уже седой профессор Геттингена, 19 | На старой кафедре согнувшися дугой, 20 | Вперив в латинщину глубокий разум свой, 21 | Раскашлявшись, табак толченый 22 | Пихает в длинный нос иссохшею рукой. 23 | Пускай младой драгун усатый 24 | Поутру, сидя у окна, 25 | Стаканы сушит все до дна, 26 | С остатком утреннего сна 27 | Из трубки пенковой дым гонит сероватый. 28 | Пускай красавица шестидесяти лет, 29 | У граций в отпуску, и у любви в отставке 30 | У коей держится вся прелесть на подставке, 31 | У коей без морщин на теле места нет, 32 | Чаек в прикуску попивает, 33 | И с верным табаком печали забывает, 34 | Злословит, молится, зевает. 35 | А ты, прелестная! . . но если уж табак 36 | Так нравится тебе--о пыл воображенья! 37 | Ах! если, превращенный в прах, 38 | И в табакерке, в заточеньи, 39 | Я в персты нежные твои попасться мог, 40 | Тогда б в сердечном восхищеньи 41 | Рассыпался на грудь под шалевый платок 42 | И даже, может быть. . о сладость 43 | вожделенья 44 | ...До тайных прелестей, которых сам 45 | Эрот 46 | Запрятал за леса и горы, 47 | Чтоб не могли нескромны взоры 48 | Открыть вместилище божественных 49 | красот. 50 | Но что! мечта, мечта пустая. 51 | Не будет этого никак. 52 | Судьба завистливая злая! 53 | Ах, отчего я не табак! . . 54 | 55 | End of the Project Gutenberg EBook of Krasavitse, Kotoraya Niuhala Tabak, by 56 | Aleksandr Sergeevich Pushkin 57 | -------------------------------------------------------------------------------- /osint/sysen.c: -------------------------------------------------------------------------------- 1 | /* 2 | Copyright 1987-2012 Robert B. K. Dewar and Mark Emmer. 3 | Copyright 2012-2013 David Shields 4 | 5 | This file is part of Macro SPITBOL. 6 | 7 | Macro SPITBOL is free software: you can redistribute it and/or modify 8 | it under the terms of the GNU General Public License as published by 9 | the Free Software Foundation, either version 2 of the License, or 10 | (at your option) any later version. 11 | 12 | Macro SPITBOL is distributed in the hope that it will be useful, 13 | but WITHOUT ANY WARRANTY; without even the implied warranty of 14 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 15 | GNU General Public License for more details. 16 | 17 | You should have received a copy of the GNU General Public License 18 | along with Macro SPITBOL. If not, see . 19 | */ 20 | 21 | /* 22 | / File: SYSEN.C Version: 01.02 23 | / --------------------------------------- 24 | / 25 | / Contents: Function zysen 26 | */ 27 | 28 | /* 29 | / zysen - endfile 30 | / 31 | / endfile is an artifact from the FORTRAN days and is supposed to 32 | / close a file. However, the file may be reopened, etc. We just 33 | / close it. 34 | / 35 | / Parameters: 36 | / WA - FCBLK pointer or 0 37 | / XR - SCBLK pointer (ENDFILE argument) 38 | / Returns: 39 | / Nothing 40 | / Exits: 41 | / 1 - file does not exist 42 | / 2 - inappropriate file 43 | / 3 - i/o error 44 | */ 45 | 46 | #include "port.h" 47 | 48 | zysen() 49 | { 50 | register struct fcblk *fcb = WA (struct fcblk *); 51 | register struct ioblk *iob = ((struct ioblk *) (fcb->iob)); 52 | 53 | // ensure the file is open 54 | if ( !(iob->flg1 & IO_OPN) ) 55 | return EXIT_1; 56 | 57 | // now close it 58 | if (osclose( iob )) 59 | return EXIT_3; 60 | 61 | return NORMAL_RETURN; 62 | } 63 | -------------------------------------------------------------------------------- /osint/cpys2sc.c: -------------------------------------------------------------------------------- 1 | /* 2 | Copyright 1987-2012 Robert B. K. Dewar and Mark Emmer. 3 | Copyright 2012-2015 David Shields 4 | 5 | This file is part of Macro SPITBOL. 6 | 7 | Macro SPITBOL is free software: you can redistribute it and/or modify 8 | it under the terms of the GNU General Public License as published by 9 | the Free Software Foundation, either version 2 of the License, or 10 | (at your option) any later version. 11 | 12 | Macro SPITBOL is distributed in the hope that it will be useful, 13 | but WITHOUT ANY WARRANTY; without even the implied warranty of 14 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 15 | GNU General Public License for more details. 16 | 17 | You should have received a copy of the GNU General Public License 18 | along with Macro SPITBOL. If not, see . 19 | */ 20 | 21 | /* 22 | / File: CPYS2SC.C Version: 01.01 23 | / --------------------------------------- 24 | / 25 | / Contents: Function cpy2sc 26 | */ 27 | 28 | /* 29 | / cpys2sc( cp, scptr, maxlen ) 30 | / 31 | / cpys2sc() copies a C style string pointed to by cp into the SCBLK 32 | / pointed to by scptr. 33 | / 34 | / Parameters: 35 | / cp pointer to C style string 36 | / scptr pointer to SCBLK to receive copy of string 37 | / maxlen maximum length of string area within SCBLK 38 | / Returns: 39 | / Nothing. 40 | / 41 | / Side Effects: 42 | / Modifies contents of passed SCBLK (scptr). 43 | */ 44 | 45 | #include "port.h" 46 | 47 | void cpys2sc( cp, scptr, maxlen ) 48 | 49 | char *cp; 50 | struct scblk *scptr; 51 | word maxlen; 52 | 53 | { 54 | register word i; 55 | register char *scbcp; 56 | 57 | scptr->typ = TYPE_SCL; 58 | scbcp = scptr->str; 59 | for( i = 0 ; i < maxlen && ((*scbcp++ = *cp++) != 0) ; i++ ) 60 | ; 61 | scptr->len = i; 62 | while (i++ & (sizeof(word) - 1)) 63 | *scbcp++ = 0; 64 | } 65 | -------------------------------------------------------------------------------- /osint/st2d.c: -------------------------------------------------------------------------------- 1 | /* 2 | Copyright 1987-2012 Robert B. K. Dewar and Mark Emmer. 3 | Copyright 2012-2013 David Shields 4 | 5 | This file is part of Macro SPITBOL. 6 | 7 | Macro SPITBOL is free software: you can redistribute it and/or modify 8 | it under the terms of the GNU General Public License as published by 9 | the Free Software Foundation, either version 2 of the License, or 10 | (at your option) any later version. 11 | 12 | Macro SPITBOL is distributed in the hope that it will be useful, 13 | but WITHOUT ANY WARRANTY; without even the implied warranty of 14 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 15 | GNU General Public License for more details. 16 | 17 | You should have received a copy of the GNU General Public License 18 | along with Macro SPITBOL. If not, see . 19 | */ 20 | 21 | // st2d.c - convert integer to decimal string 22 | 23 | #include "port.h" 24 | 25 | static int stc_d (char *out, unsigned int in, int outlen, int signflag); 26 | 27 | static int stc_d(out, in, outlen, signflag) 28 | register char *out; 29 | register unsigned int in; 30 | register int outlen; 31 | int signflag; 32 | { 33 | char revnum [20]; 34 | register int i=0; 35 | register char *out0 = out; 36 | 37 | if (outlen<=0) return (0); 38 | 39 | if (in == 0) revnum[i++]=0; 40 | else 41 | while (in) 42 | { 43 | revnum[i++] = in - (in/10)*10; 44 | in /= 10; 45 | } 46 | 47 | if (signflag) 48 | { 49 | *out++ = '-'; 50 | outlen--; 51 | } 52 | 53 | for (; i && outlen; i--, outlen--) 54 | *out++ = revnum[i-1] + '0'; 55 | 56 | *out = '\0'; 57 | 58 | return (out-out0); 59 | 60 | } 61 | 62 | 63 | int 64 | stcu_d(out, in, outlen) 65 | char *out; 66 | unsigned int in; 67 | int outlen; 68 | { 69 | return (stc_d(out, in, outlen, 0)); 70 | } 71 | -------------------------------------------------------------------------------- /osint/sysdc.c: -------------------------------------------------------------------------------- 1 | /* 2 | Copyright 1987-2012 Robert B. K. Dewar and Mark Emmer. 3 | Copyright 2012-2015 David Shields 4 | 5 | This file is part of Macro SPITBOL. 6 | 7 | Macro SPITBOL is free software: you can redistribute it and/or modify 8 | it under the terms of the GNU General Public License as published by 9 | the Free Software Foundation, either version 2 of the License, or 10 | (at your option) any later version. 11 | 12 | Macro SPITBOL is distributed in the hope that it will be useful, 13 | but WITHOUT ANY WARRANTY; without even the implied warranty of 14 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 15 | GNU General Public License for more details. 16 | 17 | You should have received a copy of the GNU General Public License 18 | along with Macro SPITBOL. If not, see . 19 | */ 20 | 21 | /* 22 | / zysdc - check system expiration date 23 | / 24 | / zysdc prints any header messages and may check 25 | / the date to see if execution is allowed to proceed. 26 | / 27 | / Parameters: 28 | / Nothing 29 | / Returns 30 | / Nothing 31 | / No return if execution not permitted 32 | / 33 | */ 34 | 35 | #include "port.h" 36 | 37 | zysdc() 38 | { 39 | struct scblk *pheadv = GET_DATA_OFFSET(headv,struct scblk *); 40 | // announce name and copyright 41 | return NORMAL_RETURN; 42 | if (!dcdone && !(spitflag & NOBRAG)) 43 | { 44 | dcdone = 1; // Only do once per run 45 | 46 | write( STDERRFD, "LINUX SPITBOL", 13); 47 | 48 | return NORMAL_RETURN; 49 | #if RUNTIME 50 | write( STDERRFD, " Runtime", 8); 51 | #endif // RUNTIME 52 | 53 | write( STDERRFD, " Release ", 10); 54 | write( STDERRFD, pheadv->str, pheadv->len ); 55 | write( STDERRFD, pid1blk->str, pid1blk->len ); 56 | wrterr(" copyright 1987-2012 robert b. k. dewar and mark emmer."); 57 | } 58 | return NORMAL_RETURN; 59 | } 60 | -------------------------------------------------------------------------------- /test/fmt.sbl: -------------------------------------------------------------------------------- 1 | * reformat minimal code to use tabs and more free-form input 2 | * fixed format: 3 | * 8 opcode 4 | * 13 arguments 5 | * 30 comments 6 | 7 | * this version just inserts spaces so opcode starts at 9, arguments at 17, end comments at 32 (with '; ' prefix) 8 | * a separate program can then be used to replace runs of blanks with tabs where appropriate 9 | 10 | * dave shields jan 2015 11 | 12 | &anchor = &trim = 1 13 | tab = char(9) 14 | whitespace = span(' ') 15 | 16 | loop 17 | label = opcode = args = comment = text = 18 | 19 | * copy comments, conditional assembly, and stmts with opcode but no args or comment 20 | 21 | line = input :f(end) 22 | line ';' :s(copy.line) 23 | line '.' :s(copy.line) 24 | 25 | * just copy for certain opcodes. 26 | 27 | opcode = substr(line,8,3) 28 | ident(opcode,'dtc') :s(copy.op) 29 | ident(opcode,'ejc') :s(copy.op) 30 | ident(opcode,'err') :s(copy.op) 31 | ident(opcode,'erb') :s(copy.op) 32 | ident(opcode,'ttl') :s(copy.op) 33 | 34 | * done if just opcode with no args or comment 35 | 36 | le(size(line),10) :s(copy.op) 37 | * assume rest of line is argument string 38 | arg_comment = substr(line,13) 39 | arg_comment break(' ') . args span(' ') rem . comment :s(loop.1) 40 | * if no whitespace then rest of line is just argument 41 | args = substr(line,13) 42 | loop.1 43 | text = substr(line,1,7) ' ' substr(line,8,3) ' ' rpad(args,24) 44 | 45 | * done if no comment 46 | 47 | lt(size(line,30)) :s(copy.text) 48 | 49 | * append comment 50 | text = text '; ' comment :s(copy.text) 51 | copy.comment 52 | 53 | * insert space to align with opcode if possible 54 | 55 | line = ident(substr(line,1,7),'; ') ' ' substr(line,8) 56 | copy.line 57 | text = line :(copy.text) 58 | copy.op 59 | text = substr(line,1,7) ' ' opcode 60 | * add arguments and comment if present 61 | text = gt(size(text),10) text ' ' substr(line,13) 62 | :(copy.text) 63 | copy.text 64 | output = trim(text) :(loop) 65 | copy.ejc 66 | text = tab 'ejc' :(copy.text) 67 | end 68 | 69 | 70 | 71 | 72 | 73 | -------------------------------------------------------------------------------- /osint/sysef.c: -------------------------------------------------------------------------------- 1 | /* 2 | Copyright 1987-2012 Robert B. K. Dewar and Mark Emmer. 3 | Copyright 2012-2013 David Shields 4 | 5 | This file is part of Macro SPITBOL. 6 | 7 | Macro SPITBOL is free software: you can redistribute it and/or modify 8 | it under the terms of the GNU General Public License as published by 9 | the Free Software Foundation, either version 2 of the License, or 10 | (at your option) any later version. 11 | 12 | Macro SPITBOL is distributed in the hope that it will be useful, 13 | but WITHOUT ANY WARRANTY; without even the implied warranty of 14 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 15 | GNU General Public License for more details. 16 | 17 | You should have received a copy of the GNU General Public License 18 | along with Macro SPITBOL. If not, see . 19 | */ 20 | 21 | /* 22 | / File: SYSEF.C Version: 01.02 23 | / --------------------------------------- 24 | / 25 | / Contents: Function zysef 26 | */ 27 | 28 | /* 29 | / zysef - eject file 30 | / 31 | / zysef writes an eject (form-feed) to a file. 32 | / 33 | / Parameters: 34 | / WA - FCBLK pointer or 0 35 | / XR - SCBLK pointer (EJECT argument) 36 | / Returns: 37 | / Nothing 38 | / Exits: 39 | / 1 - file does not exist 40 | / 2 - inappropriate file 41 | / 3 - i/o error 42 | */ 43 | 44 | #include "port.h" 45 | 46 | /* 47 | / ffscblk is one of the few SCBLKs that can be directly allocated 48 | / using a C struct! 49 | */ 50 | static struct scblk ffscblk = 51 | { 52 | 0, // type word - ignore 53 | 1, // string length 54 | '\f' // string is a form-feed 55 | }; 56 | 57 | zysef() 58 | { 59 | register struct fcblk *fcb = WA(struct fcblk *); 60 | register struct ioblk *iob = ((struct ioblk *) (fcb->iob)); 61 | 62 | // ensure the file is open 63 | if ( !(iob->flg1 & IO_OPN) ) 64 | return EXIT_1; 65 | 66 | // write the data, fail if unsuccessful 67 | if ( oswrite( fcb->mode, fcb->rsz, ffscblk.len, iob, &ffscblk) != 0 ) 68 | return EXIT_2; 69 | 70 | return NORMAL_RETURN; 71 | } 72 | -------------------------------------------------------------------------------- /osint/sysid.c: -------------------------------------------------------------------------------- 1 | /* 2 | Copyright 1987-2012 Robert B. K. Dewar and Mark Emmer. 3 | Copyright 2012-2013 David Shields 4 | 5 | This file is part of Macro SPITBOL. 6 | 7 | Macro SPITBOL is free software: you can redistribute it and/or modify 8 | it under the terms of the GNU General Public License as published by 9 | the Free Software Foundation, either version 2 of the License, or 10 | (at your option) any later version. 11 | 12 | Macro SPITBOL is distributed in the hope that it will be useful, 13 | but WITHOUT ANY WARRANTY; without even the implied warranty of 14 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 15 | GNU General Public License for more details. 16 | 17 | You should have received a copy of the GNU General Public License 18 | along with Macro SPITBOL. If not, see . 19 | */ 20 | 21 | /* 22 | / File: SYSID.C Version: 01.02 23 | / --------------------------------------- 24 | / 25 | / Contents: Function zysid 26 | */ 27 | 28 | /* 29 | / zysid - identify system 30 | / 31 | / zysid returns two strings identifying the Spitbol system. 32 | / 33 | / Parameters: 34 | / None 35 | / Returns: 36 | / XR - pointer to SCBLK containing suffix to Spitbol header 37 | / XL - pointer to SCBLK containing 2nd header line 38 | / Exits: 39 | / None 40 | */ 41 | 42 | #include "port.h" 43 | #include 44 | #include 45 | 46 | /* 47 | / define actual headers elsewhere to overcome problems in initializing 48 | / the two SCBLKs. Use id2blk instead of tscblk because tscblk may 49 | / be active with an error message when zysid is called. 50 | */ 51 | 52 | zysid() 53 | 54 | { 55 | time_t now; 56 | register char *cp; 57 | char * s; 58 | int i; 59 | 60 | 61 | SET_XR( pid1blk ); 62 | now = time(NULL); 63 | gettype( pid2blk, id2blk_length ); 64 | cp = pid2blk->str + pid2blk->len; 65 | *cp++ = ' '; 66 | *cp++ = ' '; 67 | s = ctime(&now); 68 | for (i=0;ilen = pid2blk->len + 2 + strlen(s); 70 | SET_XL( pid2blk ); 71 | return NORMAL_RETURN; 72 | } 73 | -------------------------------------------------------------------------------- /osint/break.c: -------------------------------------------------------------------------------- 1 | /* 2 | Copyright 1987-2012 Robert B. K. Dewar and Mark Emmer. 3 | Copyright 2012-2015 David Shields 4 | 5 | This file is part of Macro SPITBOL. 6 | 7 | Macro SPITBOL is free software: you can redistribute it and/or modify 8 | it under the terms of the GNU General Public License as published by 9 | the Free Software Foundation, either version 2 of the License, or 10 | (at your option) any later version. 11 | 12 | Macro SPITBOL is distributed in the hope that it will be useful, 13 | but WITHOUT ANY WARRANTY; without even the implied warranty of 14 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 15 | GNU General Public License for more details. 16 | 17 | You should have received a copy of the GNU General Public License 18 | along with Macro SPITBOL. If not, see . 19 | */ 20 | 21 | /* 22 | / startbrk( ) 23 | / 24 | / startbrk starts up the logic for trapping user keyboard interrupts. 25 | */ 26 | 27 | #include "port.h" 28 | 29 | int brkpnd; 30 | 31 | #include 32 | #undef SigType 33 | #define SigType void 34 | 35 | static SigType (*cstat)(int); 36 | void catchbrk (int sig); 37 | void rearmbrk (void); 38 | 39 | void startbrk() // start up break logic 40 | { 41 | brkpnd = 0; 42 | cstat = signal(SIGINT,catchbrk); // set to catch control-C 43 | } 44 | 45 | 46 | 47 | void endbrk() // terminate break logic 48 | { 49 | signal(SIGINT, cstat); // restore original trap value 50 | } 51 | 52 | 53 | /* 54 | * catchbrk() - come here when a user interrupt occurs 55 | */ 56 | SigType catchbrk(sig) 57 | int sig; 58 | { 59 | word stmct, stmcs; 60 | brkpnd++; 61 | stmct = GET_MIN_VALUE(stmct,word) - 1; 62 | stmcs = GET_MIN_VALUE(stmcs,word); 63 | SET_MIN_VALUE(stmct,1,word); // force STMGO loop to check 64 | SET_MIN_VALUE(stmcs,stmcs - stmct,word); // counters quickly 65 | SET_MIN_VALUE(polct,1,word); // force quick SYSPL call 66 | } 67 | 68 | 69 | void rearmbrk() // rearm after a trap occurs 70 | { 71 | signal(SIGINT,catchbrk); // set to catch traps 72 | } 73 | 74 | -------------------------------------------------------------------------------- /osint/oswait.c: -------------------------------------------------------------------------------- 1 | /* 2 | Copyright 1987-2012 Robert B. K. Dewar and Mark Emmer. 3 | Copyright 2012-2013 David Shields 4 | 5 | This file is part of Macro SPITBOL. 6 | 7 | Macro SPITBOL is free software: you can redistribute it and/or modify 8 | it under the terms of the GNU General Public License as published by 9 | the Free Software Foundation, either version 2 of the License, or 10 | (at your option) any later version. 11 | 12 | Macro SPITBOL is distributed in the hope that it will be useful, 13 | but WITHOUT ANY WARRANTY; without even the implied warranty of 14 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 15 | GNU General Public License for more details. 16 | 17 | You should have received a copy of the GNU General Public License 18 | along with Macro SPITBOL. If not, see . 19 | */ 20 | 21 | /* 22 | / oswait( pid ) 23 | / 24 | / oswait() waits for the termination of the process with id pid. 25 | / 26 | / Parameters: 27 | / pid prcoess id 28 | / Returns: 29 | / nothing 30 | / 31 | / V1.01 MBE 07-29-91 . 32 | / V1.02 MBE 12-31-96 Modify for WinNT. 33 | / 34 | */ 35 | 36 | #include "port.h" 37 | 38 | #include 39 | 40 | void oswait( pid ) 41 | int pid; 42 | { 43 | int deadpid, status; 44 | struct chfcb *chptr; 45 | SigType (*hstat)(int), 46 | (*istat)(int), 47 | (*qstat)(int); 48 | 49 | istat = signal( SIGINT, SIG_IGN ); 50 | qstat = signal( SIGQUIT ,SIG_IGN ); 51 | hstat = signal( SIGHUP, SIG_IGN ); 52 | 53 | while ( (deadpid = wait( &status )) != pid && deadpid != -1 ) 54 | { 55 | for ( chptr = GET_MIN_VALUE(r_fcb,struct chfcb *); chptr != 0; 56 | chptr = ((struct chfcb *) (chptr->nxt)) ) 57 | { 58 | if ( deadpid == ((struct ioblk *) (((struct fcblk *) (chptr->fcp))->iob))->pid ) 59 | { 60 | ((struct ioblk *) (((struct fcblk *) (chptr->fcp))->iob))->flg2 |= IO_DED; 61 | break; 62 | } 63 | } 64 | } 65 | 66 | signal( SIGINT,istat ); 67 | signal( SIGQUIT,qstat ); 68 | signal( SIGHUP,hstat ); 69 | } 70 | -------------------------------------------------------------------------------- /osint/testty.c: -------------------------------------------------------------------------------- 1 | /* 2 | Copyright 1987-2012 Robert B. K. Dewar and Mark Emmer. 3 | Copyright 2012-2013 David Shields 4 | 5 | This file is part of Macro SPITBOL. 6 | 7 | Macro SPITBOL is free software: you can redistribute it and/or modify 8 | it under the terms of the GNU General Public License as published by 9 | the Free Software Foundation, either version 2 of the License, or 10 | (at your option) any later version. 11 | 12 | Macro SPITBOL is distributed in the hope that it will be useful, 13 | but WITHOUT ANY WARRANTY; without even the implied warranty of 14 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 15 | GNU General Public License for more details. 16 | 17 | You should have received a copy of the GNU General Public License 18 | along with Macro SPITBOL. If not, see . 19 | */ 20 | 21 | /* 22 | / testty( fd ) 23 | / 24 | / testty() determines whether or not a file descriptor represents a 25 | / teletype (non-block) device. 26 | / 27 | / Parameters: 28 | / fd file descriptor to test 29 | / Returns: 30 | / 0 if fd is a tty / -1 if fd is not a tty 31 | */ 32 | #include "port.h" 33 | 34 | #define RAW_BIT RAW 35 | 36 | #include 37 | struct stat statbuf; 38 | #include 39 | struct termios termiosbuf; 40 | 41 | int testty( fd ) 42 | 43 | int fd; 44 | 45 | { 46 | if (fstat(fd, &statbuf)) 47 | return -1; 48 | return S_ISCHR(statbuf.st_mode) ? 0 : -1; 49 | } 50 | 51 | 52 | /* 53 | / ttyraw( fd, flag ) 54 | / 55 | / ttyraw() sets or clears the raw input mode in an teletype device. 56 | / 57 | / Parameters: 58 | / fd file descriptor 59 | / flag 0 to clear raw mode / non-zero to set raw mode 60 | / Returns: 61 | / none 62 | / 63 | */ 64 | 65 | void ttyraw( fd, flag ) 66 | 67 | int fd; 68 | int flag; 69 | 70 | { 71 | // read current params 72 | if ( testty( fd ) ) return; // exit if not tty 73 | tcgetattr( fd, &termiosbuf ); 74 | if ( flag ) 75 | termiosbuf.c_lflag &= ~(ICANON|ECHO); // Setting 76 | else 77 | termiosbuf.c_lflag |= (ICANON|ECHO); // Clearing 78 | 79 | tcsetattr( fd, TCSANOW, &termiosbuf ); // store device flags 80 | } 81 | -------------------------------------------------------------------------------- /demos/kwic1.sbl: -------------------------------------------------------------------------------- 1 | * Simple KWIC program. 2 | * 3 | * The program reads a keyword file (one word per line) to build a 4 | * table of words to index. The files is named KEYWORDS. 5 | * 6 | * The input file is then read, and each occurrence of the one of the 7 | * keywords is displayed, with NCHARS characters displayed on each side. 8 | * 9 | * Sample usage: 10 | * SPITBOL KWIC2 RESULTS 11 | * 12 | &ANCHOR = 1 13 | 14 | * Number of characters to display on either side of the matched word: 15 | * 16 | NCHARS = 30 17 | 18 | * Read keyword file and save words in a table in lower case form. 19 | * 20 | INPUT(.KEYFILE,1,'KEYWORDS') :F(END) 21 | T = TABLE(101) 22 | READKEY WORD = KEYFILE :F(ENDKEY) 23 | T = 1 :(READKEY) 24 | ENDKEY ENDFILE(1) 25 | 26 | * Establish the definition of characters that make up a word. 27 | * 28 | LETTERS = &UCASE &LCASE "-'" 29 | 30 | * Pattern to obtain the NCHARS preceeding and following a matched word. 31 | * 32 | DPAT = TAB(*KSTART) LEN(NCHARS) . PREVIOUS TAB(*WEND) 33 | + (LEN(NCHARS) | REM) . POST 34 | 35 | * Pattern to obtain the next word. Note that the deferred variable 36 | * WEND is used to index through the subject. 37 | * 38 | WPAT = TAB(*WEND) BREAK(LETTERS) @WSTART SPAN(LETTERS) . WORD @WEND 39 | 40 | * Initialize variables. 41 | * 42 | LINE = DUPL(" ",NCHARS) 43 | WEND = NCHARS 44 | 45 | * Append next input line to LINE. 46 | * 47 | MORE LINE = LINE " " INPUT :F(END) 48 | 49 | * Find next word in LINE. 50 | * 51 | GTWORD LINE ? WPAT :F(MORE) 52 | 53 | * Is it a keyword? 54 | * 55 | DIFFER(T) :F(GTWORD) 56 | 57 | * Get cursor position of previous NCHARS. 58 | * 59 | KSTART = WSTART - NCHARS 60 | 61 | * If we need more characters to display the following NCHARS, obtain them. 62 | * 63 | CKSIZE LE(WEND + NCHARS, SIZE(LINE)) :S(DISPLAY) 64 | LINE = LINE " " INPUT :S(CKSIZE) 65 | 66 | * Peel off the previous and following NCHARS, and display them. 67 | * 68 | DISPLAY LINE ? DPAT 69 | OUTPUT = PREVIOUS " " WORD " " POST 70 | 71 | * Now remove characters no longer needed from the beginning of LINE. 72 | * 73 | LINE = SUBSTR(LINE, WEND + 1 - NCHARS) 74 | WEND = NCHARS :(GTWORD) 75 | 76 | END 77 | -------------------------------------------------------------------------------- /osint/syspl.c: -------------------------------------------------------------------------------- 1 | /* 2 | Copyright 1987-2012 Robert B. K. Dewar and Mark Emmer. 3 | Copyright 2012-2013 David Shields 4 | 5 | This file is part of Macro SPITBOL. 6 | 7 | Macro SPITBOL is free software: you can redistribute it and/or modify 8 | it under the terms of the GNU General Public License as published by 9 | the Free Software Foundation, either version 2 of the License, or 10 | (at your option) any later version. 11 | 12 | Macro SPITBOL is distributed in the hope that it will be useful, 13 | but WITHOUT ANY WARRANTY; without even the implied warranty of 14 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 15 | GNU General Public License for more details. 16 | 17 | You should have received a copy of the GNU General Public License 18 | along with Macro SPITBOL. If not, see . 19 | */ 20 | 21 | /* 22 | / File: SYSPL.C Version: 01.01 23 | / --------------------------------------- 24 | / 25 | / zyspl - interface polling from SPITBOL 26 | / 27 | / zyspl is called before statement execution to allow the interface 28 | / to regain control if desired. 29 | / Parameters: 30 | / WA - reason for call 31 | / =0 periodic polling 32 | / =1 breakpoint hit 33 | / =2 completion of statement stepping 34 | / WB - current statement number 35 | / XL - SCBLK of result if WA = 3. 36 | / Normal Return 37 | / WA - number of statements to elapse before calling SYSPL again. 38 | / Exits: 39 | / 1 - set breakpoint 40 | / 2 - single step 41 | / 3 - evaluate expression 42 | / normal exit - no special action 43 | */ 44 | 45 | #include "port.h" 46 | 47 | #define pollevent() 48 | extern rearmbrk (void); 49 | extern int brkpnd; 50 | #define stmtDelay PollCount 51 | 52 | 53 | zyspl() 54 | { 55 | // Make simple polling case the fastest by avoiding switch statement 56 | if (WA(word) == 0) { 57 | #if !ENGINE 58 | pollevent(); 59 | #endif // !ENGINE 60 | SET_WA(stmtDelay); // Poll finished or Continue 61 | #if !ENGINE 62 | if (brkpnd) { 63 | brkpnd = 0; // User interrupt 64 | rearmbrk(); // allow breaks again 65 | return EXIT_1; 66 | } 67 | #endif 68 | } 69 | return NORMAL_RETURN; 70 | } 71 | 72 | -------------------------------------------------------------------------------- /osint/syscm.c: -------------------------------------------------------------------------------- 1 | /* 2 | Copyright 1987-2012 Robert B. K. Dewar and Mark Emmer. 3 | Copyright 2012-2013 David Shields 4 | 5 | This file is part of Macro SPITBOL. 6 | 7 | Macro SPITBOL is free software: you can redistribute it and/or modify 8 | it under the terms of the GNU General Public License as published by 9 | the Free Software Foundation, either version 2 of the License, or 10 | (at your option) any later version. 11 | 12 | Macro SPITBOL is distributed in the hope that it will be useful, 13 | but WITHOUT ANY WARRANTY; without even the implied warranty of 14 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 15 | GNU General Public License for more details. 16 | 17 | You should have received a copy of the GNU General Public License 18 | along with Macro SPITBOL. If not, see . 19 | */ 20 | 21 | /* 22 | / File: SYSCM.C Version: 01.01 23 | / --------------------------------------- 24 | / 25 | / zyscm - string compare 26 | / 27 | */ 28 | 29 | /* 30 | / 31 | / zyscm is called to make either a strict ASCII or INTERNATIONAL comparison. 32 | / 33 | / This external routine is provided to allow conditional access to 34 | / an alternate collation sequence. Access is 35 | / controlled by the global switch IUSTRG. 36 | / 37 | / Parameters: 38 | / XR - pointer to first string 39 | / WB - first string length 40 | / XL - pointer to second string 41 | / WA - second string length 42 | / Returns 43 | / XL = 0 44 | / Exits: 45 | / 1 - string length exceeded capability of international comparison routine 46 | / 2 - 2nd string < 1st string 47 | / 3 - 2nd string > 1st string 48 | / normal exit - strings equal 49 | / 50 | */ 51 | 52 | #include "port.h" 53 | #if ALTCOMP 54 | long *kvcom_ptr; 55 | 56 | zyscm() 57 | { 58 | register word result; 59 | 60 | if (!kvcom_ptr) // Cheap optimization to speed up 61 | kvcom_ptr = GET_DATA_OFFSET(KVCOM,long *); // &COMPARE consultation 62 | 63 | result = gencmp(XL(char *), XR(char *), WA(word), WB(word), *kvcom_ptr); 64 | 65 | SET_XL(0); 66 | 67 | if (result == 0x80000000) 68 | return EXIT_1; 69 | else if (result == 0) 70 | return NORMAL_RETURN; 71 | else if (result < 0) 72 | return EXIT_2; 73 | else 74 | return EXIT_3; 75 | } 76 | #endif // ALTCOMP 77 | -------------------------------------------------------------------------------- /osint/systm.c: -------------------------------------------------------------------------------- 1 | /* 2 | Copyright 1987-2012 Robert B. K. Dewar and Mark Emmer. 3 | Copyright 2012-2013 David Shields 4 | 5 | This file is part of Macro SPITBOL. 6 | 7 | Macro SPITBOL is free software: you can redistribute it and/or modify 8 | it under the terms of the GNU General Public License as published by 9 | the Free Software Foundation, either version 2 of the License, or 10 | (at your option) any later version. 11 | 12 | Macro SPITBOL is distributed in the hope that it will be useful, 13 | but WITHOUT ANY WARRANTY; without even the implied warranty of 14 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 15 | GNU General Public License for more details. 16 | 17 | You should have received a copy of the GNU General Public License 18 | along with Macro SPITBOL. If not, see . 19 | */ 20 | 21 | /* 22 | / File: SYSTM.C Version: 01.03 23 | / --------------------------------------- 24 | / 25 | / Contents: Function zystm 26 | */ 27 | 28 | /* 29 | / zystm - get execution time so far 30 | / 31 | / zystm is called to obtain the amount of execution time used so far 32 | / since spitbol began execution. The returned value is assumed to be 33 | / in milliseonds, except for 16-bit implementations, which return deciseconds. 34 | / 35 | / Parameters: 36 | / None 37 | / Returns: 38 | / IA - execution time so far in milliseconds or deciseconds. 39 | / 40 | */ 41 | 42 | #include "port.h" 43 | 44 | #ifdef old 45 | #include 46 | #define CLK_TCK sysconf(_SC_CLK_TCK) 47 | 48 | zystm() { 49 | 50 | /* 51 | / process times are in 60ths of second, multiply by 100 52 | / to get 6000ths of second, divide by 6 to get 100ths 53 | */ 54 | struct tms timebuf; 55 | 56 | timebuf.tms_utime = 0; // be sure to init in case failure 57 | times( &timebuf ); // get process times 58 | 59 | /* CLK_TCK is clock ticks/second: 60 | * # of seconds = tms_utime / CLK_TCK 61 | * # of milliseconds = tms_utime * 1000 / CLK_TCK 62 | * 63 | * To avoid overflow, use 64 | * # of milliseconds = tms_utime * (1000/10) / (CLK_TCK / 10) 65 | */ 66 | SET_IA( (timebuf.tms_utime * (1000/10)) / (CLK_TCK/10) ); 67 | return NORMAL_RETURN; 68 | } 69 | #endif 70 | 71 | zystm() { 72 | 73 | SET_IA( 600); 74 | return NORMAL_RETURN; 75 | } 76 | -------------------------------------------------------------------------------- /demos/treesort.sbl: -------------------------------------------------------------------------------- 1 | * PROGRAM TO SORT A SET OF RECORDS ON A KEY USING A TREE SORTING 2 | * TECHNIQUE. 3 | * 4 | * Produces dump at end to display the data structures built. 5 | * Try drawing links between the nodes to visualize the trees. 6 | * 7 | * Reads data from Treesort.in, containing a year, inventor, and 8 | * invention, one per line. 9 | * 10 | * Program by Robert B. K. Dewar. 11 | * 12 | * DATATYPE WITH THE NECESSARY 4 FIELDS 13 | * 14 | DATA('NODE(KEY,DAT,PRED,SUCC)') 15 | &DUMP = 2 16 | &ANCHOR = &TRIM = 1 17 | * 18 | * OPEN INPUT FILE 19 | * 20 | OUTPUT = ~INPUT(.INPUT,1,"treesort.in") 21 | + 'Could not open file treesort.in"' :S(END) 22 | * 23 | * ROUTINE TO ADD "DATA" TO A TREE SORTED BY "KEY". 24 | * "ROOT" IS PASSED BY REFERENCE (IT IS A SPITBOL NAME) 25 | * AND POINTS TO THE TREE TO BE USED. 26 | * 27 | DEFINE('ADNODE(KEY,DATA,ROOT)PTR') :(ADNEND) 28 | * 29 | * CREATE TREE INITIALLY IF NOT YET IN EXISTENCE 30 | * 31 | ADNODE $ROOT = IDENT($ROOT) NODE(KEY,DATA) :S(RETURN) 32 | PTR = $ROOT 33 | * 34 | * SEARCH TO FIND INSERTION POINT IN TREE 35 | * 36 | SEARCH LLE(KEY,KEY(PTR)) :S(BEFORE) 37 | * 38 | * HERE IF NODE FOLLOWS THAT IN TREE 39 | * 40 | AFTER PTR = DIFFER(SUCC(PTR)) SUCC(PTR) :S(SEARCH) 41 | SUCC(PTR) = NODE(KEY,DATA) :S(RETURN) 42 | * 43 | * HERE IF KEY PRECEDES THAT IN TREE 44 | * 45 | BEFORE PTR = DIFFER(PRED(PTR)) PRED(PTR) :S(SEARCH) 46 | PRED(PTR) = NODE(KEY,DATA) :(RETURN) 47 | ADNEND 48 | 49 | 50 | * 51 | * ROUTINE TO PRINT A SORTED BINARY TREE 52 | * 53 | DEFINE('PRINTREE(TREE)') :(ENDPRT) 54 | PRINTREE DIFFER(PRED(TREE)) PRINTREE(PRED(TREE)) 55 | OUTPUT = KEY(TREE) ' ' DAT(TREE) 56 | DIFFER(SUCC(TREE)) PRINTREE(SUCC(TREE)) :(RETURN) 57 | ENDPRT 58 | * 59 | * RECORDS OF WHICH 60 | * '1609 GALILEO : TELESCOPE' 61 | * IS TYPICAL ARE TO BE SORTED BY DATE AND BY INVENTOR. 62 | * SPLIT OUT THE RECORDS AND ADD TO TWO SORTED TREES. 63 | * 64 | SORT INP = INPUT :F(PRINT) 65 | INP ? LEN(4) $ DATE SPAN(' ') (BREAK(':') ':') $ INVR 66 | + SPAN(' ') REM $ INVN 67 | ADNODE(DATE,RPAD(INVR,16) INVN,.DATREE) 68 | ADNODE(RPAD(INVR,16),DATE ' ' INVN,.INVRTREE) :(SORT) 69 | 70 | * 71 | * JOB DONE APART FROM PRINTING THE SORTED TREES 72 | * 73 | PRINT OUTPUT = 'INVENTIONS SORTED BY DATE'; OUTPUT = 74 | PRINTREE(DATREE) ; OUTPUT = 75 | OUTPUT = 'INVENTIONS SORTED BY INVENTOR'; OUTPUT = 76 | PRINTREE(INVRTREE) 77 | END 78 | 79 | -------------------------------------------------------------------------------- /osint/sysex.c: -------------------------------------------------------------------------------- 1 | /* 2 | Copyright 1987-2012 Robert B. K. Dewar and Mark Emmer. 3 | Copyright 2012-2013 David Shields 4 | 5 | This file is part of Macro SPITBOL. 6 | 7 | Macro SPITBOL is free software: you can redistribute it and/or modify 8 | it under the terms of the GNU General Public License as published by 9 | the Free Software Foundation, either version 2 of the License, or 10 | (at your option) any later version. 11 | 12 | Macro SPITBOL is distributed in the hope that it will be useful, 13 | but WITHOUT ANY WARRANTY; without even the implied warranty of 14 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 15 | GNU General Public License for more details. 16 | 17 | You should have received a copy of the GNU General Public License 18 | along with Macro SPITBOL. If not, see . 19 | */ 20 | 21 | /* 22 | / File: SYSEX.C Version: 01.01 23 | / --------------------------------------- 24 | / 25 | / Contents: Function zysex 26 | / 27 | */ 28 | 29 | /* 30 | / zysex - call external function 31 | / 32 | / Parameters: 33 | / XS - pointer to arguments 34 | / XL - pointer to EFBLK 35 | / WA - number of arguments 36 | / Returns: 37 | / XR - result 38 | / Exits: 39 | / 1 - call fails 40 | / 2 - insufficient memory or function not found 41 | / 3 - improper argument type 42 | / 43 | / WARNING! THIS FUNCTION MAY CAUSE STORAGE ALLOCATION WHEN SAVING 44 | / THE RETURNED VALUE FROM THE EXTERNAL FUNCTION. THAT ALLOCATION MAY 45 | / CAUSE A GARBAGE COLLECTION, THEREFORE IT IS IMPERATIVE THAT THE STACK 46 | / BE CLEAN, COLLECTABLE, AND WORD ALIGNED. 47 | */ 48 | 49 | #include "port.h" 50 | 51 | zysex() 52 | { 53 | #if EXTFUN 54 | struct efblk *efb = XL(struct efblk *); 55 | word nargs = WA(word); 56 | union block *result = 0; // initialize so collectable 57 | 58 | // Bypass return word in second argument to callef 59 | result = callef(efb, ((word) (MP_OFF(XS(union block **))) 60 | + sizeof(word),union block **), nargs); 61 | switch ((word)result) { 62 | case (word)0: 63 | return EXIT_1; // fail 64 | case (word)-1: 65 | return EXIT_2; // insufficient memory 66 | case (word)-2: 67 | return EXIT_3; // improper argument 68 | default: 69 | SET_XR(result); 70 | return NORMAL_RETURN; // Success, return pointer to stuff in EFBLK 71 | } 72 | #else // EXTFUN 73 | return EXIT_1; 74 | #endif // EXTFUN 75 | } 76 | -------------------------------------------------------------------------------- /osint/sysej.c: -------------------------------------------------------------------------------- 1 | /* 2 | Copyright 1987-2012 Robert B. K. Dewar and Mark Emmer. 3 | Copyright 2012-2013 David Shields 4 | 5 | This file is part of Macro SPITBOL. 6 | 7 | Macro SPITBOL is free software: you can redistribute it and/or modify 8 | it under the terms of the GNU General Public License as published by 9 | the Free Software Foundation, either version 2 of the License, or 10 | (at your option) any later version. 11 | 12 | Macro SPITBOL is distributed in the hope that it will be useful, 13 | but WITHOUT ANY WARRANTY; without even the implied warranty of 14 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 15 | GNU General Public License for more details. 16 | 17 | You should have received a copy of the GNU General Public License 18 | along with Macro SPITBOL. If not, see . 19 | */ 20 | 21 | /* 22 | / File: SYSEJ.C Version: 01.04 23 | / --------------------------------------- 24 | / 25 | / Contents: Function zysej 26 | */ 27 | 28 | /* 29 | / zysej - end job 30 | / 31 | / zysej is called to terminate spitbol's execution. Any open files 32 | / will be closed before calling __exit. 33 | / 34 | / Parameters: 35 | / WA - value of &ABEND keyword (always 0) 36 | / WB - value of &CODE keyword 37 | / XL - pointer to FCBLK chain 38 | / Returns: 39 | / NO RETURN 40 | */ 41 | 42 | #include "port.h" 43 | 44 | #if EXTFUN 45 | unsigned char *bufp; 46 | #endif // EXTFUN 47 | 48 | 49 | /* 50 | / close_all - Close all files. 51 | / 52 | / Parameters: 53 | / chfcb pointer to FCBLK chain or 0 54 | / Returns: 55 | / Nothing 56 | / Side Effects: 57 | / All files on the chain are closed and buffers flushed. 58 | */ 59 | 60 | void close_all(chb) 61 | 62 | register struct chfcb *chb; 63 | 64 | { 65 | while( chb != 0 ) 66 | { 67 | osclose( ((struct ioblk *) (((struct fcblk *) (chb->fcp))->iob)) ); 68 | chb = ((struct chfcb *) (chb->nxt)); 69 | } 70 | } 71 | 72 | 73 | 74 | void zysej() 75 | { 76 | 77 | if (!in_gbcol) { // Only if not mid-garbage collection 78 | close_all( XL( struct chfcb * ) ); 79 | 80 | #if EXTFUN 81 | scanef(); // prepare to scan for external functions 82 | while (nextef(&bufp, 1)) // perform closing callback to some 83 | ; 84 | #endif // EXTFUN 85 | 86 | } 87 | /* 88 | / Pass &CODE to function __exit. Don't call standard exit function, 89 | / because of its association with the stdio package. 90 | */ 91 | __exit( WB(int) ); 92 | 93 | } 94 | 95 | -------------------------------------------------------------------------------- /osint/sysou.c: -------------------------------------------------------------------------------- 1 | /* 2 | Copyright 1987-2012 Robert B. K. Dewar and Mark Emmer. 3 | Copyright 2012-2013 David Shields 4 | 5 | This file is part of Macro SPITBOL. 6 | 7 | Macro SPITBOL is free software: you can redistribute it and/or modify 8 | it under the terms of the GNU General Public License as published by 9 | the Free Software Foundation, either version 2 of the License, or 10 | (at your option) any later version. 11 | 12 | Macro SPITBOL is distributed in the hope that it will be useful, 13 | but WITHOUT ANY WARRANTY; without even the implied warranty of 14 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 15 | GNU General Public License for more details. 16 | 17 | You should have received a copy of the GNU General Public License 18 | along with Macro SPITBOL. If not, see . 19 | */ 20 | 21 | /* 22 | / zysou - output a record 23 | / 24 | / zysou writes a record to a file. 25 | / 26 | / Parameters: 27 | / WA - pointer to FCBLK or 0 (TERMINAL) or 1 (OUTPUT) 28 | / XR - pointer to BCBLK or SCBLK containing record to be written 29 | / Returns: 30 | / Nothing 31 | / Exits: 32 | / 1 - file full or no file after SYSXI 33 | / 2 - i/o error 34 | */ 35 | 36 | #include "port.h" 37 | 38 | zysou() 39 | 40 | { 41 | register struct fcblk *fcb = WA (struct fcblk *); 42 | register union block *blk = XR (union block *); 43 | int result; 44 | 45 | if (blk->scb.typ == TYPE_SCL) 46 | { 47 | // called with string, get length from SCBLK 48 | SET_WA(blk->scb.len); 49 | } 50 | else 51 | { 52 | /* called with buffer, get length from BCBLK, and treat BSBLK 53 | * like an SCBLK 54 | */ 55 | SET_WA(blk->bcb.len); 56 | SET_XR(blk->bcb.bcbuf); 57 | } 58 | 59 | if (fcb == (struct fcblk *)0 || fcb == (struct fcblk *)1) 60 | { 61 | if (!fcb) 62 | result = zyspi(); 63 | else 64 | result = zyspr(); 65 | if (result == NORMAL_RETURN) 66 | return NORMAL_RETURN; 67 | else 68 | return EXIT_2; 69 | } 70 | 71 | // ensure iob is open, fail if unsuccessful 72 | if ( !(((struct ioblk *) (fcb->iob))->flg1 & IO_OPN) ) 73 | return EXIT_1; 74 | 75 | // write the data, fail if unsuccessful 76 | if ( oswrite( fcb->mode, fcb->rsz, WA(word), ((struct ioblk *) (fcb->iob)), XR(struct scblk *)) != 0 ) 77 | return EXIT_2; 78 | 79 | // normal return 80 | return NORMAL_RETURN; 81 | } 82 | -------------------------------------------------------------------------------- /osint/optfile.c: -------------------------------------------------------------------------------- 1 | /* 2 | Copyright 1987-2012 Robert B. K. Dewar and Mark Emmer. 3 | Copyright 2012-2013 David Shields 4 | 5 | This file is part of Macro SPITBOL. 6 | 7 | Macro SPITBOL is free software: you can redistribute it and/or modify 8 | it under the terms of the GNU General Public License as published by 9 | the Free Software Foundation, either version 2 of the License, or 10 | (at your option) any later version. 11 | 12 | Macro SPITBOL is distributed in the hope that it will be useful, 13 | but WITHOUT ANY WARRANTY; without even the implied warranty of 14 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 15 | GNU General Public License for more details. 16 | 17 | You should have received a copy of the GNU General Public License 18 | along with Macro SPITBOL. If not, see . 19 | */ 20 | 21 | /* 22 | / optfile( varname, result ) 23 | / 24 | / optfile() looks for other, optional ways to supply a filename to 25 | / the INPUT/OUTPUT functions. Varname is an SCBLK containing the string 26 | / used as an alias for the file name, and result is an SCBLK that will 27 | / receive the aliased name. 28 | / 29 | / optfile() looks in two places for the alias. First, if the alias is 30 | / a numeric string, it looks in the cfiles table to see if it was specified 31 | / on the command line. If not found there, it looks in the environment block. 32 | / 33 | / Parameters: 34 | / varname pointer to SCBLK containing alias 35 | / result pointer to SCBLK that will receive any name found 36 | / Returns: 37 | / 0 - success, result contains name 38 | / -1 - failure 39 | / Side Effects: 40 | / none 41 | */ 42 | 43 | #include "port.h" 44 | 45 | int optfile( varname, result ) 46 | 47 | struct scblk *varname, *result; 48 | 49 | { 50 | word i, j, n; 51 | register char *p, *q; 52 | 53 | // try to convert alias to an integer 54 | i = 0; 55 | n = scnint( varname->str, varname->len, &i); 56 | if (i == varname->len) // Consume all characters? 57 | { 58 | for (j = 0; j <= maxf; j++) 59 | { 60 | if (cfiles[j].filenum == n) 61 | { 62 | p = cfiles[j].fileptr; 63 | q = result->str; 64 | while ((*q++ = *p++) != 0) 65 | ; 66 | result->len = q - result->str - 1; 67 | return 0; 68 | } 69 | } 70 | } 71 | 72 | // didn't find it on the command line. Check environment 73 | return rdenv( varname, result ); 74 | } 75 | 76 | -------------------------------------------------------------------------------- /osint/rdenv.c: -------------------------------------------------------------------------------- 1 | /* 2 | Copyright 1987-2012 Robert B. K. Dewar and Mark Emmer. 3 | Copyright 2012-2013 David Shields 4 | 5 | This file is part of Macro SPITBOL. 6 | 7 | Macro SPITBOL is free software: you can redistribute it and/or modify 8 | it under the terms of the GNU General Public License as published by 9 | the Free Software Foundation, either version 2 of the License, or 10 | (at your option) any later version. 11 | 12 | Macro SPITBOL is distributed in the hope that it will be useful, 13 | but WITHOUT ANY WARRANTY; without even the implied warranty of 14 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 15 | GNU General Public License for more details. 16 | 17 | You should have received a copy of the GNU General Public License 18 | along with Macro SPITBOL. If not, see . 19 | */ 20 | 21 | /* 22 | / rdenv( varname, result ) 23 | / 24 | / rdenv() reads the environment variable named "varname", and if it can 25 | / be read, puts its value in "result. 26 | / 27 | / Parameters: 28 | / varname pointer to character string containing variable name 29 | / result pointer to character string to receive result 30 | / Returns: 31 | / 0 if successful / -1 on failure 32 | / 33 | / v1.02 02-Jan-91 Changed rdenv to use cpys2sc instead of mystrncpy. 34 | / Add private getenv(). 35 | */ 36 | 37 | #include "port.h" 38 | #include 39 | 40 | /* 41 | / Find environment variable vq of length vn. Return 42 | / pointer to value (just past '='), or 0 if not found. 43 | */ 44 | char *findenv( vq, vn ) 45 | char *vq; 46 | int vn; 47 | { 48 | char savech; 49 | char *p; 50 | 51 | savech = make_c_str(&vq[vn]); 52 | p = (char *)getenv(vq); // use library lookup routine 53 | unmake_c_str(&vq[vn], savech); 54 | return p; 55 | 56 | } 57 | 58 | rdenv( varname, result ) 59 | register struct scblk *varname, *result; 60 | { 61 | register char *p; 62 | 63 | 64 | if ( (p = findenv(varname->str, varname->len)) == 0 ) 65 | return -1; 66 | 67 | cpys2sc(p, result, tscblk_length); 68 | 69 | return 0; 70 | } 71 | 72 | /* make a string into a C string by changing the last character to null, 73 | * returning the old character at that location. 74 | * If the old character was already null, no change is made, so that 75 | * this works if passed a read-only C-string. 76 | */ 77 | char make_c_str(p) 78 | char *p; 79 | { 80 | char rtn; 81 | 82 | rtn = *p; 83 | if (rtn) 84 | *p = 0; 85 | return rtn; 86 | } 87 | 88 | 89 | // Intel compiler bug? 90 | void unmake_c_str(p, savech) 91 | char *p; 92 | char savech; 93 | { 94 | if (savech) 95 | *p = savech; 96 | } 97 | -------------------------------------------------------------------------------- /osint/math.c: -------------------------------------------------------------------------------- 1 | /* 2 | Copyright 1987-2012 Robert B. K. Dewar and Mark Emmer. 3 | Copyright 2012-2015 David Shields 4 | 5 | This file is part of Macro SPITBOL. 6 | 7 | Macro SPITBOL is free software: you can redistribute it and/or modify 8 | it under the terms of the GNU General Public License as published by 9 | the Free Software Foundation, either version 2 of the License, or 10 | (at your option) any later version. 11 | 12 | Macro SPITBOL is distributed in the hope that it will be useful, 13 | but WITHOUT ANY WARRANTY; without even the implied warranty of 14 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 15 | GNU General Public License for more details. 16 | 17 | You should have received a copy of the GNU General Public License 18 | along with Macro SPITBOL. If not, see . 19 | */ 20 | 21 | /* 22 | * math.c - extended math support for spitbol 23 | * 24 | * Routines not provided by hardware floating point. 25 | * 26 | * These routines are not called from other C routines. Rather they 27 | * are called by inter.*, and by external functions. 28 | */ 29 | 30 | #include "port.h" 31 | 32 | #include 33 | 34 | #if FLOAT & !MATHHDWR 35 | 36 | #include 37 | 38 | #ifndef errno 39 | int errno; 40 | #endif 41 | 42 | extern double inf; // infinity 43 | 44 | /* 45 | * f_atn - arctangent 46 | */ 47 | void f_atn() 48 | { 49 | reg_ra = atan(reg_ra); 50 | } 51 | 52 | /* 53 | * f_chp - chop 54 | */ 55 | void f_chp() 56 | { 57 | if (reg_ra >= 0.0) 58 | reg_ra = floor(reg_ra); 59 | else 60 | reg_ra = ceil(reg_ra); 61 | } 62 | 63 | /* 64 | * f_cos - cosine 65 | */ 66 | void f_cos() 67 | { 68 | reg_ra = cos(reg_ra); 69 | } 70 | 71 | 72 | /* 73 | * f_etx - e to the x 74 | */ 75 | void f_etx() 76 | { 77 | errno = 0; 78 | reg_ra = exp(reg_ra); 79 | if (errno) { 80 | reg_ra = inf; 81 | } 82 | } 83 | 84 | /* 85 | * f_lnf - natureg_ral log 86 | */ 87 | void f_lnf() 88 | { 89 | errno = 0; 90 | reg_ra = log(reg_ra); 91 | if (errno) { 92 | reg_ra = inf; 93 | } 94 | } 95 | 96 | /* 97 | * f_sin - sine 98 | */ 99 | void f_sin() 100 | { 101 | reg_ra = sin(reg_ra); 102 | } 103 | 104 | /* 105 | * f_sqr - square root (reg_range checked by caller) 106 | */ 107 | void f_sqr() 108 | { 109 | reg_ra = sqrt(reg_ra); 110 | } 111 | 112 | /* 113 | * f_tan - tangent 114 | */ 115 | void f_tan() 116 | { 117 | double result; 118 | result = tan(reg_ra); 119 | errno = 0; 120 | reg_ra = errno ? inf : result; 121 | } 122 | #endif // FLOAT & !MATHHDWR 123 | -------------------------------------------------------------------------------- /osint/gethost.c: -------------------------------------------------------------------------------- 1 | /* 2 | Copyright 1987-2012 Robert B. K. Dewar and Mark Emmer. 3 | Copyright 2012-2013 David Shields 4 | 5 | This file is part of Macro SPITBOL. 6 | 7 | Macro SPITBOL is free software: you can redistribute it and/or modify 8 | it under the terms of the GNU General Public License as published by 9 | the Free Software Foundation, either version 2 of the License, or 10 | (at your option) any later version. 11 | 12 | Macro SPITBOL is distributed in the hope that it will be useful, 13 | but WITHOUT ANY WARRANTY; without even the implied warranty of 14 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 15 | GNU General Public License for more details. 16 | 17 | You should have received a copy of the GNU General Public License 18 | along with Macro SPITBOL. If not, see . 19 | */ 20 | 21 | /* 22 | / gethost( scptr, maxlen ) 23 | / 24 | / gethost() reads the first line from the host file into the passed SCBLK. 25 | / 26 | / Parameters: 27 | / scptr pointer to SCBLK to receive host string 28 | / maxlen max length of string area in SCBLK 29 | / Returns: 30 | / Nothing. 31 | / Side Effects: 32 | / Modifies contents of passed SCBLK (scptr). 33 | */ 34 | 35 | #include "port.h" 36 | 37 | char htype[] = "x86-64"; 38 | char osver[] = ":unix "; 39 | 40 | #include 41 | 42 | void gethost( scptr, maxlen ) 43 | struct scblk *scptr; 44 | word maxlen; 45 | 46 | { 47 | struct scblk *pheadv = GET_DATA_OFFSET(headv,struct scblk *); 48 | int cnt = 0; 49 | word fd; 50 | 51 | if ( (fd = spit_open( HOST_FILE, O_RDONLY, IO_PRIVATE | IO_DENY_WRITE, 52 | IO_OPEN_IF_EXISTS )) >= 0 ) 53 | { 54 | cnt = read( fd, scptr->str, maxlen ); 55 | close( fd ); 56 | } 57 | 58 | if ( cnt > 0 && scptr->str[cnt-1] == EOL ) 59 | { 60 | scptr->str[--cnt] = 0; 61 | } 62 | 63 | if ( cnt == 0 ) 64 | { 65 | // Could not read spithost file. Construct string instead 66 | register char *scp; 67 | 68 | gettype( scptr, maxlen ); 69 | scp = scptr->str + scptr->len; 70 | scp = mystrcpy(scp,osver); 71 | scp = mystrcpy(scp,":Macro SPITBOL "); 72 | scp += mystrncpy(scp, pheadv->str, pheadv->len ); 73 | scp += mystrncpy(scp, pid1blk->str, (int)pid1blk->len); 74 | *scp++ = ' '; 75 | *scp++ = '#'; 76 | cnt = scp - scptr->str; 77 | } 78 | 79 | scptr->len = cnt; 80 | } 81 | 82 | 83 | 84 | /* 85 | * Get type of host computer 86 | */ 87 | void gettype( scptr, maxlen ) 88 | 89 | struct scblk *scptr; 90 | word maxlen; 91 | { 92 | cpys2sc( htype, scptr, maxlen ); // Computer type 93 | } 94 | -------------------------------------------------------------------------------- /osint/osclose.c: -------------------------------------------------------------------------------- 1 | /* 2 | Copyright 1987-2012 Robert B. K. Dewar and Mark Emmer. 3 | Copyright 2012-2013 David Shields 4 | 5 | This file is part of Macro SPITBOL. 6 | 7 | Macro SPITBOL is free software: you can redistribute it and/or modify 8 | it under the terms of the GNU General Public License as published by 9 | the Free Software Foundation, either version 2 of the License, or 10 | (at your option) any later version. 11 | 12 | Macro SPITBOL is distributed in the hope that it will be useful, 13 | but WITHOUT ANY WARRANTY; without even the implied warranty of 14 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 15 | GNU General Public License for more details. 16 | 17 | You should have received a copy of the GNU General Public License 18 | along with Macro SPITBOL. If not, see . 19 | */ 20 | 21 | /* 22 | / osclose( ioptr ) 23 | / 24 | / osclose() closes the file represented by the passed IOBLK. 25 | / 26 | / Parameters: 27 | / ioptr pointer to IOBLK 28 | / Returns: 29 | / Number of I/O errors, should be 0. 30 | */ 31 | 32 | #include "port.h" 33 | 34 | osclose( ioptr ) 35 | struct ioblk *ioptr; 36 | { 37 | register int errcnt = 0; 38 | 39 | /* 40 | / If not open, nothing to do. 41 | */ 42 | if ( !(ioptr->flg1 & IO_OPN) ) 43 | return 0; 44 | 45 | /* 46 | / Flush buffer before closing output file. 47 | */ 48 | if ( ioptr->flg1 & IO_OUP ) 49 | errcnt += flush( ioptr ); 50 | 51 | /* 52 | / DO NOT CLOSE SYSTEM FILE 0, 1 or 2; file was opened by shell. 53 | */ 54 | if ( (ioptr->flg1 & IO_SYS) && ioptr->fdn >= 0 && ioptr->fdn <= 2 ) 55 | return errcnt; 56 | 57 | /* 58 | / Now we can reset open flag and close the file descriptor associated 59 | / with file/pipe. 60 | */ 61 | ioptr->flg1 &= ~IO_OPN; 62 | if ( close(ioptr->fdn ) < 0 ) 63 | errcnt++; 64 | 65 | /* 66 | / For a pipe, must deal with process at other end. 67 | */ 68 | if ( ioptr->flg2 & IO_PIP ) 69 | { 70 | /* 71 | / If process already dead just reset flag. 72 | */ 73 | if ( ioptr->flg2 & IO_DED ) 74 | ioptr->flg2 &= ~IO_DED; 75 | 76 | /* 77 | / If reading from pipe, kill the process at other end 78 | / and wait for its termination. 79 | */ 80 | else if ( ioptr->flg1 & IO_INP ) 81 | { 82 | kill( ioptr->pid ); 83 | oswait( ioptr->pid ); 84 | } 85 | 86 | /* 87 | / If writing to pipe, wait for it to terminate. 88 | */ 89 | else 90 | oswait( ioptr->pid ); 91 | } 92 | 93 | /* 94 | / Return number of errors. 95 | */ 96 | return errcnt; 97 | } 98 | -------------------------------------------------------------------------------- /demos/sentenc.sbl: -------------------------------------------------------------------------------- 1 | * Sentence.spt 2 | * 3 | * This progam defines a simple sentence grammar, and then 4 | * accepts sentences from the keyboard to see if they can be 5 | * matched by the grammar. 6 | * 7 | * You'll have to examine the program to see the words that 8 | * it recognizes. Try it with sentences like: 9 | * 10 | * Dick walks with Jane. 11 | * Zippy eats the yellow banana slowly. 12 | * The aggressive monkey reads the large book, however, Dick is a boy. 13 | * 14 | * Contributed by Prof. Michael Feldman, George Washington Univ. 15 | 16 | &TRACE = 500 17 | &TRIM = 1 18 | UPPERS = "ABCDEFGHIJKLMNOPQRSTUVWXYZ" 19 | LOWERS = "abcdefghijklmnopqrstuvwxyz" 20 | 21 | BL = SPAN(' ') 22 | 23 | NOUN = ( 'BOY' | 'GIRL' | 'MONKEY' | 'TREE' | 'SCHOOL' | 'BOOK' 24 | + | 'BANANA' ) $ NOM 25 | TRACE('NOM') 26 | 27 | ARTICLE = ( 'A' | 'THE' ) $ ART 28 | TRACE('ART') 29 | 30 | CONJUNCTION = ( 'AND' | 'BUT' | 'HOWEVER' ) $ CONJ 31 | TRACE('CONJ') 32 | 33 | PROPER = ( 'DICK' | 'JANE' | 'ZIPPY' ) $ PROP 34 | TRACE('PROP') 35 | 36 | PRONOUN = ( 'HE' | 'SHE' | 'IT' ) $ PRON 37 | TRACE('PRON') 38 | 39 | ADJECTIVE = ( 'LARGE' | 'SMALL' | 'GRAY' | 'YELLOW' 40 | + | 'NICE' | 'AGGRESSIVE' ) $ ADJ 41 | TRACE('ADJ') 42 | 43 | ADVERB = ( 'SLOWLY' | 'ENTHUSIASTICALLY' ) $ ADV 44 | TRACE('ADV') 45 | 46 | TRANSITIVE = ( 'READS' | 'GIVES' | 'EATS' | 'WRITES' ) $ TRANS 47 | TRACE('TRANS') 48 | 49 | INTRANSITIVE = ( 'RUNS' | 'WALKS' ) $ INTRANS 50 | TRACE('INTRANS') 51 | 52 | BEING = ( 'IS' | 'WAS' ) $ BE 53 | TRACE('BE') 54 | 55 | PREPOSITION = ( 'TO' | 'FROM' | 'WITH' ) $ PREP 56 | TRACE('PREP') 57 | 58 | NOUN.PHRASE = ( *PROPER | (*ARTICLE *BL *NOUN) 59 | + | (*ARTICLE *BL *ADJECTIVE *BL *NOUN) ) $ NP 60 | TRACE('NP') 61 | 62 | PREP.PHRASE = ( *PREPOSITION *BL *NOUN.PHRASE ) $ PP 63 | TRACE('PP') 64 | 65 | VERB.PHRASE = ( (*INTRANSITIVE *BL *PREP.PHRASE) 66 | + | (*TRANSITIVE *BL *NOUN.PHRASE *BL *PREP.PHRASE) 67 | + | (*TRANSITIVE *BL *NOUN.PHRASE) 68 | + | (*BEING *BL *NOUN.PHRASE) 69 | + | *INTRANSITIVE | *BEING ) $ VP 70 | TRACE('VP') 71 | 72 | PREDICATE = ( (*VERB.PHRASE *BL *ADVERB) 73 | + | *VERB.PHRASE ) $ PRED 74 | TRACE('PRED') 75 | 76 | SUBJECT = ( *PRONOUN | *NOUN.PHRASE ) $ SUBJ 77 | TRACE('SUBJ') 78 | 79 | CLAUSE = ( *SUBJECT *BL *PREDICATE ) $ CL 80 | TRACE('CL') 81 | 82 | SENTENCE = POS(0) ( *CLAUSE 83 | + ARBNO( *BL *CONJUNCTION *BL *CLAUSE ) ) 84 | + $ SENT (*BL | "") RPOS(0) 85 | TRACE('SENT') 86 | 87 | READ S = INPUT :F(END) 88 | OUTPUT = '-----------------------------------------------' 89 | OUTPUT = S 90 | OUTPUT = '-----------------------------------------------' 91 | REPLACE(S,LOWERS ",.-!?;:",UPPERS " ") ? SENTENCE :S(YES)F(NO) 92 | YES OUTPUT = '==>SENTENCE FOUND' :(READ) 93 | NO OUTPUT = 'NO' :(READ) 94 | END 95 | -------------------------------------------------------------------------------- /test/memoff.sbl: -------------------------------------------------------------------------------- 1 | * copyright 2012-2015 david shields 2 | * 3 | * this file is part of macro spitbol. 4 | * 5 | * macro spitbol is free software: you can redistribute it and/or modify 6 | * it under the terms of the gnu general public license as published by 7 | * the free software foundation, either version 2 of the license, or 8 | * (at your option) any later version. 9 | * 10 | * macro spitbol is distributed in the hope that it will be useful, 11 | * but without any warranty; without even the implied warranty of 12 | * merchantability or fitness for a particular purpose. see the 13 | * gnu general public license for more details. 14 | * 15 | * you should have received a copy of the gnu general public license 16 | * along with macro spitbol. if not, see . 17 | * 18 | * compute offset of variables in constant and working section from start of constant section 19 | * assume first two entries in input are for c_aaa and w_yyy, respectively. 20 | &anchor = 1 21 | &trim = 1 22 | &dump = 0 23 | isglobal = 0 24 | int0 = integer(char('0')) 25 | define('intof(off)val,i,str,c') 26 | define('global_init()') 27 | digits = table() 28 | digits['0'] = 0 29 | digits['1'] = 1 30 | digits['2'] = 2 31 | digits['3'] = 3 32 | digits['4'] = 4 33 | digits['5'] = 5 34 | digits['6'] = 6 35 | digits['7'] = 7 36 | digits['8'] = 8 37 | digits['9'] = 9 38 | digits['a'] = 10 39 | digits['b'] = 11 40 | digits['c'] = 12 41 | digits['d'] = 13 42 | digits['e'] = 14 43 | digits['f'] = 15 44 | 45 | digit = any('0123456789') 46 | 47 | reverse_label__name = digit digit digit digit digit '_' 48 | 49 | global_init() 50 | 51 | offsetof = table(5000) 52 | lpat = len(16) . offset ' ' len(1) . typ ' ' rem . name 53 | 54 | loop 55 | line = input :f(loop.end) 56 | ne(size(line),24) :s(loop) 57 | line lpat :f(loop) 58 | * only want data symbols 59 | typ any('dD') :f(loop) 60 | * ident(global_index_table[name]) :s(loop) 61 | ioffset = intof(offset) 62 | base = ident(name, 'c_aaa') ioffset 63 | * output = ne(remdr(ioffset,4)) 'not aligned ' name 64 | * output = ident(name, 'c_aaa') 'base ' ioffset 65 | * output = name ' ' (ioffset - base) 66 | off = ioffset - base 67 | offsetof[name] = +off 68 | :(loop) 69 | loop.end 70 | * output offsets, sorted by value 71 | ara = sort(offsetof,2) 72 | i = 0 73 | loop.out 74 | i = i + 1 75 | key = ara[i,1] :f(end) 76 | val = ara[i,2] 77 | output = lpad(key,8) ' ' val :(loop.out) 78 | :(finis) 79 | 80 | intof 81 | intof = 0 82 | i = 0 83 | str = reverse(off) 84 | str = off 85 | * output = 'intof arg ' off 86 | intof.1 87 | gt(i = i + 1, 16) :s(return) 88 | c = substr(str,i,1) 89 | intof = intof * 16 + digits[c] 90 | :(intof.1) 91 | intof = intof - base :(return) 92 | finis 93 | &dump = 0 94 | end 95 | 96 | -------------------------------------------------------------------------------- /osint/sysin.c: -------------------------------------------------------------------------------- 1 | /* 2 | Copyright 1987-2012 Robert B. K. Dewar and Mark Emmer. 3 | Copyright 2012-2013 David Shields 4 | 5 | This file is part of Macro SPITBOL. 6 | 7 | Macro SPITBOL is free software: you can redistribute it and/or modify 8 | it under the terms of the GNU General Public License as published by 9 | the Free Software Foundation, either version 2 of the License, or 10 | (at your option) any later version. 11 | 12 | Macro SPITBOL is distributed in the hope that it will be useful, 13 | but WITHOUT ANY WARRANTY; without even the implied warranty of 14 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 15 | GNU General Public License for more details. 16 | 17 | You should have received a copy of the GNU General Public License 18 | along with Macro SPITBOL. If not, see . 19 | */ 20 | 21 | /* 22 | / File: SYSIN.C Version: 01.03 23 | / --------------------------------------- 24 | / 25 | / Contents: Function zysin 26 | */ 27 | 28 | /* 29 | / zysin - read input record 30 | / 31 | / zysin reads and returns the next input record from a file. 32 | / 33 | / Parameters: 34 | / WA - pointer to FCBLK or 0 35 | / XR - pointer to SCBLK containing buffer to receive record read 36 | / Returns: 37 | / Nothing 38 | / Exits: 39 | / 1 - EOF or file not available after SYSXI 40 | / 2 - i/o error 41 | / 3 - record format error 42 | */ 43 | 44 | #include "port.h" 45 | 46 | word wabs(x) 47 | word x; 48 | { 49 | return (x >= 0) ? x : -x; 50 | } 51 | 52 | zysin() 53 | { 54 | register word reclen; 55 | register struct fcblk *fcb = WA (struct fcblk *); 56 | register struct scblk *scb = XR (struct scblk *); 57 | register struct ioblk *ioptr = ((struct ioblk *) (fcb->iob)); 58 | 59 | // ensure iob is open, fail if unsuccessful 60 | if ( !(ioptr->flg1 & IO_OPN) ) 61 | return EXIT_3; 62 | 63 | // read the data, fail if unsuccessful 64 | while( (reclen = osread( fcb->mode, fcb->rsz, ioptr, scb )) < 0) 65 | { 66 | if ( reclen == (word)-1 ) // EOF? 67 | { 68 | if ( ioptr->fdn ) // If not fd 0, true EOF 69 | return EXIT_1; 70 | else // Fd 0 - try to switch files 71 | if ( swcinp( inpcnt, inpptr ) < 0 ) 72 | return EXIT_1; // If can't switch 73 | 74 | ioptr->flg2 &= ~IO_RAW; // Switched. Set IO_RAW 75 | if ( (testty( ioptr->fdn ) == 0 ) && // If TTY 76 | ( fcb->mode == 0 ) ) // and raw mode, 77 | ioptr->flg2 |= IO_RAW; // then set IO_RAW 78 | 79 | } 80 | else // I/O Error 81 | return EXIT_2; 82 | } 83 | scb->len = reclen; // set record length 84 | 85 | // normal return 86 | return NORMAL_RETURN; 87 | } 88 | -------------------------------------------------------------------------------- /osint/sysld.c: -------------------------------------------------------------------------------- 1 | /* 2 | Copyright 1987-2012 Robert B. K. Dewar and Mark Emmer. 3 | Copyright 2012-2013 David Shields 4 | 5 | This file is part of Macro SPITBOL. 6 | 7 | Macro SPITBOL is free software: you can redistribute it and/or modify 8 | it under the terms of the GNU General Public License as published by 9 | the Free Software Foundation, either version 2 of the License, or 10 | (at your option) any later version. 11 | 12 | Macro SPITBOL is distributed in the hope that it will be useful, 13 | but WITHOUT ANY WARRANTY; without even the implied warranty of 14 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 15 | GNU General Public License for more details. 16 | 17 | You should have received a copy of the GNU General Public License 18 | along with Macro SPITBOL. If not, see . 19 | */ 20 | 21 | // zysld - load external function 22 | // 23 | // Parameters: 24 | // XR - pointer to SCBLK containing function name 25 | // XL - pointer to SCBLK containing library name 26 | // Returns: 27 | // XR - pointer to code (or other data structure) to be stored in the EFBLK. 28 | // Exits: 29 | // 1 - function does not exist 30 | // 2 - I/O error loading function 31 | // 3 - insufficient memory 32 | // 33 | // 34 | // WARNING: THIS FUNCTION CALLS A FUNCTION WHICH MAY INVOKE A GARBAGE 35 | // COLLECTION. STACK MUST REMAIN WORD ALIGNED AND COLLECTABLE. 36 | // 37 | 38 | #include "port.h" 39 | #include 40 | #include 41 | 42 | #if EXTFUN 43 | static void *openloadfile (char *namebuf); 44 | static void closeloadfile (void *fd); 45 | #endif // EXTFUN 46 | 47 | zysld() 48 | { 49 | #if EXTFUN 50 | void *fd; // keep stack word-aligned 51 | void *result = 0; 52 | 53 | fd = openloadfile(ptscblk->str); 54 | if ( fd != -1 ) { // If file opened OK 55 | result = loadef(fd, ptscblk->str); // Invoke loader 56 | closeloadfile(fd); 57 | switch ((word)result) { 58 | case (word)0: 59 | return EXIT_2; // I/O error 60 | case (word)-1: 61 | return EXIT_1; // doesn't exist 62 | case (word)-2: 63 | return EXIT_3; // insufficient memory 64 | default: 65 | SET_XR(result); 66 | return NORMAL_RETURN; // Success, return pointer to stuff in EFBLK 67 | } 68 | } 69 | else 70 | return EXIT_1; 71 | } 72 | 73 | 74 | static void closeloadfile(fd) 75 | word fd; 76 | { 77 | } 78 | 79 | static void *openloadfile(file) 80 | char *file; 81 | { 82 | 83 | register struct scblk *lnscb = XL (struct scblk *); 84 | register struct scblk *fnscb = XR (struct scblk *); 85 | char *savecp; 86 | char savechar; 87 | void *handle; 88 | handle = dlopen(file, RTLD_LAZY); 89 | if (handle == NULL) 90 | return EXIT_1; 91 | else { 92 | // todo ... 93 | return EXIT_NORMAL 94 | } 95 | #else // EXTFUN 96 | return EXIT_1; 97 | } 98 | #endif // EXTFUN 99 | -------------------------------------------------------------------------------- /osint/prompt.c: -------------------------------------------------------------------------------- 1 | /* 2 | Copyright 1987-2012 Robert B. K. Dewar and Mark Emmer. 3 | Copyright 2012-2013 David Shields 4 | 5 | This file is part of Macro SPITBOL. 6 | 7 | Macro SPITBOL is free software: you can redistribute it and/or modify 8 | it under the terms of the GNU General Public License as published by 9 | the Free Software Foundation, either version 2 of the License, or 10 | (at your option) any later version. 11 | 12 | Macro SPITBOL is distributed in the hope that it will be useful, 13 | but WITHOUT ANY WARRANTY; without even the implied warranty of 14 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 15 | GNU General Public License for more details. 16 | 17 | You should have received a copy of the GNU General Public License 18 | along with Macro SPITBOL. If not, see . 19 | */ 20 | 21 | #include "port.h" 22 | 23 | /* prompt() - used to give user usage info in command line versions. 24 | * 25 | */ 26 | void prompt() 27 | { 28 | #if RUNTIME 29 | wrterr("usage: spitrun [options] file[.spx] [program arguments]"); 30 | #else // RUNTIME 31 | 32 | wrterr("usage: spitbol [options] files[.spt or .spx] [args to HOST(2)]"); 33 | 34 | #endif // RUNTIME 35 | 36 | #if RUNTIME 37 | wrterr("options: (# is a decimal number)"); 38 | wrterr("-u \"string\" data string available to program"); 39 | wrterr("-#=file associate file with I/O channel #"); 40 | #else // RUNTIME 41 | wrterr("source files are concatenated, filename '-' is standard input/output"); 42 | wrterr("# is a decimal number. Append \"k\" for kilobytes, \"m\" for megabytes."); 43 | wrterr("options:"); 44 | wrterr("-d# #bytes max heap -i# #bytes initial heap size & enlarge amount"); 45 | wrterr("-m# #bytes max object size -s# #bytes stack size"); 46 | wrterr("-c compiler statistics -x execution statistics"); 47 | wrterr("-a same as -lcx -l normal listing"); 48 | wrterr("-p listing with wide titles -z listing with form feeds"); 49 | wrterr("-o=file[.lst] listing file -h suppress version ID/date in listing"); 50 | wrterr("-g# lines per page -t# line width in characters"); 51 | wrterr("-b suppress signon message -e errors to list file only"); 52 | wrterr("-k run with compilation error -n suppress execution"); 53 | wrterr("-f no case-folding -u \"string\" data passed to HOST(0)"); 54 | 55 | #if EXECFILE 56 | wrterr("-w write load (.out) module -y write save (.spx) file"); 57 | #endif // EXECFILE 58 | 59 | #if !EXECFILE 60 | wrterr("-y write save (.spx) file"); 61 | #endif // !EXECFILE 62 | 63 | wrterr("-r INPUT from source file following END statement"); 64 | wrterr("-T=file write TERMINAL output to file"); 65 | wrterr("-#=file[options] associate file with I/O channel #"); 66 | wrterr("option defaults: -d64m -i128k -m4m -s128k -g60 -t120"); 67 | 68 | #endif // RUNTIME 69 | 70 | __exit(0); 71 | } 72 | -------------------------------------------------------------------------------- /osint/trypath.c: -------------------------------------------------------------------------------- 1 | /* 2 | Copyright 1987-2012 Robert B. K. Dewar and Mark Emmer. 3 | Copyright 2012-2013 David Shields 4 | 5 | This file is part of Macro SPITBOL. 6 | 7 | Macro SPITBOL is free software: you can redistribute it and/or modify 8 | it under the terms of the GNU General Public License as published by 9 | the Free Software Foundation, either version 2 of the License, or 10 | (at your option) any later version. 11 | 12 | Macro SPITBOL is distributed in the hope that it will be useful, 13 | but WITHOUT ANY WARRANTY; without even the implied warranty of 14 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 15 | GNU General Public License for more details. 16 | 17 | You should have received a copy of the GNU General Public License 18 | along with Macro SPITBOL. If not, see . 19 | */ 20 | 21 | #include "port.h" 22 | 23 | /* 24 | / Pointer to "SNOLIB" string 25 | */ 26 | 27 | 28 | /* 29 | / initpath - initialize for a search by looking to see if there 30 | / is a search path. Under Unix, the user could be running 31 | / either the Korn shell or csh, implying two forms: 32 | / VAR path:path:path 33 | / var (path path path) 34 | / 35 | / caller should call with the lowercase version of var. We 36 | / will try the uppercase version automatically. 37 | */ 38 | void initpath(name) 39 | char *name; 40 | { 41 | char ucname[32]; // only called with "snolib" and "path" 42 | int i; 43 | 44 | pathptr = findenv(name,length(name)); 45 | if (!pathptr) 46 | { 47 | for (i = 0; ; i++) 48 | if ((ucname[i] = uppercase(name[i])) == '\0') 49 | break; 50 | pathptr = findenv(ucname, length(ucname)); 51 | } 52 | 53 | // skip leading paren if present 54 | if (pathptr && *pathptr == '(') 55 | pathptr++; 56 | } 57 | 58 | 59 | /* 60 | / trypath - form a file name in file by concatenating name onto the 61 | / next path element. 62 | */ 63 | int trypath(name,file) 64 | char *name, *file; 65 | { 66 | char c; 67 | 68 | // return 0 if no search path or fully-qualified name 69 | if (pathptr == (char *)0L || name[0] == FSEP 70 | #ifdef FSEP2 71 | || name[0] == FSEP2 72 | #endif 73 | ) 74 | return 0; 75 | 76 | while (*pathptr == ' ') // Skip initial blanks 77 | pathptr++; 78 | if (!*pathptr) 79 | return 0; 80 | 81 | do 82 | { 83 | c = (*file++ = *pathptr++); 84 | } 85 | #ifdef PSEP2 86 | while (c && c != PSEP && c != PSEP2 && c != ')' ) 87 | #else 88 | while (c && c != PSEP) 89 | #endif 90 | ; 91 | 92 | if (!c) // If exhausted the string, 93 | pathptr = (char *)0L; // clear pathptr so kick out on next call 94 | 95 | file--; 96 | *file++ = FSEP; 97 | 98 | while ((*file++ = *name++) != 0) 99 | ; 100 | 101 | *file = '\0'; 102 | return 1; 103 | } 104 | -------------------------------------------------------------------------------- /osint/sysea.c: -------------------------------------------------------------------------------- 1 | /* 2 | Copyright 1987-2012 Robert B. K. Dewar and Mark Emmer. 3 | Copyright 2012-2013 David Shields 4 | 5 | This file is part of Macro SPITBOL. 6 | 7 | Macro SPITBOL is free software: you can redistribute it and/or modify 8 | it under the terms of the GNU General Public License as published by 9 | the Free Software Foundation, either version 2 of the License, or 10 | (at your option) any later version. 11 | 12 | Macro SPITBOL is distributed in the hope that it will be useful, 13 | but WITHOUT ANY WARRANTY; without even the implied warranty of 14 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 15 | GNU General Public License for more details. 16 | 17 | You should have received a copy of the GNU General Public License 18 | along with Macro SPITBOL. If not, see . 19 | */ 20 | 21 | /* 22 | / File: SYSEA.C Version: 01.00 23 | / --------------------------------------- 24 | / 25 | / Contents: Function zysea 26 | */ 27 | 28 | /* 29 | / 30 | / zysea - error advise 31 | / 32 | / Here we catch errors before they are printed. 33 | / 34 | / Parameters: 35 | / XR - Error stage 36 | / if XR = STGIC, STGCE, STGXT then 37 | / WA - error number (1-330) 38 | / WB - column number 39 | / WC - line number 40 | / XL - scblk containing source file name 41 | / Returns: 42 | / XR - SCBLK of message to print, or 0 if none 43 | / Exits: 44 | / 1 - suppress printing of error message 45 | */ 46 | 47 | #include "port.h" 48 | 49 | static char *eacpy (char *s1, char *s2, int n); 50 | 51 | static char *eacpy(s1, s2, n) 52 | char *s1, *s2; 53 | int n; 54 | { 55 | char *s0 = s1+n; 56 | 57 | while (n--) 58 | *s1++ = *s2++; 59 | return s0; 60 | } 61 | 62 | /* 63 | * Error stage states 64 | */ 65 | enum stage { 66 | STGIC=0, // Initial compile 67 | STGXC, // Execution compile (CODE) 68 | STGEV, // Expression eval during execution 69 | STGXT, // Execution time 70 | STGCE, // Initial compile after scanning END line 71 | STGXE, // Execute time compile after scanning END line 72 | STGEE, // EVAL evaluating expression 73 | STGNO // Number of codes 74 | }; 75 | 76 | zysea() 77 | { 78 | register struct scblk *fnscblk = XL(struct scblk *); 79 | register char *p; 80 | 81 | 82 | // Display file name if present 83 | if (fnscblk->len) { 84 | p = ptscblk->str; 85 | p = eacpy(p, fnscblk->str, (int)fnscblk->len); 86 | // Display line number if present 87 | if (WC(unsigned int)) { 88 | *p++ = '('; 89 | p += stcu_d(p, WC(unsigned int), 16); 90 | // Display character position if present 91 | if (WB(unsigned int)) { 92 | *p++ = ','; 93 | p += stcu_d(p, WB(unsigned int)+1, 16); 94 | } 95 | *p++ = ')'; 96 | } 97 | p = eacpy(p, " : ", 3); 98 | ptscblk->len = p - ptscblk->str; 99 | SET_XR( ptscblk ); 100 | return NORMAL_RETURN; 101 | } 102 | SET_XR(0L); 103 | return NORMAL_RETURN; // Other errors be processed normally 104 | } 105 | 106 | -------------------------------------------------------------------------------- /osint/sysmm.c: -------------------------------------------------------------------------------- 1 | /* 2 | Copyright 1987-2012 Robert B. K. Dewar and Mark Emmer. 3 | Copyright 2012-2013 David Shields 4 | 5 | This file is part of Macro SPITBOL. 6 | 7 | Macro SPITBOL is free software: you can redistribute it and/or modify 8 | it under the terms of the GNU General Public License as published by 9 | the Free Software Foundation, either version 2 of the License, or 10 | (at your option) any later version. 11 | 12 | Macro SPITBOL is distributed in the hope that it will be useful, 13 | but WITHOUT ANY WARRANTY; without even the implied warranty of 14 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 15 | GNU General Public License for more details. 16 | 17 | You should have received a copy of the GNU General Public License 18 | along with Macro SPITBOL. If not, see . 19 | */ 20 | 21 | /* 22 | / File: SYSMM.C Version: 01.04 23 | / --------------------------------------- 24 | / 25 | / Contents: Function zysmm 26 | */ 27 | 28 | /* 29 | / zysmm- get more memory 30 | / 31 | / Parameters: 32 | / None 33 | / Returns: 34 | / XR - number of addtional words obtained 35 | / Exits: 36 | / None 37 | */ 38 | 39 | #include "port.h" 40 | 41 | zysmm() 42 | 43 | { 44 | long n; 45 | char *dummy; 46 | 47 | SET_XR( 0 ); // Assume allocation will fail 48 | 49 | /* 50 | / If not already at maximum allocation, try to get more memory. 51 | */ 52 | if ( topmem < maxmem ) { 53 | n = moremem(memincb, &dummy); 54 | topmem += n; // adjust current top address 55 | SET_XR( n / sizeof(word) ); // set # of words obtained 56 | } 57 | return NORMAL_RETURN; 58 | } 59 | 60 | /* 61 | * moremem(n) - Attempt to fetch n bytes more memory. 62 | * Returns number of bytes actually obtained. 63 | * Address returned by sbrk returned in *pp. 64 | * 65 | * Returns the maximum amount <= n. 66 | * 67 | * Strategy: Attempt to allocate n bytes. If success, return. 68 | * If fail, set n = n/2, and repeat until n is too small. 69 | * Accumulate all memory obtained for all values of n. 70 | */ 71 | long moremem(n,pp) 72 | long n; 73 | char **pp; 74 | { 75 | long start, result; 76 | char *p; 77 | 78 | n &= -(int)sizeof(word); // multiple of word size only 79 | start = n; // initial request size 80 | result = 0; // nothing obtained yet 81 | *pp = (char *) 0; // no result sbrk value 82 | 83 | while ( n >= sizeof(word) ) { // Word is minimum allocation unit 84 | p = (char *)sbrk((uword)n); // Attempt allocation 85 | if ( p != (char *) -1 ) { // If successful 86 | result += n; // Accumulate allocation size 87 | if (*pp == (char *) 0) {// First success? 88 | if (p != topmem) { 89 | wrterr( "Internal system error--SYSMM" ); 90 | __exit(1); 91 | } 92 | *pp = p; // record first allocation 93 | } 94 | if (n == start) // If easily satisfied, great 95 | break; 96 | } 97 | n >>= 1; // Continue with smaller request size 98 | n &= -(int)sizeof(word); // Always keeping it a word multiple 99 | } 100 | return result; 101 | } 102 | -------------------------------------------------------------------------------- /gas/osx.sbl: -------------------------------------------------------------------------------- 1 | 2 | * copyright 2012-2015 david shields 3 | * 4 | * this file is part of macro spitbol. 5 | * 6 | * macro spitbol is free software: you can redistribute it and/or modify it under the terms of the 7 | * gnu general public license as published by the free software foundation, either version 2 of the license, or 8 | * (at your option) any later version. 9 | * 10 | * macro spitbol is distributed in the hope that it will be useful, but without any warranty; without even 11 | * the implied warranty of merchantability or fitness for a particular purpose. see the gnu general 12 | * public license for more details. 13 | * 14 | * you should have received a copy of the gnu general public license along with macro spitbol. 15 | * if not, see . 16 | * 17 | * no case folding 18 | -case 0 19 | 20 | * osx requires that names referenced from c code be prefixed with underline character. 21 | * don't be fancy. simple is as simple does. 22 | 23 | &trim = 1 24 | 25 | :(next) 26 | copy output = line 27 | next 28 | line = input :f(end) 29 | raw = line 30 | 31 | scan 32 | line 'save_' = '_save_' 33 | line 'trc_fl' = '_trc_fl' 34 | line '_trc_' = '_trc_' 35 | line 'compsp' = '_compsp' 36 | line 'osisp' = '_osisp' 37 | line 'sys_dvi' = '_sys_dvi' 38 | line 'sys_rmi' = '_sys_rmi' 39 | line 'trc' = '_trc' 40 | line 'reg_w0' = '_reg_w0' 41 | line 'reg_wa' = '_reg_wa' 42 | line 'reg_wb' = '_reg_wb' 43 | line 'reg_wc' = '_reg_wc' 44 | line 'reg_xl' = '_reg_xl' 45 | line 'reg_xr' = '_reg_xr' 46 | line 'reg_xs' = '_reg_xs' 47 | line 'reg_xt' = '_reg_xt' 48 | line 'reg_cp' = '_reg_cp' 49 | line 'reg_ra' = '_reg_ra' 50 | line 'reg_rb' = '_reg_rb' 51 | line 'reg_ia' = '_reg_ia' 52 | line 'reg_fl' = '_reg_fl' 53 | line 'reg_rp' = '_reg_rp' 54 | line 'w_aaa' = '_w_aaa' 55 | line '.global' = '.globl' 56 | line 'b_icl' = '_b_icl' 57 | line 'b_scl' = '_b_scl' 58 | line 'b_xnt' = '_b_xnt' 59 | line 'b_xrt' = '_b_xrt' 60 | line 'c_aaa' = '_c_aaa' 61 | line 'c_yyy' = '_c_yyy' 62 | line 'dnamb' = '_dnamb' 63 | line 'dnamp' = '_dnamp' 64 | line 'errors' = '_errors' 65 | line 'flprt' = '_flprt' 66 | line 'flptr' = '_flptr' 67 | line 'g_aaa' = '_g_aaa' 68 | line 'get_fp' = '_get_fp' 69 | line 'gtcef' = '_gtcef' 70 | line 'hasfpu' = '_hasfpu' 71 | line 'headv' = '_headv' 72 | line 'hshtb' = '_hshtb' 73 | line 'id1blk' = '_id1blk' 74 | line 'id2blk' = '_id2blk' 75 | line 'inf' = '_inf' 76 | line 'inpbuf' = '_inpbuf' 77 | line 'c_minimal' = '_c_minimal' 78 | line 'minimal_id' = '_minimal_id' 79 | line 'phrases' = '_phrases' 80 | line 'pmhbs' = '_pmhbs' 81 | line 'polct' = '_polct' 82 | line 'r_fcb' = '_r_fcb' 83 | line 'reg_block' = '_reg_block' 84 | line 'restart' = '_restart' 85 | line 's_aaa' = '_s_aaa' 86 | line 's_yyy' = '_s_yyy' 87 | line 'startup' = '_startup' 88 | line 'state' = '_state' 89 | line 'stbas' = '_stbas' 90 | line 'ticblk' = '_ticblk' 91 | line 'tscblk' = '_tscblk' 92 | line 'ttybuf' = '_ttybuf' 93 | line 'w_yyy' = '_w_yyy' 94 | line 'lmodstk' = '_lmodstk' 95 | line 'outptr' = '_outptr' 96 | line 'rereloc' = '_rereloc' 97 | line 'stacksiz' = '_stacksiz' 98 | line 'startbrk' = '_startbrk' 99 | line 'swcoup' = '_swcoup' 100 | 101 | fixed = differ(raw,line) fixed + 1 102 | :(copy) 103 | end 104 | -------------------------------------------------------------------------------- /osint/flush.c: -------------------------------------------------------------------------------- 1 | /* 2 | Copyright 1987-2012 Robert B. K. Dewar and Mark Emmer. 3 | Copyright 2012-2013 David Shields 4 | 5 | This file is part of Macro SPITBOL. 6 | 7 | Macro SPITBOL is free software: you can redistribute it and/or modify 8 | it under the terms of the GNU General Public License as published by 9 | the Free Software Foundation, either version 2 of the License, or 10 | (at your option) any later version. 11 | 12 | Macro SPITBOL is distributed in the hope that it will be useful, 13 | but WITHOUT ANY WARRANTY; without even the implied warranty of 14 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 15 | GNU General Public License for more details. 16 | 17 | You should have received a copy of the GNU General Public License 18 | along with Macro SPITBOL. If not, see . 19 | */ 20 | 21 | /* 22 | / File: FLUSH.C Version: 01.02 23 | / --------------------------------------- 24 | / 25 | / Contents: Function flush 26 | / 27 | / V1.02 05-Feb-91 Flush only if dirty. Adjust file position in buffer. 28 | / v1.01 Ignore short count writes if MS-DOS and character device. 29 | */ 30 | 31 | /* 32 | / flush( ioptr ) 33 | / 34 | / flush() writes out any characters in the buffer associated with the 35 | / passed IOBLK. 36 | / 37 | / Parameters: 38 | / ioptr pointer to IOBLK representing file 39 | / Returns: 40 | / 0 if flush successful / number of I/O errors 41 | */ 42 | 43 | #include "port.h" 44 | 45 | int flush( ioptr ) 46 | struct ioblk *ioptr; 47 | { 48 | register struct bfblk *bfptr = ((struct bfblk *) (ioptr->bfb)); 49 | register int ioerrcnt = 0; 50 | register word n; 51 | 52 | if ( bfptr ) { // if buffer 53 | if ( ioptr->flg2 & IO_DIR ) { // if dirty 54 | ioerrcnt += fsyncio(ioptr); // synchronize file and buffer 55 | if ( bfptr->fill ) { 56 | n = write(ioptr->fdn, bfptr->buf, bfptr->fill); 57 | if ( n != bfptr->fill) 58 | ioerrcnt++; 59 | 60 | if (n > 0) 61 | bfptr->curpos += n; 62 | } 63 | ioptr->flg2 &= ~IO_DIR; 64 | } 65 | bfptr->offset += bfptr->fill; // advance file position 66 | bfptr->next = bfptr->fill = 0; // empty the buffer 67 | } 68 | return ioerrcnt; 69 | } 70 | 71 | /* 72 | * fsyncio - bring file into sync with buffer. A brute force 73 | * approach is to always LSEEK to bfptr->offset, but this slows down 74 | * SPITBOL's I/O with many unnecessary LSEEKs when the file is already 75 | * properly positioned. Instead, we remember the current physical file 76 | * position in bfptr->curpos, and only LSEEK if it is different 77 | * from bfptr->offset. 78 | * 79 | * For unbuffered files, the file position is always correct. 80 | * 81 | * Returns 0 if no error, 1 if error. 82 | */ 83 | int fsyncio( ioptr ) 84 | struct ioblk *ioptr; 85 | { 86 | register struct bfblk *bfptr = ((struct bfblk *) (ioptr->bfb)); 87 | FILEPOS n; 88 | 89 | if (bfptr) { 90 | if (bfptr->offset != bfptr->curpos) { 91 | n = LSEEK(ioptr->fdn, bfptr->offset, 0); 92 | if (n >= 0) 93 | bfptr->curpos = n; 94 | else 95 | return 1; // I/O error 96 | } 97 | } 98 | return 0; 99 | } 100 | 101 | -------------------------------------------------------------------------------- /demos/kwic2.sbl: -------------------------------------------------------------------------------- 1 | * Simple KWIC program, version 2. 2 | * 3 | * The program reads a keyword file (one word per line) to build a 4 | * table of words to index. The files is named KEYWORDS. 5 | * 6 | * The input file is then read, and each occurrence of the one of the 7 | * keywords is captured to a table, with NCHARS characters on each side. 8 | * The table is then sorted, and the keywords displayed in order. 9 | * 10 | * Input is read from "Standard Input" and results are 11 | * written to "Standard Output". 12 | * 13 | * A total word count and keyword count is also displayed. 14 | * 15 | * Sample usage: 16 | * SPITBOL KWIC2 RESULTS 17 | * 18 | * 19 | &ANCHOR = 1 20 | 21 | * Number of characters to display on either side of the matched word: 22 | * 23 | NCHARS = 30 24 | 25 | * Marker to use between sentences in the capture table. 26 | * 27 | MARKER = CHAR(0) 28 | CAPTURE = TABLE(101) 29 | WORDCNTS = TABLE(101) 30 | CPAT = BREAK(MARKER) . DISPLAY MARKER 31 | 32 | * Read keyword file and save words in a table in lower case form. 33 | * 34 | INPUT(.KEYFILE,1,"keywords") :F(END) 35 | T = TABLE(101) 36 | READKEY WORD = KEYFILE :F(ENDKEY) 37 | T = 1 :(READKEY) 38 | ENDKEY ENDFILE(1) 39 | 40 | * Establish the definition of characters that make up a word. 41 | * 42 | LETTERS = &UCASE &LCASE "-'" 43 | 44 | * Pattern to obtain the NCHARS preceeding and following a matched word. 45 | * 46 | DPAT = TAB(*KSTART) LEN(NCHARS) . PREVIOUS TAB(*WEND) 47 | + (LEN(NCHARS) | REM) . POST 48 | 49 | * Pattern to obtain the next word. Note that the deferred variable 50 | * WEND is used to index through the subject. 51 | * 52 | WPAT = TAB(*WEND) BREAK(LETTERS) @WSTART SPAN(LETTERS) . WORD @WEND 53 | 54 | * Initialize variables. 55 | * 56 | LINE = DUPL(" ",NCHARS) 57 | WEND = NCHARS 58 | KCOUNT = WCOUNT = 0 59 | 60 | * Append next input line to LINE. 61 | * 62 | MORE LINE = LINE " " INPUT :F(DISPLAY) 63 | 64 | * Find next word in LINE. 65 | * 66 | GTWORD LINE ? WPAT :F(MORE) 67 | 68 | * Count it. Is it a keyword? 69 | * 70 | WCOUNT = WCOUNT + 1 71 | DIFFER(T) :F(GTWORD) 72 | 73 | * Get cursor position of previous NCHARS. 74 | * 75 | KSTART = WSTART - NCHARS 76 | 77 | * If we need more characters to display the following NCHARS, obtain them. 78 | * 79 | CKSIZE LE(WEND + NCHARS, SIZE(LINE)) :S(CAPTURE) 80 | LINE = LINE " " INPUT :S(CKSIZE) 81 | 82 | * Peel off the previous and following NCHARS, and record them. 83 | * 84 | CAPTURE LINE ? DPAT 85 | CAPTURE = CAPTURE PREVIOUS " " WORD " " POST MARKER 86 | 87 | * Count occurrence of keyword and accumulate total. 88 | * 89 | WORDCNTS = WORDCNTS + 1 90 | KCOUNT = KCOUNT + 1 91 | 92 | * Now remove characters no longer needed from the beginning of LINE. 93 | * 94 | LINE = SUBSTR(LINE, WEND + 1 - NCHARS) 95 | WEND = NCHARS :(GTWORD) 96 | 97 | * Now convert the table to a sorted array, and print it out. 98 | * 99 | DISPLAY OUTPUT = WCOUNT " total words read" 100 | OUTPUT = KCOUNT " occurrences of keywords found" 101 | CAPTURE = SORT(CAPTURE) 102 | I = 0 103 | D1 S = CAPTURE :F(END) 104 | OUTPUT = "" 105 | WORD = CAPTURE 106 | COUNT = WORDCNTS 107 | OUTPUT = WORD ": " COUNT " occurrence" 108 | + (GT(COUNT,1) "s","") " --" 109 | D2 S ? CPAT = "" :F(D1) 110 | OUTPUT = DISPLAY :(D2) 111 | END 112 | -------------------------------------------------------------------------------- /osint/arith.c: -------------------------------------------------------------------------------- 1 | /* 2 | Copyright 1987-2012 Robert B. K. Dewar and Mark Emmer. 3 | Copyright 2012-2015 David Shields 4 | 5 | This file is part of Macro SPITBOL. 6 | 7 | Macro SPITBOL is free software: you can redistribute it and/or modify 8 | it under the terms of the GNU General Public License as published by 9 | the Free Software Foundation, either version 2 of the License, or 10 | (at your option) any later version. 11 | 12 | Macro SPITBOL is distributed in the hope that it will be useful, 13 | but WITHOUT ANY WARRANTY; without even the implied warranty of 14 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 15 | GNU General Public License for more details. 16 | 17 | You should have received a copy of the GNU General Public License 18 | along with Macro SPITBOL. If not, see . 19 | */ 20 | 21 | /* 22 | * arith.c - floating point support for spitbol 23 | * 24 | * These routines are not called from other C routines. Rather they 25 | * are called by inter.*, and by external functions, to perform basic 26 | * arithmetic operatios. 27 | */ 28 | 29 | #include "port.h" 30 | 31 | 32 | // reg_rb is used to pass arguments to read operations 33 | extern double reg_rb; 34 | 35 | // overflow codes 36 | // OF = 0x80 37 | // cf = 0x01 38 | // zr = 0x40 39 | 40 | void f_ldr() { // load real 41 | reg_ra = reg_rb; 42 | return; 43 | } 44 | 45 | void f_adr() { // add real 46 | reg_ra += reg_rb; 47 | return; 48 | } 49 | 50 | void f_sbr() { // subtract real 51 | reg_fl = 0; 52 | reg_ra -= reg_rb; 53 | return; 54 | } 55 | 56 | void f_mlr() { // multiply real 57 | reg_ra *= reg_rb; 58 | reg_fl = 0; 59 | return; 60 | } 61 | 62 | void f_dvr() { // divide real 63 | if (reg_rb != 0.0) { 64 | reg_ra /= reg_rb; 65 | reg_fl = 0; 66 | } 67 | else 68 | reg_fl = 1; 69 | return; 70 | } 71 | 72 | void f_ngr() { // negate real 73 | reg_ra = -reg_ra; 74 | return; 75 | } 76 | 77 | void f_itr() { // integer to real 78 | reg_ra = (double) reg_ia; 79 | return; 80 | } 81 | 82 | void f_rti() { // real to integer 83 | reg_ia = reg_ra; 84 | } 85 | 86 | 87 | void f_cpr() { 88 | if ( reg_ra == 0.0) 89 | reg_fl = 0; 90 | else if ( reg_ra < 0.0) 91 | reg_fl = -1; 92 | else 93 | reg_fl = 1; 94 | } 95 | 96 | void f_pra () { 97 | } 98 | 99 | void i_ldi() { 100 | reg_ia = reg_w0; 101 | } 102 | 103 | void i_adi() { 104 | reg_fl = 0; 105 | reg_ia += reg_w0; 106 | } 107 | 108 | void i_dvi() { 109 | if (reg_w0 == 0) { 110 | reg_fl = 1; 111 | } 112 | else { 113 | reg_fl = 0; 114 | reg_ia /= reg_w0; 115 | } 116 | } 117 | 118 | void i_mli() { 119 | reg_fl = 0; 120 | reg_ia *= reg_w0; 121 | } 122 | 123 | void i_ngi() { 124 | reg_fl = 0; 125 | reg_ia = -reg_ia; 126 | } 127 | 128 | void i_rmi() { 129 | if (reg_w0 == 0) { 130 | reg_fl = 1; 131 | } 132 | else { 133 | reg_ia = reg_ia % reg_w0; 134 | reg_fl = 0; 135 | } 136 | } 137 | 138 | void i_sbi() { 139 | reg_ia -= reg_w0; 140 | } 141 | 142 | void i_cvd() { 143 | 144 | reg_wa = reg_ia % 10; 145 | reg_ia /= 10; 146 | reg_wa = -reg_wa + 48; // convert remainder to character code for digit 147 | } 148 | 149 | long ctbw_r; 150 | long ctbw_v; 151 | 152 | void ctw_() { 153 | long reg; 154 | reg = (ctbw_r + CPW - 1) >> LOG_CPW; 155 | reg += ctbw_v; 156 | ctbw_r = reg; 157 | } 158 | 159 | void ctb_() { 160 | ctw_(); 161 | ctbw_r = ctbw_r * CPW; 162 | } 163 | -------------------------------------------------------------------------------- /nasm/z.sbl: -------------------------------------------------------------------------------- 1 | * Copyright 2012-2015 David Shields 2 | * 3 | * This file is part of Macro SPITBOL. 4 | * 5 | * Macro SPITBOL is free software: you can redistribute it and/or modify 6 | * it under the terms of the GNU General Public License as published by 7 | * the Free Software Foundation, either version 2 of the License, or 8 | * (at your option) any later version. 9 | * 10 | * Macro SPITBOL is distributed in the hope that it will be useful, 11 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 12 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 13 | * GNU General Public License for more details. 14 | * 15 | * You should have received a copy of the GNU General Public License 16 | * along with Macro SPITBOL. If not, see . 17 | * 18 | &anchor = 0 19 | &trim = 1 20 | &stlimit = 10000000 21 | &dump = 2 22 | define('getname(varg)') 23 | define('adjust()i') 24 | input(.varfile,1,'s.dic') 25 | names = array('1000') 26 | offsets = array('1000') 27 | n = 0 28 | min_val = 0 29 | max_val = 0 30 | vloop 31 | line = varfile :f(vend) 32 | line break(' ') . name ' ' 33 | + rem . offset :f(error) 34 | v.add 35 | n = n + 1 36 | names[n] = name 37 | offsets[n] = +offset 38 | :(vloop) 39 | vend 40 | i = 0 41 | bloop 42 | gt(i = i + 1,n) :s(bloop.end) 43 | offsets[i] = offsets[i] + min_val 44 | :(bloop) 45 | bloop.end 46 | :(loop) 47 | copy 48 | output = trim(line) 49 | loop 50 | line = input :f(finis) 51 | * output = 'input: ' line 52 | lt(size(line),15) :s(loop.1) 53 | lne(substr(line,10,1),' ') :s(loop.1) 54 | vname = substr(line,1,9) 55 | min_val = ident(vname,'OFF_C_AAA') +substr(line,11) 56 | output = ident(vname,'OFF_C_AAA') 'min_val ' substr(line,11) 57 | max_val = ident(vname,'OFF_W_YYY') +substr(line,11) 58 | output = ident(vname,'OFF_W_YYY') 'max_val ' substr(line,11) 59 | ident(vname,'OFF_C_AAA') adjust() 60 | output = ident(vname,'OFF_W_YYY') 'max-min ' max_val - min_val 61 | loop.1 62 | line 'Z' span('0123456789') . varg = getname(varg) :s(loop.1) 63 | :(copy) 64 | error 65 | :(copy) 66 | output = 'ERROR line ' line :(copy) 67 | 68 | getname 69 | leq(substr(varg,1,1),'2') :s(return) 70 | leq(substr(varg,1,1),'3') :s(return) 71 | leq(substr(varg,1,1),'4') :s(return) 72 | getname = 'xxxxxxxx' 73 | eq(min_val) :s(return) 74 | val = +varg 75 | lt(val, min_val) :s(return) 76 | gt(val, max_val) :s(return) 77 | getnameoff = 0 78 | * output = 'getname arg ' varg 79 | i = n 80 | * output = 'i,v,offsets ' i ' ' val ' ' offsets[i] 81 | eq(val, offsets[i]) :s(found) 82 | i = 1 83 | * output 'i,v,offsets ' i ' ' val ' ' offsets[i] 84 | eq(val, offsets[i]) :s(found) 85 | * output = 'getname looking for ' val 86 | get.loop 87 | i = i + 1 88 | * output = 'i,n,val,offsets ' i ' ' n ' ' val ' ' offsets[i] 89 | 90 | gt(i,n) :s(error) 91 | eq(val,offsets[i]) :s(found) 92 | lt(val, offsets[i + 1]) :s(found)f(get.loop) 93 | found 94 | * output = 'found ' varg ' ' i 95 | matched = matched + 1 96 | getname = '!' names[i] (ne(val, offsets[i]) 97 | + '+' (val - offsets[i]), '') 98 | + :(return) 99 | 100 | adjust 101 | min_val = +min_val 102 | * output = 'adjust min_val ' min_val 103 | ai = 0 104 | adjust.1 105 | gt(ai = ai + 1,n) :s(return) 106 | offsets[ai] = min_val + offsets[ai] 107 | * output = names[ai] ' ' offsets[ai] 108 | :(adjust.1) 109 | 110 | finis 111 | &DUMP = 0 112 | output = 'matched ' matched ' entries' 113 | end 114 | -------------------------------------------------------------------------------- /test/z.sbl: -------------------------------------------------------------------------------- 1 | * Copyright 2012-2015 David Shields 2 | * 3 | * This file is part of Macro SPITBOL. 4 | * 5 | * Macro SPITBOL is free software: you can redistribute it and/or modify 6 | * it under the terms of the GNU General Public License as published by 7 | * the Free Software Foundation, either version 2 of the License, or 8 | * (at your option) any later version. 9 | * 10 | * Macro SPITBOL is distributed in the hope that it will be useful, 11 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 12 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 13 | * GNU General Public License for more details. 14 | * 15 | * You should have received a copy of the GNU General Public License 16 | * along with Macro SPITBOL. If not, see . 17 | * 18 | &anchor = 0 19 | &trim = 1 20 | &stlimit = 10000000 21 | &dump = 2 22 | define('getname(varg)') 23 | define('adjust()i') 24 | input(.varfile,1,'s.dic') 25 | names = array('1000') 26 | offsets = array('1000') 27 | n = 0 28 | min_val = 0 29 | max_val = 0 30 | vloop 31 | line = varfile :f(vend) 32 | line break(' ') . name ' ' 33 | + rem . offset :f(error) 34 | v.add 35 | n = n + 1 36 | names[n] = name 37 | offsets[n] = +offset 38 | :(vloop) 39 | vend 40 | i = 0 41 | bloop 42 | gt(i = i + 1,n) :s(bloop.end) 43 | offsets[i] = offsets[i] + min_val 44 | :(bloop) 45 | bloop.end 46 | :(loop) 47 | copy 48 | output = trim(line) 49 | loop 50 | line = input :f(finis) 51 | * output = 'input: ' line 52 | lt(size(line),15) :s(loop.1) 53 | lne(substr(line,10,1),' ') :s(loop.1) 54 | vname = substr(line,1,9) 55 | min_val = ident(vname,'OFF_C_AAA') +substr(line,11) 56 | output = ident(vname,'OFF_C_AAA') 'min_val ' substr(line,11) 57 | max_val = ident(vname,'OFF_W_YYY') +substr(line,11) 58 | output = ident(vname,'OFF_W_YYY') 'max_val ' substr(line,11) 59 | ident(vname,'OFF_C_AAA') adjust() 60 | output = ident(vname,'OFF_W_YYY') 'max-min ' max_val - min_val 61 | loop.1 62 | line 'Z' span('0123456789') . varg = getname(varg) :s(loop.1) 63 | :(copy) 64 | error 65 | :(copy) 66 | output = 'ERROR line ' line :(copy) 67 | 68 | getname 69 | leq(substr(varg,1,1),'2') :s(return) 70 | leq(substr(varg,1,1),'3') :s(return) 71 | leq(substr(varg,1,1),'4') :s(return) 72 | getname = 'xxxxxxxx' 73 | eq(min_val) :s(return) 74 | val = +varg 75 | lt(val, min_val) :s(return) 76 | gt(val, max_val) :s(return) 77 | getnameoff = 0 78 | * output = 'getname arg ' varg 79 | i = n 80 | * output = 'i,v,offsets ' i ' ' val ' ' offsets[i] 81 | eq(val, offsets[i]) :s(found) 82 | i = 1 83 | * output 'i,v,offsets ' i ' ' val ' ' offsets[i] 84 | eq(val, offsets[i]) :s(found) 85 | * output = 'getname looking for ' val 86 | get.loop 87 | i = i + 1 88 | * output = 'i,n,val,offsets ' i ' ' n ' ' val ' ' offsets[i] 89 | 90 | gt(i,n) :s(error) 91 | eq(val,offsets[i]) :s(found) 92 | lt(val, offsets[i + 1]) :s(found)f(get.loop) 93 | found 94 | * output = 'found ' varg ' ' i 95 | matched = matched + 1 96 | getname = '!' names[i] (ne(val, offsets[i]) 97 | + '+' (val - offsets[i]), '') 98 | + :(return) 99 | 100 | adjust 101 | min_val = +min_val 102 | * output = 'adjust min_val ' min_val 103 | ai = 0 104 | adjust.1 105 | gt(ai = ai + 1,n) :s(return) 106 | offsets[ai] = min_val + offsets[ai] 107 | * output = names[ai] ' ' offsets[ai] 108 | :(adjust.1) 109 | 110 | finis 111 | &DUMP = 0 112 | output = 'matched ' matched ' entries' 113 | end 114 | -------------------------------------------------------------------------------- /osint/systty.c: -------------------------------------------------------------------------------- 1 | /* 2 | Copyright 1987-2012 Robert B. K. Dewar and Mark Emmer. 3 | Copyright 2012-2013 David Shields 4 | 5 | This file is part of Macro SPITBOL. 6 | 7 | Macro SPITBOL is free software: you can redistribute it and/or modify 8 | it under the terms of the GNU General Public License as published by 9 | the Free Software Foundation, either version 2 of the License, or 10 | (at your option) any later version. 11 | 12 | Macro SPITBOL is distributed in the hope that it will be useful, 13 | but WITHOUT ANY WARRANTY; without even the implied warranty of 14 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 15 | GNU General Public License for more details. 16 | 17 | You should have received a copy of the GNU General Public License 18 | along with Macro SPITBOL. If not, see . 19 | */ 20 | 21 | /* 22 | / The systty module contains two functions, zyspi and zysri, that 23 | / perform terminal I/O. 24 | / 25 | / During program execution assignment to variable TERMINAL causes a line 26 | / to be printed on the terminal. A call is made to zyspi to actually 27 | / print the line. 28 | / 29 | / During program execution a value reference to varible TERMINAL causes 30 | / a line to be read from the terminal. A call is made to zysri to actually 31 | / read the line. 32 | / 33 | / Under Un*x file descriptor 2 will be used for terminal access. 34 | */ 35 | 36 | #include "port.h" 37 | 38 | void ttyinit() 39 | { 40 | ttyiobin.bfb = MP_OFF(pttybuf, struct bfblk *); 41 | } 42 | 43 | /* 44 | / zyspi - print on interactive channel 45 | / 46 | / zyspi prints a line on the user's terminal. 47 | / 48 | / Parameters: 49 | / xr pointer to SCBLK containing string to print 50 | / wa length of string 51 | / Returns: 52 | / Nothing 53 | / Exits: 54 | / 1 failure 55 | */ 56 | 57 | zyspi() 58 | 59 | { 60 | word retval; 61 | 62 | retval = oswrite( 1, ttyiobout.len, WA(word), &ttyiobout, XR( struct scblk * ) ); 63 | 64 | /* 65 | / Return error if oswrite fails. 66 | */ 67 | if ( retval != 0 ) 68 | return EXIT_1; 69 | 70 | return NORMAL_RETURN; 71 | } 72 | 73 | 74 | /* 75 | / zysri - read from interactive channel 76 | / 77 | / zysri reads a line from the user's terminal. 78 | / 79 | / Parameters: 80 | / xr pointer to SCBLK to receive line 81 | / Returns: 82 | / Nothing 83 | / Exits: 84 | / 1 EOF 85 | */ 86 | 87 | 88 | zysri() 89 | 90 | { 91 | register word length; 92 | register struct scblk *scb = XR( struct scblk * ); 93 | register char *saveptr, savechr; 94 | 95 | /* 96 | / Read a line specified by length of scblk. If EOF take exit 1. 97 | */ 98 | length = scb->len; // Length of buffer provided 99 | saveptr = scb->str + length; // Save char following buffer for \n 100 | savechr = *saveptr; 101 | 102 | ((struct bfblk *) (ttyiobin.bfb))->size = ++length; // Size includes extra byte for \n 103 | 104 | length = osread( 1, length, &ttyiobin, scb ); 105 | 106 | *saveptr = savechr; // Restore saved char 107 | 108 | if ( length < 0 ) 109 | return EXIT_1; 110 | 111 | /* 112 | / Line read OK, so set string length and return normally. 113 | */ 114 | scb->len = length; 115 | return NORMAL_RETURN; 116 | } 117 | 118 | 119 | // change handle used for TERMINAL output 120 | void ttyoutfdn(h) 121 | File_handle h; 122 | { 123 | ttyiobout.fdn = h; 124 | if (testty(h)) 125 | ttyiobout.flg1 &= ~IO_COT; 126 | else 127 | ttyiobout.flg1 |= IO_COT; 128 | } 129 | -------------------------------------------------------------------------------- /test/trc.sbl: -------------------------------------------------------------------------------- 1 | .def comment_asterisk 2 | * Copyright 2012-2015 David Shields 3 | * 4 | * This file is part of Macro SPITBOL. 5 | * 6 | * Macro SPITBOL is free software: you can redistribute it and/or modify 7 | * it under the terms of the GNU General Public License as published by 8 | * the Free Software Foundation, either version 2 of the License, or 9 | * (at your option) any later version. 10 | * 11 | * Macro SPITBOL is distributed in the hope that it will be useful, 12 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 13 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 14 | * GNU General Public License for more details. 15 | * 16 | * You should have received a copy of the GNU General Public License 17 | * along with Macro SPITBOL. If not, see . 18 | * 19 | &anchor = 0 20 | &trim = 1 21 | &stlimit = 10000000 22 | &stlimit = 10000000 23 | &dump = 3 24 | 25 | 26 | define('getname(varg)') 27 | define('adjust()i') 28 | 29 | names = array('10000') 30 | offsets = array('10000') 31 | n = 0 32 | min_val = 0 33 | max_val = 0 34 | dicname = (differ(host(0)) host(0), 's-nasm.dic') 35 | output = ~input(.varfile,1,dicname) 'cannot open input' :s(end) 36 | vloop 37 | line = varfile :f(vend) 38 | line break(' ') . name ' ' 39 | + rem . offset :f(error) 40 | v.add 41 | n = n + 1 42 | names[n] = name 43 | offsets[n] = +offset 44 | :(vloop) 45 | vend 46 | i = 0 47 | bloop 48 | gt(i = i + 1,n) :s(bloop.end) 49 | offsets[i] = offsets[i] + min_val 50 | * output = '#offsets ' i ' ' offsets[i] 51 | :(bloop) 52 | bloop.end 53 | :(loop) 54 | copy 55 | output = trim(line) 56 | loop 57 | line = input :f(finis) 58 | * output = 'input: ' line 59 | lt(size(line),15) :s(loop.1) 60 | lne(substr(line,10,1),' ') :s(loop.1) 61 | vname = substr(line,1,9) 62 | min_val = ident(vname,'off_c_aaa') +substr(line,11) 63 | output = ident(vname,'off_c_aaa') 'min_val ' substr(line,11) 64 | max_val = ident(vname,'off_w_yyy') +substr(line,11) 65 | output = ident(vname,'off_w_yyy') 'max_val ' substr(line,11) 66 | ident(vname,'off_c_aaa') adjust() 67 | output = ident(vname,'off_w_yyy') 'max-min ' max_val - min_val 68 | loop.1 69 | * output = '# ' line 70 | line 'Z' span('0123456789') . varg = getname(varg) :s(loop.1) 71 | :(copy) 72 | error 73 | :(copy) 74 | output = 'ERROR line ' line :(copy) 75 | 76 | getname 77 | leq(substr(varg,1,1),'2') :s(return) 78 | leq(substr(varg,1,1),'3') :s(return) 79 | leq(substr(varg,1,1),'4') :s(return) 80 | getname = 'xxxxxxxx' 81 | eq(min_val) :s(return) 82 | val = +varg 83 | lt(val, min_val) :s(return) 84 | gt(val, max_val) :s(return) 85 | getnameoff = 0 86 | * output = 'getname arg ' varg 87 | i = n 88 | * output = 'i,v,offsets ' i ' ' val ' ' offsets[i] 89 | eq(val, offsets[i]) :s(found) 90 | i = 1 91 | * output 'i,v,offsets ' i ' ' val ' ' offsets[i] 92 | eq(val, offsets[i]) :s(found) 93 | * output = 'getname looking for ' val 94 | get.loop 95 | i = i + 1 96 | * output = 'i,n,val,offsets ' i ' ' n ' ' val ' ' offsets[i] 97 | 98 | gt(i,n) :s(error) 99 | eq(val,offsets[i]) :s(found) 100 | lt(val, offsets[i + 1]) :s(found)f(get.loop) 101 | found 102 | * output = 'found ' varg ' ' i 103 | matched = matched + 1 104 | getname = '!' names[i] (ne(val, offsets[i]) 105 | + '+' (val - offsets[i]), '') 106 | + :(return) 107 | 108 | adjust 109 | min_val = +min_val 110 | * output = 'adjust min_val ' min_val 111 | ai = 0 112 | adjust.1 113 | gt(ai = ai + 1,n) :s(return) 114 | offsets[ai] = min_val + offsets[ai] 115 | * output = names[ai] ' ' offsets[ai] 116 | :(adjust.1) 117 | 118 | finis 119 | &dump = 0 120 | output = 'matched ' matched ' entries' 121 | end 122 | -------------------------------------------------------------------------------- /osint/sysdt.c: -------------------------------------------------------------------------------- 1 | /* 2 | Copyright 1987-2012 Robert B. K. Dewar and Mark Emmer. 3 | Copyright 2012-2015 David Shields 4 | 5 | This file is part of Macro SPITBOL. 6 | 7 | Macro SPITBOL is free software: you can redistribute it and/or modify 8 | it under the terms of the GNU General Public License as published by 9 | the Free Software Foundation, either version 2 of the License, or 10 | (at your option) any later version. 11 | 12 | Macro SPITBOL is distributed in the hope that it will be useful, 13 | but WITHOUT ANY WARRANTY; without even the implied warranty of 14 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 15 | GNU General Public License for more details. 16 | 17 | You should have received a copy of the GNU General Public License 18 | along with Macro SPITBOL. If not, see . 19 | */ 20 | 21 | /* 22 | / File: SYSDT.C Version: 01.06 23 | / --------------------------------------- 24 | / 25 | / Contents: Function zysdt 26 | / Function conv 27 | */ 28 | 29 | /* 30 | / zysdt - get current date 31 | / 32 | / zysdt is called when executing a Spitbol date function. 33 | / 34 | / Parameters: 35 | / XR - optional integer argument describing date format desired 36 | / Returns: 37 | / XL - pointer to SCBLK containing date string 38 | / Exits: 39 | / None 40 | */ 41 | 42 | #include "port.h" 43 | #include 44 | 45 | static int datecvt ( char *cp, int type ); 46 | static int timeconv ( char *tp, struct tm *tm ); 47 | 48 | // conv() rewritten to avoid dependence on library remainder routine 49 | void conv (dest, value) 50 | 51 | register char *dest; 52 | register int value; 53 | 54 | { 55 | register short int i; 56 | i = value / 10; 57 | dest[0] = i + '0'; 58 | dest[1] = value - i*10 + '0'; 59 | } 60 | 61 | zysdt() 62 | { 63 | struct icblk *dtscb = XR (struct icblk *); 64 | 65 | ptscblk->len = datecvt( ptscblk->str, dtscb->val ); 66 | SET_XL( ptscblk ); 67 | return NORMAL_RETURN; 68 | } 69 | 70 | /* 71 | * Write date/time in SPITBOL form to a string 72 | */ 73 | int storedate( cp, maxlen ) 74 | char *cp; 75 | word maxlen; 76 | { 77 | if (maxlen < 18) 78 | return 0; 79 | 80 | return datecvt(cp, 0); 81 | } 82 | 83 | /* 84 | * Write date/time in several different forms to a string 85 | */ 86 | int datecvt( cp, type ) 87 | char *cp; 88 | int type; 89 | { 90 | 91 | time_t tod; 92 | 93 | register struct tm *tm; 94 | tm = localtime( &tod ); 95 | 96 | switch (type) 97 | { 98 | default: 99 | case 0: // "MM/DD/YY hh:mm:ss" 100 | conv( cp, tm->tm_mon+1 ); 101 | cp[2] = '/'; 102 | conv( cp+3, tm->tm_mday ); 103 | cp[5] = '/'; 104 | conv( cp+6, tm->tm_year % 100 ); // Prepare for year 2000! 105 | return 8 + timeconv(&cp[8], tm); 106 | 107 | case 1: // "MM/DD/YYYY hh:mm:ss" 108 | conv( cp, tm->tm_mon+1 ); 109 | cp[2] = '/'; 110 | conv( cp+3, tm->tm_mday ); 111 | cp[5] = '/'; 112 | conv( cp+6, (tm->tm_year + 1900) / 100 ); 113 | conv( cp+8, tm->tm_year % 100 ); // Prepare for year 2000! 114 | return 10 + timeconv(&cp[10], tm); 115 | 116 | case 2: // "YYYY-MM-DD/YYYY hh:mm:ss" 117 | conv( cp+0, (tm->tm_year + 1900) / 100 ); 118 | conv( cp+2, tm->tm_year % 100 ); // Prepare for year 2000! 119 | cp[4] = '-'; 120 | conv( cp+5, tm->tm_mon+1 ); 121 | cp[7] = '-'; 122 | conv( cp+8, tm->tm_mday ); 123 | return 10 + timeconv(&cp[10], tm); 124 | } 125 | } 126 | 127 | static int timeconv( tp, tm) 128 | char *tp; 129 | struct tm *tm; 130 | { 131 | tp[0] = ' '; 132 | conv( tp+1, tm->tm_hour ); 133 | tp[3] = ':'; 134 | conv( tp+4, tm->tm_min ); 135 | tp[6] = ':'; 136 | conv( tp+7, tm->tm_sec ); 137 | *(tp+9) = '\0'; 138 | return 9; 139 | } 140 | 141 | -------------------------------------------------------------------------------- /osint/sysbx.c: -------------------------------------------------------------------------------- 1 | /* 2 | Copyright 1987-2012 Robert B. K. Dewar and Mark Emmer. 3 | Copyright 2012-2013 David Shields 4 | 5 | This file is part of Macro SPITBOL. 6 | 7 | Macro SPITBOL is free software: you can redistribute it and/or modify 8 | it under the terms of the GNU General Public License as published by 9 | the Free Software Foundation, either version 2 of the License, or 10 | (at your option) any later version. 11 | 12 | Macro SPITBOL is distributed in the hope that it will be useful, 13 | but WITHOUT ANY WARRANTY; without even the implied warranty of 14 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 15 | GNU General Public License for more details. 16 | 17 | You should have received a copy of the GNU General Public License 18 | along with Macro SPITBOL. If not, see . 19 | */ 20 | 21 | /* 22 | / File: SYSBX.C Version: 01.06 23 | / --------------------------------------- 24 | / 25 | / Contents: Function zysbx 26 | */ 27 | 28 | /* 29 | / zysbx - before execution setup 30 | / 31 | / Setup here so that all further "standard output" goes to stdout. 32 | / This allows us to separate compiler/interpreter generated output 33 | / from output generated by the executing program. 34 | / 35 | / If the -w command line option has been invoked, this module will 36 | / write an executable module and terminate. 37 | / 38 | / If the -y command line option has been invoked, this module will 39 | / write a save (.spx) file and terminate. 40 | 41 | / Parameters: 42 | / None 43 | / Returns: 44 | / Nothing 45 | / Exits: 46 | / None 47 | / 48 | */ 49 | 50 | #include "port.h" 51 | 52 | zysbx() 53 | { 54 | #if !RUNTIME 55 | 56 | executing = 1; 57 | 58 | if (readshell0) { 59 | doset(getrdiob(), 0L, 2); // bypass rest of source file 60 | curfile = inpcnt; // skip rest of cmd line files 61 | swcinp( inpcnt, inpptr ); // v1.07 switch away from source file 62 | } 63 | 64 | #if EXECFILE 65 | /* 66 | / do we need to write an executable module, and if 67 | / so does writing it produce an error? 68 | */ 69 | if ( spitflag & WRTEXE) 70 | { 71 | ptscblk->len = appendext( *inpptr, BINEXT, ptscblk->str, 1 ); 72 | 73 | if ( makeexec( ptscblk, spitflag & NOEXEC ? 3 : 4 ) ) 74 | { 75 | wrterr( "Error writing load module." ); 76 | zysej(); 77 | } 78 | } 79 | #endif // EXECFILE 80 | 81 | /* 82 | / do we need to write a save (.spx) file, and if 83 | / so does writing it produce an error? 84 | */ 85 | if ( spitflag & WRTSAV) 86 | { 87 | ptscblk->len = appendext( *inpptr, RUNEXT, ptscblk->str, 1 ); 88 | if ( makeexec( ptscblk, spitflag & NOEXEC ? -3 : -4 ) ) 89 | { 90 | wrterr( "Error writing save file." ); 91 | zysej(); 92 | } 93 | } 94 | /* 95 | / Execution does not resume here for dirty load modules. 96 | / Because we must allow for new versions with different 97 | / size C code, the stacked return addresses are not valid. 98 | / Therefore, inter.asm forces a jump to restart code that 99 | / eventually jumps to the MINIMAL code following the call 100 | / the sysbx call. 101 | / 102 | / *********************************************************** 103 | / * WE DO NOT RETURN HERE. ANY NEW CODE ADDED HERE MUST BE * 104 | / * DUPLICATED IN THE RESTART CODE * 105 | / *********************************************************** 106 | */ 107 | 108 | // execution resumes here when a.out file created with 109 | // the -w option is reloaded. 110 | 111 | startbrk(); // turn on Control-C checking 112 | 113 | // swcoup does real work 114 | swcoup( outptr ); 115 | 116 | #else // !RUNTIME 117 | __exit(1); 118 | #endif // !RUNTIME 119 | 120 | return NORMAL_RETURN; 121 | } 122 | -------------------------------------------------------------------------------- /osint/save.h: -------------------------------------------------------------------------------- 1 | /* 2 | Copyright 1987-2012 Robert B. K. Dewar and Mark Emmer. 3 | Copyright 2012-2015 David Shields 4 | 5 | This file is part of Macro SPITBOL. 6 | 7 | Macro SPITBOL is free software: you can redistribute it and/or modify 8 | it under the terms of the GNU General Public License as published by 9 | the Free Software Foundation, either version 2 of the License, or 10 | (at your option) any later version. 11 | 12 | Macro SPITBOL is distributed in the hope that it will be useful, 13 | but WITHOUT ANY WARRANTY; without even the implied warranty of 14 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 15 | GNU General Public License for more details. 16 | 17 | You should have received a copy of the GNU General Public License 18 | along with Macro SPITBOL. If not, see . 19 | */ 20 | 21 | /* 22 | / File: SAVE.H Version 1.01 23 | / ------------------------------------- 24 | / 25 | / This header file provides information for writing the impure 26 | / portions of SPITBOL's data segments to a save file. 27 | / 28 | / v1.01 3-Jun-91 MBE 29 | / Added memincb, maxsize, readshell0 & uarg to header, and 30 | / additional argument to specify whether these values should 31 | / override existing values, as would be the case for the 32 | / Intel MS-DOS version, where Save files are used to simulate 33 | / Exec files. 34 | / 35 | */ 36 | /* 37 | * +--------2--------+--------2--------+---------4---------+ 38 | * | | | | 39 | * | IA size | WORD size | Save File Version | 40 | * | | | | 41 | * +-----------------+-----------------+-------------------+ 42 | * 43 | * IA (integer accumulator) and Minimal Word Size: 44 | * 0 - 16 bits 45 | * 1 - 32 bits 46 | * 2 - 64 bits 47 | * 3 - 128 bits 48 | */ 49 | #define VWBSHFT 4 50 | #define VIASHFT (VWBSHFT+2) 51 | #define VERSION 5 52 | #define SaveVersion ((unsigned char)(VERSION+((WORDBITS/32)<0 = code word size (bits) 85 | word uarglen; // length of -u command string 86 | }; 87 | 88 | #define OURMAGIC1 0xfaa5a5fa 89 | #define OURMAGIC2 0x0d0a0d0a 90 | -------------------------------------------------------------------------------- /osint/lenfnm.c: -------------------------------------------------------------------------------- 1 | /* 2 | Copyright 1987-2012 Robert B. K. Dewar and Mark Emmer. 3 | Copyright 2012-2013 David Shields 4 | 5 | This file is part of Macro SPITBOL. 6 | 7 | Macro SPITBOL is free software: you can redistribute it and/or modify 8 | it under the terms of the GNU General Public License as published by 9 | the Free Software Foundation, either version 2 of the License, or 10 | (at your option) any later version. 11 | 12 | Macro SPITBOL is distributed in the hope that it will be useful, 13 | but WITHOUT ANY WARRANTY; without even the implied warranty of 14 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 15 | GNU General Public License for more details. 16 | 17 | You should have received a copy of the GNU General Public License 18 | along with Macro SPITBOL. If not, see . 19 | */ 20 | 21 | /* 22 | / lenfnm( scptr ) 23 | / 24 | / lenfnm() examines the file argument within the passed SCBLK and returns 25 | / the length of the filename contained within it. This function will be 26 | / called from any of the OSINT functions dealing with filenames or I/O 27 | / options. 28 | */ 29 | 30 | /* The file argument string will contain a filename and/or options with the 31 | / options enclosed in "[" and "]", as in 32 | / 33 | / "filename" 34 | / "filename[options]" 35 | / "[options]" 36 | / 37 | / v1.02 23-Feb-96 - Check pipe syntax when bracketed options present. 38 | */ 39 | 40 | /* The file argument can also contain options separated from the filename 41 | / by a blank. 42 | / 43 | / "filename options" 44 | / " options" 45 | / 46 | */ 47 | 48 | /* 49 | / The file argument may instead be a command string with options as in 50 | / 51 | / "!*commandstring" 52 | / "!*commandstring*" 53 | / "!*commandstring* options" 54 | / 55 | / Notice that the character following the '!' serves as a delimiter to 56 | / separate the end of the command string from the space preceding any 57 | / options. 58 | */ 59 | 60 | /* Parameters: 61 | / scptr pointer to SCBLK containg filename string 62 | / Returns: 63 | / length of filename (0 is possible) 64 | / -1 if illegal name 65 | */ 66 | 67 | #include "port.h" 68 | 69 | word lenfnm( scptr ) 70 | 71 | struct scblk *scptr; 72 | 73 | { 74 | register word cnt, len, len2; 75 | register char *cp; 76 | register char delim; 77 | 78 | /* 79 | / Null strings have filenames with lengths of 0. 80 | */ 81 | len = len2 = scptr->len; 82 | if ( len == 0 ) 83 | return 0L; 84 | 85 | /* 86 | / Here to examine end of string for "[option]". 87 | */ 88 | cp = &scptr->str[--len2]; // last char of strng 89 | if ( *cp == ']') // string end with "]" ? 90 | { 91 | // String ends with "]", find preceeding "[" 92 | while (len2--) 93 | { 94 | if (*--cp == ']') 95 | break; 96 | if (*cp == '[') 97 | { 98 | // valid option syntax, remove from length of string we'll examine 99 | len = cp - scptr->str; 100 | break; 101 | } 102 | } 103 | } 104 | 105 | // Look for space as the options delimiter 106 | cp = scptr->str; 107 | 108 | /* 109 | / Here to bypass spaces within a pipe command. 110 | / Count characters through second occurrence of delimiting 111 | / character. lenfnm( "!!foo goo!" ) = 10 112 | */ 113 | if ( *cp == '!' ) 114 | { 115 | if ( len < 3L ) // "!!" clearly invalid 116 | return -1L; 117 | delim = *++cp; // pick up delimiter 118 | if ( *++cp == delim ) // "!!!" also invalid 119 | return -1L; 120 | // count chars up to delim 121 | for ( cnt = 2; cnt < len && *cp++ != delim; cnt++ ) 122 | ; 123 | if ( *--cp == delim ) // if last char is delim then 124 | ++cnt; // include it in the count 125 | return cnt; 126 | } 127 | 128 | /* 129 | / Here for a normal filename. Just count the number of characters 130 | / up to the first blank or end of string, whichever occurs first. 131 | */ 132 | for ( cnt = 0; cnt < len && *cp++ != ' '; cnt++ ) 133 | ; 134 | return cnt; 135 | } 136 | -------------------------------------------------------------------------------- /osint/sysbs.c: -------------------------------------------------------------------------------- 1 | /* 2 | Copyright 1987-2012 Robert B. K. Dewar and Mark Emmer. 3 | Copyright 2012-2013 David Shields 4 | 5 | This file is part of Macro SPITBOL. 6 | 7 | Macro SPITBOL is free software: you can redistribute it and/or modify 8 | it under the terms of the GNU General Public License as published by 9 | the Free Software Foundation, either version 2 of the License, or 10 | (at your option) any later version. 11 | 12 | Macro SPITBOL is distributed in the hope that it will be useful, 13 | but WITHOUT ANY WARRANTY; without even the implied warranty of 14 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 15 | GNU General Public License for more details. 16 | 17 | You should have received a copy of the GNU General Public License 18 | along with Macro SPITBOL. If not, see . 19 | */ 20 | 21 | /* 22 | / File: SYSBS.C Version: 01.02 23 | / --------------------------------------- 24 | / 25 | / Contents: Function zysbs 26 | */ 27 | 28 | /* 29 | / zysbs - backspace file 30 | / 31 | / zysbs move a file's position back one physical record. 32 | / 33 | / Parameters: 34 | / WA - FCBLK pointer or 0 35 | / XR - SCBLK pointer (EJECT argument) 36 | / Returns: 37 | / Nothing 38 | / Exits: 39 | / 1 - file does not exist 40 | / 2 - inappropriate file 41 | / 3 - i/o error 42 | / 43 | */ 44 | 45 | #include "port.h" 46 | 47 | static int back (struct ioblk *iob); 48 | 49 | #define RET_BIAS 100 50 | 51 | zysbs() 52 | { 53 | register int c; 54 | register struct fcblk *fcb = WA(struct fcblk *); 55 | register struct ioblk *iob = ((struct ioblk *) (fcb->iob)); 56 | 57 | // ensure the file is open 58 | if ( !(iob->flg1 & IO_OPN) ) 59 | return EXIT_1; 60 | 61 | if (!testty(iob->fdn) 62 | || iob->flg2 & IO_PIP // not allowed on pipes 63 | ) 64 | return EXIT_2; // character device 65 | 66 | if (fcb->mode) { // if line mode 67 | 68 | /* 69 | * If the characters immediately preceding the current position 70 | * are end-of-line characters, ignore them before starting scan 71 | * for beginning of record. 72 | */ 73 | if ((c = back(iob)) < 0) 74 | return c + RET_BIAS; // beginning of file 75 | if (c == EOL) 76 | if ((c = back(iob)) < 0) 77 | return c + RET_BIAS; 78 | 79 | /* 80 | * Here with c containing the first character of the record 81 | * we should examine. 82 | */ 83 | do { 84 | if (c == EOL) 85 | break; 86 | } while ((c = back(iob)) >= 0); 87 | 88 | if (c >= 0) 89 | doset(iob, 1L, 1); // advance past EOL char 90 | else 91 | return c + RET_BIAS; 92 | } 93 | 94 | else { // if raw mode 95 | if (doset(iob, -fcb->rsz, 1) < 0L) // just move back record length 96 | return EXIT_1; // I/O error 97 | } 98 | 99 | return NORMAL_RETURN; 100 | } 101 | 102 | 103 | /* 104 | * BACK - helper function to backup one position in file. 105 | * 106 | * returns character found at that position, or NORMAL_RETURN-RET_BIAS 107 | * if at beginning of file, or EXIT_3-RET_BIAS if I/O error. 108 | * Non-character returns are guaranteed to be negative. 109 | */ 110 | static int back(ioptr) 111 | struct ioblk *ioptr; 112 | { 113 | register struct bfblk *bfptr = ((struct bfblk *) (ioptr->bfb)); 114 | unsigned char c; 115 | 116 | while (bfptr) { // if file is buffered 117 | if (bfptr->next) 118 | return (unsigned int)(unsigned char)bfptr->buf[--bfptr->next]; 119 | if (!bfptr->offset) // if at beginning of file 120 | return NORMAL_RETURN-RET_BIAS; 121 | if (doset(ioptr, -1L, 1) < 0L) // seek back one position 122 | return EXIT_3-RET_BIAS; // if I/O error 123 | bfptr->next++; // setup to return character 124 | } 125 | 126 | // Unbuffered file. Use disgusting code 127 | if (!doset(ioptr, 0L, 1)) 128 | return NORMAL_RETURN-RET_BIAS; 129 | if (doset(ioptr, -1L, 1) < 0L || 130 | read(ioptr->fdn, &c, 1) != 1) 131 | return EXIT_3-RET_BIAS; // if I/O error 132 | doset(ioptr, -1L, 1); 133 | return (unsigned int)c; 134 | } 135 | -------------------------------------------------------------------------------- /test/if.sbl: -------------------------------------------------------------------------------- 1 | -title lex: phase 1 translation from minimal to lexemes (lexemes) 2 | -stitl initialization 3 | * copyright 1987-2012 robert b. k. dewar and mark emmer. 4 | * copyright 2012-2015 david shields 5 | * 6 | * this file is part of macro spitbol. 7 | * 8 | * macro spitbol is free software: you can redistribute it and/or modify 9 | * it under the terms of the gnu general public license as published by 10 | * the free software foundation, either version 2 of the license, or 11 | * (at your option) any later version. 12 | * 13 | * macro spitbol is distributed in the hope that it will be useful, 14 | * but without any warranty; without even the implied warranty of 15 | * merchantability or fitness for a particular purpose. see the 16 | * gnu general public license for more details. 17 | * 18 | * you should have received a copy of the gnu general public license 19 | * along with macro spitbol. if not, see . 20 | * 21 | * 22 | * 23 | * syntax error handler. 24 | * 25 | synerr output = incnt '(syntax error):' rdline :(rdline) 26 | * 27 | * process define 28 | * 29 | defop ident( condvar ) :s(synerr) 30 | differ( ignore_defs ) :s(rdline) 31 | eq( level ) :s(defok) 32 | eq( processrec[result(top),mode(top)] ) :s(rdline) 33 | defok symtbl[condvar] = 1 :(rdline) 34 | * 35 | * process undefine 36 | * 37 | undefop 38 | ident( condvar ) :s(synerr) 39 | eq( level ) :s(undok) 40 | eq( processrec[result(top),mode(top)] ) :s(rdline) 41 | undok symtbl[condvar] = :(rdline) 42 | * 43 | * process if 44 | * 45 | ifop ident( condvar ) :s(synerr) 46 | eq( level ) :s(ifok) 47 | * 48 | * here for .if encountered during bypass state. 49 | * 50 | ne( processrec[result(top),mode(top)] ) :s(ifok) 51 | level = level + 1 52 | top = statestk[level] = state(bypass,then) :(rdline) 53 | * 54 | * here for .if to be processed normally. 55 | * 56 | ifok level = level + 1 57 | top = statestk[level] = state( 58 | . ( differ( symtbl[condvar] ) true,false ), 59 | . then ) :(rdline) 60 | * 61 | * process .then 62 | * 63 | thenop differ(condvar) :s(synerr) 64 | eq(level) :s(synerr)f(rdline) 65 | * 66 | * process .else 67 | * 68 | elseop differ(condvar) :s(synerr) 69 | mode(top) = ne( level ) else :s(rdline)f(synerr) 70 | * 71 | * process .fi 72 | * 73 | fiop differ(condvar) :s(synerr) 74 | level = ne( level ) level - 1 :f(synerr) 75 | top = ( ne( level ) statestk[level],'' ) :(rdline) 76 | * 77 | * statestk maintains all state information while processing conditional 78 | * statements. level indexes the top entry. another variable, top, 79 | * has a copy of savestk[level]. 80 | * 81 | statestk = array( 30 ) 82 | level = 0 83 | top = 84 | * 85 | * each state entry in statestk contains state information about 86 | * the processing for each active .if. the state is maintained 87 | * as 2 fields: 88 | * 89 | * result the result of the .if expression evaluation- 90 | * true, false, or bypass 91 | * 92 | * mode whether processing then or else portion of .if 93 | * 94 | data( 'state(result,mode)' ) 95 | false = 0 96 | true = 1 97 | bypass = 2 98 | else = 0 99 | then = 1 100 | * 101 | * processrec is indexed by the current result and mode to determine 102 | * whether or not a statement should be processed and written to the 103 | * output file. 104 | * 105 | processrec = array( false ':' bypass ',' else ':' then,0 ) 106 | processrec[true,then] = 1 107 | processrec[false,else] = 1 108 | * 109 | * p.condasm breaks up conditional assembly directives. 110 | * 111 | sep = ' ' 112 | p.condasm = ( break(sep) | rem ) . condcmd 113 | . ( span(sep) | '' ) 114 | . ( break(sep) | rem ) . condvar 115 | * 116 | * 117 | 118 | 119 | 120 | * catab is the transfer vector for routing control to generators 121 | * for conditional assembly directives. 122 | * 123 | catab = table( 11,,.badop ) 124 | catab['.def'] = .defop; catab['.undef'] = .undefop 125 | catab['.if'] = .ifop; catab['.then'] = .thenop 126 | catab['.else'] = .elseop; catab['.fi'] = .fiop 127 | 128 | 129 | 130 | leq( substr( rdline,1,1 ),'.' ) :f(other) 131 | rdline ? p.condasm :s( $catab[condcmd] ) 132 | rl00 leq( substr( rdline,1,1 ),';' ) :f(rl01) 133 | -------------------------------------------------------------------------------- /osint/sysst.c: -------------------------------------------------------------------------------- 1 | /* 2 | Copyright 1987-2012 Robert B. K. Dewar and Mark Emmer. 3 | Copyright 2012-2013 David Shields 4 | 5 | This file is part of Macro SPITBOL. 6 | 7 | Macro SPITBOL is free software: you can redistribute it and/or modify 8 | it under the terms of the GNU General Public License as published by 9 | the Free Software Foundation, either version 2 of the License, or 10 | (at your option) any later version. 11 | 12 | Macro SPITBOL is distributed in the hope that it will be useful, 13 | but WITHOUT ANY WARRANTY; without even the implied warranty of 14 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 15 | GNU General Public License for more details. 16 | 17 | You should have received a copy of the GNU General Public License 18 | along with Macro SPITBOL. If not, see . 19 | */ 20 | 21 | 22 | /* 23 | / zysst - set file position 24 | / 25 | / Parameters: 26 | / WA - FCBLK pointer 27 | #if SETREAL 28 | / RA - 2nd argument (real number), offset 29 | #else 30 | / WB - 2nd argument (might require conversion), offset 31 | #endif 32 | / WC - 3rd argument (might require conversion), whence 33 | / Returns: 34 | #if SETREAL 35 | / RA - File position 36 | #else 37 | / IA - File position 38 | #endif 39 | / Exits: 40 | / 1 - invalid 2nd argument 41 | / 2 - invlaid 3rd argument 42 | / 3 - file does not exist 43 | / 4 - set not allowed 44 | / 5 - i/o error 45 | / 46 | / PC-SPITBOL option form of SET: 47 | / WB = 'P': 48 | / set position to WC 49 | / WB = 'H' 50 | / set position to WC * 32768 + (current_position mod 32768) 51 | / WB = 'R' 52 | / set position to current_position + WC 53 | / WB = 'E' 54 | / set position to end_of_file + WC 55 | / WB = 'C' 56 | / set record length to WC for byte-stream file 57 | / WB = 'D' 58 | / delete record -- not supported 59 | / 60 | */ 61 | 62 | #include "port.h" 63 | 64 | zysst() 65 | 66 | { 67 | long whence, temp; 68 | FILEPOS offset; 69 | register struct fcblk *fcb = WA (struct fcblk *); 70 | register struct ioblk *iob = ((struct ioblk *) (fcb->iob)); 71 | register struct icblk *icp; 72 | 73 | // ensure iob is open, fail if unsuccessful 74 | if ( !(iob->flg1 & IO_OPN) ) 75 | return EXIT_3; 76 | 77 | // not allowed to do a set of a pipe 78 | if ( iob->flg2 & IO_PIP ) 79 | return EXIT_4; 80 | 81 | // whence may come in either integer or string form 82 | icp = WC( struct icblk * ); 83 | if ( !getint(icp,&whence) ) 84 | return EXIT_1; 85 | 86 | #if SETREAL 87 | // offset comes in as a real in RA 88 | offset = RA(FILEPOS); 89 | #else 90 | // offset may come in either integer or string form 91 | icp = WB( struct icblk * ); 92 | if ( !getint(icp,&temp) ) { 93 | struct scblk *scp; 94 | scp = (struct scblk *)icp; 95 | if (!checkstr(scp) || scp->len != 1) 96 | return EXIT_1; 97 | temp = whence; 98 | switch (uppercase(scp->str[0])) { 99 | case 'P': 100 | whence = 0; 101 | break; 102 | 103 | case 'H': 104 | temp = (whence << 15) + ((int)doset(iob,0,1) & 0x7FFFL); 105 | whence = 0; 106 | break; 107 | 108 | case 'R': 109 | whence = 1; 110 | break; 111 | 112 | case 'E': 113 | whence = 2; 114 | break; 115 | 116 | case 'C': 117 | if ( fcb->mode == 0 && temp > 0 && temp <= (word)maxsize ) { 118 | fcb->rsz = temp; 119 | temp = 0; 120 | whence = 1; // return current position 121 | break; 122 | } 123 | else { 124 | if (temp < 0 || temp > (word)maxsize) 125 | return EXIT_2; 126 | else 127 | return EXIT_1; 128 | } 129 | 130 | default: 131 | return EXIT_1; // Unrecognised control 132 | } 133 | } 134 | offset = (FILEPOS)temp; 135 | #endif 136 | // finally, set the file position 137 | offset = doset( iob, offset, (int)whence ); 138 | 139 | // test for error. 01.02 140 | if ( offset < (FILEPOS)0 ) 141 | return EXIT_5; 142 | #if SETREAL 143 | // return resulting position in RA. 01.07 144 | SET_RA( offset ); 145 | #else 146 | // return resulting position in IA. 01.02 147 | SET_IA( (long)offset ); 148 | #endif 149 | 150 | // normal return 151 | return NORMAL_RETURN; 152 | } 153 | -------------------------------------------------------------------------------- /osint/sysem.c: -------------------------------------------------------------------------------- 1 | /* 2 | Copyright 1987-2012 Robert B. K. Dewar and Mark Emmer. 3 | Copyright 2012-2013 David Shields 4 | 5 | This file is part of Macro SPITBOL. 6 | 7 | Macro SPITBOL is free software: you can redistribute it and/or modify 8 | it under the terms of the GNU General Public License as published by 9 | the Free Software Foundation, either version 2 of the License, or 10 | (at your option) any later version. 11 | 12 | Macro SPITBOL is distributed in the hope that it will be useful, 13 | but WITHOUT ANY WARRANTY; without even the implied warranty of 14 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 15 | GNU General Public License for more details. 16 | 17 | You should have received a copy of the GNU General Public License 18 | along with Macro SPITBOL. If not, see . 19 | */ 20 | 21 | /* 22 | / File: SYSEM.C Version: 2.01 23 | / --------------------------------------- 24 | / 25 | / Contents: Function zysem 26 | */ 27 | 28 | /* 29 | / zysem - get error message text 30 | / 31 | / zysem returns the error message associated with an error number. 32 | / 33 | / An assembly language file, errors.s contains a compressed form 34 | / of the error messages. On the Macintosh, error messages are 35 | / in the resource fork of the application, uncompressed. This 36 | / allows the user to easily translate them into any language. 37 | / 38 | / Error messages are compressed into two character arrays. Segments 39 | / within these arrays are delineated by \0 characters. To find the 40 | / Nth segment, it is necessary to scan the array for the Nth \0. The 41 | / segment begins at the next character position. 42 | / 43 | / The first array, errors, contains 330 segments for the primary 44 | / error messages. Within a segment, there are ascii characters 45 | / in the range 32-127, which are taken verbatim, and character 46 | / values 1-31 and 128-255, which are special characters. 47 | / 48 | / The special characters are mapped into the range [1-159], where 49 | / they index segments in the second array, phrases. Segments within 50 | / phrases follow the same rules as those within arrays, and may 51 | / contain special characters themself. 52 | / 53 | / This expansion code is by necessity recursive. This code and 54 | / the data within errors.s were coded for minimum space, not speed, 55 | / since it is used infrequently. 56 | / 57 | / Parameters: 58 | / WA - error number 59 | / Returns: 60 | / XR - pointer to SCBLK containing error message (null string is ok) 61 | / Exits: 62 | / None 63 | */ 64 | 65 | #include "port.h" 66 | 67 | extern unsigned char ERRDIST errors[]; 68 | extern unsigned char ERRDIST phrases[]; 69 | word msgcopy (word n, unsigned char ERRDIST *source, char *dest ); 70 | word special (word c); 71 | 72 | zysem() 73 | { 74 | ptscblk->len = msgcopy( WA(word), errors, ptscblk->str ); 75 | SET_XR( ptscblk ); 76 | return NORMAL_RETURN; 77 | } 78 | 79 | /* 80 | / special(c) 81 | / 82 | / Return 0 if argument character is normal ascii. 83 | / Return index to phrase array if c is a special character. 84 | */ 85 | word special(c) 86 | word c; 87 | { 88 | if ( c == 0 ) 89 | return 0; 90 | if ( c < 32 ) 91 | return c; 92 | if ( c < 128 ) 93 | return 0; 94 | return (c - 96); 95 | } 96 | 97 | /* 98 | / msgcopy(n, source, dest) 99 | / 100 | / msgcopy() locates segment n in the source array, and copies its 101 | / characters to the destination array. If any special characters 102 | / are encountered, msgcopy() is called recursively to expand them. 103 | / 104 | / The function returns the number of characters copied. 105 | */ 106 | 107 | word msgcopy(n, source, dest ) 108 | word n; 109 | unsigned char ERRDIST *source; 110 | char *dest; 111 | { 112 | word k; 113 | unsigned char c; 114 | char *dstart; 115 | 116 | /* 117 | / Save starting destination pointer 118 | */ 119 | dstart = dest; 120 | 121 | /* 122 | / Scan to first character of Nth string 123 | */ 124 | for ( ; n--; ) 125 | { 126 | for ( ; *source++; ) 127 | ; 128 | } 129 | 130 | /* 131 | / Examine next character of string. 132 | / If it is a special character, recurse to unpack it 133 | / from phrases array. 134 | / If normal character, just copy it. 135 | */ 136 | for ( ; (c = *source++) != 0; ) 137 | { 138 | if ( (k = special(c)) != 0 ) 139 | dest += msgcopy( k, phrases, dest ); 140 | else 141 | *dest++ = c; 142 | } 143 | 144 | /* 145 | / Return number of characters transferred. 146 | */ 147 | return dest - dstart; 148 | } 149 | 150 | -------------------------------------------------------------------------------- /demos/atn.in: -------------------------------------------------------------------------------- 1 | ********************************** 2 | NETWORK PARSE_CLAUSE 3 | ********************************** 4 | S1 5 | IF PARSE_NOUN_GROUP(THIS_NODE) GOTO S2 6 | AFTER SETR('SUBJECT',LAST_PARSED) 7 | ENDIF 8 | END S1 9 | ********************************** 10 | S2 11 | IF PARSE_WORD(THIS_NODE,'VERB TENSED ') GOTO S3 12 | AFTER SETR('VERB',LAST_PARSED) 13 | ENDIF 14 | END S2 15 | ********************************** 16 | S3 17 | IF TESTF(LAST_PARSED,'BE ') 18 | PARSE_WORD(THIS_NODE,'PASTPARTICIPLE ') GOTO S4 19 | AFTER SETR('OBJECT',GETR('SUBJECT')) 20 | SETR('SUBJECT') 21 | SETR('VERB',LAST_PARSED) 22 | ENDIF 23 | IF TESTF(GETR('VERB'),'TRANSITIVE ') 24 | PARSE_NOUN_GROUP(THIS_NODE) GOTO S4 25 | AFTER SETR('OBJECT',LAST_PARSED) 26 | ENDIF 27 | IF TESTF(GETR('VERB'),'INTRANSITIVE ') GOTO S4 ENDIF 28 | IF ~NULL(GETR('OBJECT')) GOTO S4 ENDIF 29 | END S3 30 | ********************************** 31 | S4 32 | IF ~NULL(GETR('SUBJECT')) 33 | NULL(REMAINING_WORDS) GOTO WIN 34 | ENDIF 35 | IF NULL(GETR('SUBJECT')) 36 | IDENT(CURRENT_WORD,'BY') 37 | PARSE_WORD(THIS_NODE) GOTO S5 38 | ENDIF 39 | IF NULL(GETR('SUBJECT')) GOTO S4 40 | AFTER SETR('SUBJECT','SOMEONE') 41 | ENDIF 42 | END S4 43 | ********************************** 44 | S5 45 | IF PARSE_NOUN_GROUP(THIS_NODE) GOTO S4 46 | AFTER SETR('SUBJECT',LAST_PARSED) 47 | ENDIF 48 | END S5 49 | END PARSE_CLAUSE 50 | 51 | ********************************** 52 | NETWORK PARSE_NOUN_GROUP 53 | ********************************** 54 | S1 55 | IF PARSE_WORD(THIS_NODE,'DETERMINER ') GOTO S2 56 | AFTER SETR('NUMBER', 57 | SELECT('SINGULAR PLURAL ', 58 | GETF(LAST_PARSED))) 59 | SETR('DETERMINER', 60 | SELECT('DEFINITE INDEFINITE ', 61 | GETF(LAST_PARSED))) 62 | ENDIF 63 | END S1 64 | ********************************** 65 | S2 66 | IF PARSE_WORD(THIS_NODE,'ADJECTIVE ') GOTO S2 67 | AFTER ADDR('ADJECTIVES',LAST_PARSED) 68 | ENDIF 69 | IF PARSE_WORD(THIS_NODE,'NOUN ') GOTO WIN 70 | AFTER SETR('NUMBER', 71 | SELECT('SINGULAR PLURAL ', 72 | GETF(LAST_PARSED))) 73 | SETR('NOUN',LAST_PARSED) 74 | ENDIF 75 | END S2 76 | END PARSE_NOUN_GROUP 77 | 78 | ********************************** 79 | NETWORK PARSE_WORD 80 | S1 81 | IF NULL(null) GOTO WIN 82 | AFTER PARSE_WORD_1() 83 | ENDIF 84 | END S1 85 | END PARSE_WORD 86 | 87 | ********************************** 88 | FUNCTION PARSE_WORD_1 () () 89 | THIS_NODE = CURRENT_WORD ; 90 | REMAINING_WORDS BREAK(" ") SPAN(" ") = ; 91 | REMAINING_WORDS (BREAK(" ") | null) $ CURRENT_WORD :(RETURN) ; 92 | END PARSE_WORD_1 93 | 94 | ********************************** 95 | FUNCTION SETR (REGISTER,VALUE) () 96 | PUT(THIS_NODE,VALUE,REGISTER) :(RETURN) ; 97 | END SETR 98 | 99 | ********************************** 100 | FUNCTION GETR (REGISTER) () 101 | GETR = GET(THIS_NODE,REGISTER) :(RETURN) ; 102 | END GETR 103 | 104 | ********************************** 105 | FUNCTION ADDR (REGISTER,VALUE) () 106 | SETR(REGISTER,GETR(REGISTER) VALUE " ") :(RETURN) ; 107 | END ADDR 108 | 109 | ********************************** 110 | FUNCTION GENNAME (X) () 111 | GENNAME = 112 | '*' X '_' STATEMENTS(0) '*' 113 | :(RETURN) ; 114 | END GENNAME 115 | 116 | ********************************** 117 | FUNCTION ATTACH (C,P) () 118 | PUT(C,P,'PARENT') ; 119 | PUT(P,GET(P,'CHILDREN') C " ",'CHILDREN') 120 | :(RETURN) ; 121 | END ATTACH 122 | 123 | ********************************** 124 | FUNCTION SELECT (S,T) () 125 | S (BREAK(" ") $ SELECT) SPAN(" ") = :F(FRETURN) ; 126 | T (POS(0) | " ") SELECT " " 127 | :S(RETURN)F(SELECT) ; 128 | END SELECT 129 | 130 | ********************************** 131 | FUNCTION TESTF (X,F) (W,G) 132 | NULL(F) :S(RETURN) ; 133 | G = GETF(X) ; 134 | TESTF1 135 | F (BREAK(" ") $ W) SPAN(" ") = :F(RETURN) ; 136 | G (POS(0) | " ") W " " :S(TESTF)F(FRETURN) ; 137 | END TESTF 138 | 139 | ********************************** 140 | FUNCTION GETF (X) () 141 | GETF = LEXICAL_FEATURES :(RETURN) ; 142 | END GETF 143 | 144 | ********************************** 145 | LEXICON L1 146 | <* >NOUN >SINGULAR BLOCK BOY 147 | <* >DETERMINER >SINGULAR >INDEFINITE A 148 | DEFINITE THE 149 | <* >VERB >TENSED >TRANSITIVE >INTRANSITIVE >PASTPARTICIPLE DROPPED 150 | BE WAS 151 | <* >ADJECTIVE BIG RED 152 | <* >PREPOSITION BY 153 | <* 154 | END L1 155 | 156 | ********************************** 157 | SENTENCES S1 158 | A BIG RED BLOCK WAS DROPPED BY THE BOY ; 159 | THE BOY DROPPED A BIG RED BLOCK ; 160 | A BLOCK WAS DROPPED ; 161 | THE BLOCK DROPPED ; 162 | END S1 163 | 164 | ********************************** 165 | EXEC PARSE_CLAUSE("SENTENCE",null) 166 | 167 | -------------------------------------------------------------------------------- /osint/sysif.c: -------------------------------------------------------------------------------- 1 | /* 2 | Copyright 1987-2012 Robert B. K. Dewar and Mark Emmer. 3 | Copyright 2012-2013 David Shields 4 | 5 | This file is part of Macro SPITBOL. 6 | 7 | Macro SPITBOL is free software: you can redistribute it and/or modify 8 | it under the terms of the GNU General Public License as published by 9 | the Free Software Foundation, either version 2 of the License, or 10 | (at your option) any later version. 11 | 12 | Macro SPITBOL is distributed in the hope that it will be useful, 13 | but WITHOUT ANY WARRANTY; without even the implied warranty of 14 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 15 | GNU General Public License for more details. 16 | 17 | You should have received a copy of the GNU General Public License 18 | along with Macro SPITBOL. If not, see . 19 | */ 20 | 21 | 22 | /* 23 | / zysif - start/stop using include file 24 | / 25 | / zysif stacks the current input stream and opens a new include file. 26 | / It is also called when an EOF is read to restore the stacked file. 27 | / 28 | / Parameters: 29 | / XL pointer to SCBLK with name of file. 30 | / 0 to end use of file. 31 | / XR - pointer to vacant SCBLK that will receive the name of the 32 | / file finally opened, after looking in other directories. 33 | / Returns: 34 | / XR - scblk filled in with full path name and length. 35 | / Exits: 36 | / 1 - could not find file 37 | / 38 | */ 39 | 40 | #include "port.h" 41 | 42 | #include 43 | 44 | static void openprev (void); 45 | 46 | /* 47 | / Helper function to back up one file in the include nesting. 48 | */ 49 | 50 | static void openprev() 51 | { 52 | fd = inc_fd[--nesting]; // Unstack one level 53 | dup(fd); // Create fd 0 for previous file 54 | close(fd); // Release dup'ed fd of old file 55 | fd = 0; 56 | clrbuf(); 57 | 58 | doset( getrdiob(),inc_pos[nesting],0 ); // Position file where left off 59 | } 60 | 61 | zysif() 62 | { 63 | register struct scblk *fnscb = XL (struct scblk *); 64 | register struct scblk *pnscb = XR (struct scblk *); 65 | register char *savecp; 66 | char savechar, filebuf[256]; 67 | char *file; 68 | 69 | if (fnscb) { 70 | // Here to nest another include file 71 | if (nesting == INCLUDE_DEPTH) // Is there room in array? 72 | return EXIT_1; 73 | 74 | inc_pos[nesting] = doset(getrdiob(),0L,1); // Record current position 75 | inc_fd[nesting++] = dup(0); // Save current input file 76 | close(0); // Make fd 0 available 77 | clrbuf(); 78 | savecp = fnscb->str + fnscb->len; // Make it a C string for now. 79 | savechar = *savecp; 80 | *savecp = '\0'; 81 | file = fnscb->str; 82 | fd = spit_open( file, O_RDONLY, IO_PRIVATE | IO_DENY_WRITE, 83 | IO_OPEN_IF_EXISTS ); // Open file 84 | if (fd < 0) 85 | { 86 | // If couldn't open, try alternate paths via SNOLIB 87 | initpath(SPITFILEPATH); 88 | file = filebuf; 89 | while (trypath(fnscb->str,file)) 90 | { 91 | fd = spit_open(file, O_RDONLY, IO_PRIVATE | IO_DENY_WRITE, IO_OPEN_IF_EXISTS); 92 | if (fd >= 0) 93 | break; 94 | } 95 | } 96 | if (fd < 0) 97 | { 98 | // If still not open, look in directory where SPITBOL resides. 99 | int i = pathlast(gblargv[0]) - gblargv[0]; 100 | if (i) 101 | { 102 | mystrncpy(filebuf, gblargv[0], i); 103 | mystrcpy(&filebuf[i], fnscb->str); 104 | fd = spit_open(filebuf, O_RDONLY, IO_PRIVATE | IO_DENY_WRITE, IO_OPEN_IF_EXISTS); 105 | } 106 | } 107 | if (fd < 0 && sfn && sfn[0]) 108 | { 109 | // If still not open, look in directory where first source file resides. 110 | int i = pathlast(sfn) - sfn; 111 | if (i) 112 | { 113 | mystrncpy(filebuf, sfn, i); 114 | mystrcpy(&filebuf[i], fnscb->str); 115 | fd = spit_open(filebuf, O_RDONLY, IO_PRIVATE | IO_DENY_WRITE, IO_OPEN_IF_EXISTS); 116 | } 117 | } 118 | if ( fd >= 0 ) { // If file opened OK 119 | cpys2sc(file,pnscb,pnscb->len); 120 | *savecp = savechar; // Restore saved char 121 | } 122 | else { // Couldn't open file 123 | *savecp = savechar; // Restore saved char 124 | openprev(); // Restore input file we just closed 125 | return EXIT_1; // Fail 126 | } 127 | } 128 | /* 129 | / EOF read. Pop back one include file. 130 | */ 131 | else { 132 | if (nesting > 0) { // Make sure don't go too far 133 | close(fd); // Close last include file 134 | openprev(); // Reopen previous include file 135 | } 136 | } 137 | return NORMAL_RETURN; 138 | } 139 | -------------------------------------------------------------------------------- /test/pre.sbl: -------------------------------------------------------------------------------- 1 | * simple pre-processor for multi-line comments and conditional assembly. 2 | 3 | target = (differ(host(0)) host(0), 'unix_64_asm') 4 | target break('_') . os '_' break('_') . ws '_' rem . asm 5 | 6 | * defined tracks defined conditional symbols. (undefined symbols are assigned null values in defined.) 7 | 8 | defined = table( 11 ) 9 | 10 | defined[asm] = defined[os] = defined[ws] = 1 11 | defined['1'] = 1 12 | 13 | &anchor = &trim = 1 14 | &dump = 3 15 | 16 | 17 | * catab is the transfer vector for routing control to generators for conditional assembly directives. 18 | 19 | catab = table( 11,,.cond.bad ) 20 | catab['.def'] = .cond.def; catab['.undef'] = .cond.undef 21 | catab['.if'] = .cond.if; catab['.then'] = .cond.then 22 | catab['.else'] = .cond.else; catab['.fi'] = .cond.fi 23 | 24 | * stack maintains all state information while processing conditional statements. 25 | * level indexes the top entry. another variable, top, has a copy of savestk[level]. 26 | 27 | stack = array( 30 ) 28 | level = 0 29 | top = 30 | 31 | * each state entry in stack contains state information about the processing for each active .if. 32 | * the state is maintained as 2 fields: 33 | 34 | * result the result of the .if expression evaluation- true, false, or bypass 35 | * mode whether processing then or else portion of .if 36 | 37 | data( 'state(result,mode)' ) 38 | false = 0 39 | true = 1 40 | bypass = 2 41 | else = 0 42 | then = 1 43 | 44 | * processrec is indexed by the current result and mode to determine whether or not a statement should be processed 45 | * and written to the output file. 46 | 47 | processrec = array( false ':' bypass ',' else ':' then,0 ) 48 | processrec[true,then] = 1 49 | processrec[false,else] = 1 50 | 51 | * p.condasm breaks up conditional assembly directives. 52 | 53 | sep = ' ' 54 | 55 | p.condasm = ( break(sep) | rem ) . condcmd ( span(sep) | '' ) ( break(sep) | rem ) . condvar 56 | 57 | skip = 0 58 | :(next) 59 | copy 60 | output = line 61 | next 62 | line = input :f(finis) 63 | lines = lines + 1 64 | 65 | leq(substr(line,1,1),'.') :f(other) 66 | 67 | lt(size(line),2) :s(copy) 68 | lne(substr(line,1,1),'.') :s(other) 69 | 70 | * look for possible statement continuation lines beginning with '.' 71 | 72 | leq(substr(line,1,2),'. ') :s(copy) 73 | leq(substr(line,1,2),'.' char(9)) :s(copy) 74 | 75 | line ? p.condasm :s($catab[condcmd]) 76 | text 77 | 78 | * here to process text line. See if inside body of comment. 79 | 80 | differ(com) :s(com.inside) 81 | 82 | 83 | * look for extended comment, starts with line '/*' and ends with '*/'. 84 | * here when in normal text, looking for extended comment 85 | 86 | line '/*' = :f(copy) 87 | com = 1 :(copy) 88 | 89 | com.inside 90 | 91 | * here if inside extended comment, look for closing line 92 | line '*/' = :f(com.fix) 93 | 94 | com = :(copy) 95 | 96 | com.fix 97 | 98 | * here to insert comment character at start of line in extended comment body 99 | line = comment_char line :(copy) 100 | 101 | other 102 | eq(level) :s(text) 103 | eq(processrec[result(top),mode(top)]) :s(next)f(text) 104 | 105 | * process define 106 | 107 | cond.def 108 | ident( condvar ) :s(cond.err) 109 | ne(level) eq(processrec[result(top),mode(top)] ) :s(next) 110 | defined[condvar] = 1 111 | comment_char = ident(condvar,'comment_asterisk') '*' 112 | comment_char = ident(condvar,'comment_semicolon') ';' 113 | comment_char = ident(condvar,'comment_number') '#' 114 | :(next) 115 | 116 | * process undefine 117 | 118 | cond.undef 119 | ident(condvar) :s(cond.err) 120 | ne(level) eq(processrec[result(top),mode(top)]) :s(next) 121 | defined[condvar] = :(next) 122 | 123 | * process if 124 | cond.if 125 | ident( condvar ) :s(cond.err) 126 | eq( level ) :s(ifok) 127 | 128 | * here for .if encountered during bypass state. 129 | 130 | ne(processrec[result(top),mode(top)]) :s(ifok) 131 | level = level + 1 132 | top = stack[level] = state(bypass,then) :(next) 133 | ifok 134 | level = level + 1 135 | top = stack[level] = state(( differ( defined[condvar] ) true,false ), then) :(next) 136 | 137 | * process .then 138 | cond.then 139 | differ(condvar) :s(cond.err) 140 | eq(level) :s(cond.err)f(next) 141 | 142 | * process .else 143 | cond.else 144 | differ(condvar) :s(cond.err) 145 | mode(top) = ne(level) else :s(next)f(err) 146 | 147 | * process .fi 148 | cond.fi 149 | differ(condvar) :s(cond.err) 150 | level = ne(level) level - 1 :f(cond.err) 151 | top = (ne(level) stack[level],'') :(next) 152 | 153 | cond.bad 154 | &dump = 3 155 | output = ' bad condcmd:' cndcmd ':' line ':' :(finis) 156 | cond.err 157 | &dump = 3 158 | terminal = 'unknown conditional assembly command' 159 | terminal = 'line:' line :(finis) 160 | err 161 | &dump = 3 162 | terminal = 'error, line: ' line 163 | :(finis) 164 | finis 165 | &dump = 0 166 | end 167 | -------------------------------------------------------------------------------- /osint/doset.c: -------------------------------------------------------------------------------- 1 | /* 2 | Copyright 1987-2012 Robert B. K. Dewar and Mark Emmer. 3 | Copyright 2012-2013 David Shields 4 | 5 | This file is part of Macro SPITBOL. 6 | 7 | Macro SPITBOL is free software: you can redistribute it and/or modify 8 | it under the terms of the GNU General Public License as published by 9 | the Free Software Foundation, either version 2 of the License, or 10 | (at your option) any later version. 11 | 12 | Macro SPITBOL is distributed in the hope that it will be useful, 13 | but WITHOUT ANY WARRANTY; without even the implied warranty of 14 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 15 | GNU General Public License for more details. 16 | 17 | You should have received a copy of the GNU General Public License 18 | along with Macro SPITBOL. If not, see . 19 | */ 20 | 21 | /* 22 | / File: DOSET.C Version: 01.04 23 | / --------------------------------------- 24 | / 25 | / Contents: Function doset 26 | */ 27 | 28 | /* 29 | / doset( ioptr, offset, whence ) 30 | / 31 | / doset() does an "LSEEK" function call on the file described by ioptr. 32 | / For output files, the buffer must be flushed before doing the LSEEK. 33 | / For input file, any "unread" characters in the buffer must be seeked 34 | / over as well. 35 | / 36 | / Parameters: 37 | / ioptr pointer to IOBLK describing file 38 | / offset offset for LSEEK call 39 | / whence type of LSEEK to perform 40 | / Returns: 41 | / Value returned by LSEEK (-1 if error). 42 | / 43 | */ 44 | 45 | #include "port.h" 46 | 47 | 48 | #if SETREAL 49 | #include // for floor() 50 | #endif 51 | 52 | FILEPOS doset( ioptr, offset, whence ) 53 | 54 | struct ioblk *ioptr; 55 | FILEPOS offset; 56 | int whence; 57 | 58 | { 59 | register struct bfblk *bfptr = ((struct bfblk *) (ioptr->bfb)); 60 | FILEPOS target, newoffset; 61 | 62 | if (ioptr->flg2 & IO_PIP) 63 | return -1L; 64 | 65 | 66 | switch (whence) { 67 | case 0: // absolute position 68 | target = offset; 69 | break; 70 | case 1: // relative to current position 71 | target = offset + 72 | (bfptr ? bfptr->offset + bfptr->next : LSEEK(ioptr->fdn, (FILEPOS)0, 1)); 73 | break; 74 | case 2: // relative to EOF 75 | target = offset + geteof(ioptr); 76 | break; 77 | default: 78 | return -1; 79 | } 80 | 81 | if (target < (FILEPOS)0) 82 | target = (FILEPOS)0; 83 | 84 | if (bfptr) { 85 | /* 86 | * see if target is within the present buffer 87 | */ 88 | if (bfptr->offset <= target && 89 | target <= bfptr->offset + bfptr->fill) { 90 | bfptr->next = (word)(target - bfptr->offset); 91 | return target; 92 | } 93 | 94 | /* 95 | / Flush any dirty buffer before doing LSEEK. 96 | */ 97 | if (flush(ioptr)) 98 | return -1; // return if error 99 | 100 | /* 101 | / Seek to a position that is a multiple of the buffer size. 102 | */ 103 | #if SETREAL 104 | newoffset = floor(target / bfptr->size) * bfptr->size; 105 | #else 106 | newoffset = (target / bfptr->size) * bfptr->size; 107 | #endif 108 | if (newoffset != bfptr->curpos) 109 | { 110 | // physical file position differs from desired new offset 111 | FILEPOS newcurrent; 112 | newcurrent = LSEEK(ioptr->fdn, newoffset, 0); 113 | if (newcurrent < (FILEPOS)0) 114 | return -1; 115 | bfptr->offset = bfptr->curpos = newcurrent; 116 | } 117 | else 118 | { 119 | // file is properly positined already 120 | bfptr->offset = newoffset; 121 | } 122 | 123 | /* 124 | / Now fill the buffer and position the next pointer carefully. 125 | */ 126 | if (testty(ioptr->fdn) && fillbuf(ioptr) < 0) 127 | return -1; 128 | 129 | bfptr->next = (word)(target - bfptr->offset); 130 | if (bfptr->next > bfptr->fill) { // if extending beyond EOF 131 | if (ioptr->flg1 & IO_OUP) 132 | bfptr->fill = bfptr->next; // only allow if output file 133 | else 134 | bfptr->next = bfptr->fill; // otherwise, limit to true EOF 135 | } 136 | 137 | return bfptr->offset + bfptr->next; 138 | } 139 | else 140 | return LSEEK(ioptr->fdn, target, 0); // unbuffered I/O 141 | } 142 | 143 | FILEPOS geteof(ioptr) 144 | struct ioblk *ioptr; 145 | { 146 | register struct bfblk *bfptr = ((struct bfblk *) (ioptr->bfb)); 147 | FILEPOS eofpos, curpos; 148 | 149 | if (!bfptr) // if unbuffered file 150 | curpos = LSEEK(ioptr->fdn, (FILEPOS)0, 1); // record current position 151 | 152 | eofpos = LSEEK(ioptr->fdn, (FILEPOS)0, 2); // get eof position 153 | 154 | if (bfptr) { 155 | bfptr->curpos = eofpos; // buffered - record position 156 | if (bfptr->offset + bfptr->fill > eofpos) // if buffer extended 157 | eofpos = bfptr->offset + bfptr->fill; // beyond physical file 158 | } 159 | else 160 | LSEEK(ioptr->fdn, curpos, 0); // unbuffered - restore position 161 | 162 | 163 | return eofpos; 164 | } 165 | -------------------------------------------------------------------------------- /osint/swcoup.c: -------------------------------------------------------------------------------- 1 | /* 2 | Copyright 1987-2012 Robert B. K. Dewar and Mark Emmer. 3 | Copyright 2012-2013 David Shields 4 | 5 | This file is part of Macro SPITBOL. 6 | 7 | Macro SPITBOL is free software: you can redistribute it and/or modify 8 | it under the terms of the GNU General Public License as published by 9 | the Free Software Foundation, either version 2 of the License, or 10 | (at your option) any later version. 11 | 12 | Macro SPITBOL is distributed in the hope that it will be useful, 13 | but WITHOUT ANY WARRANTY; without even the implied warranty of 14 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 15 | GNU General Public License for more details. 16 | 17 | You should have received a copy of the GNU General Public License 18 | along with Macro SPITBOL. If not, see . 19 | */ 20 | 21 | 22 | #include "port.h" 23 | 24 | #include 25 | 26 | /* 27 | / swcoup( oupptr ) 28 | / 29 | / swcoup() switches between two output files: the standard output file 30 | / provided by the shell and the optional output file provided by the 31 | / -o option on the command line. 32 | / 33 | / This switching is necessary so that we blend into the Un*x environment 34 | / like other programs. To this end output is routed to the appropriate 35 | / output file: 36 | / 37 | / program listing, compilation statisitics, execution statistics, 38 | / and dump of variables at termination go to the -o file, if 39 | / specified. 40 | / 41 | / standard output produced by the executing program goes to the 42 | / standard output file provided by the shell. 43 | / 44 | / This routing insures that the ONLY standard output produced by the 45 | / "spitbol" command is that generated by the spitbol program being 46 | / executed! Thus, spitbol can be used as a filter. 47 | / 48 | / 49 | / There are three calls to swcoup() as described by this sequence of events 50 | / 51 | / spitbol initialization 52 | / 0->swcoup() called prior to compilation 53 | / compilation (with output routed to -o file) 54 | / 1->swcoup() called after compilation and prior to execution 55 | / (with output routed to shell's standard output) 56 | / 2->swcoup() called after execution 57 | / post mortem activities (with output routed to -o file) 58 | / 59 | / 60 | / A filename consisting of a single hyphen '-' represents file 61 | / descriptor 1 provided by the shell. 62 | / 63 | / Parameters: 64 | / oupptr pointer to -o option argument from command line 65 | / Returns: 66 | / 0 if switch successful / -1 if switch failed 67 | */ 68 | 69 | int swcoup( oupptr ) 70 | char *oupptr; 71 | 72 | { 73 | int retval = 0; 74 | 75 | /* 76 | / No switch necessary if no -o option or previous errors encountered. 77 | */ 78 | char namebuf[256]; 79 | 80 | if (errflag) 81 | return 0; 82 | 83 | // if no output file specified, but listing requested, use input name 84 | if ( oupptr == 0) 85 | { 86 | if (((spitflag & NOLIST) == 0) && (**inpptr)) 87 | { 88 | appendext(*inpptr, LISTEXT, namebuf, 1); 89 | oupptr = namebuf; 90 | } 91 | else 92 | goto swcexit; 93 | } 94 | 95 | /* 96 | / If -o file name is '-' then continue to write file 97 | / descriptor 1 provided by the shell. 98 | */ 99 | if ( *oupptr == '-' && *(oupptr + 1) == '\0') 100 | goto swcexit; 101 | 102 | /* 103 | / Do output file switch based on current state: 104 | */ 105 | switch ( oupState++ ) 106 | { 107 | 108 | /* 109 | / State 0 (1st call to swcoup): standard output -> -o file 110 | */ 111 | case 0: 112 | origoup = dup( 1 ); // save std output 113 | close( 1 ); // close std output 114 | if (appendext(oupptr, LISTEXT, namebuf, 0)) // Append .lst if needed 115 | oupptr = namebuf; 116 | if ( (spit_open( oupptr, O_WRONLY|O_CREAT|O_TRUNC, 117 | IO_PRIVATE | IO_DENY_READWRITE /* 0666 */, 118 | IO_REPLACE_IF_EXISTS | IO_CREATE_IF_NOT_EXIST )) < 0 ) // create -o file 119 | { 120 | wrterr( "-o file open error." ); 121 | ++errflag; 122 | dup( origoup ); 123 | close( origoup ); 124 | retval = -1; 125 | } 126 | break; 127 | 128 | /* 129 | / State 1 (2nd call to swcoup): standard output -> shell output file 130 | */ 131 | case 1: 132 | close( 1 ); // close -o file 133 | dup( origoup ); // restore std output 134 | close( origoup ); // close its duplicate 135 | break; 136 | 137 | /* 138 | / State 2 (3rd call to swcoup): standard output -> -o file 139 | */ 140 | case 2: 141 | close( 1 ); // close std output 142 | if (appendext(oupptr, LISTEXT, namebuf, 0)) // Append .lst if needed 143 | oupptr = namebuf; 144 | if ( (spit_open( oupptr,O_WRONLY, 145 | IO_PRIVATE | IO_DENY_READWRITE /* 0666 */, 146 | IO_OPEN_IF_EXISTS )) < 0 ) // reopen -o file 147 | { 148 | wrterr( "error reopening" ); 149 | } 150 | oupeof(); // seek to EOF on -o file 151 | break; 152 | 153 | default: 154 | wrterr( "Internal system error--SWCOUP" ); 155 | 156 | } 157 | 158 | swcexit: 159 | return retval; 160 | } 161 | --------------------------------------------------------------------------------