├── script ├── apl.opt2b ├── aplrc.opt5b ├── apl-setup.opt3b ├── apl-setup.opt4b ├── apl.opt1b ├── apl.opt1a ├── apl-setup.opt3a ├── aplrc.opt5a ├── aplrc.in ├── apl-setup.opt4a └── apl.opt2a ├── apl11 ├── include │ ├── patchlevel.h │ ├── char.h │ ├── config.h.in │ ├── makefile.common.in │ ├── quad_func.h │ ├── mixed_monadic.h │ ├── memory.h │ ├── oper_dyadic.h │ ├── print.h │ ├── mixed_dyadic.h │ ├── main.h │ ├── parser.h │ ├── quad_var.h │ ├── debug.h │ ├── work_space.h │ ├── execute.h │ ├── userfunc.h │ ├── utility.h │ ├── data.h │ └── format.h ├── userfunc │ ├── ex_br0.c │ ├── sichk.c │ ├── ex_nilret.c │ ├── ex_br.c │ ├── ex_auto.c │ ├── ex_label.c │ ├── Makefile │ ├── ex_arg1.c │ ├── funread.c │ ├── ex_ibr.c │ ├── csize.c │ ├── tback.c │ └── ex_arg2.c ├── parser │ ├── yyerror.c │ ├── alpha.c │ ├── alpha.h │ ├── digit.c │ ├── name.c │ ├── invert.c │ ├── getquad.c │ ├── Makefile │ ├── genlab.c │ ├── lastcode.c │ ├── table_comm.c │ ├── table_quad.c │ ├── local_parser.h │ ├── compile_new.c │ └── compile_old.c ├── Docs │ └── global_replace ├── data │ ├── nlook.c │ ├── access.c │ ├── size.c │ ├── bidx.c │ ├── s2vect.c │ ├── dupdat.c │ ├── top.c │ ├── colapse.c │ ├── purge_name.c │ ├── copy.c │ ├── putdat.c │ ├── Makefile │ ├── getdata.c │ ├── erase.c │ └── pop.c ├── scalar_dyadic │ ├── ex_minus.c │ ├── ex_plus.c │ ├── ex_mul.c │ ├── ex_max.c │ ├── ex_min.c │ ├── ex_or.c │ ├── ex_and.c │ ├── ex_nand.c │ ├── ex_nor.c │ ├── ex_eq.c │ ├── ex_ge.c │ ├── ex_gt.c │ ├── ex_le.c │ ├── ex_lt.c │ ├── ex_ne.c │ ├── ex_sub.c │ ├── ex_add.c │ ├── ex_div.c │ ├── ex_log.c │ ├── Makefile │ ├── ex_comb.c │ ├── ex_mod.c │ └── ex_pwr.c ├── execute │ ├── ex_botch.c │ ├── Makefile │ └── ex_dscal.c ├── scalar_monadic │ ├── ex_pi.c │ ├── ex_abs.c │ ├── ex_not.c │ ├── ex_ceil.c │ ├── ex_floor.c │ ├── ex_sgn.c │ ├── ex_recip.c │ ├── Makefile │ ├── ex_exp.c │ ├── ex_loge.c │ └── ex_fac.c ├── print │ ├── ex_hprint.c │ ├── Makefile │ ├── ex_print.c │ ├── c_overbar.c │ ├── local_print.h │ ├── print.c │ ├── DESIGN │ └── lt_print.c ├── utility │ ├── fix.c │ ├── checksp.c │ ├── scalar.c │ ├── iodone.c │ ├── Makefile │ ├── topfix.c │ ├── extend.c │ ├── fuzz.c │ ├── map.c │ ├── floating.c │ ├── fappend.c │ └── file.c ├── quad_func │ ├── ex_exit.c │ ├── ex_dup.c │ ├── ex_close.c │ ├── ex_chdir.c │ ├── ex_unlink.c │ ├── ex_open.c │ ├── ex_create.c │ ├── ex_fork.c │ ├── ex_kill.c │ ├── iofname.c │ ├── ex_pipe.c │ ├── ex_ap.c │ ├── ex_signl.c │ ├── ex_wait.c │ ├── ex_write.c │ ├── ex_seek.c │ ├── ex_run.c │ ├── Makefile │ ├── eval_qlx.c │ ├── ex_read.c │ ├── ex_rd.c │ ├── ex_float.c │ ├── ex_nc.c │ ├── ex_ex.c │ └── ex_exec.c ├── ibeam │ ├── Makefile │ └── ex_dibm.c ├── mixed_monadic │ ├── ex_menc.c │ ├── Makefile │ ├── ex_rand.c │ ├── gd.h │ ├── ex_rev.c │ ├── ex_mdom.c │ ├── ex_gdd.c │ ├── ex_gdu.c │ └── gd.c ├── struct_monadic │ ├── Makefile │ ├── ex_mrho.c │ ├── ex_miot.c │ └── ex_rav.c ├── work_space │ ├── Makefile │ ├── fdat.h │ ├── ws_clear.c │ └── fdat.c ├── debug │ ├── memory.h │ ├── Makefile │ ├── parsedump.c │ ├── mem_dump.c │ └── vars_dump.c ├── memory │ ├── Makefile │ ├── afreset.c │ ├── DESIGN │ ├── aplfree.c │ └── alloc.c ├── struct_dyadic │ └── Makefile ├── oper_dyadic │ ├── Makefile │ └── ex_oprod.c ├── oper_monadic │ └── Makefile ├── main │ ├── Makefile │ ├── history.h │ ├── ascii_input.h │ ├── exit.c │ └── history.c ├── sys_command │ ├── ex_list.h │ ├── ex_prws.h │ ├── listdir.h │ ├── ex_shell.h │ ├── Makefile │ ├── ex_shell.c │ ├── listdir.c │ ├── ex_list.c │ └── ex_prws.c ├── format │ ├── Makefile │ ├── ex_mfmt.c │ └── ex_dfmt.c ├── mixed_dyadic │ ├── Makefile │ ├── ex_diot.c │ ├── ex_eps.c │ ├── ex_rep.c │ ├── ex_deal.c │ └── ex_base.c └── quad_var │ ├── Makefile │ ├── ex_qav.c │ ├── ex_qai.c │ ├── ex_qct.c │ ├── ex_qpw.c │ ├── ex_qio.c │ ├── ex_qpp.c │ ├── ex_qts.c │ └── ex_qlx.c ├── qa ├── quad_fns.dat ├── clean_dir │ ├── onearg │ ├── twoargs │ ├── withret1 │ ├── nilret1 │ ├── lemming │ ├── ulam.ws │ ├── makeN.ws │ └── exp ├── ulam.ws ├── debug.inp ├── debug.ref ├── makeN.ws ├── trig.inp ├── trig.ref ├── errors.inp ├── errors.ref ├── format.inp ├── format.ref ├── ibeams.inp ├── ibeams.ref ├── mixed_monadic.ainp ├── nesting.inp ├── nesting.ref ├── nesting.ws ├── printing.inp ├── printing.ref ├── quad_fns.inp ├── quad_fns.ref ├── quad_fx.aref ├── userfunc.inp ├── userfunc.ref ├── userfunc.ws ├── quad_vars.inp ├── quad_vars.ref ├── mixed_dyadic.aref ├── mixed_dyadic.inp ├── mixed_dyadic.ref ├── mixed_monadic.inp ├── mixed_monadic.ref ├── quad_fx.ainp ├── scalar_dyadic.inp ├── scalar_dyadic.ref ├── struct_dyadic.inp ├── struct_dyadic.ref ├── sys_commands.inp ├── sys_commands.ref ├── mixed_monadic.aref ├── scalar_monadic.inp ├── scalar_monadic.ref ├── struct_dyadic.aref ├── struct_monadic.aref ├── struct_monadic.inp ├── struct_monadic.ref ├── userfunc_nilret1.aref ├── userfunc_onearg1.aref ├── userfunc_twoargs1.aref ├── userfunc_withret1.aref ├── userfunc_nilret1.ainp ├── userfunc_onearg1.ainp ├── userfunc_twoargs1.ainp ├── userfunc_withret1.ainp ├── mixed_dyadic.ainp ├── struct_dyadic.ainp └── struct_monadic.ainp ├── library └── continue ├── terminal ├── 000-255 ├── 000-255.txt ├── linux-ppc │ ├── README │ ├── fonts │ │ └── apl8x16.psf │ └── keymap │ │ └── apl2741.map ├── XFree86 │ ├── fonts │ │ ├── apl8x13.pcf │ │ ├── aplox.108.pcf │ │ ├── aplox.150.pcf │ │ ├── aplox.216.pcf │ │ └── aplox.300.pcf │ └── keymap │ │ ├── modeswitch.xmap │ │ └── Design.Notes ├── linux-i386 │ ├── fonts │ │ ├── apl8x16.psf │ │ └── Design.Notes │ └── keymap │ │ └── apl2741.map ├── XFree86-ppc │ └── keymap │ │ ├── apl2741.xmap │ │ └── modeswitch.xmap └── SunOS │ └── keymap │ └── apl2741.xmap ├── docs ├── user_guide │ ├── IBeams │ ├── Printing │ ├── QuadFunc │ ├── QuadVar │ ├── README │ ├── Readline │ ├── WorkSpaces │ └── SandBox ├── project │ ├── openapl.lsm │ └── ToDo ├── install_guide │ └── pagers └── Copyright ├── .gitignore ├── printer ├── DESIGN ├── apl2gs.in └── apl2epson.in ├── configure └── man └── apl2gs.1 /script/apl.opt2b: -------------------------------------------------------------------------------- 1 | -------------------------------------------------------------------------------- /script/aplrc.opt5b: -------------------------------------------------------------------------------- 1 | -------------------------------------------------------------------------------- /script/apl-setup.opt3b: -------------------------------------------------------------------------------- 1 | -------------------------------------------------------------------------------- /script/apl-setup.opt4b: -------------------------------------------------------------------------------- 1 | -------------------------------------------------------------------------------- /apl11/include/patchlevel.h: -------------------------------------------------------------------------------- 1 | ".15" 2 | -------------------------------------------------------------------------------- /qa/quad_fns.dat: -------------------------------------------------------------------------------- 1 | 1234.5 2 | abcdef 3 | -------------------------------------------------------------------------------- /script/apl.opt1b: -------------------------------------------------------------------------------- 1 | interface="X11" 2 | -------------------------------------------------------------------------------- /qa/clean_dir/onearg: -------------------------------------------------------------------------------- 1 | G z { onearg x 2 | z { x * x 3 | -------------------------------------------------------------------------------- /qa/clean_dir/twoargs: -------------------------------------------------------------------------------- 1 | G z { n twoargs x 2 | z { n * x 3 | -------------------------------------------------------------------------------- /qa/clean_dir/withret1: -------------------------------------------------------------------------------- 1 | G z { withret1 2 | z { 10 3 | z { z % 100 4 | -------------------------------------------------------------------------------- /qa/ulam.ws: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/PlanetAPL/openAPL/HEAD/qa/ulam.ws -------------------------------------------------------------------------------- /qa/debug.inp: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/PlanetAPL/openAPL/HEAD/qa/debug.inp -------------------------------------------------------------------------------- /qa/debug.ref: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/PlanetAPL/openAPL/HEAD/qa/debug.ref -------------------------------------------------------------------------------- /qa/makeN.ws: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/PlanetAPL/openAPL/HEAD/qa/makeN.ws -------------------------------------------------------------------------------- /qa/trig.inp: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/PlanetAPL/openAPL/HEAD/qa/trig.inp -------------------------------------------------------------------------------- /qa/trig.ref: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/PlanetAPL/openAPL/HEAD/qa/trig.ref -------------------------------------------------------------------------------- /qa/errors.inp: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/PlanetAPL/openAPL/HEAD/qa/errors.inp -------------------------------------------------------------------------------- /qa/errors.ref: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/PlanetAPL/openAPL/HEAD/qa/errors.ref -------------------------------------------------------------------------------- /qa/format.inp: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/PlanetAPL/openAPL/HEAD/qa/format.inp -------------------------------------------------------------------------------- /qa/format.ref: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/PlanetAPL/openAPL/HEAD/qa/format.ref -------------------------------------------------------------------------------- /qa/ibeams.inp: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/PlanetAPL/openAPL/HEAD/qa/ibeams.inp -------------------------------------------------------------------------------- /qa/ibeams.ref: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/PlanetAPL/openAPL/HEAD/qa/ibeams.ref -------------------------------------------------------------------------------- /qa/mixed_monadic.ainp: -------------------------------------------------------------------------------- 1 | pi { 3 1 4 1 5 9 2 6 2 | pi[ H@| pi] 3 | pi[ G@| pi ] 4 | -------------------------------------------------------------------------------- /qa/nesting.inp: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/PlanetAPL/openAPL/HEAD/qa/nesting.inp -------------------------------------------------------------------------------- /qa/nesting.ref: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/PlanetAPL/openAPL/HEAD/qa/nesting.ref -------------------------------------------------------------------------------- /qa/nesting.ws: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/PlanetAPL/openAPL/HEAD/qa/nesting.ws -------------------------------------------------------------------------------- /qa/printing.inp: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/PlanetAPL/openAPL/HEAD/qa/printing.inp -------------------------------------------------------------------------------- /qa/printing.ref: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/PlanetAPL/openAPL/HEAD/qa/printing.ref -------------------------------------------------------------------------------- /qa/quad_fns.inp: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/PlanetAPL/openAPL/HEAD/qa/quad_fns.inp -------------------------------------------------------------------------------- /qa/quad_fns.ref: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/PlanetAPL/openAPL/HEAD/qa/quad_fns.ref -------------------------------------------------------------------------------- /qa/quad_fx.aref: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/PlanetAPL/openAPL/HEAD/qa/quad_fx.aref -------------------------------------------------------------------------------- /qa/userfunc.inp: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/PlanetAPL/openAPL/HEAD/qa/userfunc.inp -------------------------------------------------------------------------------- /qa/userfunc.ref: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/PlanetAPL/openAPL/HEAD/qa/userfunc.ref -------------------------------------------------------------------------------- /qa/userfunc.ws: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/PlanetAPL/openAPL/HEAD/qa/userfunc.ws -------------------------------------------------------------------------------- /library/continue: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/PlanetAPL/openAPL/HEAD/library/continue -------------------------------------------------------------------------------- /qa/clean_dir/nilret1: -------------------------------------------------------------------------------- 1 | G nilret1; lcl1 2 | l1: lcl1 { 47 3 | l2: a { 10 4 | l3: a % 10 5 | -------------------------------------------------------------------------------- /qa/quad_vars.inp: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/PlanetAPL/openAPL/HEAD/qa/quad_vars.inp -------------------------------------------------------------------------------- /qa/quad_vars.ref: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/PlanetAPL/openAPL/HEAD/qa/quad_vars.ref -------------------------------------------------------------------------------- /terminal/000-255: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/PlanetAPL/openAPL/HEAD/terminal/000-255 -------------------------------------------------------------------------------- /apl11/include/char.h: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/PlanetAPL/openAPL/HEAD/apl11/include/char.h -------------------------------------------------------------------------------- /qa/clean_dir/lemming: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/PlanetAPL/openAPL/HEAD/qa/clean_dir/lemming -------------------------------------------------------------------------------- /qa/clean_dir/ulam.ws: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/PlanetAPL/openAPL/HEAD/qa/clean_dir/ulam.ws -------------------------------------------------------------------------------- /qa/mixed_dyadic.aref: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/PlanetAPL/openAPL/HEAD/qa/mixed_dyadic.aref -------------------------------------------------------------------------------- /qa/mixed_dyadic.inp: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/PlanetAPL/openAPL/HEAD/qa/mixed_dyadic.inp -------------------------------------------------------------------------------- /qa/mixed_dyadic.ref: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/PlanetAPL/openAPL/HEAD/qa/mixed_dyadic.ref -------------------------------------------------------------------------------- /qa/mixed_monadic.inp: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/PlanetAPL/openAPL/HEAD/qa/mixed_monadic.inp -------------------------------------------------------------------------------- /qa/mixed_monadic.ref: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/PlanetAPL/openAPL/HEAD/qa/mixed_monadic.ref -------------------------------------------------------------------------------- /qa/quad_fx.ainp: -------------------------------------------------------------------------------- 1 | fn { 1 10R'G z { sq n' 2 | fn { fn,[1] 10Y'z { n*2' 3 | Lfx fn 4 | sq 4 5 | -------------------------------------------------------------------------------- /qa/scalar_dyadic.inp: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/PlanetAPL/openAPL/HEAD/qa/scalar_dyadic.inp -------------------------------------------------------------------------------- /qa/scalar_dyadic.ref: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/PlanetAPL/openAPL/HEAD/qa/scalar_dyadic.ref -------------------------------------------------------------------------------- /qa/struct_dyadic.inp: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/PlanetAPL/openAPL/HEAD/qa/struct_dyadic.inp -------------------------------------------------------------------------------- /qa/struct_dyadic.ref: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/PlanetAPL/openAPL/HEAD/qa/struct_dyadic.ref -------------------------------------------------------------------------------- /qa/sys_commands.inp: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/PlanetAPL/openAPL/HEAD/qa/sys_commands.inp -------------------------------------------------------------------------------- /qa/sys_commands.ref: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/PlanetAPL/openAPL/HEAD/qa/sys_commands.ref -------------------------------------------------------------------------------- /terminal/000-255.txt: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/PlanetAPL/openAPL/HEAD/terminal/000-255.txt -------------------------------------------------------------------------------- /apl11/include/config.h.in: -------------------------------------------------------------------------------- 1 | 2 | /* Define if you have readline */ 3 | #undef HAVE_LIBREADLINE 4 | -------------------------------------------------------------------------------- /docs/user_guide/IBeams: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/PlanetAPL/openAPL/HEAD/docs/user_guide/IBeams -------------------------------------------------------------------------------- /qa/clean_dir/makeN.ws: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/PlanetAPL/openAPL/HEAD/qa/clean_dir/makeN.ws -------------------------------------------------------------------------------- /qa/mixed_monadic.aref: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/PlanetAPL/openAPL/HEAD/qa/mixed_monadic.aref -------------------------------------------------------------------------------- /qa/scalar_monadic.inp: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/PlanetAPL/openAPL/HEAD/qa/scalar_monadic.inp -------------------------------------------------------------------------------- /qa/scalar_monadic.ref: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/PlanetAPL/openAPL/HEAD/qa/scalar_monadic.ref -------------------------------------------------------------------------------- /qa/struct_dyadic.aref: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/PlanetAPL/openAPL/HEAD/qa/struct_dyadic.aref -------------------------------------------------------------------------------- /qa/struct_monadic.aref: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/PlanetAPL/openAPL/HEAD/qa/struct_monadic.aref -------------------------------------------------------------------------------- /qa/struct_monadic.inp: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/PlanetAPL/openAPL/HEAD/qa/struct_monadic.inp -------------------------------------------------------------------------------- /qa/struct_monadic.ref: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/PlanetAPL/openAPL/HEAD/qa/struct_monadic.ref -------------------------------------------------------------------------------- /docs/user_guide/Printing: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/PlanetAPL/openAPL/HEAD/docs/user_guide/Printing -------------------------------------------------------------------------------- /docs/user_guide/QuadFunc: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/PlanetAPL/openAPL/HEAD/docs/user_guide/QuadFunc -------------------------------------------------------------------------------- /docs/user_guide/QuadVar: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/PlanetAPL/openAPL/HEAD/docs/user_guide/QuadVar -------------------------------------------------------------------------------- /qa/userfunc_nilret1.aref: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/PlanetAPL/openAPL/HEAD/qa/userfunc_nilret1.aref -------------------------------------------------------------------------------- /qa/userfunc_onearg1.aref: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/PlanetAPL/openAPL/HEAD/qa/userfunc_onearg1.aref -------------------------------------------------------------------------------- /qa/userfunc_twoargs1.aref: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/PlanetAPL/openAPL/HEAD/qa/userfunc_twoargs1.aref -------------------------------------------------------------------------------- /qa/userfunc_withret1.aref: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/PlanetAPL/openAPL/HEAD/qa/userfunc_withret1.aref -------------------------------------------------------------------------------- /apl11/include/makefile.common.in: -------------------------------------------------------------------------------- 1 | CC= @CC@ 2 | CFLAGS= @CFLAGS@ 3 | LIBS= @LIBS@ 4 | YACC= @YACC@ 5 | 6 | -------------------------------------------------------------------------------- /terminal/linux-ppc/README: -------------------------------------------------------------------------------- 1 | This directory contains contributed material for Linux PPC 2 | for Macintosh. 3 | -------------------------------------------------------------------------------- /terminal/XFree86/fonts/apl8x13.pcf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/PlanetAPL/openAPL/HEAD/terminal/XFree86/fonts/apl8x13.pcf -------------------------------------------------------------------------------- /terminal/XFree86/fonts/aplox.108.pcf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/PlanetAPL/openAPL/HEAD/terminal/XFree86/fonts/aplox.108.pcf -------------------------------------------------------------------------------- /terminal/XFree86/fonts/aplox.150.pcf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/PlanetAPL/openAPL/HEAD/terminal/XFree86/fonts/aplox.150.pcf -------------------------------------------------------------------------------- /terminal/XFree86/fonts/aplox.216.pcf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/PlanetAPL/openAPL/HEAD/terminal/XFree86/fonts/aplox.216.pcf -------------------------------------------------------------------------------- /terminal/XFree86/fonts/aplox.300.pcf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/PlanetAPL/openAPL/HEAD/terminal/XFree86/fonts/aplox.300.pcf -------------------------------------------------------------------------------- /terminal/linux-i386/fonts/apl8x16.psf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/PlanetAPL/openAPL/HEAD/terminal/linux-i386/fonts/apl8x16.psf -------------------------------------------------------------------------------- /terminal/linux-ppc/fonts/apl8x16.psf: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/PlanetAPL/openAPL/HEAD/terminal/linux-ppc/fonts/apl8x16.psf -------------------------------------------------------------------------------- /terminal/linux-ppc/keymap/apl2741.map: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/PlanetAPL/openAPL/HEAD/terminal/linux-ppc/keymap/apl2741.map -------------------------------------------------------------------------------- /terminal/XFree86-ppc/keymap/apl2741.xmap: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/PlanetAPL/openAPL/HEAD/terminal/XFree86-ppc/keymap/apl2741.xmap -------------------------------------------------------------------------------- /terminal/linux-i386/keymap/apl2741.map: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/PlanetAPL/openAPL/HEAD/terminal/linux-i386/keymap/apl2741.map -------------------------------------------------------------------------------- /terminal/XFree86-ppc/keymap/modeswitch.xmap: -------------------------------------------------------------------------------- https://raw.githubusercontent.com/PlanetAPL/openAPL/HEAD/terminal/XFree86-ppc/keymap/modeswitch.xmap -------------------------------------------------------------------------------- /qa/userfunc_nilret1.ainp: -------------------------------------------------------------------------------- 1 | C@J Test of )read. function with no return value. 2 | 3 | Lchdir 'clean_dir' 4 | 5 | )read nilret1 6 | nilret1 7 | )vars 8 | )fns 9 | -------------------------------------------------------------------------------- /qa/userfunc_onearg1.ainp: -------------------------------------------------------------------------------- 1 | C@J Test of )read. monadic function with a return value. 2 | 3 | Lchdir 'clean_dir' 4 | 5 | )read onearg 6 | onearg 5 7 | )vars 8 | )fns 9 | -------------------------------------------------------------------------------- /qa/userfunc_twoargs1.ainp: -------------------------------------------------------------------------------- 1 | C@J Test of )read. dyadic function with a return value. 2 | 3 | Lchdir 'clean_dir' 4 | 5 | )read twoargs 6 | 2 twoargs 5 7 | )vars 8 | )fns 9 | -------------------------------------------------------------------------------- /qa/userfunc_withret1.ainp: -------------------------------------------------------------------------------- 1 | C@J Test of )read. niladic function with a return value. 2 | 3 | Lchdir 'clean_dir' 4 | 5 | )read withret1 6 | withret1 7 | )vars 8 | )fns 9 | -------------------------------------------------------------------------------- /apl11/userfunc/ex_br0.c: -------------------------------------------------------------------------------- 1 | /* Copyright U S WEST Advanced Technologies, Inc. 2 | * You may use, copy, modify and sublicense this Software 3 | * subject to the conditions expressed in the file "License". 4 | */ 5 | 6 | #include "apl.h" 7 | -------------------------------------------------------------------------------- /apl11/parser/yyerror.c: -------------------------------------------------------------------------------- 1 | /* Copyright U S WEST Advanced Technologies, Inc. 2 | * You may use, copy, modify and sublicense this Software 3 | * subject to the conditions expressed in the file "License". 4 | */ 5 | 6 | void yyerror(char* error) 7 | { 8 | } 9 | -------------------------------------------------------------------------------- /qa/clean_dir/exp: -------------------------------------------------------------------------------- 1 | G z { exp x; xreal; ximag; rz 2 | } ((0 # RRx) ^ 1 # `1 Y Rx) / xnotreal 3 | x { x, 0 4 | xnotreal: 5 | rz { Rx 6 | xreal { 0 `1 U ((X/`1URx), 2) Rx 7 | ximag { 0 1 U ((X/`1URx), 2) Rx 8 | z { rz R ((*xreal) X (2 O ximag)), (*xreal) X 1 O ximag 9 | -------------------------------------------------------------------------------- /qa/mixed_dyadic.ainp: -------------------------------------------------------------------------------- 1 | pi { 3 1 4 1 5 9 2 6 2 | left { 1 3 | right { -1 4 | left O@| pi 5 | right O@| pi 6 | 7 | 3 Y pi 8 | 0 Y pi 9 | R0 Y pi 10 | RR0 Y pi 11 | 12 | m { 3 4RI12 13 | L { m1 { 2 1 U m 14 | Rm1 15 | RRm1 16 | 17 | L { m0 { 1 2 U m1 18 | Rm0 19 | RRm0 20 | -------------------------------------------------------------------------------- /apl11/Docs/global_replace: -------------------------------------------------------------------------------- 1 | #! /bin/sh 2 | 3 | find_string='contemp' 4 | replace_string='thisContext' 5 | 6 | for file in */*.c ; do 7 | if (grep $find_string $file > /dev/null ) then 8 | echo $file 9 | cat $file | sed "s/$find_string/$replace_string/g" > temp 10 | mv temp $file 11 | fi 12 | done 13 | -------------------------------------------------------------------------------- /apl11/data/nlook.c: -------------------------------------------------------------------------------- 1 | /* Copyright U S WEST Advanced Technologies, Inc. 2 | * You may use, copy, modify and sublicense this Software 3 | * subject to the conditions expressed in the file "License". 4 | */ 5 | #include "apl.h" 6 | #include "data.h" 7 | 8 | SymTabEntry* nlook(char* name) 9 | { 10 | return symtabFind(name); 11 | } 12 | -------------------------------------------------------------------------------- /apl11/scalar_dyadic/ex_minus.c: -------------------------------------------------------------------------------- 1 | /* Copyright U S WEST Advanced Technologies, Inc. 2 | * You may use, copy, modify and sublicense this Software 3 | * subject to the conditions expressed in the file "License". 4 | */ 5 | 6 | #include "apl.h" 7 | 8 | data 9 | ex_minus(d) 10 | data d; 11 | { 12 | return (-d); 13 | } 14 | -------------------------------------------------------------------------------- /apl11/scalar_dyadic/ex_plus.c: -------------------------------------------------------------------------------- 1 | /* Copyright U S WEST Advanced Technologies, Inc. 2 | * You may use, copy, modify and sublicense this Software 3 | * subject to the conditions expressed in the file "License". 4 | */ 5 | 6 | #include "apl.h" 7 | 8 | data 9 | ex_plus(d) 10 | data d; 11 | { 12 | return (d); 13 | } 14 | -------------------------------------------------------------------------------- /apl11/execute/ex_botch.c: -------------------------------------------------------------------------------- 1 | /* Copyright U S WEST Advanced Technologies, Inc. 2 | * You may use, copy, modify and sublicense this Software 3 | * subject to the conditions expressed in the file "License". 4 | */ 5 | #include "apl.h" 6 | #include "utility.h" 7 | 8 | void ex_botch() 9 | { 10 | error(ERR_botch, "implementation"); 11 | } 12 | -------------------------------------------------------------------------------- /apl11/scalar_monadic/ex_pi.c: -------------------------------------------------------------------------------- 1 | /* Copyright U S WEST Advanced Technologies, Inc. 2 | * You may use, copy, modify and sublicense this Software 3 | * subject to the conditions expressed in the file "License". 4 | */ 5 | 6 | #include "apl.h" 7 | 8 | data 9 | ex_pi(d) 10 | data d; 11 | { 12 | d = pi * d; 13 | return (d); 14 | } 15 | -------------------------------------------------------------------------------- /script/apl.opt1a: -------------------------------------------------------------------------------- 1 | # determine if we are running under X11 2 | if ( xset q 2>/dev/null 1>&2 ) ; then 3 | interface="X11" 4 | else 5 | if ! { setfont 2>/dev/null ; } then 6 | echo Panic: cannot find X11 support, cannot run setfont 7 | echo Unable to provide apl font, stopping... 8 | exit 0 9 | fi 10 | interface="console" 11 | fi 12 | -------------------------------------------------------------------------------- /apl11/scalar_dyadic/ex_mul.c: -------------------------------------------------------------------------------- 1 | /* Copyright U S WEST Advanced Technologies, Inc. 2 | * You may use, copy, modify and sublicense this Software 3 | * subject to the conditions expressed in the file "License". 4 | */ 5 | 6 | #include "apl.h" 7 | 8 | data 9 | ex_mul(d1, d2) 10 | data d1, 11 | d2; 12 | { 13 | return (d1 * d2); 14 | } 15 | -------------------------------------------------------------------------------- /apl11/print/ex_hprint.c: -------------------------------------------------------------------------------- 1 | /* Copyright U S WEST Advanced Technologies, Inc. 2 | * You may use, copy, modify and sublicense this Software 3 | * subject to the conditions expressed in the file "License". 4 | */ 5 | #include "apl.h" 6 | #include "data.h" 7 | #include "local_print.h" 8 | 9 | void ex_hprint() 10 | { 11 | print(); 12 | pop(); 13 | } 14 | -------------------------------------------------------------------------------- /apl11/utility/fix.c: -------------------------------------------------------------------------------- 1 | /* Copyright U S WEST Advanced Technologies, Inc. 2 | * You may use, copy, modify and sublicense this Software 3 | * subject to the conditions expressed in the file "License". 4 | */ 5 | #include 6 | #include "apl.h" 7 | 8 | int fix(data d) 9 | { 10 | int i; 11 | 12 | i = floor(d + 0.5); 13 | return (i); 14 | } 15 | -------------------------------------------------------------------------------- /apl11/utility/checksp.c: -------------------------------------------------------------------------------- 1 | /* Copyright U S WEST Advanced Technologies, Inc. 2 | * You may use, copy, modify and sublicense this Software 3 | * subject to the conditions expressed in the file "License". 4 | */ 5 | #include "apl.h" 6 | #include "utility.h" 7 | 8 | void checksp() 9 | { 10 | if (sp >= &stack[STKS]) 11 | error(ERR, "stack overflow"); 12 | } 13 | -------------------------------------------------------------------------------- /apl11/quad_func/ex_exit.c: -------------------------------------------------------------------------------- 1 | /* Copyright U S WEST Advanced Technologies, Inc. 2 | * You may use, copy, modify and sublicense this Software 3 | * subject to the conditions expressed in the file "License". 4 | */ 5 | 6 | #include "apl.h" 7 | #include "utility.h" 8 | #include "main.h" 9 | 10 | void ex_exit() 11 | { 12 | SECURITY_CHECK; 13 | Exit(topfix()); 14 | } 15 | -------------------------------------------------------------------------------- /apl11/ibeam/Makefile: -------------------------------------------------------------------------------- 1 | # Makefile for I-Beam functions 2 | 3 | include ../include/makefile.common 4 | CFLAGS += -I../include 5 | 6 | OBJECTS = ex_dibm.o ex_mibm.o 7 | 8 | all: Q.o 9 | 10 | Q.o: $(OBJECTS) 11 | $(LD) -r -o Q.o $(OBJECTS) 12 | 13 | $(OBJECTS): ../include/apl.h 14 | 15 | .c.o: 16 | $(CC) $(CFLAGS) -c $< 17 | 18 | clean: 19 | rm -f $(OBJECTS) core 20 | 21 | -------------------------------------------------------------------------------- /apl11/scalar_monadic/ex_abs.c: -------------------------------------------------------------------------------- 1 | /* Copyright U S WEST Advanced Technologies, Inc. 2 | * You may use, copy, modify and sublicense this Software 3 | * subject to the conditions expressed in the file "License". 4 | */ 5 | 6 | #include "apl.h" 7 | 8 | data 9 | ex_abs(d) 10 | data d; 11 | { 12 | if (d < zero) 13 | return (-d); 14 | return (d); 15 | } 16 | -------------------------------------------------------------------------------- /apl11/mixed_monadic/ex_menc.c: -------------------------------------------------------------------------------- 1 | /* Copyright U S WEST Advanced Technologies, Inc. 2 | * You may use, copy, modify and sublicense this Software 3 | * subject to the conditions expressed in the file "License". 4 | */ 5 | 6 | #include "apl.h" 7 | #include "utility.h" 8 | 9 | /* monadic encode */ 10 | void ex_menc() 11 | { 12 | error(ERR, "Monadic encode not supported"); 13 | } 14 | -------------------------------------------------------------------------------- /apl11/quad_func/ex_dup.c: -------------------------------------------------------------------------------- 1 | /* Copyright U S WEST Advanced Technologies, Inc. 2 | * You may use, copy, modify and sublicense this Software 3 | * subject to the conditions expressed in the file "License". 4 | */ 5 | #include 6 | 7 | #include "apl.h" 8 | #include "utility.h" 9 | 10 | void ex_dup() 11 | { 12 | SECURITY_CHECK; 13 | iodone(dup(topfix())); 14 | } 15 | -------------------------------------------------------------------------------- /apl11/scalar_monadic/ex_not.c: -------------------------------------------------------------------------------- 1 | /* Copyright U S WEST Advanced Technologies, Inc. 2 | * You may use, copy, modify and sublicense this Software 3 | * subject to the conditions expressed in the file "License". 4 | */ 5 | 6 | #include "apl.h" 7 | 8 | data 9 | ex_not(d) 10 | data d; 11 | { 12 | if (d == zero) 13 | return (one); 14 | return (zero); 15 | } 16 | -------------------------------------------------------------------------------- /apl11/utility/scalar.c: -------------------------------------------------------------------------------- 1 | /* Copyright U S WEST Advanced Technologies, Inc. 2 | * You may use, copy, modify and sublicense this Software 3 | * subject to the conditions expressed in the file "License". 4 | */ 5 | #include "apl.h" 6 | 7 | /* 8 | * scalar -- return true if arg is a scalar 9 | */ 10 | int scalar(struct item* aip) 11 | { 12 | return (aip->size == 1); 13 | } 14 | -------------------------------------------------------------------------------- /apl11/quad_func/ex_close.c: -------------------------------------------------------------------------------- 1 | /* Copyright U S WEST Advanced Technologies, Inc. 2 | * You may use, copy, modify and sublicense this Software 3 | * subject to the conditions expressed in the file "License". 4 | */ 5 | #include 6 | 7 | #include "apl.h" 8 | #include "utility.h" 9 | 10 | void ex_close() 11 | { 12 | SECURITY_CHECK; 13 | iodone(close(topfix())); 14 | } 15 | -------------------------------------------------------------------------------- /apl11/scalar_monadic/ex_ceil.c: -------------------------------------------------------------------------------- 1 | /* Copyright U S WEST Advanced Technologies, Inc. 2 | * You may use, copy, modify and sublicense this Software 3 | * subject to the conditions expressed in the file "License". 4 | */ 5 | 6 | #include "apl.h" 7 | #include "math.h" 8 | 9 | data 10 | ex_ceil(d) 11 | data d; 12 | { 13 | d = ceil(d - tolerance); 14 | return (d); 15 | } 16 | -------------------------------------------------------------------------------- /apl11/struct_monadic/Makefile: -------------------------------------------------------------------------------- 1 | # Makefile for struct_monadic 2 | 3 | include ../include/makefile.common 4 | CFLAGS += -I../include 5 | 6 | OBJECTS = ex_mrho.o ex_miot.o ex_rav.o 7 | 8 | all: Q.o 9 | 10 | Q.o: $(OBJECTS) 11 | $(LD) -r -o Q.o $(OBJECTS) 12 | 13 | $(OBJECTS): ../include/apl.h 14 | 15 | .c.o: 16 | $(CC) $(CFLAGS) -c $< 17 | 18 | clean: 19 | rm -f $(OBJECTS) core 20 | -------------------------------------------------------------------------------- /apl11/work_space/Makefile: -------------------------------------------------------------------------------- 1 | # Makefile for APL11 2 | 3 | include ../include/makefile.common 4 | CFLAGS += -I../include 5 | 6 | OBJECTS = ws_clear.o ws_load.o ws_save.o fdat.o 7 | 8 | all: Q.o 9 | 10 | Q.o: $(OBJECTS) 11 | $(LD) -r -o Q.o $(OBJECTS) 12 | 13 | $(OBJECTS): ../include/apl.h 14 | 15 | .c.o: 16 | $(CC) $(CFLAGS) -c $< 17 | 18 | clean: 19 | rm -f $(OBJECTS) core 20 | 21 | -------------------------------------------------------------------------------- /docs/user_guide/README: -------------------------------------------------------------------------------- 1 | Some of the files in this directory contain characters 2 | encoded for apl2741 font (specifically the files QuadVars 3 | and QuadFunc). 4 | 5 | In order to see the APL characters properly, use the command 6 | "apl -on" then view the file with an 8-bit clean pager or 7 | editor. Advice on 8-bit clean programs can be found in the 8 | install_guide directory. 9 | 10 | -------------------------------------------------------------------------------- /apl11/debug/memory.h: -------------------------------------------------------------------------------- 1 | /* Copyright U S WEST Advanced Technologies, Inc. (AT&T) 2 | * You may use, copy, modify and sublicense this Software 3 | * subject to the conditions expressed in the file "License". 4 | */ 5 | 6 | struct memblock { 7 | int* block; 8 | unsigned nbytes; 9 | struct memblock* next; 10 | }; 11 | 12 | struct memblock* firstblock; 13 | extern int mem_trace; 14 | -------------------------------------------------------------------------------- /apl11/scalar_monadic/ex_floor.c: -------------------------------------------------------------------------------- 1 | /* Copyright U S WEST Advanced Technologies, Inc. 2 | * You may use, copy, modify and sublicense this Software 3 | * subject to the conditions expressed in the file "License". 4 | */ 5 | 6 | #include "apl.h" 7 | #include 8 | 9 | data 10 | ex_floor(d) 11 | data d; 12 | { 13 | d = floor(d + tolerance); 14 | return (d); 15 | } 16 | -------------------------------------------------------------------------------- /apl11/memory/Makefile: -------------------------------------------------------------------------------- 1 | # Makefile for memory 2 | 3 | include ../include/makefile.common 4 | CFLAGS += -I../include 5 | 6 | OBJECTS = afreset.o alloc.o aplfree.o 7 | 8 | all : Q.o 9 | 10 | Q.o: $(OBJECTS) 11 | $(LD) -r -o Q.o $(OBJECTS) 12 | 13 | $(OBJECTS): ../include/apl.h ../include/memory.h 14 | 15 | .c.o: 16 | $(CC) $(CFLAGS) -c $< 17 | 18 | clean: 19 | rm -f Q.o $(OBJECTS) core 20 | -------------------------------------------------------------------------------- /apl11/scalar_dyadic/ex_max.c: -------------------------------------------------------------------------------- 1 | /* Copyright U S WEST Advanced Technologies, Inc. 2 | * You may use, copy, modify and sublicense this Software 3 | * subject to the conditions expressed in the file "License". 4 | */ 5 | 6 | #include "apl.h" 7 | 8 | data 9 | ex_max(d1, d2) 10 | data d1, 11 | d2; 12 | { 13 | if (d1 > d2) 14 | return (d1); 15 | return (d2); 16 | } 17 | -------------------------------------------------------------------------------- /apl11/scalar_dyadic/ex_min.c: -------------------------------------------------------------------------------- 1 | /* Copyright U S WEST Advanced Technologies, Inc. 2 | * You may use, copy, modify and sublicense this Software 3 | * subject to the conditions expressed in the file "License". 4 | */ 5 | 6 | #include "apl.h" 7 | 8 | data 9 | ex_min(d1, d2) 10 | data d1, 11 | d2; 12 | { 13 | if (d1 < d2) 14 | return (d1); 15 | return (d2); 16 | } 17 | -------------------------------------------------------------------------------- /apl11/data/access.c: -------------------------------------------------------------------------------- 1 | /* Copyright U S WEST Advanced Technologies, Inc. 2 | * You may use, copy, modify and sublicense this Software 3 | * subject to the conditions expressed in the file "License". 4 | */ 5 | #include "apl.h" 6 | 7 | int access() { 8 | int i, n; 9 | 10 | n = 0; 11 | for (i = 0; i < idx.rank; i++) 12 | n += idx.idx[i] * idx.del[i]; 13 | return (n); 14 | } 15 | -------------------------------------------------------------------------------- /apl11/struct_dyadic/Makefile: -------------------------------------------------------------------------------- 1 | # Makefile for struct_dyadic (structural dyadic operators) 2 | 3 | include ../include/makefile.common 4 | CFLAGS += -I../include 5 | 6 | OBJECTS = ex_cat.o ex_drho.o 7 | 8 | all: Q.o 9 | 10 | Q.o: $(OBJECTS) 11 | $(LD) -r -o Q.o $(OBJECTS) 12 | 13 | $(OBJECTS): ../include/apl.h 14 | 15 | .c.o: 16 | $(CC) $(CFLAGS) -c $< 17 | 18 | clean: 19 | rm -f $(OBJECTS) core 20 | -------------------------------------------------------------------------------- /apl11/utility/iodone.c: -------------------------------------------------------------------------------- 1 | /* Copyright U S WEST Advanced Technologies, Inc. 2 | * You may use, copy, modify and sublicense this Software 3 | * subject to the conditions expressed in the file "License". 4 | */ 5 | 6 | #include "apl.h" 7 | #include "data.h" 8 | 9 | void iodone(int ok) 10 | { 11 | struct item* p; 12 | 13 | p = newdat(DA, 0, 1); 14 | p->datap[0] = ok; 15 | *sp++ = p; 16 | } 17 | -------------------------------------------------------------------------------- /apl11/scalar_dyadic/ex_or.c: -------------------------------------------------------------------------------- 1 | /* Copyright U S WEST Advanced Technologies, Inc. 2 | * You may use, copy, modify and sublicense this Software 3 | * subject to the conditions expressed in the file "License". 4 | */ 5 | 6 | #include "apl.h" 7 | 8 | data 9 | ex_or(d1, d2) 10 | data d1, 11 | d2; 12 | { 13 | if (d1 != zero || d2 != zero) 14 | return (one); 15 | return (zero); 16 | } 17 | -------------------------------------------------------------------------------- /terminal/XFree86/keymap/modeswitch.xmap: -------------------------------------------------------------------------------- 1 | ! A file to use with xmodmap to convert the right ALT key 2 | ! into the "Mode Switch" key. 3 | ! There are other ways to obtain a Mode Switch key on your 4 | ! X11 keyboard, eg through the XF86Config file or XKB, if 5 | ! you use one of these, then loading this file is not 6 | ! necessary. 7 | 8 | keycode 113 = Mode_switch 9 | clear Mod3 10 | add Mod3 = Mode_switch 11 | -------------------------------------------------------------------------------- /apl11/quad_func/ex_chdir.c: -------------------------------------------------------------------------------- 1 | /* Copyright U S WEST Advanced Technologies, Inc. 2 | * You may use, copy, modify and sublicense this Software 3 | * subject to the conditions expressed in the file "License". 4 | */ 5 | #include 6 | 7 | #include "apl.h" 8 | #include "utility.h" 9 | 10 | char* iofname(); 11 | 12 | void ex_chdir() 13 | { 14 | SECURITY_CHECK; 15 | iodone(chdir(iofname())); 16 | } 17 | -------------------------------------------------------------------------------- /apl11/quad_func/ex_unlink.c: -------------------------------------------------------------------------------- 1 | /* Copyright U S WEST Advanced Technologies, Inc. 2 | * You may use, copy, modify and sublicense this Software 3 | * subject to the conditions expressed in the file "License". 4 | */ 5 | #include 6 | 7 | #include "apl.h" 8 | #include "utility.h" 9 | 10 | char* iofname(); 11 | 12 | void ex_unlink() 13 | { 14 | SECURITY_CHECK; 15 | iodone(unlink(iofname())); 16 | } 17 | -------------------------------------------------------------------------------- /apl11/scalar_dyadic/ex_and.c: -------------------------------------------------------------------------------- 1 | /* Copyright U S WEST Advanced Technologies, Inc. 2 | * You may use, copy, modify and sublicense this Software 3 | * subject to the conditions expressed in the file "License". 4 | */ 5 | 6 | #include "apl.h" 7 | 8 | data 9 | ex_and(d1, d2) 10 | data d1, 11 | d2; 12 | { 13 | if (d1 != zero && d2 != zero) 14 | return (one); 15 | return (zero); 16 | } 17 | -------------------------------------------------------------------------------- /apl11/scalar_dyadic/ex_nand.c: -------------------------------------------------------------------------------- 1 | /* Copyright U S WEST Advanced Technologies, Inc. 2 | * You may use, copy, modify and sublicense this Software 3 | * subject to the conditions expressed in the file "License". 4 | */ 5 | 6 | #include "apl.h" 7 | 8 | data 9 | ex_nand(d1, d2) 10 | data d1, 11 | d2; 12 | { 13 | if (d1 != zero && d2 != zero) 14 | return (zero); 15 | return (one); 16 | } 17 | -------------------------------------------------------------------------------- /apl11/scalar_dyadic/ex_nor.c: -------------------------------------------------------------------------------- 1 | /* Copyright U S WEST Advanced Technologies, Inc. 2 | * You may use, copy, modify and sublicense this Software 3 | * subject to the conditions expressed in the file "License". 4 | */ 5 | 6 | #include "apl.h" 7 | 8 | data 9 | ex_nor(d1, d2) 10 | data d1, 11 | d2; 12 | { 13 | if (d1 != zero || d2 != zero) 14 | return (zero); 15 | return (one); 16 | } 17 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | *.o 2 | apl 3 | rline 4 | aplws.abort 5 | /Makefile 6 | qa/Makefile 7 | apl11/apl11 8 | apl11/include/config.h 9 | apl11/include/makefile.common 10 | apl11/parser/y.tab.c 11 | apl11/parser/y.tab.h 12 | autoconf/config.cache 13 | autoconf/config.log 14 | autoconf/config.status 15 | printer/apl2epson 16 | printer/apl2gs 17 | script/apl-setup 18 | script/aplrc 19 | qa/*.dif 20 | qa/*.adif 21 | qa/*.out 22 | qa/*.aout 23 | -------------------------------------------------------------------------------- /apl11/scalar_dyadic/ex_eq.c: -------------------------------------------------------------------------------- 1 | /* Copyright U S WEST Advanced Technologies, Inc. 2 | * You may use, copy, modify and sublicense this Software 3 | * subject to the conditions expressed in the file "License". 4 | */ 5 | 6 | #include "apl.h" 7 | #include "utility.h" 8 | 9 | data 10 | ex_eq(d1, d2) 11 | data d1, 12 | d2; 13 | { 14 | if (fuzz(d1, d2) == 0) 15 | return (one); 16 | return (zero); 17 | } 18 | -------------------------------------------------------------------------------- /apl11/scalar_dyadic/ex_ge.c: -------------------------------------------------------------------------------- 1 | /* Copyright U S WEST Advanced Technologies, Inc. 2 | * You may use, copy, modify and sublicense this Software 3 | * subject to the conditions expressed in the file "License". 4 | */ 5 | 6 | #include "apl.h" 7 | #include "utility.h" 8 | 9 | data 10 | ex_ge(d1, d2) 11 | data d1, 12 | d2; 13 | { 14 | if (fuzz(d1, d2) >= 0) 15 | return (one); 16 | return (zero); 17 | } 18 | -------------------------------------------------------------------------------- /apl11/scalar_dyadic/ex_gt.c: -------------------------------------------------------------------------------- 1 | /* Copyright U S WEST Advanced Technologies, Inc. 2 | * You may use, copy, modify and sublicense this Software 3 | * subject to the conditions expressed in the file "License". 4 | */ 5 | 6 | #include "apl.h" 7 | #include "utility.h" 8 | 9 | data 10 | ex_gt(d1, d2) 11 | data d1, 12 | d2; 13 | { 14 | if (fuzz(d1, d2) > 0) 15 | return (one); 16 | return (zero); 17 | } 18 | -------------------------------------------------------------------------------- /apl11/scalar_dyadic/ex_le.c: -------------------------------------------------------------------------------- 1 | /* Copyright U S WEST Advanced Technologies, Inc. 2 | * You may use, copy, modify and sublicense this Software 3 | * subject to the conditions expressed in the file "License". 4 | */ 5 | 6 | #include "apl.h" 7 | #include "utility.h" 8 | 9 | data 10 | ex_le(d1, d2) 11 | data d1, 12 | d2; 13 | { 14 | if (fuzz(d1, d2) <= 0) 15 | return (one); 16 | return (zero); 17 | } 18 | -------------------------------------------------------------------------------- /apl11/scalar_dyadic/ex_lt.c: -------------------------------------------------------------------------------- 1 | /* Copyright U S WEST Advanced Technologies, Inc. 2 | * You may use, copy, modify and sublicense this Software 3 | * subject to the conditions expressed in the file "License". 4 | */ 5 | 6 | #include "apl.h" 7 | #include "utility.h" 8 | 9 | data 10 | ex_lt(d1, d2) 11 | data d1, 12 | d2; 13 | { 14 | if (fuzz(d1, d2) < 0) 15 | return (one); 16 | return (zero); 17 | } 18 | -------------------------------------------------------------------------------- /apl11/scalar_dyadic/ex_ne.c: -------------------------------------------------------------------------------- 1 | /* Copyright U S WEST Advanced Technologies, Inc. 2 | * You may use, copy, modify and sublicense this Software 3 | * subject to the conditions expressed in the file "License". 4 | */ 5 | 6 | #include "apl.h" 7 | #include "utility.h" 8 | 9 | data 10 | ex_ne(d1, d2) 11 | data d1, 12 | d2; 13 | { 14 | if (fuzz(d1, d2) != 0) 15 | return (one); 16 | return (zero); 17 | } 18 | -------------------------------------------------------------------------------- /apl11/scalar_monadic/ex_sgn.c: -------------------------------------------------------------------------------- 1 | /* Copyright U S WEST Advanced Technologies, Inc. 2 | * You may use, copy, modify and sublicense this Software 3 | * subject to the conditions expressed in the file "License". 4 | */ 5 | 6 | #include "apl.h" 7 | 8 | data 9 | ex_sgn(d) 10 | data d; 11 | { 12 | if (d == zero) 13 | return (zero); 14 | if (d < zero) 15 | return (-one); 16 | return (one); 17 | } 18 | -------------------------------------------------------------------------------- /apl11/mixed_monadic/Makefile: -------------------------------------------------------------------------------- 1 | # Makefile for mixed_monadic functions 2 | 3 | include ../include/makefile.common 4 | CFLAGS += -I../include 5 | 6 | OBJECTS = ex_menc.o ex_rand.o ex_mdom.o ex_execute.o ex_rev.o \ 7 | ex_gdu.o ex_gdd.o gd.o 8 | 9 | all : Q.o 10 | 11 | Q.o: $(OBJECTS) 12 | $(LD) -r -o Q.o $(OBJECTS) 13 | 14 | $(OBJECTS): ../include/apl.h 15 | 16 | .c.o: 17 | $(CC) $(CFLAGS) -c $< 18 | 19 | clean: 20 | rm -f *.o 21 | -------------------------------------------------------------------------------- /apl11/parser/alpha.c: -------------------------------------------------------------------------------- 1 | /* Copyright U S WEST Advanced Technologies, Inc. 2 | * You may use, copy, modify and sublicense this Software 3 | * subject to the conditions expressed in the file "License". 4 | */ 5 | 6 | #include "local_parser.h" 7 | 8 | bool alpha(char s) 9 | { 10 | return ( 11 | (s >= 'a' && s <= 'z') 12 | || (s >= 'A' && s <= 'Z') 13 | || (litflag == -2 && (s == '/' || s == '.'))); 14 | } 15 | -------------------------------------------------------------------------------- /apl11/scalar_dyadic/ex_sub.c: -------------------------------------------------------------------------------- 1 | /* Copyright U S WEST Advanced Technologies, Inc. 2 | * You may use, copy, modify and sublicense this Software 3 | * subject to the conditions expressed in the file "License". 4 | */ 5 | 6 | #include "apl.h" 7 | #include "utility.h" 8 | 9 | data 10 | ex_sub(d1, d2) 11 | data d1, 12 | d2; 13 | { 14 | if (fuzz(d1, d2) == 0) 15 | return (zero); 16 | return (d1 - d2); 17 | } 18 | -------------------------------------------------------------------------------- /apl11/scalar_dyadic/ex_add.c: -------------------------------------------------------------------------------- 1 | /* Copyright U S WEST Advanced Technologies, Inc. 2 | * You may use, copy, modify and sublicense this Software 3 | * subject to the conditions expressed in the file "License". 4 | */ 5 | 6 | #include "apl.h" 7 | #include "utility.h" 8 | 9 | data 10 | ex_add(d1, d2) 11 | data d1, 12 | d2; 13 | { 14 | if (fuzz(d1, -d2) == 0) 15 | return (zero); 16 | return (d1 + d2); 17 | } 18 | -------------------------------------------------------------------------------- /apl11/oper_dyadic/Makefile: -------------------------------------------------------------------------------- 1 | # Makefile for oper_dyadic (dyadic operators) 2 | 3 | include ../include/makefile.common 4 | CFLAGS += -I../include 5 | 6 | OBJECTS = ex_iprod.o ex_oprod.o ex_asgn.o 7 | 8 | all: Q.o 9 | 10 | Q.o: $(OBJECTS) 11 | $(LD) -r -o Q.o $(OBJECTS) 12 | 13 | $(OBJECTS): ../include/apl.h 14 | 15 | ex_asgn.o: ../include/char.h 16 | 17 | .c.o: 18 | $(CC) $(CFLAGS) -c $< 19 | 20 | clean: 21 | rm -f $(OBJECTS) core Q.o 22 | -------------------------------------------------------------------------------- /apl11/print/Makefile: -------------------------------------------------------------------------------- 1 | # Makefile for print 2 | 3 | include ../include/makefile.common 4 | CFLAGS += -I../include 5 | 6 | OBJECTS = print.o ex_hprint.o ex_print.o\ 7 | fp_print.o lt_print.o c_overbar.o 8 | 9 | all: Q.o 10 | 11 | Q.o: $(OBJECTS) 12 | $(LD) -r -o Q.o $(OBJECTS) 13 | 14 | $(OBJECTS): ../include/apl.h 15 | 16 | print.o: ../include/format.h 17 | 18 | .c.o: 19 | $(CC) $(CFLAGS) -c $< 20 | 21 | clean: 22 | rm -f *.o 23 | 24 | -------------------------------------------------------------------------------- /apl11/print/ex_print.c: -------------------------------------------------------------------------------- 1 | /* Copyright U S WEST Advanced Technologies, Inc. 2 | * You may use, copy, modify and sublicense this Software 3 | * subject to the conditions expressed in the file "License". 4 | */ 5 | #include "apl.h" 6 | #include "local_print.h" 7 | 8 | int ex_print() 9 | { 10 | if (print()) { /* print() would only return 0 for type NIL */ 11 | putchar('\n'); 12 | column = 0; 13 | } 14 | return (0); 15 | } 16 | -------------------------------------------------------------------------------- /apl11/scalar_monadic/ex_recip.c: -------------------------------------------------------------------------------- 1 | /* Copyright U S WEST Advanced Technologies, Inc. 2 | * You may use, copy, modify and sublicense this Software 3 | * subject to the conditions expressed in the file "License". 4 | */ 5 | 6 | #include "apl.h" 7 | #include "utility.h" 8 | 9 | data 10 | ex_recip(d) 11 | data d; 12 | { 13 | if (d == zero) 14 | error(ERR_domain, "reciprocal of zero attempted"); 15 | return (one / d); 16 | } 17 | -------------------------------------------------------------------------------- /apl11/data/size.c: -------------------------------------------------------------------------------- 1 | /* Copyright U S WEST Advanced Technologies, Inc. 2 | * You may use, copy, modify and sublicense this Software 3 | * subject to the conditions expressed in the file "License". 4 | */ 5 | #include "apl.h" 6 | 7 | int size() 8 | { 9 | int i, s; 10 | 11 | s = 1; 12 | for (i = idx.rank - 1; i >= 0; i--) { 13 | idx.del[i] = s; 14 | s *= idx.dim[i]; 15 | } 16 | idx.size = s; 17 | return (s); 18 | } 19 | -------------------------------------------------------------------------------- /apl11/quad_func/ex_open.c: -------------------------------------------------------------------------------- 1 | /* Copyright U S WEST Advanced Technologies, Inc. 2 | * You may use, copy, modify and sublicense this Software 3 | * subject to the conditions expressed in the file "License". 4 | */ 5 | #include 6 | 7 | #include "apl.h" 8 | #include "utility.h" 9 | 10 | char* iofname(); 11 | 12 | void ex_open() 13 | { 14 | int m; 15 | 16 | m = topfix(); 17 | SECURITY_CHECK; 18 | iodone(open(iofname(), m)); 19 | } 20 | -------------------------------------------------------------------------------- /apl11/oper_monadic/Makefile: -------------------------------------------------------------------------------- 1 | # Makefile for oper_monadic (monadic operators) 2 | 3 | include ../include/makefile.common 4 | CFLAGS += -I../include 5 | 6 | OBJECTS = ex_red.o ex_com.o ex_exd.o ex_scan.o 7 | 8 | all: Q.o 9 | 10 | Q.o: $(OBJECTS) 11 | $(LD) -r -o Q.o $(OBJECTS) 12 | 13 | $(OBJECTS): ../include/apl.h 14 | 15 | ex_red.o ex_scan.o: ../include/opt_codes.h 16 | 17 | .c.o: 18 | $(CC) $(CFLAGS) -c $< 19 | 20 | clean: 21 | rm -f $(OBJECTS) 22 | -------------------------------------------------------------------------------- /apl11/quad_func/ex_create.c: -------------------------------------------------------------------------------- 1 | /* Copyright U S WEST Advanced Technologies, Inc. 2 | * You may use, copy, modify and sublicense this Software 3 | * subject to the conditions expressed in the file "License". 4 | */ 5 | #include 6 | 7 | #include "apl.h" 8 | #include "utility.h" 9 | 10 | char* iofname(); 11 | 12 | void ex_creat() 13 | { 14 | int m; 15 | 16 | SECURITY_CHECK; 17 | m = topfix(); 18 | iodone(creat(iofname(), m)); 19 | } 20 | -------------------------------------------------------------------------------- /script/apl-setup.opt3a: -------------------------------------------------------------------------------- 1 | which_option "console text editor" elvis-tiny pico elvis 2 | select_option "console text editor" editor $list 3 | 4 | case $result in 5 | none ) 6 | result="" 7 | ;; 8 | elvis ) 9 | echo WARNING 10 | echo You have selected an editor that may need manual configuration. 11 | echo Consult the editors file in the docs/install_guide directory. 12 | echo -n OK? 13 | read n 14 | ;; 15 | esac 16 | 17 | install_option editor $result 18 | -------------------------------------------------------------------------------- /apl11/execute/Makefile: -------------------------------------------------------------------------------- 1 | # Makefile for execute 2 | 3 | include ../include/makefile.common 4 | CFLAGS += -I../include 5 | 6 | OBJECTS = ex_dscal.o ex_botch.o ex_cdyad.o ex_ddyad.o execute.o \ 7 | ex_mdyad.o 8 | 9 | all: Q.o 10 | 11 | Q.o: $(OBJECTS) 12 | $(LD) -r -o Q.o $(OBJECTS) 13 | 14 | $(OBJECTS): ../include/apl.h 15 | 16 | execute.o: ../include/opt_codes.h 17 | 18 | .c.o: 19 | $(CC) $(CFLAGS) -c $< 20 | 21 | clean: 22 | rm -f $(OBJECTS) core 23 | 24 | -------------------------------------------------------------------------------- /apl11/scalar_monadic/Makefile: -------------------------------------------------------------------------------- 1 | # Makefile for scalar_monadic (monadic scalar functions) 2 | 3 | include ../include/makefile.common 4 | CFLAGS += -I../include 5 | 6 | OBJECTS = ex_abs.o ex_fac.o ex_not.o ex_sgn.o ex_ceil.o \ 7 | ex_floor.o ex_pi.o ex_exp.o ex_loge.o ex_recip.o 8 | 9 | all: Q.o 10 | 11 | Q.o: $(OBJECTS) 12 | $(LD) -r -o Q.o $(OBJECTS) 13 | 14 | $(OBJECTS): ../include/apl.h 15 | 16 | .c.o: 17 | $(CC) $(CFLAGS) -c $< 18 | 19 | clean: 20 | rm -f *.o 21 | -------------------------------------------------------------------------------- /script/aplrc.opt5a: -------------------------------------------------------------------------------- 1 | # $consolefont is the apl font used on the Linux character console 2 | #consolefont= 3 | 4 | # $defaultfont is used to return Linux console font to normal. 5 | #defaultfont= 6 | 7 | # $consolemap converts Linux console keystokes into APL characters. 8 | #consolemap= 9 | 10 | # $defaultmap is used to return the Linux console keyboard to normal. 11 | #defaultmap= 12 | 13 | # $editor is used with the Linux console to edit apl functions 14 | #editor= 15 | 16 | -------------------------------------------------------------------------------- /apl11/data/bidx.c: -------------------------------------------------------------------------------- 1 | /* Copyright U S WEST Advanced Technologies, Inc. 2 | * You may use, copy, modify and sublicense this Software 3 | * subject to the conditions expressed in the file "License". 4 | */ 5 | #include "apl.h" 6 | #include "data.h" 7 | 8 | void bidx(struct item* ip) 9 | { 10 | struct item* p; 11 | 12 | p = ip; 13 | idx.type = p->itemType; 14 | idx.rank = p->rank; 15 | copy(IN, (char*)p->dim, (char*)idx.dim, idx.rank); 16 | size(); 17 | } 18 | -------------------------------------------------------------------------------- /apl11/work_space/fdat.h: -------------------------------------------------------------------------------- 1 | /* fdat.h, Copyright (C) 2016, Greg Johnson 2 | * Released under the terms of the GNU GPL v2.0. 3 | * 4 | * This program is distributed in the hope that it will be useful, 5 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 6 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 7 | * GNU General Public License for more details. 8 | */ 9 | #ifndef FDAT_H 10 | #define FDAT_H 11 | 12 | void fdat(int f); 13 | 14 | #endif 15 | -------------------------------------------------------------------------------- /apl11/data/s2vect.c: -------------------------------------------------------------------------------- 1 | /* Copyright U S WEST Advanced Technologies, Inc. 2 | * You may use, copy, modify and sublicense this Software 3 | * subject to the conditions expressed in the file "License". 4 | */ 5 | #include "apl.h" 6 | #include "data.h" 7 | 8 | struct item* 9 | s2vect(ap) struct item* ap; 10 | { 11 | struct item *p, *q; 12 | 13 | p = ap; 14 | q = newdat(p->itemType, 1, 1); 15 | q->datap = p->datap; 16 | q->dim[0] = 1; 17 | return (q); 18 | } 19 | -------------------------------------------------------------------------------- /apl11/main/Makefile: -------------------------------------------------------------------------------- 1 | # Makefile for main 2 | 3 | include ../include/makefile.common 4 | CFLAGS += -I../include 5 | 6 | OBJECTS = mainloop.o exit.o apl.o getinput.o history.o ascii_input.o 7 | 8 | all: Q.o 9 | 10 | Q.o: $(OBJECTS) 11 | $(LD) -r -o Q.o $(OBJECTS) 12 | 13 | $(OBJECTS): ../include/apl.h 14 | 15 | apl.o: ../include/patchlevel.h 16 | 17 | getinput.o: ../include/config.h 18 | 19 | .c.o: 20 | $(CC) $(CFLAGS) -c $< 21 | 22 | clean: 23 | rm -f $(OBJECTS) core 24 | 25 | -------------------------------------------------------------------------------- /apl11/sys_command/ex_list.h: -------------------------------------------------------------------------------- 1 | /* ex_list.h, Copyright (C) 2016, Greg Johnson 2 | * Released under the terms of the GNU GPL v2.0. 3 | * 4 | * This program is distributed in the hope that it will be useful, 5 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 6 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 7 | * GNU General Public License for more details. 8 | */ 9 | #ifndef EX_LIST_H 10 | #define EX_LIST_H 11 | 12 | void ex_list(); 13 | 14 | #endif 15 | -------------------------------------------------------------------------------- /apl11/sys_command/ex_prws.h: -------------------------------------------------------------------------------- 1 | /* ex_prws.h, Copyright (C) 2016, Greg Johnson 2 | * Released under the terms of the GNU GPL v2.0. 3 | * 4 | * This program is distributed in the hope that it will be useful, 5 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 6 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 7 | * GNU General Public License for more details. 8 | */ 9 | #ifndef EX_PRWS_H 10 | #define EX_PRWS_H 11 | 12 | void ex_prws(); 13 | 14 | #endif 15 | -------------------------------------------------------------------------------- /apl11/sys_command/listdir.h: -------------------------------------------------------------------------------- 1 | /* listdir.h, Copyright (C) 2016, Greg Johnson 2 | * Released under the terms of the GNU GPL v2.0. 3 | * 4 | * This program is distributed in the hope that it will be useful, 5 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 6 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 7 | * GNU General Public License for more details. 8 | */ 9 | #ifndef LISTDIR_H 10 | #define LISTDIR_H 11 | 12 | void listdir(); 13 | 14 | #endif 15 | -------------------------------------------------------------------------------- /apl11/userfunc/sichk.c: -------------------------------------------------------------------------------- 1 | /* Copyright U S WEST Advanced Technologies, Inc. 2 | * You may use, copy, modify and sublicense this Software 3 | * subject to the conditions expressed in the file "License". 4 | */ 5 | 6 | #include "apl.h" 7 | #include "utility.h" 8 | 9 | void sichk(SymTabEntry* n) { 10 | Context* p; 11 | 12 | p = gsip; 13 | while (p) { 14 | if (n == p->np) 15 | error(ERR, "si damage -- type ')sic'"); 16 | p = p->prev; 17 | } 18 | } 19 | -------------------------------------------------------------------------------- /apl11/sys_command/ex_shell.h: -------------------------------------------------------------------------------- 1 | /* ex_shell.h, Copyright (C) 2016, Greg Johnson 2 | * Released under the terms of the GNU GPL v2.0. 3 | * 4 | * This program is distributed in the hope that it will be useful, 5 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 6 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 7 | * GNU General Public License for more details. 8 | */ 9 | #ifndef EX_SHELL_H 10 | #define EX_SHELL_H 11 | 12 | void ex_shell(); 13 | 14 | #endif 15 | -------------------------------------------------------------------------------- /qa/struct_dyadic.ainp: -------------------------------------------------------------------------------- 1 | C@J Dyadic Structural Primitives 2 | 3 | C@J Reshape 4 | L { n213 { 2 1 3 R I 6 5 | 2 4 R n213 6 | 7 | R 0 R 'ABCD' 8 | 9 | b { 1E2 1E2 1E2 0 1E2 1E2 1E2 R 42 10 | R b 11 | 12 | '' R n213 13 | 14 | C@J Join 15 | L { n233 { 2 3 3 R I 18 16 | L { n23 { 2 3 R I 6 17 | n233,n23 18 | n233,[3]n23 19 | n233,[2]n23 20 | n233,[1]n23 21 | 22 | L { n33 { 3 3 R I 9 23 | n233,[1]n33 24 | 25 | Lio { 0 26 | n233,[3]n23 27 | n233,[2]n23 28 | n233,[1]n23 29 | n233,[0]n33 30 | 31 | 32 | -------------------------------------------------------------------------------- /apl11/mixed_monadic/ex_rand.c: -------------------------------------------------------------------------------- 1 | /* Copyright U S WEST Advanced Technologies, Inc. 2 | * You may use, copy, modify and sublicense this Software 3 | * subject to the conditions expressed in the file "License". 4 | */ 5 | #include 6 | #include 7 | #include 8 | 9 | #include "apl.h" 10 | 11 | double floor(); 12 | 13 | data ex_rand(data d) 14 | { 15 | double f; 16 | 17 | f = (random() / (float)INT_MAX) * d; 18 | d = floor(f) + iorigin; 19 | return (d); 20 | } 21 | -------------------------------------------------------------------------------- /apl11/utility/Makefile: -------------------------------------------------------------------------------- 1 | # Makefile for utility 2 | 3 | include ../include/makefile.common 4 | CFLAGS += -I../include 5 | 6 | OBJECTS = floating.o iodone.o checksp.o fix.o topfix.o \ 7 | errors.o file.o gamma.o signals.o optable.o \ 8 | extend.o map.o scalar.o fappend.o fuzz.o readline.o 9 | 10 | all: Q.o 11 | 12 | Q.o: $(OBJECTS) 13 | $(LD) -r -o Q.o $(OBJECTS) 14 | 15 | $(OBJECTS): ../include/apl.h 16 | 17 | .c.o: 18 | $(CC) $(CFLAGS) -c $< 19 | 20 | clean: 21 | rm -f $(OBJECTS) core 22 | 23 | -------------------------------------------------------------------------------- /apl11/include/quad_func.h: -------------------------------------------------------------------------------- 1 | /* quad_func.h, Copyright (C) 2016, Greg Johnson 2 | * Released under the terms of the GNU GPL v2.0. 3 | * 4 | * This program is distributed in the hope that it will be useful, 5 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 6 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 7 | * GNU General Public License for more details. 8 | */ 9 | #ifndef QUAD_FUNC_H 10 | #define QUAD_FUNC_H 11 | 12 | void eval_qlx(); 13 | 14 | #endif // QUAD_FUNC_H 15 | -------------------------------------------------------------------------------- /apl11/main/history.h: -------------------------------------------------------------------------------- 1 | /* history.h, Copyright (C) 2016, Greg Johnson 2 | * Released under the terms of the GNU GPL v2.0. 3 | * 4 | * This program is distributed in the hope that it will be useful, 5 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 6 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 7 | * GNU General Public License for more details. 8 | */ 9 | #ifndef HISTORY_H 10 | #define HISTORY_H 11 | 12 | void readline_add_history(char* line); 13 | 14 | #endif 15 | -------------------------------------------------------------------------------- /apl11/mixed_monadic/gd.h: -------------------------------------------------------------------------------- 1 | /* gd.h, Copyright (C) 2016, Greg Johnson 2 | * Released under the terms of the GNU GPL v2.0. 3 | * 4 | * This program is distributed in the hope that it will be useful, 5 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 6 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 7 | * GNU General Public License for more details. 8 | */ 9 | #ifndef GD_H 10 | #define GD_H 11 | 12 | void gd0(int k, int (*f)(const void*, const void*)); 13 | 14 | #endif 15 | -------------------------------------------------------------------------------- /apl11/quad_func/ex_fork.c: -------------------------------------------------------------------------------- 1 | /* Copyright U S WEST Advanced Technologies, Inc. 2 | * You may use, copy, modify and sublicense this Software 3 | * subject to the conditions expressed in the file "License". 4 | */ 5 | #include 6 | 7 | #include "apl.h" 8 | #include "data.h" 9 | #include "utility.h" 10 | 11 | void ex_fork() 12 | { 13 | int pid; 14 | 15 | SECURITY_CHECK; 16 | if ((pid = fork()) == -1) 17 | error(ERR, "could not fork"); 18 | pop(); 19 | iodone(pid); 20 | } 21 | -------------------------------------------------------------------------------- /apl11/sys_command/Makefile: -------------------------------------------------------------------------------- 1 | # Makefile for syscom (system commands) 2 | 3 | include ../include/makefile.common 4 | CFLAGS += -I../include 5 | 6 | OBJECTS = ex_syscom.o ex_prws.o ex_shell.o listdir.o ex_list.o 7 | 8 | all: Q.o 9 | 10 | Q.o: $(OBJECTS) 11 | $(LD) -r -o Q.o $(OBJECTS) 12 | 13 | $(OBJECTS): ../include/apl.h 14 | 15 | ex_prws.o: ../include/char.h 16 | 17 | ex_syscom.o: ../include/opt_codes.h 18 | 19 | .c.o: 20 | $(CC) $(CFLAGS) -c $< 21 | 22 | clean: 23 | rm -f $(OBJECTS) core 24 | 25 | -------------------------------------------------------------------------------- /apl11/include/mixed_monadic.h: -------------------------------------------------------------------------------- 1 | /* mixed_monadic.h, Copyright (C) 2016, Greg Johnson 2 | * Released under the terms of the GNU GPL v2.0. 3 | * 4 | * This program is distributed in the hope that it will be useful, 5 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 6 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 7 | * GNU General Public License for more details. 8 | */ 9 | #ifndef MIXED_MONADIC_H 10 | #define MIXED_MONADIC_H 11 | 12 | void ex_execute(); 13 | 14 | #endif 15 | -------------------------------------------------------------------------------- /apl11/parser/alpha.h: -------------------------------------------------------------------------------- 1 | /* alpha.h, Copyright (C) 2016, Greg Johnson 2 | * Released under the terms of the GNU GPL v2.0. 3 | * 4 | * This program is distributed in the hope that it will be useful, 5 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 6 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 7 | * GNU General Public License for more details. 8 | */ 9 | #ifndef ALPHA_H 10 | #define ALPHA_H 11 | 12 | #include 13 | 14 | bool alpha(int s); 15 | 16 | #endif 17 | -------------------------------------------------------------------------------- /apl11/parser/digit.c: -------------------------------------------------------------------------------- 1 | /* Copyright U S WEST Advanced Technologies, Inc. 2 | * You may use, copy, modify and sublicense this Software 3 | * subject to the conditions expressed in the file "License". 4 | */ 5 | 6 | #include "local_parser.h" 7 | 8 | int digit(char s) 9 | { 10 | if (s >= '0' && s <= '9') 11 | return (1); 12 | return (0); 13 | } 14 | 15 | int isodigit(char c) 16 | { 17 | if (c < '0') 18 | return 0; 19 | if (c > '7') 20 | return 0; 21 | return 1; 22 | } 23 | -------------------------------------------------------------------------------- /apl11/quad_func/ex_kill.c: -------------------------------------------------------------------------------- 1 | /* Copyright U S WEST Advanced Technologies, Inc. 2 | * You may use, copy, modify and sublicense this Software 3 | * subject to the conditions expressed in the file "License". 4 | */ 5 | #include 6 | 7 | #include "apl.h" 8 | #include "utility.h" 9 | #include "data.h" 10 | 11 | void ex_kill() 12 | { 13 | int pid, signo; 14 | 15 | SECURITY_CHECK; 16 | pid = topfix(); 17 | signo = topfix(); 18 | kill(pid, signo); 19 | *sp++ = newdat(DA, 1, 0); 20 | } 21 | -------------------------------------------------------------------------------- /apl11/main/ascii_input.h: -------------------------------------------------------------------------------- 1 | /* ascii_input.h, Copyright (C) 2016, Greg Johnson 2 | * Released under the terms of the GNU GPL v2.0. 3 | * 4 | * This program is distributed in the hope that it will be useful, 5 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 6 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 7 | * GNU General Public License for more details. 8 | */ 9 | #ifndef ASCII_INPUT_H 10 | #define ASCII_INPUT_H 11 | 12 | char* to_ascii_input(char* input); 13 | 14 | #endif 15 | -------------------------------------------------------------------------------- /apl11/include/memory.h: -------------------------------------------------------------------------------- 1 | /* Copyright U S WEST Advanced Technologies, Inc. (AT&T) 2 | * You may use, copy, modify and sublicense this Software 3 | * subject to the conditions expressed in the file "License". 4 | */ 5 | #ifndef MEMORY_H 6 | #define MEMORY_H 7 | 8 | struct memblock { 9 | int* block; 10 | unsigned nbytes; 11 | struct memblock* next; 12 | }; 13 | 14 | struct memblock* firstblock; 15 | extern int mem_trace; 16 | 17 | void afreset(); 18 | int* alloc(); 19 | void aplfree(int* ap); 20 | 21 | #endif 22 | -------------------------------------------------------------------------------- /apl11/include/oper_dyadic.h: -------------------------------------------------------------------------------- 1 | /* oper_dyadic.h, Copyright (C) 2016, Greg Johnson 2 | * Released under the terms of the GNU GPL v2.0. 3 | * 4 | * This program is distributed in the hope that it will be useful, 5 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 6 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 7 | * GNU General Public License for more details. 8 | */ 9 | #ifndef OPER_DYADIC_H 10 | #define OPER_DYADIC_H 11 | 12 | void ex_iprod(); 13 | void ex_asgn(); 14 | 15 | #endif 16 | -------------------------------------------------------------------------------- /apl11/include/print.h: -------------------------------------------------------------------------------- 1 | /* print.h, Copyright (C) 2016, Greg Johnson 2 | * Released under the terms of the GNU GPL v2.0. 3 | * 4 | * This program is distributed in the hope that it will be useful, 5 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 6 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 7 | * GNU General Public License for more details. 8 | */ 9 | #ifndef PRINT_H 10 | #define PRINT_H 11 | 12 | int ex_print(); 13 | 14 | char c_overbar(void); 15 | 16 | #endif // PRINT_H 17 | -------------------------------------------------------------------------------- /apl11/scalar_monadic/ex_exp.c: -------------------------------------------------------------------------------- 1 | /* Copyright U S WEST Advanced Technologies, Inc. 2 | * You may use, copy, modify and sublicense this Software 3 | * subject to the conditions expressed in the file "License". 4 | */ 5 | 6 | #include "apl.h" 7 | #include "utility.h" 8 | #include 9 | 10 | data 11 | ex_exp(d) 12 | data d; 13 | { 14 | double f; 15 | 16 | f = d; 17 | if (f > MAXEXP) 18 | error(ERR_limit, "input value to exp function"); 19 | d = exp(f); 20 | return (d); 21 | } 22 | -------------------------------------------------------------------------------- /apl11/include/mixed_dyadic.h: -------------------------------------------------------------------------------- 1 | /* mixed_dyadic.h, Copyright (C) 2016, Greg Johnson 2 | * Released under the terms of the GNU GPL v2.0. 3 | * 4 | * This program is distributed in the hope that it will be useful, 5 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 6 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 7 | * GNU General Public License for more details. 8 | */ 9 | #ifndef MIXED_DYADIC_H 10 | #define MIXED_DYADIC_H 11 | 12 | void ex_ddom(); 13 | void ex_elid(); 14 | 15 | #endif 16 | -------------------------------------------------------------------------------- /apl11/parser/name.c: -------------------------------------------------------------------------------- 1 | /* Copyright U S WEST Advanced Technologies, Inc. 2 | * You may use, copy, modify and sublicense this Software 3 | * subject to the conditions expressed in the file "License". 4 | */ 5 | #include "data.h" 6 | #include "local_parser.h" 7 | #include "debug.h" 8 | 9 | char* name(char* np, char c) 10 | { 11 | char* p = ccharp; 12 | 13 | *ccharp++ = c; 14 | copy(PTR, (char*)&np, ccharp, 1); 15 | ccharp += SPTR; 16 | 17 | parseDump(oline, ccharp - oline); 18 | 19 | return p; 20 | } 21 | -------------------------------------------------------------------------------- /apl11/scalar_monadic/ex_loge.c: -------------------------------------------------------------------------------- 1 | /* Copyright U S WEST Advanced Technologies, Inc. 2 | * You may use, copy, modify and sublicense this Software 3 | * subject to the conditions expressed in the file "License". 4 | */ 5 | 6 | #include "apl.h" 7 | #include "utility.h" 8 | #include 9 | 10 | data 11 | ex_loge(d) 12 | data d; 13 | { 14 | double f; 15 | 16 | f = d; 17 | if (f <= 0.) 18 | error(ERR_limit, "log of negative number attempted"); 19 | d = log(f); 20 | return (d); 21 | } 22 | -------------------------------------------------------------------------------- /apl11/memory/afreset.c: -------------------------------------------------------------------------------- 1 | /* Copyright U S WEST Advanced Technologies, Inc. 2 | * You may use, copy, modify and sublicense this Software 3 | * subject to the conditions expressed in the file "License". 4 | */ 5 | 6 | #include 7 | #include "memory.h" 8 | 9 | void afreset() 10 | { 11 | struct memblock *item, *next_item; 12 | 13 | for (item = firstblock; item; item = next_item) { 14 | next_item = item->next; 15 | free(item->block); 16 | free(item); 17 | } 18 | firstblock = 0; 19 | } 20 | -------------------------------------------------------------------------------- /apl11/print/c_overbar.c: -------------------------------------------------------------------------------- 1 | /* c_overbar.c, Copyright (C) 2016, Greg Johnson 2 | * Released under the terms of the GNU GPL v2.0. 3 | * 4 | * This program is distributed in the hope that it will be useful, 5 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 6 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 7 | * GNU General Public License for more details. 8 | */ 9 | #include "apl.h" 10 | #include "char.h" 11 | 12 | char c_overbar(void) { 13 | return ascii_characters ? '`' : C_OVERBAR; 14 | } 15 | -------------------------------------------------------------------------------- /apl11/debug/Makefile: -------------------------------------------------------------------------------- 1 | # Makefile for debug 2 | 3 | include ../include/makefile.common 4 | CFLAGS += -I../include 5 | 6 | OBJECTS = code_dump.o stack_dump.o mem_dump.o vars_dump.o parsedump.o 7 | 8 | all: Q.o 9 | 10 | Q.o: $(OBJECTS) 11 | $(LD) -r -o Q.o $(OBJECTS) 12 | 13 | $(OBJECTS): ../include/apl.h 14 | 15 | # Things that depend on characters 16 | code_dump.o: ../include/char.h ../include/opt_codes.h 17 | 18 | mem_dump.o: memory.h 19 | 20 | .c.o: 21 | $(CC) $(CFLAGS) -c $< 22 | 23 | clean: 24 | rm -f $(OBJECTS) core 25 | 26 | -------------------------------------------------------------------------------- /apl11/userfunc/ex_nilret.c: -------------------------------------------------------------------------------- 1 | /* Copyright U S WEST Advanced Technologies, Inc. 2 | * You may use, copy, modify and sublicense this Software 3 | * subject to the conditions expressed in the file "License". 4 | */ 5 | 6 | #include "apl.h" 7 | #include "utility.h" 8 | #include "data.h" 9 | 10 | /* ex_nilret() is called when a user defined function 11 | * does not return a value. It just puts an empty vector 12 | * onto the stack 13 | */ 14 | 15 | void ex_nilret() 16 | { 17 | checksp(); 18 | *sp++ = newdat(NIL, 0, 0); 19 | } 20 | -------------------------------------------------------------------------------- /apl11/include/main.h: -------------------------------------------------------------------------------- 1 | /* main.h, Copyright (C) 2016, Greg Johnson 2 | * Released under the terms of the GNU GPL v2.0. 3 | * 4 | * This program is distributed in the hope that it will be useful, 5 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 6 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 7 | * GNU General Public License for more details. 8 | */ 9 | #ifndef MAIN_LOOP_H 10 | #define MAIN_LOOP_H 11 | 12 | void mainloop(); 13 | void Exit(int s); 14 | char* to_ascii_input(char* input); 15 | 16 | #endif 17 | -------------------------------------------------------------------------------- /apl11/userfunc/ex_br.c: -------------------------------------------------------------------------------- 1 | /* Copyright U S WEST Advanced Technologies, Inc. 2 | * You may use, copy, modify and sublicense this Software 3 | * subject to the conditions expressed in the file "License". 4 | */ 5 | 6 | #include "apl.h" 7 | #include "utility.h" 8 | #include "mixed_dyadic.h" 9 | 10 | void ex_br() 11 | { 12 | struct item* p; 13 | 14 | p = fetch1(); 15 | if (p->size == 0) 16 | return; 17 | gsip->funlc = fix(getdat(p)); 18 | } 19 | 20 | void ex_br0() 21 | { 22 | gsip->funlc = 0; 23 | ex_elid(); 24 | } 25 | -------------------------------------------------------------------------------- /apl11/format/Makefile: -------------------------------------------------------------------------------- 1 | # Makefile for format conversions (ie downtackjot) 2 | 3 | include ../include/makefile.common 4 | CFLAGS += -I../include 5 | 6 | OBJECTS = ex_mfmt.o fp_mfmt.o fp_digits.o fp2char.o\ 7 | ex_dfmt.o fp_dfmt.o fp2char_paded.o 8 | 9 | all: Q.o 10 | 11 | Q.o: $(OBJECTS) 12 | $(LD) -r -o Q.o $(OBJECTS) 13 | 14 | $(OBJECTS): ../include/apl.h ../include/format.h 15 | 16 | #Depends on char.h 17 | fpt2char.o fp2char_paded.o fp_digits.o: ../include/char.h 18 | 19 | .c.o: 20 | $(CC) $(CFLAGS) -c $< 21 | 22 | clean: 23 | rm -f *.o 24 | -------------------------------------------------------------------------------- /apl11/mixed_dyadic/Makefile: -------------------------------------------------------------------------------- 1 | # Makefile for mixed_dyadic (dyadic mixed functions) 2 | 3 | include ../include/makefile.common 4 | CFLAGS += -I../include 5 | 6 | OBJECTS = ex_base.o ex_index.o ex_tak_drp.o ex_ddom.o ex_diot.o \ 7 | ex_rep.o ex_trn.o ex_deal.o ex_eps.o ex_rot.o 8 | 9 | all: Q.o 10 | 11 | Q.o: $(OBJECTS) 12 | $(LD) -r -o Q.o $(OBJECTS) 13 | 14 | $(OBJECTS): ../include/apl.h 15 | 16 | ex_base.o ex_index.o: ../include/opt_codes.h 17 | 18 | .c.o: 19 | $(CC) $(CFLAGS) -c $< 20 | 21 | clean: 22 | rm -f $(OBJECTS) core Q.o 23 | -------------------------------------------------------------------------------- /apl11/struct_monadic/ex_mrho.c: -------------------------------------------------------------------------------- 1 | /* Copyright U S WEST Advanced Technologies, Inc. 2 | * You may use, copy, modify and sublicense this Software 3 | * subject to the conditions expressed in the file "License". 4 | */ 5 | #include "apl.h" 6 | #include "data.h" 7 | 8 | void ex_mrho() 9 | { 10 | struct item *p, *q; 11 | data* dp; 12 | int i; 13 | 14 | p = fetch1(); 15 | q = newdat(DA, 1, p->rank); 16 | dp = q->datap; 17 | for (i = 0; i < p->rank; i++) 18 | *dp++ = p->dim[i]; 19 | pop(); 20 | *sp++ = q; 21 | } 22 | -------------------------------------------------------------------------------- /apl11/include/parser.h: -------------------------------------------------------------------------------- 1 | /* parser.h, Copyright (C) 2016, Greg Johnson 2 | * Released under the terms of the GNU GPL v2.0. 3 | * 4 | * This program is distributed in the hope that it will be useful, 5 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 6 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 7 | * GNU General Public License for more details. 8 | */ 9 | #ifndef PARSER_H 10 | #define PARSER_H 11 | 12 | char* compile_new(int f); 13 | char* compile_old(char* s, int f); 14 | extern int exprOrNullFlag; 15 | 16 | #endif 17 | -------------------------------------------------------------------------------- /apl11/include/quad_var.h: -------------------------------------------------------------------------------- 1 | /* quad_var.h, Copyright (C) 2017, Greg Johnson 2 | * Released under the terms of the GNU GPL v2.0. 3 | * 4 | * This program is distributed in the hope that it will be useful, 5 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 6 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 7 | * GNU General Public License for more details. 8 | */ 9 | #ifndef QUAD_VAR_H 10 | #define QUAD_VAR_H 11 | 12 | #include "apl.h" 13 | 14 | void outputPrintP(); 15 | void updatePrintP(struct item *p); 16 | 17 | #endif // QUAD_VAR_H 18 | -------------------------------------------------------------------------------- /apl11/scalar_dyadic/ex_div.c: -------------------------------------------------------------------------------- 1 | /* Copyright U S WEST Advanced Technologies, Inc. 2 | * You may use, copy, modify and sublicense this Software 3 | * subject to the conditions expressed in the file "License". 4 | */ 5 | 6 | #include "apl.h" 7 | #include "utility.h" 8 | 9 | data 10 | ex_div(d1, d2) 11 | data d1, 12 | d2; 13 | { 14 | /* 0 div 0 is 1 */ 15 | if (d2 == zero) { 16 | if (d1 == zero) 17 | return (one); 18 | else 19 | error(ERR_implicit, "division by 0 attempted"); 20 | } 21 | return (d1 / d2); 22 | } 23 | -------------------------------------------------------------------------------- /apl11/print/local_print.h: -------------------------------------------------------------------------------- 1 | /* local_print.h, Copyright (C) 2016, Greg Johnson 2 | * Released under the terms of the GNU GPL v2.0. 3 | * 4 | * This program is distributed in the hope that it will be useful, 5 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 6 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 7 | * GNU General Public License for more details. 8 | */ 9 | #ifndef LOCAL_PRINT_H 10 | #define LOCAL_PRINT_H 11 | 12 | #include "apl.h" 13 | 14 | int print(); 15 | int fp_print(struct item* p); 16 | int lt_print(struct item* p); 17 | 18 | #endif 19 | -------------------------------------------------------------------------------- /apl11/quad_var/Makefile: -------------------------------------------------------------------------------- 1 | # Makefile for quad_var (quad variables) 2 | 3 | include ../include/makefile.common 4 | CFLAGS += -I../include 5 | 6 | OBJECTS = ex_quad.o ex_qquad.o \ 7 | ex_qav.o ex_qct.o ex_qio.o ex_qlx.o ex_qpp.o ex_qpw.o \ 8 | ex_qts.o ex_qai.o 9 | 10 | all: Q.o 11 | 12 | Q.o: $(OBJECTS) 13 | $(LD) -r -o Q.o $(OBJECTS) 14 | 15 | $(OBJECTS): ../include/apl.h 16 | 17 | # Things that depend on characters 18 | ex_qav.o ex_qlx.o ex_qpp.o ex_qpw.o ex_quad.o : ../include/char.h 19 | 20 | .c.o: 21 | $(CC) $(CFLAGS) -c $< 22 | 23 | clean: 24 | rm -f $(OBJECTS) core 25 | 26 | -------------------------------------------------------------------------------- /apl11/data/dupdat.c: -------------------------------------------------------------------------------- 1 | /* Copyright U S WEST Advanced Technologies, Inc. 2 | * You may use, copy, modify and sublicense this Software 3 | * subject to the conditions expressed in the file "License". 4 | */ 5 | #include "apl.h" 6 | #include "data.h" 7 | 8 | struct item* dupdat(struct item* ap) { 9 | struct item *p1, *p2; 10 | int i; 11 | 12 | p1 = ap; 13 | p2 = newdat(p1->itemType, p1->rank, p1->size); 14 | for (i = 0; i < p1->rank; i++) 15 | p2->dim[i] = p1->dim[i]; 16 | copy(p1->itemType, (char*)p1->datap, (char*)p2->datap, p1->size); 17 | return (p2); 18 | } 19 | -------------------------------------------------------------------------------- /apl11/scalar_dyadic/ex_log.c: -------------------------------------------------------------------------------- 1 | /* Copyright U S WEST Advanced Technologies, Inc. 2 | * You may use, copy, modify and sublicense this Software 3 | * subject to the conditions expressed in the file "License". 4 | */ 5 | 6 | #include "apl.h" 7 | #include "utility.h" 8 | #include 9 | 10 | data 11 | ex_log(d1, d2) 12 | data d1, 13 | d2; 14 | { 15 | double f1, f2; 16 | 17 | f1 = d1; 18 | f2 = d2; 19 | if (f1 <= 0. || f2 <= 0.) 20 | error(ERR_implicit, "log of a negative number attempted"); 21 | d1 = log(f2) / log(f1); 22 | return (d1); 23 | } 24 | -------------------------------------------------------------------------------- /docs/user_guide/Readline: -------------------------------------------------------------------------------- 1 | In order for readline to work, you need to have a ~/.inputrc 2 | file that contains the following: 3 | 4 | $if openapl 5 | set editing-mode emacs 6 | set convert-meta off 7 | set input-meta on 8 | set output-meta on 9 | $endif 10 | 11 | (You can 'set editing-mode vi' if preferred.) 12 | 13 | If the apl script detects an .inputrc file it will pass -r to 14 | apl11 which will then use readline during execution. 15 | 16 | If your .inputrc file does not have the above but you include -r 17 | on the command line, then the special APL characters will not work. 18 | 19 | -------------------------------------------------------------------------------- /apl11/include/debug.h: -------------------------------------------------------------------------------- 1 | /* debug.h, Copyright (C) 2016, Greg Johnson 2 | * Released under the terms of the GNU GPL v2.0. 3 | * 4 | * This program is distributed in the hope that it will be useful, 5 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 6 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 7 | * GNU General Public License for more details. 8 | */ 9 | #ifndef DEBUG_H 10 | #define DEBUG_H 11 | 12 | void vars_dump(); 13 | void mem_dump(); 14 | void code_dump(char* cp, int flag); 15 | void stack_dump(); 16 | void parseDump(char* line, int len); 17 | 18 | #endif 19 | -------------------------------------------------------------------------------- /apl11/main/exit.c: -------------------------------------------------------------------------------- 1 | /* Copyright U S WEST Advanced Technologies, Inc. 2 | * You may use, copy, modify and sublicense this Software 3 | * subject to the conditions expressed in the file "License". 4 | */ 5 | // #include 6 | #include 7 | #include 8 | #include 9 | #include "apl.h" 10 | 11 | void Exit(int s) 12 | { 13 | 14 | int j; 15 | 16 | for (j = 3; j < NFDS; j++) 17 | close(j); 18 | unlink(scr_file); 19 | free(scr_file); 20 | normalExit = 1; /* Set this flag for atexit() */ 21 | exit(s); /* And we're outa here */ 22 | } 23 | -------------------------------------------------------------------------------- /apl11/scalar_dyadic/Makefile: -------------------------------------------------------------------------------- 1 | # Makefile for scalar_dyadic (dyadic scalar functions) 2 | 3 | include ../include/makefile.common 4 | CFLAGS += -I../include 5 | 6 | OBJECTS = ex_cir.o ex_gt.o ex_min.o ex_ne.o ex_pwr.o ex_comb.o \ 7 | ex_le.o ex_minus.o ex_sub.o ex_div.o ex_log.o \ 8 | ex_mod.o ex_nor.o ex_add.o ex_eq.o ex_lt.o ex_mul.o ex_or.o \ 9 | ex_and.o ex_ge.o ex_max.o ex_nand.o ex_plus.o 10 | 11 | all: Q.o 12 | 13 | Q.o: $(OBJECTS) 14 | $(LD) -r -o Q.o $(OBJECTS) 15 | 16 | $(OBJECTS): ../include/apl.h 17 | 18 | .c.o: 19 | $(CC) $(CFLAGS) -c $< 20 | 21 | clean: 22 | rm -f $(OBJECTS) core Q.o 23 | -------------------------------------------------------------------------------- /apl11/data/top.c: -------------------------------------------------------------------------------- 1 | /* Copyright U S WEST Advanced Technologies, Inc. 2 | * You may use, copy, modify and sublicense this Software 3 | * subject to the conditions expressed in the file "License". 4 | */ 5 | #include "apl.h" 6 | #include "utility.h" 7 | #include "data.h" 8 | 9 | double top() 10 | { 11 | struct item* p; 12 | double d; 13 | 14 | p = fetch1(); 15 | if (p->itemType != DA) 16 | error(ERR_implicit, "topval - bad data type"); 17 | if (p->size != 1) 18 | error(ERR_implicit, "topval - size is not 1"); 19 | d = p->datap[0]; 20 | pop(); 21 | return d; 22 | } 23 | -------------------------------------------------------------------------------- /apl11/parser/invert.c: -------------------------------------------------------------------------------- 1 | /* Copyright U S WEST Advanced Technologies, Inc. 2 | * You may use, copy, modify and sublicense this Software 3 | * subject to the conditions expressed in the file "License". 4 | */ 5 | 6 | #include "local_parser.h" 7 | 8 | static void flop(char* a, char* b) 9 | { 10 | char *a1, *a2; 11 | int c; 12 | 13 | a1 = a; 14 | a2 = b; 15 | while (a1 < a2) { 16 | c = *a1; 17 | *a1++ = *--a2; 18 | *a2 = c; 19 | } 20 | } 21 | 22 | void invert(char* a, char* b) 23 | { 24 | flop(a, b); 25 | flop(b, ccharp); 26 | flop(a, ccharp); 27 | } 28 | -------------------------------------------------------------------------------- /apl11/quad_func/iofname.c: -------------------------------------------------------------------------------- 1 | /* Copyright U S WEST Advanced Technologies, Inc. 2 | * You may use, copy, modify and sublicense this Software 3 | * subject to the conditions expressed in the file "License". 4 | */ 5 | 6 | #include "apl.h" 7 | #include "data.h" 8 | #include "utility.h" 9 | static char b[200]; 10 | 11 | char* iofname(int m) 12 | { 13 | struct item* p; 14 | 15 | p = fetch1(); 16 | if (p->itemType != CH || p->rank > 1) 17 | error(ERR_implicit, "file name"); 18 | copy(CH, (char*)p->datap, (char*)b, p->size); 19 | b[p->size] = 0; 20 | pop(); 21 | return (b); 22 | } 23 | -------------------------------------------------------------------------------- /apl11/scalar_monadic/ex_fac.c: -------------------------------------------------------------------------------- 1 | /* Copyright U S WEST Advanced Technologies, Inc. 2 | * You may use, copy, modify and sublicense this Software 3 | * subject to the conditions expressed in the file "License". 4 | */ 5 | 6 | #include "apl.h" 7 | #include "utility.h" 8 | #include 9 | 10 | data 11 | ex_fac(d) 12 | data d; 13 | { 14 | double f; 15 | 16 | f = gamma(d + 1.); 17 | if (f > MAXEXP) 18 | error(ERR_limit, "input to factorial function"); 19 | d = exp(f); 20 | if (signgam < 0) 21 | d = -d; /* if (signgam) in version 6 */ 22 | return (d); 23 | } 24 | -------------------------------------------------------------------------------- /apl11/utility/topfix.c: -------------------------------------------------------------------------------- 1 | /* Copyright U S WEST Advanced Technologies, Inc. 2 | * You may use, copy, modify and sublicense this Software 3 | * subject to the conditions expressed in the file "License". 4 | */ 5 | #include "apl.h" 6 | #include "utility.h" 7 | #include "data.h" 8 | 9 | int topfix() 10 | { 11 | struct item* p; 12 | int i; 13 | 14 | p = fetch1(); 15 | 16 | if (p->itemType != DA) 17 | error(ERR_domain, "topval"); 18 | 19 | if (p->size != 1) 20 | error(ERR_length, "topval"); 21 | 22 | i = fix(p->datap[0]); 23 | 24 | pop(); 25 | 26 | return (i); 27 | } 28 | -------------------------------------------------------------------------------- /qa/struct_monadic.ainp: -------------------------------------------------------------------------------- 1 | C@J Monadic Structural Primitives 2 | 3 | 0 0 0 \ I0 4 | 1 0 1 0 1 \ 4 3 R I12 5 | 0 0 0 \ 4 0 R0 6 | 7 | C@J Ravel 8 | L { n22 { 2 2 R I 4 9 | L { n222 { 2 2 2 R I 8 10 | L { n2221 { 2 2 2 1 R I 8 11 | 12 | ,n22 13 | ,n222 14 | ,n2221 15 | 16 | C@J Shape 17 | L { n { 1 18 | L { n3 { I 3 19 | L { n34 { 3 4 R I 12 20 | 21 | R n 22 | R, n 23 | R R n 24 | R n3 25 | R R n3 26 | R n34 27 | 28 | C@J Index Generator 29 | Lio { 0 30 | I 4 31 | Lio { 1 32 | I 4 33 | 34 | C@J Table - not implemented 35 | C@J Depth - not implemented 36 | C@J Enlist - not implemented 37 | -------------------------------------------------------------------------------- /apl11/userfunc/ex_auto.c: -------------------------------------------------------------------------------- 1 | /* Copyright U S WEST Advanced Technologies, Inc. 2 | * You may use, copy, modify and sublicense this Software 3 | * subject to the conditions expressed in the file "License". 4 | */ 5 | 6 | #include "apl.h" 7 | #include "data.h" 8 | #include "utility.h" 9 | 10 | void ex_auto() 11 | { 12 | SymTabEntry* np; 13 | SymTabEntry* newEntry; 14 | 15 | gsip->ptr += copy(PTR, (char*)gsip->ptr, (char*)&np, 1); 16 | checksp(); 17 | 18 | *sp++ = (struct item*) np; 19 | symtabRemoveEntry(np); 20 | 21 | newEntry = symtabInsert(np->namep); 22 | newEntry->entryType = LV; 23 | } 24 | -------------------------------------------------------------------------------- /apl11/utility/extend.c: -------------------------------------------------------------------------------- 1 | /* Copyright U S WEST Advanced Technologies, Inc. 2 | * You may use, copy, modify and sublicense this Software 3 | * subject to the conditions expressed in the file "License". 4 | */ 5 | #include "apl.h" 6 | #include "utility.h" 7 | #include "data.h" 8 | 9 | /* extend - used by ex_base and ex_iprod */ 10 | struct item* 11 | extend(int ty, int n, data d) 12 | { 13 | int i; 14 | struct item* q; 15 | 16 | if (ty != DA) 17 | error(ERR_domain, "not numeric type"); 18 | q = newdat(ty, 1, n); 19 | for (i = 0; i < n; i++) 20 | q->datap[i] = d; 21 | return (q); 22 | } 23 | -------------------------------------------------------------------------------- /apl11/scalar_dyadic/ex_comb.c: -------------------------------------------------------------------------------- 1 | /* Copyright U S WEST Advanced Technologies, Inc. 2 | * You may use, copy, modify and sublicense this Software 3 | * subject to the conditions expressed in the file "License". 4 | */ 5 | 6 | #include "apl.h" 7 | #include "utility.h" 8 | #include 9 | 10 | data 11 | ex_comb(d1, d2) 12 | data d1, 13 | d2; 14 | { 15 | double f; 16 | 17 | if (d1 > d2) 18 | return (zero); 19 | f = gamma(d2 + 1.) - gamma(d1 + 1.) - gamma(d2 - d1 + 1.); 20 | if (f > MAXEXP) 21 | error(ERR_limit, "input range overflow"); 22 | d1 = exp(f); 23 | return (d1); 24 | } 25 | -------------------------------------------------------------------------------- /apl11/quad_func/ex_pipe.c: -------------------------------------------------------------------------------- 1 | /* Copyright U S WEST Advanced Technologies, Inc. 2 | * You may use, copy, modify and sublicense this Software 3 | * subject to the conditions expressed in the file "License". 4 | */ 5 | #include 6 | 7 | #include "apl.h" 8 | #include "data.h" 9 | #include "utility.h" 10 | 11 | void ex_pipe() 12 | { 13 | struct item* p; 14 | int pp[2]; 15 | 16 | SECURITY_CHECK; 17 | if (pipe(pp) == -1) 18 | p = newdat(DA, 1, 0); 19 | else { 20 | p = newdat(DA, 1, 2); 21 | p->datap[0] = pp[0]; 22 | p->datap[1] = pp[1]; 23 | } 24 | pop(); 25 | *sp++ = p; 26 | } 27 | -------------------------------------------------------------------------------- /apl11/userfunc/ex_label.c: -------------------------------------------------------------------------------- 1 | /* Copyright U S WEST Advanced Technologies, Inc. 2 | * You may use, copy, modify and sublicense this Software 3 | * subject to the conditions expressed in the file "License". 4 | */ 5 | #include "apl.h" 6 | #include "oper_dyadic.h" 7 | 8 | /* 9 | * parser generates the following for each label 10 | * 11 | * AUTO-name CONST NAME-name LABEL 12 | * 13 | * (where CONST is the label address) 14 | */ 15 | 16 | void ex_label() { 17 | SymTabEntry* n; 18 | 19 | ex_asgn(); 20 | n = (SymTabEntry*)sp[-1]; 21 | 22 | // lock out assignments 23 | n->itemp->itemType = LBL; 24 | 25 | sp--; 26 | } 27 | -------------------------------------------------------------------------------- /apl11/data/colapse.c: -------------------------------------------------------------------------------- 1 | /* Copyright U S WEST Advanced Technologies, Inc. 2 | * You may use, copy, modify and sublicense this Software 3 | * subject to the conditions expressed in the file "License". 4 | */ 5 | #include "apl.h" 6 | #include "utility.h" 7 | 8 | void colapse(int k) 9 | { 10 | int i; 11 | 12 | if (k < 0 || k >= idx.rank) 13 | error(ERR_index, "collapse"); 14 | idx.dimk = idx.dim[k]; 15 | idx.delk = idx.del[k]; 16 | for (i = k; i < idx.rank; i++) { 17 | idx.del[i] = idx.del[i + 1]; 18 | idx.dim[i] = idx.dim[i + 1]; 19 | } 20 | if (idx.dimk) 21 | idx.size /= idx.dimk; 22 | idx.rank--; 23 | } 24 | -------------------------------------------------------------------------------- /apl11/quad_func/ex_ap.c: -------------------------------------------------------------------------------- 1 | /* Copyright U S WEST Advanced Technologies, Inc. 2 | * You may use, copy, modify and sublicense this Software 3 | * subject to the conditions expressed in the file "License". 4 | */ 5 | #include 6 | 7 | #include "apl.h" 8 | #include "data.h" 9 | #include "utility.h" 10 | #include "work_space.h" 11 | 12 | void ex_ap() 13 | { 14 | int fd; 15 | struct item* p; 16 | 17 | SECURITY_CHECK; 18 | fd = topfix(); 19 | p = fetch1(); 20 | lseek(fd, 0L, SEEK_END); 21 | fappend(fd, p); 22 | if (p->rank == 1) 23 | writeErrorOnFailure(fd, "\n", 1); 24 | pop(); 25 | *sp++ = newdat(DA, 1, 0); 26 | } 27 | -------------------------------------------------------------------------------- /printer/DESIGN: -------------------------------------------------------------------------------- 1 | Printer Scripts Design Notes 2 | ---------------------------- 3 | Apl2epson and apl2gs are simple shell scripts that set up some 4 | variables, source /etc/apl.sh and ~/.aplrc, and call some real 5 | print filters with the APL2741 font as a parameter. 6 | 7 | It was not possible to use a2ps because it could not be made 8 | to ignore the 8th bit. A2gs worked in this respect, plus its 9 | default font (Courier) is very close to the metrics of apl2741.fnt. 10 | 11 | The original tar file from which apl2741.fnt was extracted contains 12 | instructions for using it with other applications. Refer to the 13 | Credits file for directions to the archive site. 14 | -------------------------------------------------------------------------------- /apl11/data/purge_name.c: -------------------------------------------------------------------------------- 1 | /* openAPL, Copyright (C) Branko Bratkovic 1999 2 | * This file is free software and is covered by the GNU General 3 | * Public License. 4 | * 5 | * This program is distributed in the hope that it will be useful, 6 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 7 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. 8 | * 9 | * For more details see the GNU General Public License (GPL) in 10 | * the docs directory. 11 | */ 12 | 13 | #include "apl.h" 14 | #include "memory.h" 15 | 16 | void purge_name(SymTabEntry* np) { 17 | char* hash = "#"; 18 | 19 | aplfree((int*)np->namep); 20 | np->namep = hash; 21 | } 22 | -------------------------------------------------------------------------------- /apl11/main/history.c: -------------------------------------------------------------------------------- 1 | /* history.c, Copyright (C) 2016, Greg Johnson 2 | * Released under the terms of the GNU GPL v2.0. 3 | * 4 | * This program is distributed in the hope that it will be useful, 5 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 6 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 7 | * GNU General Public License for more details. 8 | */ 9 | #include 10 | #include "config.h" 11 | 12 | #ifdef HAVE_LIBREADLINE 13 | #include 14 | 15 | void readline_add_history(char* line) 16 | { 17 | add_history(line); 18 | } 19 | #else 20 | void readline_add_history(char* line) 21 | { 22 | } 23 | #endif 24 | -------------------------------------------------------------------------------- /apl11/scalar_dyadic/ex_mod.c: -------------------------------------------------------------------------------- 1 | /* Copyright U S WEST Advanced Technologies, Inc. 2 | * You may use, copy, modify and sublicense this Software 3 | * subject to the conditions expressed in the file "License". 4 | */ 5 | 6 | #include "apl.h" 7 | #include 8 | 9 | data 10 | ex_mod(d1, d2) 11 | data d1, 12 | d2; 13 | { 14 | /* x mod 0 is defined to be x */ 15 | if (d1 == zero) 16 | return (d2); 17 | d2 = d2 - d1 * floor(MINFLOAT + d2 / d1); 18 | if (fabs(d2) < tolerance) 19 | return (0); 20 | if (fabs(d2 - d1) < tolerance) 21 | return (0); 22 | if (d2 == d1) 23 | return (0); 24 | return (d2); 25 | } 26 | -------------------------------------------------------------------------------- /apl11/include/work_space.h: -------------------------------------------------------------------------------- 1 | /* work_space.h, Copyright (C) 2016, Greg Johnson 2 | * Released under the terms of the GNU GPL v2.0. 3 | * 4 | * This program is distributed in the hope that it will be useful, 5 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 6 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 7 | * GNU General Public License for more details. 8 | */ 9 | #ifndef WORK_SPACE_H 10 | #define WORK_SPACE_H 11 | 12 | void wsload(int ffile); 13 | void wssave(int ffile); 14 | void clear(); 15 | 16 | void readErrorOnFailure(int fd, void* buf, size_t count); 17 | void writeErrorOnFailure(int fd, void* buf, size_t count); 18 | 19 | #endif 20 | -------------------------------------------------------------------------------- /apl11/utility/fuzz.c: -------------------------------------------------------------------------------- 1 | /* Copyright U S WEST Advanced Technologies, Inc. 2 | * You may use, copy, modify and sublicense this Software 3 | * subject to the conditions expressed in the file "License". 4 | */ 5 | #include "apl.h" 6 | 7 | int fuzz(data d1, data d2) 8 | { 9 | data f1, f2; 10 | 11 | f1 = d1; 12 | if (f1 < 0.) 13 | f1 = -f1; 14 | f2 = d2; 15 | if (f2 < 0.) 16 | f2 = -f2; 17 | if (f2 > f1) 18 | f1 = f2; 19 | f1 *= tolerance; 20 | if (d1 > d2) { 21 | if (d2 + f1 >= d1) 22 | return (0); 23 | return (1); 24 | } 25 | if (d1 + f1 >= d2) 26 | return (0); 27 | return (-1); 28 | } 29 | -------------------------------------------------------------------------------- /apl11/quad_func/ex_signl.c: -------------------------------------------------------------------------------- 1 | /* Copyright U S WEST Advanced Technologies, Inc. 2 | * You may use, copy, modify and sublicense this Software 3 | * subject to the conditions expressed in the file "License". 4 | */ 5 | #include 6 | typedef void (sighandler_t)(int); 7 | 8 | #include "apl.h" 9 | #include "utility.h" 10 | 11 | void ex_signl() 12 | { 13 | int i, j; 14 | 15 | i = topfix(); 16 | j = topfix(); 17 | 18 | if (j == 0) { 19 | iodone(signal(i, SIG_DFL) == SIG_ERR ? -1 : 0); 20 | 21 | } else if (j == 1) { 22 | iodone(signal(i, SIG_IGN) == SIG_ERR ? -1 : 0); 23 | 24 | } else { 25 | error(ERR_domain, "signal"); 26 | } 27 | } 28 | -------------------------------------------------------------------------------- /apl11/memory/DESIGN: -------------------------------------------------------------------------------- 1 | DYNAMIC MEMORY MANAGEMENT 2 | ------------------------- 3 | (This file consists of an attempt to analyse the memory 4 | management functions from apl\11.) 5 | 6 | Throughout the client routines, memory is obtained and released 7 | with alloc() and aplfree(). These are wrappers for malloc(3) 8 | and free(3) and include some additional overheads. 9 | 10 | The module afreset() is used by ws_clear... this provides the 11 | clue to the overheads. afreset() is able to clear all dynamic 12 | memory because a linked list of allocated blocks is maintained 13 | by alloc() and aplfree(). 14 | 15 | The clients which use these functions the most are in the 16 | ../data subdirectory. 17 | -------------------------------------------------------------------------------- /apl11/data/copy.c: -------------------------------------------------------------------------------- 1 | /* Copyright U S WEST Advanced Technologies, Inc. 2 | * You may use, copy, modify and sublicense this Software 3 | * subject to the conditions expressed in the file "License". 4 | */ 5 | #include "apl.h" 6 | 7 | int copy(int type, char* from, char* to, int size) 8 | { 9 | int i; 10 | char *a, *b; 11 | int s; 12 | 13 | if (size == 0) 14 | return (0); 15 | 16 | i = size; 17 | a = from; 18 | b = to; 19 | if (type == DA) 20 | i *= SDAT; 21 | if (type == IN) 22 | i *= SINT; 23 | if (type == PTR) 24 | i *= SPTR; 25 | s = i; 26 | do 27 | *b++ = *a++; 28 | while (--i); 29 | 30 | return (s); 31 | } 32 | -------------------------------------------------------------------------------- /apl11/debug/parsedump.c: -------------------------------------------------------------------------------- 1 | /* parsedump.c, Copyright (C) 2016, Greg Johnson 2 | * Released under the terms of the GNU GPL v2.0. 3 | * 4 | * This program is distributed in the hope that it will be useful, 5 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 6 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 7 | * GNU General Public License for more details. 8 | */ 9 | #include 10 | #include "apl.h" 11 | 12 | void parseDump(char* line, int len) 13 | { 14 | int i; 15 | 16 | if (!code_trace) 17 | return; 18 | 19 | for (i = 0; i < len; ++i) { 20 | fprintf(stderr, "%02x ", 0xff & line[i]); 21 | } 22 | fprintf(stderr, "\n"); 23 | } 24 | -------------------------------------------------------------------------------- /apl11/sys_command/ex_shell.c: -------------------------------------------------------------------------------- 1 | /* Copyright U S WEST Advanced Technologies, Inc. 2 | * You may use, copy, modify and sublicense this Software 3 | * subject to the conditions expressed in the file "License". 4 | */ 5 | #include 6 | 7 | #include "apl.h" 8 | #include "utility.h" 9 | 10 | /* If the environment variable SHELL is defined, attempt to 11 | * execute that shell. If not, or if that exec fails, attempt 12 | * to execute the standard shell, /bin/sh 13 | */ 14 | void ex_shell() 15 | { 16 | char *getenv(), *sh; 17 | 18 | sh = getenv("SHELL"); 19 | if (sh == 0) 20 | sh = "/bin/sh"; 21 | if (system(sh) == -1) 22 | error(ERR, "attempt to start shell failed"); 23 | } 24 | -------------------------------------------------------------------------------- /script/aplrc.in: -------------------------------------------------------------------------------- 1 | #! /bin/sh 2 | # User specific configuration file for openAPL 3 | # DO NOT include any statements that write to stdout (because this 4 | # would appear in the output from the print filters). 5 | 6 | @option_5@ 7 | 8 | # $x11modeswitch is used under X11 to create a modeswitch key 9 | # Only required if a mode switch key has not yet been defined. 10 | #x11modeswitch= 11 | 12 | # $x11map is used under X11 to remap the keyboard. 13 | #x11map= 14 | 15 | # $x11font is the APL X11 font used by X11 terminal and editor 16 | #x11font= 17 | 18 | # $x11terminal is used to host apl11 sessions under X11 19 | #x11terminal= 20 | 21 | # $x11editor is used under X11 to edit apl functions 22 | #x11editor= 23 | 24 | -------------------------------------------------------------------------------- /apl11/userfunc/Makefile: -------------------------------------------------------------------------------- 1 | # Makefile for userfunc (user defined functions) 2 | 3 | include ../include/makefile.common 4 | CFLAGS += -I../include 5 | 6 | OBJECTS = ex_auto.o ex_fun.o ex_nilret.o fundef.o \ 7 | csize.o ex_br.o ex_ibr.o ex_rest.o funedit.o sichk.o \ 8 | ex_arg1.o ex_ibr0.o funread.o tback.o \ 9 | ex_arg2.o ex_label.o funcomp.o funwrite.o 10 | 11 | all: Q.o 12 | 13 | Q.o: $(OBJECTS) 14 | $(LD) -r -o Q.o $(OBJECTS) 15 | 16 | $(OBJECTS): ../include/apl.h 17 | 18 | # Things that depend on characters 19 | ex_fdef.o ex_ibr.o ex_ibr0.o: ../include/char.h 20 | 21 | csize.o funcomp.o: ../include/opt_codes.h 22 | 23 | .c.o: 24 | $(CC) $(CFLAGS) -c $< 25 | 26 | clean: 27 | rm -f $(OBJECTS) core 28 | 29 | -------------------------------------------------------------------------------- /apl11/userfunc/ex_arg1.c: -------------------------------------------------------------------------------- 1 | /* Copyright U S WEST Advanced Technologies, Inc. 2 | * You may use, copy, modify and sublicense this Software 3 | * subject to the conditions expressed in the file "License". 4 | */ 5 | 6 | #include "apl.h" 7 | #include "data.h" 8 | 9 | void ex_arg1() { 10 | struct item* p; 11 | SymTabEntry* np; 12 | SymTabEntry* newEntry; 13 | 14 | gsip->ptr += copy(PTR, (char*) gsip->ptr, (char*) &np, 1); 15 | p = fetch(sp[-1]); 16 | --sp; 17 | 18 | *sp++ = (struct item*) np; 19 | symtabRemoveEntry(np); 20 | 21 | newEntry = symtabInsert(np->namep); 22 | 23 | newEntry->itemp = p; 24 | newEntry->entryType = LV; 25 | newEntry->entryUse = DA; // ??? 26 | } 27 | -------------------------------------------------------------------------------- /apl11/userfunc/funread.c: -------------------------------------------------------------------------------- 1 | /* Copyright U S WEST Advanced Technologies, Inc. 2 | * You may use, copy, modify and sublicense this Software 3 | * subject to the conditions expressed in the file "License". 4 | */ 5 | 6 | #include 7 | #include 8 | #include "apl.h" 9 | #include "utility.h" 10 | #include "userfunc.h" 11 | 12 | int funread(char* fname) { 13 | struct item* p; 14 | int f; 15 | 16 | p = sp[-1]; 17 | sp--; 18 | 19 | if (p->itemType != LV) { error(ERR_value, "not a local variable"); } 20 | 21 | if (fname == 0) { 22 | fname = ((SymTabEntry*)p)->namep; 23 | } 24 | 25 | f = opn(fname, O_RDONLY); 26 | 27 | fundef(f); 28 | 29 | close(f); 30 | 31 | return f; 32 | } 33 | -------------------------------------------------------------------------------- /apl11/work_space/ws_clear.c: -------------------------------------------------------------------------------- 1 | /* Copyright U S WEST Advanced Technologies, Inc. 2 | * You may use, copy, modify and sublicense this Software 3 | * subject to the conditions expressed in the file "License". 4 | */ 5 | #include "apl.h" 6 | #include "memory.h" 7 | #include "data.h" 8 | 9 | void clear() 10 | { 11 | SymTabEntry* n; 12 | 13 | symtabIterateInit(); 14 | while (n = symtabIterate()) { 15 | n->entryUse = 0; 16 | n->itemp = 0; 17 | n->namep = 0; 18 | } 19 | afreset(); /* release all dynamic memory */ 20 | gsip = 0; /* reset state indicator */ 21 | 22 | iorigin = INITIAL_iorigin; 23 | pagewidth = INITIAL_pagewidth; 24 | PrintP = INITIAL_PrintP; 25 | tolerance = INITIAL_tolerance; 26 | } 27 | -------------------------------------------------------------------------------- /apl11/quad_func/ex_wait.c: -------------------------------------------------------------------------------- 1 | /* Copyright U S WEST Advanced Technologies, Inc. 2 | * You may use, copy, modify and sublicense this Software 3 | * subject to the conditions expressed in the file "License". 4 | */ 5 | #include 6 | #include 7 | 8 | #include "apl.h" 9 | #include "data.h" 10 | #include "utility.h" 11 | 12 | void ex_wait() 13 | { 14 | struct item* p; 15 | void (*sig)(int); 16 | pid_t pid; 17 | int s; 18 | 19 | SECURITY_CHECK; 20 | sig = signal(SIGINT, SIG_IGN); 21 | pid = wait(&s); 22 | signal(SIGINT, sig); 23 | p = newdat(DA, 1, 3); 24 | p->datap[0] = pid; 25 | p->datap[1] = s & 0377; 26 | p->datap[2] = (s >> 8) & 0377; 27 | pop(); /* dummy arg */ 28 | *sp++ = p; 29 | } 30 | -------------------------------------------------------------------------------- /apl11/data/putdat.c: -------------------------------------------------------------------------------- 1 | /* Copyright U S WEST Advanced Technologies, Inc. 2 | * You may use, copy, modify and sublicense this Software 3 | * subject to the conditions expressed in the file "License". 4 | */ 5 | #include "apl.h" 6 | #include "utility.h" 7 | 8 | void putdat(struct item* ip, data d) 9 | { 10 | struct item* p; 11 | int i; 12 | 13 | p = ip; 14 | i = p->index; 15 | if (i >= p->size) 16 | error(ERR_botch, "putdat - index exceeds size"); 17 | if (p->itemType == DA) { 18 | p->datap[i] = d; 19 | } 20 | else if (p->itemType == CH) { 21 | ((struct chrstrct*)p->datap)->c[i] = d; 22 | } 23 | else 24 | error(ERR_botch, "putdat - unrecognised type"); 25 | i++; 26 | p->index = i; 27 | } 28 | -------------------------------------------------------------------------------- /apl11/quad_func/ex_write.c: -------------------------------------------------------------------------------- 1 | /* Copyright U S WEST Advanced Technologies, Inc. 2 | * You may use, copy, modify and sublicense this Software 3 | * subject to the conditions expressed in the file "License". 4 | */ 5 | #include 6 | 7 | #include "apl.h" 8 | #include "data.h" 9 | #include "utility.h" 10 | #include "char.h" 11 | 12 | void ex_write() 13 | { 14 | int fd, m; 15 | struct item* p; 16 | int mult; /* Multiplier (data size) */ 17 | 18 | SECURITY_CHECK; 19 | fd = topfix(); 20 | p = fetch1(); 21 | if (p->itemType != CH && p->itemType != DA) 22 | error(ERR_domain, ""); 23 | mult = p->itemType == CH ? 1 : sizeof datum; 24 | m = write(fd, p->datap, p->size * mult) / mult; 25 | pop(); 26 | iodone(m); 27 | } 28 | -------------------------------------------------------------------------------- /apl11/struct_monadic/ex_miot.c: -------------------------------------------------------------------------------- 1 | /* Copyright U S WEST Advanced Technologies, Inc. 2 | * You may use, copy, modify and sublicense this Software 3 | * subject to the conditions expressed in the file "License". 4 | */ 5 | #include "apl.h" 6 | #include "utility.h" 7 | #include "data.h" 8 | 9 | void ex_miot() 10 | { 11 | struct item* p; 12 | data* dp; 13 | int i; 14 | 15 | i = topfix(); 16 | if (i < 0) { /* must allocate something to ")sic" properly */ 17 | *sp++ = newdat(DA, 1, 0); 18 | error(ERR_domain, "right value is less than 0"); 19 | } 20 | p = newdat(DA, 1, i); 21 | dp = p->datap; 22 | datum = iorigin; 23 | for (; i; i--) { 24 | *dp++ = datum; 25 | datum += one; 26 | } 27 | *sp++ = p; 28 | } 29 | -------------------------------------------------------------------------------- /apl11/include/execute.h: -------------------------------------------------------------------------------- 1 | /* execute.h, Copyright (C) 2016, Greg Johnson 2 | * Released under the terms of the GNU GPL v2.0. 3 | * 4 | * This program is distributed in the hope that it will be useful, 5 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 6 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 7 | * GNU General Public License for more details. 8 | */ 9 | #ifndef EXECUTE_H 10 | #define EXECUTE_H 11 | #include "apl.h" 12 | 13 | void execute(); 14 | void ex_dscal(int m, int (*f)(), struct item* p1, struct item* p2); 15 | 16 | void ex_cdyad(data (*f)(), struct item* ap, struct item** ap1); 17 | void ex_mdyad(data (*f)(), struct item* ap, struct item* ap1); 18 | void ex_ddyad(data (*f)(), struct item* ap, struct item* ap1); 19 | 20 | #endif 21 | -------------------------------------------------------------------------------- /script/apl-setup.opt4a: -------------------------------------------------------------------------------- 1 | # look for .inputrc file support for readline 2 | if [ -r $HOME/.inputrc ] 3 | then 4 | if ! { grep "\$if openapl" $HOME/.inputrc > /dev/null ;} 5 | then 6 | # add meta character support to ~.inputrc file 7 | cat <<-STOP >> $HOME/.inputrc 8 | \$if openapl 9 | set editing-mode emacs 10 | set convert-meta off 11 | set input-meta on 12 | set output-meta on 13 | \$endif 14 | STOP 15 | echo -n Added meta character support to ~.inputrc for openapl 16 | fi 17 | else 18 | # create ~.inputrc file 19 | cat <<-STOP > $HOME/.inputrc 20 | \$if openapl 21 | set editing-mode emacs 22 | set convert-meta off 23 | set input-meta on 24 | set output-meta on 25 | \$endif 26 | STOP 27 | echo -n Created ~.inputrc with meta character support for openapl 28 | fi 29 | -------------------------------------------------------------------------------- /apl11/quad_func/ex_seek.c: -------------------------------------------------------------------------------- 1 | /* Copyright U S WEST Advanced Technologies, Inc. 2 | * You may use, copy, modify and sublicense this Software 3 | * subject to the conditions expressed in the file "License". 4 | */ 5 | #include 6 | 7 | #include "apl.h" 8 | #include "data.h" 9 | #include "utility.h" 10 | #include "char.h" 11 | 12 | void ex_seek() 13 | { 14 | struct item* p; 15 | int k1, k3; 16 | long k2; 17 | 18 | SECURITY_CHECK; 19 | p = fetch1(); 20 | if (p->itemType != DA) 21 | error(ERR_domain, ""); 22 | if (p->rank != 1) 23 | error(ERR_rank, ""); 24 | if (p->size != 3) 25 | error(ERR_length, ""); 26 | k1 = p->datap[0]; 27 | k2 = p->datap[1]; 28 | k3 = p->datap[2]; 29 | k1 = lseek(k1, k2, k3); 30 | pop(); 31 | iodone(k1); 32 | } 33 | -------------------------------------------------------------------------------- /apl11/data/Makefile: -------------------------------------------------------------------------------- 1 | # Makefile for data 2 | 3 | include ../include/makefile.common 4 | CFLAGS += -I../include 5 | 6 | OBJECTS = access.o dupdat.o getdata.o putdat.o top.o \ 7 | bidx.o copy.o erase.o newdat.o s2vect.o \ 8 | colapse.o fetch.o nlook.o size.o pop.o purge_name.o \ 9 | data_iterator.o rbtree.o symtab.o 10 | 11 | all: Q.o 12 | 13 | Q.o: $(OBJECTS) 14 | $(LD) -r -o Q.o $(OBJECTS) 15 | 16 | $(OBJECTS): ../include/apl.h 17 | 18 | # Things that depend on characters 19 | fetch.o : ../include/char.h ../include/opt_codes.h 20 | 21 | .c.o: 22 | $(CC) $(CFLAGS) -c $< 23 | 24 | unit_test: data_iterator_unit_test 25 | 26 | data_iterator_unit_test: data_iterator.c 27 | $(CC) $(CFLAGS) -DUNIT_TEST -o data_iterator_unit_test data_iterator.c 28 | 29 | clean: 30 | rm -f $(OBJECTS) core data_iterator_unit_test 31 | 32 | -------------------------------------------------------------------------------- /apl11/parser/getquad.c: -------------------------------------------------------------------------------- 1 | /* Copyright U S WEST Advanced Technologies, Inc. 2 | * You may use, copy, modify and sublicense this Software 3 | * subject to the conditions expressed in the file "License". 4 | */ 5 | 6 | #include "local_parser.h" 7 | #include "y.tab.h" 8 | 9 | extern struct QUOD qtab[]; 10 | #define lv yylval 11 | 12 | int getquad() 13 | { 14 | char* p1; 15 | struct QUOD* p2; 16 | char qbuf[10]; 17 | 18 | p1 = qbuf; 19 | while (alpha(*iline)) 20 | *p1++ = *iline++; 21 | *p1++ = 0; 22 | if (*qbuf == 0) 23 | return (q_var); /* ordinary quad variable*/ 24 | for (p2 = qtab; p2->qname; p2++) { 25 | if (equal(p2->qname, qbuf)) { 26 | lv.charval = p2->qtype; 27 | return (p2->rtype); 28 | } 29 | } 30 | return (unk); 31 | } 32 | -------------------------------------------------------------------------------- /apl11/quad_func/ex_run.c: -------------------------------------------------------------------------------- 1 | /* Copyright U S WEST Advanced Technologies, Inc. 2 | * You may use, copy, modify and sublicense this Software 3 | * subject to the conditions expressed in the file "License". 4 | */ 5 | #include 6 | 7 | #include "apl.h" 8 | #include "data.h" 9 | #include "utility.h" 10 | #include "char.h" 11 | 12 | void ex_run() 13 | { 14 | struct item* p; 15 | char ebuf[100]; 16 | int val; 17 | 18 | SECURITY_CHECK; 19 | p = fetch1(); 20 | if (p->itemType != CH) 21 | error(ERR_domain, ""); 22 | if (p->rank != 1) 23 | error(ERR_rank, ""); 24 | copy(CH, (char*)p->datap, (char*)ebuf, p->size); 25 | ebuf[p->size] = 0; 26 | val = system(ebuf); 27 | p = newdat(DA, 0, 1); 28 | p->datap[0] = (data)val; 29 | pop(); 30 | *sp++ = p; 31 | } 32 | -------------------------------------------------------------------------------- /apl11/work_space/fdat.c: -------------------------------------------------------------------------------- 1 | /* openAPL, Copyright (C) Branko Bratkovic 2000 2 | * This file is free software and is covered by the GNU General 3 | * Public License. 4 | * 5 | * This program is distributed in the hope that it will be useful, 6 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 7 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. 8 | * 9 | * For more details see the GNU General Public License (GPL) in 10 | * the docs directory. 11 | */ 12 | 13 | #include "apl.h" 14 | 15 | void fdat(int f) 16 | { 17 | struct stat b; 18 | struct tm *p, *localtime(); 19 | 20 | fstat(f, &b); 21 | p = localtime(&b.st_mtime); 22 | 23 | printf(" %02d:%02d.%02d", p->tm_hour, p->tm_min, p->tm_sec); 24 | printf(" %02d/%02d/%02d", p->tm_mon + 1, p->tm_mday, p->tm_year % 100); 25 | } 26 | -------------------------------------------------------------------------------- /apl11/quad_func/Makefile: -------------------------------------------------------------------------------- 1 | # Makefile for quad_func (quad functions) 2 | 3 | include ../include/makefile.common 4 | CFLAGS += -I../include 5 | 6 | OBJECTS = eval_qlx.o ex_crp.o ex_float.o ex_open.o ex_seek.o iofname.o \ 7 | ex_ap.o ex_dup.o ex_fork.o ex_pipe.o ex_signl.o \ 8 | ex_chdir.o ex_exec.o ex_kill.o ex_rd.o ex_unlink.o \ 9 | ex_close.o ex_exit.o ex_nc.o ex_read.o ex_wait.o \ 10 | ex_create.o ex_fdef.o ex_nl.o ex_run.o ex_write.o ex_ex.o 11 | 12 | all: Q.o 13 | 14 | Q.o: $(OBJECTS) 15 | $(LD) -r -o Q.o $(OBJECTS) 16 | 17 | $(OBJECTS): ../include/apl.h 18 | 19 | # Things that depend on characters 20 | eval_qlx.o ex_nc.o ex_run.o ex_crp.o ex_exec.o ex_fdef.o \ 21 | ex_nl.o ex_rd.o ex_seek.o ex_write.o : ../include/char.h 22 | 23 | .c.o: 24 | $(CC) $(CFLAGS) -c $< 25 | 26 | clean: 27 | rm -f $(OBJECTS) core 28 | 29 | -------------------------------------------------------------------------------- /apl11/include/userfunc.h: -------------------------------------------------------------------------------- 1 | /* userfunc.h, Copyright (C) 2016, Greg Johnson 2 | * Released under the terms of the GNU GPL v2.0. 3 | * 4 | * This program is distributed in the hope that it will be useful, 5 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 6 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 7 | * GNU General Public License for more details. 8 | */ 9 | #ifndef USERFUNC_H 10 | #define USERFUNC_H 11 | 12 | #include "apl.h" 13 | 14 | void tback(int flag); 15 | void sichk(SymTabEntry* n); 16 | int csize(char* s); 17 | void ex_nilret(); 18 | 19 | void funwrite(char* fname); 20 | void funedit(char* fname); 21 | int funread(char* fname); 22 | int fundef(int f); 23 | void funcomp(SymTabEntry* np); 24 | 25 | void ex_ibr0(); 26 | void ex_br(); 27 | void ex_br0(); 28 | 29 | void eval_qlx(); 30 | 31 | #endif 32 | -------------------------------------------------------------------------------- /apl11/mixed_dyadic/ex_diot.c: -------------------------------------------------------------------------------- 1 | /* Copyright U S WEST Advanced Technologies, Inc. 2 | * You may use, copy, modify and sublicense this Software 3 | * subject to the conditions expressed in the file "License". 4 | */ 5 | 6 | #include "apl.h" 7 | #include "utility.h" 8 | #include "data.h" 9 | 10 | void ex_diot() 11 | { 12 | struct item *p, *q, *r; 13 | int i, j; 14 | 15 | p = fetch2(); 16 | q = sp[-2]; 17 | r = newdat(DA, q->rank, q->size); 18 | copy(IN, (char*)q->dim, (char*)r->dim, q->rank); 19 | for (i = 0; i < q->size; i++) { 20 | datum = getdat(q); 21 | p->index = 0; 22 | for (j = 0; j < p->size; j++) 23 | if (fuzz(getdat(p), datum) == 0) 24 | break; 25 | datum = j + iorigin; 26 | putdat(r, datum); 27 | } 28 | pop(); 29 | pop(); 30 | *sp++ = r; 31 | } 32 | -------------------------------------------------------------------------------- /apl11/quad_func/eval_qlx.c: -------------------------------------------------------------------------------- 1 | /* Copyright U S WEST Advanced Technologies, Inc. 2 | * You may use, copy, modify and sublicense this Software 3 | * subject to the conditions expressed in the file "License". 4 | */ 5 | 6 | #include "apl.h" 7 | #include "data.h" 8 | #include "char.h" 9 | #include "print.h" 10 | #include "mixed_monadic.h" 11 | 12 | /* 13 | * check for latent expr quad LX and evaluate it if found 14 | */ 15 | 16 | void eval_qlx() 17 | { 18 | SymTabEntry* n; 19 | struct item* p; 20 | 21 | if ((n = nlook(S_QUAD "lx")) && n->itemp->itemType == CH && n->itemp->size) { 22 | *sp++ = dupdat(n->itemp); 23 | sandbox = 1; 24 | ex_execute(); 25 | sandbox = sandboxflg; 26 | p = sp[-1]; 27 | if (p->itemType != EL && p->itemType != NIL) 28 | ex_print(); 29 | pop(); 30 | } 31 | } 32 | -------------------------------------------------------------------------------- /apl11/quad_func/ex_read.c: -------------------------------------------------------------------------------- 1 | /* Copyright U S WEST Advanced Technologies, Inc. 2 | * You may use, copy, modify and sublicense this Software 3 | * subject to the conditions expressed in the file "License". 4 | */ 5 | #include 6 | 7 | #include "apl.h" 8 | #include "data.h" 9 | #include "utility.h" 10 | #include "memory.h" 11 | 12 | void ex_read() 13 | { 14 | struct item *p, *q; 15 | int fd, nb, c; 16 | 17 | SECURITY_CHECK; 18 | fd = topfix(); 19 | nb = topfix(); 20 | p = newdat(CH, 1, nb); 21 | c = read(fd, p->datap, nb); 22 | if (c != nb) { 23 | q = p; 24 | if (c <= 0) 25 | p = newdat(CH, 1, 0); 26 | else { 27 | p = newdat(CH, 1, c); 28 | copy(CH, (char*)q->datap, (char*)p->datap, c); 29 | } 30 | aplfree((int*)q); 31 | } 32 | *sp++ = p; 33 | } 34 | -------------------------------------------------------------------------------- /apl11/mixed_monadic/ex_rev.c: -------------------------------------------------------------------------------- 1 | /* Copyright U S WEST Advanced Technologies, Inc. 2 | * You may use, copy, modify and sublicense this Software 3 | * subject to the conditions expressed in the file "License". 4 | */ 5 | 6 | #include "apl.h" 7 | #include "utility.h" 8 | #include "data.h" 9 | 10 | void revk(int k); 11 | 12 | void ex_rev0() 13 | { 14 | fetch1(); 15 | revk(0); 16 | } 17 | 18 | void ex_revk() 19 | { 20 | int k; 21 | 22 | k = topfix() - iorigin; 23 | fetch1(); 24 | revk(k); 25 | } 26 | 27 | void ex_rev() 28 | { 29 | struct item* p; 30 | 31 | p = fetch1(); 32 | revk(p->rank - 1); 33 | } 34 | 35 | void revk(int k) 36 | { 37 | int o; 38 | 39 | bidx(sp[-1]); 40 | if (k < 0 || k >= idx.rank) 41 | error(ERR_index, ""); 42 | o = idx.del[k] * (idx.dim[k] - 1); 43 | idx.del[k] = -idx.del[k]; 44 | map(o); 45 | } 46 | -------------------------------------------------------------------------------- /apl11/mixed_monadic/ex_mdom.c: -------------------------------------------------------------------------------- 1 | /* Copyright U S WEST Advanced Technologies, Inc. 2 | * You may use, copy, modify and sublicense this Software 3 | * subject to the conditions expressed in the file "License". 4 | */ 5 | 6 | #include "apl.h" 7 | #include "utility.h" 8 | #include "data.h" 9 | #include "mixed_dyadic.h" 10 | 11 | void ex_mdom() 12 | { 13 | data* dp; 14 | int a, i, j; 15 | struct item *p, *q; 16 | 17 | p = fetch1(); 18 | if (p->rank != 2) 19 | error(ERR_rank, ""); 20 | a = p->dim[0]; 21 | q = newdat(DA, 2, a * a); 22 | q->dim[0] = a; 23 | q->dim[1] = a; 24 | *sp++ = q; 25 | dp = q->datap; 26 | for (i = 0; i < a; i++) { 27 | for (j = 0; j < a; j++) { 28 | datum = zero; 29 | if (i == j) 30 | datum = one; 31 | *dp++ = datum; 32 | } 33 | } 34 | ex_ddom(); 35 | } 36 | -------------------------------------------------------------------------------- /apl11/mixed_dyadic/ex_eps.c: -------------------------------------------------------------------------------- 1 | /* Copyright U S WEST Advanced Technologies, Inc. 2 | * You may use, copy, modify and sublicense this Software 3 | * subject to the conditions expressed in the file "License". 4 | */ 5 | 6 | #include "apl.h" 7 | #include "utility.h" 8 | #include "data.h" 9 | 10 | void ex_eps() 11 | { 12 | struct item *p, *q, *r; 13 | int i, j; 14 | data d; 15 | 16 | p = fetch2(); 17 | q = sp[-2]; 18 | r = newdat(DA, p->rank, p->size); 19 | copy(IN, (char*)p->dim, (char*)r->dim, p->rank); 20 | for (i = 0; i < p->size; i++) { 21 | datum = getdat(p); 22 | d = zero; 23 | q->index = 0; 24 | for (j = 0; j < q->size; j++) { 25 | if (fuzz(getdat(q), datum) == 0) { 26 | d = one; 27 | break; 28 | } 29 | } 30 | putdat(r, d); 31 | } 32 | pop(); 33 | pop(); 34 | *sp++ = r; 35 | } 36 | -------------------------------------------------------------------------------- /script/apl.opt2a: -------------------------------------------------------------------------------- 1 | # Now do it for Linux console 2 | if [ "$interface" = console ] 3 | then 4 | 5 | # Set the font 6 | if [ "$font_only" != "off" ] ; then 7 | # load the apl font 8 | setfont $consolefont 9 | 10 | # load the key translation table 11 | loadkeys $consolemap 12 | 13 | # select user defined key map 14 | echo -e \\033\(K 15 | fi 16 | 17 | # run the program (unless -on or -off were given) 18 | if [ "$font_only" = "" ] ; then 19 | if [ "$editor" != "" ] ; then 20 | EDITOR=$editor 21 | export EDITOR 22 | else 23 | echo Warning: cannot edit functions until \$editor is set. 24 | echo Use: apl -setup 25 | fi 26 | $aplexe $arglist $rl_flag 27 | fi 28 | 29 | # Finish off 30 | if [ "$font_only" != "on" ] ; then 31 | setfont $defaultfont 32 | loadkeys $defaultmap 33 | echo -e \\033c 34 | fi 35 | fi 36 | -------------------------------------------------------------------------------- /apl11/mixed_monadic/ex_gdd.c: -------------------------------------------------------------------------------- 1 | /* Copyright U S WEST Advanced Technologies, Inc. 2 | * You may use, copy, modify and sublicense this Software 3 | * subject to the conditions expressed in the file "License". 4 | */ 5 | 6 | #include "apl.h" 7 | #include "utility.h" 8 | #include "gd.h" 9 | 10 | int gdd(); 11 | 12 | void ex_gdd() 13 | { 14 | struct item* p; 15 | 16 | p = fetch1(); 17 | gd0(p->rank - 1, gdd); 18 | } 19 | 20 | void ex_gddk() 21 | { 22 | int k; 23 | 24 | k = topfix() - iorigin; 25 | fetch1(); 26 | gd0(k, gdd); 27 | } 28 | 29 | int gdd(int* p1, int* p2) 30 | { 31 | struct item* p; 32 | data d1, d2; 33 | 34 | p = sp[-2]; 35 | p->index = integ + *p1 * idx.delk; 36 | d1 = getdat(p); 37 | p->index = integ + *p2 * idx.delk; 38 | d2 = getdat(p); 39 | if (fuzz(d1, d2) != 0) { 40 | if (d1 > d2) 41 | return (-1); 42 | return (1); 43 | } 44 | return (*p1 - *p2); 45 | } 46 | -------------------------------------------------------------------------------- /apl11/quad_func/ex_rd.c: -------------------------------------------------------------------------------- 1 | /* Copyright U S WEST Advanced Technologies, Inc. 2 | * You may use, copy, modify and sublicense this Software 3 | * subject to the conditions expressed in the file "License". 4 | */ 5 | #include 6 | 7 | #include "apl.h" 8 | #include "data.h" 9 | #include "utility.h" 10 | #include "char.h" 11 | 12 | void ex_rd() 13 | { 14 | /* note: 15 | * an empty line is converted to NULL. 16 | * no '\n' chars are returned. 17 | */ 18 | char buf[200]; 19 | struct item* p; 20 | int fd, i; 21 | 22 | SECURITY_CHECK; 23 | fd = topfix(); 24 | i = 0; 25 | while ((read(fd, &buf[i], 1) == 1) && i < 200 && buf[i] != '\n') 26 | i++; 27 | if (i == 200) 28 | error(ERR_limit, "input buffer overflow"); 29 | if (i > 0) { 30 | p = newdat(CH, 1, i); 31 | copy(CH, (char*)buf, (char*)p->datap, i); 32 | } 33 | else 34 | p = newdat(CH, 1, 0); 35 | *sp++ = p; 36 | } 37 | -------------------------------------------------------------------------------- /apl11/utility/map.c: -------------------------------------------------------------------------------- 1 | /* Copyright U S WEST Advanced Technologies, Inc. 2 | * You may use, copy, modify and sublicense this Software 3 | * subject to the conditions expressed in the file "License". 4 | */ 5 | #include "apl.h" 6 | #include "data.h" 7 | 8 | /* map used by ex_take ex_drop, ex_rev* and trn0 9 | * which is used by ex_dtrn and ex_mtrn 10 | */ 11 | 12 | void map(int o) { 13 | struct item* p; 14 | int n, i; 15 | 16 | n = 1; 17 | 18 | for (i = 0; i < idx.rank; i++) 19 | n *= idx.dim[i]; 20 | 21 | p = newdat(idx.type, idx.rank, n); 22 | 23 | copy(IN, (char*)idx.dim, (char*)p->dim, idx.rank); 24 | *sp++ = p; 25 | 26 | if (n != 0) { 27 | struct item* p = sp[-2]; 28 | 29 | indexIterateInit(&idx); 30 | while (indexIterate(&idx)) { 31 | p->index = access() + o; 32 | putdat(sp[-1], getdat(p)); 33 | } 34 | } 35 | 36 | sp--; 37 | pop(); 38 | *sp++ = p; 39 | } 40 | -------------------------------------------------------------------------------- /apl11/userfunc/ex_ibr.c: -------------------------------------------------------------------------------- 1 | /* Copyright U S WEST Advanced Technologies, Inc. 2 | * You may use, copy, modify and sublicense this Software 3 | * subject to the conditions expressed in the file "License". 4 | */ 5 | 6 | #include "apl.h" 7 | #include "data.h" 8 | #include "utility.h" 9 | #include "char.h" 10 | #include "memory.h" 11 | #include "userfunc.h" 12 | 13 | /* 14 | * monadic immediate branch -- resume fn at specific line 15 | */ 16 | 17 | void ex_ibr() 18 | { 19 | Context* thisContext; 20 | 21 | if (gsip == &prime_context || gsip->prev->suspended == 0) { 22 | error(ERR_implicit, "no suspended fn"); 23 | } 24 | 25 | /* throw away current context */ 26 | thisContext = gsip; 27 | gsip = gsip->prev; 28 | aplfree((int*)thisContext); 29 | 30 | ex_br(); 31 | if (gsip->sp == 0 || sp < gsip->sp) 32 | error(ERR_botch, "stack pointer problem"); 33 | while (sp > gsip->sp) 34 | pop(); 35 | longjmp(gsip->env, 0); /* warp out */ 36 | } 37 | -------------------------------------------------------------------------------- /terminal/linux-i386/fonts/Design.Notes: -------------------------------------------------------------------------------- 1 | 2 | The file in this directory was derived from aply16.psf of the 3 | kbd package. Its contents were re-ordered to match the encoding 4 | selected for openAPL. Strictly speaking this should not have been 5 | necessary as a translation table could have achieved the same 6 | result; it was felt that translation tables are for Unicode systems 7 | and that this 8 bit encoding scheme would be neater with a direct 8 | one to one relationship. Furthermore, any file written with this 9 | encoding could be sent directly to a PostScript(TM) printer 10 | by appending it to the APL PostScript font file. 11 | 12 | Cosmetic changes were subsequently introduced using 'chedit'. This 13 | psf font file editor was discovered under the Linux tree on sunsite. 14 | It doesn't appear to be part of any distribution (as of early 1998) and 15 | it has a few rough edges. 16 | 17 | -- 18 | This file is subject to the restrictions and privileges of the 19 | GNU General Public License. 20 | -------------------------------------------------------------------------------- /apl11/sys_command/listdir.c: -------------------------------------------------------------------------------- 1 | /* Copyright U S WEST Advanced Technologies, Inc. 2 | * You may use, copy, modify and sublicense this Software 3 | * subject to the conditions expressed in the file "License". 4 | */ 5 | #include 6 | 7 | #include "apl.h" 8 | #include "utility.h" 9 | 10 | void listdir() 11 | { 12 | DIR* thisDirectory; 13 | struct dirent* entry; 14 | int i; 15 | 16 | thisDirectory = opendir("."); 17 | if (thisDirectory == 0) 18 | error(ERR_botch, "could not open CWD"); 19 | while (1) { 20 | entry = readdir(thisDirectory); 21 | if (entry == 0) 22 | break; 23 | if (entry->d_ino != 0 && entry->d_name[0] != '.') { 24 | if (column + 10 >= pagewidth) 25 | printf("\n\t"); 26 | for (i = 0; i < 14 && entry->d_name[i]; i++) 27 | putchar(entry->d_name[i]); 28 | putchar('\t'); 29 | } 30 | } 31 | putchar('\n'); 32 | closedir(thisDirectory); 33 | } 34 | -------------------------------------------------------------------------------- /apl11/parser/Makefile: -------------------------------------------------------------------------------- 1 | # Makefile for parser 2 | 3 | include ../include/makefile.common 4 | CFLAGS += -I../include 5 | 6 | OBJECTS = alpha.o genlab.o getquad.o name.o \ 7 | compile_old.o compile_new.o getnam.o invert.o yyerror.o \ 8 | digit.o getnum.o yylex.o \ 9 | table_oper.o table_comm.o table_quad.o \ 10 | lastcode.o y.tab.o 11 | 12 | all: Q.o 13 | 14 | Q.o: $(OBJECTS) 15 | $(LD) -r -o Q.o $(OBJECTS) 16 | 17 | $(OBJECTS): ../include/apl.h local_parser.h 18 | 19 | genlab.o compile_old.o compile_new.o yylex.o lastcode.o apl.y \ 20 | table_comm.o table_oper.o table_quad.o: ../include/opt_codes.h 21 | 22 | y.tab.o: y.tab.c 23 | $(CC) $(CFLAGS) -c y.tab.c 24 | 25 | y.tab.c y.tab.h: apl.y 26 | $(YACC) -d apl.y 27 | 28 | .c.o: 29 | $(CC) $(CFLAGS) -c $< 30 | 31 | getquad.o compile_old.o compile_new.o getnam.o getnum.o yylex.o \ 32 | table_oper.o table_comm.o table_quad.o: y.tab.h 33 | 34 | getnum.o yylex.o table_oper.o: ../include/char.h 35 | 36 | clean: 37 | rm -f $(OBJECTS) core y.tab.c y.tab.h Q.o 38 | 39 | -------------------------------------------------------------------------------- /docs/project/openapl.lsm: -------------------------------------------------------------------------------- 1 | 2 | Begin3 3 | Title: openAPL 4 | Version: 0.14 5 | Entered-date: 01MAY00 6 | Description: A Programming Language (APL) allows the user 7 | to manipulate multi-dimensional arrays through 8 | a grammar that uses special character symbols 9 | to represent functions and operators. openAPL 10 | is a package that provides the special APL font 11 | plus some enhancements for APL\11 - a very old 12 | version of APL. Both the Linux console and X11 13 | can be used to host this font. 14 | This is an ALPHA version. 15 | Keywords: apl APL array vector matrix 16 | Author: 17 | Maintained-by: see the Support file 18 | Primary-site: metalab.unc.edu /pub/Linux/devel/lang/apl 19 | 319k openapl-0.13.tar.gz 20 | Alternate-site: 21 | Original-site: 22 | Platforms: Linux console - requires kbd package 23 | X11 - requires specially compiled rxvt 24 | Postscript printer - requires a2gs 25 | Epson printer - requires fontprint 26 | Copying-policy: GPL 27 | End 28 | -------------------------------------------------------------------------------- /docs/user_guide/WorkSpaces: -------------------------------------------------------------------------------- 1 | 2 | Workspaces are simply UNIX data files. The name of the 3 | workspace is the same as the file name. 4 | 5 | A saved workspace includes function definitions and 6 | variables. If there are suspended functions, all of the 7 | local variables for those functions are also saved. 8 | However, the APL state indicator is not saved, so that those 9 | variables become global in scope when the saved workspace is 10 | loaded. Trying to save the state indicator is very hard in 11 | the current version of the interpreter because of the way 12 | the main program loop is implemented. 13 | 14 | The first time you run apl, a directory named "apl" will 15 | be created in your $HOME directory, this contains the 16 | workspace "continue" which is in turn automatically loaded 17 | on startup - it displays the copyright message. Delete the 18 | file "continue" when you have had enough of it; however, 19 | the "apl" directory in your $HOME directory should remain as 20 | a place to keep openAPL workspaces. 21 | 22 | -------------------------------------------------------------------------------- /apl11/debug/mem_dump.c: -------------------------------------------------------------------------------- 1 | /* openAPL, Copyright (C) Branko Bratkovic 1998 2 | * This file is free software and is covered by the GNU General 3 | * Public License. 4 | * 5 | * This program is distributed in the hope that it will be useful, 6 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 7 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. 8 | * 9 | * For more details see the GNU General Public License (GPL) in 10 | * the docs directory. 11 | */ 12 | 13 | #include 14 | #include "memory.h" 15 | #include "apl.h" 16 | 17 | void mem_dump() 18 | { 19 | struct memblock* item; 20 | printf("Dumping dynamic memory... \n"); 21 | printf("firstblock, points to %x \n", (uintptr_t)firstblock); 22 | 23 | if (firstblock == 0) { 24 | printf("no dynamic memory\n"); 25 | return; 26 | } 27 | for (item = firstblock; item; item = item->next) { 28 | printf("%x points to %d bytes at %x \n", 29 | (uintptr_t)item, item->nbytes, (uintptr_t)item->block); 30 | } 31 | } 32 | -------------------------------------------------------------------------------- /apl11/utility/floating.c: -------------------------------------------------------------------------------- 1 | /* Copyright U S WEST Advanced Technologies, Inc. 2 | * You may use, copy, modify and sublicense this Software 3 | * subject to the conditions expressed in the file "License". 4 | */ 5 | 6 | /* 7 | * Floating-point initialization and trap service 8 | * 9 | */ 10 | 11 | #include 12 | #include "apl.h" 13 | #include "utility.h" 14 | 15 | char* fpelist[] = { 16 | "floating exception", 17 | "integer overflow", 18 | "integer divide by zero", 19 | "floating overflow", 20 | "floating divide by zero", 21 | "floating underflow", 22 | "decimal overflow", 23 | "subscript range", 24 | "floating overflow", 25 | "floating divide by zero", 26 | "floating underflow" 27 | }; 28 | 29 | void fpe(int param) 30 | { 31 | signal(SIGFPE, fpe); 32 | if (param >= sizeof fpelist / sizeof fpelist[0]) 33 | error(ERR, "floating exception"); 34 | else 35 | error(ERR, fpelist[param]); 36 | } 37 | 38 | void fppinit(int arg) 39 | { 40 | signal(SIGFPE, fpe); 41 | } 42 | -------------------------------------------------------------------------------- /apl11/quad_var/ex_qav.c: -------------------------------------------------------------------------------- 1 | /* openAPL, Copyright (C) Branko Bratkovic 1998 2 | * This file is free software and is covered by the GNU General 3 | * Public License. 4 | * 5 | * This program is distributed in the hope that it will be useful, 6 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 7 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. 8 | * 9 | * For more details see the GNU General Public License (GPL) in 10 | * the docs directory. 11 | */ 12 | 13 | #include 14 | #include "apl.h" 15 | #include "utility.h" 16 | #include "data.h" 17 | #include "char.h" 18 | 19 | struct item* ex_qav(io) int io; /* 0 = source, 1 = sink */ 20 | { 21 | struct item* p; 22 | int i; 23 | char* n; 24 | 25 | if (io == 0) { 26 | p = newdat(CH, 1, 256); 27 | n = (char*)p->datap; 28 | for (i = 0; i < p->size; i++) { 29 | *n = i; 30 | n++; 31 | } 32 | return (p); 33 | } 34 | else { 35 | error(ERR_implicit, "cannot change " S_QUAD "av"); 36 | }; 37 | } 38 | -------------------------------------------------------------------------------- /apl11/debug/vars_dump.c: -------------------------------------------------------------------------------- 1 | /* openAPL, Copyright (C) Branko Bratkovic 1999 2 | * This file is free software and is covered by the GNU General 3 | * Public License. 4 | * 5 | * This program is distributed in the hope that it will be useful, 6 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 7 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. 8 | * 9 | * For more details see the GNU General Public License (GPL) in 10 | * the docs directory. 11 | */ 12 | 13 | #include 14 | #include "apl.h" 15 | #include "data.h" 16 | 17 | void vars_dump() 18 | { 19 | SymTabEntry* n; 20 | 21 | symtabIterateInit(); 22 | 23 | while (n = symtabIterate()) { 24 | // for(n=symbolTable; n->namep; n++) { 25 | printf("%x:", (uintptr_t)n); 26 | printf(" namep=%s", n->namep); 27 | printf(" itemp=%x", (uintptr_t)n->itemp); 28 | printf(" use=%d", n->entryUse); 29 | printf(" entryType=%d", n->entryType); 30 | /* printf(" label=%d",n->label); */ 31 | printf("\n"); 32 | } 33 | } 34 | -------------------------------------------------------------------------------- /apl11/userfunc/csize.c: -------------------------------------------------------------------------------- 1 | /* Copyright U S WEST Advanced Technologies, Inc. 2 | * You may use, copy, modify and sublicense this Software 3 | * subject to the conditions expressed in the file "License". 4 | */ 5 | #include "apl.h" 6 | #include "opt_codes.h" 7 | 8 | /* 9 | * csize -- return size (in bytes) of a compiled string 10 | */ 11 | int csize(char* s) { 12 | int c, len; 13 | char* p; 14 | 15 | len = 1; 16 | p = s; 17 | while ((c = *p++) != END) { 18 | int i = 0; 19 | len++; 20 | c &= 0377; 21 | 22 | switch (c) { 23 | default: 24 | break; 25 | 26 | case QUOT: 27 | i = *p++; 28 | break; 29 | 30 | case CONST: 31 | i = *p++; 32 | i *= SDAT; 33 | len++; 34 | break; 35 | 36 | case NAME: case FUN: case ARG1: case ARG2: case AUTO: case REST: case RVAL: 37 | i = SPTR; 38 | break; 39 | } 40 | p += i; 41 | len += i; 42 | } 43 | 44 | return (len); 45 | } 46 | -------------------------------------------------------------------------------- /apl11/include/utility.h: -------------------------------------------------------------------------------- 1 | /* utility.h, Copyright (C) 2016, Greg Johnson 2 | * Released under the terms of the GNU GPL v2.0. 3 | * 4 | * This program is distributed in the hope that it will be useful, 5 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 6 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 7 | * GNU General Public License for more details. 8 | */ 9 | 10 | #ifndef UTILITY_H 11 | #define UTILITY_H 12 | #include 13 | #include "apl.h" 14 | 15 | void error(int type, char* diagnostic); 16 | int topfix(); 17 | int scalar(struct item* aip); 18 | void pline(char* str, int loc, int ln); 19 | int fix(data d); 20 | void checksp(); 21 | void fppinit(int arg); 22 | int fuzz(data d1, data d2); 23 | void map(int o); 24 | void iodone(int ok); 25 | int empty(int fd); 26 | int opn(char file[], int rw); 27 | 28 | void intr(int s); 29 | void panic(int signum); 30 | void catchsigs(); 31 | 32 | void fappend(int fd, struct item* ap); 33 | char* readLine(char* title, char* xLine, int xLineLength, FILE* xInfile); 34 | 35 | #endif // UTILITY_H 36 | -------------------------------------------------------------------------------- /apl11/mixed_monadic/ex_gdu.c: -------------------------------------------------------------------------------- 1 | /* Copyright U S WEST Advanced Technologies, Inc. 2 | * You may use, copy, modify and sublicense this Software 3 | * subject to the conditions expressed in the file "License". 4 | */ 5 | 6 | #include "apl.h" 7 | #include "utility.h" 8 | #include "gd.h" 9 | 10 | int gdu(const int* p1, const int* p2); 11 | 12 | void ex_gdu() 13 | { 14 | struct item* p; 15 | 16 | p = fetch1(); 17 | gd0(p->rank - 1, (int (*)(const void*, const void*))gdu); 18 | } 19 | 20 | void ex_gduk() 21 | { 22 | int k; 23 | 24 | k = topfix() - iorigin; 25 | fetch1(); 26 | gd0(k, (int (*)(const void*, const void*))gdu); 27 | } 28 | 29 | int gdu(const int* p1, const int* p2) 30 | { 31 | struct item* p; 32 | data d1, d2; 33 | 34 | p = sp[-2]; 35 | p->index = integ + *p1 * idx.delk; 36 | d1 = getdat(p); 37 | p->index = integ + *p2 * idx.delk; 38 | d2 = getdat(p); 39 | if (fuzz(d1, d2) != 0) { 40 | if (d1 > d2) 41 | return (1); 42 | return (-1); 43 | } 44 | return (*p1 - *p2); 45 | } 46 | -------------------------------------------------------------------------------- /apl11/quad_func/ex_float.c: -------------------------------------------------------------------------------- 1 | /* Copyright U S WEST Advanced Technologies, Inc. 2 | * You may use, copy, modify and sublicense this Software 3 | * subject to the conditions expressed in the file "License". 4 | */ 5 | 6 | #include "apl.h" 7 | #include "utility.h" 8 | 9 | void ex_float() 10 | { 11 | 12 | /* Convert characters into either double-precision (apl) 13 | * or single-precision (apl2) format. (Involves only 14 | * changing the data type and size declarations. 15 | */ 16 | 17 | struct item* p; 18 | 19 | p = fetch1(); /* Get variable descriptor */ 20 | 21 | if (p->itemType != CH) 22 | error(ERR_domain, ""); /* Must be characters */ 23 | 24 | if (p->rank == 0 /* Scalar */ 25 | || p->dim[(p->rank) - 1] % sizeof datum) /* Bad size */ 26 | error(ERR_length, ""); 27 | 28 | p->dim[p->rank - 1] /= sizeof datum; /* Reduce dimensions */ 29 | p->size /= sizeof datum; /* Reduce size */ 30 | p->itemType = DA; /* Change data type */ 31 | } 32 | -------------------------------------------------------------------------------- /apl11/scalar_dyadic/ex_pwr.c: -------------------------------------------------------------------------------- 1 | /* Copyright U S WEST Advanced Technologies, Inc. 2 | * You may use, copy, modify and sublicense this Software 3 | * subject to the conditions expressed in the file "License". 4 | */ 5 | 6 | #include "apl.h" 7 | #include "utility.h" 8 | #include 9 | 10 | data 11 | ex_pwr(d1, d2) 12 | data d1, 13 | d2; 14 | { 15 | int s; 16 | double f1, f2; 17 | 18 | s = 0; 19 | f1 = d1; 20 | if (f1 > 0.) { 21 | f1 = d2 * log(f1); 22 | goto chk; 23 | } 24 | if (f1 == 0.) 25 | return (d2 == zero ? (data)1.0 : zero); 26 | 27 | /* check for integer exponent */ 28 | f2 = floor(d2); 29 | if (fabs(d2 - f2) < tolerance) { 30 | s = (int)f2 % 2; 31 | f1 = d2 * log(fabs(f1)); 32 | goto chk; 33 | } 34 | /* should check rational d2 here */ 35 | goto bad; 36 | 37 | chk: 38 | if (f1 < MAXEXP) { 39 | d1 = exp(f1); 40 | if (s) 41 | d1 = -d1; 42 | return (d1); 43 | } 44 | bad: 45 | error(ERR_limit, "input range to pwr()"); 46 | } 47 | -------------------------------------------------------------------------------- /apl11/data/getdata.c: -------------------------------------------------------------------------------- 1 | /* Copyright U S WEST Advanced Technologies, Inc. 2 | * You may use, copy, modify and sublicense this Software 3 | * subject to the conditions expressed in the file "License". 4 | */ 5 | #include "apl.h" 6 | #include "utility.h" 7 | #include "data.h" 8 | 9 | data getdat(struct item* ip) { 10 | struct item* p; 11 | int i; 12 | data d; 13 | 14 | /* Get the data value stored at index p->index. If the 15 | * index is out of range it will be wrapped around. If 16 | * the data item is null, a zero or blank will be returned. 17 | */ 18 | 19 | p = ip; 20 | i = p->index; 21 | while (i >= p->size) { 22 | if (p->size == 0) 23 | return ((p->itemType == DA) ? zero : (data)' ') /* let the caller beware */; 24 | i -= p->size; 25 | } 26 | if (p->itemType == DA) { 27 | d = p->datap[i]; 28 | } 29 | else if (p->itemType == CH) { 30 | d = ((struct chrstrct*)p->datap)->c[i]; 31 | } 32 | else 33 | error(ERR_botch, "getdat"); 34 | i++; 35 | p->index = i; 36 | return (d); 37 | } 38 | -------------------------------------------------------------------------------- /apl11/format/ex_mfmt.c: -------------------------------------------------------------------------------- 1 | /* openAPL, Copyright (C) Branko Bratkovic 1999 2 | * This file is free software and is covered by the GNU General 3 | * Public License. 4 | * 5 | * This program is distributed in the hope that it will be useful, 6 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 7 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. 8 | * 9 | * For more details see the GNU General Public License (GPL) in 10 | * the docs directory. 11 | */ 12 | 13 | #include "apl.h" 14 | #include "data.h" 15 | #include "utility.h" 16 | #include "format.h" 17 | 18 | /* monadic format */ 19 | void ex_mfmt() 20 | { 21 | struct item *p, *q; 22 | 23 | p = fetch1(); 24 | switch (p->itemType) { 25 | case DA: 26 | /* convert p from numeric to a literal array */ 27 | q = fp_mfmt(p); 28 | pop(); 29 | *sp++ = q; // put it onto the stack 30 | break; 31 | 32 | case CH: 33 | /* do nothing, pass p unchanged */ 34 | break; 35 | 36 | default: 37 | error(ERR_botch, "attempt to format unsupported type"); 38 | } 39 | } 40 | -------------------------------------------------------------------------------- /apl11/print/print.c: -------------------------------------------------------------------------------- 1 | /* openAPL, Copyright (C) Branko Bratkovic 1999 2 | * This file is free software and is covered by the GNU General 3 | * Public License. 4 | * 5 | * This program is distributed in the hope that it will be useful, 6 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 7 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. 8 | * 9 | * For more details see the GNU General Public License (GPL) in 10 | * the docs directory. 11 | */ 12 | 13 | #include "apl.h" 14 | #include "utility.h" 15 | #include "format.h" 16 | #include "local_print.h" 17 | 18 | int print() 19 | { 20 | struct item* p; 21 | 22 | p = fetch1(); 23 | 24 | if (p->itemType == NIL) { 25 | return (0); 26 | } 27 | 28 | if (p->size == 0) { 29 | return (1); 30 | } 31 | 32 | switch (p->itemType) { 33 | case DA: 34 | fp_print(p); 35 | break; 36 | 37 | case CH: 38 | lt_print(p); 39 | break; 40 | 41 | default: 42 | error(ERR_botch, "attempt to print unsupported type"); 43 | } 44 | 45 | return (1); 46 | } 47 | -------------------------------------------------------------------------------- /apl11/parser/genlab.c: -------------------------------------------------------------------------------- 1 | /* Copyright U S WEST Advanced Technologies, Inc. 2 | * You may use, copy, modify and sublicense this Software 3 | * subject to the conditions expressed in the file "License". 4 | */ 5 | 6 | #include "local_parser.h" 7 | #include "opt_codes.h" 8 | #include "data.h" 9 | 10 | /* 11 | * genlab -- generates label code onto label stacks. 12 | * 13 | * prologue: AUTO-lab, CONST-linenum, NAME-lab LABEL END 14 | * 15 | * epilog: REST-lab END 16 | */ 17 | void genlab(SymTabEntry* np) { 18 | data lnumb; 19 | 20 | // label prologue 21 | 22 | *labcpp++ = AUTO; 23 | labcpp += copy(PTR, (char*)&np, (char*)labcpp, 1); 24 | 25 | *labcpp++ = CONST; 26 | *labcpp++ = 1; 27 | lnumb = (data)lineNumber; 28 | labcpp += copy(DA, (char*)&lnumb, (char*)labcpp, 1); 29 | 30 | *labcpp++ = NAME; 31 | labcpp += copy(PTR, (char*)&np, (char*)labcpp, 1); 32 | 33 | *labcpp++ = LABEL; 34 | 35 | *labcpp = END; 36 | 37 | // label epilog 38 | 39 | *labcpe++ = REST; 40 | labcpe += copy(PTR, (char*)&np, (char*)labcpe, 1); 41 | 42 | *labcpe = END; 43 | } 44 | -------------------------------------------------------------------------------- /apl11/utility/fappend.c: -------------------------------------------------------------------------------- 1 | /* Copyright U S WEST Advanced Technologies, Inc. 2 | * You may use, copy, modify and sublicense this Software 3 | * subject to the conditions expressed in the file "License". 4 | */ 5 | 6 | #include 7 | #include "apl.h" 8 | #include "data.h" 9 | #include "utility.h" 10 | #include "work_space.h" 11 | 12 | void fappend(int fd, struct item* ap) 13 | { 14 | struct item* p; 15 | char* p1; 16 | int i, dim0, dim1; 17 | char b[200]; 18 | 19 | p = ap; 20 | if (p->rank != 2 && p->rank != 1) 21 | error(ERR_rank, ""); 22 | if (p->itemType != CH) 23 | error(ERR_domain, "not character type"); 24 | dim1 = p->dim[1]; 25 | dim0 = p->dim[0]; 26 | if (p->rank == 1) 27 | dim1 = dim0; 28 | p1 = (char*)(p->datap); 29 | if (p->rank == 2) { 30 | for (i = 0; i < dim0; i++) { 31 | copy(CH, p1, b, dim1); 32 | p1 += dim1; 33 | b[dim1] = '\n'; 34 | writeErrorOnFailure(fd, b, dim1 + 1); 35 | } 36 | } 37 | else 38 | writeErrorOnFailure(fd, p->datap, dim0); 39 | } 40 | -------------------------------------------------------------------------------- /apl11/ibeam/ex_dibm.c: -------------------------------------------------------------------------------- 1 | /* Copyright U S WEST Advanced Technologies, Inc. 2 | * You may use, copy, modify and sublicense this Software 3 | * subject to the conditions expressed in the file "License". 4 | */ 5 | #include 6 | 7 | #include "apl.h" 8 | #include "utility.h" 9 | #include "data.h" 10 | 11 | void ex_dibm() { 12 | int arg; 13 | struct item* p; 14 | 15 | /* Dyadic i-beam functions. I-beam 63 assumes that the 16 | * "empty" system call (check whether pipe empty) has been 17 | * implemented in the Unix kernel. 18 | */ 19 | 20 | arg = topfix(); /* Get left argument */ 21 | 22 | switch (topfix()) { 23 | 24 | default: 25 | error(ERR_implicit, "unknown i-beam"); 26 | 27 | case 34: /* "Nice" system call */ 28 | datum = nice(arg); 29 | break; 30 | 31 | case 35: /* "Sleep" system call */ 32 | datum = sleep(arg); 33 | break; 34 | 35 | case 63: /* "Empty" system call */ 36 | datum = empty(arg); 37 | break; 38 | } 39 | 40 | p = newdat(DA, 0, 1); 41 | p->datap[0] = datum; 42 | *sp++ = p; 43 | } 44 | -------------------------------------------------------------------------------- /apl11/parser/lastcode.c: -------------------------------------------------------------------------------- 1 | /* Copyright U S WEST Advanced Technologies, Inc. 2 | * You may use, copy, modify and sublicense this Software 3 | * subject to the conditions expressed in the file "License". 4 | */ 5 | 6 | #include "apl.h" 7 | #include "opt_codes.h" 8 | 9 | int lastCode(char* s) 10 | { 11 | int code, j, last; 12 | 13 | code = 0; 14 | last = 0; 15 | loop: 16 | if (code && code != EOL && code != END) 17 | last = code; 18 | code = *s++; 19 | //if(code != END) code &= 0377; 20 | switch (code) { 21 | 22 | case EOL: 23 | if (*s != EOL) 24 | break; 25 | case END: 26 | return last; 27 | 28 | case QUOT: 29 | j = *s++; 30 | s += j; 31 | break; 32 | 33 | case CONST: 34 | j = *s++; 35 | s += j * SDAT; 36 | break; 37 | 38 | case NAME: 39 | case FUN: 40 | case ARG1: 41 | case ARG2: 42 | case AUTO: 43 | case REST: 44 | case RVAL: 45 | s += SPTR; 46 | break; 47 | 48 | case INDEX: 49 | case IMMED: 50 | s++; 51 | break; 52 | } 53 | goto loop; 54 | } 55 | -------------------------------------------------------------------------------- /docs/project/ToDo: -------------------------------------------------------------------------------- 1 | To Do List, version 0.0 2 | ----------------------- 3 | This list describes what I intend to get done during the ALPHA testing 4 | period. The overall goal is to create a useable APL for GNU/Linux - 5 | diversions for enhancements will be resisted. The list is in 6 | approximate priority order (highest first), however, it could change 7 | in response to something that the ALPHA testers may discover. 8 | -- 9 | Branko 10 | 11 | List begins: 12 | Rewrite the Quality Assurance (QA) scripts to cover as much APL 13 | as possible. 14 | 15 | Improve error reporting beyond the parser. Refer BugList(008) 16 | 17 | Introduce )WSID system function 18 | 19 | Adapt the parser to enable system functions to use variable 20 | length argument lists. Refer BugList(006) 21 | 22 | Create )IMPORT and )EXPORT system functions to deal with 23 | APLASCII and )IN )OUT to deal with *.ATF files. 24 | 25 | Download computer based training from the waterloo site, 26 | import into openAPL and test. 27 | 28 | Introduce a plotting function: possibly shelling out to gnuplot. 29 | 30 | Create the quad expunge function (QuadEX) from existing )erase code. 31 | -------------------------------------------------------------------------------- /apl11/execute/ex_dscal.c: -------------------------------------------------------------------------------- 1 | /* Copyright U S WEST Advanced Technologies, Inc. 2 | * You may use, copy, modify and sublicense this Software 3 | * subject to the conditions expressed in the file "License". 4 | */ 5 | #include "apl.h" 6 | #include "utility.h" 7 | #include "execute.h" 8 | 9 | /* execute dyadic scalar functions 10 | * this routine is called from execute() 11 | * 'm' indicates whether the function may or not operate with char 12 | * this routine makes a decision and passes control to 13 | * one of the specialist routines: 14 | * * ex_cdyad - character dyadic 15 | * * ex_ddyad - floating point dyadic (ie type d) 16 | * * ex_mdyad - mixed dyadic 17 | */ 18 | void ex_dscal(int m, int (*f)(), struct item* p1, struct item* p2) 19 | { 20 | if (p1->itemType != p2->itemType) { 21 | if (m == 2) 22 | ex_mdyad(f, p1, p2); /* modified 9.8.1999/tyl */ 23 | else 24 | error(ERR_domain, "dscal - types do not match"); 25 | } 26 | else if (p1->itemType == CH) { 27 | if (m) 28 | ex_cdyad(f, p1, p2); 29 | else 30 | error(ERR, "dscal - type panic"); 31 | } 32 | else 33 | ex_ddyad(f, p1, p2); 34 | } 35 | -------------------------------------------------------------------------------- /apl11/quad_var/ex_qai.c: -------------------------------------------------------------------------------- 1 | /* openAPL, Copyright (C) Branko Bratkovic 1998 2 | * This file is free software and is covered by the GNU General 3 | * Public License. 4 | * 5 | * This program is distributed in the hope that it will be useful, 6 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 7 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. 8 | * 9 | * For more details see the GNU General Public License (GPL) in 10 | * the docs directory. 11 | */ 12 | 13 | #include 14 | #include 15 | #include 16 | #include 17 | #include "apl.h" 18 | #include "utility.h" 19 | #include "data.h" 20 | 21 | struct item* ex_qai(io) int io; /* 0 = source, 1 = sink */ 22 | { 23 | struct tms t; 24 | struct item* p; 25 | long tv; 26 | 27 | if (io == 0) { 28 | time(&tv); 29 | times(&t); 30 | p = newdat(DA, 1, 4); 31 | p->datap[0] = (data)geteuid(); 32 | p->datap[1] = t.tms_utime + t.tms_cutime; 33 | p->datap[3] = tv - startTime; 34 | p->datap[2] = t.tms_stime + t.tms_cstime; 35 | return (p); 36 | } 37 | else { 38 | error(ERR_implicit, "cannot change accounting info"); 39 | }; 40 | } 41 | -------------------------------------------------------------------------------- /docs/install_guide/pagers: -------------------------------------------------------------------------------- 1 | 2 | FILE PAGERS KNOWN TO WORK WITH APL2741 ENCODING 3 | ----------------------------------------------- 4 | One would not normally want to page APL files under an 5 | openAPL session. However, functions can be written out 6 | to unix files; some of the documentation and all of the QA 7 | test files are encoded in APL2741 so the use of a pager 8 | can be convient at times. Note: in order to to use a pager 9 | to view APL2741 encoding, you should be running a shell 10 | inside an emulated APL terminal, ie following the command: 11 | 12 | $> apl -on 13 | 14 | more 15 | ---- 16 | The classic Unix pager "more" does not attempt to change the 17 | 8th bit which is used to represent APL characters. That is, 18 | it displays raw characters and so is suitable for viewing 19 | APL2741 encoded files. 20 | Tested on version 5.19 (Berkeley) 6/29/88 on a Debian system. 21 | 22 | less 23 | ---- 24 | The more clone "less" can be made to display raw characters 25 | with the option -r. Ease of use can be improved by setting 26 | the environment variable LESS to include this option. 27 | Tested on version 332 28 | 29 | -- 30 | This file is subject to the restrictions and privileges of the 31 | GNU General Public License. 32 | -------------------------------------------------------------------------------- /apl11/userfunc/tback.c: -------------------------------------------------------------------------------- 1 | /* Copyright U S WEST Advanced Technologies, Inc. 2 | * You may use, copy, modify and sublicense this Software 3 | * subject to the conditions expressed in the file "License". 4 | */ 5 | 6 | #include "apl.h" 7 | 8 | /* 9 | * produce trace back info 10 | */ 11 | 12 | char* atfrom[] = { "at\t", "from\t", "", "" }; 13 | 14 | void tback(int flag) 15 | { 16 | Context* thisContext; 17 | int i; 18 | 19 | if (gsip == &prime_context) 20 | return; /* don't attempt to trace state zero */ 21 | else 22 | thisContext = gsip; 23 | i = 0; 24 | if (flag) 25 | i = 2; 26 | while (thisContext != &prime_context) { 27 | if (thisContext->Mode == deffun) { 28 | if (flag == 0 && thisContext->suspended) 29 | return; 30 | if (thisContext->funlc != 1 || i) { /* skip if at line 0 */ 31 | printf("%s%s[%d]%s\n", 32 | atfrom[i], 33 | thisContext->np->namep, 34 | thisContext->funlc - 1, 35 | (thisContext->suspended ? " *" : "")); 36 | i |= 1; 37 | } 38 | } 39 | thisContext = thisContext->prev; 40 | } 41 | } 42 | -------------------------------------------------------------------------------- /apl11/parser/table_comm.c: -------------------------------------------------------------------------------- 1 | /* Copyright U S WEST Advanced Technologies, Inc. 2 | * You may use, copy, modify and sublicense this Software 3 | * subject to the conditions expressed in the file "License". 4 | */ 5 | 6 | #include "char.h" 7 | #include "local_parser.h" 8 | #include "y.tab.h" 9 | #include "opt_codes.h" 10 | 11 | struct COMM comtab[] = { 12 | "clear", comnull, CLEAR, 13 | "continue", comnull, CONTIN, 14 | "copy", comnam, COPY, 15 | "debug", comnull, DEBUG, 16 | "drop", comlist, DROPC, 17 | "license", comnull, LICENSE, 18 | "edit", comnam, EDIT, 19 | "write", comnam, WRITE, 20 | "trace", comnull, TRACE, 21 | "untrace", comnull, UNTRACE, 22 | "erase", comlist, ERASE, 23 | "fns", comnull, FNS, 24 | "lib", comnull, LIB, 25 | "load", comnam, LOAD, 26 | "off", comnull, OFF, 27 | "read", comnam, READ, 28 | "save", comnam, SAVE, 29 | "vars", comnull, VARS, 30 | "script", comnam, SCRIPT, 31 | "si", comnull, SICOM, 32 | "sic", comnull, SICLEAR, 33 | "code", comnam, CODE, 34 | "shell", comnull, SHELL, 35 | "list", comnam, LIST, 36 | "prws", comnull, PRWS, 37 | "memory", comnull, MEMORY, 38 | "digits", comExprOrNull, DIGITS, 39 | 0, unk 40 | }; 41 | -------------------------------------------------------------------------------- /apl11/mixed_dyadic/ex_rep.c: -------------------------------------------------------------------------------- 1 | /* Copyright U S WEST Advanced Technologies, Inc. 2 | * You may use, copy, modify and sublicense this Software 3 | * subject to the conditions expressed in the file "License". 4 | */ 5 | 6 | #include "apl.h" 7 | #include "data.h" 8 | double floor(); 9 | 10 | void ex_rep() 11 | { 12 | struct item *p, *q, *r; 13 | double d1, d2, d3; 14 | data *p1, *p2, *p3; 15 | 16 | p = fetch2(); 17 | q = sp[-2]; 18 | /* 19 | * first map 1 element vectors to scalars: 20 | * 21 | if(scalar(p)) p->rank = 0; 22 | if(scalar(q)) q->rank = 0; 23 | */ 24 | r = newdat(DA, p->rank + q->rank, p->size * q->size); 25 | copy(IN, (char*)p->dim, (char*)r->dim, p->rank); 26 | copy(IN, (char*)q->dim, (char*)r->dim + p->rank, q->rank); 27 | p3 = &r->datap[r->size]; 28 | for (p1 = &p->datap[p->size]; p1 > p->datap;) { 29 | d1 = *--p1; 30 | if (d1 == 0.0) 31 | d1 = 1.0e38; /* all else goes here */ 32 | for (p2 = &q->datap[q->size]; p2 > q->datap;) { 33 | d2 = *--p2; 34 | d3 = d2 /= d1; 35 | *p2 = d2 = floor(d2); 36 | *--p3 = (d3 - d2) * d1; 37 | } 38 | } 39 | pop(); 40 | pop(); 41 | *sp++ = r; 42 | } 43 | -------------------------------------------------------------------------------- /apl11/oper_dyadic/ex_oprod.c: -------------------------------------------------------------------------------- 1 | /* Copyright U S WEST Advanced Technologies, Inc. 2 | * You may use, copy, modify and sublicense this Software 3 | * subject to the conditions expressed in the file "License". 4 | */ 5 | #include "apl.h" 6 | #include "utility.h" 7 | #include "data.h" 8 | 9 | void ex_oprod() 10 | { 11 | int i, j; 12 | data *dp, *dp1, *dp2; 13 | struct item *p, *q, *r; 14 | data (*f)(); 15 | 16 | f = (data*)exop[*gsip->ptr++]; 17 | p = fetch2(); 18 | q = sp[-2]; 19 | if (p->itemType != DA || q->itemType != DA) 20 | error(ERR_domain, "not numeric data"); 21 | /* 22 | * collapse 1 element vectors to scalars 23 | * 24 | if(scalar(p)) p->rank = 0; 25 | if(scalar(q)) q->rank = 0; 26 | */ 27 | bidx(p); 28 | for (i = 0; i < q->rank; i++) 29 | idx.dim[idx.rank++] = q->dim[i]; 30 | r = newdat(DA, idx.rank, size()); 31 | copy(IN, (char*)idx.dim, (char*)r->dim, idx.rank); 32 | dp = r->datap; 33 | dp1 = p->datap; 34 | for (i = 0; i < p->size; i++) { 35 | datum = *dp1++; 36 | dp2 = q->datap; 37 | for (j = 0; j < q->size; j++) 38 | *dp++ = (*f)(datum, *dp2++); 39 | } 40 | pop(); 41 | pop(); 42 | *sp++ = r; 43 | } 44 | -------------------------------------------------------------------------------- /apl11/data/erase.c: -------------------------------------------------------------------------------- 1 | /* Copyright U S WEST Advanced Technologies, Inc. 2 | * You may use, copy, modify and sublicense this Software 3 | * subject to the conditions expressed in the file "License". 4 | */ 5 | #include "apl.h" 6 | #include "memory.h" 7 | #include "utility.h" 8 | 9 | void erase(SymTabEntry* np) 10 | { 11 | struct item* itemp; 12 | int i; 13 | 14 | if (np) { 15 | switch (np->entryUse) { 16 | case CH: 17 | case DA: 18 | case EL: 19 | case QV: 20 | case NIL: 21 | aplfree((int*)np->itemp->datap); 22 | aplfree((int*)np->itemp); 23 | np->itemp = 0; 24 | break; 25 | 26 | case NF: 27 | case MF: 28 | case DF: 29 | // free the p-code that np points to. 30 | for (i = 0; i < np->functionLineLength; ++i) { 31 | aplfree((int*)np->functionLines[i]); 32 | } 33 | if (np->functionLines != NULL) { 34 | aplfree((int*)np->functionLines); 35 | } 36 | 37 | np->functionLines = NULL; 38 | np->functionLineCount = 0; 39 | np->functionLineLength = 0; 40 | } 41 | np->entryUse = UNKNOWN; 42 | } 43 | } 44 | -------------------------------------------------------------------------------- /apl11/memory/aplfree.c: -------------------------------------------------------------------------------- 1 | /* Copyright U S WEST Advanced Technologies, Inc. 2 | * You may use, copy, modify and sublicense this Software 3 | * subject to the conditions expressed in the file "License". 4 | */ 5 | 6 | #include 7 | #include 8 | #include 9 | #include "memory.h" 10 | 11 | void aplfree(int* ap) 12 | { 13 | struct memblock *item, *last; 14 | 15 | if (ap == 0) 16 | return; 17 | 18 | last = 0; 19 | for (item = firstblock; item; item = item->next) { 20 | if (item->block == ap) { 21 | if (last) 22 | last->next = item->next; 23 | else 24 | firstblock = item->next; 25 | 26 | if (mem_trace) { 27 | printf("[aplfree: %d bytes at %x (data)", 28 | item->nbytes, (uintptr_t)item->block); 29 | } 30 | free(item->block); 31 | 32 | if (mem_trace) { 33 | printf(", %d bytes at %x (memblock)]\n", 34 | sizeof(struct memblock), (uintptr_t)item); 35 | } 36 | free(item); 37 | return; 38 | } 39 | last = item; 40 | } 41 | printf("aplfree bad block address %x\n", (uintptr_t)ap); 42 | } 43 | -------------------------------------------------------------------------------- /apl11/userfunc/ex_arg2.c: -------------------------------------------------------------------------------- 1 | /* Copyright U S WEST Advanced Technologies, Inc. 2 | * You may use, copy, modify and sublicense this Software 3 | * subject to the conditions expressed in the file "License". 4 | */ 5 | 6 | #include "apl.h" 7 | #include "data.h" 8 | 9 | void ex_arg2() 10 | { 11 | struct item *p1, *p2; 12 | SymTabEntry *np1, *np2; 13 | SymTabEntry *newEntry1, *newEntry2; 14 | 15 | // get first argument's name 16 | gsip->ptr += copy(PTR, (char*)gsip->ptr, (char*)&np2, 1); 17 | 18 | // skip over ARG1 19 | gsip->ptr++; 20 | 21 | // get second arg's name 22 | gsip->ptr += copy(PTR, (char*)gsip->ptr, (char*)&np1, 1); 23 | 24 | // get first expr to be bound to arg 25 | p1 = fetch(sp[-1]); 26 | --sp; 27 | 28 | // get second one 29 | p2 = fetch(sp[-1]); 30 | --sp; 31 | 32 | *sp++ = (struct item*) np2; 33 | *sp++ = (struct item*) np1; 34 | 35 | newEntry1 = symtabInsert(np1->namep); 36 | newEntry2 = symtabInsert(np2->namep); 37 | 38 | // new arg1 binding 39 | newEntry1->itemp = p1; 40 | newEntry1->entryType = LV; 41 | newEntry1->entryUse = DA; 42 | 43 | // ditto arg2 44 | newEntry2->itemp = p2; 45 | newEntry2->entryType = LV; 46 | newEntry2->entryUse = DA; 47 | } 48 | -------------------------------------------------------------------------------- /apl11/mixed_dyadic/ex_deal.c: -------------------------------------------------------------------------------- 1 | /* Copyright U S WEST Advanced Technologies, Inc. 2 | * You may use, copy, modify and sublicense this Software 3 | * subject to the conditions expressed in the file "License". 4 | */ 5 | #include 6 | #include 7 | 8 | #include "apl.h" 9 | #include "utility.h" 10 | #include "data.h" 11 | 12 | void ex_deal() 13 | { 14 | struct item* p; 15 | int m, n; 16 | double f; 17 | data d1, d2; 18 | 19 | m = topfix(); 20 | n = topfix(); 21 | if (m < 0 || m > n) 22 | error(ERR_length, ""); 23 | p = newdat(DA, 1, m); 24 | datum = iorigin; 25 | for (; n != 0; n--) { 26 | f = m; 27 | f /= n; 28 | if (random() / (float)INT_MAX < f) { 29 | putdat(p, datum); 30 | m--; 31 | } 32 | datum += one; 33 | } 34 | m = p->size; 35 | while (m > 0) { 36 | f = random() / (float)INT_MAX; 37 | n = m * f; 38 | m--; 39 | if (n != m) { 40 | p->index = n; 41 | d1 = getdat(p); 42 | p->index = m; 43 | d2 = getdat(p); 44 | p->index = n; 45 | putdat(p, d2); 46 | p->index = m; 47 | putdat(p, d1); 48 | } 49 | } 50 | *sp++ = p; 51 | } 52 | -------------------------------------------------------------------------------- /apl11/quad_var/ex_qct.c: -------------------------------------------------------------------------------- 1 | /* openAPL, Copyright (C) Branko Bratkovic 1998 2 | * This file is free software and is covered by the GNU General 3 | * Public License. 4 | * 5 | * This program is distributed in the hope that it will be useful, 6 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 7 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. 8 | * 9 | * For more details see the GNU General Public License (GPL) in 10 | * the docs directory. 11 | */ 12 | 13 | #include 14 | #include "apl.h" 15 | #include "data.h" 16 | #include "utility.h" 17 | #include "char.h" 18 | 19 | struct item* ex_qct(io) int io; /* 0 = source, 1 = sink */ 20 | { 21 | struct item* p; 22 | data f; 23 | 24 | if (io == 0) { 25 | p = newdat(DA, 0, 1); 26 | p->datap[0] = tolerance; 27 | return (p); 28 | } 29 | else { 30 | pop(); 31 | p = fetch1(); 32 | 33 | if (p->itemType != DA) 34 | error(ERR_domain, "assign value not numeric"); 35 | 36 | if (p->rank != 0) 37 | error(ERR_rank, "assign value not scalar"); 38 | 39 | f = p->datap[0]; 40 | if (f < 0) 41 | f = -f; 42 | tolerance = f; 43 | sp[-1] = (struct item*)p; 44 | return (0); 45 | }; 46 | } 47 | -------------------------------------------------------------------------------- /apl11/quad_func/ex_nc.c: -------------------------------------------------------------------------------- 1 | /* Copyright U S WEST Advanced Technologies, Inc. 2 | * You may use, copy, modify and sublicense this Software 3 | * subject to the conditions expressed in the file "License". 4 | */ 5 | 6 | #include "apl.h" 7 | #include "data.h" 8 | #include "utility.h" 9 | #include "char.h" 10 | 11 | void ex_nc() 12 | { 13 | SymTabEntry* np; 14 | struct item* p; 15 | int i; 16 | char buf[40]; 17 | 18 | p = fetch1(); 19 | if (p->itemType != CH) 20 | error(ERR_domain, ""); 21 | if (p->size >= 40 || p->rank > 1) 22 | error(ERR_rank, ""); 23 | copy(CH, (char*)p->datap, (char*)buf, p->size); 24 | buf[p->size] = 0; 25 | np = nlook(buf); 26 | i = 0; 27 | if (np != 0) { 28 | switch (np->entryUse) { 29 | case 0: 30 | i = 0; 31 | break; 32 | case MF: 33 | case NF: 34 | case DF: 35 | i = 3; 36 | break; 37 | case DA: 38 | case CH: 39 | case LV: 40 | i = 2; 41 | break; 42 | default: 43 | printf("unknown ", S_QUAD, "nc type = %d\n", np->entryUse); 44 | i = 4; 45 | } 46 | } 47 | p = newdat(DA, 0, 1); 48 | p->datap[0] = i; 49 | pop(); 50 | *sp++ = p; 51 | } 52 | -------------------------------------------------------------------------------- /docs/Copyright: -------------------------------------------------------------------------------- 1 | openAPL, Copyright (C) Branko Bratkovic 1998 2 | 3 | This program is distributed in the hope that it will be useful, 4 | but WITHOUT ANY WARRANTY; without even the implied warranty of 5 | MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. 6 | 7 | openAPL is free software and is covered by the GNU General 8 | Public License; for more details see the file "GPL". 9 | 10 | ---------------------------------------------------------- 11 | openAPL is based on apl\11. Conditions of use for apl\11 are 12 | described in the file "License.original" which provides for 13 | apl\11 to be sublicensed. apl\11 has been modified to create 14 | openAPL which has been sublicensed with the additional 15 | provisions of the GPL applied. 16 | 17 | The copyright holder for apl\11 is: 18 | 19 | U S WEST Advanced Technologies 20 | 4001 Discovery Drive, Boulder, Colorado, 80303 21 | 22 | ---------------------------------------------------------- 23 | The owners and origins of the fonts that were used in the 24 | integration of apl\11 onto the Linux console and into X11 25 | are described in the file "project/Credits". 26 | 27 | ---------------------------------------------------------- 28 | The Postscript(TM) file apl2741.fnt is subject to a copyright 29 | that prevents it being modified. 30 | 31 | -------------------------------------------------------------------------------- /apl11/print/DESIGN: -------------------------------------------------------------------------------- 1 | PRINT ROUTINES 2 | -------------- 3 | The entry points for most print tasks are ex_print and 4 | ex_hprint. These call print() which coordinates most of 5 | the real work. 6 | 7 | Stage 1. The top of the stack is fetch()'ed - so it 8 | stays on the stack and if it is a quad function or 9 | variable, fetch() will convert it into a number. For 10 | data types, fpt_size() is called with every member of the 11 | item as an argument. The goal of this process is to 12 | calculate 4 parameters held in the structure "format" 13 | Next fpt_adjust() is called to determine the width of 14 | the print fields - each numeral will subsequently be printed 15 | in an identical field width. 16 | 17 | not sure what bidx does!! 18 | 19 | Stage 2 - The actual printing. One bigish loop takes 20 | care of printing all the values in the data space. 21 | Character and numeric data types are dealt with 22 | differently: character data is handled on the spot, 23 | numeric data requires a call to fpt2char(). After each 24 | value (character or numeral) is printed, a test is 25 | performed to see if a line feed is required. For 26 | instance: if pagewidth is exceeded or if the end of 27 | a major block (ie "dimension") is reached. 28 | 29 | fpt_size(), fpt_adjust() and fpt2char are in the ../format 30 | directory. 31 | 32 | -------------------------------------------------------------------------------- /apl11/data/pop.c: -------------------------------------------------------------------------------- 1 | /* Copyright U S WEST Advanced Technologies, Inc. 2 | * You may use, copy, modify and sublicense this Software 3 | * subject to the conditions expressed in the file "License". 4 | */ 5 | #include 6 | #include "apl.h" 7 | #include "utility.h" 8 | #include "memory.h" 9 | #include "debug.h" 10 | 11 | void pop() { 12 | struct item* p; 13 | 14 | if (stack_trace) { 15 | printf("pop stack..\n"); 16 | } 17 | 18 | if (sp <= stack) { 19 | error(ERR_botch, "pop - stack underflow"); 20 | } 21 | p = sp[-1]; 22 | if (p) { 23 | switch (p->itemType) { 24 | default: 25 | printf("[bad type: %d]\n", p->itemType); 26 | error(ERR_botch, "pop - unrecognised type"); 27 | break; 28 | 29 | case LBL: 30 | ((SymTabEntry*)p)->entryUse = UNKNOWN; /* delete label */ 31 | 32 | case UNKNOWN: 33 | case LV: 34 | break; 35 | 36 | case DA: 37 | case CH: 38 | aplfree((int*)p->datap); 39 | aplfree((int*)p); 40 | break; 41 | 42 | // case QQ: 43 | // case QD: 44 | case EL: 45 | case NIL: 46 | case QX: 47 | case QV: 48 | aplfree((int*)p); 49 | } 50 | } 51 | sp--; 52 | } 53 | -------------------------------------------------------------------------------- /apl11/memory/alloc.c: -------------------------------------------------------------------------------- 1 | /* Copyright U S WEST Advanced Technologies, Inc. 2 | * You may use, copy, modify and sublicense this Software 3 | * subject to the conditions expressed in the file "License". 4 | */ 5 | 6 | #include 7 | #include 8 | #include "apl.h" 9 | #include "utility.h" 10 | #include "memory.h" 11 | 12 | int* alloc(nbytes) unsigned nbytes; 13 | { 14 | struct memblock* newblock; 15 | 16 | if (nbytes <= 0) 17 | return 0; 18 | newblock = (struct memblock*)malloc(sizeof(struct memblock)); 19 | if (newblock == 0) 20 | goto failed; 21 | if (mem_trace) { 22 | printf("[alloc: %d bytes at %x (memblock)", 23 | sizeof(struct memblock), (uintptr_t)newblock); 24 | } 25 | newblock->nbytes = nbytes; 26 | newblock->block = malloc(nbytes); 27 | if (newblock->block == 0) 28 | goto failed; 29 | if (mem_trace) { 30 | printf(", %d bytes at %x (data)]\n", 31 | nbytes, (uintptr_t)newblock->block); 32 | } 33 | newblock->next = firstblock; 34 | firstblock = newblock; 35 | return newblock->block; 36 | 37 | failed: 38 | printf("Unable to obtain requested memory\n"); 39 | printf("%d bytes were requested\n", nbytes); 40 | error(ERR_interrupt, ""); 41 | //mem_dump(); 42 | //abort(); 43 | } 44 | -------------------------------------------------------------------------------- /apl11/quad_var/ex_qpw.c: -------------------------------------------------------------------------------- 1 | /* openAPL, Copyright (C) Branko Bratkovic 1998 2 | * This file is free software and is covered by the GNU General 3 | * Public License. 4 | * 5 | * This program is distributed in the hope that it will be useful, 6 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 7 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. 8 | * 9 | * For more details see the GNU General Public License (GPL) in 10 | * the docs directory. 11 | */ 12 | 13 | #include 14 | #include "apl.h" 15 | #include "data.h" 16 | #include "utility.h" 17 | #include "char.h" 18 | 19 | struct item* ex_qpw(io) int io; /* 0 = source, 1 = sink */ 20 | { 21 | struct item* p; 22 | int i; 23 | 24 | if (io == 0) { 25 | p = newdat(DA, 0, 1); 26 | p->datap[0] = pagewidth; 27 | return (p); 28 | } 29 | else { 30 | pop(); 31 | p = fetch1(); 32 | if (p->itemType != DA) 33 | error(ERR_domain, "assign value not numeric"); 34 | if (p->rank != 0) 35 | error(ERR_rank, "assign value not scalar"); 36 | i = p->datap[0]; 37 | if (i < 10 || i > 132) 38 | error(ERR_limit, S_QUAD "pw range is 20 to 132"); 39 | pagewidth = i; 40 | sp[-1] = (struct item*)p; 41 | return (0); 42 | }; 43 | } 44 | -------------------------------------------------------------------------------- /configure: -------------------------------------------------------------------------------- 1 | #! /bin/sh 2 | ## This is a BOGUS configure script! 3 | ## The REAL configure script is in the autoconf directory 4 | ## (where the log and cache files are concealed). 5 | args='' 6 | 7 | ## Uncomment and edit the following to change prefix from /usr/local 8 | #args="$args --prefix=/usr" 9 | 10 | ## Uncomment and edit the following to change configuration 11 | ## directory from $prefix/etc 12 | #args="$args --sysconfdir=/etc" 13 | 14 | ## You would uncomment the previous two options in order to install 15 | ## openAPL according to the Linux File System Standard. If that is 16 | ## your goal, then leave the next group alone. 17 | 18 | ## Uncomment the following to force all support files to go under 19 | ## $prefix ; or leave them commented and ./autoconf/configure will guess 20 | ## where they should go according to similar files on your machine. 21 | #export wsdir ; wsdir='${prefix}/share/openAPL' 22 | #export x11share ; x11share='${prefix}/X11' 23 | #export fontdir ; fontdir=${x11share}/fonts 24 | 25 | # Uncomment the following to install epson compatible print filter 26 | #args="$args --enable-epson" 27 | 28 | # Uncomment the following to install ghostscript compatible print filter 29 | #args="$args --enable-ghostscript" 30 | 31 | ## STOP no more user options below this point. 32 | cd autoconf 33 | ./configure $args $* 34 | -------------------------------------------------------------------------------- /apl11/parser/table_quad.c: -------------------------------------------------------------------------------- 1 | /* Copyright U S WEST Advanced Technologies, Inc. 2 | * You may use, copy, modify and sublicense this Software 3 | * subject to the conditions expressed in the file "License". 4 | */ 5 | 6 | #include "char.h" 7 | #include "local_parser.h" 8 | #include "y.tab.h" 9 | #include "opt_codes.h" 10 | 11 | /* 12 | * qtab -- table of valid quad variables and quad functions 13 | * the format of the qtab is the similar to tab, above 14 | * 15 | */ 16 | struct QUOD qtab[] = { 17 | "lx", QLX, q_var, 18 | "av", QAV, q_var, 19 | "ai", QAI, q_var, 20 | "ts", QTS, q_var, 21 | "pp", QPP, q_var, 22 | "pw", QPW, q_var, 23 | "ct", QCT, q_var, 24 | "io", QIO, q_var, 25 | "run", QRUN, m, 26 | "fork", QFORK, m, 27 | "wait", QWAIT, m, 28 | "exec", QEXEC, m, 29 | "cr", QCRP, m, 30 | "fx", FDEF, m, 31 | "exit", QEXIT, m, 32 | "pipe", QPIPE, m, 33 | "chdir", QCHDIR, m, 34 | "open", QOPEN, d, 35 | "close", QCLOSE, m, 36 | "read", QREAD, d, 37 | "write", QWRITE, d, 38 | "creat", QCREAT, d, 39 | "seek", QSEEK, m, 40 | "kill", QKILL, d, 41 | "rd", QRD, m, 42 | "rm", QUNLNK, m, 43 | "dup", QDUP, m, 44 | "ap", QAP, d, 45 | "nc", QNC, m, 46 | "sig", QSIGNL, d, 47 | "float", QFLOAT, m, 48 | "nl", QNL, m, 49 | "ex", QEX, m, 50 | 0 51 | }; 52 | -------------------------------------------------------------------------------- /apl11/mixed_dyadic/ex_base.c: -------------------------------------------------------------------------------- 1 | /* Copyright U S WEST Advanced Technologies, Inc. 2 | * You may use, copy, modify and sublicense this Software 3 | * subject to the conditions expressed in the file "License". 4 | */ 5 | 6 | #include "apl.h" 7 | #include "data.h" 8 | #include "utility.h" 9 | #include "opt_codes.h" 10 | #include "oper_dyadic.h" 11 | 12 | char base_com[] = { ADD, MUL }; 13 | 14 | void ex_base() 15 | { 16 | struct item* extend(); 17 | struct item *p, *q; 18 | int i; 19 | char* savptr; 20 | data d1, d2; 21 | 22 | p = fetch2(); 23 | q = sp[-2]; 24 | if (p->itemType != DA || q->itemType != DA) 25 | error(ERR_domain, "base - incorrect types"); 26 | if (p->rank > 1) 27 | error(ERR_rank, "base - cannot handle left-arg-rank > 1"); 28 | if (scalar(p)) { 29 | if (q->rank > 0) 30 | i = q->dim[0]; 31 | else 32 | i = q->size; 33 | q = extend(DA, i, p->datap[0]); 34 | pop(); 35 | *sp++ = p = q; 36 | q = sp[-2]; 37 | } 38 | d1 = p->datap[p->size - 1]; 39 | p->datap[p->size - 1] = 1.0; 40 | for (i = p->size - 2; i >= 0; i--) { 41 | d2 = p->datap[i]; 42 | p->datap[i] = d1; 43 | d1 *= d2; 44 | } 45 | savptr = gsip->ptr; 46 | gsip->ptr = base_com; 47 | ex_iprod(); 48 | gsip->ptr = savptr; 49 | } 50 | -------------------------------------------------------------------------------- /apl11/quad_var/ex_qio.c: -------------------------------------------------------------------------------- 1 | /* openAPL, Copyright (C) Branko Bratkovic 1998 2 | * This file is free software and is covered by the GNU General 3 | * Public License. 4 | * 5 | * This program is distributed in the hope that it will be useful, 6 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 7 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. 8 | * 9 | * For more details see the GNU General Public License (GPL) in 10 | * the docs directory. 11 | */ 12 | 13 | /* Changed 26.9.1999 by tyl */ 14 | 15 | #include 16 | #include "apl.h" 17 | #include "data.h" 18 | #include "utility.h" 19 | 20 | struct item* ex_qio(io) int io; /* 0 = source, 1 = sink */ 21 | { 22 | struct item* p; 23 | int i; 24 | 25 | if (io == 0) { 26 | p = newdat(DA, 0, 1); 27 | p->datap[0] = iorigin; 28 | return (p); 29 | } 30 | else { 31 | pop(); 32 | p = fetch1(); 33 | 34 | if (p->itemType != DA) 35 | error(ERR_domain, "assign value not numeric"); 36 | 37 | if (p->rank != 0) 38 | error(ERR_rank, "assign value not scalar"); 39 | 40 | i = fix(p->datap[0]); 41 | if (i == 0 || i == 1) 42 | iorigin = (data)i; 43 | else 44 | error(ERR_domain, "assign value not 0 or 1"); 45 | sp[-1] = (struct item*)p; 46 | return (0); 47 | }; 48 | } 49 | -------------------------------------------------------------------------------- /apl11/parser/local_parser.h: -------------------------------------------------------------------------------- 1 | /* Copyright U S WEST Advanced Technologies, Inc. (AT&T) 2 | * You may use, copy, modify and sublicense this Software 3 | * subject to the conditions expressed in the file "License". 4 | */ 5 | #ifndef LOCAL_PARSER_H 6 | #define LOCAL_PARSER_H 7 | 8 | #include 9 | #include "../include/apl.h" 10 | 11 | int vcount; 12 | int scount; 13 | int litflag; 14 | int exprOrNullFlag; 15 | int nlexsym; 16 | int context; 17 | char* iline; 18 | char *ccharp, *ccharp2; 19 | data lnumb; /* current label number */ 20 | char* labcpp; /* label prologue */ 21 | char* labcpe; /* label epilogue */ 22 | int immedcmd; /* immediate command number */ 23 | 24 | int yylex(); 25 | 26 | char* name(char* np, char c); 27 | bool alpha(char s); 28 | int digit(char s); 29 | int isodigit(char c); 30 | int getquad(); 31 | void yyerror(char* error); 32 | void genlab(SymTabEntry* np); 33 | void invert(char* a, char* b); 34 | int getnum(char ic); 35 | int getnam(char ic); 36 | int lastCode(char* s); 37 | 38 | char oline[OBJS]; 39 | 40 | struct OPER { 41 | int input; 42 | int lexval; 43 | int retval; 44 | }; 45 | 46 | struct COMM { 47 | char* ct_name; /* command name string */ 48 | int ct_ytype; /* command type */ 49 | int ct_ylval; /* "yylval" value */ 50 | }; 51 | 52 | struct QUOD { 53 | char* qname; 54 | int qtype; 55 | int rtype; 56 | }; 57 | 58 | #endif 59 | -------------------------------------------------------------------------------- /apl11/quad_func/ex_ex.c: -------------------------------------------------------------------------------- 1 | #include "apl.h" 2 | #include "data.h" 3 | #include "utility.h" 4 | #include "char.h" 5 | 6 | void ex_ex(void) 7 | { 8 | SymTabEntry* np; 9 | struct item *p, *ip; 10 | int i, nlen; 11 | int j, n; 12 | char buf[40]; 13 | 14 | p = fetch1(); 15 | if (p->itemType != CH) 16 | error(ERR_domain, ""); 17 | if (p->rank > 2) 18 | error(ERR_rank, ""); 19 | if (p->rank < 2) { 20 | n = 1; 21 | nlen = p->size; 22 | } 23 | else { 24 | n = p->dim[0]; 25 | nlen = p->dim[1]; 26 | } 27 | if (nlen >= 40) 28 | error(ERR_length, ""); 29 | ip = newdat(DA, 1, n); 30 | 31 | for (j = 0; j < n; j++) { 32 | copy(CH, ((char*)p->datap) + nlen * j, buf, nlen); 33 | buf[nlen] = 0; 34 | for (i = nlen - 1; buf[i] == ' '; i--) 35 | buf[i] = 0; 36 | np = nlook(buf); 37 | i = 0; 38 | if (np != 0) { 39 | if ( np->entryUse == MF 40 | || np->entryUse == NF 41 | || np->entryUse == DF 42 | || np->entryUse == DA 43 | || np->entryUse == CH 44 | || np->entryUse == LV) 45 | { 46 | erase(np); 47 | i = 1; 48 | } 49 | } 50 | ip->datap[j] = i; 51 | } 52 | pop(); 53 | *sp++ = ip; 54 | } 55 | -------------------------------------------------------------------------------- /apl11/sys_command/ex_list.c: -------------------------------------------------------------------------------- 1 | /* Copyright U S WEST Advanced Technologies, Inc. 2 | * You may use, copy, modify and sublicense this Software 3 | * subject to the conditions expressed in the file "License". 4 | */ 5 | #include 6 | #include 7 | #include 8 | 9 | #include "apl.h" 10 | #include "utility.h" 11 | 12 | /* List a function on the terminal */ 13 | void ex_list() { 14 | SymTabEntry* function; 15 | int line; 16 | int i; 17 | 18 | /* Check for valid function */ 19 | 20 | function = (SymTabEntry*)*--sp; 21 | if (function->entryType != LV) 22 | error(ERR_value, "function name not defined"); 23 | 24 | /* If a function, locate it in workspace file and 25 | * print on the terminal in formatted form. 26 | */ 27 | 28 | switch (function->entryUse) { 29 | default: 30 | error(ERR_botch, "cannot find requested function"); 31 | 32 | case NF: 33 | case MF: 34 | case DF: 35 | for (line = 0; line < function->sourceCodeCount; ++line) { 36 | if (line == 0) { 37 | printf(" "); 38 | } else { 39 | printf("[%d] ", line); 40 | } 41 | for (i = 0; i < strlen(function->functionSourceCode[line])-1; ++i) { 42 | printf("%c", function->functionSourceCode[line][i]); 43 | } 44 | } 45 | } 46 | } 47 | -------------------------------------------------------------------------------- /apl11/struct_monadic/ex_rav.c: -------------------------------------------------------------------------------- 1 | /* Copyright U S WEST Advanced Technologies, Inc. 2 | * You may use, copy, modify and sublicense this Software 3 | * subject to the conditions expressed in the file "License". 4 | */ 5 | 6 | #include "apl.h" 7 | #include "data.h" 8 | #include "utility.h" 9 | 10 | static void rav0(int k); 11 | static void rav1(struct item* p, struct item* dest); 12 | 13 | void ex_rav() 14 | { 15 | struct item *p, *r; 16 | 17 | p = fetch1(); 18 | if (p->rank == 0) { 19 | r = newdat(p->itemType, 1, 1); 20 | putdat(r, getdat(p)); 21 | pop(); 22 | *sp++ = r; 23 | return; 24 | } 25 | rav0(p->rank - 1); 26 | } 27 | 28 | void ex_ravk() 29 | { 30 | int i; 31 | 32 | i = topfix() - iorigin; 33 | fetch1(); 34 | rav0(i); 35 | } 36 | 37 | static void rav0(int k) 38 | { 39 | struct item *p, *r; 40 | 41 | p = sp[-1]; 42 | bidx(p); 43 | colapse(k); 44 | r = newdat(p->itemType, 1, p->size); 45 | 46 | indexIterateInit(&idx); 47 | while (indexIterate(&idx)) { 48 | rav1(p, r); 49 | } 50 | 51 | pop(); 52 | *sp++ = r; 53 | } 54 | 55 | static void rav1(struct item* p, struct item* dest) 56 | { 57 | int i, n; 58 | 59 | n = access(); 60 | for (i = 0; i < idx.dimk; i++) { 61 | p->index = n; 62 | putdat(dest, getdat(p)); 63 | n += idx.delk; 64 | } 65 | } 66 | -------------------------------------------------------------------------------- /apl11/format/ex_dfmt.c: -------------------------------------------------------------------------------- 1 | /* openAPL, Copyright (C) Branko Bratkovic 1999 2 | * This file is free software and is covered by the GNU General 3 | * Public License. 4 | * 5 | * This program is distributed in the hope that it will be useful, 6 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 7 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. 8 | * 9 | * For more details see the GNU General Public License (GPL) in 10 | * the docs directory. 11 | */ 12 | 13 | #include "apl.h" 14 | #include "data.h" 15 | #include "utility.h" 16 | #include "format.h" 17 | 18 | /* dyadic format */ 19 | void ex_dfmt() 20 | { 21 | struct item *rp, *lp, *q; 22 | 23 | lp = fetch2(); 24 | rp = sp[-2]; 25 | 26 | switch (lp->itemType) { 27 | case DA: 28 | break; 29 | 30 | case CH: 31 | error(ERR_domain, ""); 32 | break; 33 | 34 | default: 35 | error(ERR_botch, "attempt to format unsupported type"); 36 | } 37 | 38 | switch (rp->itemType) { 39 | case DA: 40 | /* convert rp from numeric to a literal array */ 41 | q = fp_dfmt(lp, rp); 42 | pop(); 43 | pop(); 44 | *sp++ = q; // put it onto the stack 45 | break; 46 | 47 | case CH: 48 | error(ERR_domain, ""); 49 | break; 50 | 51 | default: 52 | error(ERR_botch, "attempt to format unsupported type"); 53 | } 54 | } 55 | -------------------------------------------------------------------------------- /apl11/include/data.h: -------------------------------------------------------------------------------- 1 | /* data.h, Copyright (C) 2016, Greg Johnson 2 | * Released under the terms of the GNU GPL v2.0. 3 | * 4 | * This program is distributed in the hope that it will be useful, 5 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 6 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 7 | * GNU General Public License for more details. 8 | */ 9 | #ifndef DATA_H 10 | #define DATA_H 11 | 12 | #include 13 | #include "apl.h" 14 | 15 | int access(); 16 | 17 | void bidx(struct item* ip); 18 | int copy(int type, char* from, char* to, int size); 19 | void colapse(int k); 20 | void putdat(struct item* ip, data d); 21 | void pop(); 22 | int size(); 23 | 24 | void indexIterateInit(DataIterator* iter); 25 | bool indexIterate(DataIterator* iter); 26 | 27 | void purge_name(SymTabEntry* np); 28 | void erase(SymTabEntry* np); 29 | 30 | struct item* newdat(EntryType type, int rank, int size); 31 | struct item* dupdat(struct item* ap); 32 | 33 | void symtab_init(); 34 | SymTabEntry* symtabFind(char* name); 35 | SymTabEntry* symtabInsert(char* name); 36 | SymTabEntry* symtabEntryCreate(char* name); 37 | void symtabEntryInsert(SymTabEntry* entry); 38 | void symtabDelete(char* name); 39 | void symtabRemoveEntry(SymTabEntry* entry); 40 | 41 | void symtabIterateInit(); 42 | SymTabEntry* symtabIterate(); 43 | 44 | void initFunctionDefnSymbolTable(); 45 | 46 | #endif // DATA_H 47 | -------------------------------------------------------------------------------- /terminal/XFree86/keymap/Design.Notes: -------------------------------------------------------------------------------- 1 | Unlike the Linux console, X11 does not support the full set of 2 | SHIFT, CTRL, and ALT combinations. It recognises shifted and meta 3 | characters plus an alternative produced by the 'Mode Switch' key. 4 | This key can itself be mapped to one of several physical keys. 5 | 6 | OpenAPL under X11 does not support composed symbols (as of this 7 | release). The 'Mode Switch' key is used to produce the APL special 8 | characters. 9 | 10 | Two files are provided for mapping the keyboard. Firstly the 11 | APL character mapping is provided with apl2741.xmap. Second, 12 | modeswitch.xmap is used to set the mode switch key to right ALT. 13 | Both of these must be loaded with xmodmap , once per X11 session is 14 | sufficient but repeating the command for every client does no 15 | (additional) harm. 16 | 17 | You may want to change the mode switch key to your preference. Note 18 | that any shift or meta action associated with your preferred key must 19 | first be removed with the 'clear' command. 20 | 21 | Backspace Key: 22 | After having problems with an inoperative Backspace key under rxvt, 23 | the FAQ for rxvt was consulted, it contained a fix for Linux/X11R6 24 | (ie that keycode 22 be mapped to BackSpace by xmodmap). Accordingly, 25 | the file apl2741.xmap does just that! 26 | 27 | -- 28 | This file is subject to the restrictions and privileges of the 29 | GNU General Public License. 30 | -------------------------------------------------------------------------------- /man/apl2gs.1: -------------------------------------------------------------------------------- 1 | .\" Copyright (C) Branko Bratkovic 1998 2 | .\" This file is free software and is covered by the GNU General 3 | .\" Public License. 4 | .\" 5 | .\" This program is distributed in the hope that it will be useful, 6 | .\" but WITHOUT ANY WARRANTY; without even the implied warranty of 7 | .\" MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. 8 | .\" 9 | .\" For more details see the GNU General Public License (GPL) in 10 | .\" the docs directory. 11 | .TH apl2gs 1 "6 December 1998" "openAPL" 12 | .SH NAME 13 | apl2gs 14 | .SH SYNOPSIS 15 | apl2gs 16 | [ 17 | .I options to a2gs 18 | ] 19 | [ filename ] 20 | 21 | .SH DESCRIPTION 22 | The language APL uses a special character set. 23 | .I apl2gs 24 | is a print filter that will convert APL text 25 | (which must be encoded by the 2741 system used in openAPL) 26 | into a Ghostscript file. 27 | If a filename is provided, that file will be converted, 28 | otherwise stdin is used. 29 | 30 | .SH OPTIONS 31 | apl2gs uses a2gs(1) and any options provided on the 32 | command line will be passed to a2gs. 33 | 34 | .SH CONFIGURATION 35 | .LP 36 | If the files 37 | .I /etc/apl.sh 38 | or 39 | .I .aplrc 40 | (in the users home directory) exit, 41 | they will be sourced after internal variables are created, 42 | but before any actions are taken. 43 | This enables the system administrator or user to specify a list 44 | of options to pass to a2gs. 45 | 46 | .SH "SEE ALSO" 47 | apl(1), apl11(1) 48 | 49 | -------------------------------------------------------------------------------- /apl11/parser/compile_new.c: -------------------------------------------------------------------------------- 1 | /* Copyright U S WEST Advanced Technologies, Inc. 2 | * You may use, copy, modify and sublicense this Software 3 | * subject to the conditions expressed in the file "License". 4 | */ 5 | 6 | #include "utility.h" 7 | #include "local_parser.h" 8 | #include "y.tab.h" 9 | #include "opt_codes.h" 10 | #include "memory.h" 11 | #include "debug.h" 12 | 13 | /* f is execution flag: 14 | * 0 compile immediate 15 | * 1 compile quad input 16 | * 2 function definition 17 | * 3 function prolog 18 | * 4 function epilog 19 | * 5 function body 20 | */ 21 | int ilex[] = { 22 | lex0, lex1, lex2, lex3, lex4, lex5 23 | }; 24 | 25 | char* compile_new(int f) { 26 | char *p, *q; 27 | 28 | iline = gsip->text; 29 | ccharp = oline; 30 | litflag = 0; 31 | nlexsym = ilex[f]; 32 | context = nlexsym; 33 | compilePhase = (CompilePhase) f; 34 | 35 | if (code_trace) 36 | fprintf(stderr, "\n\nabout to yyparse.. iline: >>%s<<\n\n", iline); 37 | 38 | if (yyparse()) { 39 | //print line and error pointer 40 | pline(gsip->text, iline - (gsip->text), lineNumber); 41 | return (0); 42 | } 43 | 44 | *ccharp++ = END; 45 | 46 | parseDump(oline, ccharp - oline); 47 | 48 | iline = (char*)alloc(ccharp - oline); 49 | 50 | p = iline; 51 | for (q = oline; q < ccharp; ++q) 52 | *p++ = *q; 53 | 54 | gsip->pcode = iline; 55 | 56 | return (iline); 57 | } 58 | -------------------------------------------------------------------------------- /apl11/print/lt_print.c: -------------------------------------------------------------------------------- 1 | /* openAPL, Copyright (C) Branko Bratkovic 1999 2 | * This file is free software and is covered by the GNU General 3 | * Public License. 4 | * 5 | * This program is distributed in the hope that it will be useful, 6 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 7 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. 8 | * 9 | * For more details see the GNU General Public License (GPL) in 10 | * the docs directory. 11 | */ 12 | 13 | #include "apl.h" 14 | #include "format.h" 15 | #include "data.h" 16 | 17 | /* Print literals */ 18 | int lt_print(struct item* p) 19 | { 20 | int i, j; 21 | 22 | bidx(p); 23 | 24 | for (i = 1; i < p->size; i++) { 25 | if (intflg) 26 | break; 27 | j = getdat(p); 28 | putchar(j); 29 | column++; 30 | if (column >= pagewidth) { 31 | putchar('\n'); 32 | column = 0; 33 | } 34 | 35 | /* has end of dimension been reached? */ 36 | if (i != p->size) { 37 | for (j = p->rank - 2; j >= 0; j--) { 38 | if (i % idx.del[j] == 0) { 39 | putchar('\n'); 40 | column = 0; 41 | } 42 | } 43 | } 44 | } 45 | 46 | j = getdat(p); 47 | putchar(j); 48 | column++; 49 | if (column >= pagewidth) { 50 | putchar('\n'); 51 | column = 0; 52 | } 53 | return (1); 54 | } 55 | -------------------------------------------------------------------------------- /apl11/quad_var/ex_qpp.c: -------------------------------------------------------------------------------- 1 | /* openAPL, Copyright (C) Branko Bratkovic 1998 2 | * This file is free software and is covered by the GNU General 3 | * Public License. 4 | * 5 | * This program is distributed in the hope that it will be useful, 6 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 7 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. 8 | * 9 | * For more details see the GNU General Public License (GPL) in 10 | * the docs directory. 11 | */ 12 | 13 | #include 14 | #include "apl.h" 15 | #include "data.h" 16 | #include "utility.h" 17 | #include "char.h" 18 | 19 | void outputPrintP() { 20 | printf("digits %d\n", PrintP); 21 | } 22 | 23 | void updatePrintP(struct item *p) { 24 | int i; 25 | 26 | if (p->itemType != DA) 27 | error(ERR_domain, "assign value not numeric"); 28 | if (p->rank != 0) 29 | error(ERR_rank, "assign value not scalar"); 30 | i = p->datap[0]; 31 | if (i < 1 || i > 20) 32 | error(ERR_limit, S_QUAD "pp range is 1 to 20"); 33 | PrintP = i; 34 | } 35 | 36 | struct item* ex_qpp(io) int io; /* 0 = source, 1 = sink */ 37 | { 38 | struct item* p; 39 | int i; 40 | 41 | if (io == 0) { 42 | p = newdat(DA, 0, 1); 43 | p->datap[0] = PrintP; 44 | return (p); 45 | } 46 | else { 47 | pop(); 48 | p = fetch1(); 49 | updatePrintP(p); 50 | sp[-1] = (struct item*)p; 51 | return (0); 52 | }; 53 | } 54 | -------------------------------------------------------------------------------- /apl11/parser/compile_old.c: -------------------------------------------------------------------------------- 1 | /* Copyright U S WEST Advanced Technologies, Inc. 2 | * You may use, copy, modify and sublicense this Software 3 | * subject to the conditions expressed in the file "License". 4 | */ 5 | 6 | #include "utility.h" 7 | #include "local_parser.h" 8 | #include "y.tab.h" 9 | #include "opt_codes.h" 10 | #include "memory.h" 11 | #include "debug.h" 12 | 13 | /* s is statement 14 | * f is execution flag: 15 | * 0 compile immediate 16 | * 1 compile quad input 17 | * 2 function definition 18 | * 3 function prolog 19 | * 4 function epilog 20 | * 5 function body 21 | */ 22 | extern int ilex[]; 23 | 24 | char* compile_old(char* s, int f) 25 | { 26 | char *p, *q; 27 | int i; 28 | 29 | iline = s; 30 | ccharp = oline; 31 | litflag = 0; 32 | nlexsym = ilex[f]; 33 | context = nlexsym; 34 | compilePhase = (CompilePhase)f; 35 | 36 | if (code_trace) { 37 | fprintf(stderr, "\n\nabout to yyparse.. iline: %s\n\n", iline); 38 | } 39 | 40 | if (yyparse()) { 41 | pline(s, iline - s, lineNumber); //print line and error pointer 42 | return (0); 43 | } 44 | *ccharp++ = END; 45 | 46 | parseDump(oline, ccharp - oline); 47 | 48 | iline = (char*)alloc(ccharp - oline); 49 | 50 | // p = iline; 51 | // for(q = oline; q < ccharp; ++q) *p++ = *q; 52 | 53 | for (i = 0; i < ccharp - oline; ++i) { 54 | iline[i] = oline[i]; 55 | } 56 | 57 | return (iline); 58 | } 59 | -------------------------------------------------------------------------------- /apl11/quad_var/ex_qts.c: -------------------------------------------------------------------------------- 1 | /* openAPL, Copyright (C) Branko Bratkovic 1998 2 | * This file is free software and is covered by the GNU General 3 | * Public License. 4 | * 5 | * This program is distributed in the hope that it will be useful, 6 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 7 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. 8 | * 9 | * For more details see the GNU General Public License (GPL) in 10 | * the docs directory. 11 | */ 12 | 13 | #include 14 | #include 15 | #include "apl.h" 16 | #include "utility.h" 17 | #include "data.h" 18 | 19 | struct item* ex_qts(io) int io; /* 0 = source, 1 = sink */ 20 | { 21 | struct item* p; 22 | struct tm* tp; 23 | struct timeval tv; 24 | struct timezone tz; 25 | long tvec; 26 | 27 | if (io == 0) { 28 | p = newdat(DA, 1, 7); 29 | 30 | /* get time information from the OS */ 31 | time(&tvec); 32 | tp = localtime(&tvec); 33 | gettimeofday(&tv, &tz); 34 | 35 | /* load time into item *p */ 36 | p->datap[0] = tp->tm_year + 1900; 37 | p->datap[1] = tp->tm_mon + 1; 38 | p->datap[2] = tp->tm_mday; 39 | p->datap[3] = tp->tm_hour; 40 | p->datap[4] = tp->tm_min; 41 | p->datap[5] = tp->tm_sec; 42 | p->datap[6] = tv.tv_usec / 1000; 43 | 44 | return (p); 45 | } 46 | else { 47 | error(ERR_implicit, "cannot change time"); 48 | }; 49 | } 50 | -------------------------------------------------------------------------------- /printer/apl2gs.in: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | # A print filter for APL character files in openAPL 3 | # User beware: any changes you make to the following, 4 | # could be destroyed when the Makefile is re-run. 5 | # Refer to the printer directory in the source. 6 | # 7 | # Copyright (C) Branko Bratkovic 1998 8 | # This file is free software and is covered by the GNU General 9 | # Public License. 10 | # 11 | # This program 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. 14 | # 15 | # For more details see the GNU General Public License (GPL) in 16 | # the docs directory. 17 | 18 | # Declare the defaults 19 | a2gsoptions="-p" 20 | # Note that $a2gsoptions is applied in addition to any command line 21 | # arguments provided when this script is invoked. This parameter 22 | # is provided so that apl.sh and .aplrc may specify any commonly 23 | # used flags. 24 | 25 | prefix=@prefix@ 26 | sysconfdir=@sysconfdir@ 27 | gsfont=@gsfontdir@/apl2741.fnt 28 | 29 | # Implement site specific customisation 30 | if [ -r $sysconfdir/apl.sh ] 31 | then 32 | . $sysconfdir/apl.sh 33 | fi 34 | 35 | # Implement user specific customisation 36 | if [ -r $HOME/.aplrc ] 37 | then 38 | . $HOME/.aplrc 39 | fi 40 | 41 | 42 | # Now do it, the subject text is read from stdin and passes to stdout 43 | echo '%!PS' 44 | cat $gsfont 45 | a2gs $a2gsoptions $* | sed "s/\/Courier findfont/\/APL-2741 findfont/" 46 | 47 | -------------------------------------------------------------------------------- /apl11/quad_func/ex_exec.c: -------------------------------------------------------------------------------- 1 | /* Copyright U S WEST Advanced Technologies, Inc. 2 | * You may use, copy, modify and sublicense this Software 3 | * subject to the conditions expressed in the file "License". 4 | */ 5 | #include 6 | 7 | #include "apl.h" 8 | #include "data.h" 9 | #include "utility.h" 10 | #include "char.h" 11 | 12 | #define MAXP 20 13 | 14 | void ex_exec() 15 | { 16 | struct item* p; 17 | int i, j; 18 | char *cp, *argv[MAXP + 1]; 19 | 20 | SECURITY_CHECK; 21 | p = fetch1(); 22 | if (!p->rank || p->rank > 2) 23 | error(ERR_rank, ""); 24 | if (p->size > 500) 25 | error(ERR_length, ""); 26 | if (p->itemType != CH) 27 | error(ERR_domain, ""); 28 | if (p->rank == 2) { 29 | if (p->dim[0] > MAXP) 30 | error(ERR_length, ""); 31 | cp = (char*)(p->datap); 32 | for (i = 0; i < p->dim[0]; i++) 33 | argv[i] = cp + i * p->dim[1]; 34 | argv[p->dim[0]] = 0; 35 | } 36 | else { 37 | cp = (char*)(p->datap); 38 | for (i = j = 0; i < MAXP && cp < (char*)(p->datap) + p->size; cp++) { 39 | if (!*cp) 40 | j = 0; 41 | else if (!j) { 42 | j = 1; 43 | argv[i++] = (char*)cp; 44 | } 45 | } 46 | if (i == MAXP || *--cp) 47 | error(ERR, "exec - panic"); 48 | argv[i] = 0; 49 | } 50 | execv(argv[0], &argv[1]); 51 | pop(); 52 | p = newdat(DA, 0, 0); 53 | *sp++ = p; 54 | } 55 | -------------------------------------------------------------------------------- /apl11/sys_command/ex_prws.c: -------------------------------------------------------------------------------- 1 | /* Copyright U S WEST Advanced Technologies, Inc. 2 | * You may use, copy, modify and sublicense this Software 3 | * subject to the conditions expressed in the file "License". 4 | */ 5 | #include 6 | 7 | #include "apl.h" 8 | #include "data.h" 9 | #include "char.h" 10 | #include "ex_list.h" 11 | #include "print.h" 12 | 13 | /* Print Workspace */ 14 | void ex_prws() 15 | { 16 | SymTabEntry* np; 17 | struct item* ip; 18 | int i; 19 | 20 | printf(S_QUAD "io " S_LEFTARROW " %d\n", iorigin); 21 | printf(S_QUAD "pw " S_LEFTARROW " %d\n", pagewidth); 22 | printf(S_QUAD "pp " S_LEFTARROW " %d\n", PrintP); 23 | symtabIterateInit(); 24 | while (np = symtabIterate()) { 25 | // for(np=symbolTable; np < &symbolTable[SYM_TAB_MAX]; np++) { 26 | switch (np->entryUse) { 27 | case CH: 28 | case DA: 29 | printf("%s " S_LEFTARROW " ", np->namep); 30 | ip = np->itemp; 31 | if (ip->rank) { 32 | for (i = 0; i < ip->rank; i++) 33 | printf("%d ", ip->dim[i]); 34 | printf(S_RHO "\n"); 35 | } 36 | *sp++ = (struct item*)np; 37 | ex_print(); 38 | pop(); 39 | putchar('\n'); 40 | break; 41 | 42 | case NF: 43 | case MF: 44 | case DF: 45 | *sp++ = (struct item*)np; 46 | ex_list(); 47 | putchar('\n'); 48 | break; 49 | } 50 | } 51 | } 52 | -------------------------------------------------------------------------------- /apl11/utility/file.c: -------------------------------------------------------------------------------- 1 | /* Copyright U S WEST Advanced Technologies, Inc. 2 | * You may use, copy, modify and sublicense this Software 3 | * subject to the conditions expressed in the file "License". 4 | */ 5 | #include 6 | #include 7 | #include 8 | #include 9 | #include 10 | 11 | #include "apl.h" 12 | #include "utility.h" 13 | 14 | static int openOrCreateFile(char* fileName, int mode) 15 | { 16 | int fd; 17 | 18 | if (mode != O_RDONLY && mode != O_WRONLY && mode != O_RDWR) { 19 | fd = creat(fileName, mode); 20 | } 21 | else { 22 | fd = open(fileName, mode); 23 | } 24 | 25 | return fd; 26 | } 27 | 28 | int opn(char file[], int rw) 29 | { 30 | int fd; 31 | char f2[100]; 32 | 33 | if ((fd = openOrCreateFile(file, rw)) < 0) { 34 | strcpy(f2, "/usr/lib/apl/"); 35 | strncat(f2, file, sizeof(f2) - 1); 36 | 37 | if ((fd = openOrCreateFile(f2, rw)) >= 0) { 38 | printf("[using %s]\n", f2); 39 | } 40 | else { 41 | printf("can't open file %s\n", file); 42 | error(ERR, ""); 43 | } 44 | } 45 | return (fd); 46 | } 47 | 48 | int empty(int fd) 49 | { 50 | struct stat sbuf; 51 | 52 | /* Simulate the Rand Corp.'s "empty" system call on a 53 | * V7 system by seeing if the given fd is a pipe, and if 54 | * so, whether or not it is empty. 55 | */ 56 | 57 | if (fstat(fd, &sbuf) < 0) 58 | return (-1); /* Can't "stat" it */ 59 | return (sbuf.st_size == 0); 60 | } 61 | -------------------------------------------------------------------------------- /terminal/SunOS/keymap/apl2741.xmap: -------------------------------------------------------------------------------- 1 | keycode 37 = 1 exclam 0x9a 2 | keycode 38 = 2 at 0xfd 3 | keycode 39 = 3 numbersign 0x3c 4 | keycode 40 = 4 dollar 0xf3 5 | keycode 41 = 5 percent 0x3d 0xf0 6 | keycode 42 = 6 asciicircum 0xf2 7 | keycode 43 = 7 ampersand 0x3e 8 | keycode 44 = 8 asterisk 0x86 9 | keycode 45 = 9 parenleft 0xfa 0xe5 10 | keycode 46 = 0 parenright 0x5e 0xea 11 | keycode 47 = minus underscore 0xf6 0x98 12 | keycode 48 = equal plus 0x92 13 | keycode 49 = grave asciitilde 14 | keycode 60 = Tab 15 | keycode 61 = q Q 0x3f 16 | keycode 62 = w W 0xf7 17 | keycode 63 = e E 0xee 18 | keycode 64 = r R 0xfb 19 | keycode 65 = t T 0x7e 20 | keycode 66 = y Y 0x8c 21 | keycode 67 = u U 0x8b 22 | keycode 68 = i I 0xe2 0x84 23 | keycode 69 = o O 0xf9 0x89 24 | keycode 70 = P 25 | keycode 71 = bracketleft braceleft 0x90 0x85 26 | keycode 72 = bracketright braceright 0x81 0x80 27 | keycode 84 = a A 0xe0 0xed 28 | keycode 85 = s S 0x8d 0xe8 29 | keycode 86 = d D 0x8f 0xe9 30 | keycode 87 = f F 0x5f 31 | keycode 88 = g G 0xec 0x9d 32 | keycode 89 = h H 0x91 0x93 33 | keycode 90 = j J 0xf8 34 | keycode 91 = k K 0x60 35 | keycode 92 = l L 0x95 36 | keycode 93 = semicolon colon 37 | keycode 94 = apostrophe quotedbl 0x97 38 | keycode 95 = backslash bar 0xa8 39 | keycode 107 = z Z 0x82 40 | keycode 108 = x X 0x83 41 | keycode 109 = c C 0xef 0xa6 42 | keycode 110 = v V 0xfc 43 | keycode 111 = b B 0xe6 0xf5 44 | keycode 112 = n N 0xe7 0xf4 45 | keycode 113 = m M 0xfe 46 | keycode 114 = comma less 47 | keycode 115 = period greater 48 | keycode 116 = slash question 0xeb 0xa7 49 | -------------------------------------------------------------------------------- /apl11/mixed_monadic/gd.c: -------------------------------------------------------------------------------- 1 | /* Copyright U S WEST Advanced Technologies, Inc. 2 | * You may use, copy, modify and sublicense this Software 3 | * subject to the conditions expressed in the file "License". 4 | */ 5 | #include 6 | 7 | /* gd0 and gd1 are used by both grade up and grade down */ 8 | 9 | static void gd1(int* m, int (*f)(const void*, const void*)); 10 | 11 | #include "apl.h" 12 | #include "utility.h" 13 | #include "data.h" 14 | #include "memory.h" 15 | 16 | void gd0(int k, int (*f)(const void*, const void*)) 17 | { 18 | struct item* p; 19 | int* intvec; 20 | 21 | bidx(sp[-1]); 22 | if (k < 0 || k >= idx.rank) 23 | error(ERR_index, ""); 24 | p = newdat(DA, idx.rank, idx.size); 25 | copy(IN, (char*)idx.dim, (char*)p->dim, idx.rank); 26 | *sp++ = p; 27 | colapse(k); 28 | 29 | intvec = (int*)alloc(idx.dimk * SINT); 30 | 31 | indexIterateInit(&idx); 32 | while (indexIterate(&idx)) { 33 | gd1(intvec, f); 34 | } 35 | 36 | aplfree(intvec); 37 | p = sp[-1]; 38 | sp--; 39 | pop(); 40 | *sp++ = p; 41 | } 42 | 43 | static void gd1(int* m, int (*f)(const void*, const void*)) 44 | { 45 | struct item* p; 46 | int i, *m1; 47 | 48 | integ = access(); 49 | m1 = m; 50 | for (i = 0; i < idx.dimk; i++) 51 | *m1++ = i; 52 | qsort(m, idx.dimk, SINT, (int (*)(const void*, const void*))f); 53 | p = sp[-1]; 54 | for (i = 0; i < idx.dimk; i++) { 55 | p->index = integ; 56 | datum = *m++ + iorigin; 57 | putdat(p, datum); 58 | integ += idx.delk; 59 | } 60 | } 61 | -------------------------------------------------------------------------------- /apl11/include/format.h: -------------------------------------------------------------------------------- 1 | /* openAPL, Copyright (C) Branko Bratkovic 1999 2 | * This file is free software and is covered by the GNU General 3 | * Public License. 4 | * 5 | * This program is distributed in the hope that it will be useful, 6 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 7 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. 8 | * 9 | * For more details see the GNU General Public License (GPL) in 10 | * the docs directory. 11 | */ 12 | #ifndef FORMAT_H 13 | #define FORMAT_H 14 | 15 | struct FORMAT { 16 | int sign; /* 1 if space for a minus sign is required */ 17 | int exp; /* 1 if exponential format */ 18 | int left_ratn; /* number of left digits, rational format 19 | * ie, sign+left_digits */ 20 | int right_ratn; /* number of right digits, rational format 21 | * ie, right_digits */ 22 | int pp_ratn; /* Print Precision for rational format*/ 23 | int left_expn; /* number of left digits, expotential format 24 | * ie, sign+1 */ 25 | int right_expn; /* number of right digits, expotential format */ 26 | int digit_expn; /* number of digits in exponent inc sign & 'E' */ 27 | int digits; /* total field width */ 28 | struct FORMAT* next; /* linked list forward pointer */ 29 | }; 30 | 31 | char format_buffer[80]; 32 | void fp_digits(data d, struct FORMAT* format); 33 | char* fp2char(data d, struct FORMAT* format); 34 | char* fp2char_paded(data d, struct FORMAT* format); 35 | struct item* fp_mfmt(struct item* p); 36 | struct item* fp_dfmt(struct item* f, struct item* p); 37 | 38 | #endif 39 | -------------------------------------------------------------------------------- /apl11/quad_var/ex_qlx.c: -------------------------------------------------------------------------------- 1 | /* openAPL, Copyright (C) Branko Bratkovic 1998 2 | * This file is free software and is covered by the GNU General 3 | * Public License. 4 | * 5 | * This program is distributed in the hope that it will be useful, 6 | * but WITHOUT ANY WARRANTY; without even the implied warranty of 7 | * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. 8 | * 9 | * For more details see the GNU General Public License (GPL) in 10 | * the docs directory. 11 | */ 12 | 13 | #include 14 | #include "apl.h" 15 | #include "data.h" 16 | #include "char.h" 17 | #include "memory.h" 18 | 19 | struct item* ex_qlx(io) int io; /* 0 = source, 1 = sink */ 20 | { 21 | struct item *p, *q; 22 | SymTabEntry* n; 23 | 24 | if (io == 0) { 25 | n = nlook(S_QUAD "lx"); 26 | if (n) { 27 | q = n->itemp; 28 | p = dupdat(q); 29 | copy(q->itemType, (char*)q->datap, (char*)p->datap, q->size); 30 | } 31 | else 32 | p = newdat(CH, 1, 0); 33 | return (p); 34 | } 35 | else { 36 | 37 | pop(); 38 | n = nlook(S_QUAD "lx"); 39 | if (n == 0) { /* allocate new name: */ 40 | //for(n=symbolTable; n->namep; n++) ; 41 | char name[4] = S_QUAD "lx"; 42 | n = symtabInsert(name); 43 | n->entryType = LV; 44 | n->entryUse = 0; 45 | n->itemp = newdat(CH, 0, 0); 46 | } 47 | q = fetch1(); 48 | erase(n); 49 | n->entryUse = DA; 50 | n->itemp = q; 51 | sp[-1] = (struct item*)n; 52 | 53 | return (0); 54 | }; 55 | } 56 | -------------------------------------------------------------------------------- /docs/user_guide/SandBox: -------------------------------------------------------------------------------- 1 | SandBox Mode 2 | ----------- 3 | 4 | SandBox Mode is an attempt to reduce the risk of damage to external files by 5 | hostile programs. 6 | 7 | SandBox mode becomes active when: 8 | 1. the -s flag is provided in the argument list when apl11 is invoked. 9 | 2. Quad LX (Latent eXpression) is executed through the )load command 10 | 11 | Situation 2. is the main reason for the existence of SandBox mode, it is 12 | intended to be a defense against macro style viruses. However, it should 13 | not be regarded as total security by users who receive APL programs from 14 | outside their control. It does not prevent a user run program from 15 | doing damage after being started by a legitimate method, ie 'Trojan Horse' 16 | attack. Furthermore, damage within the user's workspace should not be 17 | dismissed as trivial (which SandBox mode does not guard against). 18 | 19 | By design, SandBox mode cannot be tested or set within a session. This is 20 | intended to prevent a hostile program from adjusting its behaviour: 21 | once a prohibited operation is attempted during SandBox mode, control is 22 | returned to the user. 23 | 24 | OpenAPL could be set up by the administrator to run in SandBox mode by 25 | putting -s on the argument list in /etc/apl.sh. This would be easy to 26 | bypass. Slightly more confidence could be had by editing apl.c, to 27 | set sandboxflg to 1 and recompiling. 28 | 29 | Nobody can guarantee that openAPL or APL/11 is, or can be made, secure. 30 | The contributers and developers of this package do not accept any 31 | responsibility for loss and/or damage caused by the use of this package 32 | by anyone at all. 33 | 34 | -------------------------------------------------------------------------------- /printer/apl2epson.in: -------------------------------------------------------------------------------- 1 | #!/bin/sh 2 | # A print filter for APL character files in openAPL 3 | # User beware: any changes you make to the following, 4 | # could be destroyed when the Makefile is re-run. 5 | # Refer to the printer directory in the source. 6 | # 7 | # Copyright (C) Branko Bratkovic 1998 8 | # This file is free software and is covered by the GNU General 9 | # Public License. 10 | # 11 | # This program 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. 14 | # 15 | # For more details see the GNU General Public License (GPL) in 16 | # the docs directory. 17 | 18 | # Declare the defaults 19 | fpoptions="" 20 | # Note that $fpoptions is applied in addition to any command line 21 | # arguments provided when this script is invoked. This parameter 22 | # is provided so that apl.sh and .aplrc may specify any commonly 23 | # used flags. 24 | 25 | prefix=@prefix@ 26 | fpfont=@consolefontdir@/apl8x16.psf 27 | sysconfdir=@sysconfdir@ 28 | 29 | # Implement site specific customisation 30 | if [ -r $sysconfdir/apl.sh ] 31 | then 32 | . $sysconfdir/apl.sh 33 | fi 34 | 35 | # Implement user specific customisation 36 | if [ -r $HOME/.aplrc ] 37 | then 38 | . $HOME/.aplrc 39 | fi 40 | 41 | # the syntax for fontprint is: 42 | # fontprint font_file [ text_file ] [ output_file ] [ -options] 43 | # the command line is permitted to specify an optional filename 44 | # (if not provided, then stdin is used) followed by an optional 45 | # output filename (if not provided, then stdout) followed 46 | # by any flags each starting with "-". 47 | 48 | fontprint $fpfont $* $fpoptions 49 | 50 | --------------------------------------------------------------------------------