! File: ONCE.BLI ! Module ONCE = Begin Require 'Bliss'; !----------------------------------------------------------------------- !THIS COMPLETE MODULE CONSISTS OF AN INITIALIZATION PORTION FOR THE !BLISS COMPILER. ALL THESE THINGS ARE DONE ONE TIME ONLY, AT THE !VERY INITIALIZATION OF COMPILATION. ! ! BASICALLY, THIS MODULE HAS A ROUTINE 'ONCEONLY', FOR ! INITIALIZATIONS, AND THREE (3) OTHER USEFUL ROUTINES ! TO HELP DO THESE INITIALIZATIONS. !----------------------------------------------------------------------- Macro XXX1[a,b] = %If %IsString(a) %Then AZ(a) %Else 0 %fi,b %; ! reserved words ! ! notes: ! DETBRACKET knows the indices of 'PLIT', 'SET', ! 'TES', and 'OF'. Bind ISTPLIT = Uplit Long (XXX1( 0, TK_ERROR, ! 0 'BEGIN', TK_BEGIN, ! 1 'CASE', TK_CASE, ! 2 'DECR', TK_DECR, ! 3 'IF', TK_IF, ! 4 'INCR', TK_INCR, ! 5 'SET', TK_SET, ! 6 'UNTIL', TK_UNTIL, ! 7 'WHILE', TK_WHILE, ! 10 'DO', TK_DO, ! 11 'ELUDOM', TK_ELUDOM, ! 12 'EXITLOOP', TK_EXITLOOP, ! 13 'PSECT', TK_PSECT, ! 14 'GTR', TK_GTR, ! 15 'END', TK_END, ! 16 'OF', TK_OF, ! 17 'FROM', TK_FROM, ! 20 'THEN', TK_THEN, ! 21 'TO', TK_TO, ! 22 'TES', TK_TES, ! 23 'ELSE', TK_ELSE, ! 24 'BY', TK_BY, ! 25 'SELECT', TK_SELECT, ! 26 'ENABLE', TK_ENABLE, ! 27 'ELBANE', TK_ELBANE, ! 30 'ALWAYS', TK_ALWAYS, ! 31 'OTHERWISE', TK_OTHERWISE, ! 32 'OR', TK_OR, ! 33 'XOR', TK_XOR, ! 34 'EQV', TK_EQV, ! 35 'AND', TK_AND, ! 36 'NOT', TK_NOT, ! 37 'LSS', TK_LSS, ! 40 'LEQ', TK_LEQ, ! 41 'EQL', TK_EQL, ! 42 'NEQ', TK_NEQ, ! 43 '$', TK_ERROR, ! 44 '$' 'GEQ', TK_GEQ, ! 45 'SIGNAL', TK_SIGNAL, ! 46 '&' 'MOD', TK_MOD, ! 47 0, TK_CALL, ! 50 '(' 0, TK_RPAREN, ! 51 ')' 0, TK_MUL, ! 52 '*' 0, TK_ADD, ! 53 '+' 0, TK_COMMA, ! 54 ',' 0, TK_MINUS, ! 55 '-' 0, TK_DOT, ! 56 '.' 'DIV', TK_DIV, ! 57 '/' 'REGISTER', TK_REGISTER, ! 60 'OWN', TK_OWN, ! 61 'GLOBAL', TK_GLOBAL, ! 62 'EXTERNAL', TK_EXTERNAL, ! 63 'ROUTINE', TK_ROUTINE, ! 64 'STRUCTURE', TK_STRUCTURE, ! 65 'MAP', TK_MAP, ! 66 'BIND', TK_BIND, ! 67 'LOCAL', TK_LOCAL, ! 70 'MACRO', TK_MACRO, ! 71 0, TK_COLON, ! 72 ':' 0, TK_SEMICOLON, ! 73 ';' 0, TK_LANGLE, ! 74 '<' 0, TK_EQUAL, ! 75 '=' 0, TK_RANGLE, ! 76 '>' 'FORWARD', TK_FORWARD, ! 77 0, TK_DOT, ! 100 '@' (same as '.') 'UNDECLARE', TK_UNDECLARE, ! 101 'RETURN', TK_RETURN, ! 102 'LEAVE', TK_LEAVE, ! 103 'WITH', TK_WITH, ! 104 'LABEL', TK_LABEL, ! 105 'BYTE', TK_BYTE, ! 106 'WORD', TK_WORD, ! 107 'SWITCHES', TK_SWITCHES, ! 110 'MODULE', TK_MODULE, ! 111 'MAX', TK_MAX, ! 112 'MIN', TK_MIN, ! 113 'ROT', TK_ROT, ! 114 'UPLIT', TK_UPLIT, ! 115 'REQUIRE', TK_REQUIRE, ! 116 0, 0, ! 117 'STACKLOCAL', TK_STACKLOCAL, ! 120 'LINKAGE', TK_LINKAGE, ! 121 'INLINECOM', TK_INLINECOM, ! 122 'GEQU', TK_GEQU, ! 123 'GTRU', TK_GTRU, ! 124 'NEQU', TK_NEQU, ! 125 'PLIT', TK_PLIT, ! 126 'INLINE', TK_INLINE, ! 127 'EQLU', TK_EQLU, ! 130 'LEQU', TK_LEQU, ! 131 'LSSU', TK_LSSU, ! 132 0, TK_LBRACKET, ! 133 '[' 0, 0, ! 134 '\' 0, TK_RBRACKET, ! 135 ']' 0, TK_SHIFT, ! 136 '^' 0, TK_STORE, ! 137 '_' 'REP', TK_REP, ! 140 '`' 0, 0, ! 141 0, 0, ! 142 0, 0, ! 143 0, 0, ! 144 0, 0, ! 145 0, 0, ! 146 0, 0, ! 147 0, 0, ! 150 0, 0, ! 151 0, 0, ! 152 0, 0, ! 153 0, 0, ! 154 0, 0, ! 155 0, 0, ! 156 0, 0, ! 157 0, 0, ! 160 0, 0, ! 161 0, 0, ! 162 0, 0, ! 163 0, 0, ! 164 0, 0, ! 165 0, 0, ! 166 0, 0, ! 167 0, 0, ! 170 0, 0, ! 171 0, 0, ! 172 0, 0, ! 173 '{' 0, 0, ! 174 '|' 0, 0, ! 175 '}' 0, 0, ! 176 '~' 0, 0 ! 177 )) : Vector[,Long]; ! special functions Bind SPCFNPLIT = Plit( AZ( 'HALT', 'RESET', 'WAIT', 'NOP', 'SWAB', 'CARRY', 'OVERFLOW', 'MFPI', 'MFPD', 'MTPI', 'MTPD' )) : Vector; ! lexical functions Bind ISTGPLIT = Plit( AZ( 'ASCII', 'ASCIZ', '$NAME', '$STRING', '$COUNT', '$LENGTH' )) : Vector; ! register names Bind REGSPLIT = Plit( AZ( 'VREG', 'SP', 'PC', 'R0', 'R1', 'R2', 'R3', 'R4', 'R5' )) : Vector; ! run-time library routines Bind DCLEXTPLIT = Plit( AZ( 'MUL', 'DIVR', 'MODR', 'ROTATE', 'SHIFT', '$SAV2', '$SAV3', '$SAV4', '$SAV5', '$SIGNL', '$SIGN1', '$ENABL', 'SIGVAL', 'SIGREG', 'INIT612', 'ESIX12', 'SIX12', 'XSIX12' )) : Vector; ! default psect names Bind PSCPLIT = Plit( AZ( 'CODE','DEBUG','GLOBAL','OWN','PLIT' ) ) : Vector; ! STRUCTURE VECTOR[I] = [I*BYTES](VECTOR+.I*BYTES)<0,BYTES*8>; ! ! notes: ! the structure arguments are numbered: ! ! 0 = structure variable ! 1 = 'BYTES' value ! 2+ = actuals Bind DVP = Uplit Long ( 0, 0,'(', T_STRUCT_ARG, 0,'+', T_STRUCT_ARG, 2,'*', T_STRUCT_ARG, 1,')', 0, 0,'<', T_LITERAL, 0,',', T_STRUCT_ARG, 1,'*', T_LITERAL, 8,'>', 0, 0,'>') : Vector[,Long]; ! MACRO $REMAINDER[X] = X $; Bind DVP2 = Uplit Long ( T_MACRO_ARG,0,0) : Vector[,Long]; ! note: ! we are using the knowledge of byte-ordering here. Bind PARM0 = Uplit Long (0,0), PARM1 = Uplit Long (1,0,VR,PARM_REGISTER), PARM2 = Uplit Long (2,0,0,PARM_STACK,VR,PARM_REGISTER); ! create a symbol table entry Routine ISTG(NAME : Ref Vector[,Byte],TYP : Integer,ADDINF : Integer) = Begin Return STINSERT(SEARCH(.NAME),.TYP,.ADDINF) End; ! define a linkage type Routine DEFLNKG(N,T,DESC) = Begin Local S : Ref ST; S = ISTG(.N,S_LINKAGE,0); S[st_lnk_type] = .T; S[st_lnk_desc] = .DESC; Return .S End; ! define an external symbol Routine DECLEXT(N : Ref Vector[,Byte]) = Begin Local S : Ref ST; S = ISTG(.N,S_EXTERNAL,0); S[st_var_size] = 2; S[gt_pos] = 0; S[gt_len] = 16; S[st_v_no_acts] = TRUE; S[st_var_actuals] = .sym_vector; S[st_var_linkage] = .sym_bliss; post_external(0,2,.S); Return .S End; ! form a lexeme stream for a structure/macro body ! ! note: ! this routine is a kludge because the bliss-64 compiler ! does not allow for constants of more than 32 bits and ! lexemes are 64 bits long. Routine FORMBODY(T : Ref Vector[0,Long],N : Integer) = Begin Local V : Ref Vector, p : Ref GT, J : Integer; V = GETSPACE(SZ_STREAM(.N)); V[strm_size] = .N; V[strm_next] = 0; p = v[strm_data(0)]; Incr I From 0 To .N-1 Do Begin J = .I * 3; p[lex_type] = .t[.j]; p[lex_addr] = .t[.j+1]; p[lex_delim] = .t[.j+2]; p = .p + 8 End; Return .V End; Global Routine ONCEONLY : Novalue = Begin Local V : Ref Vector, R : Ref ST, J : Integer, S : Ref Vector[,Byte]; ! define all the linkage types sym_bliss = DEFLNKG(AZ('BLISS'), LNK_BLISS, PARM0); DEFLNKG(AZ('FORTRAN'), LNK_FORTRAN, PARM0); DEFLNKG(AZ('EMT'), LNK_EMT, PARM0); sym_trap = DEFLNKG(AZ('TRAP'), LNK_TRAP, PARM0); DEFLNKG(AZ('INTERRUPT'),LNK_INTERRUPT,PARM0); DEFLNKG(AZ('IOT'), LNK_IOT, PARM0); SPEC1LNKG = DEFLNKG(AZ('.SPEC1'), LNK_SPECIAL, PARM0); SPEC2LNKG = DEFLNKG(AZ('.SPEC2'), LNK_SPECIAL, PARM1); ! define all the reserved words Incr I From 0 To 127 Do Begin J = .I * 2; S = .ISTPLIT[.J]; If .S Neqa 0 Then Begin dtpf[.i] = R = SEARCH(.S); R[nt_code] = .I End; DT[.I] = .ISTPLIT[.J+1] End; ! define the name 'STACK' sym_stack = SEARCH(AZ('STACK')); ! I. INITIALIZE THE VECTOR STRUCTURE AND THE 'BYTES' STRUCTURE FORMAL sym_vector = R = ISTG(AZ('VECTOR'),S_STRUCTURE,0); R[st_str_argc] = 1; R[st_str_alloc] = 0; R[st_str_body] = FORMBODY(DVP,9); ! J. INITIALIZE THE ITERATED MACRO $REMAINING sym_remainder = R = ISTG(AZ('$REMAINING'),S_MACRO,0); R[st_mac_num_ited] = 1; R[st_mac_type] = MAC_ITERATIVE; R[st_mac_body] = FORMBODY(DVP2,1); ISTG(AZ('BYTES'),S_STRUCT_ARG,2); ! initialize the lexical functions '$QUOTE' and '$UNQUOTE' ISTG(AZ('$QUOTE'), S_LEX_QUOTE,0); ISTG(AZ('$UNQUOTE'),S_LEX_QUOTE,1); ! initialize all the other lexical functions Incr I From 0 To .ISTGPLIT[-1]-1 Do ISTG(.ISTGPLIT[.I], S_LEX_FUNC, .I); ! define all the pre-defined register names Incr I From 0 To .REGSPLIT[-1]-1 Do Begin R = ISTG(.REGSPLIT[.I],S_REGISTER,0); tbl_registers[.I] = .R; R[gt_mode] = 0; R[gt_pos] = 0; R[gt_len] = 16; End; ! define all the run-time library routines Incr I From 0 To .DCLEXTPLIT[-1]-1 Do tbl_symbols[.I] = DECLEXT(.DCLEXTPLIT[.I]); ! define all the builtin functions Incr I From 0 To .SPCFNPLIT[-1]-1 Do Begin R = ISTG(.SPCFNPLIT[.I], S_SPECIAL, .I); tbl_builtins[.I] = .R; R[st_var_linkage] = .SPEC1LNKG End; LXHALT[st_var_linkage] = .SPEC2LNKG; ! initialize all the psect names Incr I from 0 To 4 Do psc_name[.i] = SEARCH(.pscplit[.i]); ! define the special symbols for OTHERWISE and ALWAYS sym_otherwise = ISTG(AZ('*OTHERWISE*'),S_OTHER,0); sym_always = ISTG(AZ('*ALWAYS*'), S_OTHER,1) End; End Eludom