![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to asmosint.s CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [Research Unix] / researchv10no / cmd / spitbol / cint|
Return to asmosint.s CVS log | Up to [Research Unix] / researchv10no / cmd / spitbol / cint |
1.1 root 1: #
2: # Operating System Interface to Berkeley VAX/UNIX
3: # for
4: # Macro SPITBOL V3.5
5: # -----------------------------------------------
6: #
7: # Copyright 1982
8: # Dewar Information Systems Corporation
9: # 221 West Lake Street
10: # Oak Park, Illinois 60302
11: #
12: # register masks
13: #
14: .set mr0,1
15: .set mr1,2
16: .set mr2,4
17: .set mr3,8
18: .set mr4,16
19: .set mr5,32
20: .set mr6,64
21: .set mr7,128
22: .set mr8,256
23: .set mr9,512
24: .set mr10,1024
25: .set mr11,2048
26: #
27: # c functions assume that r0 -> r5 are scratch. however, spitbol
28: # uses r2, r3, and r5. so, need to save these registers across
29: # function calls.
30: #
31: .set mr235,mr2+mr3+mr5
32: #
33: # mask for all registers used by compiler. necessary for dealing
34: # with load modules.
35: #
36: .set cmpreg,mr2+mr3+mr5+mr6+mr7+mr8+mr9+mr10
37: #
38: # miscellaneous equates
39: #
40: .set ch$lk,107 # upper case letter k
41: .set ch$mn,45 # dash (minus sign)
42: .set k,1024
43: .set kwords,k*4
44: #
45: # internal spitbol blocks
46: # -----------------------
47: #
48: # these equates describe compiler control blocks used by osint.
49: #
50: # chain of file control blocks
51: #
52: .set chtyp,0 # type word
53: .set chlen,4 # block length
54: .set chnxt,8 # -> next chblk
55: .set chfcb,12 # -> fcb
56: .set chsize,16 # size of chblk
57: #
58: # icblk - integer block
59: #
60: .set ictyp,0 # type word
61: .set icval,4 # integer value
62: #
63: # scblk - string block
64: #
65: .set sctyp,0 # type word
66: .set sclen,4 # string length
67: .set scstr,8 # start of string
68: #
69: # interface control blocks
70: # ------------------------
71: #
72: # these control blocks are built by the interface to handle i/o.
73: # for files other than standard input, standard output, and the
74: # terminal, these control blocks reside in the compiler's
75: # dynamic area. this requires appropriate setting of the type
76: # words to allow proper garbage collection.
77: #
78: # blocks with type b$xnt contain non-relocatable addresses - that
79: # is, no word may contain a pointer to another block in the
80: # dynamic area.
81: #
82: # blocks with type b$xrt contain relocatable addresses - that is
83: # words may contain a pointer to another block in the dynamic area.
84: #
85: # the basic structure is:
86: #
87: # for each input or output associated file there is:
88: #
89: # 1 ioblk containing all global information about
90: # the file: filename, buffer block pointer,
91: # file descriptor number, flags
92: #
93: # 1 bfblk containing the file buffer
94: #
95: # 1 or more fcblks containing the access mode (line or
96: # raw), the record length, and a pointer to
97: # the ioblk
98: #
99: # the first INPUT() or OUTPUT() call for a file creates one block
100: # of each type. subsequent calls to INPUT() or OUTPUT() for a
101: # previously associated file, may cause the creation of a new fcblk.
102: # allowing multiple fcblks provides the program with different
103: # ways of accessing the same file. for example, one type of access
104: # can be a character at a time and another entire records.
105: #
106: # the compiler keeps track of all active fcblks, and at times
107: # like end-of-job provides the inteface with a chain of all fcblks.
108: #
109: #
110: # bfblk - i/o buffer control block
111: #
112: .set bftyp,0 # type word - b$xnt
113: .set bflen,4 # block length
114: .set bfsiz,8 # buffer size in bytes
115: .set bfrem,12 # bytes remaining
116: .set bfoff,16 # offset to next remaining byte
117: .set bfsize,20 # end of fixed portion
118: #
119: # fcblk - file control block
120: #
121: .set fctyp,0 # type word - b$xrt
122: .set fclen,4 # block length
123: .set fcrsz,8 # record size ( >0 line mode / <0 raw mode)
124: .set fciob,12 # -> ioblk
125: .set fcsize,16 # size of fcblk
126: #
127: # ioblk - i/o control block
128: #
129: .set iotyp,0 # type word - b$xrt
130: .set iolen,4 # block length
131: .set iofnm,8 # -> filename scblk
132: .set iopid,12 # pid (if one end of pipe)
133: .set iobuf,16 # -> bfblk
134: .set iofdn,20 # file descriptor number
135: .set ioflg,24 # flags
136: .set iosize,28 # size of ioelt
137: #
138: # defines that match "spitio.h" for flags in ioflg
139: #
140: .set IO_INP,1 # input associated
141: .set IO_OUP,2 # output associated
142: .set IO_APP,4 # output open for append
143: .set IO_OPN,8 # file is open
144: .set IO_EOF,16 # eof on input file
145: .set IO_ERR,32 # i/o error
146: .set IO_SYS,64 # this is an osint file
147: .set IO_WRC,128 # don't do buffering
148: .set IO_PIP,256 # this is one end of a pipe
149: .set IO_DED,512 # other end of pipe died
150: .set IO_ILL,1024 # i/o illegal according to sysfc
151: #
152: #-----------
153: #
154: # sysej - end of job
155: #
156: .globl sysej
157: sysej:
158: movl r10,_rzfcb # copy head of fcb chain
159: beqlu 1f # if empty then nothing to close
160: 0: movl chfcb(r10),r1 # -> fcb
161: pushl fciob(r1) # -> ioblk
162: calls $1,_osclose # call to do close
163: movl chnxt(r10),r10 # -> next on chain
164: bnequ 0b # and loop back for more
165: 1: pushl r7 # return &code
166: calls $1,__exit
167: rsb
168: #
169: # sysfc
170: #
171: .globl sysfc
172: sysfc:
173: movl (sp)+,(sp) # remove stacked scblk
174: pushr $mr235
175: tstl sclen(r10) # if null filearg1 then
176: jeqlu erxit1 # error
177: #
178: # get length of filename and scan off options.
179: #
180: movl r9,-(sp) # -> filename scblk
181: calls $1,_lenfnm # call to get filename length
182: movl r0,lenfname # save length for later use
183: jlss erxit1 # length must not be negative
184: movl r9,-(sp) # -> filename scblk
185: movl $tioblk,-(sp) # -> temporary ioblk
186: movl r7,-(sp) # input/output association flag
187: calls $3,_sioarg # call to scan i/o args
188: tstl r0 # if error in args then
189: jlss erxit1 # take error return
190: #
191: # check for consistency of calls. cannot have both input
192: # and output to same channel. if this happens, though,
193: # set flag and let sysio take proper error exit.
194: #
195: tstl r6 # if no previous fcblk then
196: beqlu 0f # skip
197: movl fciob(r6),r0 # -> ioblk
198: movl ioflg(r0),r0 # get previous flags
199: mcoml $IO_INP+IO_OUP,r1 # get mask for bicl
200: bicl2 r1,r0 # remove all bits but INP&OUP
201: bitl tioblk+ioflg,r0 # if bits are not same then
202: bnequ 0f
203: bisl2 $IO_ILL,tioblk+ioflg # then set error flag
204: 0:
205: #
206: # handle null filenames here - must either have a previous
207: # fcblk or specify -f arg.
208: #
209: tstl lenfname # if non-null filename then
210: bgtr fcfnam # go handle below
211: bitl $IO_OPN,tioblk+ioflg
212: bnequ fcfarf # if -f specified then merge w/non-null
213: tstl r6 # if no previous fcblk then
214: jeqlu erxit1 # error
215: clrl r6 # assume that no new fcblk needed
216: clrl ioblkptr # no ioblk ptr to stuff
217: tstl tioblk # if however i/o args indicate one
218: jeqlu fcxit
219: movl fciob(r6),ioblkptr
220: movl $fcsize,r6 # allocate one
221: jbr fcxit
222: #
223: # handle real filenames and null filenames with -f arg here.
224: # note that they're mutually exclusive.
225: #
226: fcfnam: bitl $IO_OPN,tioblk+ioflg
227: jnequ erxit1 # can't have -f arg too
228: fcfarf: tstl r6 # if previous fcblk passed then
229: jnequ erxit1 # error
230: clrl ioblkptr
231: addl3 $bfsize+3,tioblk+iopid,r6
232: bicl2 $3,r6
233: movl r6,bfblksiz
234: addl2 $fcsize+iosize,r6
235: movl $1,tioblk # set newfcb flag
236: #
237: fcxit: clrl r10 # no private fcblk
238: clrl r8 # xrblk please
239: popr $mr235
240: addl2 $4,(sp)
241: rsb
242: #
243: # sysil - get input record length
244: #
245: .globl sysil
246: sysil:
247: movl fcrsz(r6),r6
248: bgtr 0f
249: mnegl r6,r6
250: 0:
251: rsb
252: #
253: # sysin - read input record
254: #
255: .globl sysin
256: sysin:
257: pushr $mr235
258: pushl fciob(r6) # -> ioblk
259: calls $1,_osopen # call to open file
260: tstl r0 # if open unsuccessful then
261: jnequ erxit3 # take error exit
262: pushl r9 # -> scblk
263: pushl fciob(r6) # -> ioblk
264: pushl fcrsz(r6) # push record length
265: bgtr 0f
266: mnegl (sp),(sp) # if negative then make it positive
267: 0: pushl fcrsz(r6) # i/o mode - raw or line
268: calls $4,_osread # call to do read
269: cmpl r0,$-1 # check for eof or input error
270: jeql erxit1 # take eof exit
271: jlss erxit2 # take error exit
272: movl r0,sclen(r9) # set record length
273: popr $mr235
274: addl2 $12,(sp)
275: rsb
276: #
277: # sysio
278: #
279: .globl sysio
280: sysio:
281: pushr $mr235
282: bitl $IO_ILL,tioblk+ioflg
283: jnequ erxit2 # if illegal then take error exit
284: movl r6,fcblkptr # copy fcblk pointer for exit
285: #
286: # fill in fcblk.
287: #
288: tstl tioblk+iotyp # if no new fcb to build then
289: jeqlu iodon # done
290: movl $fcsize,fclen(r6)
291: movl tioblk+iolen,fcrsz(r6)
292: movl ioblkptr,fciob(r6)
293: jnequ iodon
294: movab fcsize(r6),fciob(r6)
295: #
296: # fill in ioblk.
297: #
298: movab fcsize(r6),r6 # -> ioblk
299: movl $b$xrt,(r6)
300: movl $iosize,iolen(r6)
301: movl r9,iofnm(r6)
302: clrl iopid(r6)
303: movab iosize(r6),iobuf(r6)
304: movl tioblk+iofdn,iofdn(r6)
305: movl tioblk+ioflg,ioflg(r6)
306: #
307: # if -f0 or -f1 specified then
308: #
309: # for -f0 ensure that buffer is same as osint's
310: #
311: # for -f1 no buffering should be done
312: #
313: bitl $IO_SYS,ioflg(r6)
314: beqlu 9f
315: cmpl $1,iofdn(r6)
316: blssu 9f
317: beqlu 1f
318: movl $inpbf,iobuf(r6)
319: jbr 9f
320: 1: clrl iobuf(r6)
321: bisl2 $IO_WRC,ioflg(r6)
322: 9:
323: #
324: # fill in bfblk
325: #
326: movab iosize(r6),r6 # -> bfblk
327: movl $b$xnt,(r6)
328: movl bfblksiz,bflen(r6)
329: movl tioblk+iopid,bfsiz(r6)
330: clrl bfrem(r6)
331: clrl bfoff(r6)
332: #
333: iodon: movl fcblkptr,r10
334: clrl r8
335: popr $mr235
336: addl2 $8,(sp)
337: rsb
338: #
339: # syspi - print on interactive channel (terminal)
340: #
341: .globl syspi
342: syspi:
343: movl $ttyiob,r11
344: jbr piprt
345: #
346: # syspr - print on standard output
347: #
348: .globl syspr
349: syspr:
350: movl $oupiob,r11
351: #
352: # handle both syspi and syspr here.
353: #
354: piprt:
355: pushr $mr235
356: bisl2 $IO_WRC,ioflg(r11) # briefly set no buffering
357: pushl r9 # -> scblk
358: pushl r11 # -> ioblk
359: pushl r6 # number characters
360: pushl $1 # line mode
361: calls $4,_oswrite # call to do write
362: bicl2 $IO_WRC,ioflg(r11) # back to buffering
363: tstl r0 # if output error then
364: jneq erxit1 # indicate error return
365: popr $mr235
366: addl2 $4,(sp)
367: rsb
368: #
369: # sysrd - read from standard input
370: #
371: .globl sysrd
372: sysrd:
373: pushr $mr235
374: movl $inpiob,ioblkptr
375: #
376: # handle both sysrd and sysri here.
377: #
378: rdmrg:
379: pushl r9 # -> scblk
380: pushl ioblkptr # -> ioblk
381: pushl r8 # read length
382: pushl r8 # line mode
383: calls $4,_osread # call to do read
384: cmpl r0,$-1 # check for eof or input error
385: jeql rdeof # take eof exit
386: jlss erxit1 # take error exit
387: movl r0,sclen(r9) # set read length
388: #
389: # check for 1st record of standard input coming from a file specified
390: # on the command line. if all of these conditions are true, allow
391: # the program to access any arguments following the file name.
392: #
393: tstl rdrec1 # if already ready record 1 then
394: bnequ rdskp # skip
395: cmpl $inpiob,ioblkptr
396: bnequ rdskp # if sysri entry then skip
397: incl rdrec1 # indicate read 1st record from std input
398: tstl _inpptr # if not file from command line then
399: beqlu rdskp # skip
400: cmpb $'#,scstr(r9) # if 1st char not # then
401: bnequ rdskp # skip
402: cmpb $'!,scstr+1(r9) # if 2nd char not ! then
403: bnequ rdskp # skip
404: subl3 _inpcnt,_gblargc,_cmdcnt
405: incl _cmdcnt # compute # args after filename
406: movl $1,_inpcnt # reset input count
407: brb rdmrg # ignore 1st record and try again
408: rdskp:
409: popr $mr235
410: addl2 $4,(sp)
411: rsb
412: #
413: # come here to handle eof for both sysrd and sysri. if eof
414: # is for sysrd, standard input, switch to next input file
415: # if one exists.
416: #
417: rdeof: movl ioblkptr,r4 # -> ioblk
418: tstl iofdn(r4) # if not file descriptor 0 then
419: jnequ erxit1 # real eof
420: pushl _inpptr # push -> array of pointers
421: pushl _inpcnt # push size of areray
422: calls $2,_swcinp # call to switch input files
423: tstl r0 # if more to read then
424: jeqlu rdmrg # read it
425: jmp erxit1 # else signal eof
426: #
427: # sysri - read from interactive channel (terminal)
428: #
429: .globl sysri
430: sysri:
431: pushr $mr235
432: movl $ttyiob,ioblkptr
433: jbr rdmrg
434: #
435: # sysst - set file pointer
436: #
437: .globl sysst
438: sysst:
439: pushr $mr235
440: pushl fciob(r6) # -> ioblk
441: calls $1,_osopen # call to do open
442: tstl r0 # if file open error then
443: jnequ erxit3 # return error
444: #
445: movl fciob(r6),r1 # -> ioblk
446: bitl $IO_PIP,ioflg(r1)
447: jnequ erxit4 # if pipe then set not allowed
448: cmpl iofdn(r1),$2 # if fd < 2 then
449: jlssu erxit4 # set not allowed
450: #
451: cmpl $b$icl,(r7) # if already integer then
452: bnequ 0f
453: movl icval(r7),temp1 # grab value
454: brb 1f
455: 0: cmpl $b$scl,(r7) # else if not a string then
456: jnequ erxit1 # error
457: clrl temp3 # clear scnint character count
458: pushl $temp3 # -> temp3
459: pushl sclen(r7) # string length
460: pushab scstr(r7) # -> string
461: calls $3,_scnint # call to scan integer
462: movl r0,temp1 # and save
463: 1:
464: #
465: cmpl $b$icl,(r8) # if already integer then
466: bnequ 0f
467: movl icval(r8),temp2 # grab value
468: brb 1f
469: 0: cmpl $b$scl,(r8) # else if not a string then
470: jnequ erxit1 # error
471: clrl temp3 # clear scnint character count
472: pushl $temp3 # -> temp3
473: pushl sclen(r8) # string length
474: pushab scstr(r8) # -> string
475: calls $3,_scnint # call to scan integer
476: movl r0,temp2 # and save
477: 1:
478: #
479: pushl temp2 # whence
480: pushl temp1 # offset
481: pushl fciob(r6) # -> ioblk
482: calls $3,_doset # call to do set
483: popr $mr235
484: addl2 $20,(sp)
485: rsb
486: #
487: # systm - get execution time so far
488: #
489: .globl systm
490: systm:
491: pushr $mr2+mr3
492: movl $tscblk+8,-(sp) # -> times buffer
493: calls $1,_times # call to do times
494: movl tscblk+8,r5 # get user time in 60ths
495: mull2 $100,r5 # mulitply by 100 to get 6000ths
496: divl2 $6,r5 # divide by 6 to get 1000ths
497: popr $mr2+mr3
498: rsb
499: #
500: # sysxi - exit from executing program
501: #
502: .globl sysxi
503: sysxi:
504: tstl r10 # if 0 instead of scblk then
505: jeqlu xilmod # try to write load module
506: pushr $mr235
507: cmpl $b$scl,(r10) # if not scblk then
508: jnequ erxit1 # error
509: pushl r10 # push scblk pointer
510: calls $1,_doexec # go do exit
511: jmp erxit2 # should never return
512: #
513: # write load module
514: #
515: xilmod: tstl r5 # if r5 <= 0 then
516: bgtr 0f
517: pushr $mr235 # save regs for error exits
518: jbr erxit1 # and take error exit
519: 0: pushr $cmpreg # else save all compiler regs
520: #
521: # need to save stack contents, so that when load module is
522: # invoked, stack can be recreated.
523: #
524: subl3 sp,_initsp,r0 # compute depth of stack
525: cmpl r0,tscblk # if stack won't fit in tscblk then
526: jgtru xi2big # big trouble
527: movl sp,r0 # -> into real stack
528: movab tscblk+scstr,r1 # -> save stack area
529: 1: movl (r0)+,(r1)+ # copy word of stack ...
530: cmpl r0,_initsp # until hit top word
531: blssu 1b
532: movl r1,lmodstk # set top of saved stack
533: #
534: # before creating the load module, we must relativize the
535: # compiler cells that point into the stack. We do this by
536: # temporarily negating _initsp, calling streloc, and then
537: # restoring _initsp. After the load module has been written,
538: # another call to streloc will restore the stack pointers.
539: #
540: mnegl _initsp,_initsp # negate _initsp so streloc will subtract
541: jsb streloc # relativize the compiler cells
542: mnegl _initsp,_initsp # restore _initsp to its previous value
543: #
544: # create a.out header in hststr scblk.
545: #
546: addl3 $1023,dnamp,r1 # round current memory in use
547: bicl3 $0x3ff,r1,-(sp) # to a multiple of the page size
548: movab hststr+scstr,r0 # -> a.out header block
549: pushl r0 # which will be the other argument
550: movl $0413,(r0)+ # set magic number
551: bicl3 $0x3ff,$_etext,r1 # get text size, rounded down
552: movl r1,(r0)+ # and place it in a.out header
553: subl3 r1,4(sp),(r0)+ # data size = total - text size
554: clrl (r0)+ # we will use no bss
555: clrl (r0)+
556: clrl (r0)+ # set starting address
557: clrl (r0)+
558: clrl (r0)+
559: #
560: # call a workhorse c routine to actually write a.out file.
561: # the amount of memory to write has already been pushed.
562: #
563: calls $2,_wrtaout # call to write a.out
564: #
565: # restore compiler cells to their previous values
566: #
567: jsb streloc # unrelativize stack pointers
568: #
569: tstl r0 # if error creating a.out then
570: blss xi2big # return error
571: #
572: # pop registers and set up call to sysej
573: #
574: popr $cmpreg # restore all registers
575: movl r7,r10 # -> chain of fcbs
576: clrl r7 # set &CODE = 0
577: jsb sysej # call to end run
578: #
579: # if stack too big
580: #
581: xi2big: popr $cmpreg # restore all regs
582: pushr $mr235 # push correct regs
583: jbr erxit2 # take error exit
584: #
585: # error/ppm exits - pick up n-th word following jsb and return
586: # to address contained in that word.
587: #
588: erxit1:
589: popr $mr235
590: movl (sp)+,r11
591: jmp *(r11)+
592: #
593: erxit2:
594: popr $mr235
595: addl3 $4,(sp)+,r11
596: jmp *(r11)+
597: #
598: erxit3:
599: popr $mr235
600: addl3 $8,(sp)+,r11
601: jmp *(r11)+
602: #
603: erxit4:
604: popr $mr235
605: addl3 $12,(sp)+,r11
606: jmp *(r11)+
607: #
608: erxit5:
609: popr $mr235
610: addl3 $16,(sp)+,r11
611: jmp *(r11)+
612: #
613: erxit6:
614: popr $mr235
615: addl3 $20,(sp)+,r11
616: jmp *(r11)+
617: #
618: # streloc - relocate stack pointers. this routine adds
619: # _initsp to every cell whose address appears in strellst.
620: #
621: streloc:
622: pushr $mr0+mr1
623: moval _strellst,r1 # start of list of thing to relocate
624: jbr strel1 # jump into the loop
625: strel0: addl2 _initsp,(r0) # relocate a pointer
626: strel1: movl (r1)+,r0 # fetch a pointer to a cell
627: jneq strel0 # if zero, we're done
628: popr $mr0+mr1
629: rsb
630: #
631: # interface data area
632: # -------------------
633: #
634: .data 1
635: #
636: # #! data areas
637: #
638: .globl _cmdcnt
639: _cmdcnt: .long 0 # number of command args
640: rdrec1: .long 0 # read record 1 from std in flag
641: #
642: # standard ioblks
643: #
644: inpiob: .space iobuf
645: .long inpbf # -> input bfblk
646: .long 0 # file descriptor
647: .long IO_INP|IO_OPN|IO_SYS
648: #
649: inpbf: .space bfsiz
650: .long 1024 # buffer size
651: .long 0 # remaining chars to read
652: .long 0 # offset to next character to read
653: .space 1024 # buffer
654: #
655: #
656: oupiob: .space iobuf
657: .long 0 # no buffer
658: .long 1 # file descriptor number
659: .long IO_OUP|IO_OPN|IO_SYS
660: #
661: #
662: ttyiob: .space iobuf
663: .long ttybf # -> tty buffer input
664: .long 2 # file descriptor number
665: .long IO_INP|IO_OUP|IO_OPN|IO_SYS
666: #
667: ttybf: .space bfsiz
668: .long 258 # buffer size
669: .long 0 # remaining chars to read
670: .long 0 # offset to next char to read
671: .space 258 # buffer
672: .align 2
673: #
674: .globl _rzfcb
675: _rzfcb: .long 0
676: #
677: fildes: .long 0
678: pr_len: .long 0
679: rd_len: .long 0
680: lenfname: .long 0
681: ioblkptr: .long 0
682: bfblkptr: .long 0
683: bfblksiz: .long 0
684: fcblkptr: .long 0
685: tioblk: .space iosize
686: #
687: # flag that indicates that this is a load module. also, serves
688: # the dual purpose of indicating size of saved stack.
689: #
690: lmodstk: .long 0
691: #
692: temp1: .long 0
693: temp2: .long 0
694: temp3: .long 0
695: #
696: nulstr: .long 0,0
697: #
698: tscblk: .long 512,0
699: .space 512
700: #
701: hststr: .long 128,0
702: .space 128
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.