![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to OLDosint.s CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [Research Unix] / researchv10no / cmd / spitbol|
Return to OLDosint.s CVS log | Up to [Research Unix] / researchv10no / cmd / spitbol |
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: # this operating system interface, commonly referred to as osint,
13: # provides the Macro SPITBOL compiler with a means to do all i/o
14: # and other OS dependent activities.
15: #
16: # osint is composed of one medium sized assembly module, with
17: # multiple entry points, and a collection of c functions. the
18: # entire interface is not in c due to the compiler's use of
19: # registers to pass parameters and other technicalities. all
20: # entries, except for sbchk, have five letter names starting
21: # with sys.
22: #
23: # when spitbol first starts execution, control passes to function
24: # main, just like in a normal c program. main processes any options
25: # and does other initialization chores. after completing
26: # initialization, main jumps to label sec04 to start
27: # the compiler itself. from that point, the compiler makes calls
28: # to sysxx routines to get service.
29: #
30: # the c functions are called from this module to do most of the
31: # hard and/or unix dependent work. an effort has been made to
32: # do all the system calls from c functions. this goal has not
33: # been entirely achieved.
34: #
35: #
36: # register masks
37: #
38: .set mr0,1
39: .set mr1,2
40: .set mr2,4
41: .set mr3,8
42: .set mr4,16
43: .set mr5,32
44: .set mr6,64
45: .set mr7,128
46: .set mr8,256
47: .set mr9,512
48: .set mr10,1024
49: .set mr11,2048
50: #
51: # c functions assume that r0 -> r5 are scratch. however, spitbol
52: # uses r2, r3, and r5. so, need to save these registers across
53: # function calls.
54: #
55: .set mr235,mr2+mr3+mr5
56: #
57: # mask for all registers used by compiler. necessary for dealing
58: # with load modules.
59: #
60: .set cmpreg,mr2+mr3+mr5+mr6+mr7+mr8+mr9+mr10
61: #
62: # miscellaneous equates
63: #
64: .set ch$lk,107 # upper case letter k
65: .set ch$mn,45 # dash (minus sign)
66: .set k,1024
67: .set kwords,k*4
68: #
69: # internal spitbol blocks
70: # -----------------------
71: #
72: # these equates describe compiler control blocks used by osint.
73: #
74: # chain of file control blocks
75: #
76: .set chtyp,0 # type word
77: .set chlen,4 # block length
78: .set chnxt,8 # -> next chblk
79: .set chfcb,12 # -> fcb
80: .set chsize,16 # size of chblk
81: #
82: # icblk - integer block
83: #
84: .set ictyp,0 # type word
85: .set icval,4 # integer value
86: #
87: # scblk - string block
88: #
89: .set sctyp,0 # type word
90: .set sclen,4 # string length
91: .set scstr,8 # start of string
92: #
93: # interface control blocks
94: # ------------------------
95: #
96: # these control blocks are built by the interface to handle i/o.
97: # for files other than standard input, standard output, and the
98: # terminal, these control blocks reside in the compiler's
99: # dynamic area. this requires appropriate setting of the type
100: # words to allow proper garbage collection.
101: #
102: # blocks with type b$xnt contain non-relocatable addresses - that
103: # is, no word may contain a pointer to another block in the
104: # dynamic area.
105: #
106: # blocks with type b$xrt contain relocatable addresses - that is
107: # words may contain a pointer to another block in the dynamic area.
108: #
109: # the basic structure is:
110: #
111: # for each input or output associated file there is:
112: #
113: # 1 ioblk containing all global information about
114: # the file: filename, buffer block pointer,
115: # file descriptor number, flags
116: #
117: # 1 bfblk containing the file buffer
118: #
119: # 1 or more fcblks containing the access mode (line or
120: # raw), the record length, and a pointer to
121: # the ioblk
122: #
123: # the first INPUT() or OUTPUT() call for a file creates one block
124: # of each type. subsequent calls to INPUT() or OUTPUT() for a
125: # previously associated file, may cause the creation of a new fcblk.
126: # allowing multiple fcblks provides the program with different
127: # ways of accessing the same file. for example, one type of access
128: # can be a character at a time and another entire records.
129: #
130: # the compiler keeps track of all active fcblks, and at times
131: # like end-of-job provides the inteface with a chain of all fcblks.
132: #
133: #
134: # bfblk - i/o buffer control block
135: #
136: .set bftyp,0 # type word - b$xnt
137: .set bflen,4 # block length
138: .set bfsiz,8 # buffer size in bytes
139: .set bfrem,12 # bytes remaining
140: .set bfoff,16 # offset to next remaining byte
141: .set bfsize,20 # end of fixed portion
142: #
143: # fcblk - file control block
144: #
145: .set fctyp,0 # type word - b$xrt
146: .set fclen,4 # block length
147: .set fcrsz,8 # record size ( >0 line mode / <0 raw mode)
148: .set fciob,12 # -> ioblk
149: .set fcsize,16 # size of fcblk
150: #
151: # ioblk - i/o control block
152: #
153: .set iotyp,0 # type word - b$xrt
154: .set iolen,4 # block length
155: .set iofnm,8 # -> filename scblk
156: .set iopid,12 # pid (if one end of pipe)
157: .set iobuf,16 # -> bfblk
158: .set iofdn,20 # file descriptor number
159: .set ioflg,24 # flags
160: .set iosize,28 # size of ioelt
161: #
162: # defines that match "spitio.h" for flags in ioflg
163: #
164: .set IO_INP,1 # input associated
165: .set IO_OUP,2 # output associated
166: .set IO_APP,4 # output open for append
167: .set IO_OPN,8 # file is open
168: .set IO_EOF,16 # eof on input file
169: .set IO_ERR,32 # i/o error
170: .set IO_SYS,64 # this is an osint file
171: .set IO_WRC,128 # don't do buffering
172: .set IO_PIP,256 # this is one end of a pipe
173: .set IO_DED,512 # other end of pipe died
174: .set IO_ILL,1024 # i/o illegal according to sysfc
175: #
176: # osint( argc,argv,environ ) is called just like the main
177: # function of a c program.
178: #
179: .globl _main
180: _main: .word 0
181: #
182: # normal start - process all command arguments.
183: #
184: movl 4(ap),r4 # get number of options
185: movl r4,argc # and save
186: movl 8(ap),r6 # -> option pointers
187: movl r6,argv # and save
188: #
189: # if this is a restart from an load module, go handle.
190: #
191: tstl lmodstk # if load module stack != 0 then
192: jnequ rstart # go handle
193: #
194: tstl (r6)+ # program name not interesting
195: brb gtcont # process other args
196: gtarg: movl (r6)+,r0 # -> option text
197: cmpb $ch$mn,(r0) # if no leading - then
198: bnequ gtinp # treat as input filename
199: incl r0 # bump over -
200: 1: movb (r0)+,curopt+1 # set option character in table
201: movl $opttbl,r1 # -> option table
202: 2: cmpl curopt,(r1) # if we have found it then
203: beqlu 3f # process it
204: addl2 $optsiz,r1 # -> next table entry
205: brb 2b # loop until found
206: 3: movl optrtn(r1),r11 # -> option routine
207: jsb (r11) # call option routine
208: 4: tstb (r0) # if char is binary zeros then
209: beqlu gtcont # done with this arg
210: cmpb $040,(r0) # if next char is blank then
211: bnequ 5f
212: incl r0 # ignore it
213: brb 4b # and check next char
214: 5: cmpb $ch$mn,(r0) # if next char is not - then
215: bnequ 1b # treat as option character
216: incl r0 # else skip over -
217: brb 1b # and treat next char as option
218: gtinp: jsb optinp # process input filename(s)
219: gtcont: sobgtr r4,gtarg # loop thru all options
220: #
221: # switch to proper input file
222: #
223: pushl inpptr
224: pushl inpcnt
225: calls $2,_swcinp
226: #
227: # call to do initial switch of output files.
228: #
229: pushl oupptr
230: calls $1,_swcoup
231: #
232: # see if standard output is tty or not.
233: #
234: pushl $1 # file descriptor 1
235: calls $1,_testty # call to check i/o chcaracteristics
236: tstl r0 # if r0 not 0 then
237: bnequ 0f # not a tty
238: clrl lnsppg # reset # lines per page
239: bisl2 $prtich,sptflg # else tell compiler
240: 0:
241: #
242: # set signals for execution
243: #
244: .globl _setsigs
245: calls $0,_setsigs # trap overflow signals
246: #
247: # allocate initial dynamic memory
248: #
249: mull3 meminc,$4,meminb# convert meminc to bytes
250: pushl meminb # memory request increment
251: calls $1,_sbrk # call to system call
252: movl r0,basmem # save base of memory
253: addl3 r0,meminb,topmem# computer top of memory
254: mull3 datwds,$4,r1 # convert max data words to bytes
255: addl3 r0,r1,maxmem # computer top of memory
256: 0: clrl (r0)+ # clear initial allocation
257: cmpl r0,topmem # loop until all cleared
258: blssu 0b
259: #
260: # set up lowest legal sp value, so that stack overflow can be detected,
261: #
262: mull3 $4,stksiz,r0 # convert words to bytes
263: subl3 r0,sp,lowsp # and compute lowest sp
264: movl sp,initsp # save initial sp
265: #
266: # clear registers, set dynamic area pointers, and jump off
267: # to compiler
268: #
269: clrl r2
270: clrl r3
271: clrl r4
272: clrl r5
273: clrl r6
274: clrl r7
275: clrl r8
276: movl basmem,r9
277: subl3 $4,topmem,r10
278: jmp sec04
279: #
280: # here to restart program after EXIT() call. this means we are now
281: # executing from an a.out file created by the interface.
282: #
283: rstart:
284: #
285: # before restoring stack, set up values for proper checking of
286: # stack overflow. (initial sp here will most probably differ
287: # from initial sp when compile was done.)
288: #
289: mull3 $4,stksiz,r0 # convert words to bytes
290: subl3 r0,sp,lowsp # and compute lowest sp
291: movl sp,initsp # save initial sp
292: #
293: # restore stack from tscblk.
294: #
295: movl lmodstk,r0 # -> bottom word of stack
296: movab tscblk+scstr,r1 # -> top word of stack
297: 0: movl -(r0),-(sp) # relocate word of stack
298: cmpl r0,r1 # if not at end of relocation then
299: bgtru 0b # loop back
300: #
301: # if restarting, we can always access the command line arguments
302: #
303: movl $1,cmdcnt
304: #
305: # the system break will not be what it should, so reset it
306: #
307: pushl topmem
308: calls $1,_brk
309: #
310: # reset signals to what they should be.
311: #
312: calls $0,_setsigs
313: #
314: # forget about files open during compilation -
315: #
316: clrl inpptr # no input files
317: clrl inpcnt # so count is 0 too
318: clrl oupptr # no output file
319: clrl errfdn # no error file
320: #
321: # reset standard input buffer
322: #
323: clrl inpbf+bfrem # no remaining chars
324: clrl inpbf+bfoff # offset to next char
325: #
326: # restore compiler's registers and off we go.
327: #
328: popr $cmpreg # restore compiler's registers
329: addl2 $8,(sp)
330: rsb
331: #
332: # sbchk is called by the compiler to check for stack overflow.
333: #
334: .globl sbchk
335: sbchk: cmpl sp,lowsp # if sp is ok then
336: blssu 0f
337: rsb # return
338: 0: tstl (sp)+ # else pop stack
339: jmp sec05 # and go to stack overflow section
340: #
341: # unsupported entries that simply return.
342: #
343: .globl sysdc
344: sysdc:
345: .globl sysdm
346: sysdm:
347: .globl systt
348: systt:
349: .globl sysul
350: sysul:
351: rsb
352: #
353: # unsupported that take error returns
354: #
355: .globl sysex
356: sysex:
357: .globl sysld
358: sysld:
359: pushr $mr235 # save ye registers
360: jbr erxit1
361: #
362: # sysax - after execution call
363: #
364: # sysax is called immediately after execution, so that the interface
365: # can do any cleanup. here, the standard output file is switched, if
366: # necessary back to the listing file.
367: #
368: .globl sysax
369: sysax:
370: pushr $mr235
371: pushl oupptr
372: calls $1,_swcoup
373: popr $mr235
374: rsb
375: #
376: # sysbx - before execution call
377: #
378: # sysbx is called after compilation and before execution begins.
379: # sysbx allows the inteface to do any cleanup. here, the standard
380: # listing file is switched to the standard output file.
381: #
382: .globl sysbx
383: sysbx:
384: pushr $mr235
385: pushl oupptr
386: calls $1,_swcoup
387: popr $mr235
388: rsb
389: #
390: # sysdt - get current date
391: #
392: # return both date and time
393: #
394: # jsb sysdt # call to get date
395: # (r10) # -> scblk
396: #
397: .globl sysdt
398: sysdt:
399: pushr $mr235
400: movl $tscblk,r10
401: movl $17,sclen(r10) # dd/mm/yy hh.mm.ss
402: pushl $tscblk+scstr
403: calls $1,_getdate
404: popr $mr235
405: rsb
406: #
407: # sysef - eject file
408: #
409: .globl sysef
410: sysef:
411: pushr $mr235
412: pushl fciob(r6) # -> ioblk
413: calls $1,_osopen # call to do open
414: tstl r0 # if open error then
415: jnequ erxit1 # take error exit
416: pushl $ffscb # -> ff scblk
417: pushl fciob(r6) # -> ioblk
418: pushl ffscb+sclen # record length
419: mnegl fcrsz(r6),-(sp) # i/o mode - raw or line
420: calls $4,_oswrite # call to do write
421: tstl r0 # if output error then
422: jneq erxit3 # signal failure
423: popr $mr235
424: addl2 $12,(sp)
425: rsb
426: #
427: # sysej - end of job
428: #
429: .globl sysej
430: sysej:
431: movl r10,_rzfcb # copy head of fcb chain
432: beqlu 1f # if empty then nothing to close
433: 0: movl chfcb(r10),r1 # -> fcb
434: pushl fciob(r1) # -> ioblk
435: calls $1,_osclose # call to do close
436: movl chnxt(r10),r10 # -> next on chain
437: bnequ 0b # and loop back for more
438: 1: pushl r7 # return &code
439: calls $1,__exit
440: #
441: # sysem - get error message text
442: #
443: .globl sysem
444: sysem:
445: pushr $mr235
446: movl $tscblk,r9 # -> temp scblk
447: clrl sclen(r9) # default error text is null string
448: tstl errfdn # if error fd exists then
449: bnequ 0f # skip open
450: calls $0,_openerr # else open error text file
451: movl r0,errfdn # and save fd
452: 0: tstl errfdn # if no error text file then
453: blss emxit # return null string
454: decl r6 # errors start at 1
455: blss emxit # but don't have error 0
456: mull2 $49,r6 # compute byte offset of error text
457: pushl $0 # whence
458: pushl r6 # offset
459: pushl errfdn # file descriptor number
460: calls $3,_lseek # call to do seek
461: tstl r0 # if lseek fails then
462: blss emxit # return null string
463: pushl $48 # error text length w/out nl
464: pushl $tscblk+8 # buffer address
465: pushl errfdn # file descriptor number
466: calls $3,_read # call to do read
467: tstl r0 # if read failed then
468: blss emxit # return null string
469: 1: cmpb $' ,tscblk+7(r0)# if last character is
470: bneq 2f # nonblank, return length
471: sobgeq r0,1b # otherwise discard the blank, try again
472: 2: movl r0,sclen(r9) # set actual length
473: emxit:
474: popr $mr235
475: rsb # return
476: #
477: # sysen - endfile
478: #
479: .globl sysen
480: sysen:
481: pushr $mr235
482: pushl fciob(r6) # -> ioblk
483: calls $1,_osopen # call to do open
484: tstl r0 # if open error then
485: jnequ erxit1 # take error exit
486: movl r$fcb,_rzfcb # copy fcb chain head
487: pushl fciob(r6) # -> ioblk
488: calls $1,_osclose # call to do close
489: popr $mr235
490: addl2 $12,(sp)
491: rsb
492: #
493: # sysej - eject standard output
494: #
495: .globl sysep
496: sysep:
497: pushr $mr235
498: pushl $1 # 1 character
499: pushl $ffstr # -> ff
500: pushl $1 # fd 1
501: calls $3,_write # call to do write
502: popr $mr235
503: rsb
504: #
505: # sysfc
506: #
507: .globl sysfc
508: sysfc:
509: movl (sp)+,(sp) # remove stacked scblk
510: pushr $mr235
511: tstl sclen(r10) # if null filearg1 then
512: jeqlu erxit1 # error
513: #
514: # get length of filename and scan off options.
515: #
516: movl r9,-(sp) # -> filename scblk
517: calls $1,_lenfnm # call to get filename length
518: movl r0,lenfname # save length for later use
519: jlss erxit1 # length must not be negative
520: movl r9,-(sp) # -> filename scblk
521: movl $tioblk,-(sp) # -> temporary ioblk
522: movl r7,-(sp) # input/output association flag
523: calls $3,_sioarg # call to scan i/o args
524: tstl r0 # if error in args then
525: jlss erxit1 # take error return
526: #
527: # check for consistency of calls. cannot have both input
528: # and output to same channel. if this happens, though,
529: # set flag and let sysio take proper error exit.
530: #
531: tstl r6 # if no previous fcblk then
532: beqlu 0f # skip
533: movl fciob(r6),r0 # -> ioblk
534: movl ioflg(r0),r0 # get previous flags
535: mcoml $IO_INP+IO_OUP,r1 # get mask for bicl
536: bicl2 r1,r0 # remove all bits but INP&OUP
537: bitl tioblk+ioflg,r0 # if bits are not same then
538: bnequ 0f
539: bisl2 $IO_ILL,tioblk+ioflg # then set error flag
540: 0:
541: #
542: # handle null filenames here - must either have a previous
543: # fcblk or specify -f arg.
544: #
545: tstl lenfname # if non-null filename then
546: bgtr fcfnam # go handle below
547: bitl $IO_OPN,tioblk+ioflg
548: bnequ fcfarf # if -f specified then merge w/non-null
549: tstl r6 # if no previous fcblk then
550: jeqlu erxit1 # error
551: clrl r6 # assume that no new fcblk needed
552: clrl ioblkptr # no ioblk ptr to stuff
553: tstl tioblk # if however i/o args indicate one
554: jeqlu fcxit
555: movl fciob(r6),ioblkptr
556: movl $fcsize,r6 # allocate one
557: jbr fcxit
558: #
559: # handle real filenames and null filenames with -f arg here.
560: # note that they're mutually exclusive.
561: #
562: fcfnam: bitl $IO_OPN,tioblk+ioflg
563: jnequ erxit1 # can't have -f arg too
564: fcfarf: tstl r6 # if previous fcblk passed then
565: jnequ erxit1 # error
566: clrl ioblkptr
567: addl3 $bfsize+3,tioblk+iopid,r6
568: bicl2 $3,r6
569: movl r6,bfblksiz
570: addl2 $fcsize+iosize,r6
571: movl $1,tioblk # set newfcb flag
572: #
573: fcxit: clrl r10 # no private fcblk
574: clrl r8 # xrblk please
575: popr $mr235
576: addl2 $4,(sp)
577: rsb
578: #
579: # syshs
580: #
581: .globl syshs
582: syshs:
583: pushr $mr235
584: cmpl $b$icl,(r6) # if arg1 not integer then
585: jnequ 9f # return host string
586: tstl icval(r6) # if integer 0 then
587: beqlu 1f # return -u argument
588: cmpl $1,icval(r6) # if integer 1 then
589: beqlu 2f # do system call
590: cmpl $2,icval(r6) # if integer 2 then
591: jeqlu 3f # return command arg
592: cmpl $3,icval(r6) # if integer 3 then
593: jeqlu 4f # return number of 1st #! arg
594: cmpl $4,icval(r6) # if integer 4 then
595: jeqlu 5f # return value of environment variable
596: jbr erxit1 # else arg error
597: #
598: 1: tstl uarg # if uarg is 0 then
599: jeqlu erxit4 # return null string
600: pushl tscblk # push scblk string length
601: pushl $tscblk # -> temp scblk
602: clrl -(sp) # ending character is 0
603: pushl uarg # -> -u argument
604: calls $4,_cpys2sc # copy string to scblk
605: movab tscblk,r10 # -> temp scblk
606: jbr erxit3 # return
607: #
608: 2: cmpl $b$scl,(r10) # if 2nd arg not string then
609: jnequ erxit1 # return error
610: tstl sclen(r10) # if null string then
611: jeqlu erxit4 # return null string
612: pushl r10 # -> command string
613: calls $1,_dosys # call to do system call
614: jbr erxit4 # return null string
615: #
616: 3: cmpl $b$icl,(r10) # if 2nd arg not integer then
617: jnequ erxit1 # return error
618: movl tscblk,tscblk+sclen # set max length of scblk
619: pushab tscblk # push -> tscblk
620: pushl argv # push -> pointers
621: pushl argc # push number of args
622: pushl icval(r10) # arg requested
623: calls $4,_arg2scb # call to do real move
624: tstl r0 # if out of range then
625: jlss erxit6 # fail
626: jeqlu erxit4 # (if 0) return null string
627: movab tscblk,r10 # -> tscblk
628: jbr erxit3 # return
629: #
630: 4: tstl cmdcnt # if not invoked by #! then
631: jeqlu erxit6 # fail
632: movab temp1,r9 # -> temp icblk
633: movl $b$icl,(r9) # set integer block
634: movl cmdcnt,icval(r9)# set value
635: jbr erxit5 # return result
636: #
637: 5: cmpl $b$scl,(r10) # if 2nd arg not string then
638: jnequ erxit1 # return error
639: tstl sclen(r10) # if null string then
640: jeqlu erxit1 # return error
641: movl tscblk,tscblk+sclen # set max length of scblk
642: pushab tscblk # push -> tscblk
643: pushl r10 # -> environment variable requested
644: calls $2,_rdenv # fetch the environment variable
645: tstl r0 # if it couldn't be found
646: jlss erxit6 # fail
647: movab tscblk,r10 # else return tscblk
648: jbr erxit3
649: #
650: 9: pushl hststr # push length of host string
651: pushab hststr # push -> host string scblk
652: calls $2,_gethost # call to get host string
653: tstl hststr+sclen # if null host string then
654: jeqlu erxit4 # return null string
655: movl $hststr,r10 # -> host string
656: jbr erxit3 # return
657: #
658: # sysid - return system id
659: #
660: .globl sysid
661: sysid:
662: movl $id1,r9
663: movl $id2,r10
664: rsb
665: #
666: # sysil - get input record length
667: #
668: .globl sysil
669: sysil:
670: movl fcrsz(r6),r6
671: bgtr 0f
672: mnegl r6,r6
673: 0:
674: rsb
675: #
676: # sysin - read input record
677: #
678: .globl sysin
679: sysin:
680: pushr $mr235
681: pushl fciob(r6) # -> ioblk
682: calls $1,_osopen # call to open file
683: tstl r0 # if open unsuccessful then
684: jnequ erxit3 # take error exit
685: pushl r9 # -> scblk
686: pushl fciob(r6) # -> ioblk
687: pushl fcrsz(r6) # push record length
688: bgtr 0f
689: mnegl (sp),(sp) # if negative then make it positive
690: 0: pushl fcrsz(r6) # i/o mode - raw or line
691: calls $4,_osread # call to do read
692: cmpl r0,$-1 # check for eof or input error
693: jeql erxit1 # take eof exit
694: jlss erxit2 # take error exit
695: movl r0,sclen(r9) # set record length
696: popr $mr235
697: addl2 $12,(sp)
698: rsb
699: #
700: # sysio
701: #
702: .globl sysio
703: sysio:
704: pushr $mr235
705: bitl $IO_ILL,tioblk+ioflg
706: jnequ erxit2 # if illegal then take error exit
707: movl r6,fcblkptr # copy fcblk pointer for exit
708: #
709: # fill in fcblk.
710: #
711: tstl tioblk+iotyp # if no new fcb to build then
712: jeqlu iodon # done
713: movl $fcsize,fclen(r6)
714: movl tioblk+iolen,fcrsz(r6)
715: movl ioblkptr,fciob(r6)
716: jnequ iodon
717: movab fcsize(r6),fciob(r6)
718: #
719: # fill in ioblk.
720: #
721: movab fcsize(r6),r6 # -> ioblk
722: movl $b$xrt,(r6)
723: movl $iosize,iolen(r6)
724: movl r9,iofnm(r6)
725: clrl iopid(r6)
726: movab iosize(r6),iobuf(r6)
727: movl tioblk+iofdn,iofdn(r6)
728: movl tioblk+ioflg,ioflg(r6)
729: #
730: # if -f0 or -f1 specified then
731: #
732: # for -f0 ensure that buffer is same as osint's
733: #
734: # for -f1 no buffering should be done
735: #
736: bitl $IO_SYS,ioflg(r6)
737: beqlu 9f
738: cmpl $1,iofdn(r6)
739: blssu 9f
740: beqlu 1f
741: movl $inpbf,iobuf(r6)
742: jbr 9f
743: 1: clrl iobuf(r6)
744: bisl2 $IO_WRC,ioflg(r6)
745: 9:
746: #
747: # fill in bfblk
748: #
749: movab iosize(r6),r6 # -> bfblk
750: movl $b$xnt,(r6)
751: movl bfblksiz,bflen(r6)
752: movl tioblk+iopid,bfsiz(r6)
753: clrl bfrem(r6)
754: clrl bfoff(r6)
755: #
756: iodon: movl fcblkptr,r10
757: clrl r8
758: popr $mr235
759: addl2 $8,(sp)
760: rsb
761: #
762: # sysmm - get more memory
763: #
764: .globl sysmm
765: sysmm:
766: cmpl topmem,maxmem # if already at top of memory then
767: blssu 0f
768: clrl r9 # no more to be had
769: rsb
770: 0: # else {alloc some more}
771: pushr $mr235
772: pushl meminb # size in bytes of memory request
773: calls $1,_sbrk # call to get memory
774: popr $mr235
775: tstl r0 # if memory obtained then
776: blss 1f
777: addl2 meminb,topmem # adjust current top
778: movl meminc,r9 # set number of words in block
779: rsb # return
780: 1: clrl r9 # else nothing to get
781: rsb
782: #
783: # sysmx - get maximum size of created objects
784: #
785: .globl sysmx
786: sysmx:
787: mull3 $4,maxsiz,r6
788: rsb
789: #
790: # sysou - output record
791: #
792: .globl sysou
793: sysou:
794: pushr $mr235
795: pushl fciob(r6) # -> ioblk
796: calls $1,_osopen # call to do open
797: tstl r0 # if open error then
798: jnequ erxit1 # take error exit
799: pushl r9 # -> scblk
800: pushl fciob(r6) # -> ioblk
801: pushl sclen(r9) # record length
802: pushl fcrsz(r6) # i/o mode - raw or line
803: calls $4,_oswrite # call to do write
804: tstl r0 # if output error,
805: jneq erxit2 # take error exit
806: popr $mr235
807: addl2 $8,(sp)
808: rsb
809: #
810: # syspi - print on interactive channel (terminal)
811: #
812: .globl syspi
813: syspi:
814: movl $ttyiob,r11
815: jbr piprt
816: #
817: # syspp - return print parameters
818: #
819: .globl syspp
820: syspp:
821: movl pagwid,r6
822: movl lnsppg,r7
823: movl sptflg,r8
824: movl defcas,kvcas
825: rsb
826: #
827: # syspr - print on standard output
828: #
829: .globl syspr
830: syspr:
831: movl $oupiob,r11
832: #
833: # handle both syspi and syspr here.
834: #
835: piprt:
836: pushr $mr235
837: bisl2 $IO_WRC,ioflg(r11) # briefly set no buffering
838: pushl r9 # -> scblk
839: pushl r11 # -> ioblk
840: pushl r6 # number characters
841: pushl $1 # line mode
842: calls $4,_oswrite # call to do write
843: bicl2 $IO_WRC,ioflg(r11) # back to buffering
844: tstl r0 # if output error then
845: jneq erxit1 # indicate error return
846: popr $mr235
847: addl2 $4,(sp)
848: rsb
849: #
850: # sysrd - read from standard input
851: #
852: .globl sysrd
853: sysrd:
854: pushr $mr235
855: movl $inpiob,ioblkptr
856: #
857: # handle both sysrd and sysri here.
858: #
859: rdmrg:
860: pushl r9 # -> scblk
861: pushl ioblkptr # -> ioblk
862: pushl r8 # read length
863: pushl r8 # line mode
864: calls $4,_osread # call to do read
865: cmpl r0,$-1 # check for eof or input error
866: jeql rdeof # take eof exit
867: jlss erxit1 # take error exit
868: movl r0,sclen(r9) # set read length
869: #
870: # check for 1st record of standard input coming from a file specified
871: # on the command line. if all of these conditions are true, allow
872: # the program to access any arguments following the file name.
873: #
874: tstl rdrec1 # if already ready record 1 then
875: bnequ rdskp # skip
876: cmpl $inpiob,ioblkptr
877: bnequ rdskp # if sysri entry then skip
878: incl rdrec1 # indicate read 1st record from std input
879: tstl inpptr # if not file from command line then
880: beqlu rdskp # skip
881: cmpb $'#,scstr(r9) # if 1st char not # then
882: bnequ rdskp # skip
883: cmpb $'!,scstr+1(r9) # if 2nd char not ! then
884: bnequ rdskp # skip
885: subl3 inpcnt,argc,cmdcnt
886: incl cmdcnt # compute # args after filename
887: movl $1,inpcnt # reset input count
888: brb rdmrg # ignore 1st record and try again
889: rdskp:
890: popr $mr235
891: addl2 $4,(sp)
892: rsb
893: #
894: # come here to handle eof for both sysrd and sysri. if eof
895: # is for sysrd, standard input, switch to next input file
896: # if one exists.
897: #
898: rdeof: movl ioblkptr,r4 # -> ioblk
899: tstl iofdn(r4) # if not file descriptor 0 then
900: jnequ erxit1 # real eof
901: pushl inpptr # push -> array of pointers
902: pushl inpcnt # push size of areray
903: calls $2,_swcinp # call to switch input files
904: tstl r0 # if more to read then
905: jeqlu rdmrg # read it
906: jmp erxit1 # else signal eof
907: #
908: # sysri - read from interactive channel (terminal)
909: #
910: .globl sysri
911: sysri:
912: pushr $mr235
913: movl $ttyiob,ioblkptr
914: jbr rdmrg
915: #
916: # sysrw - rewind file
917: #
918: .globl sysrw
919: sysrw:
920: pushr $mr235
921: pushl fciob(r6) # -> ioblk
922: calls $1,_osopen # call to do open
923: tstl r0 # if open error then
924: jnequ erxit1 # take error exit
925: movl fciob(r6),r1 # -> ioblk
926: bitl $IO_PIP,ioflg(r1)
927: jnequ erxit2 # if pipe then rewind not allowed
928: cmpl iofdn(r1),$2 # if fd < 2 then
929: jlssu erxit2 # rewind not allowed
930: pushl $0 # whence
931: pushl $0 # offset
932: pushl fciob(r6) # -> ioblk
933: calls $3,_doset # call to do set
934: popr $mr235
935: addl2 $12,(sp)
936: rsb
937: #
938: # sysst - set file pointer
939: #
940: .globl sysst
941: sysst:
942: pushr $mr235
943: pushl fciob(r6) # -> ioblk
944: calls $1,_osopen # call to do open
945: tstl r0 # if file open error then
946: jnequ erxit3 # return error
947: #
948: movl fciob(r6),r1 # -> ioblk
949: bitl $IO_PIP,ioflg(r1)
950: jnequ erxit4 # if pipe then set not allowed
951: cmpl iofdn(r1),$2 # if fd < 2 then
952: jlssu erxit4 # set not allowed
953: #
954: cmpl $b$icl,(r7) # if already integer then
955: bnequ 0f
956: movl icval(r7),temp1 # grab value
957: brb 1f
958: 0: cmpl $b$scl,(r7) # else if not a string then
959: jnequ erxit1 # error
960: clrl temp3 # clear scnint character count
961: pushl $temp3 # -> temp3
962: pushl sclen(r7) # string length
963: pushab scstr(r7) # -> string
964: calls $3,_scnint # call to scan integer
965: movl r0,temp1 # and save
966: 1:
967: #
968: cmpl $b$icl,(r8) # if already integer then
969: bnequ 0f
970: movl icval(r8),temp2 # grab value
971: brb 1f
972: 0: cmpl $b$scl,(r8) # else if not a string then
973: jnequ erxit1 # error
974: clrl temp3 # clear scnint character count
975: pushl $temp3 # -> temp3
976: pushl sclen(r8) # string length
977: pushab scstr(r8) # -> string
978: calls $3,_scnint # call to scan integer
979: movl r0,temp2 # and save
980: 1:
981: #
982: pushl temp2 # whence
983: pushl temp1 # offset
984: pushl fciob(r6) # -> ioblk
985: calls $3,_doset # call to do set
986: popr $mr235
987: addl2 $20,(sp)
988: rsb
989: #
990: # systm - get execution time so far
991: #
992: .globl systm
993: systm:
994: pushr $mr2+mr3
995: movl $tscblk+8,-(sp) # -> times buffer
996: calls $1,_times # call to do times
997: movl tscblk+8,r5 # get user time in 60ths
998: mull2 $100,r5 # mulitply by 100 to get 6000ths
999: divl2 $6,r5 # divide by 6 to get 1000ths
1000: popr $mr2+mr3
1001: rsb
1002: #
1003: # sysxi - exit from executing program
1004: #
1005: .globl sysxi
1006: sysxi:
1007: tstl r10 # if 0 instead of scblk then
1008: jeqlu xilmod # try to write load module
1009: pushr $mr235
1010: cmpl $b$scl,(r10) # if not scblk then
1011: jnequ erxit1 # error
1012: pushl r10 # push scblk pointer
1013: calls $1,_doexec # go do exit
1014: jmp erxit2 # should never return
1015: #
1016: # write load module
1017: #
1018: xilmod: tstl r5 # if r5 <= 0 then
1019: bgtr 0f
1020: pushr $mr235 # save regs for error exits
1021: jbr erxit1 # and take error exit
1022: 0: pushr $cmpreg # else save all compiler regs
1023: #
1024: # need to save stack contents, so that when load module is
1025: # invoked, stack can be recreated.
1026: #
1027: subl3 sp,initsp,r0 # compute depth of stack
1028: cmpl r0,tscblk # if stack won't fit in tscblk then
1029: jgtru xi2big # big trouble
1030: movl sp,r0 # -> into real stack
1031: movab tscblk+scstr,r1 # -> save stack area
1032: 1: movl (r0)+,(r1)+ # copy word of stack ...
1033: cmpl r0,initsp # until hit top word
1034: blssu 1b
1035: movl r1,lmodstk # set top of saved stack
1036: #
1037: # create a.out header in hststr scblk.
1038: #
1039: addl3 $1023,dnamp,r1 # round current memory in use
1040: bicl3 $0x3ff,r1,-(sp) # to a multiple of the page size
1041: movab hststr+scstr,r0 # -> a.out header block
1042: pushl r0 # which will be the other argument
1043: movl $0413,(r0)+ # set magic number
1044: bicl3 $0x3ff,$_etext,r1 # get text size, rounded down
1045: movl r1,(r0)+ # and place it in a.out header
1046: subl3 r1,4(sp),(r0)+ # data size = total - text size
1047: clrl (r0)+ # we will use no bss
1048: clrl (r0)+
1049: clrl (r0)+ # set starting address
1050: clrl (r0)+
1051: clrl (r0)+
1052: #
1053: # call a workhorse c routine to actually write a.out file.
1054: # the amount of memory to write has already been pushed.
1055: #
1056: calls $2,_wrtaout # call to write a.out
1057: #
1058: # restore flptr to its previous value
1059: #
1060: addl2 initsp,flptr
1061: #
1062: tstl r0 # if error creating a.out then
1063: blss xi2big # return error
1064: #
1065: # pop registers and set up call to sysej
1066: #
1067: popr $cmpreg # restore all registers
1068: movl r7,r10 # -> chain of fcbs
1069: clrl r7 # set &CODE = 0
1070: jsb sysej # call to end run
1071: #
1072: # if stack too big
1073: #
1074: xi2big: popr $cmpreg # restore all regs
1075: pushr $mr235 # push correct regs
1076: jbr erxit2 # take error exit
1077: #
1078: # error/ppm exits - pick up n-th word following jsb and return
1079: # to address contained in that word.
1080: #
1081: erxit1:
1082: popr $mr235
1083: movl (sp)+,r11
1084: jmp *(r11)+
1085: #
1086: erxit2:
1087: popr $mr235
1088: addl3 $4,(sp)+,r11
1089: jmp *(r11)+
1090: #
1091: erxit3:
1092: popr $mr235
1093: addl3 $8,(sp)+,r11
1094: jmp *(r11)+
1095: #
1096: erxit4:
1097: popr $mr235
1098: addl3 $12,(sp)+,r11
1099: jmp *(r11)+
1100: #
1101: erxit5:
1102: popr $mr235
1103: addl3 $16,(sp)+,r11
1104: jmp *(r11)+
1105: #
1106: erxit6:
1107: popr $mr235
1108: addl3 $20,(sp)+,r11
1109: jmp *(r11)+
1110: #
1111: # option routines
1112: #
1113: # optclr clears a flag
1114: # opterr signals an error
1115: # optfld sets defcas to 0 for no folding
1116: # optnum get numeric value
1117: # optset set option value
1118: #
1119: # optclr
1120: #
1121: optclr: bicl2 optflg(r1),sptflg
1122: rsb
1123: #
1124: # opterr
1125: #
1126: opterr: pushr $mr0+mr1+mr2+mr3+mr4+mr5
1127: pushl $6
1128: pushl $curopt
1129: pushl $2
1130: calls $3,_write
1131: popr $mr0+mr1+mr2+mr3+mr4+mr5
1132: rsb
1133: #
1134: # optinp
1135: #
1136: optinp: tstl inpptr # if already processed input filenames then
1137: bnequ opterr # error
1138: subl3 $4,r6,inpptr # -> first input filename
1139: movl r4,inpcnt # set number of filenames
1140: movl $1,r4 # done scanning options
1141: rsb # return
1142: #
1143: # optfld
1144: #
1145: optfld: clrl defcas
1146: rsb
1147: #
1148: # optnum
1149: #
1150: optnum: pushl r0 # -> number
1151: jsb getnum # get number
1152: movl (sp)+,r0 # -> byte past last digit
1153: movzbl (r0),r2 # get byte past last digit
1154: bisb2 $040,r2 # fold to lower case
1155: cmpb $ch$lk,r2 # if number followed by k then
1156: bnequ 0f
1157: mull2 $1024,r5 # mulitply by 1024
1158: incl r0 # skip over k
1159: 0: tstl r5 # if number zero or negative
1160: bleq opterr # treat as error
1161: movl r5,*optflg(r1) # store option
1162: rsb # return
1163: #
1164: # optoup
1165: #
1166: optoup: cmpl $2,r4 # if no option after -o then
1167: bgtru opterr # error
1168: movl (r6),r1 # -> output filename
1169: cmpb $ch$mn,(r1) # if filename starts with - then
1170: beqlu opterr # error
1171: movl (r6)+,oupptr # save pointer to output filename
1172: decl r4 # one less option to process
1173: rsb # return
1174: #
1175: # optset
1176: #
1177: optset: bisl2 optflg(r1),sptflg
1178: rsb
1179: #
1180: # optusr
1181: #
1182: optusr: cmpl $2,r4 # if fewer than 2 options then
1183: jgtru opterr # can't have argument
1184: movl (r6)+,uarg # save -> argument
1185: decl r4 # dec number of remaining options
1186: rsb
1187: #
1188: # getnum
1189: #
1190: # (sp) -> string to convert
1191: # jsb getnum
1192: # (sp) -> char after last digit
1193: # (r5) converted number
1194: #
1195: getnum:
1196: movl 4(sp),r7 # -> string
1197: clrl r5 # clear accumulator
1198: 0: cmpb $060,(r7) # if not a decimal digit then
1199: bgtru 1f # done with conversion
1200: cmpb $071,(r7) #
1201: blssu 1f
1202: movzbl (r7)+,r8 # load digit
1203: subl2 $060,r8 # remove unnecessary bits
1204: mull2 $10,r5 # accum * 10
1205: addl2 r8,r5 # add in this digit
1206: brb 0b
1207: 1: movl r7,4(sp) # return address of next byte
1208: rsb # return
1209: #
1210: # interface data area
1211: # -------------------
1212: #
1213: .data 1
1214: #
1215: # flags for compiler
1216: #
1217: .set errors,1 # send errors to terminal
1218: .set prtich,2 # standard printer is terminal
1219: .set nolist,4 # suppress compilation listing
1220: .set nocmps,8 # suppress compilation statistics
1221: .set noexcs,16 # suppress execution statistics
1222: .set lnglst,32 # generate page ejects
1223: .set noexec,64 # suppress program execution
1224: .set trmnal,128 # terminal i/o association
1225: .set stdlst,256 # standard listing (intermediate)
1226: .set nohedr,512 # suppress sysid header
1227: #
1228: .set deflag,errors+nolist+nocmps+noexcs+trmnal+nohedr
1229: #
1230: # option table
1231: #
1232: .set opttxt,0 # option characters
1233: .set optflg,4 # option flag - flags or address
1234: .set optrtn,8 # -> option processing routine
1235: .set optsiz,12 # size in bytes of entry
1236: #
1237: opttbl:
1238: .ascii "-f "
1239: .long 0,optfld
1240: #
1241: .ascii "-e "
1242: .long errors,optclr
1243: #
1244: .ascii "-l "
1245: .long nolist,optclr
1246: #
1247: .ascii "-c "
1248: .long nocmps,optclr
1249: #
1250: .ascii "-x "
1251: .long noexcs,optclr
1252: #
1253: .ascii "-a "
1254: .long nolist+nocmps+noexcs,optclr
1255: #
1256: .ascii "-p "
1257: .long lnglst,optset
1258: #
1259: .ascii "-z "
1260: .long stdlst,optset
1261: #
1262: .ascii "-h "
1263: .long nohedr,optclr
1264: #
1265: .ascii "-n "
1266: .long noexec,optset
1267: #
1268: .ascii "-m "
1269: .long maxsiz,optnum
1270: #
1271: .ascii "-s "
1272: .long stksiz,optnum
1273: #
1274: .ascii "-d "
1275: .long datwds,optnum
1276: #
1277: .ascii "-i "
1278: .long meminc,optnum
1279: #
1280: .ascii "-o "
1281: .long 0,optoup
1282: #
1283: .ascii "-u "
1284: .long 0,optusr
1285: #
1286: curopt: .ascii "- "
1287: .ascii "?\n "
1288: .long opterr
1289: .align 2
1290: #
1291: # standard input/output pointers
1292: #
1293: inpcnt: .long 0
1294: inpptr: .long 0
1295: oupptr: .long 0
1296: #
1297: # pointer to -u arg
1298: #
1299: uarg: .long 0
1300: #
1301: # save argc and argv from initial call
1302: #
1303: argc: .long 0
1304: argv: .long 0
1305: #
1306: # #! data areas
1307: #
1308: cmdcnt: .long 0 # number of command args
1309: rdrec1: .long 0 # read record 1 from std in flag
1310: #
1311: # standard ioblks
1312: #
1313: inpiob: .space iobuf
1314: .long inpbf # -> input bfblk
1315: .long 0 # file descriptor
1316: .long IO_INP|IO_OPN|IO_SYS
1317: #
1318: inpbf: .space bfsiz
1319: .long 1024 # buffer size
1320: .long 0 # remaining chars to read
1321: .long 0 # offset to next character to read
1322: .space 1024 # buffer
1323: #
1324: #
1325: oupiob: .space iobuf
1326: .long 0 # no buffer
1327: .long 1 # file descriptor number
1328: .long IO_OUP|IO_OPN|IO_SYS
1329: #
1330: #
1331: ttyiob: .space iobuf
1332: .long ttybf # -> tty buffer input
1333: .long 2 # file descriptor number
1334: .long IO_INP|IO_OUP|IO_OPN|IO_SYS
1335: #
1336: ttybf: .space bfsiz
1337: .long 258 # buffer size
1338: .long 0 # remaining chars to read
1339: .long 0 # offset to next char to read
1340: .space 258 # buffer
1341: .align 2
1342: #
1343: .globl _rzfcb
1344: _rzfcb: .long 0
1345: #
1346: fildes: .long 0
1347: pr_len: .long 0
1348: rd_len: .long 0
1349: lenfname: .long 0
1350: ioblkptr: .long 0
1351: bfblkptr: .long 0
1352: bfblksiz: .long 0
1353: fcblkptr: .long 0
1354: tioblk: .space iosize
1355: #
1356: # memory allocation variables
1357: #
1358: meminc: .long 4*k # increment in words for sbrk
1359: meminb: .long 0 # meminc * 4 (to get bytes)
1360: datwds: .long 256*k # max size in words of dynamic area
1361: basmem: .long 0 # base of dynamic memory
1362: topmem: .long 0 # current top of dynamic memory
1363: maxmem: .long 0 # maximum top of dynamic memory
1364: maxsiz: .long 8*k # maximum object size in words
1365: stksiz: .long 2*k # stack size in words
1366: initsp: .long 0 # initial value of sp on entry to sec04
1367: lowsp: .long 0 # lowest legal sp value
1368: #
1369: # default value for &case
1370: #
1371: defcas: .long 1
1372: #
1373: # values given to syspp for print parameters
1374: #
1375: lnsppg: .long 60 # lines per page
1376: pagwid: .long 120 # page width
1377: sptflg: .long deflag # flags
1378: #
1379: # flag that indicates that this is a load module. also, serves
1380: # the dual purpose of indicating size of saved stack.
1381: #
1382: lmodstk: .long 0
1383: #
1384: temp1: .long 0
1385: temp2: .long 0
1386: temp3: .long 0
1387: #
1388: nulstr: .long 0,0
1389: #
1390: tscblk: .long 512,0
1391: .space 512
1392: #
1393: hststr: .long 128,0
1394: .space 128
1395: #
1396: id1: .long 0,id1l
1397: .ascii "(0.0)"
1398: id1e:
1399: .set id1l,id1e-id1-8
1400: .align 2
1401: #
1402: id2: .long 0,id2l
1403: .ascii "VAX/UNIX Version"
1404: id2e:
1405: .set id2l,id2e-id2-8
1406: .align 2
1407: #
1408: ffscb: .long 0,1
1409: ffstr: .byte 12
1410: #
1411: nlstr: .ascii "\n"
1412: .align 2
1413: #
1414: errfdn: .long 0
1415:
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.