From 49b506ce1366d6db300b8edb26a1ee4bbd975dbf Mon Sep 17 00:00:00 2001
From: Mike Collins <mdcolli@evoforge.org>
Date: Tue, 13 Jul 2021 16:05:30 -0400
Subject: [PATCH] deleted obsolete c files which are not used at all
---
RIGAL/rigsc.446/src/ley2.c | 300 --------
RIGAL/rigsc.446/src/s_scan.c | 1279 ----------------------------------
2 files changed, 1579 deletions(-)
delete mode 100644 RIGAL/rigsc.446/src/ley2.c
delete mode 100644 RIGAL/rigsc.446/src/s_scan.c
diff --git a/RIGAL/rigsc.446/src/ley2.c b/RIGAL/rigsc.446/src/ley2.c
deleted file mode 100644
index 764a7d0..0000000
--- a/RIGAL/rigsc.446/src/ley2.c
+++ /dev/null
@@ -1,300 +0,0 @@
-#include "globrig.h"
-#include "define.h"
-#include "defpage.h"
-#include "ley.h"
-#include "nef2.h"
-
-
-/* lexic analysis for rigal language
- input : text file with name first_file
- and if 'NOT_INCLUDE' is false
- then all included files
- output :s-object code and added a-objects
-
- may be called from editor environment through checker
- or from usepas for user's call
- #call_pas(14 'A.RIG') or #call_pas(15 'A.RIG') .
-
- token's COoRDinates returned as LINE_NUMBER*80+SYMBOL_NUMBER
- included file names returned as tatom descriptors;
- exception: first_file never returned as first lexem.
- added letter to filename i if %included file
- c if returned from %include
-*/
-
-#define filemax 4 /* ~islo wlovenij dlq include */
-#define bufmaxlen 10 /* dlina malogo bufera , kak minimum - 8 */
-#define two_char_sym_max 50 /* maks. massiwa */
-
-
-typedef union bufrectype {
- Char lexbuf[bufmaxlen];
- Char b1;
- Char b2[2];
- Char b3[3];
- Char b4[4];
- Char b5[5];
- Char b6[6];
- Char b7[7];
- Char b8[8];
- Char b9[9];
- Char b10[10];
-} bufrectype;
-
-
-FILE *infile[filemax]; /* fajly ish. teksta */
-bufrectype bufrec; /* sohranenie dlq leksera !!!! */
-c2 twochar_symbols[two_char_sym_max];
-char twochar_symbols_num;
-
-
-typedef Char a146[146]; /* source string type */
-
-typedef Char bigstr_type[146];
-
-
-
-typedef struct _REC_fistack {
- long curline; /* current line of this file */
- filespecification f; /* file name */
-} _REC_fistack;
-
-/* Local variables for ley: */
-struct LOC_ley {
- error_rec_type *error_rec;
- a satomadr;
- long i; /* current byte */
- boolean errflag;
- a146 s;
-
- _REC_fistack fistack[filemax + 1];
- long fistacklen;
-} ;
-
-Local Void newlist(pp, LINK)
-ptr_ *pp;
-struct LOC_ley *LINK;
-{
- /* nowyj ukazatelx spiska */
- /* sozdaet nowyj spisok */
- mpd x;
- a a1;
-
- gets5(&a1, &x.sa);
- points(a1, &x.sa);
- x.smld->dtype = listmain;
- x.smld->lastfragm = a1;
- pp->ptrtype = ptrlist;
- pp->cel = 0;
- pp->nel = 0;
- pp->UU.U1.curfragment = a1;
- pp->UU.U1.mainadr = a1;
-}
-
-Local Void push(pp, adr, LINK)
-ptr_ *pp;
-long adr;
-struct LOC_ley *LINK;
-{
- mpd x, x1;
- a a1;
-
- /* dobawlqet po pojnteru spiska nowyj |lement k spisku*/
- /* i sdwigaet pojnter pp */
- if (pp->ptrtype != ptrlist) {
- printf("Rigal internal error Push-102\n");
- return;
- } /* if/then */
- points(pp->UU.U1.mainadr, &x.sa);
- if (x.smld->dtype == listmain)
- x.smld->totalelnum++;
- else
- printf("Rigal internal error Push-101\n");
- points(pp->UU.U1.curfragment, &x.sa);
- if (x.smld->dtype == listmain && pp->nel == mainlistelnum ||
- x.sfld->dtype == listfragm && pp->nel == fragmlistelnum) {
- /* w slu~ae dostiveniq konca fragmenta spiska */
- gets5(&a1, &x1.sa);
- if (x.smld->dtype == listmain) /* podceplenie */
- x.smld->next = a1;
- else
- x.sfld->next = a1;
- /* obrazuem i zapolnqem nowyj */
- x1.sfld->dtype = listfragm;
- x1.sfld->elnum = 1;
- x1.sfld->elt[0] = adr;
- points(pp->UU.U1.mainadr, &x.sa);
- x.smld->lastfragm = a1;
- /* sdwig pojntera */
- pp->nel = 1;
- pp->cel = adr;
- pp->UU.U1.curfragment = a1;
- return;
- } /* then */
- /* ob{ij clu~aj dobawleniq |lementa wnutri fragmenta */
- switch (x.smld->dtype) {
-
- case listmain:
- x.smld->elnum++;
- x.smld->elt[pp->nel] = adr;
- break;
-
- case listfragm:
- x.sfld->elnum++;
- x.sfld->elt[pp->nel] = adr;
- break;
- }/* case */
- pp->nel++;
- pp->cel = adr;
-
- /* else */
-} /* push */
-
-Local Void mistake(mistake_num, LINK)
-long mistake_num;
-struct LOC_ley *LINK;
-{
- string80 com;
-
- printf("Error...%12ld M=%s\n", mistake_num, LINK->error_rec->message);
- switch (mistake_num) {
-
- case 1:
- strcpy(com, "MAIN PROGRAM FILE IS NOT FOUND ");
- break;
-
- case 2:
- strcpy(com, "MORE THAN 2 NESTED %INCLUDE FILES");
- break;
-
- case 3:
- strcpy(com, "THIS %INCLUDE FILE IS NOT FOUND ");
- break;
-
- case 4:
- strcpy(com, "TOO LONG (>80 BYTES) TOKEN");
- break;
-
- case 5:
- strcpy(com, "WRONG CHARACTER AFTER NUMBER");
- break;
-
- case 6:
- strcpy(com, "TOO BIG NUMBER (> 2.**31) ");
- break;
-
- case 8:
- strcpy(com, "ENDING APOSTROPHE NOT FOUND IN THIS LINE");
- break;
-
- case 11:
- strcpy(com, "THIS CHARACTER NOT ALLOWED ");
- break;
-
- case 12:
- strcpy(com, "NUMBER AFTER \"A'\" NOT FOUND ");
- break;
-
- case 13:
- strcpy(com, "ZERO LENGTH STRING NOT ALLOWED");
- break;
-
- case 14:
- strcpy(com, "RULE NAME AFTER \"#\" NOT FOUND ");
- break;
-
- case 17:
- strcpy(com, "NUMBER AFTER \"A'\" MUST BE N*512");
- break;
-
- case 18:
- strcpy(com, "WRONG DIGIT (8 or 9) IN OCTAL NUMBER ");
- break;
-
-
- default:
- strcpy(com, "UNKNOWN LEXICAL ERROR");
- break;
- }
- printf("...\n");
- LINK->errflag = true;
- strcpy(LINK->error_rec->message, com);
- LINK->error_rec->address =
- LINK->fistack[LINK->fistacklen - 1].curline * 80 + LINK->i;
- strcpy(LINK->error_rec->filename, LINK->fistack[LINK->fistacklen - 1].f);
- printf(" LEXICAL ERROR : %s\n", com);
- printf(" LINE=%12ld SYMBOL=%12ld\n",
- LINK->fistack[LINK->fistacklen - 1].curline, LINK->i);
-}
-
-Local Void makeatom(ik, jk, desk, LINK)
-long ik, jk;
-char desk;
-struct LOC_ley *LINK;
-{
- /* makes s-atom
- from array s, starting ik, length jk
- */
- mpd x;
- a a1m;
- atomdescriptor *WITH;
-
- putatm(&LINK->s[ik - 1], jk, &a1m);
- gets1(&LINK->satomadr, &x.sa);
- WITH = x.sad;
- WITH->cord = LINK->fistack[LINK->fistacklen - 1].curline * 80 + LINK->i;
- /*!!*/
- WITH->dtype = desk;
- WITH->name = a1m;
-}
-
-
-
-Void ley(first_file_, lesrez, not_include, error_rec_)
-Char *first_file_;
-long *lesrez;
-boolean not_include;
-error_rec_type *error_rec_;
-{
- /* added lastfragm 12-jul-91 */
-
- struct LOC_ley V;
- string80 first_file;
- char dt;
- longint ilong;
- a adr;
- char jcase;
- long j, nn, jj, ii;
- mpd x;
- long len; /* current line length */
- ptr_ p;
- mpd y;
- boolean is_ident, x_lists;
- /* srb,srl,slb,sll: string; */
- Char table[254];
- boolean maybe_octal;
- bigstr_type a_long; /*varying[145] of char;*/
- a146 s1;
- filespecification ff1;
- string80 ssint;
-
-
- /*** Char twochar_string[161]; **/
- long rline;
- Char c;
- long FORLIM;
- numberdescriptor *WITH;
- ruledescriptor *WITH1;
- vardescriptor *WITH2;
- specdescriptor *WITH3;
-
-
-printf("L1");
-
-}
-
-
-
-
-/* End. */
-
diff --git a/RIGAL/rigsc.446/src/s_scan.c b/RIGAL/rigsc.446/src/s_scan.c
deleted file mode 100644
index 8b00e1e..0000000
--- a/RIGAL/rigsc.446/src/s_scan.c
+++ /dev/null
@@ -1,1279 +0,0 @@
-#include "globrig.h"
-#include "define.h"
-#include "defpage.h"
-#include "scan.h"
-#include "nef2.h"
-typedef Char bigstring[128];
-#define new_line_code '\015' /* chr(0 is allowed too */
-#define endfile_code '\032'
-
-
-#define is_control 0
-#define is_letter 1
-#define is_digit 2
-#define is_underscore 3
-#define is_printable 4
-#define is_special 5
-#define is_space 6
-#define is_first_of_two 7
-
-
-typedef Char pair[2];
-
-
-a a1; /* global variable for only local use */
-/*aa1 : aa ;*/
-/* --"-- */
-mpd x; /* --"-- */
-bl80 bl801;
-/* -- " -- */
-/* array[1..80] of char*/
-long k, kk; /* -"- */
-Char c1;
-
-word saved_coord; /* where current token began */
-word coord_mark; /* what was set by coordinate marker */
-word line_byte_number;
-/* number of totally read bytes till beginning
- of current line */
-word last_mark_byte_number;
-/* number of totally read bytes till
- last coordinate marker */
-/* length of the current line,
- used only for incrementation of "lyne_byte_number"*/
-word old_line_length;
-char dt;
-/* type of last read token or control character */
-a aadr; /* a-space address of last read token */
-longint linenumber; /* current line number */
-longint tokennumber; /* current token number */
-a errlist; /* list of numbers of errors */
-long read_mode; /* 1,2,3 */
-ptr_ ptr1; /* list pointer when read from list of atoms */
-
-FILE *inpfile;
-boolean c_lexics, pascal_lexics, row80_coord, byte_coord, mark_byte_coord,
- mark_only_coord, string_coord, char_coord, token_coord,
- collect_errors, screen_errors, to_uppercase, pascal_comment,
- c_comment, ada_comment, pascal_string, modula_string;
-bigstring s, s_for_val; /* added 17-feb-92 */
-long i;
-char as[256];
-char isa;
-Char upcase_tab[256];
-char set_of_second_of_two[9];
-long two_char_symbols_num;
-pair two_char_symbols[30];
-
-union {
- Char b1;
- Char b2[2];
- Char b3[3];
-} b123;
-
-
-boolean in_comment, in_string, is_2quote;
- /* if in_string then it is possible */
-longint str_constlen;
-string80 str_const; /* array of char is allowed too */
-
-
-/*===== sun version ===*/
-Static Void jnc(xxx)
-long *xxx;
-{
- (*xxx)++;
-}
-
-
-Static Void jnc2(xxx, yyy)
-long *xxx, yyy;
-{
- *xxx += yyy;
-}
-
-
-Static Void jncx(xxx)
-long *xxx;
-{
- (*xxx)++;
-}
-
-
-Static Void jnc2x(xxx, yyy)
-long *xxx, yyy;
-{
- *xxx += yyy;
-}
-
-
-/*=====*/
-
-Static char cont_char_to_dt PP((Char c));
-
-Static word getcoord PV();
-
-Static Void er_lex PP((long er_number));
-
-/*procedure initialize_scan_variables;forward;*/
-Static Void read_file PP((long *read_file_rez));
-
-Static long read_item PV();
-
-Static Void readline PV();
-
-Static Void putatom PP((long j));
-
-Static Void putit PP((Char dd, long j));
-
-Static Void putident PP((long j));
-
-Static Void putfloat PP((long j));
-
-Static Void putnumber PV();
-
-Static Void putstr PV();
-
-Static Void putstr2 PV();
-
-/*procedure scaner;forward;*/
-Static Void setlexics PV();
-
-Static Void stradd PP((Char c));
-
-Static Void strbegin PV();
-
-Static Void token PV();
-
-Static long take_digits PP((long *jj));
-
-Static long take_letters PV();
-
-
-
-/* uses global string, received from readline procedure,
- produces global attributes of new one token read.
- some variables also should be initialized if by initial_token
- procedure at the start of the whole programm */
-
-/* this procedure is oriented to turbo pascal language */
-/* procedure call graph follows :
- /self\
- usepas -> scan -> readfile -> readitem -> addel.nef
- -> lconc.nef er_lex
- -> setoptions gets1.defpage
- -> first.nef token
- -> assign.system pointr.defpage
- -> reset.system lconc.nef
- -> readline
-
-
- token -> er
- -> read_letters_or_digits
- -> read_digits
- -> strbegin
- -> putnumber
- -> stradd -> er
- -> putstr -> putatm.defpage
- -> putatom ->\
- -> putfloat -> putit -> putatm.defpage
- -> putident ->/
-*/
-
-
-
-Static char cont_char_to_dt(c)
-Char c;
-{
- /************************************************/
- return ((char)c);
-}
-
-
-Static word getcoord()
-{
- /*************************/
- if (row80_coord)
- return (i + linenumber * 80);
- else {
- if (mark_only_coord)
- return coord_mark;
- else {
- if (mark_byte_coord)
- return (coord_mark + line_byte_number + i - last_mark_byte_number);
- else {
- if (byte_coord)
- return (line_byte_number + i);
- else {
- if (string_coord)
- return linenumber;
- else {
- if (token_coord)
- return tokennumber;
- else
- return 0;
- }
- }
- }
- }
- }
-}
-
-
-Static Void er_lex(er_number)
-long er_number;
-{
- /*************************************/
- a er_atom;
- word co;
- numberdescriptor *WITH;
-
- co = getcoord();
- if (collect_errors) {
- gets1(&er_atom, &x.sa);
- WITH = x.snd; /*global*/
- WITH->dtype = number;
- WITH->cord = co;
- WITH->val = er_number;
- lconc(&errlist, er_atom);
- }
- if (screen_errors)
- printf("Lexical error (%12ld) line=%12d column=%12d\n",
- er_number, co / 80, co % 80);
-}
-
-
-
-
-Void initialize_scan_variables()
-{
- /*************************************/
- Char c;
- short TEMP;
-
- for (TEMP = '\0'; TEMP <= 255; TEMP++) {
- c = TEMP;
- upcase_tab[c] = c;
- }
- for (c = 'a'; c <= 'z'; c++) /*ascii*/
- upcase_tab[c] = c - 32;
- for (TEMP = 160; TEMP <= 175; TEMP++) {
- c = TEMP;
- upcase_tab[c] = c - 32;
- }
- /*russian*/
- for (TEMP = 224; TEMP <= 239; TEMP++) {
- c = TEMP;
- upcase_tab[c] = c - 60;
- }
- /*russian*/
- for (c = '\0'; c <= '\037'; c++)
- as[c] = is_control;
- for (TEMP = 128; TEMP <= 255; TEMP++) {
- c = TEMP;
- as[c] = is_letter;
- }
- /* russian and pseudographics */
- for (TEMP = ' '; TEMP <= '\177'; TEMP++) {
- c = TEMP;
- /* not used actually */
-
-
- as[c] = is_printable;
- }
- as[new_line_code] = is_control;
-
- as[' '] = is_space;
- as['\t'] = is_space;
- /* these are allowed to be first letter of identifiers */
- for (c = 'A'; c <= 'Z'; c++)
- as[c] = is_letter;
- for (c = 'a'; c <= 'z'; c++)
- as[c] = is_letter;
- for (c = '0'; c <= '9'; c++)
- as[c] = is_digit;
- /* allowed to be non-first letter of odentifier */
- as['_'] = is_underscore;
-
- /* all the rest settings - see procedure setlexics */
-
-}
-
-
-
-
-
-
-
-
-Static Void read_file(read_file_rez)
-long *read_file_rez;
-{
- /********************************/
- /* reads whole input, produces list of items */
- *read_file_rez = null_;
- do {
- a1 = read_item();
- if (dt == start_tree || dt == end_tree || dt == start_list ||
- dt == end_list || dt == name_obj) {
- er_lex(6L);
- goto _L99;
- }
- if (dt != eof_desk)
- lconc(read_file_rez, a1);
- } while (dt != eof_desk);
-_L99: ;
-}
-
-
-
-Static long read_item()
-{
- /**********************/
- long Result;
- a aadr1, result, temp_res;
- atomdescriptor *WITH;
- numberdescriptor *WITH1;
-
- Result = null_; /* default value for exits with errors */
- result = null_;
- token();
-
- /*writeln('DT=',dt,ord(dt));*/
-
- switch (dt) {
-
- case atom:
- case idatom:
- case tatom:
- case fatom:
- case keyword:
- gets1(&result, &x.sa);
- WITH = x.sad;
- WITH->dtype = dt;
- WITH->cord = saved_coord;
- WITH->name = aadr;
- break;
-
- case number:
- gets1(&result, &x.sa);
- WITH1 = x.snd;
- WITH1->dtype = dt;
- WITH1->cord = saved_coord;
- WITH1->val = aadr; /* is set in token .. is_digit */
- break;
-
- case start_tree:
- result = null_;
- do {
- token();
- aadr1 = aadr; /* to save */
- if (dt == idatom || dt == atom || dt == tatom || dt == keyword) {
- /* what is allowed selector in scaner input ?
- normally - idatom only, but here
- atom is allowed too - for experiment purposes */
- a1 = read_item();
- if (dt == end_list) {
- er_lex(6L);
- goto _L99;
- }
- if (dt == eof_desk) {
- er_lex(1L);
- goto _L99;
- }
- addel3(&result, aadr1, a1);
- } else if (dt != end_tree) {
- er_lex(2L);
- goto _L99;
- }
- } while (dt != end_tree && dt != eof_desk);
- if (dt == eof_desk) {
- er_lex(3L);
- goto _L99;
- }
- dt = complex_desk;
- /* to ignore analysis in upper level of
- recursion */
- break;
-
- case start_list:
- result = null_;
- do {
- a1 = read_item();
- if (dt == eof_desk) {
- er_lex(4L);
- goto _L99;
- }
- if (dt != end_list)
- lconc(&result, a1);
- } while (dt != end_list);
- dt = complex_desk;
- break;
-
- case end_tree:
- er_lex(5L);
- goto _L99;
- break;
-
- case end_list:
- break;
- /*immodiately returns to the upper level*/
-
- case name_obj:
- temp_res = read_item();
- if (dt == end_list) {
- er_lex(6L);
- goto _L99;
- }
- if (dt == eof_desk) {
- er_lex(7L);
- goto _L99;
- }
- result = read_item();
- if (dt == end_list) {
- er_lex(6L);
- goto _L99;
- }
- if (dt == eof_desk) {
- er_lex(8L);
- goto _L99;
- }
- if (result != null_) {
- points(result, &x.sa);
- if (x.smld->dtype == listmain || x.smtd->dtype == treemain)
- x.smtd->name = temp_res;
- }
- dt = complex_desk;
- break;
-
- case eof_desk:
- break;
- /* returns to the upper level */
-
-
-
- default:
- er_lex(9L);
- goto _L99; /* impossible value */
- break;
- }/* case */
- Result = result;
-_L99:
- return Result;
-} /* read_item */
-
-
-
-
-Static Void readline()
-{
- /*****************************/
- /* sets new values for "s" and "i" global variables */
- Char c;
- long rline;
- atomdescriptor *WITH;
- long FORLIM;
- int fff;
- i = 1;
- /* in any case, so; only here it is initialized.
- it is column number.
- variable "s" is string only for speed purposes;
- it plays exactly as packed array of char,
- never used as whole and the length byte is never used */
- linenumber++;
- line_byte_number += old_line_length;
- if (read_mode == 1) {
-
- if (feof(inpfile))
- s[0] = endfile_code;
- else {
- /*readln(inpfile,s);*/
-
- fgets(s,145,inpfile);
- if (s[strlen(s)-1]=='\n')
- { s[strlen(s)-1]=0;
- fff=fgetc(inpfile);
- if (fff!=10)
- { ungetc(fff,inpfile);}
- else
- linenumber++;
- }
-
- s[strlen(s)] = new_line_code;
- old_line_length = strlen(s);
- }
- } else {
- if (read_mode == 2) {
- if (ptr1.nel == 0) {
- s[0] = endfile_code;
- goto _L99;
- }
- if (ptr1.cel == 0) {
- s[0] = new_line_code;
- old_line_length = 0;
- } else {
- pointr(ptr1.cel, &x.sa);
- WITH = x.sad; /* with */
- if (WITH->dtype == atom || WITH->dtype == idatom ||
- WITH->dtype == fatom || WITH->dtype == tatom ||
- WITH->dtype == keyword) {
- pointa(WITH->name, bl801, &k);
- FORLIM = k;
- for (kk = 1; kk <= FORLIM; kk++)
- s[kk - 1] = bl801[kk - 1];
- old_line_length = k;
- s[k] = new_line_code;
- } else {
- s[0] = new_line_code; /* other objects are ignored */
- old_line_length = 0;
- }
- } /* <>0 */
- next(&ptr1);
-
- } /*=2*/
- }
-_L99: ;
-
-
-}
-
-
-
-
-
-Static Void putatom(j)
-long j;
-{
- /*************************/
- putit(atom, j);
-}
-
-
-Static Void putit(dd, j)
-Char dd;
-long j;
-{
- /*************************/
- putatm(&s[i - 1], j, &aadr);
- dt = dd;
- saved_coord = getcoord();
- tokennumber++;
-}
-
-
-Static Void putident(j)
-long j;
-{
- /*************************/
- putit(idatom, j);
-}
-
-
-Static Void putfloat(j)
-long j;
-{ /*ignored*/
- /*************************/
- double rea_val;
- long ii, kk;
- real_char reac;
- Char STR1[256];
-
- sprintf(STR1, "%.*s", (int)j, s + i - 1);
- val2(STR1, &rea_val, &ii);
- ii = sizeof(double);
-
- for (kk = 0; kk < ii; kk++)
- reac[kk] = ((Char *)(&rea_val))[kk];
-
-
- putatm(reac, ii, &aadr);
- dt = fatom;
- saved_coord = getcoord();
- jnc(&tokennumber);
-}
-
-
-Static Void putnumber()
-{
- /*************************/
- dt = number;
- saved_coord = getcoord();
- jnc(&tokennumber);
-}
-
-
-Static Void putstr()
-{
- /*************************/
- putatm(str_const, str_constlen, &aadr);
- dt = tatom;
- in_string = false;
- tokennumber++;
-}
-
-
-Static Void putstr2()
-{
- /*************************/
- putatm(str_const, str_constlen, &aadr);
- dt = keyword;
- in_string = false;
- tokennumber++;
-}
-
-
-/* Local variables for scaner: */
-struct LOC_scaner {
- string80 options_str;
-} ;
-
-/*inner function*/
-Local boolean setop(c, LINK)
-Char c;
-struct LOC_scaner *LINK;
-{
- boolean Result;
- char * tmp;
- Result = false;
-
- tmp=strchr(LINK->options_str,c);
-
- if ( tmp ) {
- if (tmp[1] != '-') /* Check next position */
- return true;
- }
- return Result;
-}
-
-
-/* this procedure used only for modula2 or c-style string constants like 'x', -
- to show difference between 'x' and "x".
- access via #_keyword built_in rule is possible.
- when input use 'm+p-' !
- when output such tokens you should write
- if #_keyword($x) -> out <] @ '"' $x '"' elsif t-> out <] $x fi;
- */
-
-
-
-
-Void scaner(mode_parm, filename_, options_str_, rez, erlist_parm, strlist,
- segm, ofs)
-long mode_parm;
-Char *filename_, *options_str_;
-long *rez, *erlist_parm, strlist, segm, ofs;
-{
- /*******************************************/
- /*1=from file,2=list of strings,3=absulute address*/
- /* result; set to null if input is absent */
- /* error number list; set to null if no error */
- /* list of atoms */
- /* parts of absolute address */
- struct LOC_scaner V;
- string80 filename;
-
-
- strcpy(filename, filename_);
- strcpy(V.options_str, options_str_);
- read_mode = mode_parm; /* save for global use */
- *rez = null_;
- *erlist_parm = null_;
- errlist = null_; /* global */
-
- /* initializes all options */
- /* defaults */
- strcat(V.options_str, "D-C-P+p+m-U+S+O+s-t-L-A+R+Y-B-N-");
- /* to every option su,me default value should be given,
- otherwise the flag remains uninitialized */
-
- /*errors*/
- screen_errors = setop('S', &V);
- collect_errors = setop('O', &V);
-
- /*comments*/
- ada_comment = setop('D', &V);
- c_comment = setop('C', &V);
- pascal_comment = setop('P', &V);
-
- /*string constants*/
- pascal_string = setop('p', &V);
- modula_string = setop('m', &V);
- to_uppercase = setop('U', &V);
-
- /*coordinate*/
- string_coord = setop('s', &V);
- token_coord = setop('t', &V);
- row80_coord = setop('R', &V);
- byte_coord = setop('Y', &V);
- mark_byte_coord = setop('B', &V);
- mark_only_coord = setop('N', &V);
-
- /*language_specific lexics*/
- c_lexics = setop('L', &V);
- pascal_lexics = setop('A', &V);
-
-
- /* initializes language-specific settings */
- setlexics();
-
- /* initializes "session" flags (alf order)*/
- coord_mark = 0;
- in_comment = false;
- in_string = false;
- is_2quote = false;
- last_mark_byte_number = 0;
- line_byte_number = 0;
- linenumber = 0;
- old_line_length = 0;
- str_constlen = 0;
- tokennumber = 0;
-
- /* initializes physical level reading */
-
- if (read_mode == 1) { /* read from file */
- if (!existfile(filename)) {
- *rez = 0;
- goto _L1;
- }
-
-
- inpfile = fopen(filename, "r");
- if (inpfile == NULL)
- _EscIO(FileNotFound);
-
-
- readline(); /* reads first line of file */
- } else {
- if (read_mode == 2) { /* read from list */
- if (strlist == null_) {
- *rez = 0;
- goto _L99;
- }
- first(strlist, &ptr1); /* sets global list-pointer ptr1 */
- if (ptr1.ptrtype != ptrlist || ptr1.nel == 0) {
- *rez = 0;
- goto _L99;
- }
- readline(); /* reads line from current list-pointer position */
- /* read from ms-dos ram memory */
-
- }
- }
-
-
-
- read_file(rez); /* main call ... */
-
- *erlist_parm = errlist; /*global*/
-_L1:
-_L99: ;
-} /* scaner */
-
-
-Static Void setlexics()
-{
- /*************************/
- long j, FORLIM;
-
- if (pascal_lexics) {
- /* changes in standard, necessary for pascal*/
- as['{'] = is_special;
- as['#'] = is_special;
- as['$'] = is_special;
- as['%'] = is_special;
- as['\''] = is_special;
- as['('] = is_special;
- memcpy(two_char_symbols[0], ":=", sizeof(pair));
- memcpy(two_char_symbols[1], "<=", sizeof(pair));
- memcpy(two_char_symbols[2], ">=", sizeof(pair));
- memcpy(two_char_symbols[3], "**", sizeof(pair));
- memcpy(two_char_symbols[4], "..", sizeof(pair));
- memcpy(two_char_symbols[5], "<>", sizeof(pair));
- two_char_symbols_num = 6;
- strcpy(set_of_second_of_two,"=*.>");
- FORLIM = two_char_symbols_num;
- for (j = 0; j < FORLIM; j++)
- as[two_char_symbols[j][0]] = is_first_of_two;
- if (modula_string) {
- as['"'] = is_special;
- as['{'] = is_printable;
- }
- return;
- }
- if (!c_lexics)
- return;
- as['_'] = is_letter;
- as['$'] = is_letter;
- memcpy(two_char_symbols[0], "->", sizeof(pair));
- memcpy(two_char_symbols[1], "++", sizeof(pair));
- memcpy(two_char_symbols[2], "--", sizeof(pair));
- memcpy(two_char_symbols[3], ">>", sizeof(pair));
- memcpy(two_char_symbols[4], "<<", sizeof(pair));
- memcpy(two_char_symbols[5], "==", sizeof(pair));
- memcpy(two_char_symbols[6], "+=", sizeof(pair));
- memcpy(two_char_symbols[7], "*=", sizeof(pair));
- memcpy(two_char_symbols[8], "-=", sizeof(pair));
- memcpy(two_char_symbols[9], "/=", sizeof(pair));
- memcpy(two_char_symbols[10], "%=", sizeof(pair));
- memcpy(two_char_symbols[11], "&=", sizeof(pair));
- memcpy(two_char_symbols[12], "^=", sizeof(pair));
- memcpy(two_char_symbols[13], "|=", sizeof(pair));
- memcpy(two_char_symbols[14], "!=", sizeof(pair));
- two_char_symbols_num = 15;
- strcpy(set_of_second_of_two,">+-<=");
- FORLIM = two_char_symbols_num;
- for (j = 0; j < FORLIM; j++)
- as[two_char_symbols[j][0]] = is_first_of_two;
- as['<'] = is_special; /* used to process <<= */
- as['>'] = is_special; /* used to process >>= */
- as['/'] = is_special; /* used to process / * */
- /* otherwise isa:=is_first_of_two
- is assigned ! */
- as['\''] = is_special;
- as['"'] = is_special;
-
-}
-
-
-
-
-Static Void stradd(c)
-Char c;
-{
- /*************************/
- if (str_constlen > 80) /* string is truncated */
- er_lex(10L);
- else
- jnc(&str_constlen);
- str_const[str_constlen - 1] = c;
-}
-
-
-Static Void strbegin()
-{
- /********************/
- saved_coord = getcoord();
- /* it will be used when putstr works and token exits - in read_item*/
- in_string = true;
- str_constlen = 0;
-}
-
-
-
-
-
-Static Void token()
-{ /* variant record ,b1=b2[1]=b3[1]; b2[2]=b3[2] */
- /**********************/
- long j, i_saved; /* positions */
- long FORLIM;
-
- /* at beginning time
- "i" - is already set to character in string "s";
- array "as" is already initialized;
- coordinate mode "coord_mode" is already known;
- */
-
-_L1: /* we return to this label if token is not ready still */
-
- b123.b1 = s[i - 1];
- isa = as[b123.b1]; /* type of this character */
-
-
-
- if (isa == is_control) { /*1*/
- if (b123.b1 == new_line_code) {
- readline(); /* skips to next line, sets new "s" and "i" */
- if (in_string) {
- er_lex(11L);
- putstr();
- goto _L99;
- }
- /* error= end of line appears in string constant */
- goto _L1;
- } else {
- if (b123.b1 == endfile_code) {
- if (in_comment)
- er_lex(12L);
- /* error = end of file appears in comment */
- dt = eof_desk;
- goto _L99;
- } else { /*2*/
- if (in_comment) {
- er_lex(13L);
- in_comment = false;
- }
- /* error = control char in comment */
- if (in_string) {
- er_lex(14L);
- putstr();
- goto _L99;
- /* will take control character next time */
- }
- /* error = control char in string */
- dt = cont_char_to_dt(b123.b1);
- i++;
- if (dt == set_coord && as[s[i - 1]] == is_digit) {
- /* this control character sets coordinate to value given in input */
- coord_mark = take_digits(&j);
- last_mark_byte_number = line_byte_number + i;
- i += j;
- goto _L1; /* does not returns ! */
-
- }
- goto _L99;
- } /*2*/
- }
- /*never here*/
- } /*1*/
-
-
-
-
- /* all the following executes after check of is_control */
-
- /*b3[1]:=s[i];*/
- /* this character */
- b123.b3[1] = s[i]; /* next */
- b123.b3[2] = s[i + 1]; /* next */
-
- if (in_comment) /* check for end of comment */
- { /*1*/
- /* we are in comment;
- here only comments that have some special end mark are processed */
- if (pascal_comment) { /*2*/
- if (b123.b1 == '}') {
- jncx(&i);
- in_comment = false;
- goto _L1;
- }
-
-
-
- if (!strncmp(b123.b2, "*)", 2)) {
- jnc2x(&i, 2L);
- in_comment = false;
- goto _L1;
- }
-
-
- } /*2*/
- else {
- if (c_comment) { /*2*/
- if (!strncmp(b123.b2, "*/", 2)) {
- jnc2x(&i, 2L);
- in_comment = false;
- goto _L1;
- }
- } /*2*/
- }
- jncx(&i);
- goto _L1;
- } /*1*/
-
-
-
-
- if (in_string) { /*1*/
- if (pascal_string) { /*2*/
- if (b123.b1 == '\'') { /*3*/
- if (b123.b2[1] == '\'') {
- stradd('\'');
- jnc2x(&i, 2L);
- goto _L1;
- } else {
- putstr();
- jncx(&i);
- goto _L99;
- }
- /* this allow to save '''' as '' */
-
-
- } /*3*/
- else { /*3*/
- stradd(b123.b1);
- jncx(&i);
- goto _L1;
- } /*3*/
-
- } /*2*/
- if (modula_string) { /*2*/
- if (is_2quote && b123.b1 == '"') {
- putstr();
- jncx(&i);
- goto _L99;
- }
- if (!is_2quote && b123.b1 == '\'') {
- putstr2();
- jncx(&i);
- goto _L99;
- } else { /*3*/
- if (b123.b1 == '\\') {
- stradd(b123.b1);
- stradd(b123.b2[1]);
- /* this allows to save \? as ? even if \" appears" */
- jnc2x(&i, 2L);
- goto _L1;
- }
-
- stradd(b123.b1);
- jncx(&i);
- goto _L1;
- } /*3*/
- } /*2*/
- } /*1*/
-
- /* check for end of string or something special in string */
-
-
-
- /* all the following executes after check for in_string & in_comment */
-
- if (isa == is_special) { /*1*/
- if (pascal_comment) { /*2*/
- if (!strncmp(b123.b2, "(*", 2)) {
- in_comment = true;
- jnc2x(&i, 2L);
- goto _L1;
- }
- if (b123.b1 == '{' && b123.b2[1] != '$') {
- in_comment = true;
- jncx(&i);
- goto _L1;
- }
- } /*2*/
- else {
- if (c_comment) { /*2*/
- if (!strncmp(b123.b2, "/*", 2)) {
- in_comment = true;
- jnc2x(&i, 2L);
- goto _L1;
- }
- } /*2*/
- else {
- if (ada_comment) { /*2*/
- if (!strncmp(b123.b2, "--", 2)) {
- readline();
- goto _L1;
- }
- } /*2*/
- }
- }
-
- if (pascal_string) { /*2*/
- if (b123.b1 == '\'') {
- strbegin();
- is_2quote = false;
- jncx(&i);
- goto _L1;
- }
- } /*2*/
- else {
- if (modula_string) { /*2*/
- if (b123.b1 == '\'') {
- strbegin();
- is_2quote = false;
- jncx(&i);
- goto _L1;
- }
- if (b123.b1 == '"') {
- strbegin();
- is_2quote = true;
- jncx(&i);
- goto _L1;
- }
- } /*2*/
- }
- if (pascal_lexics) { /*2*/
- /* specially takes turbo pascal directive-comments */
- if (!strncmp(b123.b2, "{$", 2)) { /*3*/
- j = 0;
- do {
- jncx(&j);
- } while (s[i + j - 1] != '}' && as[s[i + j - 1]] != is_control);
- if (s[i + j - 1] == '}')
- jncx(&j);
- putatom(j);
- jnc2x(&i, j);
- goto _L99;
- } /*3*/
-
- /* additional symbols */
- if (b123.b1 == '#' || b123.b1 == '$' || b123.b1 == '%') { /*3*/
- jncx(&i);
- j = take_letters(); /* starts from i-th position */
- i--;
- putatom(j + 1); /* takes token from i-th position */
- jnc2x(&i, j + 1);
- goto _L99;
- } /*3*/
-
- } /*2*/
- else {
- if (c_lexics) { /*2*/
- if (!strncmp(b123.b3, "<<=", 3) || !strncmp(b123.b3, ">>=", 3)) {
- putatom(3L);
- jnc2x(&i, 3L);
- goto _L99;
- }
- isa = is_first_of_two;
- /* !! in c case <<, >>, >=, <= will be tested further
- in two_char_symbols section, hence we go to there
- using assignment to "isa" */
-
- } /*2*/
- /* symbols= > < */
- /* special cases for c language */
-
- }
-
- } /*1*/
-
-
- if (isa == is_space) {
- jncx(&i);
- goto _L1;
- }
-
- if (isa == is_letter) {
- j = take_letters();
- putident(j);
- i += j;
- goto _L99;
- }
-
-
- if (isa == is_digit) { /*1*/
- if (c_lexics) { /*2*/
- /* additional symbols; here hex and octal numbers are saved as
- normal atoms */
- if (b123.b1 == '0') { /*3*/
- jncx(&i);
- j = take_letters(); /* starts from i-th position */
- i--;
- putatom(j + 1); /* takes token from i-th position */
- jnc2x(&i, j + 1);
- goto _L99;
- } /*3*/
- } /*2*/
-
-
- i_saved = i; /* remember starting position */
- aadr = take_digits(&j);
-
- if (j < 10 &&
- (s[i + j - 1] == '.' && s[i + j] == '.' ||
- s[i + j - 1] != '.' && s[i + j - 1] != 'E' && s[i + j - 1] != 'e')) {
- putnumber();
- jnc2x(&i, j);
- goto _L99;
- }
- jnc2x(&i, j);
- if (s[i - 1] == '.') {
- jncx(&i);
- aadr = take_digits(&j);
- jnc2x(&i, j);
- }
- if (s[i - 1] == 'E' || s[i - 1] == 'e') {
- jncx(&i);
- if (s[i - 1] == '-' || s[i - 1] == '+')
- jncx(&i);
- aadr = take_digits(&j);
- jnc2x(&i, j);
- }
- j = i - i_saved;
- i = i_saved; /* to set "i" to starting position */
- putfloat(j);
- jnc2x(&i, j);
- goto _L99;
- } /*1*/
-
- if (isa == is_first_of_two) { /*1*/
- if (strchr(set_of_second_of_two,(int)b123.b2[1])) {
- FORLIM = two_char_symbols_num;
- for (j = 0; j < FORLIM; j++) {
- if (b123.b2[0] == two_char_symbols[j][0] &&
- b123.b2[1] == two_char_symbols[j][1]) {
- putatom(2L);
- i += 2;
- goto _L99;
- }
- }
- }
- } /*1*/
-
- putatom(1L);
- jncx(&i); /* with*/
-_L99: ;
-
-
-
- /* others are control characters; */
- /* they set "dt" field and then form rigal list/tree structure */
-
-}
-
-
-
-Static long take_letters()
-{
- /****************************************/
- long Result;
- /* reads only letters, digits and underscores.
- returns number of characters read */
-
- long jj;
- Char c;
-
- jj = 0;
- while (true) {
- c = s[i + jj - 1];
- isa = as[c];
- if (isa != is_letter && isa != is_digit && isa != is_underscore) {
- Result = jj;
- goto _L99;
- }
- if (to_uppercase)
- s[i + jj - 1] = upcase_tab[c];
- jncx(&jj);
- }
-_L99:
- return Result;
-}
-
-
-
-
-Static long take_digits(jj)
-long *jj;
-{
- /**************************************************/
- long Result;
- longint summator;
- Char c;
-
- *jj = 0;
- summator = 0;
- while (true) {
- c = s[i + *jj - 1];
- if (as[c] != is_digit) {
- Result = summator;
- goto _L99;
- }
- summator = summator * 10 + c - '0';
- jncx(jj);
- }
-_L99:
- return Result;
-}
-
-
-
-/*begin*/
-/* press f8 when debugging ! */
-/*initialize_scan_variables;*/
-
-
-
-
-/* End. */
--
GitLab