v21i051: Pascal to C translator, Part06/32
Rich Salz
rsalz at uunet.uu.net
Tue Mar 27 06:31:16 AEST 1990
Submitted-by: Dave Gillespie <daveg at csvax.caltech.edu>
Posting-number: Volume 21, Issue 51
Archive-name: p2c/part06
#! /bin/sh
# This is a shell archive. Remove anything before this line, then unpack
# it by saving it into a file and typing "sh file". To overwrite existing
# files, type "sh file -c". You can also feed this as standard input via
# unshar, or by typing "sh <file", e.g.. If this archive is complete, you
# will see the following message at the end:
# "End of archive 6 (of 32)."
# Contents: HP/import/sysdevs.imp src/makeproto.c src/p2clib.c
# Wrapped by rsalz at litchi.bbn.com on Mon Mar 26 14:29:30 1990
PATH=/bin:/usr/bin:/usr/ucb ; export PATH
if test -f 'HP/import/sysdevs.imp' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'HP/import/sysdevs.imp'\"
else
echo shar: Extracting \"'HP/import/sysdevs.imp'\" \(15631 characters\)
sed "s/^X//" >'HP/import/sysdevs.imp' <<'END_OF_FILE'
X
X
X{IncludeFrom=sysdevs <p2c/sysdevs.h>}
X
X
X{*VarStrings=1} {*ExportSymbol=}
X
X
XMODULE SYSDEVS;
X
X$SEARCH 'INITLOAD'$
X
X
XIMPORT SYSGLOBALS;
XEXPORT
X {* DUMMY DECLARATIONS **********************************}
X TYPE
X KBDHOOKTYPE = PROCEDURE(VAR STATBYTE,DATABYTE: BYTE;
X VAR DOIT: BOOLEAN);
X OUT2TYPE = PROCEDURE(VALUE1,VALUE2: BYTE);
X REQUEST1TYPE = PROCEDURE(CMD: BYTE; VAR VALUE: BYTE);
X BOOLPROC = PROCEDURE(B:BOOLEAN);
X
X{* CRT *************************************************}
X{***** THIS SECTION HAS HARD OFFSET REFERENCES *********}
X{ IN MODULES CRTB (ASSY FILE GASSM) }
XTYPE
X CRTWORD = RECORD CASE INTEGER OF
X 1:(HIGHLIGHTBYTE,CHARACTER: CHAR);
X 2:(WHOLEWORD: SHORTINT);
X END;
X CRTLLOPS =(CLLPUT,CLLSHIFTL,CLLSHIFTR,CLLCLEAR,CLLDISPLAY,PUTSTATUS);
X CRTLLTYPE=PROCEDURE(OP:CRTLLOPS; ANYVAR POSITION:INTEGER; C:CHAR);
X DBCRTOPS =(DBINFO,DBEXCG,DBGOTOXY,DBPUT,DBINIT,DBCLEAR,DBCLINE,DBSCROLLUP,
X DBSCROLLDN,DBSCROLLL,DBSCROLLR,DBHIGHL);
X DBCINFO = RECORD
X SAVEAREA : WINDOWP;
X SAVESIZE : INTEGER;
X DCURSORADDR : INTEGER;
X XMIN,XMAX,YMIN,YMAX : SHORTINT;
X CURSX,CURSY : SHORTINT;
X C : CHAR;
X AREAISDBCRT : BOOLEAN;
X CHARISMAPPED: BOOLEAN; { 3/25/85 }
X DEBUGHIGHLIGHT: SHORTINT; { 3/25/85 }
X END;
X DBCRTTYPE=PROCEDURE(OP:DBCRTOPS; VAR DBCRT:DBCINFO);
X
X crtconsttype = packed array [0..11] of byte;
X
X crtfrec = packed record
X nobreak,stupid,slowterm,hasxycrt,
X haslccrt{built in crt},hasclock,
X canupscroll,candownscroll : boolean;
X end;
X
X b9 = packed array[0..8] of boolean;
X b14= packed array[0..13] of boolean;
X crtcrec = packed record (* CRT CONTROL CHARS *)
X rlf,ndfs,eraseeol,
X eraseeos,home,
X escape : char;
X backspace : char;
X fillcount : 0..255;
X clearscreen,
X clearline : char;
X prefixed : b9
X end;
X
X crtirec = packed record (* CRT INFO & INPUT CHARS *)
X width,height : shortint;
X crtmemaddr,crtcontroladdr,
X keybufferaddr,progstateinfoaddr:integer;
X keybuffersize: shortint;
X crtcon : crtconsttype;
X right,left,down,up: char;
X badch,chardel,stop,
X break,flush,eof : char;
X altmode,linedel : char;
X backspace,
X etx,prefix : char;
X prefixed : b14 ;
X cursormask : integer;
X spare : integer;
X end;
X
X environ = record
X miscinfo: crtfrec;
X crttype: integer;
X crtctrl: crtcrec;
X crtinfo: crtirec;
X end;
X
X environptr = ^environ;
X
X crtkinds = (NOCRT, ALPHATYPE, BITMAPTYPE, SPECIALCRT1, SPECIALCRT2);
X
XVAR
X SYSCOM: ENVIRONPTR;
X ALPHASTATE['ALPHAFLAG'] : BOOLEAN;
X GRAPHICSTATE['GRAPHICSFLAG'] : BOOLEAN;
X CRTIOHOOK : AMTYPE;
X TOGGLEALPHAHOOK : PROCEDURE;
X TOGGLEGRAPHICSHOOK : PROCEDURE;
X DUMPALPHAHOOK : PROCEDURE;
X DUMPGRAPHICSHOOK : PROCEDURE;
X UPDATECURSORHOOK : PROCEDURE;
X CRTINITHOOK : PROCEDURE;
X CRTLLHOOK : CRTLLTYPE;
X DBCRTHOOK : DBCRTTYPE;
X XPOS : SHORTINT; { CURSOR X POSITION }
X YPOS : SHORTINT; { CURSOR Y POSITION }
X CURRENTCRT : CRTKINDS; { ACTIVE ALPHA DRIVER TYPE }
X BITMAPADDR : INTEGER; { ADDRESS OF BITMAP CONTROL SPACE }
X FRAMEADDR : INTEGER; { ADDRESS OF BITMAP FRAME BUFFER }
X REPLREGCOPY : SHORTINT; { REGISTER COPIES FOR BITMAP DISPLAY }
X WINDOWREGCOPY : SHORTINT; { MUST BE IN GLOBALS BECAUSE REGISTERS }
X WRITEREGCOPY : SHORTINT; { ARE NOT READABLE -- MAY BE UNDEFINED }
X
X {* KEYBOARD *******************************************}
X CONST
X KBD_ENABLE = 0; KBD_DISABLE = 1;
X SET_AUTO_DELAY = 2; SET_AUTO_REPEAT= 3;
X GET_AUTO_DELAY = 4; GET_AUTO_REPEAT= 5;
X SET_KBDTYPE = 6; SET_KBDLANG = 7;
X TYPE
X STRING80PTR = ^STRING80;
X KEYBOARDTYPE = (NOKBD,LARGEKBD,SMALLKBD,ITFKBD,SPECIALKBD1,SPECIALKBD2);
X LANGTYPE = (NO_KBD,FINISH_KBD,BELGIAN_KBD,CDN_ENG_KBD,CDN_FR_KBD,
X NORWEGIAN_KBD,DANISH_KBD,DUTCH_KBD,SWISS_GR_KBD,SWISS_FR_KBD,
X SPANISH_EUR_KBD,SPANISH_LATIN_KBD,UK_KBD,ITALIAN_KBD,
X FRENCH_KBD,GERMAN_KBD,SWEDISH_KBD,SPANISH_KBD,
X KATAKANA_KBD,US_KBD,ROMAN8_KBD,NS1_KBD,NS2_KBD,NS3_KBD,
X SWISS_GR_B_KBD,SWISS_FR_B_KBD {ADDED FOR 3.1--SFB-5/22/85} );
X MENUTYPE = (M_NONE,M_SYSNORM,M_SYSSHIFT,M_U1,M_U2,M_U3,M_U4);
X VAR
X KBDREQHOOK : REQUEST1TYPE;
X KBDIOHOOK : AMTYPE;
X KBDISRHOOK : KBDHOOKTYPE;
X KBDPOLLHOOK : BOOLPROC;
X KBDTYPE : KEYBOARDTYPE;
X KBDCONFIG : BYTE; { KEYBOARD CONFIGURATION JUMPER }
X KBDLANG : LANGTYPE;
X SYSMENU : STRING80PTR;
X SYSMENUSHIFT : STRING80PTR;
X MENUSTATE : MENUTYPE;
X
X{* ENABLE / DISABLE ************************************}
X CONST
X KBDMASK=1;RESETMASK=2;TIMERMASK=4;PSIMASK=8;FHIMASK=16;
X VAR
X MASKOPSHOOK : OUT2TYPE; { ENABLE, DISABLE }
X
X{* BEEPER **********************************************}
X VAR
X BEEPERHOOK: OUT2TYPE;
X BFREQUENCY, BDURATION: BYTE;
X
X{* RPG *************************************************}
X CONST
X RPG_ENABLE = 0; RPG_DISABLE = 1;
X SET_RPG_RATE = 2; GET_RPG_RATE =3;
X VAR
X RPGREQHOOK: REQUEST1TYPE;
X RPGISRHOOK: KBDHOOKTYPE;
X
X{* BATTERY *********************************************}
XTYPE
X BATCMDTYPE = PROCEDURE(CMD: BYTE; NUMDATA: INTEGER;
X B1, B2, B3, B4, B5: BYTE);
X BATREADTYPE= PROCEDURE(VAR DATA: BYTE);
XVAR
X BATTERYPRESENT[-563]: BOOLEAN;
X BATCMDHOOK : BATCMDTYPE;
X BATREADHOOK: BATREADTYPE;
X
X{* CLOCK ***********************************************}
XTYPE
X RTCTIME = PACKED RECORD
X PACKEDTIME,PACKEDDATE:INTEGER;
X END;
X CLOCKFUNC = (CGETDATE,CGETTIME,CSETDATE,CSETTIME);
X CLOCKOP = (CGET,CSET,CUPDATE); {CUPDATE ADDED FOR BOBCAT 4/11/85 SFB}
X CLOCKDATA = RECORD
X CASE BOOLEAN OF
X TRUE :(TIMETYPE:TIMEREC);
X FALSE:(DATETYPE:DATEREC);
X END;
X CLOCKREQTYPE = PROCEDURE(CMD:CLOCKFUNC; ANYVAR DATA:CLOCKDATA);
X CLOCKIOTYPE = PROCEDURE(CMD:CLOCKOP ; VAR DATA:RTCTIME);
XVAR
X CLOCKREQHOOK : CLOCKREQTYPE; { CLOCK MODULE INTERFACE }
X CLOCKIOHOOK : CLOCKIOTYPE; { CARD DRIVER INTERFACE }
X
X{* TIMER ***********************************************}
XTYPE
X TIMERTYPES = (CYCLICT,PERIODICT,DELAYT,DELAY7T,MATCHT);
X TIMEROPTYPE = (SETT,READT,GETTINFO);
X TIMERDATA = RECORD
X CASE INTEGER OF
X 0: (COUNT: INTEGER);
X 1: (MATCH: TIMEREC);
X 2: (RESOLUTION,RANGE:INTEGER);
X END;
X TIMERIOTYPE = PROCEDURE(TIMER: TIMERTYPES;OP: TIMEROPTYPE;VAR TD: TIMERDATA);
XVAR
X TIMERIOHOOK : TIMERIOTYPE;
X TIMERISRHOOK : KBDHOOKTYPE;
X
X
X{* KEYBUFFER *******************************************}
XCONST
X KMAXBUFSIZE = 255;
XTYPE
X
X KOPTYPE = (KGETCHAR,KAPPEND,KNONADVANCE,KCLEAR,KDISPLAY,
X KGETLAST,KPUTFIRST);
X KBUFTYPE= PACKED ARRAY[0..KMAXBUFSIZE] OF CHAR;
X KBUFPTR = ^KBUFTYPE;
X KBUFRECPTR = ^KBUFREC;
X KBUFREC = RECORD
X ECHO: BOOLEAN;
X NON_CHAR: CHAR;
X MAXSIZE,SIZE,INP,OUTP: INTEGER;
X BUFFER: KBUFPTR;
X END;
X
XVAR
X KEYBUFFER : KBUFRECPTR;
X KBDWAITHOOK: PROCEDURE;
X KBDRELEASEHOOK: PROCEDURE;
X STATUSLINE: PACKED ARRAY[0..7] OF CHAR;
X {0 s or f = STEP/FLASH IN PROGRESS (WAITING FOR TRAP #0)}
X {1..5 last executed/current line number }
X {6 S=SYSTEM U=USER DEFINITION FOR ITF SOFT KEYS}
X { BLANK FOR NON ITF KEYBOARDS }
X {7 RUNLIGHT }
X
X{* KEY TRANSLATION SERVICES ********************************}
XTYPE
X KEYTRANSTYPE =(KPASSTHRU,KSHIFT_EXTC,KPASS_EXTC);
X KEYTYPE = (ALPHA_KEY,NONADV_KEY,SPECIAL_KEY,IGNORED_KEY,NONA_ALPHA_KEY);
X { ADDED NONA_ALPHA_KEY 5/9/84 RQ/SFB }
X
X LANGCOMREC = RECORD
X STATUS : BYTE;
X DATA : BYTE;
X KEY : CHAR;
X RESULT : KEYTYPE;
X SHIFT,CONTROL,EXTENSION: BOOLEAN;
X END;
X LANGKEYREC = RECORD
X NO_CAPSLOCK: BOOLEAN;
X NO_SHIFT : BOOLEAN;
X NO_CONTROL : BOOLEAN;
X NO_EXTENSION : BOOLEAN;
X KEYCLASS : KEYTYPE;
X KEYS : ARRAY[BOOLEAN] OF CHAR;
X END;
X LANGRECORD= RECORD
X CAN_NONADV: BOOLEAN;
X LANGCODE : LANGTYPE;
X SEMANTICS : PROCEDURE;
X KEYTABLE : ARRAY[0..127] OF LANGKEYREC;
X END;
X LANGPTR = ^LANGRECORD;
XVAR
X LANGCOM : LANGCOMREC;
X LANGTABLE : ARRAY[0..1] OF LANGPTR;
X LANGINDEX : 0..1;
X KBDTRANSHOOK : KBDHOOKTYPE;
X TRANSMODE : KEYTRANSTYPE;
X KBDSYSMODE, KBDALTLOCK, KBDCAPSLOCK : BOOLEAN;
X
X{* HPHIL ***********************************************}
X{MOVED INTO SYSDEVS 4/6/84 SFB}
Xconst
X le_configured = hex('80');
X le_error = hex('81');
X le_timeout = hex('82');
X le_loopdown = hex('84');
X
X lmaxdevices = 7;
X
Xtype
X loopdvrop = (datastarting,dataended,resetdevice,uninitdevice);
X {UNINIT ADDED 4/8/85 SFB}
X loopdvrproc = procedure(op:loopdvrop);
X
X {HPHILOP DEFINED AS NEW TYPE 4/6/84 SFB}
X HPHILOP = (RAWSHIFTOP,NORMSHIFTOP,CHECKLOOPOP,CONFIGUREOP,LCOMMANDOP);
X {5 PROCEDURES HOOKED AS TYPE HPHILCMDPROC 4/6/84 SFB}
X HPHILCMDPROC = PROCEDURE(OP : HPHILOP);
X
X
X descriprec = packed record { DEVICE DESCRIBE RECORD }
X case boolean of
X true :(id : byte;
X twosets : boolean;
X abscoords: boolean;
X size16 : boolean;
X hasprompts:boolean;
X { reserved : 0..3; {DELETED 3/25/85 SFB}
X ext_desc : boolean; {3/27/85 SFB}
X security : boolean; {3/26/85 SFB}
X numaxes : 0..3;
X counts : shortint;
X maxcountx: shortint;
X maxcounty: shortint;
X maxcountz: shortint;
X promptack: boolean; {ADDED 3/15/85 SFB}
X nprompts : 0..7;
X proximity: boolean; {ADDED 3/15/85 SFB}
X nbuttons : 0..7);
X false:(darray : array[1..11] of char);
X end;
X
X devicerec = record
X devstate : integer;
X descrip : descriprec;
X opsproc : loopdvrproc;
X dataproc : kbdhooktype;
X end;
X
X loopdvrptr = ^loopdriverrec;
X loopdriverrec = record
X lowid,highid,daddr : byte;
X opsproc : loopdvrproc;
X dataproc : kbdhooktype;
X next : loopdvrptr;
X end;
X
X LOOPCONTROLREC = RECORD {REDEFINED AS RECORD - 4/6/84 SFB}
X rawmode : boolean;
X loopdevices : array[1..lmaxdevices] of devicerec;
X loopdevice : 1..lmaxdevices;
X loopcmd : byte; { last loop command sent }
X loopdata : byte; { data bye in / out }
X looperror : boolean; { error occured on last operation }
X loopinconfig:boolean; { now doing reconfigure }
X loopcmddone: boolean; { last sent command is done }
X loopisok : boolean; { loop is configured }
X loopdevreading: boolean; { reading poll data } { 3.0 BUG #39 3/17/84 }
X END;
X
X CONST {NEW TO END OF HPHIL_COMM_REC TYPE 3/26/85 SFB}
X
X
X {DRIVER TYPES}
X NODRIVER = 0;
X ABSLOCATOR = 1; {range 1..15 reserved for DGL}
X
X {CODETYPES FROM POLLBLOCK (OR OTHER HPHIL OPCODE)}
X NOCODES = 0;
X ASCIICODES = 1;
X SET1CODES = 2;
X SET2CODES = 3;
X
X TYPE
X
X HPHIL_COMM_REC_PTR_TYPE = ^hphil_comm_rec_type; {3/25/85 SFB}
X
X HPHIL_COMM_REC_TYPE = RECORD CASE BOOLEAN OF {3/25/85 SFB}
X TRUE :
X (dvr_type : shortint;
X dev_addr : 0..7;
X latch, {stop updating data after button press/event}
X active, {capture data in ISR}
X reading : boolean; {dvr_comm_rec busy, delay update from ISR}
X devices : byte; {bit/loopaddress that driver should service
X put 0 where driver should NOT service device
X with this dvr_comm_rec !}
X update : procedure(recptr : hphil_comm_rec_ptr_type);
X {call update to flush delayed poll data update}
X link : hphil_comm_rec_ptr_type; {next comm record}
X extend : integer; {for extensibility use as pointer/datarec}
X
X xloc, {HPHIL intrinsic data types from poll/command}
X yloc,
X zloc : shortint;
X codetype : shortint; {describes content of codes}
X ncodes : shortint;
X codes : packed array [1..16] of char
X {extensible for variant} );
X FALSE:
X (barray : array[0..53] of char);
X END;
X
Xvar
X
X loopdriverlist : loopdvrptr;
X LOOPCONTROL : ^LOOPCONTROLREC; {4/6/84 SFB}
X HPHILCMDHOOK : HPHILCMDPROC; {4/6/84 SFB}
X
X HPHIL_DATA_LINK : hphil_comm_rec_ptr_type; {3/13/85 SFB}
X
X{-----------------------------------------------------------------------------}
XPROCEDURE SYSDEV_INIT;
X{* BEEPER **********************************************}
XPROCEDURE BEEP;
XPROCEDURE BEEPER(FREQUENCY,DURATION:BYTE);
X{* RPG *************************************************}
XPROCEDURE SETRPGRATE(RATE : BYTE);
X{* KEYBOARD ********************************************}
XPROCEDURE KBDSETUP(CMD,VALUE:BYTE);
XPROCEDURE KBDIO(FP: FIBP; REQUEST: AMREQUESTTYPE;
X ANYVAR BUFFER: WINDOW; BUFSIZE,POSITION: INTEGER);
Xprocedure lockedaction(a: action);
X{* CRT *************************************************}
XPROCEDURE CRTIO(FP: FIBP; REQUEST: AMREQUESTTYPE;
X ANYVAR BUFFER: WINDOW; BUFSIZE,POSITION: INTEGER);
XPROCEDURE DUMMYCRTLL(OP:CRTLLOPS; ANYVAR POSITION:INTEGER; C:CHAR);
X{* BATTERY *********************************************}
XPROCEDURE BATCOMMAND(CMD:BYTE; NUMDATA:INTEGER; B1, B2, B3, B4, B5: BYTE);
XFUNCTION BATBYTERECEIVED:BYTE;
X{* CLOCK ***********************************************}
Xfunction sysclock: integer; {centiseconds from midnight}
Xprocedure sysdate (var thedate: daterec);
Xprocedure systime (var thetime: timerec);
Xprocedure setsysdate ( thedate: daterec);
Xprocedure setsystime ( thetime: timerec);
X{* KEYBUFFER *******************************************}
XPROCEDURE KEYBUFOPS(OP:KOPTYPE; VAR C: CHAR);
X{* STATUSLINE ******************************************}
XPROCEDURE SETSTATUS(N:INTEGER; C:CHAR);
XFUNCTION RUNLIGHT:CHAR;
XPROCEDURE SETRUNLIGHT(C:CHAR);
X
X
Xend.
X
X
END_OF_FILE
if test 15631 -ne `wc -c <'HP/import/sysdevs.imp'`; then
echo shar: \"'HP/import/sysdevs.imp'\" unpacked with wrong size!
fi
# end of 'HP/import/sysdevs.imp'
fi
if test -f 'src/makeproto.c' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'src/makeproto.c'\"
else
echo shar: Extracting \"'src/makeproto.c'\" \(16377 characters\)
sed "s/^X//" >'src/makeproto.c' <<'END_OF_FILE'
X
X/* "makeproto" Copyright 1989 Dave Gillespie */
X
X
X/* Program to scan old-style source files and make prototypes */
X
X
X
X#include <stdio.h>
X#include <ctype.h>
X#include <time.h>
X
X#ifdef FILE /* a #define in BSD, a typedef in SYSV (hp-ux, at least) */
X# ifndef BSD
X# define BSD 1
X# endif
X#endif
X
X#ifdef BSD
X# include <strings.h>
X#else
X# include <string.h>
X#endif
X
X
X
X#define isidchar(x) (isalnum(x) || (x) == '_')
X
X#define dprintf if (!debug) ; else printf
X
X#define MAXARGS 16
X
X
X
Xint verbose, debug, incomment;
X
X
Xstruct warnstruct {
X char *bad, *good;
X} warntypes[] = {
X { "char", "int" },
X { "signed char", "int" },
X { "unsigned char", "int" },
X { "short", "int" },
X { "signed short", "int" },
X { "unsigned short", "int" },
X { "boolean", "int" },
X { "Boolean", "int" },
X { "float", "double" },
X { NULL, NULL }
X} ;
X
X
X
Xint readline(buf, inf)
Xchar *buf;
XFILE *inf;
X{
X char *cp, *cp2;
X int spflag;
X
X for (;;) {
X if (fgets(buf, 1000, inf)) {
X cp = buf;
X cp2 = buf;
X spflag = 0;
X while (*cp) {
X if (incomment) {
X if (cp[0] == '*' && cp[1] == '/') {
X incomment = 0;
X cp += 2;
X } else
X cp++;
X spflag = 1;
X } else {
X if (cp[0] == '/' && cp[1] == '*') {
X incomment = 1;
X cp += 2;
X } else if (isspace(*cp)) {
X spflag = 1;
X cp++;
X } else {
X if (spflag)
X *cp2++ = ' ';
X *cp2++ = *cp++;
X spflag = 0;
X }
X }
X }
X *cp2 = 0;
X if (!*buf)
X continue;
X if (verbose)
X printf("\217%s\210\n", buf);
X return 1;
X } else
X strcpy(buf, "\001");
X return 0;
X }
X}
X
X
X
X
Xint strbeginsword(s1, s2)
Xregister char *s1, *s2;
X{
X while (*s2 && *s1 == *s2)
X s1++, s2++;
X return (!*s2 && !isidchar(*s1));
X}
X
X
X
X
Xvoid usage()
X{
X fprintf(stderr, "usage: makeproto [options] [infile ...] [-o outfile]]\n");
X fprintf(stderr, " -tnnn Tab to nnn after type name [default 15]\n");
X fprintf(stderr, " -annn Tab to nnn before arguments [default 30]\n");
X fprintf(stderr, " -s0 Omit functions declared static\n");
X fprintf(stderr, " -s1 Omit functions not declared static\n");
X fprintf(stderr, " -x Add \"extern\" keyword (-X => \"Extern\")\n");
X fprintf(stderr, " -n Include argument names in prototypes\n");
X fprintf(stderr, " -m Use PP/PV macro notation\n");
X exit(1);
X}
X
X
X
X
X#define bounce(msg) do { if (verbose) printf("Bounced: %s\n", msg); if (stupid) goto Lbounce; } while (0)
X
X
X
X
X
Xmain(argc, argv)
Xint argc;
Xchar **argv;
X{
X FILE *inf, *outf;
X char outfname[256];
X char buf[1000], ifdefname[256];
X char ftype[256], fname[80], dtype[256], decl[256], dname[80], temp[256];
X char argdecls[MAXARGS][256], argnames[MAXARGS][80];
X char *cp, *cp2, *cp3;
X int i, j, pos, len, thistab, numstars, whichf, nargs, incomment, errors = 0;
X long li;
X int typetab = 15, argtab = 30, width = 80, usenames = 0, usemacros = 0;
X int useextern = 0, staticness = -1, hasheader = 0, useifdefs = 0;
X int stupid = 1, firstdecl;
X
X errors = 0;
X verbose = 0;
X debug = 0;
X *outfname = 0;
X while (argc > 1 && argv[1][0] == '-') {
X if (argv[1][1] == 't') {
X typetab = atoi(argv[1] + 2);
X } else if (argv[1][1] == 'a') {
X argtab = atoi(argv[1] + 2);
X } else if (argv[1][1] == 'w') {
X width = atoi(argv[1] + 2);
X } else if (argv[1][1] == 's') {
X staticness = atoi(argv[1] + 2);
X } else if (argv[1][1] == 'v') {
X verbose = 1;
X } else if (argv[1][1] == 'D') {
X debug = 1;
X } else if (argv[1][1] == 'x') {
X useextern = 1;
X } else if (argv[1][1] == 'X') {
X useextern = 2;
X } else if (argv[1][1] == 'n') {
X usenames = 1;
X } else if (argv[1][1] == 'm') {
X usemacros = 1;
X } else if (argv[1][1] == 'h') {
X hasheader = 1;
X } else if (argv[1][1] == 'i') {
X useifdefs = 1;
X } else if (argv[1][1] == 'o' && argc > 2) {
X strcpy(outfname, argv[2]);
X argc--, argv++;
X } else {
X usage();
X }
X argc--, argv++;
X }
X if (argc > 2 && !strcmp(argv[argc-2], "-o")) {
X strcpy(outfname, argv[argc-1]);
X argc -= 2;
X }
X if (*outfname) {
X outf = fopen(outfname, "w");
X if (!outf) {
X perror(outfname);
X exit(1);
X }
X } else
X outf = stdout;
X if (hasheader) {
X time(&li);
X cp = ctime(&li);
X cp[24] = 0;
X fprintf(outf, "\n/* Declarations created by \"makeproto\" on %s */\n", cp);
X fprintf(outf, "\n\n");
X }
X incomment = 0;
X for (whichf = 1; whichf < argc + (argc < 2); whichf++) {
X if (whichf >= argc || !strcmp(argv[whichf], "-")) {
X inf = stdin;
X } else {
X inf = fopen(argv[whichf], "r");
X if (!inf) {
X perror(argv[whichf]);
X fprintf(outf, "\n/* Unable to open file %s */\n", argv[whichf]);
X errors++;
X continue;
X }
X }
X firstdecl = 1;
X while (readline(buf, inf)) {
X if (!isidchar(*buf))
X continue;
X cp = buf;
X cp2 = ftype;
X numstars = 0;
X while (isspace(*cp) || isidchar(*cp))
X *cp2++ = *cp++;
X if (*cp == '*') {
X while (*cp == '*' || isspace(*cp)) {
X if (*cp == '*')
X numstars++;
X cp++;
X }
X } else {
X while (cp > buf && isspace(cp[-1])) cp--, cp2--;
X while (cp > buf && isidchar(cp[-1])) cp--, cp2--;
X }
X while (cp2 > ftype && isspace(cp2[-1])) cp2--;
X *cp2 = 0;
X if (!*ftype)
X strcpy(ftype, "int");
X dprintf("numstars is %d\n", numstars); /***/
X dprintf("ftype is %s\n", ftype); /***/
X dprintf("cp after ftype is %s\n", cp); /***/
X if (strbeginsword(ftype, "static") || strbeginsword(ftype, "Static")) {
X if (staticness == 0)
X bounce("Function is static");
X } else {
X if (staticness == 1)
X bounce("Function is not static");
X if (useextern &&
X !strbeginsword(ftype, "extern") && !strbeginsword(ftype, "Extern")) {
X sprintf(temp, useextern == 2 ? "Extern %s" : "extern %s", ftype);
X strcpy(ftype, temp);
X }
X }
X while (isspace(*cp)) cp++;
X if (!*cp) {
X readline(buf, inf);
X cp = buf;
X }
X dprintf("cp before fname is %s\n", cp); /***/
X if (!isidchar(*cp))
X bounce("No function name");
X cp2 = fname;
X while (isidchar(*cp))
X *cp2++= *cp++;
X *cp2 = 0;
X dprintf("fname is %s\n", fname); /***/
X dprintf("cp after fname is %s\n", cp); /***/
X while (isspace(*cp)) cp++;
X if (*cp++ != '(')
X bounce("No function '('");
X nargs = 0;
X if (!*cp) {
X readline(buf, inf);
X cp = buf;
X }
X while (isspace(*cp)) cp++;
X while (*cp != ')') {
X if (!isidchar(*cp))
X bounce("Missing argument name");
X if (nargs >= MAXARGS)
X bounce("Too many arguments");
X cp2 = argnames[nargs];
X argdecls[nargs][0] = 0;
X nargs++;
X while (isidchar(*cp))
X *cp2++ = *cp++;
X *cp2 = 0;
X dprintf("Argument %d is named %s\n", nargs-1, argnames[nargs-1]); /***/
X while (isspace(*cp)) cp++;
X if (*cp == ',') {
X cp++;
X if (!*cp) {
X readline(buf, inf);
X cp = buf;
X }
X while (isspace(*cp)) cp++;
X } else if (*cp != ')')
X bounce("Missing function ')'");
X }
X if (cp[1])
X bounce("Characters after function ')'");
X readline(buf, inf);
X cp = buf;
X for (;;) {
X while (isspace(*cp)) cp++;
X if (isidchar(*cp)) {
X cp2 = dtype;
X if (strbeginsword(cp, "register")) {
X cp += 8;
X while (isspace(*cp)) cp++;
X }
X while (isspace(*cp) || isidchar(*cp))
X *cp2++ = *cp++;
X if (*cp == ',' || *cp == ';' || *cp == '[') {
X while (cp2 > dtype && isspace(cp2[-1])) cp--, cp2--;
X while (cp2 > dtype && isidchar(cp2[-1])) cp--, cp2--;
X } else if (*cp != '(' && *cp != '*')
X bounce("Strange character in arg decl");
X while (cp2 > dtype && isspace(cp2[-1])) cp2--;
X *cp2 = 0;
X if (!*dtype)
X bounce("Empty argument type");
X for (;;) {
X cp2 = decl;
X cp3 = dname;
X while (*cp == '*' || *cp == '(' || isspace(*cp))
X *cp2++ = *cp++;
X if (!isidchar(*cp))
X bounce("Missing arg decl name");
X while (isidchar(*cp)) {
X if (usenames)
X *cp2++ = *cp;
X *cp3++ = *cp++;
X }
X if (!usenames) {
X while (cp2 > decl && isspace(cp2[-1])) cp2--;
X while (isspace(*cp)) cp++;
X }
X i = 0;
X while (*cp && *cp != ';' && (*cp != ',' || i > 0)) {
X if (*cp == '(' || *cp == '[') i++;
X if (*cp == ')' || *cp == ']') i--;
X *cp2++ = *cp++;
X }
X *cp2 = 0;
X *cp3 = 0;
X dprintf("Argument %s is %s\n", dname, decl); /***/
X if (i > 0)
X bounce("Unbalanced parens in arg decl");
X if (!*cp)
X bounce("Missing ';' or ',' in arg decl");
X for (i = 0; i < nargs && strcmp(argnames[i], dname); i++) ;
X if (i >= nargs)
X bounce("Arg decl name not in argument list");
X if (*decl)
X sprintf(argdecls[i], "%s %s", dtype, decl);
X else
X strcpy(argdecls[i], dtype);
X if (*cp == ',') {
X cp++;
X if (!*cp) {
X readline(buf, inf);
X cp = buf;
X }
X while (isspace(*cp)) cp++;
X } else
X break;
X }
X cp++;
X if (!*cp) {
X readline(buf, inf);
X cp = buf;
X }
X } else
X break;
X }
X if (*cp != '{')
X bounce("Missing function '{'");
X if (firstdecl) {
X firstdecl = 0;
X if (argc > 2)
X fprintf(outf, "\n/* Declarations from %s */\n", argv[whichf]);
X if (useifdefs && inf != stdin) {
X strcpy(ifdefname, argv[whichf]);
X cp = ifdefname;
X for (cp2 = ifdefname; *cp2; ) {
X if (*cp2++ == '/')
X cp = cp2;
X }
X for (cp2 = ifdefname; *cp; cp++, cp2++) {
X if (islower(*cp))
X *cp2 = toupper(*cp);
X else if (isalnum(*cp))
X *cp2 = *cp;
X else
X *cp2 = '_';
X }
X fprintf(outf, "#ifdef PROTO_%s\n", ifdefname);
X }
X }
X for (i = 0; i < nargs; i++) {
X if (!argdecls[i][0])
X sprintf(argdecls[i], "int %s", argnames[i]);
X for (j = 0; warntypes[j].bad &&
X !strbeginsword(argdecls[i], warntypes[j].bad); j++) ;
X if (warntypes[j].bad) {
X cp = argdecls[i];
X while (isspace(*cp) || isidchar(*cp)) cp++;
X if (!*cp) { /* not, e.g., "char *" */
X sprintf(temp, "%s%s", warntypes[j].good,
X argdecls[i] + strlen(warntypes[j].bad));
X strcpy(argdecls[i], temp);
X fprintf(stderr, "Warning: Argument %s of %s has type %s\n",
X argnames[i], fname, warntypes[j]);
X }
X }
X }
X if (verbose && outf != stdout)
X printf("Found declaration for %s\n", fname);
X fprintf(outf, "%s", ftype);
X pos = strlen(ftype) + numstars;
X do {
X putc(' ', outf);
X pos++;
X } while (pos < typetab);
X for (i = 1; i <= numstars; i++)
X putc('*', outf);
X fprintf(outf, "%s", fname);
X pos += strlen(fname);
X do {
X putc(' ', outf);
X pos++;
X } while (pos < argtab);
X if (nargs == 0) {
X if (usemacros)
X fprintf(outf, "PV();");
X else
X fprintf(outf, "(void);");
X } else {
X if (usemacros)
X fprintf(outf, "PP( ("), pos += 5;
X else
X fprintf(outf, "("), pos++;
X thistab = pos;
X for (i = 0; i < nargs; i++) {
X len = strlen(argdecls[i]);
X if (i > 0) {
X putc(',', outf);
X pos++;
X if (pos > thistab && pos + len >= width) {
X putc('\n', outf);
X for (j = 1; j <= thistab; j++)
X putc(' ', outf);
X pos = thistab;
X } else {
X putc(' ', outf);
X pos++;
X }
X }
X fprintf(outf, "%s", argdecls[i]);
X pos += len;
X }
X if (usemacros)
X fprintf(outf, ") );");
X else
X fprintf(outf, ");");
X }
X putc('\n', outf);
XLbounce: ;
X }
X if (inf != stdin) {
X if (useifdefs && !firstdecl)
X fprintf(outf, "#endif /*PROTO_%s*/\n", ifdefname);
X fclose(inf);
X }
X }
X if (hasheader) {
X fprintf(outf, "\n\n/* End. */\n\n");
X }
X if (outf != stdout)
X fclose(outf);
X if (errors)
X exit(1);
X else
X exit(0);
X}
X
X
X
X/* End. */
X
X
X
END_OF_FILE
if test 16377 -ne `wc -c <'src/makeproto.c'`; then
echo shar: \"'src/makeproto.c'\" unpacked with wrong size!
fi
# end of 'src/makeproto.c'
fi
if test -f 'src/p2clib.c' -a "${1}" != "-c" ; then
echo shar: Will not clobber existing file \"'src/p2clib.c'\"
else
echo shar: Extracting \"'src/p2clib.c'\" \(16729 characters\)
sed "s/^X//" >'src/p2clib.c' <<'END_OF_FILE'
X
X/* Run-time library for use with "p2c", the Pascal to C translator */
X
X/* "p2c" Copyright (C) 1989 Dave Gillespie.
X * This file may be copied, modified, etc. in any way. It is not restricted
X * by the licence agreement accompanying p2c itself.
X */
X
X
X
X#include "p2c.h"
X
X
X/* #define LACK_LABS */ /* Define these if necessary */
X/* #define LACK_MEMMOVE */
X
X
X#ifndef NO_TIME
X# include <time.h>
X#endif
X
X
X#define Isspace(c) isspace(c) /* or "((c) == ' ')" if preferred */
X
X
X
X
Xint P_argc;
Xchar **P_argv;
X
Xshort P_escapecode;
Xint P_ioresult;
X
Xlong EXCP_LINE; /* Used by Pascal workstation system */
X
XAnyptr __MallocTemp__;
X
X__p2c_jmp_buf *__top_jb;
X
X
X
X
Xvoid PASCAL_MAIN(argc, argv)
Xint argc;
Xchar **argv;
X{
X P_argc = argc;
X P_argv = argv;
X __top_jb = NULL;
X
X#ifdef LOCAL_INIT
X LOCAL_INIT();
X#endif
X}
X
X
X
X
X
X/* In case your system lacks these... */
X
X#ifdef LACK_LABS
Xlong labs(x)
Xlong x;
X{
X return((x > 0) ? x : -x);
X}
X#endif
X
X
X#ifdef LACK_MEMMOVE
XAnyptr memmove(d, s, n)
XAnyptr d, s;
Xregister long n;
X{
X if (d < s || d - s >= n) {
X memcpy(d, s, n);
X return d;
X } else if (n > 0) {
X register char *dd = d + n, *ss = s + n;
X while (--n >= 0)
X *--dd = *--ss;
X }
X return d;
X}
X#endif
X
X
Xint my_toupper(c)
Xint c;
X{
X if (islower(c))
X return _toupper(c);
X else
X return c;
X}
X
X
Xint my_tolower(c)
Xint c;
X{
X if (isupper(c))
X return _tolower(c);
X else
X return c;
X}
X
X
X
X
Xlong ipow(a, b)
Xlong a, b;
X{
X long v;
X
X if (a == 0 || a == 1)
X return a;
X if (a == -1)
X return (b & 1) ? -1 : 1;
X if (b < 0)
X return 0;
X if (a == 2)
X return 1 << b;
X v = (b & 1) ? a : 1;
X while ((b >>= 1) > 0) {
X a *= a;
X if (b & 1)
X v *= a;
X }
X return v;
X}
X
X
X
X
X/* Common string functions: */
X
X/* Store in "ret" the substring of length "len" starting from "pos" (1-based).
X Store a shorter or null string if out-of-range. Return "ret". */
X
Xchar *strsub(ret, s, pos, len)
Xregister char *ret, *s;
Xregister int pos, len;
X{
X register char *s2;
X
X if (--pos < 0 || len <= 0) {
X *ret = 0;
X return ret;
X }
X while (pos > 0) {
X if (!*s++) {
X *ret = 0;
X return ret;
X }
X pos--;
X }
X s2 = ret;
X while (--len >= 0) {
X if (!(*s2++ = *s++))
X return ret;
X }
X *s2 = 0;
X return ret;
X}
X
X
X/* Return the index of the first occurrence of "pat" as a substring of "s",
X starting at index "pos" (1-based). Result is 1-based, 0 if not found. */
X
Xint strpos2(s, pat, pos)
Xchar *s;
Xregister char *pat;
Xregister int pos;
X{
X register char *cp, ch;
X register int slen;
X
X if (--pos < 0)
X return 0;
X slen = strlen(s) - pos;
X cp = s + pos;
X if (!(ch = *pat++))
X return 0;
X pos = strlen(pat);
X slen -= pos;
X while (--slen >= 0) {
X if (*cp++ == ch && !strncmp(cp, pat, pos))
X return cp - s;
X }
X return 0;
X}
X
X
X/* Case-insensitive version of strcmp. */
X
Xint strcicmp(s1, s2)
Xregister char *s1, *s2;
X{
X register unsigned char c1, c2;
X
X while (*s1) {
X if (*s1++ != *s2++) {
X if (!s2[-1])
X return 1;
X c1 = toupper(s1[-1]);
X c2 = toupper(s2[-1]);
X if (c1 != c2)
X return c1 - c2;
X }
X }
X if (*s2)
X return -1;
X return 0;
X}
X
X
X
X
X/* HP and Turbo Pascal string functions: */
X
X/* Trim blanks at left end of string. */
X
Xchar *strltrim(s)
Xregister char *s;
X{
X while (Isspace(*s++)) ;
X return s - 1;
X}
X
X
X/* Trim blanks at right end of string. */
X
Xchar *strrtrim(s)
Xregister char *s;
X{
X register char *s2 = s;
X
X while (*++s2) ;
X while (s2 > s && Isspace(*--s2))
X *s2 = 0;
X return s;
X}
X
X
X/* Store in "ret" "num" copies of string "s". Return "ret". */
X
Xchar *strrpt(ret, s, num)
Xchar *ret;
Xregister char *s;
Xregister int num;
X{
X register char *s2 = ret;
X register char *s1;
X
X while (--num >= 0) {
X s1 = s;
X while ((*s2++ = *s1++)) ;
X s2--;
X }
X return ret;
X}
X
X
X/* Store in "ret" string "s" with enough pad chars added to reach "size". */
X
Xchar *strpad(ret, s, padchar, num)
Xchar *ret;
Xregister char *s;
Xregister int padchar, num;
X{
X register char *d = ret;
X
X if (s == d) {
X while (*d++) ;
X } else {
X while ((*d++ = *s++)) ;
X }
X num -= (--d - ret);
X while (--num >= 0)
X *d++ = padchar;
X *d = 0;
X return ret;
X}
X
X
X/* Copy the substring of length "len" from index "spos" of "s" (1-based)
X to index "dpos" of "d", lengthening "d" if necessary. Length and
X indices must be in-range. */
X
Xvoid strmove(len, s, spos, d, dpos)
Xregister char *s, *d;
Xregister int len, spos, dpos;
X{
X s += spos - 1;
X d += dpos - 1;
X while (*d && --len >= 0)
X *d++ = *s++;
X if (len > 0) {
X while (--len >= 0)
X *d++ = *s++;
X *d = 0;
X }
X}
X
X
X/* Delete the substring of length "len" at index "pos" from "s".
X Delete less if out-of-range. */
X
Xvoid strdelete(s, pos, len)
Xregister char *s;
Xregister int pos, len;
X{
X register int slen;
X
X if (--pos < 0)
X return;
X slen = strlen(s) - pos;
X if (slen <= 0)
X return;
X s += pos;
X if (slen <= len) {
X *s = 0;
X return;
X }
X while ((*s = s[len])) s++;
X}
X
X
X/* Insert string "src" at index "pos" of "dst". */
X
Xvoid strinsert(src, dst, pos)
Xregister char *src, *dst;
Xregister int pos;
X{
X register int slen, dlen;
X
X if (--pos < 0)
X return;
X dlen = strlen(dst);
X dst += dlen;
X dlen -= pos;
X if (dlen <= 0) {
X strcpy(dst, src);
X return;
X }
X slen = strlen(src);
X do {
X dst[slen] = *dst;
X --dst;
X } while (--dlen >= 0);
X dst++;
X while (--slen >= 0)
X *dst++ = *src++;
X}
X
X
X
X
X/* File functions */
X
X/* Peek at next character of input stream; return EOF at end-of-file. */
X
Xint P_peek(f)
XFILE *f;
X{
X int ch;
X
X ch = getc(f);
X if (ch == EOF)
X return EOF;
X ungetc(ch, f);
X return (ch == '\n') ? ' ' : ch;
X}
X
X
X/* Check if at end of file, using Pascal "eof" semantics. End-of-file for
X stdin is broken; remove the special case for it to be broken in a
X different way. */
X
Xint P_eof(f)
XFILE *f;
X{
X register int ch;
X
X if (feof(f))
X return 1;
X if (f == stdin)
X return 0; /* not safe to look-ahead on the keyboard! */
X ch = getc(f);
X if (ch == EOF)
X return 1;
X ungetc(ch, f);
X return 0;
X}
X
X
X/* Check if at end of line (or end of entire file). */
X
Xint P_eoln(f)
XFILE *f;
X{
X register int ch;
X
X ch = getc(f);
X if (ch == EOF)
X return 1;
X ungetc(ch, f);
X return (ch == '\n');
X}
X
X
X/* Read a packed array of characters from a file. */
X
XVoid P_readpaoc(f, s, len)
XFILE *f;
Xchar *s;
Xint len;
X{
X int ch;
X
X for (;;) {
X if (len <= 0)
X return;
X ch = getc(f);
X if (ch == EOF || ch == '\n')
X break;
X *s++ = ch;
X --len;
X }
X while (--len >= 0)
X *s++ = ' ';
X if (ch != EOF)
X ungetc(ch, f);
X}
X
XVoid P_readlnpaoc(f, s, len)
XFILE *f;
Xchar *s;
Xint len;
X{
X int ch;
X
X for (;;) {
X ch = getc(f);
X if (ch == EOF || ch == '\n')
X break;
X if (len > 0) {
X *s++ = ch;
X --len;
X }
X }
X while (--len >= 0)
X *s++ = ' ';
X}
X
X
X/* Compute maximum legal "seek" index in file (0-based). */
X
Xlong P_maxpos(f)
XFILE *f;
X{
X long savepos = ftell(f);
X long val;
X
X if (fseek(f, 0L, SEEK_END))
X return -1;
X val = ftell(f);
X if (fseek(f, savepos, SEEK_SET))
X return -1;
X return val;
X}
X
X
X/* Use packed array of char for a file name. */
X
Xchar *P_trimname(fn, len)
Xregister char *fn;
Xregister int len;
X{
X static char fnbuf[256];
X register char *cp = fnbuf;
X
X while (--len >= 0 && *fn && !isspace(*fn))
X *cp++ = *fn++;
X return fnbuf;
X}
X
X
X
X
X/* Pascal's "memavail" doesn't make much sense in Unix with virtual memory.
X We fix memory size as 10Meg as a reasonable compromise. */
X
Xlong memavail()
X{
X return 10000000; /* worry about this later! */
X}
X
Xlong maxavail()
X{
X return memavail();
X}
X
X
X
X
X/* Sets are stored as an array of longs. S[0] is the size of the set;
X S[N] is the N'th 32-bit chunk of the set. S[0] equals the maximum
X I such that S[I] is nonzero. S[0] is zero for an empty set. Within
X each long, bits are packed from lsb to msb. The first bit of the
X set is the element with ordinal value 0. (Thus, for a "set of 5..99",
X the lowest five bits of the first long are unused and always zero.) */
X
X/* (Sets with 32 or fewer elements are normally stored as plain longs.) */
X
Xlong *P_setunion(d, s1, s2) /* d := s1 + s2 */
Xregister long *d, *s1, *s2;
X{
X long *dbase = d++;
X register int sz1 = *s1++, sz2 = *s2++;
X while (sz1 > 0 && sz2 > 0) {
X *d++ = *s1++ | *s2++;
X sz1--, sz2--;
X }
X while (--sz1 >= 0)
X *d++ = *s1++;
X while (--sz2 >= 0)
X *d++ = *s2++;
X *dbase = d - dbase - 1;
X return dbase;
X}
X
X
Xlong *P_setint(d, s1, s2) /* d := s1 * s2 */
Xregister long *d, *s1, *s2;
X{
X long *dbase = d++;
X register int sz1 = *s1++, sz2 = *s2++;
X while (--sz1 >= 0 && --sz2 >= 0)
X *d++ = *s1++ & *s2++;
X while (--d > dbase && !*d) ;
X *dbase = d - dbase;
X return dbase;
X}
X
X
Xlong *P_setdiff(d, s1, s2) /* d := s1 - s2 */
Xregister long *d, *s1, *s2;
X{
X long *dbase = d++;
X register int sz1 = *s1++, sz2 = *s2++;
X while (--sz1 >= 0 && --sz2 >= 0)
X *d++ = *s1++ & ~*s2++;
X if (sz1 >= 0) {
X while (sz1-- >= 0)
X *d++ = *s1++;
X }
X while (--d > dbase && !*d) ;
X *dbase = d - dbase;
X return dbase;
X}
X
X
Xlong *P_setxor(d, s1, s2) /* d := s1 / s2 */
Xregister long *d, *s1, *s2;
X{
X long *dbase = d++;
X register int sz1 = *s1++, sz2 = *s2++;
X while (sz1 > 0 && sz2 > 0) {
X *d++ = *s1++ ^ *s2++;
X sz1--, sz2--;
X }
X while (--sz1 >= 0)
X *d++ = *s1++;
X while (--sz2 >= 0)
X *d++ = *s2++;
X *dbase = d - dbase - 1;
X return dbase;
X}
X
X
Xint P_inset(val, s) /* val IN s */
Xregister unsigned val;
Xregister long *s;
X{
X register int bit;
X bit = val % SETBITS;
X val /= SETBITS;
X if (val < *s++ && ((1<<bit) & s[val]))
X return 1;
X return 0;
X}
X
X
Xlong *P_addset(s, val) /* s := s + [val] */
Xregister long *s;
Xregister unsigned val;
X{
X register long *sbase = s;
X register int bit, size;
X bit = val % SETBITS;
X val /= SETBITS;
X size = *s;
X if (++val > size) {
X s += size;
X while (val > size)
X *++s = 0, size++;
X *sbase = size;
X } else
X s += val;
X *s |= 1<<bit;
X return sbase;
X}
X
X
Xlong *P_addsetr(s, v1, v2) /* s := s + [v1..v2] */
Xregister long *s;
Xregister unsigned v1, v2;
X{
X register long *sbase = s;
X register int b1, b2, size;
X if (v1 > v2)
X return sbase;
X b1 = v1 % SETBITS;
X v1 /= SETBITS;
X b2 = v2 % SETBITS;
X v2 /= SETBITS;
X size = *s;
X v1++;
X if (++v2 > size) {
X while (v2 > size)
X s[++size] = 0;
X s[v2] = 0;
X *s = v2;
X }
X s += v1;
X if (v1 == v2) {
X *s |= (~((-2)<<(b2-b1))) << b1;
X } else {
X *s++ |= (-1) << b1;
X while (++v1 < v2)
X *s++ = -1;
X *s |= ~((-2) << b2);
X }
X return sbase;
X}
X
X
Xlong *P_remset(s, val) /* s := s - [val] */
Xregister long *s;
Xregister unsigned val;
X{
X register int bit;
X bit = val % SETBITS;
X val /= SETBITS;
X if (++val <= *s)
X s[val] &= ~(1<<bit);
X return s;
X}
X
X
Xint P_setequal(s1, s2) /* s1 = s2 */
Xregister long *s1, *s2;
X{
X register int size = *s1++;
X if (*s2++ != size)
X return 0;
X while (--size >= 0) {
X if (*s1++ != *s2++)
X return 0;
X }
X return 1;
X}
X
X
Xint P_subset(s1, s2) /* s1 <= s2 */
Xregister long *s1, *s2;
X{
X register int sz1 = *s1++, sz2 = *s2++;
X if (sz1 > sz2)
X return 0;
X while (--sz1 >= 0) {
X if (*s1++ & ~*s2++)
X return 0;
X }
X return 1;
X}
X
X
Xlong *P_setcpy(d, s) /* d := s */
Xregister long *d, *s;
X{
X register long *save_d = d;
X
X#ifdef SETCPY_MEMCPY
X memcpy(d, s, (*s + 1) * sizeof(long));
X#else
X register int i = *s + 1;
X while (--i >= 0)
X *d++ = *s++;
X#endif
X return save_d;
X}
X
X
X/* s is a "smallset", i.e., a 32-bit or less set stored
X directly in a long. */
X
Xlong *P_expset(d, s) /* d := s */
Xregister long *d;
Xlong s;
X{
X if ((d[1] = s))
X *d = 1;
X else
X *d = 0;
X return d;
X}
X
X
Xlong P_packset(s) /* convert s to a small-set */
Xregister long *s;
X{
X if (*s++)
X return *s;
X else
X return 0;
X}
X
X
X
X
X
X/* Oregon Software Pascal extensions, courtesy of William Bader */
X
Xint P_getcmdline(l, h, line)
Xint l, h;
XChar *line;
X{
X int i, len;
X char *s;
X
X h = h - l + 1;
X len = 0;
X for(i = 1; i < P_argc; i++) {
X s = P_argv[i];
X while (*s) {
X if (len >= h) return len;
X line[len++] = *s++;
X }
X if (len >= h) return len;
X line[len++] = ' ';
X }
X return len;
X}
X
XVoid TimeStamp(Day, Month, Year, Hour, Min, Sec)
Xint *Day, *Month, *Year, *Hour, *Min, *Sec;
X{
X#ifndef NO_TIME
X struct tm *tm;
X long clock;
X
X time(&clock);
X tm = localtime(&clock);
X *Day = tm->tm_mday;
X *Month = tm->tm_mon + 1; /* Jan = 0 */
X *Year = tm->tm_year;
X if (*Year < 1900)
X *Year += 1900; /* year since 1900 */
X *Hour = tm->tm_hour;
X *Min = tm->tm_min;
X *Sec = tm->tm_sec;
X#endif
X}
X
X
X
X
X/* SUN Berkeley Pascal extensions */
X
XVoid P_sun_argv(s, len, n)
Xregister char *s;
Xregister int len, n;
X{
X register char *cp;
X
X if ((unsigned)n < P_argc)
X cp = P_argv[n];
X else
X cp = "";
X while (*cp && --len >= 0)
X *s++ = *cp++;
X while (--len >= 0)
X *s++ = ' ';
X}
X
X
X
X
Xint _OutMem()
X{
X return _Escape(-2);
X}
X
Xint _CaseCheck()
X{
X return _Escape(-9);
X}
X
Xint _NilCheck()
X{
X return _Escape(-3);
X}
X
X
X
X
X
X/* The following is suitable for the HP Pascal operating system.
X It might want to be revised when emulating another system. */
X
Xchar *_ShowEscape(buf, code, ior, prefix)
Xchar *buf, *prefix;
Xint code, ior;
X{
X char *bufp;
X
X if (prefix && *prefix) {
X strcpy(buf, prefix);
X strcat(buf, ": ");
X bufp = buf + strlen(buf);
X } else {
X bufp = buf;
X }
X if (code == -10) {
X sprintf(bufp, "Pascal system I/O error %d", ior);
X switch (ior) {
X case 3:
X strcat(buf, " (illegal I/O request)");
X break;
X case 7:
X strcat(buf, " (bad file name)");
X break;
X case FileNotFound: /*10*/
X strcat(buf, " (file not found)");
X break;
X case FileNotOpen: /*13*/
X strcat(buf, " (file not open)");
X break;
X case BadInputFormat: /*14*/
X strcat(buf, " (bad input format)");
X break;
X case 24:
X strcat(buf, " (not open for reading)");
X break;
X case 25:
X strcat(buf, " (not open for writing)");
X break;
X case 26:
X strcat(buf, " (not open for direct access)");
X break;
X case 28:
X strcat(buf, " (string subscript out of range)");
X break;
X case EndOfFile: /*30*/
X strcat(buf, " (end-of-file)");
X break;
X case FileWriteError: /*38*/
X strcat(buf, " (file write error)");
X break;
X }
X } else {
X sprintf(bufp, "Pascal system error %d", code);
X switch (code) {
X case -2:
X strcat(buf, " (out of memory)");
X break;
X case -3:
X strcat(buf, " (reference to NIL pointer)");
X break;
X case -4:
X strcat(buf, " (integer overflow)");
X break;
X case -5:
X strcat(buf, " (divide by zero)");
X break;
X case -6:
X strcat(buf, " (real math overflow)");
X break;
X case -8:
X strcat(buf, " (value range error)");
X break;
X case -9:
X strcat(buf, " (CASE value range error)");
X break;
X case -12:
X strcat(buf, " (bus error)");
X break;
X case -20:
X strcat(buf, " (stopped by user)");
X break;
X }
X }
X return buf;
X}
X
X
Xint _Escape(code)
Xint code;
X{
X char buf[100];
X
X P_escapecode = code;
X if (__top_jb) {
X __p2c_jmp_buf *jb = __top_jb;
X __top_jb = jb->next;
X longjmp(jb->jbuf, 1);
X }
X if (code == 0)
X exit(0);
X if (code == -1)
X exit(1);
X fprintf(stderr, "%s\n", _ShowEscape(buf, P_escapecode, P_ioresult, ""));
X exit(1);
X}
X
Xint _EscIO(code)
Xint code;
X{
X P_ioresult = code;
X return _Escape(-10);
X}
X
X
X
X
X/* End. */
X
X
X
END_OF_FILE
if test 16729 -ne `wc -c <'src/p2clib.c'`; then
echo shar: \"'src/p2clib.c'\" unpacked with wrong size!
fi
# end of 'src/p2clib.c'
fi
echo shar: End of archive 6 \(of 32\).
cp /dev/null ark6isdone
MISSING=""
for I in 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 ; do
if test ! -f ark${I}isdone ; then
MISSING="${MISSING} ${I}"
fi
done
if test "${MISSING}" = "" ; then
echo You have unpacked all 32 archives.
echo "Now see PACKNOTES and the README"
rm -f ark[1-9]isdone ark[1-9][0-9]isdone
else
echo You still need to unpack the following archives:
echo " " ${MISSING}
fi
## End of shell archive.
exit 0
--
Please send comp.sources.unix-related mail to rsalz at uunet.uu.net.
Use a domain-based address or give alternate paths, or you may lose out.
More information about the Comp.sources.unix
mailing list