#include // 1 ! Copyright (c) 1987 Edinburgh Portable Compilers Ltd. All Rights Reserved. // 2 %ownstring(90) copyright = " Copyright (c) 1987 Edinburgh Portable Compilers Ltd. All Rights Reserved." #line 2 "uiocp17.imp" static _imp_string /*%string(90)*/ COPYRIGHT = _imp_str_literal(" Copyright (c) 1987 Edinburgh Portable Compilers Ltd. All Rights Reserved."); // 3 // 4 !* 09May 96 uiocp17 // 5 !* Flattened for translation to C // 6 !* 27-Nov-92 uiocp16 // 7 !* Simple IMP version all library duplicat material chopped out // 8 !* // 9 // 10 %conststring(1) %array Hex(0:15) = #line 10 "uiocp17.imp" const _imp_string /*%string(1)*/ HEX[16] = { _imp_str_literal("0"), _imp_str_literal("1"), _imp_str_literal("2"), _imp_str_literal("3"), _imp_str_literal("4"), _imp_str_literal("5"), _imp_str_literal("6"), _imp_str_literal("7"), _imp_str_literal("8"), _imp_str_literal("9"), _imp_str_literal("A"), _imp_str_literal("B"), _imp_str_literal("C"), _imp_str_literal("D"), _imp_str_literal("E"), _imp_str_literal("F"), }; // 11 "0","1","2","3","4","5","6","7","8","9","A","B","C","D","E","F" // 12 // 13 %externalroutine Phexbyte(%integer n) #line 13 "uiocp17.imp" void PHEXBYTE( int N ) #line 13 "uiocp17.imp" { // 14 printstring(Hex((n>>4)&15)) #line 14 "uiocp17.imp" _imp_PRINTSTRING(HEX[(((int)((((unsigned int)(N)) >> (4)))) & (15))]); // 15 printstring(Hex(n&15)) #line 15 "uiocp17.imp" _imp_PRINTSTRING(HEX[((N) & (15))]); // 16 %end;! Phexbyte #line 16 "uiocp17.imp" /* Remove %on %event handler here if present for this block */ return; } // End of block PHEXBYTE at level 1 // 17 ! // 18 ! Copyright (c) 1987 Edinburgh Portable Compilers Ltd. All Rights Reserved. // 19 ! // 20 // 21 // 22 // 23 !************************************************************ // 24 !* * // 25 !* IOCP - IMP stream input/output package * // 26 !* (This is a cut down version for the Fortran compiler * // 27 !* * // 28 !************************************************************ // 29 // 30 %constinteger Stdin = 0, // 31 Stdout = 1, // 32 Stderr = 2 // 33 // 34 %systemroutinespec Close (%integer id) { Sys Call } #line 34 "uiocp17.imp" extern void close( int ID ); // 35 %systemintegerfnspec Open (%integer ad,mode) #line 35 "uiocp17.imp" extern int open( int AD, int MODE ); // 36 %systemintegerfnspec write (%integer id,bytead,len) #line 36 "uiocp17.imp" extern int write( int ID, int BYTEAD, int LEN ); // 37 %systemintegerfnspec read (%integer id,bytead,len) #line 37 "uiocp17.imp" extern int read( int ID, int BYTEAD, int LEN ); // 38 // 39 %ownintegerarray streamtable(0:100) #line 39 "uiocp17.imp" static int STREAMTABLE[101]; // 40 // 41 %externalroutine Openfile(%integer stream, %string(128) name) #line 41 "uiocp17.imp" void OPENFILE( int STREAM, _imp_string /*%string(128)*/ NAME ) #line 41 "uiocp17.imp" { // 42 %integer i #line 42 "uiocp17.imp" int I; // 43 %ownbyteintegerarray cname(0:127) #line 43 "uiocp17.imp" static unsigned char CNAME[128]; // 44 // 45 %unless 0<=stream<=100 %then printstring(" invalid stream number ") %andstop #line 45 "uiocp17.imp" if ((((0) > (STREAM))) || (((STREAM) <= (100)))) goto L_0003; #line 45 "uiocp17.imp" L_0002:; #line 45 "uiocp17.imp" _imp_PRINTSTRING(_imp_str_literal(" invalid stream number ")); #line 45 "uiocp17.imp" exit(0); #line 45 "uiocp17.imp" L_0003:; // 46 string(addr(cname(0)))=name.tostring(0) #line 46 "uiocp17.imp" *_imp_STRING(_imp_ADDR(&CNAME[0])) = _imp_join((_imp_string)NAME,(_imp_string)_imp_TOSTRING(0)); // 47 i=open(addr(cname(1)),0) { open reading } #line 47 "uiocp17.imp" I = open(_imp_ADDR(&CNAME[1]), 0); // 48 streamtable(stream)=i #line 48 "uiocp17.imp" STREAMTABLE[STREAM] = I; // 49 %end;! Openfile #line 49 "uiocp17.imp" /* Remove %on %event handler here if present for this block */ return; } // End of block OPENFILE at level 1 // 50 // 51 %externalroutine Openinput(%integer stream, %string(128) name) #line 51 "uiocp17.imp" void OPENINPUT( int STREAM, _imp_string /*%string(128)*/ NAME ) #line 51 "uiocp17.imp" { // 52 %integer i #line 52 "uiocp17.imp" int I; // 53 %ownbyteintegerarray cname(0:127) #line 53 "uiocp17.imp" static unsigned char CNAME[128]; // 54 // 55 %unless 0<=stream<=100 %then printstring(" invalid stream number ") %andstop #line 55 "uiocp17.imp" if ((((0) > (STREAM))) || (((STREAM) <= (100)))) goto L_0005; #line 55 "uiocp17.imp" L_0004:; #line 55 "uiocp17.imp" _imp_PRINTSTRING(_imp_str_literal(" invalid stream number ")); #line 55 "uiocp17.imp" exit(0); #line 55 "uiocp17.imp" L_0005:; // 56 string(addr(cname(0)))=name.tostring(0) #line 56 "uiocp17.imp" *_imp_STRING(_imp_ADDR(&CNAME[0])) = _imp_join((_imp_string)NAME,(_imp_string)_imp_TOSTRING(0)); // 57 i=open(addr(cname(1)),0) { open reading } #line 57 "uiocp17.imp" I = open(_imp_ADDR(&CNAME[1]), 0); // 58 streamtable(stream)=i #line 58 "uiocp17.imp" STREAMTABLE[STREAM] = I; // 59 %end;! Openfile #line 59 "uiocp17.imp" /* Remove %on %event handler here if present for this block */ return; } // End of block OPENINPUT at level 1 // 60 // 61 %externalroutine Openoutput(%integer stream, %string(128) name) #line 61 "uiocp17.imp" void OPENOUTPUT( int STREAM, _imp_string /*%string(128)*/ NAME ) #line 61 "uiocp17.imp" { // 62 %integer i #line 62 "uiocp17.imp" int I; // 63 %ownbyteintegerarray cname(0:127) #line 63 "uiocp17.imp" static unsigned char CNAME[128]; // 64 // 65 %unless 0<=stream<=100 %then printstring(" invalid stream number ") %andstop #line 65 "uiocp17.imp" if ((((0) > (STREAM))) || (((STREAM) <= (100)))) goto L_0007; #line 65 "uiocp17.imp" L_0006:; #line 65 "uiocp17.imp" _imp_PRINTSTRING(_imp_str_literal(" invalid stream number ")); #line 65 "uiocp17.imp" exit(0); #line 65 "uiocp17.imp" L_0007:; // 66 string(addr(cname(0)))=name.tostring(0) #line 66 "uiocp17.imp" *_imp_STRING(_imp_ADDR(&CNAME[0])) = _imp_join((_imp_string)NAME,(_imp_string)_imp_TOSTRING(0)); // 67 i=open(addr(cname(1)),1) { open for writing } #line 67 "uiocp17.imp" I = open(_imp_ADDR(&CNAME[1]), 1); // 68 streamtable(stream)=i #line 68 "uiocp17.imp" STREAMTABLE[STREAM] = I; // 69 %end;! Openfile #line 69 "uiocp17.imp" /* Remove %on %event handler here if present for this block */ return; } // End of block OPENOUTPUT at level 1 // 70 // 71 %externalroutine Closeoutput #line 71 "uiocp17.imp" void CLOSEOUTPUT( void ) #line 71 "uiocp17.imp" { // 72 %end #line 72 "uiocp17.imp" /* Remove %on %event handler here if present for this block */ return; } // End of block CLOSEOUTPUT at level 1 // 73 // 74 %externalroutine Closeinput #line 74 "uiocp17.imp" void CLOSEINPUT( void ) #line 74 "uiocp17.imp" { // 75 %end #line 75 "uiocp17.imp" /* Remove %on %event handler here if present for this block */ return; } // End of block CLOSEINPUT at level 1 // 76 // 77 !* // 78 %STRING(15) %FN Itos(%INTEGER K) #line 78 "uiocp17.imp" _imp_string /*%string(15)*/ ITOS( int K ) #line 78 "uiocp17.imp" { // 79 %INTEGER REM,NUM,NF #line 79 "uiocp17.imp" int REM; #line 79 "uiocp17.imp" int NUM; #line 79 "uiocp17.imp" int NF; // 80 %STRING(15) STR #line 80 "uiocp17.imp" _imp_string /*%string(15)*/ STR; // 81 // 82 STR="" #line 82 "uiocp17.imp" STR = _imp_str_literal(""); // 83 NF=0 #line 83 "uiocp17.imp" NF = 0; // 84 %IF K<0 %START #line 84 "uiocp17.imp" if (((K) >= (0))) goto L_0008; // 85 NF=1 #line 85 "uiocp17.imp" NF = 1; // 86 K = K *(-1) #line 86 "uiocp17.imp" K = (((int)(K)) * ((-1))); // 87 %FINISH #line 87 "uiocp17.imp" L_0008:; // 88 %CYCLE #line 88 "uiocp17.imp" L_0009:; // 89 NUM=K #line 89 "uiocp17.imp" NUM = K; // 90 K = K//10 #line 90 "uiocp17.imp" K = (long)((long)((int)(K)) / (long)((int)(10))); // 91 REM = NUM-(K*10) #line 91 "uiocp17.imp" REM = ((NUM) - ((int)((((int)(K)) * (10))))); // 92 STR = TOSTRING(REM+'0').STR #line 92 "uiocp17.imp" STR = _imp_join((_imp_string)_imp_TOSTRING((((int)(REM)) + (48))),(_imp_string)STR); // 93 %IF K=0 %THEN %EXIT #line 93 "uiocp17.imp" if (((K) != (0))) goto L_000c; #line 93 "uiocp17.imp" goto L_000a; #line 93 "uiocp17.imp" L_000c:; // 94 %REPEAT #line 94 "uiocp17.imp" goto L_0009; #line 94 "uiocp17.imp" L_000a:; // 95 %IF NF=1 %THEN STR = "-".STR #line 95 "uiocp17.imp" if (((NF) != (1))) goto L_000d; #line 95 "uiocp17.imp" STR = _imp_join((_imp_string)_imp_str_literal("-"),(_imp_string)STR); #line 95 "uiocp17.imp" L_000d:; // 96 %RESULT = STR #line 96 "uiocp17.imp" /* Remove %on %event handler here if present for this block */ return STR; // 97 %END;! Itos #line 97 "uiocp17.imp" } // End of block ITOS at level 1 // 98 ! // 99 ! Copyright (c) 1987 Edinburgh Portable Compilers Ltd. All Rights Reserved. // 100 ! // 101 // 102 // 103 %routine Ioerr(%integer ep,n,%string(255) s) #line 103 "uiocp17.imp" void IOERR( int EP, int N, _imp_string /*%string(255)*/ S ) #line 103 "uiocp17.imp" { // 104 %integer i #line 104 "uiocp17.imp" int I; // 105 s = " #line 105 "uiocp17.imp" S = _imp_join((_imp_string)_imp_join((_imp_string)_imp_join((_imp_string)_imp_join((_imp_string)_imp_join((_imp_string)_imp_join((_imp_string)_imp_str_literal("\nIOCP ERROR "),(_imp_string)S),(_imp_string)_imp_str_literal(" ep = ")),(_imp_string)ITOS(EP)),(_imp_string)_imp_str_literal(" n = ")),(_imp_string)ITOS(N)),(_imp_string)_imp_str_literal("\n")); // 106 IOCP ERROR ".s." ep = ".itos(ep)." n = ".itos(n)." // 107 " // 108 i = write(Stderr,(addr(s) )+1,length(S)) #line 108 "uiocp17.imp" I = write(2, (((int)(_imp_ADDR(&S))) + (1)), *_imp_LENGTH(&S)); // 109 %end;! Ioerr #line 109 "uiocp17.imp" /* Remove %on %event handler here if present for this block */ return; } // End of block IOERR at level 1 // 110 ! // 111 ! Copyright (c) 1987 Edinburgh Portable Compilers Ltd. All Rights Reserved. // 112 %externalintegerfn Iocp %alias "s_iocp"(%integer ep,n) #line 112 "uiocp17.imp" int IOCP( int EP, int N ) #line 112 "uiocp17.imp" { // 113 %switch entry(1:19) #line 113 "uiocp17.imp" static int sw1_ENTRY_idx; static const void * /*SWITCH*/ sw1_ENTRY[19] = { &&sw1_ENTRY_1, &&sw1_ENTRY_2, &&sw1_ENTRY_3, &&sw1_ENTRY_4, &&sw1_ENTRY_5, &&sw1_ENTRY_6, &&sw1_ENTRY_7, &&sw1_ENTRY_8, &&sw1_ENTRY_9, &&sw1_ENTRY_10, &&sw1_ENTRY_11, &&sw1_ENTRY_12, &&sw1_ENTRY_13, &&sw1_ENTRY_14, &&sw1_ENTRY_15, &&sw1_ENTRY_16, &&sw1_ENTRY_17, &&sw1_ENTRY_18, &&sw1_ENTRY_19, }; // 114 %constinteger Maxlinelen = 132 // 115 %ownbyteintegerarray Line(0:Maxlinelen+1) #line 115 "uiocp17.imp" static unsigned char LINE[134]; // 116 %ownbyteintegerarray inbuf(0:4096) #line 116 "uiocp17.imp" static unsigned char INBUF[4097]; // 117 %owninteger left,inptr #line 117 "uiocp17.imp" static int LEFT; #line 117 "uiocp17.imp" static int INPTR; // 118 %owninteger endgiven=0 #line 118 "uiocp17.imp" static int ENDGIVEN = 0; // 119 %integer bytead,len #line 119 "uiocp17.imp" int BYTEAD; #line 119 "uiocp17.imp" int LEN; // 120 %owninteger Lptr #line 120 "uiocp17.imp" static int LPTR; // 121 %integer i,ch,j #line 121 "uiocp17.imp" int I; #line 121 "uiocp17.imp" int CH; #line 121 "uiocp17.imp" int J; // 122 %owninteger OutID = Stdout, InID = Stdin #line 122 "uiocp17.imp" static int OUTID = 1; #line 122 "uiocp17.imp" static int INID = 0; // 123 // 124 !%string(255) mess // 125 // 126 ! mess = " // 127 ! IOCP( ".itos(ep)." ".itos(n)." Lptr = ".itos(lptr) // 128 ! i = NOT write(1,(addr(mess)*2) + 1, length(mess)) // 129 ! // 130 // 131 ! // 132 // 133 // 134 ! Copyright (c) 1987 Edinburgh Portable Compilers Ltd. All Rights Reserved. // 135 ! // 136 // 137 // 138 // 139 // 140 %unless 1<=ep<=19 %then IOERR(ep,n," Bad entry ") %and OutID=Stderr #line 140 "uiocp17.imp" if ((((1) > (EP))) || (((EP) <= (19)))) goto L_000e; #line 140 "uiocp17.imp" L_000b:; #line 140 "uiocp17.imp" IOERR(EP, N, _imp_str_literal(" Bad entry ")); #line 140 "uiocp17.imp" OUTID = 2; #line 140 "uiocp17.imp" L_000e:; // 141 ->entry(ep) #line 141 "uiocp17.imp" sw1_ENTRY_idx = EP; if ((1 <= sw1_ENTRY_idx) && (sw1_ENTRY_idx <= 19)) goto *(sw1_ENTRY-1)[sw1_ENTRY_idx]; /* Bounds=1:19 */ else { /*_imp_signal(8, 2, sw1_ENTRY_idx);*/ fprintf(stderr, "%%SWITCH index ENTRY(%d) not in range 1:19 at %s:%d\n", sw1_ENTRY_idx, (_imp_current_file != 0 ? _imp_current_file : __FILE__), (_imp_current_line != 0 ? _imp_current_line : __LINE__)); exit(1); } // 142 // 143 entry(*): IOERR(ep,n," Entry not implemented ") #line 143 "uiocp17.imp" sw1_ENTRY_default:; #line 143 "uiocp17.imp" IOERR(EP, N, _imp_str_literal(" Entry not implemented ")); // 144 OutID=Stderr #line 144 "uiocp17.imp" OUTID = 2; // 145 // 146 ! entry(4): // 147 entry(1): { READSYMBOL } #line 147 "uiocp17.imp" sw1_ENTRY_1:; // 148 entry(2): { NEXTSYMBOL } #line 148 "uiocp17.imp" sw1_ENTRY_2:; // 149 entry(18): { nextsymbol } #line 149 "uiocp17.imp" sw1_ENTRY_18:; // 150 %if left=0 %start #line 150 "uiocp17.imp" if (((LEFT) != (0))) goto L_000f; // 151 left = read(streamtable(inid),addr(inbuf(0)) ,4096) #line 151 "uiocp17.imp" LEFT = read(STREAMTABLE[INID], _imp_ADDR(&INBUF[0]), 4096); // 152 %if left=0 %start #line 152 "uiocp17.imp" if (((LEFT) != (0))) goto L_0010; // 153 %if endgiven=0 %start #line 153 "uiocp17.imp" if (((ENDGIVEN) != (0))) goto L_0011; // 154 endgiven=1 #line 154 "uiocp17.imp" ENDGIVEN = 1; // 155 printstring("End of input file") #line 155 "uiocp17.imp" _imp_PRINTSTRING(_imp_str_literal("End of input file")); // 156 %result=0 #line 156 "uiocp17.imp" /* Remove %on %event handler here if present for this block */ return 0; // 157 %finish %else %stop #line 157 "uiocp17.imp" L_0011:; #line 157 "uiocp17.imp" exit(0); // 158 %finish #line 158 "uiocp17.imp" L_0010:; // 159 %if left = -1 %then printstring(" read fails ") %and %result=0 #line 159 "uiocp17.imp" if (((LEFT) != ((-1)))) goto L_0012; #line 159 "uiocp17.imp" _imp_PRINTSTRING(_imp_str_literal(" read fails ")); #line 159 "uiocp17.imp" /* Remove %on %event handler here if present for this block */ return 0; #line 159 "uiocp17.imp" L_0012:; // 160 inptr=-1 #line 160 "uiocp17.imp" INPTR = (-1); // 161 %finish #line 161 "uiocp17.imp" L_000f:; // 162 // 163 %if ep=1 %start #line 163 "uiocp17.imp" if (((EP) != (1))) goto L_0013; // 164 inptr=inptr+1 #line 164 "uiocp17.imp" INPTR = (((int)(INPTR)) + (1)); // 165 left=left-1 #line 165 "uiocp17.imp" LEFT = (((int)(LEFT)) - (1)); // 166 %result = inbuf(inptr) #line 166 "uiocp17.imp" /* Remove %on %event handler here if present for this block */ return INBUF[INPTR]; // 167 %finishelsestart #line 167 "uiocp17.imp" L_0013:; // 168 %result=inbuf(inptr+1) #line 168 "uiocp17.imp" /* Remove %on %event handler here if present for this block */ return INBUF[(((int)(INPTR)) + (1))]; // 169 %finish // 170 // 171 entry(3): { PRINTSYMBOL } #line 171 "uiocp17.imp" sw1_ENTRY_3:; // 172 entry(5): { PRINTCH } #line 172 "uiocp17.imp" sw1_ENTRY_5:; // 173 %result=0 %if OutID<0 #line 173 "uiocp17.imp" if (((OUTID) >= (0))) goto L_0014; #line 173 "uiocp17.imp" /* Remove %on %event handler here if present for this block */ return 0; #line 173 "uiocp17.imp" L_0014:; // 174 Line(Lptr) = n #line 174 "uiocp17.imp" LINE[LPTR] = N; // 175 Lptr = Lptr + 1 #line 175 "uiocp17.imp" LPTR = (((int)(LPTR)) + (1)); // 176 %if ch = NL %or Lptr >= Maxlinelen %start #line 176 "uiocp17.imp" if (((CH) == (10))) goto L_0015; #line 176 "uiocp17.imp" if (((LPTR) < (132))) goto L_0016; #line 176 "uiocp17.imp" L_0015:; // 177 i = write(OutID,addr(Line(0)) ,Lptr) #line 177 "uiocp17.imp" I = write(OUTID, _imp_ADDR(&LINE[0]), LPTR); // 178 %if i#Lptr %then ioerr(ep,n," Write fails ") %and OutID=Stderr #line 178 "uiocp17.imp" if (((I) == (LPTR))) goto L_0017; #line 178 "uiocp17.imp" IOERR(EP, N, _imp_str_literal(" Write fails ")); #line 178 "uiocp17.imp" OUTID = 2; #line 178 "uiocp17.imp" L_0017:; // 179 Lptr = 0 #line 179 "uiocp17.imp" LPTR = 0; // 180 %finish #line 180 "uiocp17.imp" L_0016:; // 181 %result=0 #line 181 "uiocp17.imp" /* Remove %on %event handler here if present for this block */ return 0; // 182 // 183 entry(15): {only valid symbols PRINTSTRING } #line 183 "uiocp17.imp" sw1_ENTRY_15:; // 184 entry(7): { PRINTSTRING } #line 184 "uiocp17.imp" sw1_ENTRY_7:; // 185 %result=0 %if OutID<0 #line 185 "uiocp17.imp" if (((OUTID) >= (0))) goto L_0018; #line 185 "uiocp17.imp" /* Remove %on %event handler here if present for this block */ return 0; #line 185 "uiocp17.imp" L_0018:; // 186 bytead = n #line 186 "uiocp17.imp" BYTEAD = N; // 187 Len = byteinteger(bytead) #line 187 "uiocp17.imp" LEN = *_imp_BYTEINTEGER(BYTEAD); // 188 %result=0 %if len = 0 #line 188 "uiocp17.imp" if (((LEN) != (0))) goto L_0019; #line 188 "uiocp17.imp" /* Remove %on %event handler here if present for this block */ return 0; #line 188 "uiocp17.imp" L_0019:; // 189 %cycle i = 1,1,Len #line 189 "uiocp17.imp" {static int _initial, _increment, _final, _control; _initial = 1; _increment = 1; _final = LEN; I = _control = _initial; if (((_final-_initial) % _increment) != 0) _imp_signal(5,1,0,"Illegal cycle I = 1, 1, LEN"); I -= _increment; _control -= _increment; L_001a:; if (I == _final) goto L_001b; I += _increment; _control += _increment; if (I != _control) _imp_signal(4,2,0,"Corrupt control variable I"); /* FOR loop control variable corrupted */ } // 190 ch = byteinteger(bytead+i) #line 190 "uiocp17.imp" CH = *_imp_BYTEINTEGER((((int)(BYTEAD)) + (I))); // 191 Line(Lptr) = ch #line 191 "uiocp17.imp" LINE[LPTR] = CH; // 192 Lptr = Lptr + 1 #line 192 "uiocp17.imp" LPTR = (((int)(LPTR)) + (1)); // 193 %if ch = NL %or Lptr >= Maxlinelen %start #line 193 "uiocp17.imp" if (((CH) == (10))) goto L_001d; #line 193 "uiocp17.imp" if (((LPTR) < (132))) goto L_001e; #line 193 "uiocp17.imp" L_001d:; // 194 j = write(OutID,addr(Line(0)) ,Lptr) #line 194 "uiocp17.imp" J = write(OUTID, _imp_ADDR(&LINE[0]), LPTR); // 195 %if j#Lptr %then ioerr(ep,n," Write fails ") %and OutID=Stderr #line 195 "uiocp17.imp" if (((J) == (LPTR))) goto L_001f; #line 195 "uiocp17.imp" IOERR(EP, N, _imp_str_literal(" Write fails ")); #line 195 "uiocp17.imp" OUTID = 2; #line 195 "uiocp17.imp" L_001f:; // 196 Lptr = 0 #line 196 "uiocp17.imp" LPTR = 0; // 197 %finish #line 197 "uiocp17.imp" L_001e:; // 198 %repeat #line 198 "uiocp17.imp" goto L_001a; #line 198 "uiocp17.imp" L_001b:; // 199 %result=0 #line 199 "uiocp17.imp" /* Remove %on %event handler here if present for this block */ return 0; // 200 // 201 entry(8): { SELECTINPUT } #line 201 "uiocp17.imp" sw1_ENTRY_8:; // 202 InID = n #line 202 "uiocp17.imp" INID = N; // 203 %result=0 #line 203 "uiocp17.imp" /* Remove %on %event handler here if present for this block */ return 0; // 204 // 205 // 206 entry(9): %if n=0 %then n=1 { map 0 to STDOUT } #line 206 "uiocp17.imp" sw1_ENTRY_9:; #line 206 "uiocp17.imp" if (((N) != (0))) goto L_0020; #line 206 "uiocp17.imp" N = 1; #line 206 "uiocp17.imp" L_0020:; // 207 { SELECTOUTPUT } // 208 %if Lptr>0 %start #line 208 "uiocp17.imp" if (((LPTR) <= (0))) goto L_0021; // 209 i = write(OutID,addr(Line(0)) ,Lptr) #line 209 "uiocp17.imp" I = write(OUTID, _imp_ADDR(&LINE[0]), LPTR); // 210 %if i#Lptr %then ioerr(ep,n," Write fails ") %and OutID=Stderr #line 210 "uiocp17.imp" if (((I) == (LPTR))) goto L_0022; #line 210 "uiocp17.imp" IOERR(EP, N, _imp_str_literal(" Write fails ")); #line 210 "uiocp17.imp" OUTID = 2; #line 210 "uiocp17.imp" L_0022:; // 211 Lptr = 0 #line 211 "uiocp17.imp" LPTR = 0; // 212 %finish #line 212 "uiocp17.imp" L_0021:; // 213 OutID = n #line 213 "uiocp17.imp" OUTID = N; // 214 %result=0 #line 214 "uiocp17.imp" /* Remove %on %event handler here if present for this block */ return 0; // 215 // 216 entry(11): %result=0 %if OutID<0 #line 216 "uiocp17.imp" sw1_ENTRY_11:; #line 216 "uiocp17.imp" if (((OUTID) >= (0))) goto L_0023; #line 216 "uiocp17.imp" /* Remove %on %event handler here if present for this block */ return 0; #line 216 "uiocp17.imp" L_0023:; // 217 { Flush buffer } // 218 %if Lptr>0 %start #line 218 "uiocp17.imp" if (((LPTR) <= (0))) goto L_0024; // 219 i = write(OutID,addr(Line(0)) ,Lptr) #line 219 "uiocp17.imp" I = write(OUTID, _imp_ADDR(&LINE[0]), LPTR); // 220 %if i#Lptr %then ioerr(ep,n," Write fails ") %and OutID=Stderr #line 220 "uiocp17.imp" if (((I) == (LPTR))) goto L_0025; #line 220 "uiocp17.imp" IOERR(EP, N, _imp_str_literal(" Write fails ")); #line 220 "uiocp17.imp" OUTID = 2; #line 220 "uiocp17.imp" L_0025:; // 221 Lptr = 0 #line 221 "uiocp17.imp" LPTR = 0; // 222 %finish #line 222 "uiocp17.imp" L_0024:; // 223 %result=0 #line 223 "uiocp17.imp" /* Remove %on %event handler here if present for this block */ return 0; // 224 // 225 entry(16): %result=0 %if OutID<0 #line 225 "uiocp17.imp" sw1_ENTRY_16:; #line 225 "uiocp17.imp" if (((OUTID) >= (0))) goto L_0026; #line 225 "uiocp17.imp" /* Remove %on %event handler here if present for this block */ return 0; #line 225 "uiocp17.imp" L_0026:; // 226 { CLOSE } // 227 %if Lptr>0 %start #line 227 "uiocp17.imp" if (((LPTR) <= (0))) goto L_0027; // 228 i = write(OutID,addr(Line(0)) ,Lptr) #line 228 "uiocp17.imp" I = write(OUTID, _imp_ADDR(&LINE[0]), LPTR); // 229 %if i#Lptr %then ioerr(ep,n," Write fails ") %and OutID=Stderr #line 229 "uiocp17.imp" if (((I) == (LPTR))) goto L_0028; #line 229 "uiocp17.imp" IOERR(EP, N, _imp_str_literal(" Write fails ")); #line 229 "uiocp17.imp" OUTID = 2; #line 229 "uiocp17.imp" L_0028:; // 230 Lptr = 0 #line 230 "uiocp17.imp" LPTR = 0; // 231 %finish #line 231 "uiocp17.imp" L_0027:; // 232 CLOSE(n) %unless n < 3 #line 232 "uiocp17.imp" if (((N) < (3))) goto L_0029; #line 232 "uiocp17.imp" close(N); #line 232 "uiocp17.imp" L_0029:; // 233 %result=0 #line 233 "uiocp17.imp" /* Remove %on %event handler here if present for this block */ return 0; // 234 // 235 entry(17): { PRINTSYMBOL n times } #line 235 "uiocp17.imp" sw1_ENTRY_17:; // 236 %result=0 %if OutID<0 #line 236 "uiocp17.imp" if (((OUTID) >= (0))) goto L_002a; #line 236 "uiocp17.imp" /* Remove %on %event handler here if present for this block */ return 0; #line 236 "uiocp17.imp" L_002a:; // 237 ch = n&255 #line 237 "uiocp17.imp" CH = ((N) & (255)); // 238 %if n> 0 %thenstart #line 238 "uiocp17.imp" if (((N) <= (0))) goto L_002b; // 239 %cycle i=1,1,(n>>8)&255 #line 239 "uiocp17.imp" {static int _initial, _increment, _final, _control; _initial = 1; _increment = 1; _final = (((int)((((unsigned int)(N)) >> (8)))) & (255)); I = _control = _initial; if (((_final-_initial) % _increment) != 0) _imp_signal(5,1,0,"Illegal cycle I = 1, 1, (((int)((((unsigned int)(N)) >> (8)))) & (255))"); I -= _increment; _control -= _increment; L_002c:; if (I == _final) goto L_002d; I += _increment; _control += _increment; if (I != _control) _imp_signal(4,2,0,"Corrupt control variable I"); /* FOR loop control variable corrupted */ } // 240 Line(Lptr) = ch #line 240 "uiocp17.imp" LINE[LPTR] = CH; // 241 Lptr = Lptr + 1 #line 241 "uiocp17.imp" LPTR = (((int)(LPTR)) + (1)); // 242 %if Lptr >= Maxlinelen %start #line 242 "uiocp17.imp" if (((LPTR) < (132))) goto L_002f; // 243 i = write(OutID,addr(Line(0)) ,Lptr) #line 243 "uiocp17.imp" I = write(OUTID, _imp_ADDR(&LINE[0]), LPTR); // 244 %if i#Lptr %then ioerr(ep,n," Write fails ") %and OutID=Stderr #line 244 "uiocp17.imp" if (((I) == (LPTR))) goto L_0030; #line 244 "uiocp17.imp" IOERR(EP, N, _imp_str_literal(" Write fails ")); #line 244 "uiocp17.imp" OUTID = 2; #line 244 "uiocp17.imp" L_0030:; // 245 Lptr = 0 #line 245 "uiocp17.imp" LPTR = 0; // 246 %finish #line 246 "uiocp17.imp" L_002f:; // 247 %repeat #line 247 "uiocp17.imp" goto L_002c; #line 247 "uiocp17.imp" L_002d:; // 248 %if ch=NL %start #line 248 "uiocp17.imp" if (((CH) != (10))) goto L_0031; // 249 i = write(OutID,addr(Line(0)) ,Lptr) #line 249 "uiocp17.imp" I = write(OUTID, _imp_ADDR(&LINE[0]), LPTR); // 250 %if i#Lptr %then ioerr(ep,n," Write fails ") %and OutID=Stderr #line 250 "uiocp17.imp" if (((I) == (LPTR))) goto L_0032; #line 250 "uiocp17.imp" IOERR(EP, N, _imp_str_literal(" Write fails ")); #line 250 "uiocp17.imp" OUTID = 2; #line 250 "uiocp17.imp" L_0032:; // 251 Lptr = 0 #line 251 "uiocp17.imp" LPTR = 0; // 252 %finish #line 252 "uiocp17.imp" L_0031:; // 253 // 254 %finish #line 254 "uiocp17.imp" L_002b:; // 255 %result=0 #line 255 "uiocp17.imp" /* Remove %on %event handler here if present for this block */ return 0; // 256 entry(19): ! return output line ptr #line 256 "uiocp17.imp" sw1_ENTRY_19:; // 257 %result=Lptr #line 257 "uiocp17.imp" /* Remove %on %event handler here if present for this block */ return LPTR; // 258 %end; !Iocp #line 258 "uiocp17.imp" sw1_ENTRY_4:; sw1_ENTRY_6:; sw1_ENTRY_10:; sw1_ENTRY_12:; sw1_ENTRY_13:; sw1_ENTRY_14:; goto sw1_ENTRY_default; } // End of block IOCP at level 1 // 259 ! // 260 ! Copyright (c) 1987 Edinburgh Portable Compilers Ltd. All Rights Reserved. // 261 ! // 262 // 263 %externalroutine Stop %alias "s_stop" #line 263 "uiocp17.imp" void STOP( void ) #line 263 "uiocp17.imp" { // 264 // 265 !%externalroutinespec iocp %alias "s_iocp"(%integer ep,n) // 266 %systemroutinespec exit %alias "exit" (%integer rc) #line 266 "uiocp17.imp" extern void exit( int RC ); // 267 // 268 %integer rc = Iocp(11,0) { flush buffer } #line 268 "uiocp17.imp" int RC; #line 268 "uiocp17.imp" RC = IOCP(11, 0); // 269 ! printstring(" // 270 !Program stopped // 271 !") // 272 // 273 exit(rc) #line 273 "uiocp17.imp" exit(RC); // 274 // 275 %end;! Stop #line 275 "uiocp17.imp" /* Remove %on %event handler here if present for this block */ return; } // End of block STOP at level 1 // 276 // 277 // 278 // 279 !%externalroutine Fdiag %alias "f_fdiag"(%integer LNB,gla,PC,ADIAGS,first,%integername flag) // 280 !%end;! Fdiag // 281 ! // 282 ! Copyright (c) 1987 Edinburgh Portable Compilers Ltd. All Rights Reserved. // 283 ! // 284 %endoffile #line 284 "uiocp17.imp" // End of file