home *** CD-ROM | disk | FTP | other *** search
- Subject: v21i049: Pascal to C translator, Part04/32
- Newsgroups: comp.sources.unix
- Approved: rsalz@uunet.UU.NET
- X-Checksum-Snefru: 486b3823 1a37e96d 9c306c2d 0ab06d9b
-
- Submitted-by: Dave Gillespie <daveg@csvax.caltech.edu>
- Posting-number: Volume 21, Issue 49
- Archive-name: p2c/part04
-
- #! /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 4 (of 32)."
- # Contents: HP/import/iodecl.imp HP/include/sysdevs.h
- # examples/basic.doc examples/cref.p
- # Wrapped by rsalz@litchi.bbn.com on Mon Mar 26 14:29:28 1990
- PATH=/bin:/usr/bin:/usr/ucb ; export PATH
- if test -f 'HP/import/iodecl.imp' -a "${1}" != "-c" ; then
- echo shar: Will not clobber existing file \"'HP/import/iodecl.imp'\"
- else
- echo shar: Extracting \"'HP/import/iodecl.imp'\" \(11318 characters\)
- sed "s/^X//" >'HP/import/iodecl.imp' <<'END_OF_FILE'
- X
- X
- X{IncludeFrom=iodeclarations <p2c/iodecl.h>}
- X
- X
- X{*VarStrings=0} {*ExportSymbol=P_%s} {*Export_Symbol=%s}
- X
- X
- XMODULE IODECLARATIONS;
- XIMPORT sysglobals;
- X
- XEXPORT
- X
- X CONST
- X iominisc = 0 ;
- X iomaxisc = 31;
- X minrealisc = 7 ;
- X maxrealisc = 31;
- X
- X io_line_feed = CHR(10);
- X io_carriage_rtn = CHR(13);
- X
- X ioescapecode = -26;
- X
- X ioe_no_error = 0;
- X ioe_no_card = 1;
- X ioe_not_hpib = 2;
- X ioe_not_act = 3;
- X ioe_not_dvc = 4;
- X ioe_no_space = 5;
- X ioe_no_data = 6;
- X ioe_bad_tfr = 7;
- X ioe_isc_busy = 8;
- X ioe_buf_busy = 9;
- X ioe_bad_cnt = 10;
- X ioe_bad_tmo = 11;
- X ioe_no_driver = 12;
- X ioe_no_dma = 13;
- X ioe_no_word = 14;
- X ioe_not_talk = 15;
- X ioe_not_lstn = 16;
- X ioe_timeout = 17;
- X ioe_not_sctl = 18;
- X ioe_rds_wtc = 19;
- X ioe_bad_sct = 20;
- X ioe_crd_dwn = 21;
- X ioe_eod_seen = 22;
- X ioe_misc = 23;
- X
- X ioe_sr_toomany = 304;
- X ioe_dc_fail = 306;
- X ioe_dc_usart = 313;
- X ioe_dc_ovfl = 314;
- X ioe_dc_clk = 315;
- X ioe_dc_cts = 316;
- X ioe_dc_car = 317;
- X ioe_dc_act = 318;
- X ioe_dc_conn = 319;
- X ioe_dc_conf = 325;
- X ioe_dc_reg = 326;
- X ioe_dc_rval = 327;
- X ioe_sr_fail = 353;
- X
- X no_isc = 255;
- X
- X gtl_message = CHR( 1 );
- X sdc_message = CHR( 4 );
- X ppc_message = CHR( 5 );
- X get_message = CHR( 8 );
- X tct_message = CHR( 9 );
- X llo_message = CHR( 17 );
- X dcl_message = CHR( 20 );
- X ppu_message = CHR( 21 );
- X spe_message = CHR( 24 );
- X spd_message = CHR( 25 );
- X unl_message = CHR( 63 );
- X unt_message = CHR( 95 );
- X ppe_message = CHR( 96 );
- X ppd_message = CHR(112 );
- X
- X talk_constant = 64;
- X listen_constant = 32;
- X
- X no_card = 0 ;
- X other_card = 1 ;
- X
- X system_card = 2 ;
- X hpib_card = 3 ;
- X gpio_card = 4 ;
- X serial_card = 5 ;
- X graphics_card = 6 ;
- X srm_card = 7 ;
- X bubble_card = 8 ;
- X eprom_prgmr = 9 ;
- X
- X hp98628_dsndl = -7;
- X hp98629 = -6;
- X hp_datacomm = -5;
- X hp98620 = -4;
- X internal_kbd = -3;
- X internal_crt = -2;
- X internal_hpib = -1;
- X
- X no_id = 0;
- X
- X hp98624 = 1;
- X hp98626 = 2;
- X
- X hp98622 = 3;
- X hp98623 = 4;
- X hp98625 = 8;
- X hp98628_async = 20;
- X hpGATOR = 25;
- X hp98253 = 27;
- X hp98627 = 28;
- X hp98259 = 30;
- X hp98644 = 66;
- X
- X
- X
- X TYPE
- X type_isc = iominisc..iomaxisc ;
- X type_device = iominisc..iomaxisc*100+99;
- X io_bit = 0..15 ;
- X io_byte = 0..255 ;
- X io_word = -32768..32767 ;
- X io_string =
- X STRING[255];
- X io_proc_type = PROCEDURE;
- X errlnk_type = PROCEDURE ( errorcode : INTEGER ; VAR s : io_string );
- X
- X type_of_card = io_word;
- X type_card_id = io_word;
- X
- X
- X
- X
- X type_hpib_addr = 0..31 ;
- X type_hpib_line = ( ren_line ,
- X ifc_line ,
- X srq_line ,
- X eoi_line ,
- X nrfd_line ,
- X ndac_line ,
- X dav_line ,
- X atn_line
- X ) ;
- X
- X
- X
- X
- X type_parity = ( no_parity ,
- X odd_parity ,
- X even_parity ,
- X zero_parity ,
- X one_parity
- X );
- X type_serial_line= ( rts_line ,
- X cts_line ,
- X dcd_line ,
- X dsr_line ,
- X drs_line ,
- X ri_line ,
- X
- X dtr_line
- X );
- X
- X
- X
- X io_proc = PROCEDURE ( temp : ANYPTR );
- X io_proc_c = PROCEDURE ( temp : ANYPTR; v : CHAR );
- X io_proc_vc = PROCEDURE ( temp : ANYPTR; VAR v : CHAR);
- X io_proc_w = PROCEDURE ( temp : ANYPTR; v : io_word );
- X io_proc_vw = PROCEDURE ( temp : ANYPTR; VAR v : io_word );
- X io_proc_s = PROCEDURE ( temp : ANYPTR; reg : io_word ;
- X v : io_word );
- X io_proc_vs = PROCEDURE ( temp : ANYPTR; reg : io_word ;
- X VAR v : io_word );
- X io_proc_l = PROCEDURE ( temp : ANYPTR; line : io_bit );
- X io_proc_vl = PROCEDURE ( temp : ANYPTR; line : io_bit ;
- X VAR v : BOOLEAN );
- X io_proc_vb = PROCEDURE ( temp : ANYPTR; VAR v : BOOLEAN );
- X io_proc_ptr = PROCEDURE ( temp : ANYPTR; v : ANYPTR );
- X
- X drv_table_type = RECORD
- X iod_init : io_proc ;
- X iod_isr : ISRPROCTYPE ;
- X iod_rdb : io_proc_vc ;
- X iod_wtb : io_proc_c ;
- X iod_rdw : io_proc_vw ;
- X iod_wtw : io_proc_w ;
- X iod_rds : io_proc_vs ;
- X iod_wtc : io_proc_s ;
- X iod_end : io_proc_vb ;
- X iod_tfr : io_proc_ptr ;
- X iod_send : io_proc_c;
- X iod_ppoll : io_proc_vc ;
- X iod_set : io_proc_l ;
- X iod_clr : io_proc_l ;
- X iod_test : io_proc_vl ;
- X END;
- X
- X
- X
- X io_funny_proc = RECORD
- X CASE BOOLEAN OF
- X TRUE: ( real_proc : io_proc );
- X FALSE: ( dummy_pr : ANYPTR ; dummy_sl : ANYPTR )
- X END;
- X
- X io_temp_type = PACKED RECORD
- X myisrib : ISRIB ;
- X user_isr : io_funny_proc;
- X user_parm : ANYPTR ;
- X card_addr : ANYPTR ;
- X in_bufptr : ANYPTR ;
- X out_bufptr: ANYPTR ;
- X eirbyte : CHAR ;
- X my_isc : io_byte ;
- X timeout : INTEGER ;
- X addressed : io_word ;
- X drv_misc : ARRAY[1..32] OF CHAR ;
- X END;
- X
- X io_temp_type2 = PACKED RECORD
- X myisrib : ISRIB ;
- X user_isr : io_funny_proc;
- X user_parm : ANYPTR ;
- X card_addr : ANYPTR ;
- X in_bufptr : ANYPTR ;
- X out_bufptr: ANYPTR ;
- X eirbyte : CHAR ;
- X my_isc : io_byte ;
- X timeout : INTEGER ;
- X addressed : io_word ;
- X drv_misc : ARRAY[1..128] OF CHAR ;
- X END;
- X
- X io_temp_type3 = PACKED RECORD
- X myisrib : ISRIB ;
- X user_isr : io_funny_proc;
- X user_parm : ANYPTR ;
- X card_addr : ANYPTR ;
- X in_bufptr : ANYPTR ;
- X out_bufptr: ANYPTR ;
- X eirbyte : CHAR ;
- X my_isc : io_byte ;
- X timeout : INTEGER ;
- X addressed : io_word ;
- X drv_misc : ARRAY[1..160] OF CHAR ;
- X END;
- X
- X io_temp_type4 = PACKED RECORD
- X myisrib : ISRIB ;
- X user_isr : io_funny_proc;
- X user_parm : ANYPTR ;
- X card_addr : ANYPTR ;
- X in_bufptr : ANYPTR ;
- X out_bufptr: ANYPTR ;
- X eirbyte : CHAR ;
- X my_isc : io_byte ;
- X timeout : INTEGER ;
- X addressed : io_word ;
- X drv_misc : ARRAY[1..164] OF CHAR ;
- X END;
- X
- X
- X pio_tmp_ptr = ^io_temp_type;
- X
- X
- X isc_table_type = RECORD
- X io_drv_ptr: ^drv_table_type;
- X io_tmp_ptr: pio_tmp_ptr;
- X card_type : type_of_card;
- X user_time : INTEGER;
- X card_id : type_card_id;
- X card_ptr : ANYPTR;
- X END;
- X
- X
- X
- X user_tfr_type = ( dummy_tfr_1 ,
- X serial_DMA ,
- X serial_FHS ,
- X serial_FASTEST ,
- X dummy_tfr_2 ,
- X overlap_INTR ,
- X overlap_DMA ,
- X overlap_FHS ,
- X overlap_FASTEST ,
- X OVERLAP ) ;
- X actual_tfr_type = ( no_tfr ,
- X INTR_tfr ,
- X DMA_tfr ,
- X BURST_tfr ,
- X FHS_tfr
- X ) ;
- X dir_of_tfr = ( to_memory,
- X from_memory
- X ) ;
- X
- X buf_type = PACKED ARRAY[0..maxint] OF CHAR;
- X
- X buf_info_type = RECORD
- X drv_tmp_ptr : pio_tmp_ptr;
- X active_isc : io_byte;
- X act_tfr : actual_tfr_type ;
- X usr_tfr : user_tfr_type ;
- X b_w_mode : BOOLEAN ;
- X end_mode : BOOLEAN ;
- X direction : dir_of_tfr ;
- X term_char : -1..255 ;
- X term_count : INTEGER ;
- X buf_ptr : ^buf_type ;
- X buf_size : INTEGER ;
- X buf_empty : ANYPTR ;
- X buf_fill : ANYPTR ;
- X eot_proc : io_funny_proc;
- X eot_parm : ANYPTR ;
- X dma_priority: BOOLEAN;
- X END;
- X
- X VAR
- X dma_ch_0 : io_funny_proc ;
- X dma_isc_0 : io_byte ;
- X dma_ch_1 : io_funny_proc ;
- X dma_isc_1 : io_byte ;
- X dma_isrib0 : ISRIB ;
- X dma_isrib1 : ISRIB ;
- X dma_here : BOOLEAN;
- X
- X io_work_char : CHAR;
- X
- X ioe_result : INTEGER;
- X ioe_isc : INTEGER;
- X
- X isc_table : PACKED ARRAY [type_isc]
- X OF isc_table_type;
- X
- X io_revid : STRING[96];
- X
- X io_error_link : errlnk_type;
- X
- X PROCEDURE io_escape ( my_code : INTEGER ; select_code: INTEGER);
- X FUNCTION io_find_isc ( iod_temp : ANYPTR ): io_byte;
- XEND.
- X
- END_OF_FILE
- if test 11318 -ne `wc -c <'HP/import/iodecl.imp'`; then
- echo shar: \"'HP/import/iodecl.imp'\" unpacked with wrong size!
- fi
- # end of 'HP/import/iodecl.imp'
- fi
- if test -f 'HP/include/sysdevs.h' -a "${1}" != "-c" ; then
- echo shar: Will not clobber existing file \"'HP/include/sysdevs.h'\"
- else
- echo shar: Extracting \"'HP/include/sysdevs.h'\" \(12249 characters\)
- sed "s/^X//" >'HP/include/sysdevs.h' <<'END_OF_FILE'
- X/* Header for module SYSDEVS, generated by p2c */
- X#ifndef SYSDEVS_H
- X#define SYSDEVS_H
- X
- X
- X
- X#ifndef SYSGLOBALS_H
- X#include <p2c/sysglobals.h>
- X#endif
- X
- X
- X
- X#ifdef SYSDEVS_G
- X# define vextern
- X#else
- X# define vextern extern
- X#endif
- X
- X
- X
- X/** DUMMY DECLARATIONS ***********************************/
- X/** CRT **************************************************/
- X/****** THIS SECTION HAS HARD OFFSET REFERENCES **********/
- X/* IN MODULES CRTB (ASSY FILE GASSM) */
- X
- X
- X
- X/* 3/25/85 */
- X/* 3/25/85 */
- X/*built in crt*/
- X/* CRT CONTROL CHARS */
- X/* CRT INFO & INPUT CHARS */
- X
- Xtypedef union CRTWORD {
- X struct {
- X Char HIGHLIGHTBYTE, CHARACTER;
- X } U1;
- X short WHOLEWORD;
- X} CRTWORD;
- X
- Xtypedef enum {
- X CLLPUT, CLLSHIFTL, CLLSHIFTR, CLLCLEAR, CLLDISPLAY, PUTSTATUS
- X} CRTLLOPS;
- X
- Xtypedef enum {
- X DBINFO, DBEXCG, DBGOTOXY, DBPUT, DBINIT, DBCLEAR, DBCLINE, DBSCROLLUP,
- X DBSCROLLDN, DBSCROLLL, DBSCROLLR, DBHIGHL
- X} DBCRTOPS;
- X
- Xtypedef struct DBCINFO {
- X Char *SAVEAREA;
- X long SAVESIZE, DCURSORADDR;
- X short XMIN, XMAX, YMIN, YMAX, CURSX, CURSY;
- X Char C;
- X boolean AREAISDBCRT, CHARISMAPPED;
- X short DEBUGHIGHLIGHT;
- X} DBCINFO;
- X
- Xtypedef uchar crtconsttype[12];
- X
- Xtypedef struct crtfrec {
- X unsigned nobreak : 1, stupid : 1, slowterm : 1, hasxycrt : 1,
- X haslccrt : 1, hasclock : 1, canupscroll : 1, candownscroll : 1;
- X} crtfrec;
- X
- Xtypedef unsigned short b9;
- X
- Xtypedef unsigned short b14;
- X
- Xtypedef struct crtcrec {
- X Char rlf, ndfs, eraseeol, eraseeos, home, escape, backspace;
- X uchar fillcount;
- X Char clearscreen, clearline;
- X unsigned short prefixed;
- X} crtcrec;
- X
- Xtypedef struct crtirec {
- X short width, height;
- X long crtmemaddr, crtcontroladdr, keybufferaddr, progstateinfoaddr;
- X short keybuffersize;
- X crtconsttype crtcon;
- X Char right, left, down, up, badch, chardel, stop, break_, flush, eof,
- X altmode, linedel, backspace, etx, prefix;
- X unsigned short prefixed;
- X long cursormask, spare;
- X} crtirec;
- X
- Xtypedef struct environ {
- X crtfrec miscinfo;
- X long crttype;
- X crtcrec crtctrl;
- X crtirec crtinfo;
- X} environ;
- X
- Xtypedef enum {
- X NOCRT, ALPHATYPE, BITMAPTYPE, SPECIALCRT1, SPECIALCRT2
- X} crtkinds;
- X
- X
- X
- X/* CURSOR X POSITION */
- X/* CURSOR Y POSITION */
- X/* ACTIVE ALPHA DRIVER TYPE */
- X/* ADDRESS OF BITMAP CONTROL SPACE */
- X/* ADDRESS OF BITMAP FRAME BUFFER */
- X/* REGISTER COPIES FOR BITMAP DISPLAY */
- X/* MUST BE IN GLOBALS BECAUSE REGISTERS */
- X/* ARE NOT READABLE -- MAY BE UNDEFINED */
- X/** KEYBOARD ********************************************/
- X#define KBD_ENABLE 0
- X#define KBD_DISABLE 1
- X#define SET_AUTO_DELAY 2
- X#define SET_AUTO_REPEAT 3
- X#define GET_AUTO_DELAY 4
- X#define GET_AUTO_REPEAT 5
- X#define SET_KBDTYPE 6
- X#define SET_KBDLANG 7
- X
- X
- X
- X/*ADDED FOR 3.1--SFB-5/22/85*/
- X
- Xtypedef enum {
- X NOKBD, LARGEKBD, SMALLKBD, ITFKBD, SPECIALKBD1, SPECIALKBD2
- X} KEYBOARDTYPE;
- X
- Xtypedef enum {
- X NO_KBD, FINISH_KBD, BELGIAN_KBD, CDN_ENG_KBD, CDN_FR_KBD, NORWEGIAN_KBD,
- X DANISH_KBD, DUTCH_KBD, SWISS_GR_KBD, SWISS_FR_KBD, SPANISH_EUR_KBD,
- X SPANISH_LATIN_KBD, UK_KBD, ITALIAN_KBD, FRENCH_KBD, GERMAN_KBD,
- X SWEDISH_KBD, SPANISH_KBD, KATAKANA_KBD, US_KBD, ROMAN8_KBD, NS1_KBD,
- X NS2_KBD, NS3_KBD, SWISS_GR_B_KBD, SWISS_FR_B_KBD
- X} LANGTYPE;
- X
- Xtypedef enum {
- X M_NONE, M_SYSNORM, M_SYSSHIFT, M_U1, M_U2, M_U3, M_U4
- X} MENUTYPE;
- X
- X
- X
- X/* KEYBOARD CONFIGURATION JUMPER */
- X/** ENABLE / DISABLE *************************************/
- X#define KBDMASK 1
- X#define RESETMASK 2
- X#define TIMERMASK 4
- X#define PSIMASK 8
- X#define FHIMASK 16
- X
- X
- X
- X/* ENABLE, DISABLE */
- X/** BEEPER ***********************************************/
- X/** RPG **************************************************/
- X#define RPG_ENABLE 0
- X#define RPG_DISABLE 1
- X#define SET_RPG_RATE 2
- X#define GET_RPG_RATE 3
- X
- X
- X
- X/** BATTERY **********************************************/
- X
- X
- X
- X/** CLOCK ************************************************/
- X/*CUPDATE ADDED FOR BOBCAT 4/11/85 SFB*/
- X
- Xtypedef struct RTCTIME {
- X long PACKEDTIME, PACKEDDATE;
- X} RTCTIME;
- X
- Xtypedef enum {
- X CGETDATE, CGETTIME, CSETDATE, CSETTIME
- X} CLOCKFUNC;
- X
- Xtypedef enum {
- X CGET, CSET, CUPDATE
- X} CLOCKOP;
- X
- Xtypedef union CLOCKDATA {
- X timerec TIMETYPE;
- X daterec DATETYPE;
- X} CLOCKDATA;
- X
- X
- X
- X/* CLOCK MODULE INTERFACE */
- X/* CARD DRIVER INTERFACE */
- X/** TIMER ************************************************/
- X
- Xtypedef enum {
- X CYCLICT, PERIODICT, DELAYT, DELAY7T, MATCHT
- X} TIMERTYPES;
- X
- Xtypedef enum {
- X SETT, READT, GETTINFO
- X} TIMEROPTYPE;
- X
- Xtypedef union TIMERDATA {
- X long COUNT;
- X timerec MATCH;
- X struct {
- X long RESOLUTION, RANGE;
- X } U2;
- X} TIMERDATA;
- X
- X
- X
- X/** KEYBUFFER ********************************************/
- X#define KMAXBUFSIZE 255
- X
- X
- X
- Xtypedef enum {
- X KGETCHAR, KAPPEND, KNONADVANCE, KCLEAR, KDISPLAY, KGETLAST, KPUTFIRST
- X} KOPTYPE;
- X
- Xtypedef Char KBUFTYPE[KMAXBUFSIZE + 1];
- X
- Xtypedef struct KBUFREC {
- X boolean ECHO;
- X Char NON_CHAR;
- X long MAXSIZE, SIZE, INP, OUTP;
- X Char *BUFFER;
- X} KBUFREC;
- X
- X
- X
- 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/** KEY TRANSLATION SERVICES *********************************/
- X/* ADDED NONA_ALPHA_KEY 5/9/84 RQ/SFB */
- X
- Xtypedef enum {
- X KPASSTHRU, KSHIFT_EXTC, KPASS_EXTC
- X} KEYTRANSTYPE;
- X
- Xtypedef enum {
- X ALPHA_KEY, NONADV_KEY, SPECIAL_KEY, IGNORED_KEY, NONA_ALPHA_KEY
- X} KEYTYPE;
- X
- Xtypedef struct LANGCOMREC {
- X uchar STATUS, DATA;
- X Char KEY;
- X KEYTYPE RESULT;
- X boolean SHIFT, CONTROL, EXTENSION;
- X} LANGCOMREC;
- X
- Xtypedef struct LANGKEYREC {
- X boolean NO_CAPSLOCK, NO_SHIFT, NO_CONTROL, NO_EXTENSION;
- X KEYTYPE KEYCLASS;
- X Char KEYS[2];
- X} LANGKEYREC;
- X
- Xtypedef struct LANGRECORD {
- X boolean CAN_NONADV;
- X LANGTYPE LANGCODE;
- X _PROCEDURE SEMANTICS;
- X LANGKEYREC KEYTABLE[128];
- X} LANGRECORD;
- X
- X
- X
- X/** HPHIL ************************************************/
- X/*MOVED INTO SYSDEVS 4/6/84 SFB*/
- X#define le_configured 0x80
- X#define le_error 0x81
- X#define le_timeout 0x82
- X#define le_loopdown 0x84
- X#define lmaxdevices 7
- X
- X
- X
- X/*UNINIT ADDED 4/8/85 SFB*/
- X/*HPHILOP DEFINED AS NEW TYPE 4/6/84 SFB*/
- X/*5 PROCEDURES HOOKED AS TYPE HPHILCMDPROC 4/6/84 SFB*/
- X/* DEVICE DESCRIBE RECORD */
- X/* reserved : 0..3; {DELETED 3/25/85 SFB*/
- X/*3/27/85 SFB*/
- X/*3/26/85 SFB*/
- X/*ADDED 3/15/85 SFB*/
- X/*ADDED 3/15/85 SFB*/
- X/*REDEFINED AS RECORD - 4/6/84 SFB*/
- X/* last loop command sent */
- X/* data bye in / out */
- X/* error occured on last operation */
- X/* now doing reconfigure */
- X/* last sent command is done */
- X/* loop is configured */
- X/* reading poll data */
- X/* 3.0 BUG #39 3/17/84 */
- X
- Xtypedef enum {
- X datastarting, dataended, resetdevice, uninitdevice
- X} loopdvrop;
- X
- Xtypedef enum {
- X RAWSHIFTOP, NORMSHIFTOP, CHECKLOOPOP, CONFIGUREOP, LCOMMANDOP
- X} HPHILOP;
- X
- Xtypedef union descriprec {
- X struct {
- X uchar id;
- X unsigned twosets : 1, abscoords : 1, size16 : 1, hasprompts : 1,
- X ext_desc : 1, security : 1, numaxes : 2;
- X Signed int counts : 16, maxcountx : 16, maxcounty : 16,
- X maxcountz : 16;
- X unsigned promptack : 1, nprompts : 3, proximity : 1, nbuttons : 3;
- X } U1;
- X Char darray[11];
- X} descriprec;
- X
- Xtypedef struct devicerec {
- X long devstate;
- X descriprec descrip;
- X _PROCEDURE opsproc;
- X _PROCEDURE dataproc;
- X} devicerec;
- X
- Xtypedef struct loopdriverrec {
- X uchar lowid, highid, daddr;
- X _PROCEDURE opsproc;
- X _PROCEDURE dataproc;
- X struct loopdriverrec *next;
- X} loopdriverrec;
- X
- Xtypedef struct LOOPCONTROLREC {
- X boolean rawmode;
- X devicerec loopdevices[lmaxdevices];
- X char loopdevice;
- X uchar loopcmd, loopdata;
- X boolean looperror, loopinconfig, loopcmddone, loopisok, loopdevreading;
- X} LOOPCONTROLREC;
- X
- X
- X
- X/*NEW TO END OF HPHIL_COMM_REC TYPE 3/26/85 SFB*/
- X/*DRIVER TYPES*/
- X#define NODRIVER 0
- X#define ABSLOCATOR 1
- X
- X/*range 1..15 reserved for DGL*/
- X/*CODETYPES FROM POLLBLOCK (OR OTHER HPHIL OPCODE)*/
- X#define NOCODES 0
- X#define ASCIICODES 1
- X#define SET1CODES 2
- X#define SET2CODES 3
- X
- X
- X
- X/*3/25/85 SFB*/
- X/*3/25/85 SFB*/
- X/*stop updating data after button press/event*/
- X/*capture data in ISR*/
- X/*dvr_comm_rec busy, delay update from ISR*/
- X/*bit/loopaddress that driver should service */
- X/* put 0 where driver should NOT service device */
- X/* with this dvr_comm_rec !*/
- X/*call update to flush delayed poll data update*/
- X/*next comm record*/
- X/*for extensibility use as pointer/datarec*/
- X/*HPHIL intrinsic data types from poll/command*/
- X/*describes content of codes*/
- X/*extensible for variant*/
- X
- Xtypedef union HPHIL_COMM_REC_TYPE {
- X struct {
- X short dvr_type;
- X char dev_addr;
- X boolean latch, active, reading;
- X uchar devices;
- X _PROCEDURE update;
- X union HPHIL_COMM_REC_TYPE *link;
- X long extend;
- X short xloc, yloc, zloc, codetype, ncodes;
- X Char codes[16];
- X } U1;
- X Char barray[54];
- X} HPHIL_COMM_REC_TYPE;
- X
- X
- X
- Xvextern environ *SYSCOM;
- Xvextern boolean ALPHASTATE, GRAPHICSTATE;
- Xvextern _PROCEDURE CRTIOHOOK;
- Xvextern _PROCEDURE TOGGLEALPHAHOOK;
- Xvextern _PROCEDURE TOGGLEGRAPHICSHOOK;
- Xvextern _PROCEDURE DUMPALPHAHOOK;
- Xvextern _PROCEDURE DUMPGRAPHICSHOOK;
- Xvextern _PROCEDURE UPDATECURSORHOOK;
- Xvextern _PROCEDURE CRTINITHOOK;
- Xvextern _PROCEDURE CRTLLHOOK;
- Xvextern _PROCEDURE DBCRTHOOK;
- Xvextern short XPOS, YPOS;
- Xvextern crtkinds CURRENTCRT;
- Xvextern long BITMAPADDR, FRAMEADDR;
- Xvextern short REPLREGCOPY, WINDOWREGCOPY, WRITEREGCOPY;
- Xvextern _PROCEDURE KBDREQHOOK;
- Xvextern _PROCEDURE KBDIOHOOK;
- Xvextern _PROCEDURE KBDISRHOOK;
- Xvextern _PROCEDURE KBDPOLLHOOK;
- Xvextern KEYBOARDTYPE KBDTYPE;
- Xvextern uchar KBDCONFIG;
- Xvextern LANGTYPE KBDLANG;
- Xvextern Char *SYSMENU, *SYSMENUSHIFT;
- Xvextern MENUTYPE MENUSTATE;
- Xvextern _PROCEDURE MASKOPSHOOK, BEEPERHOOK;
- Xvextern uchar BFREQUENCY, BDURATION;
- Xvextern _PROCEDURE RPGREQHOOK;
- Xvextern _PROCEDURE RPGISRHOOK;
- Xvextern boolean BATTERYPRESENT;
- Xvextern _PROCEDURE BATCMDHOOK;
- Xvextern _PROCEDURE BATREADHOOK;
- Xvextern _PROCEDURE CLOCKREQHOOK;
- Xvextern _PROCEDURE CLOCKIOHOOK;
- Xvextern _PROCEDURE TIMERIOHOOK;
- Xvextern _PROCEDURE TIMERISRHOOK;
- Xvextern KBUFREC *KEYBUFFER;
- Xvextern _PROCEDURE KBDWAITHOOK;
- Xvextern _PROCEDURE KBDRELEASEHOOK;
- Xvextern Char STATUSLINE[8];
- Xvextern LANGCOMREC LANGCOM;
- Xvextern LANGRECORD *LANGTABLE[2];
- Xvextern char LANGINDEX;
- Xvextern _PROCEDURE KBDTRANSHOOK;
- Xvextern KEYTRANSTYPE TRANSMODE;
- Xvextern boolean KBDSYSMODE, KBDALTLOCK, KBDCAPSLOCK;
- Xvextern loopdriverrec *loopdriverlist;
- Xvextern LOOPCONTROLREC *LOOPCONTROL;
- Xvextern _PROCEDURE HPHILCMDHOOK;
- Xvextern HPHIL_COMM_REC_TYPE *HPHIL_DATA_LINK;
- X
- X
- X
- X/*4/6/84 SFB*/
- X/*4/6/84 SFB*/
- X/*3/13/85 SFB*/
- X/*-----------------------------------------------------------------------------*/
- Xextern Void SYSDEV_INIT PV( );
- X
- X/** BEEPER ***********************************************/
- Xextern Void BEEP PV( );
- Xextern Void BEEPER PP((int FREQUENCY, int DURATION));
- X
- X/** RPG **************************************************/
- Xextern Void SETRPGRATE PP((int RATE));
- X
- X/** KEYBOARD *********************************************/
- Xextern Void KBDSETUP PP((int CMD, int VALUE));
- Xextern Void KBDIO PP((fib *FP, int REQUEST, Char *BUFFER, long BUFSIZE,
- X long POSITION));
- Xextern Void lockedaction PP((_PROCEDURE a));
- X
- X/** CRT **************************************************/
- Xextern Void CRTIO PP((fib *FP, int REQUEST, Char *BUFFER, long BUFSIZE,
- X long POSITION));
- Xextern Void DUMMYCRTLL PP((int OP, long *POSITION, int C));
- X
- X/** BATTERY **********************************************/
- Xextern Void BATCOMMAND PP((int CMD, long NUMDATA, int B1, int B2, int B3,
- X int B4, int B5));
- Xextern uchar BATBYTERECEIVED PV( );
- X
- X/** CLOCK ************************************************/
- Xextern long sysclock PV( );
- X
- X/*centiseconds from midnight*/
- Xextern Void sysdate PP((daterec *thedate));
- Xextern Void systime PP((timerec *thetime));
- Xextern Void setsysdate PP((daterec thedate));
- Xextern Void setsystime PP((timerec thetime));
- X
- X/** KEYBUFFER ********************************************/
- Xextern Void KEYBUFOPS PP((int OP, Char *C));
- X
- X/** STATUSLINE *******************************************/
- Xextern Void SETSTATUS PP((long N, int C));
- Xextern Char RUNLIGHT PV( );
- Xextern Void SETRUNLIGHT PP((int C));
- X
- X
- X
- X#undef vextern
- X
- X#endif /*SYSDEVS_H*/
- X
- X/* End. */
- X
- END_OF_FILE
- if test 12249 -ne `wc -c <'HP/include/sysdevs.h'`; then
- echo shar: \"'HP/include/sysdevs.h'\" unpacked with wrong size!
- fi
- # end of 'HP/include/sysdevs.h'
- fi
- if test -f 'examples/basic.doc' -a "${1}" != "-c" ; then
- echo shar: Will not clobber existing file \"'examples/basic.doc'\"
- else
- echo shar: Extracting \"'examples/basic.doc'\" \(11310 characters\)
- sed "s/^X//" >'examples/basic.doc' <<'END_OF_FILE'
- X
- X Chipmunk BASIC 1.0
- X David Gillespie
- X
- X
- X --------------------------------------------------------------
- X
- X
- X
- X
- X COMMANDS
- X
- X
- X LIST line(s)
- X
- X List the specified program lines. For example,
- X
- X LIST 10, 100-200
- X
- X lists line 10, and lines 100 through 200, inclusive.
- X
- X
- X RUN [line]
- X
- X Begin execution of the program at the first line, or at the
- X specified line. All variables are cleared.
- X
- X
- X RUN file[,line]
- X
- X Load and run a program. For example,
- X
- X RUN "FOO", 30
- X
- X loads a program from the file FOO.TEXT and begins execution at
- X line 30.
- X
- X
- X NEW
- X
- X Erase the program in memory.
- X
- X
- X LOAD file
- X
- X Load a program into memory. The program previously in memory is
- X erased. The file name should be in quotes; a .TEXT extension is
- X automatically added. Files contain ASCII listings of the programs.
- X All lines in the file must begin with a line number, but line
- X numbers do not need to be in increasing order.
- X
- X
- X MERGE file
- X
- X Load a program into memory. The previous program remains in
- X memory; if a line exists in both programs, the newly loaded
- X line is kept.
- X
- X
- X SAVE file
- X
- X Save the program in memory to a file.
- X
- X
- X BYE
- X
- X Return to the operating system.
- X
- X
- X DEL line(s)
- X
- X Delete the specified program lines. Line numbers may be
- X separated by commas and dashes as in LIST. If used inside
- X a program, DEL will terminate execution only if it deletes
- X the line on which it appears.
- X
- X
- X RENUM [start[,inc]]
- X
- X Renumber program lines. By default, the new sequence is 10,20,30,...
- X The first argument is a new initial line number; the second argument
- X is the increment between line numbers.
- X
- X
- X
- X
- X STATEMENTS
- X
- X REM comment
- X
- X A remark; ignored. Comments may contain any characters except
- X that REM can not be immediately followed by an alphanumeric
- X character.
- X
- X
- X [LET] var = expr
- X
- X Assign a value to a variable. Variable names contain up to 20
- X significant characters, consisting of upper- and lower-case
- X letters, digits, underscores, and dollar signs. Variable names
- X are case-sensitive. Variables hold real numbers normally, or
- X strings of up to 255 characters if their names end with $.
- X
- X Examples:
- X
- X LET X=20
- X X$="FOO"
- X X$=X$+"BAR"
- X
- X
- X DIM var(dimensions), ...
- X
- X Allocate memory for arrays. Arrays may have up to 4 dimensions,
- X ranging from 0 to the value specified in the DIM statement.
- X The same name must not be used for both a simple variable and
- X an array.
- X
- X If an array is used before it is dimensioned, each dimension
- X is set to 10.
- X
- X Example:
- X
- X INPUT "How many elements? "; x
- X DIM array(x,1)
- X FOR i=1 TO x : INPUT array(i,0), array(i,1) : NEXT
- X
- X
- X PRINT items
- X
- X Print the items on the screen. Items may be either numeric
- X or string expressions, and may be separated by commas, semicolons,
- X or nothing.
- X
- X Numbers are normally terminated by spaces. To avoid this space,
- X convert the number to a string with STR$.
- X
- X The line is terminated by a CR/LF, unless the item list ends
- X with a comma or semicolon.
- X
- X The word PRINT may be abbreviated as a question mark.
- X
- X Examples:
- X
- X PRINT "1+2=", 1+2
- X PRINT X$ "=" Z$;
- X ? x; y+z
- X
- X
- X INPUT [prompt;] vars
- X
- X If a prompt string is given, it is printed. Otherwise, a
- X question mark is printed. The computer then waits for values
- X for each variable to be entered. If several variables are
- X listed, their names must be separated by commas.
- X
- X If the variables are numeric, their values may be entered
- X on separate lines, or combined with commas. Any numeric expression
- X is a valid response.
- X
- X If the variables are strings, each string is typed on a separate
- X line. The characters typed are copied verbatim into the string.
- X
- X String and numeric variables may be not mixed in a single
- X INPUT statement.
- X
- X Examples:
- X
- X INPUT X$
- X INPUT "Type 3 numbers: "; X, Y, Z
- X
- X
- X GOTO line
- X
- X Begin executing statements at the specified line. The line
- X number may be any numeric expression.
- X
- X The word GO TO may be used instead of GOTO if preferable.
- X
- X
- X IF condition THEN line/statements ELSE line/statements
- X
- X If the condition is true (i.e., the numeric expression has a
- X non-zero value), the statements following the word THEN are
- X executed. Otherwise, the statements following ELSE are
- X executed. If there is no ELSE clause, execution proceeds
- X to the next line in the program.
- X
- X A line number may be used after either THEN or ELSE, for an
- X implied GOTO statement.
- X
- X
- X END
- X
- X Terminate the program. An END statement is not required.
- X
- X
- X STOP
- X
- X Terminate the program with an identifying "Break" message.
- X
- X
- X FOR var = first TO last [STEP inc]
- X {statements}
- X NEXT [var]
- X
- X Execute {statements} repeatedly while the variable counts from
- X "first" to "last," incrementing by 1, or by the STEP value if
- X given. If the STEP value is negative, the variable counts
- X downward.
- X
- X If "first" is greater than "last" (or less than if STEP is
- X negative), execution proceeds directly to the NEXT statement,
- X without executing the body of the loop at all.
- X
- X The variable name is optional on the NEXT statement.
- X
- X
- X WHILE [condition]
- X {statements}
- X WEND [condition]
- X
- X Execute {statements} repeatedly until the WHILE condition (if
- X given) becomes false, or until the WEND condition becomes true.
- X This structure can emulate Pascal's WHILE-DO and REPEAT-UNTIL,
- X or even both at once. If no conditions are given, the loop will
- X never terminate unless the Evil GOTO is used.
- X
- X
- X GOSUB line
- X RETURN
- X
- X Execute the statements beginning at the specified line, then
- X when RETURN is reached, return to the statement following the
- X GOSUB.
- X
- X
- X READ vars
- X DATA values
- X RESTORE line
- X
- X Read numeric or string values from the DATA statements. Reading
- X begins at the first DATA statement in the program and proceeds
- X to the last. Reading past the end the last DATA statement
- X generates an error.
- X
- X The DATA values must be either numeric or string expressions,
- X according to the type of variable being read. Reading the wrong
- X kind of expression produces a Syntax Error.
- X
- X The RESTORE statement causes the next READ to re-use the first
- X DATA statement in the program, or the first DATA statement on
- X or after a particular line.
- X
- X
- X GOTOXY across, down
- X
- X Move the cursor to the specified screen position, between
- X 0,0 and 79,23.
- X
- X
- X ON expr GOTO line, line, ...
- X ON expr GOSUB line, line, ...
- X
- X If the expression's value, rounded to an integer, is N, go to
- X the Nth line number in the list. If N is less than one or is
- X too large, execution continues at the next statement after
- X the ON-GOTO or ON-GOSUB.
- X
- X
- X POKE addr, data
- X
- X Store a byte at the specified address.
- X
- X
- X
- X
- X NUMERIC EXPRESSIONS
- X
- X x AND y
- X
- X Logical AND of two integers.
- X
- X
- X x OR y
- X
- X Logical OR of two integers.
- X
- X
- X x XOR y
- X
- X Logical XOR of two integers.
- X
- X
- X NOT x
- X
- X Logical complement of an integer.
- X
- X
- X x+y, x-y, x*y, x/y, x^y, -x
- X
- X Typical floating-point arithmetic operations.
- X
- X
- X x=y, x<y, x>y, x<=y, x>=y, x<>y
- X
- X Comparisons; result is 1 if true, 0 if false.
- X
- X
- X x MOD y
- X
- X Modulo of two integers.
- X
- X
- X SQR x
- X
- X Square of X. Note that parentheses are not required if a function's
- X argument is a single entitity; for example, SQR SIN X needs no
- X parentheses, but SQR(1+X) does.
- X
- X
- X SQRT x
- X
- X Square root of X.
- X
- X
- X SIN x, COS x, TAN x, ARCTAN x
- X
- X Typical trig functions, in radians.
- X
- X
- X LOG x, EXP x
- X
- X Natural logarithm, and e the power X.
- X
- X
- X ABS x
- X
- X Absolute value of X.
- X
- X
- X SGN x
- X
- X Sign of X: 1 if X is positive, 0 if zero, -1 if negative.
- X
- X
- X VAL x$
- X
- X Value of the expression contained in the string X$. For example,
- X VAL "1+2" yields 3. X$ may be a single string literal, variable,
- X or function, or a string expression in parentheses.
- X
- X
- X ASC x$
- X
- X ASCII code of the first character in X$, or 0 if X$ is null.
- X
- X
- X LEN x$
- X
- X Number of characters in X$.
- X
- X
- X Precedence: Parentheses
- X Functions (incl. NOT and unary minus)
- X ^
- X *, /, MOD
- X +, -
- X =, <, >, <=, >=, <>
- X AND
- X OR, XOR
- X
- X
- X
- X STRING EXPRESSIONS
- X
- X "string" or 'string'
- X
- X String literal. Single quotes are converted to double quotes
- X internally.
- X
- X
- X x$+y$
- X
- X Concatenation. Result must be 255 characters or less.
- X
- X
- X x$=y$, x$<y$, x$>y$, x$<=y$, x$>=y$, x$<>y$
- X
- X String comparisons; result is 1 if true, 0 if false.
- X
- X
- X STR$(x)
- X
- X The number X expressed as a string of digits. No leading or
- X trailing spaces are included; scientific notation is used
- X if the absolute values is greater than 1E12 or less than 1E-2.
- X
- X
- X CHR$(x)
- X
- X The character whose ASCII code is X.
- X
- X
- X MID$(x$, y)
- X MID$(x$, y, z)
- X
- X (Parentheses required.) The substring consisting of the first
- X Z characters starting at position Y of string X$. Position 1
- X is the first character of the string. If Z is omitted, 255
- X is used, i.e., the entire right part of the string.
- X
- X
- X
- X CONVENTIONS
- X
- X Multiple statements may be written on a line, separated by colons:
- X
- X 10 INPUT X : PRINT X : STOP
- X
- X
- X There is actually no difference between commands and statements;
- X both can be used in or out of programs at will. Certain commands,
- X such as NEW, will, of course, halt program execution.
- X
- X
- X Line numbers may be any integer from 1 to MAXINT.
- X
- X
- X To delete a line use DEL, or type its line number alone:
- X
- X 10
- X
- X
- X Press CLR I/O to halt program execution. [This is not supported
- X by p2c's translation!] To leave BASIC, use the BYE command.
- X
- X
- X Keywords must be written in all upper- or all lower-case; they are
- X always converted to upper-case internally. Spaces are ignored in
- X the input except between quotes. Square brackets are converted to
- X parentheses. Missing closing quotes at the end of the line are
- X added, as in the command:
- X
- X SAVE "PROGRAM
- X
- X
- X
- X
- END_OF_FILE
- if test 11310 -ne `wc -c <'examples/basic.doc'`; then
- echo shar: \"'examples/basic.doc'\" unpacked with wrong size!
- fi
- # end of 'examples/basic.doc'
- fi
- if test -f 'examples/cref.p' -a "${1}" != "-c" ; then
- echo shar: Will not clobber existing file \"'examples/cref.p'\"
- else
- echo shar: Extracting \"'examples/cref.p'\" \(11280 characters\)
- sed "s/^X//" >'examples/cref.p' <<'END_OF_FILE'
- X
- X$debug$
- X$ sysprog, partial_eval $
- X
- Xprogram crefprog(input, output);
- X
- X
- Xconst
- X { linesperpage = 139; }
- X maxnamelen = 30;
- X
- X
- Xtype
- X str255 = string[255];
- X
- X occurptr = ^occur;
- X occur =
- X record
- X next : occurptr;
- X lnum : integer;
- X fnum : integer;
- X defn : boolean;
- X end;
- X
- X kinds = (k_normal, k_proc, k_var, k_const, k_type, k_strlit, k_extproc,
- X k_kw, k_prockw, k_varkw, k_constkw, k_typekw, k_beginkw);
- X
- X nodeptr = ^node;
- X node =
- X record
- X left, right : nodeptr;
- X name : string[maxnamelen];
- X first : occurptr;
- X kind : kinds;
- X end;
- X
- X
- Xvar
- X f : text;
- X fn : string[120];
- X fnum : integer;
- X buf, name : str255;
- X good : boolean;
- X i, j : integer;
- X lnum : integer;
- X np, base : nodeptr;
- X op : occurptr;
- X curkind, section : kinds;
- X paren : integer;
- X brace : integer;
- X
- X
- X
- Xprocedure lookup(var name : str255; var np : nodeptr);
- X var
- X npp : ^nodeptr;
- X begin
- X if strlen(name) > maxnamelen then
- X setstrlen(name, maxnamelen);
- X npp := addr(base);
- X while (npp^ <> nil) and (npp^^.name <> name) do
- X begin
- X if name < npp^^.name then
- X npp := addr(npp^^.left)
- X else
- X npp := addr(npp^^.right);
- X end;
- X if (npp^ = nil) then
- X begin
- X new(np);
- X npp^ := np;
- X np^.name := name;
- X np^.first := nil;
- X np^.left := nil;
- X np^.right := nil;
- X np^.kind := k_normal;
- X end
- X else
- X np := npp^;
- X end;
- X
- X
- Xprocedure kw(name : str255; kind : kinds);
- X var
- X np : nodeptr;
- X begin
- X lookup(name, np);
- X np^.kind := kind;
- X end;
- X
- X
- Xprocedure cref(np : nodeptr; kind : kinds);
- X var
- X op : occurptr;
- X begin
- X new(op);
- X op^.next := np^.first;
- X np^.first := op;
- X op^.lnum := lnum;
- X op^.fnum := fnum;
- X op^.defn := (kind in [k_var, k_type, k_const, k_proc]);
- X if op^.defn or (kind = k_strlit) or
- X ((kind = k_extproc) and (np^.kind = k_normal)) then
- X np^.kind := kind;
- X end;
- X
- X
- X
- Xprocedure traverse(np : nodeptr);
- X var
- X op : occurptr;
- X i : integer;
- X begin
- X if (np <> nil) then
- X begin
- X traverse(np^.left);
- X if np^.kind < k_kw then
- X begin
- X case np^.kind of
- X k_var:
- X write(f, 'V:');
- X k_type:
- X write(f, 'T:');
- X k_const:
- X write(f, 'C:');
- X k_proc:
- X write(f, 'P:');
- X k_strlit:
- X write(f, 'S:');
- X k_extproc:
- X write(f, 'E:');
- X k_normal:
- X write(f, 'X:');
- X end;
- X write(f, np^.name);
- X i := 0;
- X op := np^.first;
- X while op <> nil do
- X begin
- X if i = 0 then
- X begin
- X writeln(f);
- X write(f, ' ');
- X i := 5;
- X end;
- X write(f, ' ', op^.lnum:1, '/', op^.fnum:1);
- X if op^.defn then
- X write(f, '*');
- X i := i - 1;
- X op := op^.next;
- X end;
- X writeln(f);
- X end;
- X traverse(np^.right);
- X end;
- X end;
- X
- X
- X
- Xbegin
- X base := nil;
- X fnum := 0;
- X kw('procedure', k_prockw);
- X kw('function', k_prockw);
- X kw('var', k_varkw);
- X kw('record', k_varkw);
- X kw('type', k_typekw);
- X kw('const', k_constkw);
- X kw('begin', k_beginkw);
- X kw('end', k_kw);
- X kw('do', k_kw);
- X kw('for', k_kw);
- X kw('to', k_kw);
- X kw('while', k_kw);
- X kw('repeat', k_kw);
- X kw('until', k_kw);
- X kw('if', k_kw);
- X kw('then', k_kw);
- X kw('else', k_kw);
- X kw('case', k_kw);
- X kw('of', k_kw);
- X kw('div', k_kw);
- X kw('mod', k_kw);
- X kw('nil', k_kw);
- X kw('not', k_kw);
- X kw('and', k_kw);
- X kw('or', k_kw);
- X kw('with', k_kw);
- X kw('array', k_kw);
- X kw('integer', k_kw);
- X kw('char', k_kw);
- X kw('boolean', k_kw);
- X kw('true', k_kw);
- X kw('false', k_kw);
- X writeln;
- X writeln('Pascal Cross Reference Utility');
- X writeln;
- X repeat
- X fnum := fnum + 1;
- X write('Name of cross-reference file #', fnum:1, '? ');
- X readln(fn);
- X good := true;
- X if (fn <> '') then
- X begin
- X try
- X reset(f, fn);
- X recover
- X if escapecode <> -10 then
- X escape(escapecode)
- X else
- X begin
- X good := false;
- X writeln('Can''t read file!');
- X end;
- X end
- X else
- X good := false;
- X if good then
- X begin
- X lnum := 0;
- X section := k_normal;
- X curkind := k_normal;
- X paren := 0;
- X while not eof(f) do
- X begin
- X lnum := lnum + 1;
- X readln(f, buf);
- X strappend(buf, #0);
- X i := 1;
- X while (buf[i] = ' ') do
- X i := i + 1;
- X repeat
- X while not (buf[i] in ['a'..'z', 'A'..'Z', '0'..'9', '_', #0]) do
- X begin
- X case buf[i] of
- X ':', '=':
- X if brace = 0 then
- X curkind := k_normal;
- X ';':
- X if brace = 0 then
- X curkind := section;
- X '''':
- X if brace = 0 then
- X begin
- X i := i + 1;
- X j := i;
- X while ((buf[i] <> '''') or (buf[i+1] = '''')) and
- X (buf[i] <> #0) do
- X begin
- X if (buf[i] = '''') then
- X i := i + 2
- X else
- X i := i + 1;
- X end;
- X if (buf[i] = #0) then
- X i := i - 1;
- X name := '''' + str(buf, j, i-j) + '''';
- X lookup(name, np);
- X cref(np, k_strlit);
- X end;
- X '(':
- X if brace = 0 then
- X if (buf[i+1] = '*') then
- X begin
- X brace := 1;
- X i := i + 1;
- X end
- X else
- X begin
- X paren := paren + 1;
- X curkind := k_normal;
- X end;
- X ')':
- X if brace = 0 then
- X paren := paren - 1;
- X '*':
- X if (buf[i+1] = ')') then
- X begin
- X brace := 0;
- X i := i + 1;
- X end;
- X '{': brace := 1;
- X '}': brace := 0;
- X otherwise ;
- X end;
- X i := i + 1;
- X end;
- X if (buf[i] <> #0) then
- X begin
- X j := i;
- X if (buf[i] in ['0'..'9']) and (i > 1) and (buf[i-1] = '-') then
- X j := j - 1;
- X while (buf[i] in ['a'..'z', 'A'..'Z', '0'..'9', '_']) do
- X i := i + 1;
- X if brace = 0 then
- X begin
- X name := str(buf, j, i-j);
- X for j := 1 to strlen(name) do
- X if (buf[j] in ['A'..'Z']) then
- X buf[j] := chr(ord(buf[j]) + 32);
- X while (buf[i] = ' ') do
- X i := i + 1;
- X lookup(name, np);
- X case np^.kind of
- X k_varkw:
- X if paren = 0 then
- X begin
- X section := k_var;
- X curkind := section;
- X end;
- X k_typekw:
- X begin
- X section := k_type;
- X curkind := section;
- X end;
- X k_constkw:
- X begin
- X section := k_const;
- X curkind := section;
- X end;
- X k_prockw:
- X begin
- X section := k_normal;
- X curkind := k_proc;
- X end;
- X k_beginkw:
- X begin
- X section := k_normal;
- X curkind := k_normal;
- X end;
- X k_kw: ;
- X otherwise
- X if (curkind = k_normal) and (buf[i] = '(') then
- X cref(np, k_extproc)
- X else
- X cref(np, curkind);
- X end;
- X end;
- X end;
- X until buf[i] = #0;
- X end;
- X if paren <> 0 then
- X writeln('Warning: ending paren count = ', paren:1);
- X close(f);
- X end;
- X until fn = '';
- X writeln;
- X repeat
- X write('Output file name: ');
- X readln(fn);
- X until fn <> '';
- X rewrite(f, fn);
- X traverse(base);
- X close(f, 'save');
- Xend.
- X
- X
- X
- X
- END_OF_FILE
- if test 11280 -ne `wc -c <'examples/cref.p'`; then
- echo shar: \"'examples/cref.p'\" unpacked with wrong size!
- fi
- # end of 'examples/cref.p'
- fi
- echo shar: End of archive 4 \(of 32\).
- cp /dev/null ark4isdone
- 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
-