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