Usenet 1994 January

home *** CD-ROM | disk | FTP | other *** search

/ Usenet 1994 January / usenetsourcesnewsgroupsinfomagicjanuary1994.iso / sources / unix / volume21 / p2c / part06 < prev next >

Wrap

Internet Message Format | 1990-04-05 | 52.0 KB

Subject: v21i051: Pascal to C translator, Part06/32 Newsgroups: comp.sources.unix Approved: rsalz@uunet.UU.NET X-Checksum-Snefru: 04b4551b c038cd24 96e47e88 44c46fad Submitted-by: Dave Gillespie <daveg@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@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