1: ; Copyright (c) 1981 Harvard-Radcliffe Student Timesharing System
   2: ; Science Center, Harvard University
   3: 
   4: ; the exec function is a nlambda that takes a bunch of atom
   5: ; names and does and exec call on them...
   6: 
   7: 
   8: 
   9: atom exec,,,,execc
  10: 
  11: subrbeg execc,nlambda,1
  12:         chanl
  13:         npush   #anil           ;first, let's dump port
  14:         call    dmpport
  15:         cmp     -(np),-(np)     ;get np back in place
  16:         $sig                    ;and signal to ignore ^b, ^c
  17:                 2.
  18:                 1
  19:         $sig
  20:                 3.
  21:                 1
  22: 
  23: 
  24:  .if    ne,brksig               ;if break is enabled, ignore also
  25:         $sig
  26:          brksig
  27:                 1
  28:         mov     r0,$$sig+4
  29:  .endc
  30: 
  31: 
  32:         $fork                   ;now do the fork
  33:         br      1$              ;the child
  34:         mov     %0,j3           ;save child number
  35: 10$:    $wait                   ;and twiddle our bits
  36:         bcs     11$             ;if carry set, nothing to wait for
  37:         cmp     %0,j3           ;check which child returned
  38:         bne     10$             ;insist on correct child
  39: 11$:    swab    %1              ;return high order byte of child's r0
  40:         movb    %1,b
  41:         sxt     a
  42:         nmstore
  43:         $sig                    ;go through the littany of signals
  44:         3.
  45:         0
  46:         $sig
  47:                 2.
  48:         inthandler
  49: 
  50: 
  51:  .if    ne,brksig
  52:         mov     #brksig,$$sig+2
  53:         $indir
  54:         $$sig
  55:  .endc
  56: 
  57:         ret                     ;and leave
  58: 
  59: 
  60: 
  61: 1$:                             ;new process
  62:         call    xrestio         ;close all
  63:         mov     #strbuf,a       ;exec call will be the first 3 wrds of strbuf
  64:         mov     #6,j3           ;6 is an often used constant
  65:         mov     (pc)+,(a)+      ;(pc)+ picks up below
  66:           $exec
  67:         mov     @np,np          ;and get arg--we can kill core at will
  68:         mov     (np),(a)        ;the name
  69:         add     j3,(a)+
  70:         mov     sp,(a)+         ;and the args
  71: 2$:     jmpifnil        np,3$   ;any more???
  72:         mov     (np)+,(sp)      ;yes, stack em
  73:         add     j3,(sp)+
  74:         mov     (np),np
  75:         br      2$
  76: 3$:     clr     (sp)            ;zero the list
  77:         $indir                  ;and do it
  78:         strbuf
  79:                                 ;and die if unsuccessful
  80:         mov     #-1234,%0
  81:         $exit
  82: 
  83: subrend
  84: 
  85: 
  86: 
  87: ;this is the stuff to play with strings
  88: ;routines use each other
  89: 
  90: atom    readc,,,,readxc
  91: 
  92: subrbeg readxc,lambda,1         ;takes port
  93:         chanl
  94:         jmpifnil        @np,1$
  95:         cmptype @np,a,#nport
  96:         beq     10$
  97: 2$:     jmp     erm5er
  98: 1$:     movb    #-5,keybin      ;cheat, so that getc thinks this is non-kbd
  99: 10$:    getca                   ;get char
 100:         cmpb    a,#200          ;eof
 101:         beq     20$             ;yes, return aeof
 102: readce=* .
 103:         mov     #strbuf,b
 104:         movb    a,(b)+
 105:         clrb    (b)+
 106:         mov     a,j2
 107:         jmp     find                    ;get attom
 108: 20$:    mov     #aeof,a
 109:         ret                             ;return eof atom
 110: subrend
 111: atom    nthchar,,,,nthchar
 112: 
 113: subrbeg nthchar,lambda,2
 114:         chas
 115:         mov     @np,a
 116:         cmptype a,b,0
 117:         bne     1$
 118:         numgj1
 119:         mov     -4(np),a
 120:         cmptype a,j3,#natom
 121:         bne     2$
 122:         add     #6,a
 123: 4$:     movb    (a)+,j3
 124:         beq     3$
 125:         dec     j2
 126:         bgt     4$
 127: 3$:     mov     j3,a
 128:         jmp     readce
 129: 2$:     jmp     er17er
 130: 1$:     mov     -4(np),a
 131:         cmptype a,j1,#natom
 132:         bne     2$
 133:         add     #6,a
 134:         clr     b
 135: 5$:     tstb    (a)+
 136:         beq     6$
 137:         inc     b
 138:         br      5$
 139: 6$:     clr     a
 140:         nmstore
 141:         ret
 142: subrend
 143: 
 144: 
 145: 
 146: 
 147: atom    gensym,,,,gens
 148: 
 149: subrbeg gens,lambda,1
 150:         chanl
 151:         mov     @np,a
 152:         jmpifnil        a,1$,nl
 153:         numgj1
 154:         mov     j2,gennum+2
 155:         ret
 156: 
 157: 1$:     mov     #genstr-6,b
 158:         mov     #gennum,a
 159:         dec     2(a)
 160: numlp=* .
 161:         push    b
 162:         call    numstr
 163:         pop     a
 164:         mov     #strbend,j3
 165: 2$:     movb    (b)+,(j3)+
 166:         bne     2$
 167:         mov     #strbend-6,b
 168:         br      lp3
 169: subrend
 170: 
 171: 
 172: 
 173: 
 174: atom    concatp,,,,concatp
 175: 
 176: subrbeg concatp,lambda,1
 177:         mov     @np,b
 178:         cmptype b,a,#natom
 179:         bne     1$
 180:         mov     #pidsav-2,a
 181:         br      numlp
 182: er17er=*  .
 183: 1$:     jmp     erm17e
 184: 
 185: subrend
 186: 
 187: atom    concat,,,,conca
 188: 
 189: subrbeg conca,lambda,2
 190:         chas
 191:         mov     (np),b
 192:         mov     -4(np),a
 193:         cmptype a,j1,#natom
 194:         bne     11$
 195:         cmptype b,j1,#natom
 196:         beq     lp3
 197:         cmptype b,j1,0
 198:         bne     11$
 199:         mov     b,j1
 200:         mov     a,b
 201:         mov     j1,a
 202:         br      numlp           ;get number as int
 203: 11$:    jmp     er17er
 204: 
 205: lp3:    ;here, back with a havein ptr to string 1-6
 206:         ;		 b			"
 207: 
 208:         mov     #strbuf,j1
 209:         add     #6,a
 210:         add     #6,b
 211:         clr     j2
 212: 1$:     movb    (a)+,j3
 213:         beq     atmp2$
 214:         movb    j3,(j1)+
 215:         xor     j3,j2
 216:         cmp     j1,#strbend
 217:         blo     1$
 218: atmp3$: error   </atom too long/>
 219: 
 220: atmp2$: movb    (b)+,j3
 221:         xor     j3,j2
 222:         movb    j3,(j1)+
 223:         beq     4$
 224:         cmp     j1,#strbend
 225:         blo     atmp2$
 226:         br      atmp3$
 227: 4$:     clrb    (j1)+
 228:         mov     j1,b
 229:         jmp     find            ;and away
 230: subrend
Last modified: 1981-05-10
Generated: 2016-12-26
Generated by src2html V0.67
page hit count: 324
Valid CSS Valid XHTML 1.0 Strict