![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to osint.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 osint.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: jsb streloc # relocate pointers into stack
293: #
294: # restore stack from tscblk.
295: #
296: movl lmodstk,r0 # -> bottom word of stack
297: movab tscblk+scstr,r1 # -> top word of stack
298: 0: movl -(r0),-(sp) # relocate word of stack
299: cmpl r0,r1 # if not at end of relocation then
300: bgtru 0b # loop back
301: #
302: # if restarting, we can always access the command line arguments
303: #
304: movl $1,cmdcnt
305: #
306: # the system break will not be what it should, so reset it
307: #
308: pushl topmem
309: calls $1,_brk
310: #
311: # reset signals to what they should be.
312: #
313: calls $0,_setsigs
314: #
315: # forget about files open during compilation -
316: #
317: clrl inpptr # no input files
318: clrl inpcnt # so count is 0 too
319: clrl oupptr # no output file
320: clrl errfdn # no error file
321: #
322: # reset standard input buffer
323: #
324: clrl inpbf+bfrem # no remaining chars
325: clrl inpbf+bfoff # offset to next char
326: #
327: # restore compiler's registers and off we go.
328: #
329: popr $cmpreg # restore compiler's registers
330: addl2 $8,(sp)
331: rsb
332: #
333: # sbchk is called by the compiler to check for stack overflow.
334: #
335: .globl sbchk
336: sbchk: cmpl sp,lowsp # if sp is ok then
337: blssu 0f
338: rsb # return
339: 0: tstl (sp)+ # else pop stack
340: jmp sec05 # and go to stack overflow section
341: #
342: # unsupported entries that simply return.
343: #
344: .globl sysdc
345: sysdc:
346: .globl sysdm
347: sysdm:
348: .globl systt
349: systt:
350: .globl sysul
351: sysul:
352: rsb
353: #
354: # unsupported that take error returns
355: #
356: .globl sysex
357: sysex:
358: .globl sysld
359: sysld:
360: pushr $mr235 # save ye registers
361: jbr erxit1
362: #
363: # sysax - after execution call
364: #
365: # sysax is called immediately after execution, so that the interface
366: # can do any cleanup. here, the standard output file is switched, if
367: # necessary back to the listing file.
368: #
369: .globl sysax
370: sysax:
371: pushr $mr235
372: pushl oupptr
373: calls $1,_swcoup
374: popr $mr235
375: rsb
376: #
377: # sysbx - before execution call
378: #
379: # sysbx is called after compilation and before execution begins.
380: # sysbx allows the inteface to do any cleanup. here, the standard
381: # listing file is switched to the standard output file.
382: #
383: .globl sysbx
384: sysbx:
385: pushr $mr235
386: pushl oupptr
387: calls $1,_swcoup
388: popr $mr235
389: rsb
390: #
391: # sysdt - get current date
392: #
393: # return both date and time
394: #
395: # jsb sysdt # call to get date
396: # (r10) # -> scblk
397: #
398: .globl sysdt
399: sysdt:
400: pushr $mr235
401: movl $tscblk,r10
402: movl $17,sclen(r10) # dd/mm/yy hh.mm.ss
403: pushl $tscblk+scstr
404: calls $1,_getdate
405: popr $mr235
406: rsb
407: #
408: # sysef - eject file
409: #
410: .globl sysef
411: sysef:
412: pushr $mr235
413: pushl fciob(r6) # -> ioblk
414: calls $1,_osopen # call to do open
415: tstl r0 # if open error then
416: jnequ erxit1 # take error exit
417: pushl $ffscb # -> ff scblk
418: pushl fciob(r6) # -> ioblk
419: pushl ffscb+sclen # record length
420: mnegl fcrsz(r6),-(sp) # i/o mode - raw or line
421: calls $4,_oswrite # call to do write
422: tstl r0 # if output error then
423: jneq erxit3 # signal failure
424: popr $mr235
425: addl2 $12,(sp)
426: rsb
427: #
428: # sysej - end of job
429: #
430: .globl sysej
431: sysej:
432: movl r10,_rzfcb # copy head of fcb chain
433: beqlu 1f # if empty then nothing to close
434: 0: movl chfcb(r10),r1 # -> fcb
435: pushl fciob(r1) # -> ioblk
436: calls $1,_osclose # call to do close
437: movl chnxt(r10),r10 # -> next on chain
438: bnequ 0b # and loop back for more
439: 1: pushl r7 # return &code
440: calls $1,__exit
441: #
442: # sysem - get error message text
443: #
444: .globl sysem
445: sysem:
446: pushr $mr235
447: movl $tscblk,r9 # -> temp scblk
448: clrl sclen(r9) # default error text is null string
449: tstl errfdn # if error fd exists then
450: bnequ 0f # skip open
451: calls $0,_openerr # else open error text file
452: movl r0,errfdn # and save fd
453: 0: tstl errfdn # if no error text file then
454: blss emxit # return null string
455: decl r6 # errors start at 1
456: blss emxit # but don't have error 0
457: mull2 $49,r6 # compute byte offset of error text
458: pushl $0 # whence
459: pushl r6 # offset
460: pushl errfdn # file descriptor number
461: calls $3,_lseek # call to do seek
462: tstl r0 # if lseek fails then
463: blss emxit # return null string
464: pushl $48 # error text length w/out nl
465: pushl $tscblk+8 # buffer address
466: pushl errfdn # file descriptor number
467: calls $3,_read # call to do read
468: tstl r0 # if read failed then
469: blss emxit # return null string
470: 1: cmpb $' ,tscblk+7(r0)# if last character is
471: bneq 2f # nonblank, return length
472: sobgeq r0,1b # otherwise discard the blank, try again
473: 2: movl r0,sclen(r9) # set actual length
474: emxit:
475: popr $mr235
476: rsb # return
477: #
478: # sysen - endfile
479: #
480: .globl sysen
481: sysen:
482: pushr $mr235
483: movl r$fcb,_rzfcb # copy fcb chain head
484: pushl fciob(r6) # -> ioblk
485: calls $1,_osclose # call to do close
486: popr $mr235
487: addl2 $12,(sp)
488: rsb
489: #
490: # sysej - eject standard output
491: #
492: .globl sysep
493: sysep:
494: pushr $mr235
495: pushl $1 # 1 character
496: pushl $ffstr # -> ff
497: pushl $1 # fd 1
498: calls $3,_write # call to do write
499: popr $mr235
500: rsb
501: #
502: # sysfc
503: #
504: .globl sysfc
505: sysfc:
506: movl (sp)+,(sp) # remove stacked scblk
507: pushr $mr235
508: tstl sclen(r10) # if null filearg1 then
509: jeqlu erxit1 # error
510: #
511: # get length of filename and scan off options.
512: #
513: movl r9,-(sp) # -> filename scblk
514: calls $1,_lenfnm # call to get filename length
515: movl r0,lenfname # save length for later use
516: jlss erxit1 # length must not be negative
517: movl r9,-(sp) # -> filename scblk
518: movl $tioblk,-(sp) # -> temporary ioblk
519: movl r7,-(sp) # input/output association flag
520: calls $3,_sioarg # call to scan i/o args
521: tstl r0 # if error in args then
522: jlss erxit1 # take error return
523: #
524: # check for consistency of calls. cannot have both input
525: # and output to same channel. if this happens, though,
526: # set flag and let sysio take proper error exit.
527: #
528: tstl r6 # if no previous fcblk then
529: beqlu 0f # skip
530: movl fciob(r6),r0 # -> ioblk
531: movl ioflg(r0),r0 # get previous flags
532: mcoml $IO_INP+IO_OUP,r1 # get mask for bicl
533: bicl2 r1,r0 # remove all bits but INP&OUP
534: bitl tioblk+ioflg,r0 # if bits are not same then
535: bnequ 0f
536: bisl2 $IO_ILL,tioblk+ioflg # then set error flag
537: 0:
538: #
539: # handle null filenames here - must either have a previous
540: # fcblk or specify -f arg.
541: #
542: tstl lenfname # if non-null filename then
543: bgtr fcfnam # go handle below
544: bitl $IO_OPN,tioblk+ioflg
545: bnequ fcfarf # if -f specified then merge w/non-null
546: tstl r6 # if no previous fcblk then
547: jeqlu erxit1 # error
548: clrl r6 # assume that no new fcblk needed
549: clrl ioblkptr # no ioblk ptr to stuff
550: tstl tioblk # if however i/o args indicate one
551: jeqlu fcxit
552: movl fciob(r6),ioblkptr
553: movl $fcsize,r6 # allocate one
554: jbr fcxit
555: #
556: # handle real filenames and null filenames with -f arg here.
557: # note that they're mutually exclusive.
558: #
559: fcfnam: bitl $IO_OPN,tioblk+ioflg
560: jnequ erxit1 # can't have -f arg too
561: fcfarf: tstl r6 # if previous fcblk passed then
562: jnequ erxit1 # error
563: clrl ioblkptr
564: addl3 $bfsize+3,tioblk+iopid,r6
565: bicl2 $3,r6
566: movl r6,bfblksiz
567: addl2 $fcsize+iosize,r6
568: movl $1,tioblk # set newfcb flag
569: #
570: fcxit: clrl r10 # no private fcblk
571: clrl r8 # xrblk please
572: popr $mr235
573: addl2 $4,(sp)
574: rsb
575: #
576: # syshs
577: #
578: .globl syshs
579: syshs:
580: pushr $mr235
581: cmpl $b$icl,(r6) # if arg1 not integer then
582: jnequ 9f # return host string
583: casel icval(r6),$0,$5
584: 0:
585: .word 1f-0b # 0: return -u argument
586: .word 2f-0b # 1: do system call
587: .word 3f-0b # 2: return command arg
588: .word 4f-0b # 3: return number of first #! arg
589: .word 5f-0b # 4: get environment variable
590: .word 6f-0b # 5: manipulate signals
591: jbr erxit1 # else arg error
592: #
593: 1: tstl uarg # if uarg is 0 then
594: jeqlu erxit4 # return null string
595: pushl tscblk # push scblk string length
596: pushl $tscblk # -> temp scblk
597: clrl -(sp) # ending character is 0
598: pushl uarg # -> -u argument
599: calls $4,_cpys2sc # copy string to scblk
600: movab tscblk,r10 # -> temp scblk
601: jbr erxit3 # return
602: #
603: 2: cmpl $b$scl,(r10) # if 2nd arg not string then
604: jnequ erxit1 # return error
605: tstl sclen(r10) # if null string then
606: jeqlu erxit4 # return null string
607: pushl r10 # -> command string
608: calls $1,_dosys # call to do system call
609: jbr erxit4 # return null string
610: #
611: 3: cmpl $b$icl,(r10) # if 2nd arg not integer then
612: jnequ erxit1 # return error
613: movl tscblk,tscblk+sclen # set max length of scblk
614: pushab tscblk # push -> tscblk
615: pushl argv # push -> pointers
616: pushl argc # push number of args
617: pushl icval(r10) # arg requested
618: calls $4,_arg2scb # call to do real move
619: tstl r0 # if out of range then
620: jlss erxit6 # fail
621: jeqlu erxit4 # (if 0) return null string
622: movab tscblk,r10 # -> tscblk
623: jbr erxit3 # return
624: #
625: 4: tstl cmdcnt # if not invoked by #! then
626: jeqlu erxit6 # fail
627: movab temp1,r9 # -> temp icblk
628: movl $b$icl,(r9) # set integer block
629: movl cmdcnt,icval(r9)# set value
630: jbr erxit5 # return result
631: #
632: 5: cmpl $b$scl,(r10) # if 2nd arg not string then
633: jnequ erxit1 # return error
634: tstl sclen(r10) # if null string then
635: jeqlu erxit1 # return error
636: movl tscblk,tscblk+sclen # set max length of scblk
637: pushab tscblk # push -> tscblk
638: pushl r10 # -> environment variable requested
639: calls $2,_rdenv # fetch the environment variable
640: tstl r0 # if it couldn't be found
641: jlss erxit6 # fail
642: movab tscblk,r10 # else return tscblk
643: jbr erxit3
644: 6: cmpl $b$icl,(r10) # if second arg not integer then
645: jnequ erxit1 # return error
646: pushl icval(r10) # get the value
647: calls $1,_sigtrap # call the routine
648: movab temp1,r9 # -> temp icblk
649: movl $b$icl,(r9) # set integer block
650: movl r0,icval(r9) # set value
651: jbr erxit5 # return result
652: #
653: #
654: 9: pushl hststr # push length of host string
655: pushab hststr # push -> host string scblk
656: calls $2,_gethost # call to get host string
657: tstl hststr+sclen # if null host string then
658: jeqlu erxit4 # return null string
659: movl $hststr,r10 # -> host string
660: jbr erxit3 # return
661: #
662: # sysid - return system id
663: #
664: .globl sysid
665: sysid:
666: movl $id1,r9
667: movl $id2,r10
668: rsb
669: #
670: # sysil - get input record length
671: #
672: .globl sysil
673: sysil:
674: movl fcrsz(r6),r6
675: bgtr 0f
676: mnegl r6,r6
677: 0:
678: rsb
679: #
680: # sysin - read input record
681: #
682: .globl sysin
683: sysin:
684: pushr $mr235
685: pushl fciob(r6) # -> ioblk
686: calls $1,_osopen # call to open file
687: tstl r0 # if open unsuccessful then
688: jnequ erxit3 # take error exit
689: pushl r9 # -> scblk
690: pushl fciob(r6) # -> ioblk
691: pushl fcrsz(r6) # push record length
692: bgtr 0f
693: mnegl (sp),(sp) # if negative then make it positive
694: 0: pushl fcrsz(r6) # i/o mode - raw or line
695: calls $4,_osread # call to do read
696: cmpl r0,$-1 # check for eof or input error
697: jeql erxit1 # take eof exit
698: jlss erxit2 # take error exit
699: movl r0,sclen(r9) # set record length
700: popr $mr235
701: addl2 $12,(sp)
702: rsb
703: #
704: # sysio
705: #
706: .globl sysio
707: sysio:
708: pushr $mr235
709: bitl $IO_ILL,tioblk+ioflg
710: jnequ erxit2 # if illegal then take error exit
711: movl r6,fcblkptr # copy fcblk pointer for exit
712: #
713: # fill in fcblk.
714: #
715: tstl tioblk+iotyp # if no new fcb to build then
716: jeqlu iodon # done
717: movl $fcsize,fclen(r6)
718: movl tioblk+iolen,fcrsz(r6)
719: movl ioblkptr,fciob(r6)
720: jnequ iodon
721: movab fcsize(r6),fciob(r6)
722: #
723: # fill in ioblk.
724: #
725: movab fcsize(r6),r6 # -> ioblk
726: movl $b$xrt,(r6)
727: movl $iosize,iolen(r6)
728: movl r9,iofnm(r6)
729: clrl iopid(r6)
730: movab iosize(r6),iobuf(r6)
731: movl tioblk+iofdn,iofdn(r6)
732: movl tioblk+ioflg,ioflg(r6)
733: #
734: # if -f0 or -f1 specified then
735: #
736: # for -f0 ensure that buffer is same as osint's
737: #
738: # for -f1 no buffering should be done
739: #
740: bitl $IO_SYS,ioflg(r6)
741: beqlu 9f
742: cmpl $1,iofdn(r6)
743: blssu 9f
744: beqlu 1f
745: movl $inpbf,iobuf(r6)
746: jbr 9f
747: 1: clrl iobuf(r6)
748: bisl2 $IO_WRC,ioflg(r6)
749: 9:
750: #
751: # fill in bfblk
752: #
753: movab iosize(r6),r6 # -> bfblk
754: movl $b$xnt,(r6)
755: movl bfblksiz,bflen(r6)
756: movl tioblk+iopid,bfsiz(r6)
757: clrl bfrem(r6)
758: clrl bfoff(r6)
759: #
760: # try to open the file
761: #
762: movl fcblkptr,r0
763: pushl fciob(r0)
764: calls $1,_osopen
765: tstl r0
766: jneq erxit2 # if open failed, indicate error
767: #
768: iodon: movl fcblkptr,r10
769: clrl r8
770: popr $mr235
771: addl2 $8,(sp)
772: rsb
773: #
774: # sysmm - get more memory
775: #
776: .globl sysmm
777: sysmm:
778: cmpl topmem,maxmem # if already at top of memory then
779: blssu 0f
780: clrl r9 # no more to be had
781: rsb
782: 0: # else {alloc some more}
783: pushr $mr235
784: pushl meminb # size in bytes of memory request
785: calls $1,_sbrk # call to get memory
786: popr $mr235
787: tstl r0 # if memory obtained then
788: blss 1f
789: addl2 meminb,topmem # adjust current top
790: movl meminc,r9 # set number of words in block
791: rsb # return
792: 1: clrl r9 # else nothing to get
793: rsb
794: #
795: # sysmx - get maximum size of created objects
796: #
797: .globl sysmx
798: sysmx:
799: mull3 $4,maxsiz,r6
800: rsb
801: #
802: # sysou - output record
803: #
804: .globl sysou
805: sysou:
806: pushr $mr235
807: pushl fciob(r6) # -> ioblk
808: calls $1,_osopen # call to do open
809: tstl r0 # if open error then
810: jnequ erxit1 # take error exit
811: pushl r9 # -> scblk
812: pushl fciob(r6) # -> ioblk
813: pushl sclen(r9) # record length
814: pushl fcrsz(r6) # i/o mode - raw or line
815: calls $4,_oswrite # call to do write
816: tstl r0 # if output error,
817: jneq erxit2 # take error exit
818: popr $mr235
819: addl2 $8,(sp)
820: rsb
821: #
822: # syspi - print on interactive channel (terminal)
823: #
824: .globl syspi
825: syspi:
826: movl $ttyiob,r11
827: jbr piprt
828: #
829: # syspp - return print parameters
830: #
831: .globl syspp
832: syspp:
833: movl pagwid,r6
834: movl lnsppg,r7
835: movl sptflg,r8
836: movl defcas,kvcas
837: rsb
838: #
839: # syspr - print on standard output
840: #
841: .globl syspr
842: syspr:
843: movl $oupiob,r11
844: #
845: # handle both syspi and syspr here.
846: #
847: piprt:
848: pushr $mr235
849: bisl2 $IO_WRC,ioflg(r11) # briefly set no buffering
850: pushl r9 # -> scblk
851: pushl r11 # -> ioblk
852: pushl r6 # number characters
853: pushl $1 # line mode
854: calls $4,_oswrite # call to do write
855: bicl2 $IO_WRC,ioflg(r11) # back to buffering
856: tstl r0 # if output error then
857: jneq erxit1 # indicate error return
858: popr $mr235
859: addl2 $4,(sp)
860: rsb
861: #
862: # sysrd - read from standard input
863: #
864: .globl sysrd
865: sysrd:
866: pushr $mr235
867: movl $inpiob,ioblkptr
868: #
869: # handle both sysrd and sysri here.
870: #
871: rdmrg:
872: pushl r9 # -> scblk
873: pushl ioblkptr # -> ioblk
874: pushl r8 # read length
875: pushl r8 # line mode
876: calls $4,_osread # call to do read
877: cmpl r0,$-1 # check for eof or input error
878: jeql rdeof # take eof exit
879: jlss erxit1 # take error exit
880: movl r0,sclen(r9) # set read length
881: #
882: # check for 1st record of standard input coming from a file specified
883: # on the command line. if all of these conditions are true, allow
884: # the program to access any arguments following the file name.
885: #
886: tstl rdrec1 # if already ready record 1 then
887: bnequ rdskp # skip
888: cmpl $inpiob,ioblkptr
889: bnequ rdskp # if sysri entry then skip
890: incl rdrec1 # indicate read 1st record from std input
891: tstl inpptr # if not file from command line then
892: beqlu rdskp # skip
893: cmpb $'#,scstr(r9) # if 1st char not # then
894: bnequ rdskp # skip
895: cmpb $'!,scstr+1(r9) # if 2nd char not ! then
896: bnequ rdskp # skip
897: subl3 inpcnt,argc,cmdcnt
898: incl cmdcnt # compute # args after filename
899: movl $1,inpcnt # reset input count
900: brb rdmrg # ignore 1st record and try again
901: rdskp:
902: popr $mr235
903: addl2 $4,(sp)
904: rsb
905: #
906: # come here to handle eof for both sysrd and sysri. if eof
907: # is for sysrd, standard input, switch to next input file
908: # if one exists.
909: #
910: rdeof: movl ioblkptr,r4 # -> ioblk
911: tstl iofdn(r4) # if not file descriptor 0 then
912: jnequ erxit1 # real eof
913: pushl inpptr # push -> array of pointers
914: pushl inpcnt # push size of areray
915: calls $2,_swcinp # call to switch input files
916: tstl r0 # if more to read then
917: jeqlu rdmrg # read it
918: jmp erxit1 # else signal eof
919: #
920: # sysri - read from interactive channel (terminal)
921: #
922: .globl sysri
923: sysri:
924: pushr $mr235
925: movl $ttyiob,ioblkptr
926: jbr rdmrg
927: #
928: # sysrw - rewind file
929: #
930: .globl sysrw
931: sysrw:
932: pushr $mr235
933: pushl fciob(r6) # -> ioblk
934: calls $1,_osopen # call to do open
935: tstl r0 # if open error then
936: jnequ erxit1 # take error exit
937: movl fciob(r6),r1 # -> ioblk
938: bitl $IO_PIP,ioflg(r1)
939: jnequ erxit2 # if pipe then rewind not allowed
940: cmpl iofdn(r1),$2 # if fd < 2 then
941: jlssu erxit2 # rewind not allowed
942: pushl $0 # whence
943: pushl $0 # offset
944: pushl fciob(r6) # -> ioblk
945: calls $3,_doset # call to do set
946: popr $mr235
947: addl2 $12,(sp)
948: rsb
949: #
950: # sysst - set file pointer
951: #
952: .globl sysst
953: sysst:
954: pushr $mr235
955: pushl fciob(r6) # -> ioblk
956: calls $1,_osopen # call to do open
957: tstl r0 # if file open error then
958: jnequ erxit3 # return error
959: #
960: movl fciob(r6),r1 # -> ioblk
961: bitl $IO_PIP,ioflg(r1)
962: jnequ erxit4 # if pipe then set not allowed
963: cmpl iofdn(r1),$2 # if fd < 2 then
964: jlssu erxit4 # set not allowed
965: #
966: cmpl $b$icl,(r7) # if already integer then
967: bnequ 0f
968: movl icval(r7),temp1 # grab value
969: brb 1f
970: 0: cmpl $b$scl,(r7) # else if not a string then
971: jnequ erxit1 # error
972: clrl temp3 # clear scnint character count
973: pushl $temp3 # -> temp3
974: pushl sclen(r7) # string length
975: pushab scstr(r7) # -> string
976: calls $3,_scnint # call to scan integer
977: movl r0,temp1 # and save
978: 1:
979: #
980: cmpl $b$icl,(r8) # if already integer then
981: bnequ 0f
982: movl icval(r8),temp2 # grab value
983: brb 1f
984: 0: cmpl $b$scl,(r8) # else if not a string then
985: jnequ erxit1 # error
986: clrl temp3 # clear scnint character count
987: pushl $temp3 # -> temp3
988: pushl sclen(r8) # string length
989: pushab scstr(r8) # -> string
990: calls $3,_scnint # call to scan integer
991: movl r0,temp2 # and save
992: 1:
993: #
994: pushl temp2 # whence
995: pushl temp1 # offset
996: pushl fciob(r6) # -> ioblk
997: calls $3,_doset # call to do set
998: popr $mr235
999: addl2 $20,(sp)
1000: rsb
1001: #
1002: # systm - get execution time so far
1003: #
1004: .globl systm
1005: systm:
1006: pushr $mr2+mr3
1007: movl $tscblk+8,-(sp) # -> times buffer
1008: calls $1,_times # call to do times
1009: movl tscblk+8,r5 # get user time in 60ths
1010: mull2 $100,r5 # mulitply by 100 to get 6000ths
1011: divl2 $6,r5 # divide by 6 to get 1000ths
1012: popr $mr2+mr3
1013: rsb
1014: #
1015: # sysxi - exit from executing program
1016: #
1017: .globl sysxi
1018: sysxi:
1019: tstl r10 # if 0 instead of scblk then
1020: jeqlu xilmod # try to write load module
1021: pushr $mr235
1022: cmpl $b$scl,(r10) # if not scblk then
1023: jnequ erxit1 # error
1024: pushl r10 # push scblk pointer
1025: calls $1,_doexec # go do exit
1026: jmp erxit2 # should never return
1027: #
1028: # write load module
1029: #
1030: xilmod: tstl r5 # if r5 <= 0 then
1031: bgtr 0f
1032: pushr $mr235 # save regs for error exits
1033: jbr erxit1 # and take error exit
1034: 0: pushr $cmpreg # else save all compiler regs
1035: #
1036: # need to save stack contents, so that when load module is
1037: # invoked, stack can be recreated.
1038: #
1039: subl3 sp,initsp,r0 # compute depth of stack
1040: cmpl r0,tscblk # if stack won't fit in tscblk then
1041: jgtru xi2big # big trouble
1042: movl sp,r0 # -> into real stack
1043: movab tscblk+scstr,r1 # -> save stack area
1044: 1: movl (r0)+,(r1)+ # copy word of stack ...
1045: cmpl r0,initsp # until hit top word
1046: blssu 1b
1047: movl r1,lmodstk # set top of saved stack
1048: #
1049: # before creating the load module, we must relativize the
1050: # compiler cells that point into the stack. We do this by
1051: # temporarily negating initsp, calling streloc, and then
1052: # restoring initsp. After the load module has been written,
1053: # another call to streloc will restore the stack pointers.
1054: #
1055: mnegl initsp,initsp # negate initsp so streloc will subtract
1056: jsb streloc # relativize the compiler cells
1057: mnegl initsp,initsp # restore initsp to its previous value
1058: #
1059: # create a.out header in hststr scblk.
1060: #
1061: addl3 $1023,dnamp,r1 # round current memory in use
1062: bicl3 $0x3ff,r1,-(sp) # to a multiple of the page size
1063: movab hststr+scstr,r0 # -> a.out header block
1064: pushl r0 # which will be the other argument
1065: movl $0413,(r0)+ # set magic number
1066: bicl3 $0x3ff,$_etext,r1 # get text size, rounded down
1067: movl r1,(r0)+ # and place it in a.out header
1068: subl3 r1,4(sp),(r0)+ # data size = total - text size
1069: clrl (r0)+ # we will use no bss
1070: clrl (r0)+
1071: clrl (r0)+ # set starting address
1072: clrl (r0)+
1073: clrl (r0)+
1074: #
1075: # call a workhorse c routine to actually write a.out file.
1076: # the amount of memory to write has already been pushed.
1077: #
1078: calls $2,_wrtaout # call to write a.out
1079: #
1080: # restore compiler cells to their previous values
1081: #
1082: jsb streloc # unrelativize stack pointers
1083: #
1084: tstl r0 # if error creating a.out then
1085: blss xi2big # return error
1086: #
1087: # pop registers and set up call to sysej
1088: #
1089: popr $cmpreg # restore all registers
1090: movl r7,r10 # -> chain of fcbs
1091: clrl r7 # set &CODE = 0
1092: jsb sysej # call to end run
1093: #
1094: # if stack too big
1095: #
1096: xi2big: popr $cmpreg # restore all regs
1097: pushr $mr235 # push correct regs
1098: jbr erxit2 # take error exit
1099: #
1100: # error/ppm exits - pick up n-th word following jsb and return
1101: # to address contained in that word.
1102: #
1103: erxit1:
1104: popr $mr235
1105: movl (sp)+,r11
1106: jmp *(r11)+
1107: #
1108: erxit2:
1109: popr $mr235
1110: addl3 $4,(sp)+,r11
1111: jmp *(r11)+
1112: #
1113: erxit3:
1114: popr $mr235
1115: addl3 $8,(sp)+,r11
1116: jmp *(r11)+
1117: #
1118: erxit4:
1119: popr $mr235
1120: addl3 $12,(sp)+,r11
1121: jmp *(r11)+
1122: #
1123: erxit5:
1124: popr $mr235
1125: addl3 $16,(sp)+,r11
1126: jmp *(r11)+
1127: #
1128: erxit6:
1129: popr $mr235
1130: addl3 $20,(sp)+,r11
1131: jmp *(r11)+
1132: #
1133: # streloc - relocate stack pointers. this routine adds
1134: # initsp to every cell whose address appears in strellst.
1135: #
1136: streloc:
1137: pushr $mr0+mr1
1138: moval strellst,r1 # start of list of thing to relocate
1139: jbr strel1 # jump into the loop
1140: strel0: addl2 initsp,(r0) # relocate a pointer
1141: strel1: movl (r1)+,r0 # fetch a pointer to a cell
1142: jneq strel0 # if zero, we're done
1143: popr $mr0+mr1
1144: rsb
1145: #
1146: # option routines
1147: #
1148: # optclr clears a flag
1149: # opterr signals an error
1150: # optfld sets defcas to 0 for no folding
1151: # optnum get numeric value
1152: # optset set option value
1153: #
1154: # optclr
1155: #
1156: optclr: bicl2 optflg(r1),sptflg
1157: rsb
1158: #
1159: # opterr
1160: #
1161: opterr: pushr $mr0+mr1+mr2+mr3+mr4+mr5
1162: pushl $6
1163: pushl $curopt
1164: pushl $2
1165: calls $3,_write
1166: popr $mr0+mr1+mr2+mr3+mr4+mr5
1167: rsb
1168: #
1169: # optinp
1170: #
1171: optinp: tstl inpptr # if already processed input filenames then
1172: bnequ opterr # error
1173: subl3 $4,r6,inpptr # -> first input filename
1174: movl r4,inpcnt # set number of filenames
1175: movl $1,r4 # done scanning options
1176: rsb # return
1177: #
1178: # optfld
1179: #
1180: optfld: clrl defcas
1181: rsb
1182: #
1183: # optnum
1184: #
1185: optnum: pushl r0 # -> number
1186: jsb getnum # get number
1187: movl (sp)+,r0 # -> byte past last digit
1188: movzbl (r0),r2 # get byte past last digit
1189: bisb2 $040,r2 # fold to lower case
1190: cmpb $ch$lk,r2 # if number followed by k then
1191: bnequ 0f
1192: mull2 $1024,r5 # mulitply by 1024
1193: incl r0 # skip over k
1194: 0: tstl r5 # if number zero or negative
1195: bleq opterr # treat as error
1196: movl r5,*optflg(r1) # store option
1197: rsb # return
1198: #
1199: # optoup
1200: #
1201: optoup: cmpl $2,r4 # if no option after -o then
1202: bgtru opterr # error
1203: movl (r6),r1 # -> output filename
1204: cmpb $ch$mn,(r1) # if filename starts with - then
1205: beqlu opterr # error
1206: movl (r6)+,oupptr # save pointer to output filename
1207: decl r4 # one less option to process
1208: rsb # return
1209: #
1210: # optset
1211: #
1212: optset: bisl2 optflg(r1),sptflg
1213: rsb
1214: #
1215: # optusr
1216: #
1217: optusr: cmpl $2,r4 # if fewer than 2 options then
1218: jgtru opterr # can't have argument
1219: movl (r6)+,uarg # save -> argument
1220: decl r4 # dec number of remaining options
1221: rsb
1222: #
1223: # getnum
1224: #
1225: # (sp) -> string to convert
1226: # jsb getnum
1227: # (sp) -> char after last digit
1228: # (r5) converted number
1229: #
1230: getnum:
1231: movl 4(sp),r7 # -> string
1232: clrl r5 # clear accumulator
1233: 0: cmpb $060,(r7) # if not a decimal digit then
1234: bgtru 1f # done with conversion
1235: cmpb $071,(r7) #
1236: blssu 1f
1237: movzbl (r7)+,r8 # load digit
1238: subl2 $060,r8 # remove unnecessary bits
1239: mull2 $10,r5 # accum * 10
1240: addl2 r8,r5 # add in this digit
1241: brb 0b
1242: 1: movl r7,4(sp) # return address of next byte
1243: rsb # return
1244: #
1245: # interface data area
1246: # -------------------
1247: #
1248: .data 1
1249: #
1250: # flags for compiler
1251: #
1252: .set errors,1 # send errors to terminal
1253: .set prtich,2 # standard printer is terminal
1254: .set nolist,4 # suppress compilation listing
1255: .set nocmps,8 # suppress compilation statistics
1256: .set noexcs,16 # suppress execution statistics
1257: .set lnglst,32 # generate page ejects
1258: .set noexec,64 # suppress program execution
1259: .set trmnal,128 # terminal i/o association
1260: .set stdlst,256 # standard listing (intermediate)
1261: .set nohedr,512 # suppress sysid header
1262: #
1263: .set deflag,errors+nolist+nocmps+noexcs+trmnal+nohedr
1264: #
1265: # option table
1266: #
1267: .set opttxt,0 # option characters
1268: .set optflg,4 # option flag - flags or address
1269: .set optrtn,8 # -> option processing routine
1270: .set optsiz,12 # size in bytes of entry
1271: #
1272: opttbl:
1273: .ascii "-f "
1274: .long 0,optfld
1275: #
1276: .ascii "-e "
1277: .long errors,optclr
1278: #
1279: .ascii "-l "
1280: .long nolist,optclr
1281: #
1282: .ascii "-c "
1283: .long nocmps,optclr
1284: #
1285: .ascii "-x "
1286: .long noexcs,optclr
1287: #
1288: .ascii "-a "
1289: .long nolist+nocmps+noexcs,optclr
1290: #
1291: .ascii "-p "
1292: .long lnglst,optset
1293: #
1294: .ascii "-z "
1295: .long stdlst,optset
1296: #
1297: .ascii "-h "
1298: .long nohedr,optclr
1299: #
1300: .ascii "-n "
1301: .long noexec,optset
1302: #
1303: .ascii "-m "
1304: .long maxsiz,optnum
1305: #
1306: .ascii "-s "
1307: .long stksiz,optnum
1308: #
1309: .ascii "-d "
1310: .long datwds,optnum
1311: #
1312: .ascii "-i "
1313: .long meminc,optnum
1314: #
1315: .ascii "-o "
1316: .long 0,optoup
1317: #
1318: .ascii "-u "
1319: .long 0,optusr
1320: #
1321: curopt: .ascii "- "
1322: .ascii "?\n "
1323: .long opterr
1324: .align 2
1325: #
1326: # standard input/output pointers
1327: #
1328: inpcnt: .long 0
1329: inpptr: .long 0
1330: oupptr: .long 0
1331: #
1332: # pointer to -u arg
1333: #
1334: uarg: .long 0
1335: #
1336: # save argc and argv from initial call
1337: #
1338: argc: .long 0
1339: argv: .long 0
1340: #
1341: # #! data areas
1342: #
1343: cmdcnt: .long 0 # number of command args
1344: rdrec1: .long 0 # read record 1 from std in flag
1345: #
1346: # standard ioblks
1347: #
1348: inpiob: .space iobuf
1349: .long inpbf # -> input bfblk
1350: .long 0 # file descriptor
1351: .long IO_INP|IO_OPN|IO_SYS
1352: #
1353: inpbf: .space bfsiz
1354: .long 4096 # buffer size
1355: .long 0 # remaining chars to read
1356: .long 0 # offset to next character to read
1357: .space 4096 # buffer
1358: #
1359: #
1360: oupiob: .space iobuf
1361: .long 0 # no buffer
1362: .long 1 # file descriptor number
1363: .long IO_OUP|IO_OPN|IO_SYS
1364: #
1365: #
1366: ttyiob: .space iobuf
1367: .long ttybf # -> tty buffer input
1368: .long 2 # file descriptor number
1369: .long IO_INP|IO_OUP|IO_OPN|IO_SYS
1370: #
1371: ttybf: .space bfsiz
1372: .long 258 # buffer size
1373: .long 0 # remaining chars to read
1374: .long 0 # offset to next char to read
1375: .space 258 # buffer
1376: .align 2
1377: #
1378: .globl _rzfcb
1379: _rzfcb: .long 0
1380: #
1381: fildes: .long 0
1382: pr_len: .long 0
1383: rd_len: .long 0
1384: lenfname: .long 0
1385: ioblkptr: .long 0
1386: bfblkptr: .long 0
1387: bfblksiz: .long 0
1388: fcblkptr: .long 0
1389: tioblk: .space iosize
1390: #
1391: # memory allocation variables
1392: #
1393: meminc: .long 4*k # increment in words for sbrk
1394: meminb: .long 0 # meminc * 4 (to get bytes)
1395: datwds: .long 256*k # max size in words of dynamic area
1396: basmem: .long 0 # base of dynamic memory
1397: topmem: .long 0 # current top of dynamic memory
1398: maxmem: .long 0 # maximum top of dynamic memory
1399: maxsiz: .long 8*k # maximum object size in words
1400: stksiz: .long 2*k # stack size in words
1401: initsp: .long 0 # initial value of sp on entry to sec04
1402: lowsp: .long 0 # lowest legal sp value
1403: #
1404: # default value for &case
1405: #
1406: defcas: .long 1
1407: #
1408: # values given to syspp for print parameters
1409: #
1410: lnsppg: .long 60 # lines per page
1411: pagwid: .long 120 # page width
1412: sptflg: .long deflag # flags
1413: #
1414: # flag that indicates that this is a load module. also, serves
1415: # the dual purpose of indicating size of saved stack.
1416: #
1417: lmodstk: .long 0
1418: #
1419: temp1: .long 0
1420: temp2: .long 0
1421: temp3: .long 0
1422: #
1423: nulstr: .long 0,0
1424: #
1425: tscblk: .long 512,0
1426: .space 512
1427: #
1428: hststr: .long 128,0
1429: .space 128
1430: #
1431: id1: .long 0,id1l
1432: .ascii "(0.0)"
1433: id1e:
1434: .set id1l,id1e-id1-8
1435: .align 2
1436: #
1437: id2: .long 0,id2l
1438: .ascii "VAX/UNIX Version"
1439: id2e:
1440: .set id2l,id2e-id2-8
1441: .align 2
1442: #
1443: ffscb: .long 0,1
1444: ffstr: .byte 12
1445: #
1446: nlstr: .ascii "\n"
1447: .align 2
1448: #
1449: errfdn: .long 0
1450: #
1451: # The following pointers address those cells in the compiler
1452: # that point into the stack when a load module might be written,
1453: # and which must therefore be relocated.
1454: strellst:
1455: .long flptr
1456: .long stbas
1457: .long gtcef
1458: .long 0 # end of list marker
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.