! File: ONCE.BLI ! ! This work was supported by the Advanced Research ! Projects Agency of the Office of the Secretary of ! Defense (F44620-73-C-0074) and is monitored by the ! Air Force Office of Scientific Research. ! 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 %; 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 'CREATE', TK_CREATE, ! 12 0, 0, ! 13 'LENGTH', TK_LENGTH, ! 14 'AT', TK_CRAT, ! 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 'NSET', TK_NSET, ! 27 'TESN', TK_TESN, ! 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 0, TK_ERROR, ! 44 '$' 'GEQ', TK_GEQ, ! 45 0, TK_ERROR, ! 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 0, 0, ! 112 0, 0, ! 113 0, 0, ! 114 0, 0, ! 115 0, 0, ! 116 0, 0, ! 117 0, 0, ! 120 0, 0, ! 121 'ELUDOM', TK_ELUDOM, ! 122 'EXITLOOP', TK_EXITLOOP, ! 123 'PSECT', TK_PSECT, ! 124 'GTR', TK_GTR, ! 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, TK_BACKSLASH, ! 134 '\' 0, TK_RBRACKET, ! 135 ']' 0, TK_SHIFT, ! 136 '^' 0, TK_STORE, ! 137 '_' 0, TK_ERROR, ! 140 '`' 'GEQU', TK_GEQU, ! 141 'GTRU', TK_GTRU, ! 142 'NEQU', TK_NEQU, ! 143 'SIGNAL', TK_SIGNAL, ! 144 'ENABLE', TK_ENABLE, ! 145 'ELBANE', TK_ELBANE, ! 146 'MAX', TK_MAX, ! 147 'MIN', TK_MIN, ! 150 'ROT', TK_ROT, ! 151 'UPLIT', TK_UPLIT, ! 152 'REQUIRE', TK_REQUIRE, ! 153 'CSECT', TK_CSECT, ! 154 'STACKLOCAL', TK_STACKLOCAL, ! 155 'LINKAGE', TK_LINKAGE, ! 156 'INLINECOM', TK_INLINECOM, ! 157 0, TK_ERROR, ! 160 0, TK_ERROR, ! 161 0, TK_ERROR, ! 162 0, TK_ERROR, ! 163 0, TK_ERROR, ! 164 0, TK_ERROR, ! 165 0, TK_ERROR, ! 166 0, TK_ERROR, ! 167 0, TK_ERROR, ! 170 0, TK_ERROR, ! 171 0, TK_ERROR, ! 172 0, TK_ERROR, ! 173 '{' 0, TK_ERROR, ! 174 '|' 0, TK_ERROR, ! 175 '}' 0, TK_ERROR, ! 176 '~' 0, TK_ERROR ! 177 )) : Vector[,Long]; Bind SPCFNPLIT = Uplit Long ( AZ( 'HALT', 'RESET', 'WAIT', 'NOP', 'SWAB', 'CARRY', 'OVERFLOW', 'MFPI', 'MFPD', 'MTPI', 'MTPD' )) : Vector[,Long]; Bind ISTGPLIT = Uplit Long ( AZ( 'ASCII', 'ASCIZ', 'RAD50', '$UNQUOTE', '$NAME', '$STRING', '$COUNT', '$LENGTH' )) : Vector[,Long]; Bind REGSPLIT = Uplit Long ( AZ( 'VREG', 'SP', 'PC', 'R0', 'R1', 'R2', 'R3', 'R4', 'R5' )) : Vector[,Long]; Bind DCLEXTPLIT = Uplit Long ( AZ( 'MUL', 'DIVR', 'MODR', 'ROTATE', 'SHIFT', '$SAV2', '$SAV3', '$SAV4', '$SAV5', '$CREAT', 'EXCHJ', '$BREG', '$PREV', '$SIGNL', '$SIGN1', '$ENABL', 'SIGVAL', 'SIGREG', 'INIT612', 'ESIX12', 'SIX12', 'XSIX12', '$LINK', '$ILINK', 'LINKTB' )) : Vector[,Long]; Bind DVP = Uplit Long ( 0, 0,'(', T_STRUCT_ARG, 1,'+', T_STRUCT_ARG, 2,'*', T_STRUCT_ARG, 4,')', 0, 0,'<', T_LITERAL, 0,',', T_STRUCT_ARG, 2,'*', T_LITERAL, 8,'>', 0, 0,'>') : Vector[,Long]; Bind DVP2 = Uplit Long ( T_MACRO_ARG,1,0) : Vector[,Long]; 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); Routine ISTG(NAME : Ref Vector[,Byte],TYP,ADDINF)= Begin Return LEXOUT(T_SYMBOL,STINSERT(NTINSERT(.NAME),.TYP,.ADDINF)) End; 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; Routine DECLEXT(N : Ref Vector[,Byte])= Begin Local S : Ref ST; S = ISTG(.N,S_EXTERNAL,0); DEFASYM(.S,2,0,16); DEFMAP(.S); S[st_var_linkage] = .sym_bliss; PEXTERNAL(0,2,.S); Return .S End; Routine FORMBODY(T : Ref Vector[0,Long],N : Integer) = Begin Local V : Ref Vector, J : Integer; V = GETSPACE(.N+2); V[0] = .N; V[1] = 0; Incr I From 0 To .N-1 Do Begin J = .I * 3; V[.I+2] = FORMWINDOW(FASTLEXOUT(.T[.J],.T[.J+1]),.T[.J+2]) End; Return .V End; Global Routine ONCEONLY : Novalue = Begin Local V : Ref Vector, R : Ref ST, J : Integer, S : Ref Vector[,Byte]; 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); DEFLNKG(AZ('HYDRA'), LNK_HYDRA, PARM0); DEFLNKG(AZ('IHYDRA'), LNK_IHYDRA, PARM0); SPEC1LNKG = DEFLNKG(AZ('.SPEC1'), LNK_SPECIAL, PARM0); SPEC2LNKG = DEFLNKG(AZ('.SPEC2'), LNK_SPECIAL, PARM1); EXCHJLNKG = DEFLNKG(AZ('.SPEC3'), LNK_SPECIAL, PARM2); ! EXCHJ ACTUALLY SHOULD HAVE THE BLISS LINKAGE TYPE, BUT ! BY GIVING IT THE SPECIAL LINKAGE TYPE WE FORCE SYNTAX ! TO CHECK FOR THE NUMBER OF PARAMETERS BEING MORE THAN 2. ! define all the reserved words Incr I From 0 To 127 Do Begin J = .I * 2; S = .ISTPLIT[.J]; If .S Neqa 0 Then DTPF[.I] = STINSERT(NTINSERT(.S),0,.I); DT[.I] = .ISTPLIT[.J+1] End; ! 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 function '$QUOTE' ISTG(AZ('$QUOTE'),S_LEX_EXPAND,0); ! initialize all the other lexical functions Incr I From 0 To 7 Do ISTG(.ISTGPLIT[.I], S_LEX_CONV, .I); ! define all the pre-defined register names Incr I From 0 To 8 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; TNCHAIN[itm_llink] = TNCHAIN; TNCHAIN[itm_rlink] = TNCHAIN; ! define all the run-time library routines Incr I From 0 To 24 Do tbl_symbols[.I] = DECLEXT(.DCLEXTPLIT[.I]); LEXEXCHJ[st_var_linkage] = .EXCHJLNKG; ! define all the builtin functions Incr I From 0 To 10 Do Begin R = ISTG(.SPCFNPLIT[.I], S_SPECIAL, .I); tbl_builtins[.I] = LEXOUT(T_SYMBOL,.R); R[st_var_linkage] = .SPEC1LNKG End; LXHALT[st_var_linkage] = .SPEC2LNKG End; End Eludom